mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-31 10:31:44 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			1825 lines
		
	
	
		
			72 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			1825 lines
		
	
	
		
			72 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
| {
 | |
|     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,cclasses,
 | |
|   aasmbase,aasmdata,
 | |
|   symbase,symconst,symtype,symdef,symsym,
 | |
|   cpubase, hlcgobj, cgbase, cgutils, parabase, tgobj;
 | |
| 
 | |
|   type
 | |
| 
 | |
|     { thlcgllvm }
 | |
| 
 | |
|     thlcgllvm = class(thlcgobj)
 | |
|       constructor create;
 | |
| 
 | |
|       procedure temp_to_ref(p: ptemprecord; out ref: treference); override;
 | |
| 
 | |
|       procedure a_load_ref_cgpara(list: TAsmList; size: tdef; const r: treference; const cgpara: TCGPara); override;
 | |
|      protected
 | |
|        procedure a_load_ref_cgpara_init_src(list: TAsmList; const para: tcgpara; const initialref: treference; var refsize: tdef; out newref: treference);
 | |
|      public
 | |
|       procedure getcpuregister(list: TAsmList; r: Tregister); override;
 | |
|       procedure ungetcpuregister(list: TAsmList; r: Tregister); override;
 | |
|       procedure alloccpuregisters(list: TAsmList; rt: Tregistertype; const r: Tcpuregisterset); override;
 | |
|       procedure deallocallcpuregisters(list: TAsmList); override;
 | |
| 
 | |
|      protected
 | |
|       procedure a_call_common(list: TAsmList; pd: tabstractprocdef; const paras: array of pcgpara; const forceresdef: tdef; out res: tregister; out hlretdef: tdef; out llvmretdef: tdef; out callparas: tfplist);
 | |
|      public
 | |
|       function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;override;
 | |
|       function a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara; 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_load_ref_ref(list: TAsmList; fromsize, tosize: tdef; const sref: treference; const dref: treference); 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 handle_external_proc(list: TAsmList; pd: tprocdef; const importname: TSymStr); override;
 | |
|       procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); override;
 | |
|       procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean); override;
 | |
|      protected
 | |
|       procedure gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara); override;
 | |
|      public
 | |
|       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 g_ptrtypecast_reg(list: TAsmList; fromdef, todef: tdef; var reg: tregister); override;
 | |
|       procedure g_ptrtypecast_ref(list: TAsmList; fromdef: tpointerdef; todef: tdef; var ref: treference); override;
 | |
| 
 | |
|       procedure g_set_addr_nonbitpacked_field_ref(list: TAsmList; recdef: tabstractrecorddef; field: tfieldvarsym; var recref: treference); 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;
 | |
| 
 | |
|       function get_call_result_cgpara(pd: tabstractprocdef; forceresdef: tdef): tcgpara; override;
 | |
|      protected
 | |
|       procedure gen_load_loc_function_result(list: TAsmList; vardef: tdef; const l: tlocation); override;
 | |
|      public
 | |
|       procedure gen_load_loc_cgpara(list: TAsmList; vardef: tdef; const l: tlocation; const cgpara: tcgpara); 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; srcsize, dstsize: 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;
 | |
| 
 | |
|       procedure varsym_set_localloc(list: TAsmList; vs: tabstractnormalvarsym); override;
 | |
|       procedure paravarsym_set_initialloc_to_paraloc(vs: tparavarsym); override;
 | |
| 
 | |
|       procedure g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string); override;
 | |
| 
 | |
|       { 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;
 | |
|     protected
 | |
|       procedure paraloctoloc(const paraloc: pcgparalocation; out hloc: tlocation);
 | |
|       procedure set_call_function_result(const list: TAsmList; const pd: tabstractprocdef; const llvmretdef, hlretdef: tdef; const resval: tregister; var retpara: tcgpara);
 | |
|     end;
 | |
| 
 | |
|   procedure create_hlcodegen;
 | |
| 
 | |
| 
 | |
| implementation
 | |
| 
 | |
|   uses
 | |
|     verbose,cutils,globals,fmodule,constexp,systems,
 | |
|     defutil,llvmdef,llvmsym,
 | |
|     aasmtai,aasmcpu,
 | |
|     aasmllvm,llvmbase,tgllvm,
 | |
|     symtable,symllvm,
 | |
|     paramgr,llvmpara,
 | |
|     procinfo,cpuinfo,cgobj,cgllvm,cghlcpu,
 | |
|     cgcpu,hlcgcpu;
 | |
| 
 | |
|   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;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.temp_to_ref(p: ptemprecord; out ref: treference);
 | |
|     begin
 | |
|       { on the LLVM target, every temp is independent and encoded via a
 | |
|         separate temp register whose superregister number is stored in p^.pos }
 | |
|       reference_reset_base(ref,voidstackpointertype,newreg(R_TEMPREGISTER,p^.pos,R_SUBWHOLE),0,p^.alignment);
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.a_load_ref_cgpara(list: TAsmList; size: tdef; const r: treference; const cgpara: TCGPara);
 | |
|     var
 | |
|       tmpref, initialref, ref: treference;
 | |
|       orgsize: tdef;
 | |
|       tmpreg: tregister;
 | |
|       hloc: tlocation;
 | |
|       location: pcgparalocation;
 | |
|       orgsizeleft,
 | |
|       sizeleft,
 | |
|       totaloffset: asizeint;
 | |
|       paralocidx: longint;
 | |
|       userecord,
 | |
|       reghasvalue: boolean;
 | |
|     begin
 | |
|       location:=cgpara.location;
 | |
|       sizeleft:=cgpara.intsize;
 | |
|       totaloffset:=0;
 | |
|       orgsize:=size;
 | |
|       a_load_ref_cgpara_init_src(list,cgpara,r,size,initialref);
 | |
|       userecord:=
 | |
|         (orgsize<>size) and
 | |
|         assigned(cgpara.location^.next);
 | |
|       paralocidx:=0;
 | |
|       while assigned(location) do
 | |
|         begin
 | |
|           if userecord then
 | |
|             begin
 | |
|               { llvmparadef is a record in this case, with every field corresponding
 | |
|                 to a single paraloc }
 | |
|               paraloctoloc(location,hloc);
 | |
|               tmpreg:=getaddressregister(list,cpointerdef.getreusable(location^.def));
 | |
|               list.concat(taillvm.getelementptr_reg_size_ref_size_const(tmpreg,cpointerdef.getreusable(size),initialref,s32inttype,paralocidx,true));
 | |
|               reference_reset_base(tmpref,cpointerdef.getreusable(location^.def),tmpreg,0,newalignment(initialref.alignment,totaloffset));
 | |
|             end
 | |
|           else
 | |
|             tmpref:=initialref;
 | |
|           paramanager.allocparaloc(list,location);
 | |
|           case location^.loc of
 | |
|             LOC_REGISTER,LOC_CREGISTER:
 | |
|               begin
 | |
|                  { byval parameter -> load the address rather than the value }
 | |
|                  if not location^.llvmvalueloc then
 | |
|                    a_loadaddr_ref_reg(list,tpointerdef(location^.def).pointeddef,location^.def,tmpref,location^.register)
 | |
|                  { if this parameter is split into multiple paralocs via
 | |
|                    record fields, load the current paraloc. The type of the
 | |
|                    paraloc and of the current record field will match by
 | |
|                    construction (the record is build from the paraloc
 | |
|                    types) }
 | |
|                  else if userecord then
 | |
|                    a_load_ref_reg(list,location^.def,location^.def,tmpref,location^.register)
 | |
|                  { if the parameter is passed in a single paraloc, the
 | |
|                    paraloc's type may be different from the declared type
 | |
|                    -> use the original complete parameter size as source so
 | |
|                    we can insert a type conversion if necessary }
 | |
|                  else
 | |
|                    a_load_ref_reg(list,size,location^.def,tmpref,location^.register)
 | |
|              end;
 | |
|             LOC_REFERENCE,LOC_CREFERENCE:
 | |
|               begin
 | |
|                  if assigned(location^.next) then
 | |
|                    internalerror(2010052906);
 | |
|                  reference_reset_base(ref,cpointerdef.getreusable(size),location^.reference.index,location^.reference.offset,newalignment(cgpara.alignment,cgpara.intsize-sizeleft));
 | |
|                  if (def_cgsize(size)<>OS_NO) and
 | |
|                     (size.size=sizeleft) and
 | |
|                     (sizeleft<=sizeof(aint)) then
 | |
|                    a_load_ref_ref(list,size,location^.def,tmpref,ref)
 | |
|                  else
 | |
|                    { use concatcopy, because the parameter can be larger than }
 | |
|                    { what the OS_* constants can handle                       }
 | |
|                    g_concatcopy(list,location^.def,tmpref,ref);
 | |
|               end;
 | |
|             LOC_MMREGISTER,LOC_CMMREGISTER:
 | |
|               begin
 | |
|                  case location^.size of
 | |
|                    OS_F32,
 | |
|                    OS_F64,
 | |
|                    OS_F128:
 | |
|                      a_loadmm_ref_reg(list,location^.def,location^.def,tmpref,location^.register,mms_movescalar);
 | |
|                    OS_M8..OS_M128,
 | |
|                    OS_MS8..OS_MS128,
 | |
|                    OS_32..OS_128:
 | |
|                      a_loadmm_ref_reg(list,location^.def,location^.def,tmpref,location^.register,nil);
 | |
|                    else
 | |
|                      internalerror(2010053101);
 | |
|                  end;
 | |
|               end
 | |
|             else
 | |
|               internalerror(2010053111);
 | |
|           end;
 | |
|           inc(totaloffset,tcgsize2size[location^.size]);
 | |
|           dec(sizeleft,tcgsize2size[location^.size]);
 | |
|           location:=location^.next;
 | |
|           inc(paralocidx);
 | |
|         end;
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.a_load_ref_cgpara_init_src(list: TAsmList; const para: tcgpara; const initialref: treference; var refsize: tdef; out newref: treference);
 | |
|     var
 | |
|       newrefsize: tdef;
 | |
|       reg: tregister;
 | |
|     begin
 | |
|       newrefsize:=llvmgetcgparadef(para,true);
 | |
|       if refsize<>newrefsize then
 | |
|         begin
 | |
|           reg:=getaddressregister(list,cpointerdef.getreusable(newrefsize));
 | |
|           a_loadaddr_ref_reg(list,refsize,cpointerdef.getreusable(newrefsize),initialref,reg);
 | |
|           reference_reset_base(newref,cpointerdef.getreusable(newrefsize),reg,0,initialref.alignment);
 | |
|           refsize:=newrefsize;
 | |
|         end
 | |
|       else
 | |
|         newref:=initialref;
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.getcpuregister(list: TAsmList; r: Tregister);
 | |
|     begin
 | |
|       { don't do anything }
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.ungetcpuregister(list: TAsmList; r: Tregister);
 | |
|     begin
 | |
|       { don't do anything }
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.alloccpuregisters(list: TAsmList; rt: Tregistertype; const r: Tcpuregisterset);
 | |
|     begin
 | |
|       { don't do anything }
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.deallocallcpuregisters(list: TAsmList);
 | |
|     begin
 | |
|       { don't do anything }
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   function get_call_pd(pd: tabstractprocdef): tdef;
 | |
|     begin
 | |
|       if (pd.typ=procdef) or
 | |
|          not pd.is_addressonly then
 | |
|         { we get a pointerdef rather than a procvardef so that if we have to
 | |
|           insert an external declaration for this procdef in llvmtype, we don't
 | |
|           have to create another procdef from the procvardef we've just created.
 | |
|           With a pointerdef, we can just get the pointeddef again. A pointerdef
 | |
|           is also much cheaper to create, and in llvm a provardef is a "function
 | |
|           pointer", so a pointer to a procdef is the same as a procvar as far
 | |
|           as llvm is concerned }
 | |
|         result:=cpointerdef.getreusable(pd)
 | |
|       else
 | |
|         result:=pd
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.a_call_common(list: TAsmList; pd: tabstractprocdef; const paras: array of pcgpara; const forceresdef: tdef; out res: tregister; out hlretdef: tdef; out llvmretdef: tdef; out callparas: tfplist);
 | |
| 
 | |
|     procedure load_ref_anyreg(def: tdef; const ref: treference; reg: tregister; var callpara: pllvmcallpara);
 | |
|       begin
 | |
|         case getregtype(reg) of
 | |
|           R_INTREGISTER,
 | |
|           R_ADDRESSREGISTER:
 | |
|             begin
 | |
|               a_load_ref_reg(list,def,def,ref,reg);
 | |
|               callpara^.loc:=LOC_REGISTER;
 | |
|             end;
 | |
|           R_FPUREGISTER:
 | |
|             begin
 | |
|               a_loadfpu_ref_reg(list,def,def,ref,reg);
 | |
|               callpara^.loc:=LOC_FPUREGISTER;
 | |
|             end;
 | |
|           R_MMREGISTER:
 | |
|             begin
 | |
|               a_loadmm_ref_reg(list,def,def,ref,reg,mms_movescalar);
 | |
|               callpara^.loc:=LOC_MMREGISTER;
 | |
|             end;
 | |
|           else
 | |
|             internalerror(2014012213);
 | |
|         end;
 | |
|       end;
 | |
| 
 | |
|   var
 | |
|     i: longint;
 | |
|     href: treference;
 | |
|     callpara: pllvmcallpara;
 | |
|     paraloc: pcgparalocation;
 | |
|   begin
 | |
|     callparas:=tfplist.Create;
 | |
|     for i:=0 to high(paras) do
 | |
|       begin
 | |
|         paraloc:=paras[i]^.location;
 | |
|         while assigned(paraloc) and
 | |
|               (paraloc^.loc<>LOC_VOID) do
 | |
|           begin
 | |
|             new(callpara);
 | |
|             callpara^.def:=paraloc^.def;
 | |
|             llvmextractvalueextinfo(paras[i]^.def, callpara^.def, callpara^.valueext);
 | |
|             callpara^.loc:=paraloc^.loc;
 | |
|             case callpara^.loc of
 | |
|               LOC_REFERENCE:
 | |
|                 begin
 | |
|                   if paraloc^.llvmvalueloc then
 | |
|                     internalerror(2014012307)
 | |
|                   else
 | |
|                     begin
 | |
|                       reference_reset_base(href, cpointerdef.getreusable(callpara^.def), paraloc^.reference.index, paraloc^.reference.offset, paraloc^.def.alignment);
 | |
|                       res:=getregisterfordef(list, paraloc^.def);
 | |
|                       load_ref_anyreg(callpara^.def, href, res, callpara);
 | |
|                     end;
 | |
|                   callpara^.reg:=res
 | |
|                 end;
 | |
|               LOC_REGISTER,
 | |
|               LOC_FPUREGISTER,
 | |
|               LOC_MMREGISTER:
 | |
|                 begin
 | |
|                   { undo explicit value extension }
 | |
|                   if callpara^.valueext<>lve_none then
 | |
|                     begin
 | |
|                       res:=getregisterfordef(list, callpara^.def);
 | |
|                       a_load_reg_reg(list, paraloc^.def, callpara^.def, paraloc^.register, res);
 | |
|                       paraloc^.register:=res;
 | |
|                     end;
 | |
|                     callpara^.reg:=paraloc^.register
 | |
|                 end;
 | |
|               else
 | |
|                 internalerror(2014010605);
 | |
|             end;
 | |
|             callparas.add(callpara);
 | |
|             paraloc:=paraloc^.next;
 | |
|           end;
 | |
|       end;
 | |
|     { the Pascal level may expect a different returndef compared to the
 | |
|       declared one }
 | |
|     if not assigned(forceresdef) then
 | |
|       hlretdef:=pd.returndef
 | |
|     else
 | |
|       hlretdef:=forceresdef;
 | |
|     { llvm will always expect the original return def }
 | |
|     if not paramanager.ret_in_param(hlretdef, pd) then
 | |
|       llvmretdef:=llvmgetcgparadef(pd.funcretloc[callerside], true)
 | |
|     else
 | |
|       llvmretdef:=voidtype;
 | |
|     if not is_void(llvmretdef) then
 | |
|       res:=getregisterfordef(list, llvmretdef)
 | |
|     else
 | |
|       res:=NR_NO;
 | |
| 
 | |
|     { if this is a complex procvar, get the non-tmethod-like equivalent }
 | |
|     if (pd.typ=procvardef) and
 | |
|        not pd.is_addressonly then
 | |
|       pd:=tprocvardef(cprocvardef.getreusableprocaddr(pd));
 | |
|   end;
 | |
| 
 | |
| 
 | |
|   function thlcgllvm.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;
 | |
|     var
 | |
|       callparas: tfplist;
 | |
|       llvmretdef,
 | |
|       hlretdef: tdef;
 | |
|       res: tregister;
 | |
|     begin
 | |
|       a_call_common(list,pd,paras,forceresdef,res,hlretdef,llvmretdef,callparas);
 | |
|       list.concat(taillvm.call_size_name_paras(get_call_pd(pd),res,llvmretdef,current_asmdata.RefAsmSymbol(pd.mangledname),callparas));
 | |
|       result:=get_call_result_cgpara(pd,forceresdef);
 | |
|       set_call_function_result(list,pd,llvmretdef,hlretdef,res,result);
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   function thlcgllvm.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara;
 | |
|     var
 | |
|       callparas: tfplist;
 | |
|       llvmretdef,
 | |
|       hlretdef: tdef;
 | |
|       res: tregister;
 | |
|     begin
 | |
|       a_call_common(list,pd,paras,nil,res,hlretdef,llvmretdef,callparas);
 | |
|       list.concat(taillvm.call_size_reg_paras(get_call_pd(pd),res,llvmretdef,reg,callparas));
 | |
|       result:=get_call_result_cgpara(pd,nil);
 | |
|       set_call_function_result(list,pd,llvmretdef,hlretdef,res,result);
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.a_load_const_reg(list: TAsmList; tosize: tdef; a: tcgint; register: tregister);
 | |
|     begin
 | |
|       list.concat(taillvm.op_reg_size_const_size(llvmconvop(ptrsinttype,tosize),register,ptrsinttype,a,tosize))
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.a_load_const_ref(list: TAsmList; tosize: tdef; a: tcgint; const ref: treference);
 | |
|     var
 | |
|       sref: treference;
 | |
|     begin
 | |
|       { llvm instructions do not support pointer constants -> only directly
 | |
|         encode for integers; a_load_const_reg() handles pointers properly }
 | |
|       if is_ordinal(tosize) or
 | |
|          is_64bit(tosize) then
 | |
|         begin
 | |
|           sref:=make_simple_ref(list,ref,tosize);
 | |
|           list.concat(taillvm.op_size_const_size_ref(la_store,tosize,a,cpointerdef.getreusable(tosize),sref))
 | |
|         end
 | |
|       else
 | |
|         inherited;
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   function def2intdef(fromsize, tosize: tdef): tdef;
 | |
|     begin
 | |
|       { we cannot zero-extend from/to anything but ordinal/enum
 | |
|         types }
 | |
|       if not(tosize.typ in [orddef,enumdef]) then
 | |
|         internalerror(2014012305);
 | |
|       { will give an internalerror if def_cgsize() returns OS_NO, which is
 | |
|         what we want }
 | |
|       result:=cgsize_orddef(def_cgsize(fromsize));
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.a_load_reg_ref(list: TAsmList; fromsize, tosize: tdef; register: tregister; const ref: treference);
 | |
|     var
 | |
|       tmpref,
 | |
|       sref: treference;
 | |
|       hreg,
 | |
|       hreg2: tregister;
 | |
|       tmpsize: tdef;
 | |
|     begin
 | |
|       sref:=make_simple_ref(list,ref,tosize);
 | |
|       hreg:=register;
 | |
|       (* typecast the pointer to the value instead of the value itself if
 | |
|         they have the same size but are of different kinds, because we can't
 | |
|         e.g. typecast a loaded <{i32, i32}> to an i64 *)
 | |
|       if (llvmaggregatetype(fromsize) or
 | |
|           llvmaggregatetype(tosize)) and
 | |
|          (fromsize<>tosize) then
 | |
|         begin
 | |
|           if fromsize.size>tosize.size then
 | |
|             begin
 | |
|               { if source size is larger than the target size, we have to
 | |
|                 truncate it before storing. Unfortunately, we cannot truncate
 | |
|                 records (nor bitcast them to integers), so we first have to
 | |
|                 store them to memory and then bitcast the pointer to them
 | |
| 
 | |
|                 We can't truncate an integer to 3/5/6/7 bytes either, so also
 | |
|                 pass via a temp in that case
 | |
|               }
 | |
|               if (fromsize.typ in [arraydef,recorddef]) or
 | |
|                  (tosize.size in [3,5,6,7]) then
 | |
|                 begin
 | |
|                   { store struct/array-in-register to memory }
 | |
|                   tg.gethltemp(list,fromsize,fromsize.size,tt_normal,tmpref);
 | |
|                   a_load_reg_ref(list,fromsize,fromsize,register,tmpref);
 | |
|                   { typecast pointer to memory into pointer to integer type }
 | |
|                   hreg:=getaddressregister(list,cpointerdef.getreusable(tosize));
 | |
|                   a_loadaddr_ref_reg(list,fromsize,cpointerdef.getreusable(tosize),tmpref,hreg);
 | |
|                   reference_reset_base(sref,cpointerdef.getreusable(tosize),hreg,0,tmpref.alignment);
 | |
|                   { load the integer from the temp into the destination }
 | |
|                   a_load_ref_ref(list,tosize,tosize,sref,ref);
 | |
|                   tg.ungettemp(list,tmpref);
 | |
|                 end
 | |
|               else
 | |
|                 begin
 | |
|                   tmpsize:=def2intdef(tosize,fromsize);
 | |
|                   hreg:=getintregister(list,tmpsize);
 | |
|                   { truncate the integer }
 | |
|                   a_load_reg_reg(list,fromsize,tmpsize,register,hreg);
 | |
|                   { store it to memory (it will now be of the same size as the
 | |
|                     struct, and hence another path will be followed in this
 | |
|                     method) }
 | |
|                   a_load_reg_ref(list,tmpsize,tosize,hreg,sref);
 | |
|                 end;
 | |
|                 exit;
 | |
|             end
 | |
|           else
 | |
|             begin
 | |
|               hreg2:=getaddressregister(list,cpointerdef.getreusable(fromsize));
 | |
|               a_loadaddr_ref_reg(list,tosize,cpointerdef.getreusable(fromsize),sref,hreg2);
 | |
|               reference_reset_base(sref,cpointerdef.getreusable(fromsize),hreg2,0,sref.alignment);
 | |
|               tosize:=fromsize;
 | |
|             end;
 | |
|         end
 | |
|       else if fromsize<>tosize 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,cpointerdef.getreusable(tosize),sref));
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.a_load_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister);
 | |
|     var
 | |
|       op: tllvmop;
 | |
|       tmpreg: tregister;
 | |
|       tmpintdef: tdef;
 | |
|     begin
 | |
|       op:=llvmconvop(fromsize,tosize);
 | |
|       { converting from pointer to something else and vice versa is only
 | |
|         possible via an intermediate pass to integer. Same for "something else"
 | |
|         to pointer. }
 | |
|       case op of
 | |
|         la_ptrtoint_to_x,
 | |
|         la_x_to_inttoptr:
 | |
|           begin
 | |
|             { convert via an integer with the same size as "x" }
 | |
|             if op=la_ptrtoint_to_x then
 | |
|               begin
 | |
|                 tmpintdef:=cgsize_orddef(def_cgsize(tosize));
 | |
|                 op:=la_bitcast
 | |
|               end
 | |
|             else
 | |
|               begin
 | |
|                 tmpintdef:=cgsize_orddef(def_cgsize(fromsize));
 | |
|                 op:=la_inttoptr;
 | |
|               end;
 | |
|             tmpreg:=getintregister(list,tmpintdef);
 | |
|             a_load_reg_reg(list,fromsize,tmpintdef,reg1,tmpreg);
 | |
|             reg1:=tmpreg;
 | |
|             fromsize:=tmpintdef;
 | |
|           end;
 | |
|       end;
 | |
|       { 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
 | |
|       tmpref,
 | |
|       sref: treference;
 | |
|       hreg: tregister;
 | |
|       tmpsize: tdef;
 | |
|     begin
 | |
|       sref:=make_simple_ref(list,ref,fromsize);
 | |
|       { "named register"? }
 | |
|       if sref.refaddr=addr_full then
 | |
|         begin
 | |
|           { can't bitcast records/arrays }
 | |
|           if (llvmaggregatetype(fromsize) or
 | |
|               llvmaggregatetype(tosize)) and
 | |
|              (fromsize<>tosize) then
 | |
|             begin
 | |
|               tg.gethltemp(list,fromsize,fromsize.size,tt_normal,tmpref);
 | |
|               list.concat(taillvm.op_size_ref_size_ref(la_store,fromsize,sref,cpointerdef.getreusable(fromsize),tmpref));
 | |
|               a_load_ref_reg(list,fromsize,tosize,tmpref,register);
 | |
|               tg.ungettemp(list,tmpref);
 | |
|             end
 | |
|           else
 | |
|             list.concat(taillvm.op_reg_size_ref_size(llvmconvop(fromsize,tosize),register,fromsize,sref,tosize))
 | |
|         end
 | |
|       else
 | |
|         begin
 | |
|           if ((fromsize.typ in [arraydef,recorddef]) or
 | |
|               (tosize.typ in [arraydef,recorddef])) and
 | |
|              (fromsize<>tosize) then
 | |
|             begin
 | |
|               if fromsize.size<tosize.size then
 | |
|                 begin
 | |
|                   { if the target size is larger than the source size, we
 | |
|                     have to perform the zero-extension using an integer type
 | |
|                     (can't zero-extend a record/array) }
 | |
|                   if fromsize.typ in [arraydef,recorddef] then
 | |
|                     begin
 | |
|                       { typecast the pointer to the struct into a pointer to an
 | |
|                         integer of equal size }
 | |
|                       tmpsize:=def2intdef(fromsize,tosize);
 | |
|                       hreg:=getaddressregister(list,cpointerdef.getreusable(tmpsize));
 | |
|                       a_loadaddr_ref_reg(list,fromsize,cpointerdef.getreusable(tmpsize),sref,hreg);
 | |
|                       reference_reset_base(sref,cpointerdef.getreusable(tmpsize),hreg,0,sref.alignment);
 | |
|                       { load that integer }
 | |
|                       a_load_ref_reg(list,tmpsize,tosize,sref,register);
 | |
|                     end
 | |
|                   else
 | |
|                     begin
 | |
|                       { load the integer into an integer memory location with
 | |
|                         the same size as the struct (the integer should be
 | |
|                         unsigned, we don't want sign extensions here) }
 | |
|                       if is_signed(fromsize) then
 | |
|                         internalerror(2014012309);
 | |
|                       tmpsize:=def2intdef(tosize,fromsize);
 | |
|                       tg.gethltemp(list,tmpsize,tmpsize.size,tt_normal,tmpref);
 | |
|                       { typecast the struct-sized integer location into the
 | |
|                         struct type }
 | |
|                       a_load_ref_ref(list,fromsize,tmpsize,sref,tmpref);
 | |
|                       { load the struct in the register }
 | |
|                       a_load_ref_reg(list,tmpsize,tosize,tmpref,register);
 | |
|                       tg.ungettemp(list,tmpref);
 | |
|                     end;
 | |
|                   exit;
 | |
|                 end
 | |
|               else
 | |
|                 begin
 | |
|                   (* typecast the pointer to the value instead of the value
 | |
|                      itself if they have the same size but are of different
 | |
|                      kinds, because we can't e.g. typecast a loaded <{i32, i32}>
 | |
|                      to an i64 *)
 | |
|                   hreg:=getaddressregister(list,cpointerdef.getreusable(tosize));
 | |
|                   a_loadaddr_ref_reg(list,fromsize,cpointerdef.getreusable(tosize),sref,hreg);
 | |
|                   reference_reset_base(sref,cpointerdef.getreusable(tosize),hreg,0,sref.alignment);
 | |
|                   fromsize:=tosize;
 | |
|                 end;
 | |
|             end;
 | |
|           hreg:=register;
 | |
|           if fromsize<>tosize then
 | |
|             hreg:=getregisterfordef(list,fromsize);
 | |
|           list.concat(taillvm.op_reg_size_ref(la_load,hreg,cpointerdef.getreusable(fromsize),sref));
 | |
|           if hreg<>register then
 | |
|             a_load_reg_reg(list,fromsize,tosize,hreg,register);
 | |
|         end;
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.a_load_ref_ref(list: TAsmList; fromsize, tosize: tdef; const sref: treference; const dref: treference);
 | |
|     var
 | |
|       sdref: treference;
 | |
|     begin
 | |
|       if (fromsize=tosize) and
 | |
|          (sref.refaddr=addr_full) then
 | |
|         begin
 | |
|           sdref:=make_simple_ref(list,dref,tosize);
 | |
|           list.concat(taillvm.op_size_ref_size_ref(la_store,fromsize,sref,cpointerdef.getreusable(tosize),sdref));
 | |
|         end
 | |
|       else
 | |
|         inherited
 | |
|     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,cpointerdef.getreusable(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;
 | |
|       fallthroughlab, 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;
 | |
|             else
 | |
|               { avoid uninitialised warning }
 | |
|               internalerror(2015031504);
 | |
|             end;
 | |
|           current_asmdata.getjumplabel(falselab);
 | |
|           fallthroughlab:=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,fallthroughlab);
 | |
|           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);
 | |
|     var
 | |
|       pd: tprocdef;
 | |
|       sourcepara, destpara, sizepara, alignpara, volatilepara: tcgpara;
 | |
|       maxalign: longint;
 | |
|     begin
 | |
|       { perform small copies directly; not larger ones, because then llvm
 | |
|         will try to load the entire large datastructure into registers and
 | |
|         starts spilling like crazy; too small copies must not be done via
 | |
|         llvm.memcpy either, because then you get crashes in llvm }
 | |
|       if (size.typ in [orddef,floatdef,enumdef]) or
 | |
|          (size.size<=2*sizeof(aint)) then
 | |
|         begin
 | |
|           a_load_ref_ref(list,size,size,source,dest);
 | |
|           exit;
 | |
|         end;
 | |
|       pd:=search_system_proc('llvm_memcpy64');
 | |
|       sourcepara.init;
 | |
|       destpara.init;
 | |
|       sizepara.init;
 | |
|       alignpara.init;
 | |
|       volatilepara.init;
 | |
|       paramanager.getintparaloc(list,pd,1,sourcepara);
 | |
|       paramanager.getintparaloc(list,pd,2,destpara);
 | |
|       paramanager.getintparaloc(list,pd,3,sizepara);
 | |
|       paramanager.getintparaloc(list,pd,4,alignpara);
 | |
|       paramanager.getintparaloc(list,pd,5,volatilepara);
 | |
|       a_loadaddr_ref_cgpara(list,size,source,sourcepara);
 | |
|       a_loadaddr_ref_cgpara(list,size,dest,destpara);
 | |
|       a_load_const_cgpara(list,u64inttype,size.size,sizepara);
 | |
|       maxalign:=newalignment(source.alignment,dest.alignment);
 | |
|       a_load_const_cgpara(list,u32inttype,maxalign,alignpara);
 | |
|       { we don't know anything about volatility here, should become an extra
 | |
|         parameter to g_concatcopy }
 | |
|       a_load_const_cgpara(list,pasbool8type,0,volatilepara);
 | |
|       g_call_system_proc(list,pd,[@sourcepara,@destpara,@sizepara,@alignpara,@volatilepara],nil).resetiftemp;
 | |
|       sourcepara.done;
 | |
|       destpara.done;
 | |
|       sizepara.done;
 | |
|       alignpara.done;
 | |
|       volatilepara.done;
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister);
 | |
|     var
 | |
|        tmpreg: tregister;
 | |
|        href: treference;
 | |
|        fromcompcurr,
 | |
|        tocompcurr: boolean;
 | |
|      begin
 | |
|        { named register -> use generic code }
 | |
|        if ref.refaddr=addr_full then
 | |
|          begin
 | |
|            a_load_ref_reg(list,fromsize,tosize,ref,reg);
 | |
|            exit
 | |
|          end;
 | |
|        { comp and currency are handled by the x87 in this case. They cannot
 | |
|          be represented directly in llvm, and llvmdef translates them into i64
 | |
|          (since that's their storage size and internally they also are int64).
 | |
|          Solve this by changing the type to s80real once they are loaded into
 | |
|          a register. }
 | |
|        fromcompcurr:=tfloatdef(fromsize).floattype in [s64comp,s64currency];
 | |
|        tocompcurr:=tfloatdef(tosize).floattype in [s64comp,s64currency];
 | |
|        if tocompcurr then
 | |
|          tosize:=s80floattype;
 | |
|        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) then
 | |
|          tmpreg:=getfpuregister(list,fromsize)
 | |
|        else
 | |
|          tmpreg:=reg;
 | |
|        { %tmpreg = load size* %ref }
 | |
|        list.concat(taillvm.op_reg_size_ref(la_load,tmpreg,cpointerdef.getreusable(fromsize),href));
 | |
|        if tmpreg<>reg then
 | |
|          if fromcompcurr then
 | |
|            { treat as extended as long as it's in a register }
 | |
|            list.concat(taillvm.op_reg_size_reg_size(la_sitofp,reg,fromsize,tmpreg,tosize))
 | |
|          else
 | |
|            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;
 | |
|        fromcompcurr,
 | |
|        tocompcurr: boolean;
 | |
|      begin
 | |
|        { see comment in a_loadfpu_ref_reg }
 | |
|        fromcompcurr:=tfloatdef(fromsize).floattype in [s64comp,s64currency];
 | |
|        tocompcurr:=tfloatdef(tosize).floattype in [s64comp,s64currency];
 | |
|        if fromcompcurr then
 | |
|          fromsize:=s80floattype;
 | |
|        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) then
 | |
|          begin
 | |
|            tmpreg:=getfpuregister(list,tosize);
 | |
|            if tocompcurr then
 | |
|              { store back an int64 rather than an extended }
 | |
|              list.concat(taillvm.op_reg_size_reg_size(la_fptosi,tmpreg,fromsize,reg,tosize))
 | |
|            else
 | |
|              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,cpointerdef.getreusable(tosize),href));
 | |
|      end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister);
 | |
|     var
 | |
|       op: tllvmop;
 | |
|       intfromsize,
 | |
|       inttosize: longint;
 | |
|     begin
 | |
|       { treat comp and currency as extended in registers (see comment at start
 | |
|         of a_loadfpu_ref_reg) }
 | |
|       if tfloatdef(fromsize).floattype in [s64comp,s64currency] then
 | |
|         fromsize:=sc80floattype;
 | |
|       if tfloatdef(tosize).floattype in [s64comp,s64currency] then
 | |
|         tosize:=sc80floattype;
 | |
|       { 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;
 | |
| 
 | |
|       if intfromsize<inttosize then
 | |
|         op:=la_fpext
 | |
|        else if intfromsize>inttosize then
 | |
|         op:=la_fptrunc
 | |
|       else
 | |
|         op:=la_bitcast;
 | |
|       { 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;
 | |
|       asmsym: tasmsymbol;
 | |
|     begin
 | |
|       if po_external in current_procinfo.procdef.procoptions then
 | |
|         exit;
 | |
|       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
 | |
|         asmsym:=current_asmdata.DefineAsmSymbol(mangledname,AB_GLOBAL,AT_FUNCTION)
 | |
|       else
 | |
|         asmsym:=current_asmdata.DefineAsmSymbol(mangledname,AB_LOCAL,AT_FUNCTION);
 | |
|       while assigned(item) do
 | |
|         begin
 | |
|           if mangledname<>item.Str then
 | |
|             list.concat(taillvmalias.create(asmsym,item.str,current_procinfo.procdef,llv_default,lll_default));
 | |
|           item:=TCmdStrListItem(item.next);
 | |
|         end;
 | |
|       list.concat(taillvmdecl.createdef(asmsym,current_procinfo.procdef,nil,sec_code,current_procinfo.procdef.alignment));
 | |
|     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.handle_external_proc(list: TAsmList; pd: tprocdef; const importname: TSymStr);
 | |
|     begin
 | |
|       { don't do anything, because at this point we can't know yet for certain
 | |
|         whether the aliased routine is internal to the current routine or not.
 | |
|         If it's internal, we would have to generate an llvm alias, while if it's
 | |
|         external, we would have to generate a declaration. Additionally, aliases
 | |
|         cannot refer to declarations, so always creating aliases doesn't work
 | |
|         either -> handle in llvmtype }
 | |
|     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;
 | |
|       retreg,
 | |
|       hreg: tregister;
 | |
|       retpara: tcgpara;
 | |
|     begin
 | |
|       { the function result type is the type of the first location, which can
 | |
|         differ from the real result type (e.g. int64 for a record consisting of
 | |
|         two longint fields on x86-64 -- we are responsible for lowering the
 | |
|         result types like that) }
 | |
|       retpara:=get_call_result_cgpara(current_procinfo.procdef,nil);
 | |
|       retpara.check_simple_location;
 | |
|       retdef:=retpara.location^.def;
 | |
|       if is_void(retdef) or
 | |
|          { don't check retdef here, it is e.g. a pshortstring in case it's
 | |
|            shortstring that's returned in a parameter }
 | |
|          paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then
 | |
|         list.concat(taillvm.op_size(la_ret,voidtype))
 | |
|       else
 | |
|         begin
 | |
|           case retpara.location^.loc of
 | |
|             LOC_REGISTER,
 | |
|             LOC_FPUREGISTER,
 | |
|             LOC_MMREGISTER:
 | |
|               begin
 | |
|                 { sign/zeroextension of function results is handled implicitly
 | |
|                   via the signext/zeroext modifiers of the result, rather than
 | |
|                   in the code generator -> remove any explicit extensions here }
 | |
|                 retreg:=retpara.location^.register;
 | |
|                 if (current_procinfo.procdef.returndef.typ in [orddef,enumdef]) and
 | |
|                    (retdef.typ in [orddef,enumdef]) then
 | |
|                   begin
 | |
|                     if (current_procinfo.procdef.returndef.size<retpara.location^.def.size) then
 | |
|                       begin
 | |
|                         hreg:=getintregister(list,current_procinfo.procdef.returndef);
 | |
|                         a_load_reg_reg(list,retdef,current_procinfo.procdef.returndef,retreg,hreg);
 | |
|                         retreg:=hreg;
 | |
|                         retdef:=current_procinfo.procdef.returndef;
 | |
|                       end;
 | |
|                    end;
 | |
|                 list.concat(taillvm.op_size_reg(la_ret,retdef,retreg))
 | |
|               end
 | |
|             else
 | |
|               { todo: complex returns }
 | |
|               internalerror(2012111106);
 | |
|           end;
 | |
|         end;
 | |
|       retpara.resetiftemp;
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara);
 | |
|     begin
 | |
|       if not paramanager.ret_in_param(resdef,pd) then
 | |
|         begin
 | |
|           case resloc.location^.loc of
 | |
|             LOC_REGISTER,
 | |
|             LOC_FPUREGISTER,
 | |
|             LOC_MMREGISTER:
 | |
|               begin
 | |
|                 resloc.check_simple_location;
 | |
|                 list.concat(taillvm.op_reg_size_undef(la_bitcast,resloc.location^.register,resloc.location^.def));
 | |
|               end;
 | |
|             else
 | |
|               internalerror(2015042301);
 | |
|           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.g_ptrtypecast_reg(list: TAsmList; fromdef, todef: tdef; var reg: tregister);
 | |
|     var
 | |
|       hreg: tregister;
 | |
|     begin
 | |
|       { will insert a bitcast if necessary }
 | |
|       if fromdef<>todef then
 | |
|         begin
 | |
|           hreg:=getregisterfordef(list,todef);
 | |
|           a_load_reg_reg(list,fromdef,todef,reg,hreg);
 | |
|           reg:=hreg;
 | |
|         end;
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.g_ptrtypecast_ref(list: TAsmList; fromdef: tpointerdef; todef: tdef; var ref: treference);
 | |
|     var
 | |
|       sref: treference;
 | |
|       hreg: tregister;
 | |
|     begin
 | |
|       hreg:=getaddressregister(list,todef);
 | |
|       a_loadaddr_ref_reg(list,fromdef.pointeddef,todef,ref,hreg);
 | |
|       reference_reset_base(ref,todef,hreg,0,ref.alignment);
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.g_set_addr_nonbitpacked_field_ref(list: TAsmList; recdef: tabstractrecorddef; field: tfieldvarsym; var recref: treference);
 | |
|     var
 | |
|       parentdef,
 | |
|       subscriptdef,
 | |
|       currentstructdef,
 | |
|       llvmfielddef: tdef;
 | |
|       newbase: tregister;
 | |
|       implicitpointer: boolean;
 | |
|     begin
 | |
|       implicitpointer:=is_implicit_pointer_object_type(recdef);
 | |
|       currentstructdef:=recdef;
 | |
|       { in case the field is part of a parent of the current object,
 | |
|         index into the parents until we're at the parent containing the
 | |
|         field; if it's an implicit pointer type, these embedded parents
 | |
|         will be of the structure type of the class rather than of the
 | |
|         class time itself -> one indirection fewer }
 | |
|       while field.owner<>tabstractrecorddef(currentstructdef).symtable do
 | |
|         begin
 | |
|           { only objectdefs have parents and hence the owner of the
 | |
|             fieldvarsym can be different from the current def's owner }
 | |
|           parentdef:=tobjectdef(currentstructdef).childof;
 | |
|           if implicitpointer then
 | |
|             newbase:=getaddressregister(list,parentdef)
 | |
|           else
 | |
|             newbase:=getaddressregister(list,cpointerdef.getreusable(parentdef));
 | |
|           recref:=make_simple_ref(list,recref,recdef);
 | |
|           if implicitpointer then
 | |
|             subscriptdef:=currentstructdef
 | |
|           else
 | |
|             subscriptdef:=cpointerdef.getreusable(currentstructdef);
 | |
|           { recurse into the first field }
 | |
|           list.concat(taillvm.getelementptr_reg_size_ref_size_const(newbase,subscriptdef,recref,s32inttype,0,true));
 | |
|           reference_reset_base(recref,subscriptdef,newbase,field.offsetfromllvmfield,newalignment(recref.alignment,field.fieldoffset));
 | |
|           { go to the parent }
 | |
|           currentstructdef:=parentdef;
 | |
|         end;
 | |
|       { get the type of the corresponding field in the llvm shadow
 | |
|         definition }
 | |
|       llvmfielddef:=tabstractrecordsymtable(tabstractrecorddef(currentstructdef).symtable).llvmst[field].def;
 | |
|       if implicitpointer then
 | |
|         subscriptdef:=currentstructdef
 | |
|       else
 | |
|         subscriptdef:=cpointerdef.getreusable(currentstructdef);
 | |
|       { load the address of that shadow field }
 | |
|       newbase:=getaddressregister(list,cpointerdef.getreusable(llvmfielddef));
 | |
|       recref:=make_simple_ref(list,recref,recdef);
 | |
|       list.concat(taillvm.getelementptr_reg_size_ref_size_const(newbase,subscriptdef,recref,s32inttype,field.llvmfieldnr,true));
 | |
|       reference_reset_base(recref,subscriptdef,newbase,field.offsetfromllvmfield,newalignment(recref.alignment,field.fieldoffset+field.offsetfromllvmfield));
 | |
|       { in case of an 80 bits extended type, typecast from an array of 10
 | |
|         bytes (used because otherwise llvm will allocate the ABI-defined
 | |
|         size for extended, which is usually larger) into an extended }
 | |
|       if (llvmfielddef.typ=floatdef) and
 | |
|          (tfloatdef(llvmfielddef).floattype=s80real) then
 | |
|         g_ptrtypecast_ref(list,cpointerdef.getreusable(carraydef.getreusable(u8inttype,10)),cpointerdef.getreusable(s80floattype),recref);
 | |
|       { if it doesn't match the requested field exactly (variant record),
 | |
|         adjust the type of the pointer }
 | |
|       if (field.offsetfromllvmfield<>0) or
 | |
|          (llvmfielddef<>field.vardef) then
 | |
|         g_ptrtypecast_ref(list,cpointerdef.getreusable(llvmfielddef),cpointerdef.getreusable(field.vardef),recref);
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle);
 | |
|     var
 | |
|       href: treference;
 | |
|     begin
 | |
|       { named register -> use generic code }
 | |
|       if ref.refaddr=addr_full then
 | |
|         a_load_ref_reg(list,fromsize,tosize,ref,reg)
 | |
|       else 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,cpointerdef.getreusable(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,cpointerdef.getreusable(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;
 | |
| 
 | |
| 
 | |
|   function thlcgllvm.get_call_result_cgpara(pd: tabstractprocdef; forceresdef: tdef): tcgpara;
 | |
|     var
 | |
|       paraloc: pcgparalocation;
 | |
|     begin
 | |
|       result:=inherited;
 | |
|       { we'll change the paraloc, make sure we don't modify the original one }
 | |
|       if not result.temporary then
 | |
|         begin
 | |
|           result:=result.getcopy;
 | |
|           result.temporary:=true;
 | |
|         end;
 | |
|       { get the LLVM representation of the function result (e.g. a
 | |
|         struct with two i64 fields for a record with 4 i32 fields) }
 | |
|       result.def:=llvmgetcgparadef(result,true);
 | |
|       if assigned(result.location^.next) then
 | |
|         begin
 | |
|           { unify the result into a sinlge location; unlike for parameters,
 | |
|             we are not responsible for splitting up results into multiple
 | |
|             locations }
 | |
|           { set the first location to the type of the function result }
 | |
|           result.location^.def:=result.def;
 | |
|           result.location^.size:=result.size;
 | |
|           { free all extra paralocs }
 | |
|           while assigned(result.location^.next) do
 | |
|             begin
 | |
|               paraloc:=result.location^.next^.next;
 | |
|               freemem(result.location^.next);
 | |
|               result.location^.next:=paraloc;
 | |
|             end;
 | |
|         end;
 | |
|       paraloc:=result.location;
 | |
|       paraloc^.def:=result.def;
 | |
|       case paraloc^.loc of
 | |
|         LOC_VOID:
 | |
|           ;
 | |
|         LOC_REGISTER,
 | |
|         LOC_FPUREGISTER,
 | |
|         LOC_MMREGISTER:
 | |
|           begin
 | |
|             paraloc^.llvmloc.loc:=paraloc^.loc;
 | |
|             paraloc^.llvmloc.reg:=paraloc^.register;
 | |
|             paraloc^.llvmvalueloc:=true;
 | |
|           end;
 | |
|         LOC_REFERENCE:
 | |
|           if not paramanager.ret_in_param(pd.returndef,pd) then
 | |
|             { TODO, if this can happen at all }
 | |
|             internalerror(2014011901);
 | |
|         else
 | |
|           internalerror(2014011902);
 | |
|       end;
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.gen_load_loc_function_result(list: TAsmList; vardef: tdef; const l: tlocation);
 | |
|     begin
 | |
|       gen_load_loc_cgpara(list,vardef,l,get_call_result_cgpara(current_procinfo.procdef,nil));
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.gen_load_loc_cgpara(list: TAsmList; vardef: tdef; const l: tlocation; const cgpara: tcgpara);
 | |
|     var
 | |
|       memloc: tlocation;
 | |
|     begin
 | |
|       if not(cgpara.location^.llvmvalueloc) then
 | |
|         begin
 | |
|           memloc:=l;
 | |
|           location_force_mem(list,memloc,vardef);
 | |
|           a_loadaddr_ref_cgpara(list,vardef,memloc.reference,cgpara);
 | |
|         end
 | |
|       else
 | |
|         inherited;
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean);
 | |
|     var
 | |
|       ploc        : pcgparalocation;
 | |
|       hloc        : tlocation;
 | |
|       href, href2 : treference;
 | |
|       hreg        : tregister;
 | |
|       llvmparadef : tdef;
 | |
|       index       : longint;
 | |
|       offset      : pint;
 | |
|       userecord   : boolean;
 | |
|     begin
 | |
|       { ignore e.g. empty records }
 | |
|       if (para.location^.loc=LOC_VOID) then
 | |
|         exit;
 | |
|       { If the parameter location is reused we don't need to copy
 | |
|         anything }
 | |
|       if (destloc.loc=LOC_REFERENCE) and
 | |
|          reusepara then
 | |
|         exit;
 | |
|       { get the equivalent llvm def used to pass the parameter (e.g. a record
 | |
|         with two int64 fields for passing a record consisiting of 8 bytes on
 | |
|         x86-64) }
 | |
|       llvmparadef:=llvmgetcgparadef(para,true);
 | |
|       userecord:=
 | |
|         (llvmparadef<>para.def) and
 | |
|         assigned(para.location^.next);
 | |
|       if userecord then
 | |
|         begin
 | |
|           { llvmparadef is a record in this case, with every field corresponding
 | |
|             to a single paraloc }
 | |
|           if destloc.loc<>LOC_REFERENCE then
 | |
|             tg.gethltemp(list,llvmparadef,llvmparadef.size,tt_normal,href)
 | |
|           else
 | |
|             begin
 | |
|               hreg:=getaddressregister(list,cpointerdef.getreusable(llvmparadef));
 | |
|               a_loadaddr_ref_reg(list,vardef,cpointerdef.getreusable(llvmparadef),destloc.reference,hreg);
 | |
|               reference_reset_base(href,cpointerdef.getreusable(llvmparadef),hreg,0,destloc.reference.alignment);
 | |
|             end;
 | |
|           index:=0;
 | |
|           offset:=0;
 | |
|           ploc:=para.location;
 | |
|           repeat
 | |
|             paraloctoloc(ploc,hloc);
 | |
|             hreg:=getaddressregister(list,cpointerdef.getreusable(ploc^.def));
 | |
|             list.concat(taillvm.getelementptr_reg_size_ref_size_const(hreg,cpointerdef.getreusable(llvmparadef),href,s32inttype,index,true));
 | |
|             reference_reset_base(href2,cpointerdef.getreusable(ploc^.def),hreg,0,newalignment(href.alignment,offset));
 | |
|             a_load_loc_ref(list,ploc^.def,ploc^.def,hloc,href2);
 | |
|             inc(offset,ploc^.def.size);
 | |
|             inc(index);
 | |
|             ploc:=ploc^.next;
 | |
|           until not assigned(ploc);
 | |
|           if destloc.loc<>LOC_REFERENCE then
 | |
|             tg.ungettemp(list,href);
 | |
|         end
 | |
|       else
 | |
|         begin
 | |
|           para.check_simple_location;
 | |
|           paraloctoloc(para.location,hloc);
 | |
|           case destloc.loc of
 | |
|             LOC_REFERENCE :
 | |
|               begin
 | |
|                 case def2regtyp(llvmparadef) of
 | |
|                   R_INTREGISTER,
 | |
|                   R_ADDRESSREGISTER:
 | |
|                     a_load_loc_ref(list,llvmparadef,vardef,hloc,destloc.reference);
 | |
|                   R_FPUREGISTER:
 | |
|                     a_loadfpu_loc_ref(list,llvmparadef,vardef,hloc,destloc.reference);
 | |
|                   R_MMREGISTER:
 | |
|                     a_loadmm_loc_ref(list,llvmparadef,vardef,hloc,destloc.reference,nil);
 | |
|                   else
 | |
|                     internalerror(2014080801);
 | |
|                   end;
 | |
|               end;
 | |
|             LOC_REGISTER:
 | |
|               begin
 | |
|                 a_load_loc_reg(list,llvmparadef,vardef,hloc,destloc.register);
 | |
|               end;
 | |
|             LOC_FPUREGISTER:
 | |
|               begin
 | |
|                 a_loadfpu_loc_reg(list,llvmparadef,vardef,hloc,destloc.register);
 | |
|               end;
 | |
|             LOC_MMREGISTER:
 | |
|               begin
 | |
|                 a_loadmm_loc_reg(list,llvmparadef,vardef,hloc,destloc.register,nil);
 | |
|               end;
 | |
|             { TODO other possible locations }
 | |
|             else
 | |
|               internalerror(2013102304);
 | |
|           end;
 | |
|         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; srcsize, dstsize: 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
 | |
|       ptrindex: tcgint;
 | |
|       hreg1,
 | |
|       hreg2: tregister;
 | |
|       tmpref: treference;
 | |
|       defsize: asizeint;
 | |
|     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;
 | |
| 
 | |
|       hreg2:=getaddressregister(list,cpointerdef.getreusable(def));
 | |
|       defsize:=def.size;
 | |
|       { for voiddef/formaldef }
 | |
|       if defsize=0 then
 | |
|         defsize:=1;
 | |
|       { symbol+offset or base+offset with offset a multiple of the size ->
 | |
|         use getelementptr }
 | |
|       if (ref.index=NR_NO) and
 | |
|          (ref.offset mod defsize=0) then
 | |
|         begin
 | |
|           ptrindex:=ref.offset div defsize;
 | |
|           if assigned(ref.symbol) then
 | |
|             reference_reset_symbol(tmpref,ref.symbol,0,ref.alignment)
 | |
|           else
 | |
|             reference_reset_base(tmpref,cpointerdef.getreusable(def),ref.base,0,ref.alignment);
 | |
|           list.concat(taillvm.getelementptr_reg_size_ref_size_const(hreg2,cpointerdef.getreusable(def),tmpref,ptruinttype,ptrindex,assigned(ref.symbol)));
 | |
|           reference_reset_base(result,cpointerdef.getreusable(def),hreg2,0,ref.alignment);
 | |
|           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,cpointerdef.getreusable(def),tmpref,ptruinttype,0,true));
 | |
|         end
 | |
|       else if ref.base<>NR_NO then
 | |
|         begin
 | |
|           a_load_reg_reg(list,cpointerdef.getreusable(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,cpointerdef.getreusable(def));
 | |
|       a_load_reg_reg(list,ptruinttype,cpointerdef.getreusable(def),hreg1,hreg2);
 | |
|       reference_reset_base(result,cpointerdef.getreusable(def),hreg2,0,ref.alignment);
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.set_call_function_result(const list: TAsmList; const pd: tabstractprocdef; const llvmretdef, hlretdef: tdef; const resval: tregister; var retpara: tcgpara);
 | |
|     var
 | |
|       hreg: tregister;
 | |
|       rettemp: treference;
 | |
|     begin
 | |
|       if not is_void(hlretdef) and
 | |
|          not paramanager.ret_in_param(hlretdef, pd) then
 | |
|         begin
 | |
|           { should already be a copy, because it currently describes the llvm
 | |
|             return location }
 | |
|           if not retpara.temporary then
 | |
|             internalerror(2014020101);
 | |
|           if llvmaggregatetype(hlretdef) then
 | |
|             begin
 | |
|               { to ease the handling of aggregate types here, we just store
 | |
|                 everything to memory rather than potentially dealing with aggregates
 | |
|                 in "registers" }
 | |
|               tg.gethltemp(list, hlretdef, hlretdef.size, tt_normal, rettemp);
 | |
|               case def2regtyp(llvmretdef) of
 | |
|                 R_INTREGISTER,
 | |
|                 R_ADDRESSREGISTER:
 | |
|                   a_load_reg_ref(list,llvmretdef,hlretdef,resval,rettemp);
 | |
|                 R_FPUREGISTER:
 | |
|                   a_loadfpu_reg_ref(list,llvmretdef,hlretdef,resval,rettemp);
 | |
|                 R_MMREGISTER:
 | |
|                   a_loadmm_reg_ref(list,llvmretdef,hlretdef,resval,rettemp,mms_movescalar);
 | |
|               end;
 | |
|               { the return parameter now contains a value whose type matches the one
 | |
|                 that the high level code generator expects instead of the llvm shim
 | |
|               }
 | |
|               retpara.def:=hlretdef;
 | |
|               retpara.location^.def:=hlretdef;
 | |
|               { for llvm-specific code:  }
 | |
|               retpara.location^.llvmvalueloc:=false;
 | |
|               retpara.location^.llvmloc.loc:=LOC_REGISTER;
 | |
|               retpara.location^.llvmloc.reg:=rettemp.base;
 | |
|               { for the rest (normally not used, but cleaner to set it correclty) }
 | |
|               retpara.location^.loc:=LOC_REFERENCE;
 | |
|               retpara.location^.reference.index:=rettemp.base;
 | |
|               retpara.location^.reference.offset:=0;
 | |
|             end
 | |
|           else
 | |
|             begin
 | |
|               if llvmretdef<>hlretdef then
 | |
|                 begin
 | |
|                   hreg:=getregisterfordef(list,hlretdef);
 | |
|                   case def2regtyp(llvmretdef) of
 | |
|                     R_INTREGISTER,
 | |
|                     R_ADDRESSREGISTER:
 | |
|                       a_load_reg_reg(list,llvmretdef,hlretdef,resval,hreg);
 | |
|                     R_FPUREGISTER:
 | |
|                       a_loadfpu_reg_reg(list,llvmretdef,hlretdef,resval,hreg);
 | |
|                     R_MMREGISTER:
 | |
|                       a_loadmm_reg_reg(list,llvmretdef,hlretdef,resval,hreg,mms_movescalar);
 | |
|                   end;
 | |
|                   retpara.location^.llvmloc.reg:=hreg
 | |
|                 end
 | |
|               else
 | |
|                 retpara.location^.llvmloc.reg:=resval;
 | |
|               retpara.Location^.llvmloc.loc:=retpara.location^.loc;
 | |
|               retpara.Location^.llvmvalueloc:=true;
 | |
|             end;
 | |
|         end
 | |
|       else
 | |
|         retpara.location^.llvmloc.loc:=LOC_VOID;
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.paraloctoloc(const paraloc: pcgparalocation; out hloc: tlocation);
 | |
|     begin
 | |
|       case paraloc^.llvmloc.loc of
 | |
|         LOC_REFERENCE:
 | |
|           begin
 | |
|             location_reset_ref(hloc,LOC_REFERENCE,def_cgsize(paraloc^.def),paraloc^.def.alignment);
 | |
|             hloc.reference.symbol:=paraloc^.llvmloc.sym;
 | |
|             if paraloc^.llvmvalueloc then
 | |
|               hloc.reference.refaddr:=addr_full;
 | |
|           end;
 | |
|         LOC_REGISTER:
 | |
|           begin
 | |
|             if paraloc^.llvmvalueloc then
 | |
|               begin
 | |
|                 location_reset(hloc,LOC_REGISTER,def_cgsize(paraloc^.def));
 | |
|                 hloc.register:=paraloc^.llvmloc.reg;
 | |
|               end
 | |
|             else
 | |
|               begin
 | |
|                 if getregtype(paraloc^.llvmloc.reg)<>R_TEMPREGISTER then
 | |
|                   internalerror(2014011903);
 | |
|                 location_reset_ref(hloc,LOC_REFERENCE,def_cgsize(paraloc^.def),paraloc^.def.alignment);
 | |
|                 hloc.reference.base:=paraloc^.llvmloc.reg;
 | |
|               end;
 | |
|           end;
 | |
|         LOC_FPUREGISTER,
 | |
|         LOC_MMREGISTER:
 | |
|           begin
 | |
|             if paraloc^.llvmvalueloc then
 | |
|               begin
 | |
|                 location_reset(hloc,paraloc^.llvmloc.loc,def_cgsize(paraloc^.def));
 | |
|                 hloc.register:=paraloc^.llvmloc.reg;
 | |
|               end
 | |
|             else
 | |
|               internalerror(2014012401);
 | |
|           end
 | |
|         else
 | |
|           internalerror(2014010706);
 | |
|       end;
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.varsym_set_localloc(list: TAsmList; vs: tabstractnormalvarsym);
 | |
|     begin
 | |
|       if cs_asm_source in current_settings.globalswitches then
 | |
|         begin
 | |
|           case vs.initialloc.loc of
 | |
|             LOC_REFERENCE :
 | |
|               begin
 | |
|                 if assigned(vs.initialloc.reference.symbol) then
 | |
|                   list.concat(Tai_comment.Create(strpnew('Var '+vs.realname+' located at '+
 | |
|                      vs.initialloc.reference.symbol.name)))
 | |
|                 else
 | |
|                   list.concat(Tai_comment.Create(strpnew('Var '+vs.realname+' located at %tmp.'+
 | |
|                      tostr(getsupreg(vs.initialloc.reference.base)))));
 | |
|               end;
 | |
|           end;
 | |
|         end;
 | |
|       vs.localloc:=vs.initialloc;
 | |
|       FillChar(vs.currentregloc,sizeof(vs.currentregloc),0);
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.paravarsym_set_initialloc_to_paraloc(vs: tparavarsym);
 | |
|     var
 | |
|       parasym : tasmsymbol;
 | |
|     begin
 | |
|       if vs.paraloc[calleeside].location^.llvmloc.loc<>LOC_REFERENCE then
 | |
|         internalerror(2014010708);
 | |
|       parasym:=vs.paraloc[calleeside].location^.llvmloc.sym;
 | |
|       reference_reset_symbol(vs.initialloc.reference,parasym,0,vs.paraloc[calleeside].alignment);
 | |
|       if vs.paraloc[calleeside].location^.llvmvalueloc then
 | |
|         vs.initialloc.reference.refaddr:=addr_full;
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure thlcgllvm.g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string);
 | |
|     var
 | |
|       asmsym: TAsmSymbol;
 | |
|     begin
 | |
|       if po_external in procdef.procoptions then
 | |
|         exit;
 | |
|       asmsym:=current_asmdata.RefAsmSymbol(externalname,AT_FUNCTION);
 | |
|       list.concat(taillvmalias.create(asmsym,procdef.mangledname,procdef,llv_default,lll_default));
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   procedure create_hlcodegen;
 | |
|     begin
 | |
|       if not assigned(current_procinfo) or
 | |
|          not(po_assembler in current_procinfo.procdef.procoptions) then
 | |
|         begin
 | |
|           tgobjclass:=ttgllvm;
 | |
|           hlcg:=thlcgllvm.create;
 | |
|           cgllvm.create_codegen
 | |
|         end
 | |
|       else
 | |
|         begin
 | |
|           tgobjclass:=orgtgclass;
 | |
|           hlcgcpu.create_hlcodegen;
 | |
|           { todo: handle/remove chlcgobj }
 | |
|         end;
 | |
|     end;
 | |
| 
 | |
| begin
 | |
|   chlcgobj:=thlcgllvm;
 | |
| end.
 | 
