Browse Source

* fixed and enabled the is_pascal_goto_target check

Nikolay Nikolov 1 year ago
parent
commit
cf21365a21

+ 0 - 3
compiler/aasmbase.pas

@@ -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);

+ 0 - 3
compiler/aasmtai.pas

@@ -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;

+ 2 - 6
compiler/wasm32/cgcpu.pas

@@ -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);
-        l.is_pascal_goto_target:=true;
-        lbl.is_pascal_goto_target:=true;
-        list.concat(lbl);
+        tcpuprocinfo(current_procinfo).add_goto_target(l);
+        inherited;
       end;
       end;
 
 
 
 

+ 21 - 0
compiler/wasm32/cpupi.pas

@@ -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;

+ 3 - 4
compiler/wasm32/hlcgcpu.pas

@@ -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;