paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 22:09:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed and enabled the is_pascal_goto_target check

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
compiler/aasmbase.pas
View File

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

3
compiler/aasmtai.pas
View File

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

8
compiler/wasm32/cgcpu.pas
View File

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

21
compiler/wasm32/cpupi.pas
View File

@ -38,6 +38,7 @@ interface
private private
FFirstFreeLocal: Integer; FFirstFreeLocal: Integer;
FAllocatedLocals: array of TWasmBasicType; FAllocatedLocals: array of TWasmBasicType;
FGotoTargets: TFPHashObjectList;
function ConvertBranchTargetNumbersToLabels(ai: tai; blockstack: twasmstruc_stack): TAsmMapFuncResult; function ConvertBranchTargetNumbersToLabels(ai: tai; blockstack: twasmstruc_stack): TAsmMapFuncResult;
function ConvertIfToBrIf(ai: tai; blockstack: twasmstruc_stack): TAsmMapFuncResult; function ConvertIfToBrIf(ai: tai; blockstack: twasmstruc_stack): TAsmMapFuncResult;
@ -51,11 +52,14 @@ interface
CurrRaiseLabel : tasmlabel; CurrRaiseLabel : tasmlabel;
constructor create(aparent: tprocinfo); override; constructor create(aparent: tprocinfo); override;
destructor destroy; override;
function calc_stackframe_size : longint;override; function calc_stackframe_size : longint;override;
procedure setup_eh; override; procedure setup_eh; override;
procedure generate_exit_label(list: tasmlist); override; procedure generate_exit_label(list: tasmlist); override;
procedure postprocess_code; override; procedure postprocess_code; override;
procedure set_first_temp_offset;override; procedure set_first_temp_offset;override;
procedure add_goto_target(l : tasmlabel);
function is_goto_target(l : tasmlabel): Boolean;
end; end;
implementation implementation
@ -424,10 +428,17 @@ implementation
constructor tcpuprocinfo.create(aparent: tprocinfo); constructor tcpuprocinfo.create(aparent: tprocinfo);
begin begin
inherited create(aparent); inherited create(aparent);
FGotoTargets:=TFPHashObjectList.Create(false);
if ts_wasm_bf_exceptions in current_settings.targetswitches then if ts_wasm_bf_exceptions in current_settings.targetswitches then
current_asmdata.getjumplabel(CurrRaiseLabel); current_asmdata.getjumplabel(CurrRaiseLabel);
end; end;
destructor tcpuprocinfo.destroy;
begin
FGotoTargets.Free;
inherited destroy;
end;
function tcpuprocinfo.calc_stackframe_size: longint; function tcpuprocinfo.calc_stackframe_size: longint;
begin begin
{ the stack frame in WebAssembly should always have a 16-byte alignment } { the stack frame in WebAssembly should always have a 16-byte alignment }
@ -947,6 +958,16 @@ implementation
tg.setfirsttemp(sz); tg.setfirsttemp(sz);
end; 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 initialization
cprocinfo:=tcpuprocinfo; cprocinfo:=tcpuprocinfo;

7
compiler/wasm32/hlcgcpu.pas
View File

@ -1925,15 +1925,14 @@ implementation
list.concat(taicpu.op_sym(a_br,l)) list.concat(taicpu.op_sym(a_br,l))
else if l=current_procinfo.CurrExitLabel then else if l=current_procinfo.CurrExitLabel then
list.concat(taicpu.op_sym(a_br,l)) 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)) list.concat(taicpu.op_sym(a_br,l))
else else
begin begin
list.concat(taicpu.op_sym(a_br,l))
{$ifndef EXTDEBUG} {$ifndef EXTDEBUG}
// Internalerror(2019091806); // unexpected jump Internalerror(2019091806); // unexpected jump
{$endif EXTDEBUG} {$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;
end; end;