paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-05 05:58:02 +02:00
Code Issues Packages Projects Releases Wiki Activity
main
fpc/compiler/wasm32/cpupi.pas

1053 lines
42 KiB
ObjectPascal
Raw Permalink Blame History

{
Copyright (c) 2002-2010 by Florian Klaempfl and Jonas Maebe
This unit contains the CPU specific part of tprocinfo
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit cpupi;
{$i fpcdefs.inc}
interface
uses
cutils,globtype,aasmdata,aasmcpu,aasmtai,
procinfo,cpubase,cpuinfo, symtype,aasmbase,cgbase,
psub, cclasses;
type
{ tcpuprocinfo }
tcpuprocinfo=class(tcgprocinfo)
private
FFuncType: TWasmFuncType;
FLocals: array of TWasmBasicType;
FParametersCount: Integer;
FFirstFreeLocal: Integer;
FAllocatedLocals: array of TWasmBasicType;
FGotoTargets: TFPHashObjectList;
function ConvertBranchTargetNumbersToLabels(ai: tai; blockstack: twasmstruc_stack): TAsmMapFuncResult;
function ConvertIfToBrIf(ai: tai; blockstack: twasmstruc_stack): TAsmMapFuncResult;
function ConvertLoopToBr(ai: tai; blockstack: twasmstruc_stack): TAsmMapFuncResult;
function StripBlockInstructions(ai: tai; blockstack: twasmstruc_stack): TAsmMapFuncResult;
{ used for allocating locals during the postprocess_code stage (i.e. after register allocation) }
function AllocWasmLocal(wbt: TWasmBasicType): Integer;
function GetLocalType(localidx: Integer): TWasmBasicType;
public
{ label to the nearest local exception handler }
CurrRaiseLabel : tasmlabel;
constructor create(aparent: tprocinfo); override;
destructor destroy; override;
function calc_stackframe_size : longint;override;
procedure setup_eh; override;
procedure generate_exit_label(list: tasmlist); override;
procedure postprocess_code; override;
procedure set_first_temp_offset;override;
procedure add_goto_target(l : tasmlabel);
function is_goto_target(l : tasmsymbol): Boolean;
end;
implementation
uses
systems,verbose,globals,tgcpu,cgexcept,
tgobj,paramgr,symconst,symdef,symtable,symcpu,cgutils,pass_2,parabase,
fmodule,hlcgobj,hlcgcpu,defutil,itcpugas;
{*****************************************************************************
twasmexceptionstatehandler_noexceptions
*****************************************************************************}
type
{ twasmexceptionstatehandler_noexceptions }
twasmexceptionstatehandler_noexceptions = class(tcgexceptionstatehandler)
class procedure get_exception_temps(list:TAsmList;var t:texceptiontemps); override;
class procedure unget_exception_temps(list:TAsmList;const t:texceptiontemps); override;
class procedure new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate); override;
class procedure free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean); override;
class procedure handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate); override;
end;
class procedure twasmexceptionstatehandler_noexceptions.get_exception_temps(list:TAsmList;var t:texceptiontemps);
begin
if not assigned(exceptionreasontype) then
exceptionreasontype:=search_system_proc('fpc_setjmp').returndef;
reference_reset(t.envbuf,0,[]);
reference_reset(t.jmpbuf,0,[]);
tg.gethltemp(list,exceptionreasontype,exceptionreasontype.size,tt_persistent,t.reasonbuf);
end;
class procedure twasmexceptionstatehandler_noexceptions.unget_exception_temps(list:TAsmList;const t:texceptiontemps);
begin
tg.ungettemp(list,t.reasonbuf);
end;
class procedure twasmexceptionstatehandler_noexceptions.new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate);
begin
exceptstate.exceptionlabel:=nil;
exceptstate.oldflowcontrol:=flowcontrol;
exceptstate.finallycodelabel:=nil;
flowcontrol:=[fc_inflowcontrol,fc_catching_exceptions];
end;
class procedure twasmexceptionstatehandler_noexceptions.free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean);
begin
end;
class procedure twasmexceptionstatehandler_noexceptions.handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate);
begin
list.Concat(tai_comment.Create(strpnew('TODO: handle_nested_exception')));
end;
{*****************************************************************************
twasmexceptionstatehandler_jsexceptions
*****************************************************************************}
type
twasmexceptionstatehandler_jsexceptions = class(tcgexceptionstatehandler)
class procedure get_exception_temps(list:TAsmList;var t:texceptiontemps); override;
class procedure unget_exception_temps(list:TAsmList;const t:texceptiontemps); override;
class procedure new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate); override;
class procedure free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean); override;
class procedure handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate); override;
end;
class procedure twasmexceptionstatehandler_jsexceptions.get_exception_temps(list:TAsmList;var t:texceptiontemps);
begin
if not assigned(exceptionreasontype) then
exceptionreasontype:=search_system_proc('fpc_setjmp').returndef;
reference_reset(t.envbuf,0,[]);
reference_reset(t.jmpbuf,0,[]);
tg.gethltemp(list,exceptionreasontype,exceptionreasontype.size,tt_persistent,t.reasonbuf);
end;
class procedure twasmexceptionstatehandler_jsexceptions.unget_exception_temps(list:TAsmList;const t:texceptiontemps);
begin
tg.ungettemp(list,t.reasonbuf);
end;
class procedure twasmexceptionstatehandler_jsexceptions.new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate);
begin
exceptstate.exceptionlabel:=nil;
exceptstate.oldflowcontrol:=flowcontrol;
exceptstate.finallycodelabel:=nil;
flowcontrol:=[fc_inflowcontrol,fc_catching_exceptions];
end;
class procedure twasmexceptionstatehandler_jsexceptions.free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean);
begin
end;
class procedure twasmexceptionstatehandler_jsexceptions.handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate);
begin
list.Concat(tai_comment.Create(strpnew('TODO: handle_nested_exception')));
end;
{*****************************************************************************
twasmexceptionstatehandler_nativeexceptions
*****************************************************************************}
type
{ twasmexceptionstatehandler_nativeexceptions }
twasmexceptionstatehandler_nativeexceptions = class(tcgexceptionstatehandler)
class procedure new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate); override;
class procedure free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean); override;
class procedure handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate); override;
{ start of an "on" (catch) block }
class procedure begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister); override;
{ end of an "on" (catch) block }
class procedure end_catch(list: TAsmList); override;
end;
class procedure twasmexceptionstatehandler_nativeexceptions.new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate);
begin
exceptstate.exceptionlabel:=nil;
exceptstate.oldflowcontrol:=flowcontrol;
exceptstate.finallycodelabel:=nil;
flowcontrol:=[fc_inflowcontrol,fc_catching_exceptions];
end;
class procedure twasmexceptionstatehandler_nativeexceptions.free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean);
begin
end;
class procedure twasmexceptionstatehandler_nativeexceptions.handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate);
begin
Message1(parser_f_unsupported_feature,'nested exception');
end;
class procedure twasmexceptionstatehandler_nativeexceptions.begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister);
var
pd: tprocdef;
href2: treference;
fpc_catches_res,
paraloc1: tcgpara;
exceptloc: tlocation;
indirect: boolean;
otherunit: boolean;
begin
paraloc1.init;
otherunit:=findunitsymtable(excepttype.owner).moduleid<>findunitsymtable(current_procinfo.procdef.owner).moduleid;
indirect:=(tf_supports_packages in target_info.flags) and
(target_info.system in systems_indirect_var_imports) and
(cs_imported_data in current_settings.localswitches) and
otherunit;
{ send the vmt parameter }
pd:=search_system_proc('fpc_catches');
reference_reset_symbol(href2, current_asmdata.RefAsmSymbol(excepttype.vmt_mangledname, AT_DATA, indirect), 0, sizeof(pint), []);
if otherunit then
current_module.add_extern_asmsym(excepttype.vmt_mangledname, AB_EXTERNAL, AT_DATA);
paramanager.getcgtempparaloc(list, pd, 1, paraloc1);
hlcg.a_loadaddr_ref_cgpara(list, excepttype.vmt_def, href2, paraloc1);
paramanager.freecgpara(list, paraloc1);
fpc_catches_res:=hlcg.g_call_system_proc(list, pd, [@paraloc1], nil);
location_reset(exceptloc, LOC_REGISTER, def_cgsize(fpc_catches_res.def));
exceptloc.register:=hlcg.getaddressregister(list, fpc_catches_res.def);
hlcg.gen_load_cgpara_loc(list, fpc_catches_res.def, fpc_catches_res, exceptloc, true);
{ is it this catch? }
thlcgwasm(hlcg).a_cmp_const_reg_stack(list, fpc_catches_res.def, OC_NE, 0, exceptloc.register);
current_asmdata.CurrAsmList.concat(taicpu.op_none(a_if));
thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
paraloc1.done;
exceptlocdef:=fpc_catches_res.def;
exceptlocreg:=exceptloc.register;
end;
class procedure twasmexceptionstatehandler_nativeexceptions.end_catch(list: TAsmList);
begin
current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_if));
end;
{*****************************************************************************
twasmexceptionstatehandler_bfexceptions
*****************************************************************************}
type
{ twasmexceptionstatehandler_bfexceptions }
twasmexceptionstatehandler_bfexceptions = class(tcgexceptionstatehandler)
class procedure new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate); override;
class procedure free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean); override;
class procedure handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate); override;
{ start of an "on" (catch) block }
class procedure begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister); override;
{ end of an "on" (catch) block }
class procedure end_catch(list: TAsmList); override;
end;
class procedure twasmexceptionstatehandler_bfexceptions.new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate);
begin
exceptstate.exceptionlabel:=nil;
exceptstate.oldflowcontrol:=flowcontrol;
exceptstate.finallycodelabel:=nil;
flowcontrol:=[fc_inflowcontrol,fc_catching_exceptions];
end;
class procedure twasmexceptionstatehandler_bfexceptions.free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean);
begin
end;
class procedure twasmexceptionstatehandler_bfexceptions.handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate);
begin
Message1(parser_f_unsupported_feature,'nested exception');
end;
class procedure twasmexceptionstatehandler_bfexceptions.begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister);
var
pd: tprocdef;
href2: treference;
fpc_catches_res,
paraloc1: tcgpara;
exceptloc: tlocation;
indirect: boolean;
otherunit: boolean;
begin
paraloc1.init;
otherunit:=findunitsymtable(excepttype.owner).moduleid<>findunitsymtable(current_procinfo.procdef.owner).moduleid;
indirect:=(tf_supports_packages in target_info.flags) and
(target_info.system in systems_indirect_var_imports) and
(cs_imported_data in current_settings.localswitches) and
otherunit;
{ send the vmt parameter }
pd:=search_system_proc('fpc_catches');
reference_reset_symbol(href2, current_asmdata.RefAsmSymbol(excepttype.vmt_mangledname, AT_DATA, indirect), 0, sizeof(pint), []);
if otherunit then
current_module.add_extern_asmsym(excepttype.vmt_mangledname, AB_EXTERNAL, AT_DATA);
paramanager.getcgtempparaloc(list, pd, 1, paraloc1);
hlcg.a_loadaddr_ref_cgpara(list, excepttype.vmt_def, href2, paraloc1);
paramanager.freecgpara(list, paraloc1);
fpc_catches_res:=hlcg.g_call_system_proc(list, pd, [@paraloc1], nil);
location_reset(exceptloc, LOC_REGISTER, def_cgsize(fpc_catches_res.def));
exceptloc.register:=hlcg.getaddressregister(list, fpc_catches_res.def);
hlcg.gen_load_cgpara_loc(list, fpc_catches_res.def, fpc_catches_res, exceptloc, true);
{ is it this catch? }
thlcgwasm(hlcg).a_cmp_const_reg_stack(list, fpc_catches_res.def, OC_NE, 0, exceptloc.register);
current_asmdata.CurrAsmList.concat(taicpu.op_none(a_if));
thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
paraloc1.done;
exceptlocdef:=fpc_catches_res.def;
exceptlocreg:=exceptloc.register;
end;
class procedure twasmexceptionstatehandler_bfexceptions.end_catch(list: TAsmList);
begin
current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_if));
end;
{*****************************************************************************
twasmblockitem
*****************************************************************************}
type
{ twasmblockitem }
twasmblockitem = class(TLinkedListItem)
blockstart: taicpu;
elseinstr: taicpu;
constructor Create(ablockstart: taicpu);
end;
constructor twasmblockitem.Create(ablockstart: taicpu);
begin
blockstart:=ablockstart;
end;
{*****************************************************************************
twasmblockstack
*****************************************************************************}
type
{ twasmblockstack }
twasmblockstack = class(tlinkedlist)
end;
{*****************************************************************************
tcpuprocinfo
*****************************************************************************}
function tcpuprocinfo.ConvertBranchTargetNumbersToLabels(ai: tai; blockstack: twasmstruc_stack): TAsmMapFuncResult;
var
instr: taicpu;
bl: taicpu_wasm_structured_instruction;
l: TAsmLabel;
begin
result.typ:=amfrtNoChange;
if ai.typ<>ait_instruction then
exit;
instr:=taicpu(ai);
if not (instr.opcode in [a_br,a_br_if]) then
exit;
if instr.ops<>1 then
internalerror(2023101601);
if instr.oper[0]^.typ<>top_const then
exit;
bl:=blockstack[instr.oper[0]^.val];
l:=bl.getlabel;
instr.loadsymbol(0,l,0);
end;
function tcpuprocinfo.ConvertIfToBrIf(ai: tai; blockstack: twasmstruc_stack): TAsmMapFuncResult;
begin
result.typ:=amfrtNoChange;
if (ai.typ=ait_wasm_structured_instruction) and (taicpu_wasm_structured_instruction(ai).wstyp=aitws_if) then
begin
result.typ:=amfrtNewList;
result.newlist:=TAsmList.Create;
tai_wasmstruc_if(ai).ConvertToBrIf(result.newlist,@AllocWasmLocal);
end;
end;
function tcpuprocinfo.ConvertLoopToBr(ai: tai; blockstack: twasmstruc_stack): TAsmMapFuncResult;
begin
result.typ:=amfrtNoChange;
if (ai.typ=ait_wasm_structured_instruction) and (taicpu_wasm_structured_instruction(ai).wstyp=aitws_loop) then
begin
result.typ:=amfrtNewList;
result.newlist:=TAsmList.Create;
tai_wasmstruc_loop(ai).ConvertToBr(result.newlist);
end;
end;
function tcpuprocinfo.StripBlockInstructions(ai: tai; blockstack: twasmstruc_stack): TAsmMapFuncResult;
var
instr: taicpu;
begin
result.typ:=amfrtNoChange;
if ai.typ<>ait_instruction then
exit;
instr:=taicpu(ai);
if instr.opcode in [a_block,a_end_block] then
result.typ:=amfrtDeleteAi;
end;
function tcpuprocinfo.AllocWasmLocal(wbt: TWasmBasicType): Integer;
begin
SetLength(FAllocatedLocals,Length(FAllocatedLocals)+1);
FAllocatedLocals[High(FAllocatedLocals)]:=wbt;
result:=High(FAllocatedLocals)+FFirstFreeLocal;
SetLength(FLocals,Length(FLocals)+1);
FLocals[High(FLocals)]:=wbt;
end;
function tcpuprocinfo.GetLocalType(localidx: Integer): TWasmBasicType;
begin
if (localidx<Low(FLocals)) or (localidx>High(FLocals)) then
internalerror(2024022601);
result:=FLocals[localidx];
end;
constructor tcpuprocinfo.create(aparent: tprocinfo);
begin
inherited create(aparent);
FGotoTargets:=TFPHashObjectList.Create(false);
if ts_wasm_bf_exceptions in current_settings.targetswitches then
current_asmdata.getjumplabel(CurrRaiseLabel);
end;
destructor tcpuprocinfo.destroy;
begin
FGotoTargets.Free;
inherited destroy;
end;
function tcpuprocinfo.calc_stackframe_size: longint;
begin
{ the stack frame in WebAssembly should always have a 16-byte alignment }
Result:=Align(inherited calc_stackframe_size,16);
end;
procedure tcpuprocinfo.setup_eh;
begin
if ts_wasm_native_exceptions in current_settings.targetswitches then
cexceptionstatehandler:=twasmexceptionstatehandler_nativeexceptions
else if ts_wasm_js_exceptions in current_settings.targetswitches then
cexceptionstatehandler:=twasmexceptionstatehandler_jsexceptions
else if ts_wasm_no_exceptions in current_settings.targetswitches then
cexceptionstatehandler:=twasmexceptionstatehandler_noexceptions
else if ts_wasm_bf_exceptions in current_settings.targetswitches then
cexceptionstatehandler:=twasmexceptionstatehandler_bfexceptions
else
internalerror(2021091701);
end;
procedure tcpuprocinfo.generate_exit_label(list: tasmlist);
begin
if not (po_assembler in current_procinfo.procdef.procoptions) then
list.concat(taicpu.op_none(a_end_block));
inherited generate_exit_label(list);
end;
procedure tcpuprocinfo.postprocess_code;
function findfirst_tai_functype(asmlist: TAsmList): tai_functype;
var
hp: tai;
begin
result:=nil;
if not assigned(asmlist) then
exit;
hp:=tai(asmlist.first);
while assigned(hp) do
begin
if hp.typ=ait_functype then
begin
result:=tai_functype(hp);
exit;
end;
hp:=tai(hp.Next);
end;
end;
procedure replace_local_frame_pointer(asmlist: TAsmList);
var
hp: tai;
instr: taicpu;
l: Integer;
begin
if not assigned(asmlist) then
exit;
hp:=tai(asmlist.first);
while assigned(hp) do
begin
if hp.typ=ait_instruction then
begin
instr:=taicpu(hp);
for l:=0 to instr.ops-1 do
if (instr.oper[l]^.typ=top_reg) and (instr.oper[l]^.reg=NR_LOCAL_FRAME_POINTER_REG) then
instr.loadref(l,tcpuprocdef(current_procinfo.procdef).frame_pointer_ref);
end;
hp:=tai(hp.Next);
end;
end;
function FindNextInstruction(hp: tai): taicpu;
begin
result:=nil;
if not assigned(hp) then
exit;
repeat
hp:=tai(hp.next);
until not assigned(hp) or (hp.typ=ait_instruction);
if assigned(hp) then
result:=taicpu(hp);
end;
procedure resolve_labels_pass1(asmlist: TAsmList);
var
hp: tai;
lastinstr, nextinstr: taicpu;
cur_nesting_depth: longint;
lbl: tai_label;
blockstack: twasmblockstack;
cblock: twasmblockitem;
begin
blockstack:=twasmblockstack.create;
cur_nesting_depth:=0;
lastinstr:=nil;
hp:=tai(asmlist.first);
while assigned(hp) do
begin
case hp.typ of
ait_instruction:
begin
lastinstr:=taicpu(hp);
case lastinstr.opcode of
a_block,
a_loop,
a_if,
a_try:
begin
blockstack.Concat(twasmblockitem.create(lastinstr));
inc(cur_nesting_depth);
end;
a_else:
begin
cblock:=twasmblockitem(blockstack.Last);
if (cblock=nil) or
(cblock.blockstart.opcode<>a_if) or
assigned(cblock.elseinstr) then
Message1(parser_f_unsupported_feature,'misplaced a_else');
cblock.elseinstr:=lastinstr;
end;
a_end_block,
a_end_loop,
a_end_if,
a_end_try:
begin
dec(cur_nesting_depth);
if cur_nesting_depth<0 then
Message1(parser_f_unsupported_feature,'negative nesting level');
cblock:=twasmblockitem(blockstack.GetLast);
if (cblock=nil) or
((cblock.blockstart.opcode=a_block) and (lastinstr.opcode<>a_end_block)) or
((cblock.blockstart.opcode=a_loop) and (lastinstr.opcode<>a_end_loop)) or
((cblock.blockstart.opcode=a_if) and (lastinstr.opcode<>a_end_if)) or
((cblock.blockstart.opcode=a_try) and (lastinstr.opcode<>a_end_try)) then
Message1(parser_f_unsupported_feature,'incompatible nesting level');
cblock.free;
end;
else
;
end;
end;
ait_label:
begin
lbl:=tai_label(hp);
lbl.labsym.nestingdepth:=-1;
nextinstr:=FindNextInstruction(hp);
if assigned(nextinstr) and (nextinstr.opcode in [a_end_block,a_end_try,a_end_if]) then
lbl.labsym.nestingdepth:=cur_nesting_depth
else if assigned(lastinstr) and (lastinstr.opcode=a_loop) then
lbl.labsym.nestingdepth:=cur_nesting_depth
else if assigned(lastinstr) and (lastinstr.opcode in [a_end_block,a_end_try,a_end_if]) then
lbl.labsym.nestingdepth:=cur_nesting_depth+1
else if assigned(nextinstr) and (nextinstr.opcode=a_loop) then
lbl.labsym.nestingdepth:=cur_nesting_depth+1;
end;
else
;
end;
hp:=tai(hp.Next);
end;
if cur_nesting_depth<>0 then
Message1(parser_f_unsupported_feature,'unbalanced nesting level');
blockstack.free;
end;
function resolve_labels_pass2(asmlist: TAsmList): Boolean;
var
hp: tai;
instr: taicpu;
hlabel: tasmsymbol;
cur_nesting_depth: longint;
begin
Result:=true;
cur_nesting_depth:=0;
hp:=tai(asmlist.first);
while assigned(hp) do
begin
if hp.typ=ait_instruction then
begin
instr:=taicpu(hp);
case instr.opcode of
a_block,
a_loop,
a_if,
a_try:
inc(cur_nesting_depth);
a_end_block,
a_end_loop,
a_end_if,
a_end_try:
begin
dec(cur_nesting_depth);
if cur_nesting_depth<0 then
Message1(parser_f_unsupported_feature,'negative nesting level');
end;
a_br,
a_br_if:
begin
if instr.ops<>1 then
Message1(parser_f_unsupported_feature,'a_br or a_br_if with wrong operand count');
if instr.oper[0]^.typ=top_ref then
begin
if not assigned(instr.oper[0]^.ref^.symbol) then
Message1(parser_f_unsupported_feature,'a_br or a_br_if with wrong ref operand');
if (instr.oper[0]^.ref^.base<>NR_NO) or
(instr.oper[0]^.ref^.index<>NR_NO) or
(instr.oper[0]^.ref^.offset<>0) then
Message1(parser_f_unsupported_feature,'a_br or a_br_if with wrong ref type');
if (instr.oper[0]^.ref^.symbol.nestingdepth<>-1) and
(cur_nesting_depth>=instr.oper[0]^.ref^.symbol.nestingdepth) then
instr.loadconst(0,cur_nesting_depth-instr.oper[0]^.ref^.symbol.nestingdepth)
else
begin
result:=false;
hlabel:=tasmsymbol(instr.oper[0]^.ref^.symbol);
asmlist.insertafter(tai_comment.create(strpnew('Unable to find destination of label '+hlabel.name)),hp);
end;
end;
end;
else
;
end;
end;
hp:=tai(hp.Next);
end;
if cur_nesting_depth<>0 then
Message1(parser_f_unsupported_feature,'unbalanced nesting level');
end;
function resolve_labels_simple(asmlist: TAsmList): Boolean;
begin
if not assigned(asmlist) then
exit(true);
resolve_labels_pass1(asmlist);
result:=resolve_labels_pass2(asmlist);
end;
procedure resolve_labels_via_state_machine(asmlist: TAsmList);
var
blocks: TFPHashObjectList;
curr_block, tmplist: TAsmList;
hp, hpnext: tai;
block_nr, machine_state, target_block_index: Integer;
state_machine_loop_start_label, state_machine_exit: TAsmLabel;
begin
blocks:=TFPHashObjectList.Create;
curr_block:=TAsmList.Create;
blocks.Add('.start',curr_block);
repeat
hp:=tai(asmlist.First);
if assigned(hp) then
begin
asmlist.Remove(hp);
if hp.typ=ait_label then
begin
if (tai_label(hp).labsym.is_used) then
begin
curr_block:=TAsmList.Create;
blocks.Add(tai_label(hp).labsym.Name,curr_block);
end;
end
else
curr_block.Concat(hp);
end;
until not assigned(hp);
{ asmlist is now empty }
asmlist.Concat(tai_comment.Create(strpnew('labels resolved via state machine')));
machine_state:=AllocWasmLocal(wbt_i32);
asmlist.Concat(tai_comment.Create(strpnew('machine state is in local '+tostr(machine_state))));
asmlist.Concat(taicpu.op_const(a_i32_const,0));
asmlist.Concat(taicpu.op_const(a_local_set,machine_state));
asmlist.Concat(taicpu.op_none(a_block));
asmlist.Concat(taicpu.op_none(a_loop));
current_asmdata.getjumplabel(state_machine_loop_start_label);
asmlist.concat(tai_label.create(state_machine_loop_start_label));
current_asmdata.getjumplabel(state_machine_exit);
for block_nr:=0 to blocks.Count-1 do
asmlist.Concat(taicpu.op_none(a_block));
for block_nr:=0 to blocks.Count-1 do
begin
{ TODO: this sequence can be replaced with a single br_table instruction }
asmlist.Concat(taicpu.op_const(a_local_get,machine_state));
asmlist.Concat(taicpu.op_const(a_i32_const,block_nr));
asmlist.Concat(taicpu.op_none(a_i32_eq));
asmlist.Concat(taicpu.op_const(a_br_if,block_nr));
end;
asmlist.Concat(taicpu.op_none(a_unreachable));
tmplist:=TAsmList.Create;
for block_nr:=0 to blocks.Count-1 do
begin
asmlist.Concat(taicpu.op_none(a_end_block));
asmlist.Concat(tai_comment.Create(strpnew('block '+tostr(block_nr)+' for label '+blocks.NameOfIndex(block_nr))));
curr_block:=TAsmList(blocks[block_nr]);
hp:=tai(curr_block.First);
while assigned(hp) do
begin
hpnext:=tai(hp.next);
if (hp.typ=ait_instruction) and (taicpu(hp).opcode in [a_br,a_br_if]) and
(taicpu(hp).ops=1) and
(taicpu(hp).oper[0]^.typ=top_ref) and
assigned(taicpu(hp).oper[0]^.ref^.symbol) then
begin
target_block_index:=blocks.FindIndexOf(taicpu(hp).oper[0]^.ref^.symbol.Name);
curr_block.InsertBefore(tai_comment.Create(strpnew(
'branch '+gas_op2str[taicpu(hp).opcode]+
' '+taicpu(hp).oper[0]^.ref^.symbol.Name+
' target_block_index='+tostr(target_block_index))),hp);
if target_block_index<>-1 then
begin
tmplist.Clear;
if taicpu(hp).opcode=a_br_if then
tmplist.Concat(taicpu.op_none(a_if));
tmplist.Concat(taicpu.op_const(a_i32_const,target_block_index));
tmplist.Concat(taicpu.op_const(a_local_set,machine_state));
tmplist.Concat(taicpu.op_sym(a_br,state_machine_loop_start_label));
if taicpu(hp).opcode=a_br_if then
tmplist.Concat(taicpu.op_none(a_end_if));
curr_block.insertListAfter(hp,tmplist);
curr_block.Remove(hp);
end;
end;
hp:=hpnext;
end;
if block_nr<(blocks.Count-1) then
begin
curr_block.Concat(taicpu.op_const(a_i32_const,block_nr+1));
curr_block.Concat(taicpu.op_const(a_local_set,machine_state));
curr_block.Concat(taicpu.op_sym(a_br,state_machine_loop_start_label));
end
else
curr_block.Concat(taicpu.op_sym(a_br,state_machine_exit));
asmlist.concatList(curr_block);
end;
tmplist.Free;
asmlist.Concat(taicpu.op_none(a_end_loop));
asmlist.Concat(taicpu.op_none(a_end_block));
asmlist.concat(tai_label.create(state_machine_exit));
end;
procedure filter_start_exit_code(asmlist: TAsmList; out entry_code, proc_body, exit_code: TAsmList);
var
hp, hpnext, hpprev: tai;
begin
entry_code:=TAsmList.Create;
proc_body:=TAsmList.Create;
exit_code:=TAsmList.Create;
repeat
hp:=tai(asmlist.First);
if assigned(hp) then
begin
hpnext:=tai(hp.next);
if (hp.typ=ait_instruction) and (taicpu(hp).opcode=a_block) then
break;
asmlist.Remove(hp);
entry_code.Concat(hp);
hp:=hpnext;
end;
until not assigned(hp);
repeat
hp:=tai(asmlist.Last);
if assigned(hp) then
begin
hpprev:=tai(hp.Previous);
if (hp.typ=ait_instruction) and (taicpu(hp).opcode=a_end_block) then
break;
asmlist.Remove(hp);
exit_code.Insert(hp);
hp:=hpprev;
end;
until not assigned(hp);
proc_body.insertList(asmlist);
end;
procedure resolve_labels_of_asmlist_with_try_blocks_recursive(asmlist: TAsmList);
var
hp: tai;
i: Integer;
begin
if not assigned(asmlist) then
exit;
hp:=tai(asmlist.First);
while assigned(hp) do
begin
if hp.typ=ait_wasm_structured_instruction then
begin
if not (taicpu_wasm_structured_instruction(hp).wstyp in [aitws_try_catch,aitws_try_delegate]) then
internalerror(2023102201);
resolve_labels_of_asmlist_with_try_blocks_recursive(tai_wasmstruc_try(hp).try_asmlist);
if taicpu_wasm_structured_instruction(hp).wstyp=aitws_try_catch then
with tai_wasmstruc_try_catch(hp) do
begin
for i:=low(catch_list) to high(catch_list) do
resolve_labels_of_asmlist_with_try_blocks_recursive(catch_list[i].asmlist);
resolve_labels_of_asmlist_with_try_blocks_recursive(catch_all_asmlist);
end
else if taicpu_wasm_structured_instruction(hp).wstyp=aitws_try_delegate then
{nothing}
else
internalerror(2023102202);
end;
hp:=tai(hp.next);
end;
resolve_labels_via_state_machine(asmlist);
end;
procedure resolve_labels_complex(var asmlist: TAsmList);
var
entry_code, proc_body, exit_code: TAsmList;
begin
filter_start_exit_code(asmlist,entry_code,proc_body,exit_code);
asmlist.Free;
asmlist:=proc_body;
proc_body:=nil;
wasm_convert_to_structured_asmlist(asmlist);
map_structured_asmlist(asmlist,@ConvertBranchTargetNumbersToLabels);
map_structured_asmlist(asmlist,@ConvertIfToBrIf);
map_structured_asmlist(asmlist,@ConvertLoopToBr);
wasm_convert_to_flat_asmlist(asmlist);
map_structured_asmlist(asmlist,@StripBlockInstructions);
wasm_convert_to_structured_asmlist(asmlist);
resolve_labels_of_asmlist_with_try_blocks_recursive(asmlist);
wasm_convert_to_flat_asmlist(asmlist);
asmlist.insertList(entry_code);
entry_code.free;
asmlist.concatList(exit_code);
exit_code.free;
if not resolve_labels_simple(asmlist) then
internalerror(2023102101);
end;
function prepare_locals: TAsmList;
var
local: tai_local;
l : TWasmLocal;
begin
result:=TAsmList.create;
local:=tai_local.create([]);
result.Concat(local);
l:=ttgwasm(tg).localvars.first;
FFuncType:=findfirst_tai_functype(aktproccode).functype;
FLocals:=Copy(FFuncType.params);
FParametersCount:=Length(FLocals);
FFirstFreeLocal:=FParametersCount;
while Assigned(l) do
begin
SetLength(FLocals,Length(FLocals)+1);
FLocals[High(FLocals)]:=l.typ;
local.AddLocal(l.typ);
l:=l.nextseq;
Inc(FFirstFreeLocal);
end;
end;
procedure add_extra_allocated_locals(localslist: TAsmList);
begin
if tai(localslist.First).typ<>ait_local then
internalerror(2024081501);
tai_local(localslist.First).AddLocals(FAllocatedLocals);
end;
procedure insert_localslist(destlist,localslist: TAsmList);
begin
if assigned(localslist) then
destlist.insertListAfter(findfirst_tai_functype(destlist),localslist);
end;
procedure check_goto_br_instructions(list: TAsmList; out HasGotoBrInstructions: boolean);
var
hp: tai;
begin
HasGotoBrInstructions:=False;
hp:=tai(list.first);
while assigned(hp) do
begin
if (hp.typ=ait_instruction) and (taicpu(hp).is_br_generated_by_goto) then
begin
HasGotoBrInstructions:=True;
if (taicpu(hp).opcode<>a_br) or
(taicpu(hp).ops<>1) or
(taicpu(hp).oper[0]^.typ<>top_ref) or
(taicpu(hp).oper[0]^.ref^.offset<>0) or
(taicpu(hp).oper[0]^.ref^.base<>NR_NO) or
(taicpu(hp).oper[0]^.ref^.index<>NR_NO) or
(taicpu(hp).oper[0]^.ref^.symbol=nil) then
internalerror(2023102203);
if not is_goto_target(taicpu(hp).oper[0]^.ref^.symbol) then
internalerror(2023102204);
end;
hp:=tai(hp.next);
end;
end;
procedure validate_code;
var
vs: TWasmValidationStacks;
hp: tai;
begin
vs:=TWasmValidationStacks.Create(@GetLocalType,FFuncType);
hp:=tai(aktproccode.first);
while assigned(hp) do
begin
if hp.typ=ait_instruction then
vs.Validate(taicpu(hp));
hp:=tai(hp.next);
end;
vs.Free;
end;
procedure postprocess_code_assembler;
begin
aktproccode.InsertAfter(tai_local.create([]),findfirst_tai_functype(aktproccode));
end;
var
localslist: TAsmList;
labels_resolved, has_goto: Boolean;
begin
if po_assembler in procdef.procoptions then
begin
postprocess_code_assembler;
exit;
end;
check_goto_br_instructions(aktproccode,has_goto);
localslist:=prepare_locals;
replace_local_frame_pointer(aktproccode);
labels_resolved:=false;
if not has_goto then
{ TODO: make resolve_labels_simple handle goto labels correctly }
labels_resolved:=resolve_labels_simple(aktproccode);
{$ifndef DEBUG_WASM_GOTO}
if not labels_resolved then
{$endif DEBUG_WASM_GOTO}
resolve_labels_complex(aktproccode);
add_extra_allocated_locals(localslist);
insert_localslist(aktproccode,localslist);
localslist.Free;
{$ifdef DEBUG_WASM_VALIDATION}
validate_code;
{$endif DEBUG_WASM_VALIDATION}
inherited postprocess_code;
end;
procedure tcpuprocinfo.set_first_temp_offset;
var
sz : integer;
i : integer;
sym: tsym;
begin
{
Stackframe layout:
sp:
<incoming parameters>
sp+first_temp_offset:
<locals>
<temp>
}
procdef.init_paraloc_info(calleeside);
sz := procdef.calleeargareasize;
tg.setfirsttemp(sz);
end;
procedure tcpuprocinfo.add_goto_target(l: tasmlabel);
begin
FGotoTargets.Add(l.Name,l);
end;
function tcpuprocinfo.is_goto_target(l: tasmsymbol): Boolean;
begin
result:=FGotoTargets.FindIndexOf(l.Name)<>-1;
end;
initialization
cprocinfo:=tcpuprocinfo;
end.
Reference in New Issue View Git Blame Copy Permalink