mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 10:19:31 +01:00
1961de4ce0
and was made obsolete by the other exceptions modes, so it's unlikely it will ever be implemented.
1006 lines
40 KiB
ObjectPascal
1006 lines
40 KiB
ObjectPascal
{
|
|
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_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_legacy_exceptions in current_settings.targetswitches then
|
|
cexceptionstatehandler:=twasmexceptionstatehandler_nativeexceptions
|
|
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_legacy_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_legacy_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_legacy_try) and (lastinstr.opcode<>a_end_legacy_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_legacy_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_legacy_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_legacy_try:
|
|
inc(cur_nesting_depth);
|
|
|
|
a_end_block,
|
|
a_end_loop,
|
|
a_end_if,
|
|
a_end_legacy_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.
|