mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 06:49:27 +02:00
* fixed and enabled the is_pascal_goto_target check
This commit is contained in:
parent
84e2613ca8
commit
cf21365a21
@ -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);
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
||||
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user