[PATCH 40/83] update local variables management

From 22d4e40f86fbf1d35e404192a73573278e596782 Mon Sep 17 00:00:00 2001
From: Dmitry Boyarintsev <[email protected]>
Date: Wed, 18 Sep 2019 14:51:17 -0400

git-svn-id: branches/wasm@45917 -

compiler/wasm/aasmcpu.pas

@@ -93,6 +93,15 @@ uses
         constructor create(const aextname, aintname: ansistring; asymtype: timpexptype);
       end;
 
+      // local variable declaration
+
+      { tai_local }
+
+      tai_local = class(tai)
+        bastyp: TWasmBasicType;
+        constructor create(abasictype: TWasmBasicType);
+      end;
+
     procedure InitAsm;
     procedure DoneAsm;
 
@@ -101,6 +110,15 @@ uses
 
 implementation
 
+    { tai_local }
+
+    constructor tai_local.create(abasictype: TWasmBasicType);
+      begin
+        bastyp := abasictype;
+        typ := ait_local;
+        inherited Create;
+      end;
+
     { timpexp_ai }
 
         constructor tai_impexp.create(const aextname, aintname: ansistring;

compiler/wasm/agwat.pas

@@ -311,6 +311,9 @@ implementation
         i,pos    : longint;
         InlineLevel : longint;
         do_line  : boolean;
+      const
+        WasmBasicTypeStr : array [TWasmBasicType] of string = ('i32','i64','f32','f64');
+
       begin
         if not assigned(p) then
          exit;
@@ -529,6 +532,14 @@ implementation
                  writer.AsmLn;
                end;
 
+             ait_local :
+               begin
+                 writer.AsmWrite(#9'(local ');
+                 writer.AsmWrite( WasmBasicTypeStr[ tai_local(hp).bastyp ] );
+                 writer.AsmWrite(')');
+                 writer.AsmLn;
+               end;
+
              else
                internalerror(2010122707);
            end;

compiler/wasm/cpubase.pas

@@ -85,6 +85,8 @@ uses
       a_grow_memory, a_current_memory
       );
 
+      TWasmBasicType = (wbt_i32, wbt_i64, wbt_f32, wbt_f64);
+
       {# This should define the array of instructions as string }
       op2strtable=array[tasmop] of string[8];
 

compiler/wasm/cpupi.pas

@@ -27,7 +27,7 @@ interface
 
   uses
     cutils,
-    procinfo,cpuinfo,
+    procinfo,cpuinfo, symtype,
     psub;
 
   type
@@ -36,27 +36,51 @@ interface
 
     tcpuprocinfo=class(tcgprocinfo)
     public
+      procedure postprocess_code; override;
+
       procedure set_first_temp_offset;override;
     end;
 
 implementation
 
     uses
-      systems,globals,
+      systems,globals, tgcpu, aasmdata, aasmcpu,
       tgobj,paramgr,symconst;
 
+    procedure tcpuprocinfo.postprocess_code;
+      var
+       templist : TAsmList;
+       l : TWasmLocal;
+      begin
+        templist := TAsmList.create;
+        l := ttgwasm(tg).localvars.first;
+        while Assigned(l) do begin
+          templist.Concat( tai_local.create(l.typ));
+          l := l.nextseq;
+        end;
+        aktproccode.insertListBefore(nil, templist);
+        templist.Free;
+
+        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:
+            sp+first_temp_offset:
             <locals>
             <temp>
         }
         procdef.init_paraloc_info(calleeside);
-        tg.setfirsttemp(procdef.calleeargareasize);
+        sz := procdef.calleeargareasize;
+        tg.setfirsttemp(sz);
       end;
 
 

compiler/wasm/rgcpu.pas

@@ -26,10 +26,11 @@ unit rgcpu;
   interface
 
     uses
+      cclasses,
       aasmbase,aasmcpu,aasmtai,aasmdata,
-      cgbase,cgutils,
+      cgbase,cgutils, procinfo,
       cpubase,
-      rgobj;
+      rgobj, tgcpu;
 
     type
       tspilltemps = array[tregistertype] of ^Tspill_temp_list;
@@ -319,6 +320,27 @@ implementation
         until not removedsomething;
       end;
 
+    function registertobastype(const reg: TRegister): TWasmBasicType;
+      begin
+        case getregtype(reg) of
+          R_INTREGISTER:
+           if getsubreg(reg)=R_SUBD then
+             registertobastype:=wbt_i32
+           else
+             registertobastype:=wbt_i64;
+
+          R_ADDRESSREGISTER:
+            registertobastype:=wbt_i32;
+
+          R_FPUREGISTER:
+           if getsubreg(reg)=R_SUBFS then
+             registertobastype:=wbt_f32
+           else
+             registertobastype:=wbt_f64
+          else
+           internalerror(2010122912);
+        end;
+      end;
 
     class procedure trgcpu.do_all_register_allocation(list: TAsmList; headertai: tai);
       var
@@ -328,6 +350,18 @@ implementation
         fprg     : trgcpu;
         p,q      : tai;
         size     : longint;
+
+        insbefore : TLinkedListItem;
+        lastins   : TLinkedListItem;
+        //locavail  : array[TWasmBasicType] of tlocalalloc; // used or not
+
+        wbt     : TWasmBasicType;
+        ra      : tai_regalloc;
+        idx     : integer;
+        fidx    : integer;
+        pidx    : integer;
+        t: treftemppos;
+
       begin
         { Since there are no actual registers, we simply spill everything. We
           use tt_regallocator temps, which are not used by the temp allocator
@@ -352,36 +386,56 @@ implementation
         templist:=TAsmList.create;
         { allocate/replace all registers }
         p:=headertai;
+        insbefore := nil;
         while assigned(p) do
           begin
             case p.typ of
               ait_regalloc:
-                with Tai_regalloc(p) do
                   begin
-                    case getregtype(reg) of
+                    ra := tai_regalloc(p);
+                    wbt := registertobastype(ra.reg);
+                    case getregtype(ra.reg) of
                       R_INTREGISTER:
-                        if getsubreg(reg)=R_SUBD then
+                        if getsubreg(ra.reg)=R_SUBD then
                           size:=4
                         else
                           size:=8;
                       R_ADDRESSREGISTER:
                         size:=4;
                       R_FPUREGISTER:
-                        if getsubreg(reg)=R_SUBFS then
+                        if getsubreg(ra.reg)=R_SUBFS then
                           size:=4
                         else
                           size:=8;
                       else
                         internalerror(2010122912);
                     end;
-                    case ratype of
+                    case ra.ratype of
                       ra_alloc :
-                        tg.gettemp(templist,
-                                   size,1,
-                                   tt_regallocator,spill_temps[getregtype(reg)]^[getsupreg(reg)]);
+                        begin
+                          ttgwasm(tg).allocLocalVarToRef(wbt, spill_temps[getregtype(ra.reg)]^[getsupreg(ra.reg)]);
+                          (*wasmloc.
+                          pidx := fidx;
+                          idx := wasmloc.alloc(wbt);
+                          if idx<0 then
+                            internalerror(201909173); // ran out of local variables! ...  must be dynamic
+
+                          //spill_temps[getregtype(ra.reg)]^[getsupreg(ra.reg)].temppos := idx;
+                          //spill_temps[getregtype(ra.reg)]^[getsupreg(ra.reg)].isfloat := true;
+                          //tg.gettemp(templist,
+                                     //size,1,
+                                     //tt_regallocator,spill_temps[getregtype(ra.reg)]^[getsupreg(ra.reg)]);
+                          t.val:=idx;
+                          reference_reset_base(spill_temps[getregtype(ra.reg)]^[getsupreg(ra.reg)],current_procinfo.framepointer,idx,t,size,[]);
+                          wasm
+
+                          if fidx<>pidx then // new local variable allocated
+                            templist.Concat( tai_local.create(wbt));*)
+                        end;
                       ra_dealloc :
                         begin
-                          tg.ungettemp(templist,spill_temps[getregtype(reg)]^[getsupreg(reg)]);
+                          ttgwasm(tg).deallocLocalVar(wbt, spill_temps[getregtype(ra.reg)]^[getsupreg(ra.reg)].offset);
+                          //tg.ungettemp(templist,spill_temps[getregtype(ra.reg)]^[getsupreg(ra.reg)]);
                           { don't invalidate the temp reference, may still be used one instruction
                             later }
                         end;
@@ -389,7 +443,6 @@ implementation
                         ;
                     end;
                     { insert the tempallocation/free at the right place }
-                    list.insertlistbefore(p,templist);
                     { remove the register allocation info for the register
                       (p.previous is valid because we just inserted the temp
                        allocation/free before p) }
@@ -405,6 +458,8 @@ implementation
             end;
             p:=Tai(p.next);
           end;
+        if templist.count>0 then
+          list.insertListBefore(nil, templist);
         freemem(spill_temps[R_INTREGISTER]);
         freemem(spill_temps[R_FPUREGISTER]);
         templist.free;

compiler/wasm/tgcpu.pas

@@ -28,11 +28,38 @@ unit tgcpu;
     uses
        globtype,
        aasmdata,
-       cgutils,
+       cgutils, cpubase,
        symtype,tgobj;
 
     type
 
+      { TWasmLocal }
+
+      TWasmLocal = class
+        inuse    : Boolean;
+        index    : integer;
+        typ      : TWasmBasicType;
+        next     : TWasmLocal; // next in the same basic type
+        nextseq  : TWasmLocal; // from 0 to max
+        constructor create(atype: TWasmBasicType; aindex: integer);
+      end;
+
+      { TWasmLocalVars }
+
+      TWasmLocalVars = class
+      private
+        last: TWasmLocal; // need public?
+      public
+        locv: array[TWasmBasicType] of TWasmLocal;
+        ordered: array of integer;
+        first: TWasmLocal; // first in sequence
+        varindex: integer;
+        constructor Create(astartindex: Integer = 0);
+        destructor Destroy; override;
+        function alloc(bt: TWasmBasicType): integer;
+        procedure dealloc(bt: TWasmBasicType; index: integer);
+      end;
+
        { ttgwasm }
 
        ttgwasm = class(ttgobj)
@@ -40,22 +67,81 @@ unit tgcpu;
         // procedure getimplicitobjtemp(list: TAsmList; def: tdef; temptype: ttemptype; out ref: treference);
         // function getifspecialtemp(list: TAsmList; def: tdef; forcesize: asizeint; temptype: ttemptype; out ref: treference): boolean;
          procedure alloctemp(list: TAsmList; size: asizeint; alignment: shortint; temptype: ttemptype; def: tdef; fini: boolean; out ref: treference); override;
+
+         procedure updateFirstTemp;
         public
+         localvars: TWasmLocalVars;
          constructor create; override;
+         destructor destroy; override;
          procedure setfirsttemp(l : asizeint); override;
-         //procedure getlocal(list: TAsmList; size: asizeint; alignment: shortint; def: tdef; var ref: treference); override;
-         //procedure gethltemp(list: TAsmList; def: tdef; forcesize: asizeint; temptype: ttemptype; out ref: treference); override;
-         //procedure gethltempmanaged(list: TAsmList; def: tdef; temptype: ttemptype; out ref: treference); override;
+         procedure getlocal(list: TAsmList; size: asizeint; alignment: shortint; def: tdef; var ref: treference); override;
+         procedure gethltemp(list: TAsmList; def: tdef; forcesize: asizeint; temptype: ttemptype; out ref: treference); override;
+         procedure gethltempmanaged(list: TAsmList; def: tdef; temptype: ttemptype; out ref: treference); override;
+
+         procedure allocLocalVarToRef(wbt: TWasmBasicType; out ref: treference);
+         procedure deallocLocalVar(wbt: TWasmBasicType; idx: integer);
+         procedure LocalVarToRef(idx: integer; size: Integer; out ref: treference);
        end;
 
+    function defToWasmBasic(def: tdef; var wbt: TWasmBasicType): Boolean;
+
   implementation
 
     uses
        verbose,
        cgbase,
        symconst,symtable,symdef,symsym,symcpu,defutil,
-       cpubase,aasmbase,aasmcpu,
-       hlcgobj,hlcgcpu;
+       aasmbase,aasmcpu,
+       hlcgobj,hlcgcpu, procinfo;
+
+    function defToWasmBasic(def: tdef; var wbt: TWasmBasicType): Boolean;
+    begin
+      Result := assigned(def);
+      if not Result then Exit;
+
+      if is_pointer(def) then
+        wbt := wbt_i32 // wasm32
+      else if is_ordinal(def) then begin
+        if is_64bit(def) then wbt := wbt_i64
+        else wbt := wbt_i32;
+      end else if is_real(def) then begin
+        if is_single(def) then wbt := wbt_f32
+        else wbt := wbt_f64; // real/double/extended
+      end else
+        Result := false;
+    end;
+
+        { TWasmLocal }
+
+                constructor TWasmLocal.create(atype: TWasmBasicType;
+                  aindex: integer);
+        begin
+          typ:=atype;
+          index:=aindex;
+        end;
+
+    { TWasmLocalVars }
+
+        constructor TWasmLocalVars.Create(astartindex: Integer = 0);
+          begin
+            inherited Create;
+            varindex := astartindex;
+          end;
+
+        destructor TWasmLocalVars.Destroy;
+          var
+            t : TWasmLocal;
+            n : TWasmLocal;
+          begin
+            t := first;
+            while Assigned(t) do
+              begin
+                n:=t;
+                t:=t.nextseq;
+                n.Free;
+              end;
+            inherited Destroy;
+          end;
 
 
     { ttgwasm }
@@ -227,50 +313,131 @@ unit tgcpu;
 
     procedure ttgwasm.alloctemp(list: TAsmList; size: asizeint; alignment: shortint; temptype: ttemptype; def: tdef; fini: boolean; out ref: treference);
       begin
+        Internalerror(2019091802);
         { the WebAssembly only supports 1 slot (= 4 bytes in FPC) and 2 slot (= 8 bytes in
           FPC) temps on the stack. double and int64 are 2 slots, the rest is one slot.
           There are no problems with reusing the same slot for a value of a different
           type. There are no alignment requirements either. }
-        if size<4 then
+        {if size<4 then
           size:=4;
         if not(size in [4,8]) then
           internalerror(2010121401);
-        { don't pass on "def", since we don't care if a slot is used again for a
-          different type }
-        inherited alloctemp(list, size shr 2, 1, temptype, nil, false, ref);
+        inherited alloctemp(list, size shr 2, 1, temptype, def, false, ref);}
       end;
 
+    procedure ttgwasm.updateFirstTemp;
+    begin
+      firsttemp := localvars.varindex;
+      if lasttemp<firsttemp then lasttemp := firsttemp;
+    end;
+
     constructor ttgwasm.create;
       begin
         inherited create;
         direction := 1; // temp variables are allocated as "locals", and it starts with 0 and goes beyond!
+        localvars:=TWasmLocalVars.Create;
       end;
 
+    destructor ttgwasm.destroy;
+      begin
+        localvars.Free;
+        inherited destroy;
+      end;
 
     procedure ttgwasm.setfirsttemp(l: asizeint);
       begin
         firsttemp:=l;
         lasttemp:=l;
+        localvars.varindex := l; //?
       end;
 
 
-    //procedure ttgwasm.getlocal(list: TAsmList; size: asizeint; alignment: shortint; def: tdef; var ref: treference);
-    //  begin
-    //    if not getifspecialtemp(list,def,size,tt_persistent,ref) then
-    //      inherited;
-    //  end;
+    procedure ttgwasm.getlocal(list: TAsmList; size: asizeint; alignment: shortint; def: tdef; var ref: treference);
+      var
+        wbt : TWasmBasicType;
+        idx : integer;
+      begin
+        if defToWasmBasic(def, wbt) then
+          alloclocalVarToRef(wbt, ref)
+        else begin
+          Internalerror(2019091801); // no support of structural type
+          inherited;
+        end;
+      end;
 
 
-    //procedure ttgjvm.gethltemp(list: TAsmList; def: tdef; forcesize: asizeint; temptype: ttemptype; out ref: treference);
-    //  begin
-    //    if not getifspecialtemp(list,def,forcesize,temptype,ref) then
-    //      inherited;
-    //  end;
-    //
-    //procedure ttgjvm.gethltempmanaged(list: TAsmList; def: tdef; temptype: ttemptype; out ref: treference);
-    //  begin
-    //    gethltemp(list,def,def.size,temptype,ref);
-    //  end;
+    procedure ttgwasm.gethltemp(list: TAsmList; def: tdef; forcesize: asizeint; temptype: ttemptype; out ref: treference);
+      begin
+        inherited;
+      end;
+
+    procedure ttgwasm.gethltempmanaged(list: TAsmList; def: tdef; temptype: ttemptype; out ref: treference);
+      begin
+        inherited;
+      end;
+
+    procedure ttgwasm.allocLocalVarToRef(wbt: TWasmBasicType; out ref: treference);
+      var
+        idx : integer;
+      begin
+        idx := localvars.alloc(wbt);
+        localVarToRef(idx, 1, ref);
+      end;
+
+    procedure ttgwasm.deallocLocalVar(wbt: TWasmBasicType; idx: integer);
+      begin
+        localvars.dealloc(wbt, idx);
+      end;
+
+    procedure ttgwasm.localVarToRef(idx: integer; size: integer; out ref: treference);
+      var
+        t: treftemppos;
+      begin
+        t.val:=idx;
+        reference_reset_base(ref, current_procinfo.framepointer,idx,t,size,[]);
+        updateFirstTemp;
+      end;
+
+    function TWasmLocalVars.alloc(bt: TWasmBasicType): integer;
+      var
+        i : integer;
+        lc : TWasmLocal;
+        t  : TWasmLocal;
+      begin
+        lc := locv[bt];
+        t := nil;
+        while Assigned(lc) and (lc.inuse) do begin
+          t := lc;
+          lc := lc.next;
+        end;
+        if Assigned(lc) then begin
+          lc.inuse := true;
+        end else begin
+          lc := TWasmLocal.Create(bt, varindex);
+          if Assigned(t)
+            then t.next := lc
+            else locv[bt]:=lc;
+          lc.inuse:=true;
+          inc(varindex);
+
+          if Assigned(last) then last.nextseq := lc;
+          if not Assigned(first) then first := lc;
+          last := lc;
+        end;
+        alloc := lc.index;
+
+      end;
+
+    procedure TWasmLocalVars.dealloc(bt: TWasmBasicType; index: integer);
+      var
+        lc : TWasmLocal;
+      begin
+        lc := locv[bt];
+        while Assigned(lc) and (lc.index <> index) do
+          lc := lc.next;
+        if Assigned(lc) then lc.inuse := false;
+      end;
+
 
 
 initialization