From 9d4ea0337a6b9db1782bf68dd4afa3ca88d94f47 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Mon, 11 Nov 2013 11:15:51 +0000 Subject: [PATCH] + basic implementation of the LLVM high level code generator git-svn-id: branches/hlcgllvm@26045 - --- .gitattributes | 1 + compiler/llvm/hlcgllvm.pas | 816 +++++++++++++++++++++++++++++++++++++ 2 files changed, 817 insertions(+) create mode 100644 compiler/llvm/hlcgllvm.pas diff --git a/.gitattributes b/.gitattributes index b542a3d217..0699bb8824 100644 --- a/.gitattributes +++ b/.gitattributes @@ -316,6 +316,7 @@ compiler/ldscript.pas svneol=native#text/plain compiler/link.pas svneol=native#text/plain compiler/llvm/aasmllvm.pas svneol=native#text/plain compiler/llvm/cgllvm.pas svneol=native#text/plain +compiler/llvm/hlcgllvm.pas svneol=native#text/plain compiler/llvm/itllvm.pas svneol=native#text/plain compiler/llvm/llvmbase.pas svneol=native#text/plain compiler/llvm/llvmdef.pas svneol=native#text/plain diff --git a/compiler/llvm/hlcgllvm.pas b/compiler/llvm/hlcgllvm.pas new file mode 100644 index 0000000000..771266252c --- /dev/null +++ b/compiler/llvm/hlcgllvm.pas @@ -0,0 +1,816 @@ +{ + Copyright (c) 2010, 2013 by Jonas Maebe + Member of the Free Pascal development team + + This unit implements the LLVM high level code generator + + 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 hlcgllvm; + +{$i fpcdefs.inc} + +interface + +uses + globtype, + aasmbase,aasmdata, + symbase,symconst,symtype,symdef,symsym, + cpubase, hlcgobj, cgbase, cgutils, parabase; + + type + + { thlcgllvm } + + thlcgllvm = class(thlcgobj) + constructor create; + + function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef; weak: boolean): tcgpara;override; + procedure a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister); override; + + procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : tcgint;register : tregister);override; + procedure a_load_const_ref(list: TAsmList; tosize: tdef; a: tcgint; const ref: treference);override; + procedure a_load_reg_ref(list : TAsmList;fromsize, tosize : tdef;register : tregister;const ref : treference);override; + procedure a_load_reg_reg(list : TAsmList;fromsize, tosize : tdef;reg1,reg2 : tregister);override; + procedure a_load_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;register : tregister);override; + procedure a_loadaddr_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;r : tregister);override; + + procedure a_op_const_reg(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; reg: TRegister); override; + procedure a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister); override; + + procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister); override; + procedure a_op_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; reg1, reg2: TRegister); override; + procedure a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister;setflags : boolean;var ovloc : tlocation); override; + procedure a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation); override; + + procedure a_cmp_const_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel); override; + procedure a_cmp_reg_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel); override; + + procedure a_jmp_always(list : TAsmList;l: tasmlabel); override; + + procedure g_concatcopy(list : TAsmList;size: tdef; const source,dest : treference);override; + + procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister); override; + procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference); override; + procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister); override; + + procedure gen_proc_symbol(list: TAsmList); override; + procedure gen_proc_symbol_end(list: TAsmList); override; + procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); override; + procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean); override; + + procedure g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef); override; + procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;var ovloc : tlocation); override; + + procedure a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle); override; + procedure a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle); override; + procedure a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister; shuffle: pmmshuffle); override; + procedure a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; src, dst: tregister; shuffle: pmmshuffle); override; + procedure a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize: tdef; intreg, mmreg: tregister; shuffle: pmmshuffle); override; + procedure a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize: tdef; mmreg, intreg: tregister; shuffle: pmmshuffle); override; + + procedure gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean); override; +{$ifdef cpuflags} + { llvm doesn't have flags, but cpuflags is defined in case the real cpu + has flags and we have to override the abstract methods to prevent + warnings } + procedure a_jmp_flags(list: TAsmList; const f: TResFlags; l: tasmlabel); override; + procedure g_flags2reg(list: TAsmList; size: tdef; const f: tresflags; reg: TRegister); override; + procedure g_flags2ref(list: TAsmList; size: tdef; const f: tresflags; const ref: TReference); override; +{$endif cpuflags} + + { unimplemented or unnecessary routines } + procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: tdef; src, dst: tregister); override; + procedure g_stackpointer_alloc(list: TAsmList; size: longint); override; + procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint); override; + procedure g_adjust_self_value(list: TAsmList; procdef: tprocdef; ioffset: aint); override; + procedure g_local_unwind(list: TAsmList; l: TAsmLabel); override; + protected + { def is the type of the data stored in memory pointed to by ref, not + a pointer to this type } + function make_simple_ref(list: TAsmList; const ref: treference; def: tdef): treference; + end; + + procedure create_hlcodegen; + + +implementation + + uses + verbose,cutils,cclasses,globals,fmodule,constexp, + defutil,llvmdef,llvmsym, + aasmtai,aasmcpu, + aasmllvm,llvmbase,tgllvm, + symtable, + paramgr, + procinfo,cpuinfo,tgobj,cgobj,cgllvm,cghlcpu; + + const + topcg2llvmop: array[topcg] of tllvmop = + { OP_NONE OP_MOVE OP_ADD OP_AND OP_DIV OP_IDIV OP_IMUL OP_MUL } + (la_none, la_none, la_add, la_and, la_udiv, la_sdiv, la_mul, la_mul, + { OP_NEG OP_NOT OP_OR OP_SAR OP_SHL OP_SHR OP_SUB OP_XOR } + la_none, la_none, la_or, la_ashr, la_shl, la_lshr, la_sub, la_xor, + { OP_ROL OP_ROR } + la_none, la_none); + + + constructor thlcgllvm.create; + begin + inherited + end; + + + function thlcgllvm.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara; + begin + { todo: we also need the parameter locations here for llvm! } + list.concat(tai_comment.create(strpnew('call '+s))); + result:=get_call_result_cgpara(pd,forceresdef); + end; + + + procedure thlcgllvm.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister); + begin + internalerror(2012042824); + end; + + + procedure thlcgllvm.a_load_const_reg(list: TAsmList; tosize: tdef; a: tcgint; register: tregister); + begin + list.concat(taillvm.op_reg_size_const_size(la_bitcast,register,tosize,a,tosize)) + end; + + + procedure thlcgllvm.a_load_const_ref(list: TAsmList; tosize: tdef; a: tcgint; const ref: treference); + var + sref: treference; + begin + sref:=make_simple_ref(list,ref,tosize); + list.concat(taillvm.op_size_const_size_ref(la_store,tosize,a,getpointerdef(tosize),sref)) + end; + + + procedure thlcgllvm.a_load_reg_ref(list: TAsmList; fromsize, tosize: tdef; register: tregister; const ref: treference); + var + sref: treference; + hreg: tregister; + begin + sref:=make_simple_ref(list,ref,tosize); + hreg:=register; + if fromsize.size<>tosize.size then + begin + hreg:=getregisterfordef(list,tosize); + a_load_reg_reg(list,fromsize,tosize,register,hreg); + end; + list.concat(taillvm.op_size_reg_size_ref(la_store,tosize,hreg,getpointerdef(tosize),sref)) + end; + + + procedure thlcgllvm.a_load_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister); + var + fromregtyp, + toregtyp: tregistertype; + op: tllvmop; + begin + fromregtyp:=def2regtyp(fromsize); + toregtyp:=def2regtyp(tosize); + { int to pointer or vice versa } + if (fromregtyp=R_ADDRESSREGISTER) and + (toregtyp=R_INTREGISTER) then + op:=la_ptrtoint + else if (fromregtyp=R_INTREGISTER) and + (toregtyp=R_ADDRESSREGISTER) then + op:=la_inttoptr + { int to int or ptr to ptr: need zero/sign extension, or plain bitcast? } + else if tosize.size<>fromsize.size then + begin + if tosize.size sign extension } + op:=la_sext + else + op:=la_zext; + end + else + op:=la_bitcast; + { reg2 = bitcast fromsize reg1 to tosize } + list.concat(taillvm.op_reg_size_reg_size(op,reg2,fromsize,reg1,tosize)); + end; + + + procedure thlcgllvm.a_load_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; register: tregister); + var + sref: treference; + hreg: tregister; + begin + sref:=make_simple_ref(list,ref,fromsize); + { "named register"? } + if sref.refaddr=addr_full then + list.concat(taillvm.op_reg_size_ref_size(la_bitcast,register,fromsize,sref,tosize)) + else + begin + hreg:=register; + if fromsize<>tosize then + hreg:=getregisterfordef(list,fromsize); + list.concat(taillvm.op_reg_size_ref(la_load,hreg,getpointerdef(fromsize),sref)); + if hreg<>register then + a_load_reg_reg(list,fromsize,tosize,hreg,register); + end; + end; + + + procedure thlcgllvm.a_loadaddr_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; r: tregister); + var + sref: treference; + begin + { can't take the address of a 'named register' } + if ref.refaddr=addr_full then + internalerror(2013102306); + sref:=make_simple_ref(list,ref,fromsize); + list.concat(taillvm.op_reg_size_ref_size(la_bitcast,r,fromsize,sref,tosize)); + end; + + + procedure thlcgllvm.a_op_const_reg(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; reg: TRegister); + begin + a_op_const_reg_reg(list,op,size,a,reg,reg); + end; + + + procedure thlcgllvm.a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister); + var + tmpreg: tregister; + begin + if (def2regtyp(size)=R_INTREGISTER) and + (topcg2llvmop[op]<>la_none) then + list.concat(taillvm.op_reg_size_reg_const(topcg2llvmop[op],dst,size,src,a)) + else + begin + { default implementation is not SSA-safe } + tmpreg:=getregisterfordef(list,size); + a_load_const_reg(list,size,a,tmpreg); + a_op_reg_reg_reg(list,op,size,tmpreg,src,dst); + end; + end; + + + procedure thlcgllvm.a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister); + var + orgdst, + tmpreg1, + tmpreg2, + tmpreg3: tregister; + opsize: tdef; + begin + orgdst:=dst; + opsize:=size; + { always perform using integer registers, because math operations on + pointers are not supported (except via getelementptr, possible future + optimization) } + if def2regtyp(size)=R_ADDRESSREGISTER then + begin + opsize:=ptruinttype; + + tmpreg1:=getintregister(list,ptruinttype); + a_load_reg_reg(list,size,ptruinttype,src1,tmpreg1); + src1:=tmpreg1; + + tmpreg1:=getintregister(list,ptruinttype); + a_load_reg_reg(list,size,ptruinttype,src2,tmpreg1); + src2:=tmpreg1; + + dst:=getintregister(list,ptruinttype); + end; + if topcg2llvmop[op]<>la_none then + list.concat(taillvm.op_reg_size_reg_reg(topcg2llvmop[op],dst,opsize,src2,src1)) + else + begin + case op of + OP_NEG: + { %dst = sub size 0, %src1 } + list.concat(taillvm.op_reg_size_const_reg(la_sub,dst,opsize,0,src1)); + OP_NOT: + { %dst = xor size -1, %src1 } + list.concat(taillvm.op_reg_size_const_reg(la_xor,dst,opsize,-1,src1)); + OP_ROL: + begin + tmpreg1:=getintregister(list,opsize); + tmpreg2:=getintregister(list,opsize); + tmpreg3:=getintregister(list,opsize); + { tmpreg1 := tcgsize2size[size] - src1 } + list.concat(taillvm.op_reg_size_const_reg(la_sub,tmpreg1,opsize,opsize.size,src1)); + { tmpreg2 := src2 shr tmpreg1 } + a_op_reg_reg_reg(list,OP_SHR,opsize,tmpreg1,src2,tmpreg2); + { tmpreg3 := src2 shl src1 } + a_op_reg_reg_reg(list,OP_SHL,opsize,src1,src2,tmpreg3); + { dst := tmpreg2 or tmpreg3 } + a_op_reg_reg_reg(list,OP_OR,opsize,tmpreg2,tmpreg3,dst); + end; + OP_ROR: + begin + tmpreg1:=getintregister(list,size); + tmpreg2:=getintregister(list,size); + tmpreg3:=getintregister(list,size); + { tmpreg1 := tcgsize2size[size] - src1 } + list.concat(taillvm.op_reg_size_const_reg(la_sub,tmpreg1,opsize,opsize.size,src1)); + { tmpreg2 := src2 shl tmpreg1 } + a_op_reg_reg_reg(list,OP_SHL,opsize,tmpreg1,src2,tmpreg2); + { tmpreg3 := src2 shr src1 } + a_op_reg_reg_reg(list,OP_SHR,opsize,src1,src2,tmpreg3); + { dst := tmpreg2 or tmpreg3 } + a_op_reg_reg_reg(list,OP_OR,opsize,tmpreg2,tmpreg3,dst); + end; + else + internalerror(2010081310); + end; + end; + if dst<>orgdst then + a_load_reg_reg(list,opsize,size,dst,orgdst); + end; + + + procedure thlcgllvm.a_op_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; reg1, reg2: TRegister); + begin + a_op_reg_reg_reg(list,op,size,reg1,reg2,reg2); + end; + + + procedure thlcgllvm.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister; setflags: boolean; var ovloc: tlocation); + begin + if not setflags then + begin + inherited; + exit; + end; + { use xxx.with.overflow intrinsics } + internalerror(2012111102); + end; + + + procedure thlcgllvm.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister; setflags: boolean; var ovloc: tlocation); + begin + if not setflags then + begin + inherited; + exit; + end; + { use xxx.with.overflow intrinsics } + internalerror(2012111103); + end; + + + procedure thlcgllvm.a_cmp_const_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel); + var + tmpreg : tregister; + invert: boolean; + falselab, tmplab: tasmlabel; + begin + { since all comparisons return their results in a register, we'll often + get comparisons against true/false -> optimise } + if (size=pasbool8type) and + (cmp_op in [OC_EQ,OC_NE]) then + begin + case cmp_op of + OC_EQ: + invert:=a=0; + OC_NE: + invert:=a=1; + end; + current_asmdata.getjumplabel(falselab); + if invert then + begin + tmplab:=l; + l:=falselab; + falselab:=tmplab; + end; + list.concat(taillvm.op_size_reg_lab_lab(la_br,pasbool8type,reg,l,falselab)); + a_label(list,falselab); + exit; + end; + tmpreg:=getregisterfordef(list,size); + a_load_const_reg(list,size,a,tmpreg); + a_cmp_reg_reg_label(list,size,cmp_op,tmpreg,reg,l); + end; + + + procedure thlcgllvm.a_cmp_reg_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel); + var + resreg: tregister; + falselab: tasmlabel; + begin + if getregtype(reg1)<>getregtype(reg2) then + internalerror(2012111105); + resreg:=getintregister(list,pasbool8type); + current_asmdata.getjumplabel(falselab); + { invert order of registers. In FPC, cmp_reg_reg(reg1,reg2) means that + e.g. OC_GT is true if "subl %reg1,%reg2" in x86 AT&T is >0. In LLVM, + OC_GT is true if op1>op2 } + list.concat(taillvm.op_reg_cond_size_reg_reg(la_icmp,resreg,cmp_op,size,reg2,reg1)); + list.concat(taillvm.op_size_reg_lab_lab(la_br,pasbool8type,resreg,l,falselab)); + a_label(list,falselab); + end; + + + procedure thlcgllvm.a_jmp_always(list: TAsmList; l: tasmlabel); + begin + { implement in tcg because required by the overridden a_label; doesn't use + any high level stuff anyway } + cg.a_jmp_always(list,l); + end; + + + procedure thlcgllvm.g_concatcopy(list: TAsmList; size: tdef; const source, dest: treference); + begin + { todo } + inherited; + end; + + + procedure thlcgllvm.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister); + var + tmpreg: tregister; + href: treference; + begin + href:=make_simple_ref(list,ref,fromsize); + { don't generate different code for loading e.g. extended into cextended, + but to take care of loading e.g. comp (=int64) into double } + if (fromsize.size<>tosize.size) or + ((tfloatdef(fromsize).floattype in [s64currency,s64comp])<> + (tfloatdef(tosize).floattype in [s64currency,s64comp])) then + tmpreg:=getfpuregister(list,fromsize) + else + tmpreg:=reg; + { %tmpreg = load size* %ref } + list.concat(taillvm.op_reg_size_ref(la_load,tmpreg,getpointerdef(fromsize),href)); + if tmpreg<>reg then + a_loadfpu_reg_reg(list,fromsize,tosize,tmpreg,reg); + end; + + + procedure thlcgllvm.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference); + var + tmpreg: tregister; + href: treference; + begin + href:=make_simple_ref(list,ref,tosize); + { don't generate different code for loading e.g. extended into cextended, + but to take care of storing e.g. comp (=int64) into double } + if (fromsize.size<>tosize.size) or + ((tfloatdef(fromsize).floattype in [s64currency,s64comp])<> + (tfloatdef(tosize).floattype in [s64currency,s64comp])) then + begin + tmpreg:=getfpuregister(list,tosize); + a_loadfpu_reg_reg(list,fromsize,tosize,reg,tmpreg); + end + else + tmpreg:=reg; + { store tosize tmpreg, tosize* href } + list.concat(taillvm.op_size_reg_size_ref(la_store,tosize,tmpreg,getpointerdef(tosize),href)); + end; + + + procedure thlcgllvm.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister); + var + op: tllvmop; + intfromsize, + inttosize: longint; + fromcompcurr, + tocompcurr: boolean; + begin + { at the value level, s80real and sc80real are the same } + if fromsize<>s80floattype then + intfromsize:=fromsize.size + else + intfromsize:=sc80floattype.size; + if tosize<>s80floattype then + inttosize:=tosize.size + else + inttosize:=sc80floattype.size; + + { s64comp and s64real are handled as int64 by llvm, which complicates + things here for us } + fromcompcurr:=tfloatdef(fromsize).floattype in [s64comp,s64currency]; + tocompcurr:=tfloatdef(tosize).floattype in [s64comp,s64currency]; + if fromcompcurr=tocompcurr then + begin + if intfromsizeinttosize then + op:=la_fptrunc + else + op:=la_bitcast + end + else if fromcompcurr then + op:=la_sitofp + else + op:=la_fptosi; + { reg2 = bitcast fromllsize reg1 to tollsize } + list.concat(taillvm.op_reg_size_reg_size(op,reg2,fromsize,reg1,tosize)); + end; + + + procedure thlcgllvm.gen_proc_symbol(list: TAsmList); + var + item: TCmdStrListItem; + mangledname: TSymStr; + begin + item:=TCmdStrListItem(current_procinfo.procdef.aliasnames.first); + mangledname:=current_procinfo.procdef.mangledname; + { predefine the real function name as local/global, so the aliases can + refer to the symbol and get the binding correct } + if (cs_profile in current_settings.moduleswitches) or + (po_global in current_procinfo.procdef.procoptions) then + current_asmdata.DefineAsmSymbol(mangledname,AB_GLOBAL,AT_FUNCTION) + else + current_asmdata.DefineAsmSymbol(mangledname,AB_LOCAL,AT_FUNCTION); + while assigned(item) do + begin + if mangledname<>item.Str then + list.concat(taillvmalias.Create(mangledname,item.str,current_procinfo.procdef,llv_default,lll_default)); + item:=TCmdStrListItem(item.next); + end; + list.concat(taillvmprocdef.create(current_procinfo.procdef)); + end; + + + procedure thlcgllvm.gen_proc_symbol_end(list: TAsmList); + begin + list.concat(Tai_symbol_end.Createname(current_procinfo.procdef.mangledname)); + { todo: darwin main proc, or handle in other way? } + end; + + + procedure thlcgllvm.g_proc_entry(list: TAsmList; localsize: longint; nostackframe: boolean); + begin + list.concatlist(ttgllvm(tg).alloclist) + { rest: todo } + end; + + + procedure thlcgllvm.g_proc_exit(list: TAsmList; parasize: longint; nostackframe: boolean); + var + retdef: tdef; + begin + if current_procinfo.procdef.proctypeoption in [potype_constructor,potype_class_constructor] then + if is_implicit_pointer_object_type(current_procinfo.procdef.struct) then + retdef:=current_procinfo.procdef.struct + else + retdef:=getpointerdef(current_procinfo.procdef.struct) + else + retdef:=current_procinfo.procdef.returndef; + + if is_void(retdef) then + list.concat(taillvm.op_size(la_ret,retdef)) + else + begin + case current_procinfo.procdef.funcretloc[calleeside].location^.loc of + LOC_REGISTER, + LOC_FPUREGISTER: + list.concat(taillvm.op_size_reg(la_ret,retdef,current_procinfo.procdef.funcretloc[calleeside].location^.register)) + else + { todo: complex returns } + internalerror(2012111106); + end; + end; + end; + + + procedure thlcgllvm.g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef); + begin + { not possible, need ovloc } + internalerror(2012111107); + end; + + + procedure thlcgllvm.g_overflowCheck_loc(List: TAsmList; const Loc: TLocation; def: TDef; var ovloc: tlocation); + begin + { todo } + internalerror(2012111108); + end; + + + procedure thlcgllvm.a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle); + var + href: treference; + begin + if shuffle=mms_movescalar then + a_loadfpu_ref_reg(list,fromsize,tosize,ref,reg) + else + begin + { todo } + if fromsize<>tosize then + internalerror(2013060220); + href:=make_simple_ref(list,ref,fromsize); + { %reg = load size* %ref } + list.concat(taillvm.op_reg_size_ref(la_load,reg,getpointerdef(fromsize),href)); + end; + end; + + + procedure thlcgllvm.a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle); + var + href: treference; + begin + if shuffle=mms_movescalar then + a_loadfpu_reg_ref(list,fromsize,tosize,reg,ref) + else + begin + { todo } + if fromsize<>tosize then + internalerror(2013060220); + href:=make_simple_ref(list,ref,tosize); + { store tosize reg, tosize* href } + list.concat(taillvm.op_size_reg_size_ref(la_store,tosize,reg,getpointerdef(tosize),href)) + end; + end; + + + procedure thlcgllvm.a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister; shuffle: pmmshuffle); + begin + if shuffle=mms_movescalar then + a_loadfpu_reg_reg(list,fromsize,tosize,reg1,reg2) + else + { reg2 = bitcast fromllsize reg1 to tollsize } + list.concat(taillvm.op_reg_size_reg_size(la_bitcast,reg2,fromsize,reg1,tosize)); + end; + + + procedure thlcgllvm.a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; src, dst: tregister; shuffle: pmmshuffle); + begin + if (op=OP_XOR) and + (src=dst) then + a_load_const_reg(list,size,0,dst) + else + { todo } + internalerror(2013060221); + end; + + + procedure thlcgllvm.a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize: tdef; intreg, mmreg: tregister; shuffle: pmmshuffle); + begin + internalerror(2013060222); + end; + + + procedure thlcgllvm.a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize: tdef; mmreg, intreg: tregister; shuffle: pmmshuffle); + begin + internalerror(2013060223); + end; + + + procedure thlcgllvm.gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean); + var + href : treference; + begin + { skip e.g. empty records } + if (para.location^.loc = LOC_VOID) then + exit; + para.check_simple_location; + case destloc.loc of + LOC_REFERENCE : + begin + { If the parameter location is reused we don't need to copy + anything } + if not reusepara then + begin + reference_reset_symbol(href,para.location^.llvmloc,0,para.location^.def.alignment); + if para.location^.llvmvalueloc then + href.refaddr:=addr_full; + { TODO: if more than one location, use para.location^.def instead (otherwise para.def, because can be + zext/sext -> paraloc.location^.def will be larger) } + a_load_ref_ref(list,para.def,para.def,href,destloc.reference); + end; + end; + { TODO other possible locations } + else + internalerror(2013102304); + end; + end; + + + procedure thlcgllvm.a_jmp_flags(list: TAsmList; const f: TResFlags; l: tasmlabel); + begin + internalerror(2013060224); + end; + + + procedure thlcgllvm.g_flags2reg(list: TAsmList; size: tdef; const f: tresflags; reg: TRegister); + begin + internalerror(2013060225); + end; + + + procedure thlcgllvm.g_flags2ref(list: TAsmList; size: tdef; const f: tresflags; const ref: TReference); + begin + internalerror(2013060226); + end; + + + procedure thlcgllvm.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: tdef; src, dst: tregister); + begin + internalerror(2012090201); + end; + + + procedure thlcgllvm.g_stackpointer_alloc(list: TAsmList; size: longint); + begin + internalerror(2012090203); + end; + + + procedure thlcgllvm.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint); + begin + internalerror(2012090204); + end; + + + procedure thlcgllvm.g_adjust_self_value(list: TAsmList; procdef: tprocdef; ioffset: aint); + begin + internalerror(2012090205); + end; + + + procedure thlcgllvm.g_local_unwind(list: TAsmList; l: TAsmLabel); + begin + internalerror(2012090206); + end; + + + function thlcgllvm.make_simple_ref(list: TAsmList; const ref: treference; def: tdef): treference; + var + hreg1, + hreg2: tregister; + tmpref: treference; + begin + { already simple? } + if (not assigned(ref.symbol) or + (ref.base=NR_NO)) and + (ref.index=NR_NO) and + (ref.offset=0) then + begin + result:=ref; + exit; + end; + { for now, perform all calculations using plain pointer arithmetic. Later + we can look into optimizations based on getelementptr for structured + accesses (if only to prevent running out of virtual registers). + + Assumptions: + * symbol/base register: always type "def*" + * index/offset: always type "ptruinttype" (llvm bitcode has no sign information, so sign doesn't matter) } + hreg1:=getintregister(list,ptruinttype); + if assigned(ref.symbol) then + begin + if ref.base<>NR_NO then + internalerror(2012111301); + reference_reset_symbol(tmpref,ref.symbol,0,ref.alignment); + list.concat(taillvm.getelementptr_reg_size_ref_size_const(hreg1,getpointerdef(def),tmpref,ptruinttype,0)); + end + else if ref.base<>NR_NO then + begin + a_load_reg_reg(list,getpointerdef(def),ptruinttype,ref.base,hreg1); + end + else + { todo: support for absolute addresses on embedded platforms } + internalerror(2012111302); + if ref.index<>NR_NO then + begin + { SSA... } + hreg2:=getintregister(list,ptruinttype); + a_op_reg_reg_reg(list,OP_ADD,ptruinttype,ref.index,hreg1,hreg2); + hreg1:=hreg2; + end; + if ref.offset<>0 then + begin + hreg2:=getintregister(list,ptruinttype); + a_op_const_reg_reg(list,OP_ADD,ptruinttype,ref.offset,hreg1,hreg2); + hreg1:=hreg2; + end; + hreg2:=getaddressregister(list,getpointerdef(def)); + a_load_reg_reg(list,ptruinttype,getpointerdef(def),hreg1,hreg2); + reference_reset_base(result,hreg2,0,ref.alignment); + end; + + + procedure create_hlcodegen; + begin + hlcg:=thlcgllvm.create; + cgllvm.create_codegen + end; + +end.