* fixed and enabled the is_pascal_goto_target check

This commit is contained in:
Nikolay Nikolov 2023-10-22 04:01:37 +03:00
parent 84e2613ca8
commit cf21365a21
5 changed files with 26 additions and 16 deletions

View File

@ -239,9 +239,6 @@ interface
is_set : boolean;
is_public : boolean;
defined_in_asmstatement : boolean;
{$ifdef wasm32}
is_pascal_goto_target: boolean;
{$endif wasm32}
constructor Createlocal(AList: TFPHashObjectList; nr: longint; ltyp: TAsmLabelType);
constructor Createstatic(AList: TFPHashObjectList; nr: longint; ltyp: TAsmLabelType);
constructor Createglobal(AList: TFPHashObjectList; const modulename: TSymStr; nr: longint; ltyp: TAsmLabelType);

View File

@ -659,9 +659,6 @@ interface
pc relative offsets are allowed }
inserted : boolean;
{$endif arm}
{$ifdef wasm32}
is_pascal_goto_target: boolean;
{$endif wasm32}
constructor Create(_labsym : tasmlabel);
constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
procedure ppuwrite(ppufile:tcompilerppufile);override;

View File

@ -143,13 +143,9 @@ implementation
procedure tcgwasm.a_label_pascal_goto_target(list : TAsmList;l : tasmlabel);
var
lbl: tai_label;
begin
lbl:=tai_label.create(l);
l.is_pascal_goto_target:=true;
lbl.is_pascal_goto_target:=true;
list.concat(lbl);
tcpuprocinfo(current_procinfo).add_goto_target(l);
inherited;
end;

View File

@ -38,6 +38,7 @@ interface
private
FFirstFreeLocal: Integer;
FAllocatedLocals: array of TWasmBasicType;
FGotoTargets: TFPHashObjectList;
function ConvertBranchTargetNumbersToLabels(ai: tai; blockstack: twasmstruc_stack): TAsmMapFuncResult;
function ConvertIfToBrIf(ai: tai; blockstack: twasmstruc_stack): TAsmMapFuncResult;
@ -51,11 +52,14 @@ interface
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 : tasmlabel): Boolean;
end;
implementation
@ -424,10 +428,17 @@ implementation
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 }
@ -947,6 +958,16 @@ implementation
tg.setfirsttemp(sz);
end;
procedure tcpuprocinfo.add_goto_target(l: tasmlabel);
begin
FGotoTargets.Add(l.Name,l);
end;
function tcpuprocinfo.is_goto_target(l: tasmlabel): Boolean;
begin
result:=FGotoTargets.FindIndexOf(l.Name)<>-1;
end;
initialization
cprocinfo:=tcpuprocinfo;

View File

@ -1925,15 +1925,14 @@ implementation
list.concat(taicpu.op_sym(a_br,l))
else if l=current_procinfo.CurrExitLabel then
list.concat(taicpu.op_sym(a_br,l))
else if l.is_pascal_goto_target then
else if tcpuprocinfo(current_procinfo).is_goto_target(l) then
list.concat(taicpu.op_sym(a_br,l))
else
begin
list.concat(taicpu.op_sym(a_br,l))
{$ifndef EXTDEBUG}
// Internalerror(2019091806); // unexpected jump
Internalerror(2019091806); // unexpected jump
{$endif EXTDEBUG}
// list.concat(tai_comment.create(strpnew('Unable to find destination of label '+l.name)));
list.concat(tai_comment.create(strpnew('Unable to find destination of label '+l.name)));
end;
end;