+ llvm support for the register allocator. While llvm works with virtual

    registers itself, it requires them to be in SSA form. Therefore we
    spill all registers that are written more than once to memory.
  + support in the generic register allocator for generating code that is
    SSA-safe
  + spilling helpers for llvm

git-svn-id: branches/hlcgllvm@26044 -

.gitattributes

@@ -322,6 +322,7 @@ compiler/llvm/llvmdef.pas svneol=native#text/plain
 compiler/llvm/llvminfo.pas svneol=native#text/plain
 compiler/llvm/llvmpara.pas svneol=native#text/plain
 compiler/llvm/llvmsym.pas svneol=native#text/plain
+compiler/llvm/rgllvm.pas svneol=native#text/plain
 compiler/llvm/tgllvm.pas svneol=native#text/plain
 compiler/m68k/aasmcpu.pas svneol=native#text/plain
 compiler/m68k/ag68kgas.pas svneol=native#text/plain

compiler/llvm/aasmllvm.pas

@@ -100,6 +100,10 @@ interface
 {$endif cpuextended}
         procedure loadcond(opidx: longint; _cond: topcmp);
         procedure loadfpcond(opidx: longint; _fpcond: tllvmfpcmp);
+
+        { register spilling code }
+        function spilling_get_operation_type(opnr: longint): topertype;override;
+        function spilling_get_reg_type(opnr: longint): tdef;
       end;
 
 
@@ -252,6 +256,160 @@ uses
       end;
 
 
+    function taillvm.spilling_get_operation_type(opnr: longint): topertype;
+      begin
+        case llvmopcode of
+          la_ret, la_br, la_switch, la_indirectbr,
+          la_invoke, la_resume,
+          la_unreachable,
+          la_store,
+          la_fence,
+          la_cmpxchg,
+          la_atomicrmw:
+            begin
+              { instructions that never have a result }
+              result:=operand_read;
+            end;
+          la_alloca,
+          la_trunc, la_zext, la_sext, la_fptrunc, la_fpext,
+          la_fptoui, la_fptosi, la_uitofp, la_sitofp,
+          la_ptrtoint, la_inttoptr,
+          la_bitcast,
+          la_add, la_fadd, la_sub, la_fsub, la_mul, la_fmul,
+          la_udiv,la_sdiv, la_fdiv, la_urem, la_srem, la_frem,
+          la_shl, la_lshr, la_ashr, la_and, la_or, la_xor,
+          la_extractelement, la_insertelement, la_shufflevector,
+          la_extractvalue, la_insertvalue,
+          la_getelementptr,
+          la_load,
+          la_icmp, la_fcmp,
+          la_phi, la_select, la_call,
+          la_va_arg, la_landingpad:
+            begin
+              if opnr=0 then
+                result:=operand_write
+              else
+                result:=operand_read;
+            end;
+          else
+            internalerror(2013103101)
+        end;
+      end;
+
+
+    function taillvm.spilling_get_reg_type(opnr: longint): tdef;
+      begin
+        case llvmopcode of
+          la_trunc, la_zext, la_sext, la_fptrunc, la_fpext,
+          la_fptoui, la_fptosi, la_uitofp, la_sitofp,
+          la_ptrtoint, la_inttoptr,
+          la_bitcast:
+            begin
+              { toreg = bitcast fromsize fromreg to tosize }
+              case opnr of
+                0: result:=oper[3]^.def;
+                2: result:=oper[1]^.def
+                else
+                  internalerror(2013103102);
+              end;
+            end;
+          la_ret, la_switch, la_indirectbr,
+          la_resume:
+            begin
+              { ret size reg }
+              if opnr=1 then
+                result:=oper[0]^.def
+              else
+                internalerror(2013110101);
+            end;
+          la_invoke, la_call:
+            begin
+              internalerror(2013110102);
+            end;
+          la_br,
+          la_unreachable:
+            internalerror(2013110103);
+          la_store:
+            begin
+              case opnr of
+                1: result:=oper[0]^.def;
+                { type of the register in the reference }
+                3: result:=oper[2]^.def;
+                else
+                  internalerror(2013110104);
+              end;
+            end;
+          la_load,
+          la_getelementptr:
+            begin
+              { dst = load ptrdef srcref }
+              case opnr of
+                0: result:=tpointerdef(oper[1]^.def).pointeddef;
+                2: result:=oper[1]^.def;
+                else
+                  internalerror(2013110105);
+              end;
+            end;
+          la_fence,
+          la_cmpxchg,
+          la_atomicrmw:
+            begin
+              internalerror(2013110610);
+            end;
+          la_add, la_fadd, la_sub, la_fsub, la_mul, la_fmul,
+          la_udiv,la_sdiv, la_fdiv, la_urem, la_srem, la_frem,
+          la_shl, la_lshr, la_ashr, la_and, la_or, la_xor:
+            begin
+              case opnr of
+                0,2,3:
+                  result:=oper[1]^.def;
+                else
+                  internalerror(2013110106);
+              end;
+            end;
+          la_extractelement, la_insertelement, la_shufflevector,
+          la_extractvalue:
+            begin
+              { todo }
+              internalerror(2013110107);
+            end;
+          la_insertvalue:
+            begin
+              case opnr of
+                0,2: result:=oper[1]^.def;
+                else
+                  internalerror(2013110108);
+              end;
+            end;
+          la_icmp, la_fcmp:
+            begin
+              case opnr of
+                0: result:=pasbool8type;
+                3,4: result:=oper[2]^.def;
+                else
+                  internalerror(2013110801);
+              end
+            end;
+          la_alloca:
+            begin
+              { shouldn't be spilled, the result of alloca should be read-only }
+              internalerror(2013110109);
+            end;
+          la_select:
+            begin
+              case opnr of
+                0,4,6: result:=oper[3]^.def;
+                2: result:=oper[1]^.def;
+                else
+                  internalerror(2013110110);
+              end;
+            end;
+          else
+            internalerror(2013103101)
+        end;
+      end;
+
+
     constructor taillvm.op_size(op : tllvmop; size: tdef);
       begin
         create_llvm(op);

compiler/llvm/rgllvm.pas

@@ -0,0 +1,189 @@
+{
+    Copyright (c) 2013 by Jonas Maebe, member of the Free Pascal development
+    team
+
+    This unit implements the LLVM-specific class for the register
+    allocator
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************}
+unit rgllvm;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+      aasmcpu,aasmtai,aasmdata,
+      symtype,
+      cgbase,cgutils,
+      cpubase,llvmbase,
+      rgobj;
+
+    type
+      { trgllvm }
+      trgllvm=class(trgobj)
+        constructor create(Aregtype: Tregistertype; Adefaultsub: Tsubregister; const Ausable: array of tsuperregister; Afirst_imaginary: Tsuperregister; Apreserved_by_proc: Tcpuregisterset); reintroduce;
+        procedure do_register_allocation(list: TAsmList; headertai: tai); override;
+        procedure do_spill_read(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister); override;
+        procedure do_spill_written(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister); override;
+       protected
+        procedure determine_spill_registers(list: TasmList; headertai: tai); override;
+        procedure get_spill_temp(list:TAsmlist;spill_temps: Pspill_temp_list; supreg: tsuperregister);override;
+       strict protected
+       type
+         tregwrites = (rw_none, rw_one, rw_multiple);
+         pwrittenregs = ^twrittenregs;
+         twrittenregs = bitpacked array[tsuperregister] of tregwrites;
+       var
+        spillcounter: longint;
+        writtenregs: pwrittenregs;
+      end;
+
+
+implementation
+
+    uses
+      verbose,cutils,
+      globtype,globals,
+      symdef,
+      aasmllvm,
+      tgobj;
+
+    { trgllvm }
+
+     constructor trgllvm.create(Aregtype: Tregistertype; Adefaultsub: Tsubregister; const Ausable: array of tsuperregister; Afirst_imaginary: Tsuperregister; Apreserved_by_proc: Tcpuregisterset);
+       begin
+         inherited;
+         { tell the generic register allocator to generate SSA spilling code }
+         ssa_safe:=true;
+       end;
+
+     procedure trgllvm.do_register_allocation(list: TAsmList; headertai: tai);
+      begin
+        { these are SSA by design, they're only assigned by alloca
+          instructions }
+        if regtype=R_TEMPREGISTER then
+          exit;
+        inherited;
+      end;
+
+
+    procedure trgllvm.do_spill_read(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister);
+      var
+        ins: taillvm;
+        def: tdef;
+      begin
+        def:=tdef(reginfo[orgsupreg].def);
+        if not assigned(def) then
+          internalerror(2013110803);
+        ins:=taillvm.op_reg_size_ref(la_load,tempreg,getpointerdef(def),spilltemp);
+        list.insertafter(ins,pos);
+        {$ifdef DEBUG_SPILLING}
+        list.Insertbefore(tai_comment.Create(strpnew('Spilling: Spill Read')),ins);
+        {$endif}
+      end;
+
+
+    procedure trgllvm.do_spill_written(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister);
+      var
+        ins: taillvm;
+        def: tdef;
+      begin
+        def:=tdef(reginfo[orgsupreg].def);
+        if not assigned(def) then
+          internalerror(2013110802);
+        ins:=taillvm.op_size_reg_size_ref(la_store,def,tempreg,getpointerdef(def),spilltemp);
+        list.insertafter(ins,pos);
+        {$ifdef DEBUG_SPILLING}
+        list.Insertbefore(tai_comment.Create(strpnew('Spilling: Spill Write')),ins);
+        {$endif}
+      end;
+
+
+     procedure trgllvm.determine_spill_registers(list: TasmList; headertai: tai);
+       var
+         hp: tai;
+         reg: tregister;
+         sr: tsuperregister;
+         i: longint;
+       begin
+         spillednodes.clear;
+         { there should be only one round of spilling per register type, we
+           shouldn't generate multiple writes so a single register here }
+         if spillcounter<>0 then
+           exit;
+         { registers must be in SSA form -> determine all registers that are
+           written to more than once }
+         hp:=headertai;
+         { 2 bits per superregister, rounded up to a byte }
+         writtenregs:=allocmem((maxreg*2+7) shr 3);
+         while assigned(hp) do
+           begin
+             case hp.typ of
+               ait_llvmins:
+                 begin
+                   for i:=0 to taillvm(hp).ops-1 do
+                     if (taillvm(hp).oper[i]^.typ=top_reg) and
+                        (getregtype(taillvm(hp).oper[i]^.reg)=regtype)  and
+                        (taillvm(hp).spilling_get_operation_type(i)=operand_write) then
+                       begin
+                         reg:=taillvm(hp).oper[i]^.reg;
+                         sr:=getsupreg(reg);
+                         if writtenregs^[sr]<rw_multiple then
+                           writtenregs^[sr]:=succ(writtenregs^[sr]);
+                       end;
+                 end;
+             end;
+             hp:=tai(hp.next);
+           end;
+         { add all registers with multiple writes to the spilled nodes }
+         for sr:=0 to maxreg-1 do
+           if writtenregs^[sr]=rw_multiple then
+             spillednodes.add(sr);
+         freemem(writtenregs);
+       end;
+
+
+    procedure trgllvm.get_spill_temp(list: TAsmlist; spill_temps: Pspill_temp_list; supreg: tsuperregister);
+      var
+        supstart: tai;
+        i: longint;
+        def: tdef;
+      begin
+        supstart:=live_start[supreg];
+        if supstart.typ<>ait_llvmins then
+          internalerror(2013110701);
+        { determine type of register so we can allocate a temp of the right
+          type }
+        def:=nil;
+        for i:=0 to taillvm(supstart).ops-1 do
+          begin
+            if (taillvm(supstart).oper[i]^.typ=top_reg) and
+               (getsupreg(taillvm(supstart).oper[i]^.reg)=supreg) then
+              begin
+                def:=taillvm(supstart).spilling_get_reg_type(i);
+                break
+              end;
+          end;
+        if not assigned(def) then
+          internalerror(2013110702);
+        tg.gethltemp(list,def,def.size,tt_noreuse,spill_temps^[supreg]);
+        { record for use in spill instructions }
+        reginfo[supreg].def:=def;
+      end;
+
+end.

compiler/rgobj.pas

@@ -101,6 +101,9 @@ unit rgobj;
         degree   : TSuperregister;
         flags    : Treginfoflagset;
         weight   : longint;
+{$ifdef llvm}
+        def      : pointer;
+{$endif llvm}
       end;
       Preginfo=^TReginfo;
 
@@ -111,10 +114,14 @@ unit rgobj;
           register that will have to replace it }
         spillregconstraints : set of TSubRegister;
         orgreg : tsuperregister;
-        tempreg : tregister;
-        regread,regwritten, mustbespilled: boolean;
+        loadreg,
+        storereg: tregister;
+        regread, regwritten, mustbespilled: boolean;
+      end;
+      tspillregsinfo = record
+        reginfocount: longint;
+        reginfo: array[0..3] of tspillreginfo;
       end;
-      tspillregsinfo = array[0..3] of tspillreginfo;
 
       Pspill_temp_list=^Tspill_temp_list;
       Tspill_temp_list=array[tsuperregister] of Treference;
@@ -132,6 +139,8 @@ unit rgobj;
        trgobj=class
         preserved_by_proc : tcpuregisterset;
         used_in_proc : tcpuregisterset;
+        { generate SSA code? }
+        ssa_safe: boolean;
 
         constructor create(Aregtype:Tregistertype;
                            Adefaultsub:Tsubregister;
@@ -397,8 +406,9 @@ unit rgobj;
          regtype:=Aregtype;
          defaultsub:=Adefaultsub;
          preserved_by_proc:=Apreserved_by_proc;
-         // default value set by newinstance
+         // default values set by newinstance
          // used_in_proc:=[];
+         // ssa_safe:=false;
          live_registers.init;
          { Get reginfo for CPU registers }
          maxreginfo:=first_imaginary;
@@ -1975,6 +1985,9 @@ unit rgobj;
                           end;
                       end;
                   end;
+{$ifdef llvm}
+              ait_llvmins,
+{$endif llvm}
               ait_instruction:
                 with tai_cpu_abstract_sym(p) do
                   begin
@@ -2038,61 +2051,64 @@ unit rgobj;
                                          const r:Tsuperregisterset;
                                          const spilltemplist:Tspill_temp_list): boolean;
       var
-        counter, regindex: longint;
+        counter: longint;
         regs: tspillregsinfo;
         spilled: boolean;
 
       procedure addreginfo(reg: tregister; operation: topertype);
         var
           i, tmpindex: longint;
-          supreg : tsuperregister;
+          supreg: tsuperregister;
         begin
-          tmpindex := regindex;
-          supreg:=get_alias(getsupreg(reg));
+          tmpindex := regs.reginfocount;
+          supreg := get_alias(getsupreg(reg));
           { did we already encounter this register? }
-          for i := 0 to pred(regindex) do
-            if (regs[i].orgreg = supreg) then
+          for i := 0 to pred(regs.reginfocount) do
+            if (regs.reginfo[i].orgreg = supreg) then
               begin
                 tmpindex := i;
                 break;
               end;
-          if tmpindex > high(regs) then
+          if tmpindex > high(regs.reginfo) then
             internalerror(2003120301);
-          regs[tmpindex].orgreg := supreg;
-          include(regs[tmpindex].spillregconstraints,get_spill_subreg(reg));
+          regs.reginfo[tmpindex].orgreg := supreg;
+          include(regs.reginfo[tmpindex].spillregconstraints,get_spill_subreg(reg));
           if supregset_in(r,supreg) then
             begin
               { add/update info on this register }
-              regs[tmpindex].mustbespilled := true;
+              regs.reginfo[tmpindex].mustbespilled := true;
               case operation of
                 operand_read:
-                  regs[tmpindex].regread := true;
+                  regs.reginfo[tmpindex].regread := true;
                 operand_write:
-                  regs[tmpindex].regwritten := true;
+                  regs.reginfo[tmpindex].regwritten := true;
                 operand_readwrite:
                   begin
-                    regs[tmpindex].regread := true;
-                    regs[tmpindex].regwritten := true;
+                    regs.reginfo[tmpindex].regread := true;
+                    regs.reginfo[tmpindex].regwritten := true;
                   end;
               end;
               spilled := true;
             end;
-          inc(regindex,ord(regindex=tmpindex));
+          inc(regs.reginfocount,ord(regs.reginfocount=tmpindex));
         end;
 
 
-      procedure tryreplacereg(var reg: tregister);
+      procedure tryreplacereg(var reg: tregister; useloadreg: boolean);
         var
           i: longint;
           supreg: tsuperregister;
         begin
           supreg:=get_alias(getsupreg(reg));
-          for i:=0 to pred(regindex) do
-            if (regs[i].mustbespilled) and
-               (regs[i].orgreg=supreg) then
+          for i:=0 to pred(regs.reginfocount) do
+            if (regs.reginfo[i].mustbespilled) and
+               (regs.reginfo[i].orgreg=supreg) then
               begin
                 { Only replace supreg }
-                setsupreg(reg,getsupreg(regs[i].tempreg));
+                if useloadreg then
+                  setsupreg(reg,getsupreg(regs.reginfo[i].loadreg))
+                else
+                  setsupreg(reg,getsupreg(regs.reginfo[i].storereg));
                 break;
               end;
         end;
@@ -2105,10 +2121,13 @@ unit rgobj;
       begin
         result := false;
         fillchar(regs,sizeof(regs),0);
-        for counter := low(regs) to high(regs) do
-          regs[counter].orgreg := RS_INVALID;
+        for counter := low(regs.reginfo) to high(regs.reginfo) do
+          begin
+            regs.reginfo[counter].orgreg := RS_INVALID;
+            regs.reginfo[counter].loadreg := NR_INVALID;
+            regs.reginfo[counter].storereg := NR_INVALID;
+          end;
         spilled := false;
-        regindex := 0;
 
         { check whether and if so which and how (read/written) this instructions contains
           registers that must be spilled }
@@ -2160,8 +2179,8 @@ unit rgobj;
 
           For non-x86 it is nevertheless possible to replace moves to/from the register
           with loads/stores to spilltemp (Sergei) }
-        for counter := 0 to pred(regindex) do
-          with regs[counter] do
+        for counter := 0 to pred(regs.reginfocount) do
+          with regs.reginfo[counter] do
             begin
               if mustbespilled then
                 begin
@@ -2229,54 +2248,66 @@ unit rgobj;
         loadpos:=tai(loadpos.next);
 
         { Load the spilled registers }
-        for counter := 0 to pred(regindex) do
-          with regs[counter] do
+        for counter := 0 to pred(regs.reginfocount) do
+          with regs.reginfo[counter] do
             begin
               if mustbespilled and regread then
                 begin
-                  tempreg:=getregisterinline(list,regs[counter].spillregconstraints);
-                  do_spill_read(list,tai(loadpos.previous),spilltemplist[orgreg],tempreg,orgreg);
+                  loadreg:=getregisterinline(list,regs.reginfo[counter].spillregconstraints);
+                  do_spill_read(list,tai(loadpos.previous),spilltemplist[orgreg],loadreg,orgreg);
                 end;
             end;
 
         { Release temp registers of read-only registers, and add reference of the instruction
           to the reginfo }
-        for counter := 0 to pred(regindex) do
-          with regs[counter] do
+        for counter := 0 to pred(regs.reginfocount) do
+          with regs.reginfo[counter] do
             begin
-              if mustbespilled and regread and (not regwritten) then
+              if mustbespilled and regread and
+                (ssa_safe or
+                 not regwritten) then
                 begin
                   { The original instruction will be the next that uses this register }
-                  add_reg_instruction(instr,tempreg,1);
-                  ungetregisterinline(list,tempreg);
+                  add_reg_instruction(instr,loadreg,1);
+                  ungetregisterinline(list,loadreg);
                 end;
             end;
 
         { Allocate temp registers of write-only registers, and add reference of the instruction
           to the reginfo }
-        for counter := 0 to pred(regindex) do
-          with regs[counter] do
+        for counter := 0 to pred(regs.reginfocount) do
+          with regs.reginfo[counter] do
             begin
               if mustbespilled and regwritten then
                 begin
                   { When the register is also loaded there is already a register assigned }
-                  if (not regread) then
-                    tempreg:=getregisterinline(list,regs[counter].spillregconstraints);
+                  if (not regread) or
+                     ssa_safe then
+                    begin
+                      storereg:=getregisterinline(list,regs.reginfo[counter].spillregconstraints);
+                      { we also use loadreg for store replacements in case we
+                        don't have ensure ssa -> initialise loadreg even if
+                        there are no reads }
+                      if not regread  then
+                       loadreg:=storereg;
+                    end
+                  else
+                    storereg:=loadreg;
                   { The original instruction will be the next that uses this register, this
                     also needs to be done for read-write registers }
-                  add_reg_instruction(instr,tempreg,1);
+                  add_reg_instruction(instr,storereg,1);
                 end;
             end;
 
         { store the spilled registers }
         storepos:=tai(instr.next);
-        for counter := 0 to pred(regindex) do
-          with regs[counter] do
+        for counter := 0 to pred(regs.reginfocount) do
+          with regs.reginfo[counter] do
             begin
               if mustbespilled and regwritten then
                 begin
-                  do_spill_written(list,tai(storepos.previous),spilltemplist[orgreg],tempreg,orgreg);
-                  ungetregisterinline(list,tempreg);
+                  do_spill_written(list,tai(storepos.previous),spilltemplist[orgreg],storereg,orgreg);
+                  ungetregisterinline(list,storereg);
                 end;
             end;
 
@@ -2293,7 +2324,8 @@ unit rgobj;
               top_reg:
                 begin
                   if (getregtype(reg) = regtype) then
-                    tryreplacereg(reg);
+                    tryreplacereg(reg,not ssa_safe or
+                      (instr.spilling_get_operation_type(counter)=operand_read));
                 end;
               top_ref:
                 begin
@@ -2301,14 +2333,16 @@ unit rgobj;
                     begin
                       if (ref^.base <> NR_NO) and
                           (getregtype(ref^.base)=regtype) then
-                        tryreplacereg(ref^.base);
+                        tryreplacereg(ref^.base,
+                          not ssa_safe or (instr.spilling_get_operation_type_ref(counter,ref^.base)=operand_read));
                       if (ref^.index <> NR_NO) and
                           (getregtype(ref^.index)=regtype) then
-                        tryreplacereg(ref^.index);
+                        tryreplacereg(ref^.index,
+                          not ssa_safe or (instr.spilling_get_operation_type_ref(counter,ref^.index)=operand_read));
 {$if defined(x86) or defined(m68k)}
                       if (ref^.segment <> NR_NO) and
                           (getregtype(ref^.segment)=regtype) then
-                        tryreplacereg(ref^.segment);
+                        tryreplacereg(ref^.segment,true { always read-only });
 {$endif defined(x86) or defined(m68k)}
                     end;
                 end;
@@ -2316,7 +2350,7 @@ unit rgobj;
               top_shifterop:
                 begin
                   if regtype in [R_INTREGISTER,R_ADDRESSREGISTER] then
-                    tryreplacereg(shifterop^.rs);
+                    tryreplacereg(shifterop^.rs,true { always read-only });
                 end;
 {$endif ARM}
             end;