diff --git a/.gitattributes b/.gitattributes index 2081544aae..b542a3d217 100644 --- a/.gitattributes +++ b/.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 diff --git a/compiler/llvm/aasmllvm.pas b/compiler/llvm/aasmllvm.pas index 9054149db7..ed4e520042 100644 --- a/compiler/llvm/aasmllvm.pas +++ b/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); diff --git a/compiler/llvm/rgllvm.pas b/compiler/llvm/rgllvm.pas new file mode 100644 index 0000000000..67c2d687ee --- /dev/null +++ b/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]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. diff --git a/compiler/rgobj.pas b/compiler/rgobj.pas index d6eadc9199..df13990cd3 100644 --- a/compiler/rgobj.pas +++ b/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;