mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-10 12:38:21 +02:00

Even though it's supposedly deprecated, clang also still uses it and without the declaration ranges of local variables are sometimes cut off
2329 lines
92 KiB
ObjectPascal
2329 lines
92 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 a_load_reg_cgpara(list: TAsmList; size: tdef; r: tregister; const cgpara: TCGPara); override;
|
|
procedure a_load_ref_cgpara(list: TAsmList; size: tdef; const r: treference; const cgpara: TCGPara); override;
|
|
procedure a_load_undefined_cgpara(list: TAsmList; size: tdef; const cgpara: TCGPara); override;
|
|
procedure a_load_const_cgpara(list: TAsmList; tosize: tdef; a: tcgint; 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 allocallcpuregisters(list: TAsmList); override;
|
|
procedure deallocallcpuregisters(list: TAsmList); override;
|
|
|
|
procedure recordnewsymloc(list: TAsmList; sym: tsym; def: tdef; const ref: treference; initial: boolean); override;
|
|
|
|
class function def2regtyp(def: tdef): tregistertype; override;
|
|
public
|
|
procedure a_bit_test_reg_reg_reg(list: TAsmList; bitnumbersize, valuesize, destsize: tdef; bitnumber, value, destreg: tregister); override;
|
|
procedure a_bit_set_reg_reg(list: TAsmList; doset: boolean; bitnumbersize, destsize: tdef; bitnumber, dest: tregister); 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;
|
|
|
|
protected
|
|
procedure gen_load_refaddrfull_anyreg(list: TAsmList; fromsize, tosize : tdef; const simpleref: treference; register: tregister; shuffle: pmmshuffle);
|
|
function handle_agg_load_ref_anyreg(list: TasmList; var fromsize, tosize: tdef; var simpleref: treference; register: tregister; shuffle: pmmshuffle): boolean;
|
|
public
|
|
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;
|
|
protected
|
|
procedure a_loadaddr_ref_reg_intern(list : TAsmList;fromsize, tosize : tdef;const ref : treference;r : tregister; makefromsizepointer: boolean);
|
|
public
|
|
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_unreachable(list: TAsmList); override;
|
|
|
|
procedure g_concatcopy(list : TAsmList;size: tdef; const source,dest : treference);override;
|
|
|
|
procedure g_undefined_ok(list: TAsmList; size: tdef; reg: tregister); 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;
|
|
protected
|
|
procedure gen_fpconstrained_intrinsic(list: TAsmList; const intrinsic: TIDString; fromsize, tosize: tdef; fromreg, toreg: tregister; roundingmode: boolean);
|
|
public
|
|
|
|
procedure gen_proc_symbol(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, 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 gen_stack_check_size_para(list: TAsmList); override;
|
|
procedure gen_stack_check_call(list: TAsmList); 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 wrappername, externalname: string; global: boolean); override;
|
|
|
|
{ def is a pointerdef or implicit pointer type (class, classref, procvar,
|
|
dynamic array, ...). }
|
|
function make_simple_ref_ptr(list: TAsmList; const ref: treference; ptrdef: tdef): treference;
|
|
{ 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;
|
|
|
|
implementation
|
|
|
|
uses
|
|
verbose,cutils,globals,fmodule,constexp,systems,
|
|
defutil,llvmdef,llvmsym,
|
|
aasmtai,aasmcpu,
|
|
aasmllvm,aasmllvmmetadata,llvmbase,llvminfo,tgllvm,
|
|
symtable,symllvm,
|
|
paramgr,
|
|
pass_2,procinfo,llvmpi,cpuinfo,cgobj,cgllvm,cghlcpu,
|
|
cgcpu,hlcgcpu;
|
|
|
|
var
|
|
create_hlcodegen_cpu: TProcedure = nil;
|
|
|
|
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.a_load_reg_cgpara(list: TAsmList; size: tdef; r: tregister; const cgpara: TCGPara);
|
|
begin
|
|
if size<>llvm_metadatatype then
|
|
begin
|
|
inherited;
|
|
exit;
|
|
end;
|
|
{ overwrite with the reference to the metadata (stored in the register's supreg) }
|
|
cgpara.location^.register:=r;
|
|
end;
|
|
|
|
|
|
procedure thlcgllvm.a_load_ref_cgpara(list: TAsmList; size: tdef; const r: treference; const cgpara: TCGPara);
|
|
var
|
|
tmpref, initialref, ref: treference;
|
|
fielddef,
|
|
orgsize: tdef;
|
|
location: pcgparalocation;
|
|
sizeleft,
|
|
totaloffset: asizeint;
|
|
paralocidx: longint;
|
|
userecord: boolean;
|
|
begin
|
|
location:=cgpara.location;
|
|
sizeleft:=cgpara.intsize;
|
|
totaloffset:=0;
|
|
orgsize:=size;
|
|
a_load_ref_cgpara_init_src(list,cgpara,r,size,initialref);
|
|
if initialref.refaddr=addr_full then
|
|
begin
|
|
cgpara.check_simple_location;
|
|
location^.llvmvalueloc:=true;
|
|
location^.llvmloc.loc:=LOC_REFERENCE;
|
|
location^.llvmloc.sym:=initialref.symbol;
|
|
exit;
|
|
end;
|
|
userecord:=
|
|
(orgsize<>size) and
|
|
assigned(cgpara.location^.next);
|
|
paralocidx:=0;
|
|
fielddef:=nil;
|
|
while assigned(location) do
|
|
begin
|
|
if userecord then
|
|
begin
|
|
{ llvmparadef is a record in this case, with every field
|
|
corresponding to a single paraloc (fielddef is unused, because
|
|
it will be equivalent to location^.def -- see below) }
|
|
g_setup_load_field_by_name(list,trecorddef(size),'F'+tostr(paralocidx),initialref,tmpref,fielddef);
|
|
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,fielddef,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(2010052901);
|
|
reference_reset_base(ref,cpointerdef.getreusable(size),location^.reference.index,location^.reference.offset,ctempposinvalid,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_32..OS_128,
|
|
{ OS_NO is for records of non-power-of-two sizes that have to
|
|
be passed in MM registers -> never scalar floats }
|
|
OS_NO:
|
|
a_loadmm_ref_reg(list,location^.def,location^.def,tmpref,location^.register,nil);
|
|
else
|
|
internalerror(2010053105);
|
|
end;
|
|
end
|
|
else
|
|
internalerror(2010053107);
|
|
end;
|
|
inc(totaloffset,tcgsize2size[location^.size]);
|
|
dec(sizeleft,tcgsize2size[location^.size]);
|
|
location:=location^.next;
|
|
inc(paralocidx);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure thlcgllvm.a_load_undefined_cgpara(list: TAsmList; size: tdef; const cgpara: TCGPara);
|
|
var
|
|
hreg: tregister;
|
|
begin
|
|
hreg:=getregisterfordef(list,size);
|
|
list.concat(taillvm.op_reg_size_undef(la_bitcast,hreg,size));
|
|
a_load_reg_cgpara(list,size,hreg,cgpara);
|
|
end;
|
|
|
|
|
|
procedure thlcgllvm.a_load_const_cgpara(list: TAsmList; tosize: tdef; a: tcgint; const cgpara: TCGPara);
|
|
begin
|
|
if is_ordinal(cgpara.def) then
|
|
begin
|
|
cgpara.check_simple_location;
|
|
paramanager.alloccgpara(list,cgpara);
|
|
if cgpara.location^.shiftval<0 then
|
|
a:=a shl -cgpara.location^.shiftval;
|
|
cgpara.location^.llvmloc.loc:=LOC_CONSTANT;
|
|
cgpara.location^.llvmloc.value:=a;
|
|
end
|
|
else
|
|
inherited;
|
|
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;
|
|
tmpref: treference;
|
|
begin
|
|
newrefsize:=llvmgetcgparadef(para,true,callerside);
|
|
if (refsize<>newrefsize) and
|
|
(initialref.refaddr<>addr_full) then
|
|
begin
|
|
if refsize.size>=newrefsize.size 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.temppos,initialref.alignment,initialref.volatility);
|
|
refsize:=newrefsize;
|
|
end
|
|
else
|
|
begin
|
|
tg.gethltemp(list,newrefsize,newrefsize.size,tt_normal,newref);
|
|
reg:=getaddressregister(list,cpointerdef.getreusable(refsize));
|
|
a_loadaddr_ref_reg(list,newrefsize,cpointerdef.getreusable(refsize),newref,reg);
|
|
reference_reset_base(tmpref,refsize,reg,0,newref.temppos,newref.alignment,initialref.volatility);
|
|
g_concatcopy(list,refsize,initialref,tmpref);
|
|
refsize:=newrefsize;
|
|
end;
|
|
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.allocallcpuregisters(list: TAsmList);
|
|
begin
|
|
{ don't do anything }
|
|
end;
|
|
|
|
|
|
procedure thlcgllvm.deallocallcpuregisters(list: TAsmList);
|
|
begin
|
|
{ don't do anything }
|
|
end;
|
|
|
|
|
|
procedure thlcgllvm.recordnewsymloc(list: TAsmList; sym: tsym; def: tdef; const ref: treference; initial: boolean);
|
|
var
|
|
varmetapara,
|
|
symmetadatapara,
|
|
exprmetapara: tcgpara;
|
|
pd: tprocdef;
|
|
begin
|
|
if assigned(sym) and
|
|
(sym.visibility<>vis_hidden) and
|
|
(cs_debuginfo in current_settings.moduleswitches) then
|
|
begin
|
|
if initial then
|
|
pd:=search_system_proc('llvm_dbg_declare')
|
|
else
|
|
pd:=search_system_proc('llvm_dbg_addr');
|
|
varmetapara.init;
|
|
symmetadatapara.init;
|
|
exprmetapara.init;
|
|
paramanager.getcgtempparaloc(current_asmdata.CurrAsmList,pd,1,varmetapara);
|
|
paramanager.getcgtempparaloc(current_asmdata.CurrAsmList,pd,1,symmetadatapara);
|
|
paramanager.getcgtempparaloc(current_asmdata.CurrAsmList,pd,1,exprmetapara);
|
|
{ the local location of the var/para }
|
|
varmetapara.Location^.def:=cpointerdef.getreusable(def);
|
|
varmetapara.Location^.register:=ref.base;
|
|
{ the variable/para metadata }
|
|
symmetadatapara.Location^.llvmloc.loc:=LOC_CREFERENCE;
|
|
symmetadatapara.Location^.llvmloc.localsym:=sym;
|
|
{ dummy for the expression metadata }
|
|
exprmetapara.Location^.llvmloc.loc:=LOC_CONSTANT;
|
|
exprmetapara.Location^.llvmloc.value:=0;
|
|
g_call_system_proc(list,pd,[@varmetapara,@symmetadatapara,@exprmetapara],nil).resetiftemp;
|
|
|
|
varmetapara.done;
|
|
symmetadatapara.done;
|
|
exprmetapara.done;
|
|
end;
|
|
end;
|
|
|
|
|
|
class function thlcgllvm.def2regtyp(def: tdef): tregistertype;
|
|
begin
|
|
if (def.typ=arraydef) and
|
|
tarraydef(def).is_hwvector then
|
|
result:=R_INTREGISTER
|
|
else
|
|
result:=inherited;
|
|
end;
|
|
|
|
|
|
procedure thlcgllvm.a_bit_test_reg_reg_reg(list: TAsmList; bitnumbersize, valuesize, destsize: tdef; bitnumber, value, destreg: tregister);
|
|
var
|
|
tmpbitnumberreg: tregister;
|
|
begin
|
|
{ unlike other architectures, llvm requires the bitnumber register to
|
|
have the same size as the shifted register }
|
|
if bitnumbersize.size<>valuesize.size then
|
|
begin
|
|
tmpbitnumberreg:=hlcg.getintregister(list,valuesize);
|
|
a_load_reg_reg(list,bitnumbersize,valuesize,bitnumber,tmpbitnumberreg);
|
|
bitnumbersize:=valuesize;
|
|
bitnumber:=tmpbitnumberreg;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
|
|
procedure thlcgllvm.a_bit_set_reg_reg(list: TAsmList; doset: boolean; bitnumbersize, destsize: tdef; bitnumber, dest: tregister);
|
|
var
|
|
tmpbitnumberreg: tregister;
|
|
begin
|
|
{ unlike other architectures, llvm requires the bitnumber register to
|
|
have the same size as the shifted register }
|
|
if bitnumbersize.size<>destsize.size then
|
|
begin
|
|
tmpbitnumberreg:=hlcg.getintregister(list,destsize);
|
|
a_load_reg_reg(list,bitnumbersize,destsize,bitnumber,tmpbitnumberreg);
|
|
bitnumbersize:=destsize;
|
|
bitnumber:=tmpbitnumberreg;
|
|
end;
|
|
inherited;
|
|
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);
|
|
begin
|
|
case getregtype(reg) of
|
|
R_INTREGISTER,
|
|
R_ADDRESSREGISTER:
|
|
begin
|
|
a_load_ref_reg(list,def,def,ref,reg);
|
|
end;
|
|
R_FPUREGISTER:
|
|
begin
|
|
a_loadfpu_ref_reg(list,def,def,ref,reg);
|
|
end;
|
|
R_MMREGISTER:
|
|
begin
|
|
a_loadmm_ref_reg(list,def,def,ref,reg,mms_movescalar);
|
|
end;
|
|
else
|
|
internalerror(2014012213);
|
|
end;
|
|
end;
|
|
|
|
var
|
|
i: longint;
|
|
href: treference;
|
|
callpara: pllvmcallpara;
|
|
paraloc: pcgparalocation;
|
|
firstparaloc: boolean;
|
|
begin
|
|
callparas:=tfplist.Create;
|
|
for i:=0 to high(paras) do
|
|
begin
|
|
{ skip parameters without data }
|
|
if paras[i]^.isempty then
|
|
continue;
|
|
paraloc:=paras[i]^.location;
|
|
firstparaloc:=true;
|
|
while assigned(paraloc) do
|
|
begin
|
|
new(callpara,init(paraloc^.def,std_param_align,lve_none,[]));
|
|
if paras[i]^.def=llvm_metadatatype then
|
|
include(callpara^.flags,lcp_metadata);
|
|
callpara^.def:=paraloc^.def;
|
|
{ if the paraloc doesn't contain the value itself, it's a byval
|
|
parameter }
|
|
if paraloc^.retvalloc then
|
|
begin
|
|
include(callpara^.flags,lcp_sret);
|
|
end
|
|
else
|
|
begin
|
|
if not paraloc^.llvmvalueloc then
|
|
include(callpara^.flags,lcp_byval);
|
|
end;
|
|
if firstparaloc and
|
|
(lcp_byval in callpara^.flags) then
|
|
callpara^.alignment:=paras[i]^.Alignment;
|
|
llvmextractvalueextinfo(paras[i]^.def, callpara^.def, callpara^.valueext);
|
|
case paraloc^.llvmloc.loc of
|
|
LOC_CONSTANT:
|
|
begin
|
|
callpara^.loadconst(paraloc^.llvmloc.value);
|
|
end;
|
|
LOC_REFERENCE:
|
|
begin
|
|
callpara^.loadsym(paraloc^.llvmloc.sym);
|
|
end;
|
|
LOC_CREFERENCE:
|
|
begin
|
|
callpara^.loadlocalsym(paraloc^.llvmloc.localsym);
|
|
end
|
|
else
|
|
begin
|
|
case paraloc^.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, ctempposinvalid, paraloc^.def.alignment, []);
|
|
res:=getregisterfordef(list, paraloc^.def);
|
|
load_ref_anyreg(callpara^.def, href, res);
|
|
callpara^.loadreg(res);
|
|
end;
|
|
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^.loadreg(paraloc^.register);
|
|
end;
|
|
{ empty records }
|
|
LOC_VOID:
|
|
begin
|
|
callpara^.loadundef;
|
|
end
|
|
else
|
|
internalerror(2014010605);
|
|
end;
|
|
end;
|
|
end;
|
|
callparas.add(callpara);
|
|
paraloc:=paraloc^.next;
|
|
firstparaloc:=false;
|
|
end;
|
|
end;
|
|
{ the Pascal level may expect a different returndef compared to the
|
|
declared one }
|
|
if pd.generate_safecall_wrapper then
|
|
begin
|
|
hlretdef:=ossinttype;
|
|
llvmretdef:=ossinttype;
|
|
end
|
|
else
|
|
begin
|
|
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) or
|
|
pd.generate_safecall_wrapper then
|
|
llvmretdef:=llvmgetcgparadef(pd.funcretloc[callerside], true, callerside)
|
|
else
|
|
llvmretdef:=voidtype;
|
|
end;
|
|
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,pc_address_only));
|
|
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;
|
|
nextinslab,
|
|
exceptlab: TAsmLabel;
|
|
begin
|
|
a_call_common(list,pd,paras,forceresdef,res,hlretdef,llvmretdef,callparas);
|
|
if not(fc_catching_exceptions in flowcontrol) or
|
|
{ no invoke for intrinsics }
|
|
(copy(s,1,5)='llvm.') then
|
|
list.concat(taillvm.call_size_name_paras(get_call_pd(pd),pd.proccalloption,res,llvmretdef,current_asmdata.RefAsmSymbol(s,AT_FUNCTION),callparas))
|
|
else
|
|
begin
|
|
current_asmdata.getjumplabel(nextinslab);
|
|
exceptlab:=tllvmprocinfo(current_procinfo).CurrExceptLabel;
|
|
list.concat(taillvm.invoke_size_name_paras_retlab_exceptlab(get_call_pd(pd),pd.proccalloption,res,llvmretdef,current_asmdata.RefAsmSymbol(s,AT_FUNCTION),callparas,nextinslab,exceptlab));
|
|
a_label(list,nextinslab);
|
|
end;
|
|
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;
|
|
nextinslab,
|
|
exceptlab: TAsmLabel;
|
|
begin
|
|
a_call_common(list,pd,paras,nil,res,hlretdef,llvmretdef,callparas);
|
|
if not(fc_catching_exceptions in flowcontrol) then
|
|
list.concat(taillvm.call_size_reg_paras(get_call_pd(pd),pd.proccalloption,res,llvmretdef,reg,callparas))
|
|
else
|
|
begin
|
|
current_asmdata.getjumplabel(nextinslab);
|
|
exceptlab:=tllvmprocinfo(current_procinfo).CurrExceptLabel;
|
|
list.concat(taillvm.invoke_size_reg_paras_retlab_exceptlab(get_call_pd(pd),pd.proccalloption,res,llvmretdef,reg,callparas,nextinslab,exceptlab));
|
|
a_label(list,nextinslab);
|
|
end;
|
|
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);
|
|
var
|
|
fromsize: tdef;
|
|
begin
|
|
if tosize=llvm_metadatatype then
|
|
internalerror(2019122804);
|
|
if tosize.size<=ptrsinttype.size then
|
|
fromsize:=ptrsinttype
|
|
else
|
|
fromsize:=tosize;
|
|
list.concat(taillvm.op_reg_size_const_size(llvmconvop(fromsize,tosize,false),register,fromsize,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
|
|
if (fromsize=llvm_metadatatype) or
|
|
(tosize=llvm_metadatatype) then
|
|
internalerror(2019122812);
|
|
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
|
|
(is_set(fromsize) and not is_smallset(fromsize)) 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.temppos,tmpref.alignment,tmpref.volatility);
|
|
{ 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.temppos,sref.alignment,sref.volatility);
|
|
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
|
|
if (fromsize=llvm_metadatatype) or
|
|
(tosize=llvm_metadatatype) then
|
|
internalerror(2019122805);
|
|
op:=llvmconvop(fromsize,tosize,true);
|
|
{ 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;
|
|
else
|
|
;
|
|
end;
|
|
{ inttoptr performs zero extension -> avoid inc(ptr,longint(-1)) from
|
|
increasing ptr by 4GB on a 64bit platform }
|
|
if (op=la_inttoptr) and
|
|
(fromsize.size<tosize.size) then
|
|
begin
|
|
tmpreg:=getintregister(list,fromsize);
|
|
a_load_reg_reg(list,fromsize,ptrsinttype,reg1,tmpreg);
|
|
reg1:=tmpreg;
|
|
fromsize:=ptrsinttype;
|
|
end;
|
|
{ reg2 = bitcast fromsize reg1 to tosize }
|
|
list.concat(taillvm.op_reg_size_reg_size(op,reg2,fromsize,reg1,tosize));
|
|
end;
|
|
|
|
|
|
procedure thlcgllvm.gen_load_refaddrfull_anyreg(list: TAsmList; fromsize, tosize: tdef; const simpleref: treference; register: tregister; shuffle: pmmshuffle);
|
|
var
|
|
tmpref,
|
|
tmpref2: treference;
|
|
begin
|
|
{ can't bitcast records/arrays }
|
|
if (llvmaggregatetype(fromsize) or
|
|
llvmaggregatetype(tosize)) and
|
|
(fromsize<>tosize) then
|
|
begin
|
|
if fromsize.size>tosize.size then
|
|
begin
|
|
tg.gethltemp(list,fromsize,fromsize.size,tt_normal,tmpref);
|
|
tmpref2:=tmpref;
|
|
g_ptrtypecast_ref(list,cpointerdef.getreusable(fromsize),cpointerdef.getreusable(tosize),tmpref2);
|
|
end
|
|
else
|
|
begin
|
|
tg.gethltemp(list,tosize,tosize.size,tt_normal,tmpref);
|
|
tmpref2:=tmpref;
|
|
g_ptrtypecast_ref(list,cpointerdef.getreusable(tosize),cpointerdef.getreusable(fromsize),tmpref);
|
|
end;
|
|
list.concat(taillvm.op_size_ref_size_ref(la_store,fromsize,simpleref,cpointerdef.getreusable(fromsize),tmpref));
|
|
case getregtype(register) of
|
|
R_INTREGISTER,
|
|
R_ADDRESSREGISTER:
|
|
a_load_ref_reg(list,tosize,tosize,tmpref2,register);
|
|
R_FPUREGISTER:
|
|
a_loadfpu_ref_reg(list,tosize,tosize,tmpref2,register);
|
|
R_MMREGISTER:
|
|
a_loadmm_ref_reg(list,tosize,tosize,tmpref2,register,shuffle);
|
|
else
|
|
internalerror(2016061901);
|
|
end;
|
|
tg.ungettemp(list,tmpref);
|
|
end
|
|
else
|
|
list.concat(taillvm.op_reg_size_ref_size(llvmconvop(fromsize,tosize,false),register,fromsize,simpleref,tosize))
|
|
end;
|
|
|
|
|
|
function thlcgllvm.handle_agg_load_ref_anyreg(list: TasmList; var fromsize, tosize: tdef; var simpleref: treference; register: tregister; shuffle: pmmshuffle): boolean;
|
|
var
|
|
tmpref,
|
|
tmpref2: treference;
|
|
firstshuffle: pmmshuffle;
|
|
begin
|
|
if fromsize.size<tosize.size then
|
|
begin
|
|
{ allocate a temp of size tosize, typecast it to the
|
|
(smaller) fromsize, load the source in it, and then
|
|
load the destination from it. The extra bits will contain
|
|
garbage, but they should never be used. }
|
|
tg.gethltemp(list,tosize,tosize.size,tt_persistent,tmpref);
|
|
tmpref2:=tmpref;
|
|
g_ptrtypecast_ref(list,cpointerdef.getreusable(tosize),cpointerdef.getreusable(fromsize),tmpref2);
|
|
case getregtype(register) of
|
|
R_INTREGISTER,
|
|
R_ADDRESSREGISTER:
|
|
begin
|
|
a_load_ref_ref(list,fromsize,fromsize,simpleref,tmpref2);
|
|
a_load_ref_reg(list,tosize,tosize,tmpref,register);
|
|
end;
|
|
R_FPUREGISTER:
|
|
begin
|
|
a_loadfpu_ref_ref(list,fromsize,fromsize,simpleref,tmpref2);
|
|
a_loadfpu_ref_reg(list,tosize,tosize,tmpref,register);
|
|
end;
|
|
R_MMREGISTER:
|
|
begin
|
|
{ don't shuffle twice }
|
|
if shuffle=mms_movescalar then
|
|
firstshuffle:=shuffle
|
|
else
|
|
firstshuffle:=nil;
|
|
a_loadmm_ref_ref(list,fromsize,fromsize,simpleref,tmpref2,firstshuffle);
|
|
a_loadmm_ref_reg(list,tosize,tosize,tmpref,register,shuffle);
|
|
end;
|
|
else
|
|
internalerror(2019051040);
|
|
end;
|
|
tg.ungettemp(list,tmpref);
|
|
result:=true;
|
|
end
|
|
else
|
|
begin
|
|
(* typecast the pointer to the value instead of the value
|
|
itself if tosize<=fromsize but they are of different
|
|
kinds, because we can't e.g. bitcast a loaded <{i32, i32}>
|
|
to an i64 *)
|
|
g_ptrtypecast_ref(list,cpointerdef.getreusable(fromsize),cpointerdef.getreusable(tosize),simpleref);
|
|
fromsize:=tosize;
|
|
result:=false;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure thlcgllvm.a_load_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; register: tregister);
|
|
var
|
|
sref: treference;
|
|
hreg: tregister;
|
|
begin
|
|
if (fromsize=llvm_metadatatype) or
|
|
(tosize=llvm_metadatatype) then
|
|
internalerror(2019122803);
|
|
sref:=make_simple_ref(list,ref,fromsize);
|
|
{ "named register"? }
|
|
if sref.refaddr=addr_full then
|
|
gen_load_refaddrfull_anyreg(list,fromsize,tosize,sref,register,nil)
|
|
else
|
|
begin
|
|
if ((fromsize.typ in [arraydef,recorddef]) or
|
|
(tosize.typ in [arraydef,recorddef]) or
|
|
(is_set(fromsize) and not is_smallset(fromsize)) or
|
|
(is_set(tosize) and not is_smallset(tosize))) and
|
|
(fromsize<>tosize) then
|
|
begin
|
|
if handle_agg_load_ref_anyreg(list,fromsize,tosize,sref,register,nil) then
|
|
exit;
|
|
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 if (fromsize=tosize) and
|
|
not(fromsize.typ in [orddef,floatdef,enumdef]) and
|
|
(sref.refaddr<>addr_full) and
|
|
(fromsize.size>2*sizeof(aint)) then
|
|
g_concatcopy(list,fromsize,sref,dref)
|
|
else
|
|
inherited
|
|
end;
|
|
|
|
|
|
procedure thlcgllvm.a_loadaddr_ref_reg_intern(list: TAsmList; fromsize, tosize: tdef; const ref: treference; r: tregister; makefromsizepointer: boolean);
|
|
var
|
|
sref: treference;
|
|
begin
|
|
{ can't take the address of a 'named register' }
|
|
if ref.refaddr=addr_full then
|
|
internalerror(2013102306);
|
|
if makefromsizepointer then
|
|
fromsize:=cpointerdef.getreusable(fromsize);
|
|
sref:=make_simple_ref_ptr(list,ref,fromsize);
|
|
list.concat(taillvm.op_reg_size_ref_size(la_bitcast,r,fromsize,sref,tosize));
|
|
end;
|
|
|
|
|
|
procedure thlcgllvm.a_loadaddr_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; r: tregister);
|
|
begin
|
|
a_loadaddr_ref_reg_intern(list,fromsize,tosize,ref,r,true);
|
|
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]*8 - (src1 and (tcgsize2size[size]*8-1) }
|
|
list.concat(taillvm.op_reg_size_const_reg(la_and,tmpreg1,opsize,opsize.size*8-1,src1));
|
|
list.concat(taillvm.op_reg_size_const_reg(la_sub,tmpreg2,opsize,opsize.size*8,tmpreg1));
|
|
{ tmpreg3 := src2 shr tmpreg2 }
|
|
a_op_reg_reg_reg(list,OP_SHR,opsize,tmpreg2,src2,tmpreg3);
|
|
{ tmpreg2:= src2 shl tmpreg1 }
|
|
tmpreg2:=getintregister(list,opsize);
|
|
a_op_reg_reg_reg(list,OP_SHL,opsize,tmpreg1,src2,tmpreg2);
|
|
{ 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]*8 - (src1 and (tcgsize2size[size]*8-1) }
|
|
list.concat(taillvm.op_reg_size_const_reg(la_and,tmpreg1,opsize,opsize.size*8-1,src1));
|
|
list.concat(taillvm.op_reg_size_const_reg(la_sub,tmpreg2,opsize,opsize.size*8,tmpreg1));
|
|
{ tmpreg3 := src2 shl tmpreg2 }
|
|
a_op_reg_reg_reg(list,OP_SHL,opsize,tmpreg2,src2,tmpreg3);
|
|
{ tmpreg2:= src2 shr tmpreg1 }
|
|
tmpreg2:=getintregister(list,opsize);
|
|
a_op_reg_reg_reg(list,OP_SHR,opsize,tmpreg1,src2,tmpreg2);
|
|
{ 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);
|
|
var
|
|
hreg: tregister;
|
|
begin
|
|
if not setflags then
|
|
begin
|
|
inherited;
|
|
exit;
|
|
end;
|
|
hreg:=getintregister(list,size);
|
|
a_load_const_reg(list,size,a,hreg);
|
|
a_op_reg_reg_reg_checkoverflow(list,op,size,hreg,src,dst,setflags,ovloc);
|
|
end;
|
|
|
|
|
|
procedure thlcgllvm.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister; setflags: boolean; var ovloc: tlocation);
|
|
var
|
|
calcsize: tdef;
|
|
tmpsrc1,
|
|
tmpsrc2,
|
|
tmpdst: tregister;
|
|
signed,
|
|
docheck: boolean;
|
|
begin
|
|
docheck:=size.size>=ossinttype.size;
|
|
if not setflags or
|
|
not docheck then
|
|
begin
|
|
inherited a_op_reg_reg_reg_checkoverflow(list,op,size,src1,src2,dst,false,ovloc);
|
|
exit;
|
|
end;
|
|
{ extend values to twice their original width (one bit extra is enough,
|
|
but adding support for 9/17/33/65 bit types just for this is overkill) }
|
|
signed:=is_signed(size);
|
|
case size.size of
|
|
1:
|
|
if signed then
|
|
calcsize:=s16inttype
|
|
else
|
|
calcsize:=u16inttype;
|
|
2:
|
|
if signed then
|
|
calcsize:=s32inttype
|
|
else
|
|
calcsize:=u32inttype;
|
|
4:
|
|
if signed then
|
|
calcsize:=s64inttype
|
|
else
|
|
calcsize:=u64inttype;
|
|
8:
|
|
if signed then
|
|
calcsize:=s128inttype
|
|
else
|
|
calcsize:=u128inttype;
|
|
else
|
|
internalerror(2015122503);
|
|
end;
|
|
tmpsrc1:=getintregister(list,calcsize);
|
|
a_load_reg_reg(list,size,calcsize,src1,tmpsrc1);
|
|
tmpsrc2:=getintregister(list,calcsize);
|
|
a_load_reg_reg(list,size,calcsize,src2,tmpsrc2);
|
|
tmpdst:=getintregister(list,calcsize);
|
|
{ perform the calculation with twice the width }
|
|
a_op_reg_reg_reg(list,op,calcsize,tmpsrc1,tmpsrc2,tmpdst);
|
|
{ signed/unsigned overflow occurs if signed/unsigned truncation of the
|
|
result is different from the actual result -> extend again and compare }
|
|
a_load_reg_reg(list,calcsize,size,tmpdst,dst);
|
|
tmpsrc1:=getintregister(list,calcsize);
|
|
a_load_reg_reg(list,size,calcsize,dst,tmpsrc1);
|
|
location_reset(ovloc,LOC_REGISTER,OS_8);
|
|
ovloc.register:=getintregister(list,llvmbool1type);
|
|
list.concat(taillvm.op_reg_cond_size_reg_reg(la_icmp,ovloc.register,OC_NE,calcsize,tmpsrc1,tmpdst));
|
|
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
|
|
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,llvmbool1type);
|
|
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,llvmbool1type,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_unreachable(list: TAsmList);
|
|
begin
|
|
list.Concat(taillvm.op_none(la_unreachable));
|
|
end;
|
|
|
|
|
|
procedure thlcgllvm.g_concatcopy(list: TAsmList; size: tdef; const source, dest: treference);
|
|
var
|
|
pd: tprocdef;
|
|
sourcepara, destpara, sizepara, alignpara, volatilepara: tcgpara;
|
|
maxalign: longint;
|
|
indivalign: boolean;
|
|
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 }
|
|
if (size.typ in [orddef,floatdef,enumdef]) or
|
|
(size.size in [1,2,4,8]) then
|
|
begin
|
|
a_load_ref_ref(list,size,size,source,dest);
|
|
exit;
|
|
end;
|
|
indivalign:=llvmflag_memcpy_indiv_align in llvmversion_properties[current_settings.llvmversion];
|
|
if indivalign then
|
|
pd:=search_system_proc('llvm_memcpy64_indivalign')
|
|
else
|
|
pd:=search_system_proc('llvm_memcpy64');
|
|
sourcepara.init;
|
|
destpara.init;
|
|
sizepara.init;
|
|
alignpara.init;
|
|
volatilepara.init;
|
|
paramanager.getcgtempparaloc(list,pd,1,destpara);
|
|
paramanager.getcgtempparaloc(list,pd,2,sourcepara);
|
|
paramanager.getcgtempparaloc(list,pd,3,sizepara);
|
|
if indivalign then
|
|
begin
|
|
paramanager.getcgtempparaloc(list,pd,4,volatilepara);
|
|
destpara.Alignment:=-dest.alignment;
|
|
sourcepara.Alignment:=-source.alignment;
|
|
end
|
|
else
|
|
begin
|
|
paramanager.getcgtempparaloc(list,pd,4,alignpara);
|
|
paramanager.getcgtempparaloc(list,pd,5,volatilepara);
|
|
maxalign:=newalignment(max(source.alignment,dest.alignment),min(source.alignment,dest.alignment));
|
|
a_load_const_cgpara(list,u32inttype,maxalign,alignpara);
|
|
end;
|
|
a_loadaddr_ref_cgpara(list,size,dest,destpara);
|
|
a_loadaddr_ref_cgpara(list,size,source,sourcepara);
|
|
a_load_const_cgpara(list,u64inttype,size.size,sizepara);
|
|
a_load_const_cgpara(list,llvmbool1type,ord((vol_read in source.volatility) or (vol_write in dest.volatility)),volatilepara);
|
|
if indivalign then
|
|
g_call_system_proc(list,pd,[@destpara,@sourcepara,@sizepara,@volatilepara],nil).resetiftemp
|
|
else
|
|
g_call_system_proc(list,pd,[@destpara,@sourcepara,@sizepara,@alignpara,@volatilepara],nil).resetiftemp;
|
|
sourcepara.done;
|
|
destpara.done;
|
|
sizepara.done;
|
|
alignpara.done;
|
|
volatilepara.done;
|
|
end;
|
|
|
|
|
|
procedure thlcgllvm.g_undefined_ok(list: TAsmList; size: tdef; reg: tregister);
|
|
begin
|
|
if not(llvmflag_no_freeze in llvmversion_properties[current_settings.llvmversion]) then
|
|
begin
|
|
list.concat(taillvm.op_reg_size_reg(la_freeze,reg,size,reg));
|
|
exit;
|
|
end;
|
|
internalerror(2023010110);
|
|
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
|
|
href:=make_simple_ref(list,ref,fromsize);
|
|
{ named register -> use generic code }
|
|
if ref.refaddr=addr_full then
|
|
begin
|
|
gen_load_refaddrfull_anyreg(list,fromsize,tosize,href,reg,mms_movescalar);
|
|
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:=
|
|
(fromsize.typ=floatdef) and
|
|
(tfloatdef(fromsize).floattype in [s64comp,s64currency]);
|
|
tocompcurr:=
|
|
(tosize.typ=floatdef) and
|
|
(tfloatdef(tosize).floattype in [s64comp,s64currency]);
|
|
if tocompcurr then
|
|
tosize:=s80floattype;
|
|
{ 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;
|
|
{ handle aggregate loads (happens if a struct needs to be passed in a
|
|
floating point register) }
|
|
if (fromsize.typ in [arraydef,recorddef]) or
|
|
(tosize.typ in [arraydef,recorddef]) then
|
|
begin
|
|
if handle_agg_load_ref_anyreg(list,fromsize,tosize,href,reg,mms_movescalar) then
|
|
exit;
|
|
end;
|
|
{ %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
|
|
pd: tprocdef;
|
|
roundpara, respara: tcgpara;
|
|
tmpreg: tregister;
|
|
tmploc: tlocation;
|
|
href: treference;
|
|
fromcompcurr,
|
|
tocompcurr: boolean;
|
|
begin
|
|
{ see comment in a_loadfpu_ref_reg }
|
|
fromcompcurr:=
|
|
(fromsize.typ=floatdef) and
|
|
(tfloatdef(fromsize).floattype in [s64comp,s64currency]);
|
|
tocompcurr:=
|
|
(tosize.typ=floatdef) and
|
|
(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
|
|
begin
|
|
{ store back an int64 rather than an extended }
|
|
pd:=search_system_proc('fpc_round_real');
|
|
roundpara.init;
|
|
paramanager.getcgtempparaloc(list,pd,1,roundpara);
|
|
a_load_reg_cgpara(list,fromsize,reg,roundpara);
|
|
respara:=g_call_system_proc(list,pd,[@roundpara],nil);
|
|
if not assigned(respara.location) or
|
|
(respara.location^.loc<>LOC_REGISTER) then
|
|
internalerror(2023120510);
|
|
location_reset(tmploc,respara.location^.loc,def_cgsize(tosize));
|
|
tmploc.register:=tmpreg;
|
|
gen_load_cgpara_loc(list,respara.location^.def,respara,tmploc,false);
|
|
respara.resetiftemp;
|
|
respara.done;
|
|
roundpara.done;
|
|
end
|
|
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;
|
|
intrinsic: TIDString;
|
|
begin
|
|
op:=llvmconvop(fromsize,tosize,true);
|
|
if (cs_opt_fastmath in current_settings.optimizerswitches) or
|
|
not(llvmflag_constrained_fptrunc_fpext in llvmversion_properties[current_settings.llvmversion]) or
|
|
not(op in [la_fptrunc,la_fpext]) then
|
|
list.concat(taillvm.op_reg_size_reg_size(op,reg2,fromsize,reg1,tosize))
|
|
else
|
|
begin
|
|
if op=la_fptrunc then
|
|
intrinsic:='llvm_experimental_constrained_fptrunc'
|
|
else
|
|
intrinsic:='llvm_experimental_constrained_fpext';
|
|
gen_fpconstrained_intrinsic(list,
|
|
intrinsic+llvmfloatintrinsicsuffix(tfloatdef(tosize))+llvmfloatintrinsicsuffix(tfloatdef(fromsize)),
|
|
fromsize,tosize,reg1,reg2,op=la_fptrunc);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure thlcgllvm.gen_fpconstrained_intrinsic(list: TAsmList; const intrinsic: TIDString; fromsize, tosize: tdef; fromreg, toreg: tregister; roundingmode: boolean);
|
|
var
|
|
exceptmode: ansistring;
|
|
frompara, roundpara, exceptpara, respara: tcgpara;
|
|
tmploc: tlocation;
|
|
pd: tprocdef;
|
|
begin
|
|
frompara.init;
|
|
if roundingmode then
|
|
roundpara.init;
|
|
exceptpara.init;
|
|
pd:=search_system_proc(intrinsic);
|
|
|
|
paramanager.getcgtempparaloc(list,pd,1,frompara);
|
|
if roundingmode then
|
|
begin
|
|
paramanager.getcgtempparaloc(list,pd,2,roundpara);
|
|
paramanager.getcgtempparaloc(list,pd,3,exceptpara);
|
|
end
|
|
else
|
|
paramanager.getcgtempparaloc(list,pd,2,exceptpara);
|
|
|
|
location_reset(tmploc,frompara.location^.loc,def_cgsize(fromsize));
|
|
tmploc.register:=fromreg;
|
|
gen_load_loc_cgpara(list,fromsize,tmploc,frompara);
|
|
if roundingmode then
|
|
a_load_reg_cgpara(list,llvm_metadatatype,tllvmmetadata.getstringreg('round.dynamic'),roundpara);
|
|
exceptmode:=llvm_constrainedexceptmodestring;
|
|
a_load_reg_cgpara(list,llvm_metadatatype,tllvmmetadata.getstringreg(exceptmode),exceptpara);
|
|
if roundingmode then
|
|
respara:=g_call_system_proc(list,pd,[@frompara,@roundpara,@exceptpara],nil)
|
|
else
|
|
respara:=g_call_system_proc(list,pd,[@frompara,@exceptpara],nil);
|
|
|
|
location_reset(tmploc,respara.location^.loc,def_cgsize(tosize));
|
|
tmploc.register:=toreg;
|
|
gen_load_cgpara_loc(list,tosize,respara,tmploc,false);
|
|
frompara.done;
|
|
if roundingmode then
|
|
roundpara.done;
|
|
exceptpara.done;
|
|
respara.resetiftemp;
|
|
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,current_procinfo.procdef)
|
|
else
|
|
asmsym:=current_asmdata.DefineAsmSymbol(mangledname,AB_LOCAL,AT_FUNCTION,current_procinfo.procdef);
|
|
while assigned(item) do
|
|
begin
|
|
if mangledname<>item.Str then
|
|
list.concat(taillvmalias.create(asmsym,item.str,current_procinfo.procdef,asmsym.bind));
|
|
item:=TCmdStrListItem(item.next);
|
|
end;
|
|
list.concat(taillvmdecl.createdef(asmsym,current_procinfo.procdef.procsym,current_procinfo.procdef,nil,sec_code,current_procinfo.procdef.alignment));
|
|
current_procinfo.procdef.procstarttai:=tai(list.last);
|
|
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)) and
|
|
not current_procinfo.procdef.generate_safecall_wrapper 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]) and
|
|
not current_procinfo.procdef.generate_safecall_wrapper 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;
|
|
LOC_VOID:
|
|
begin
|
|
{ zero-sized records: return an undefined zero-sized record of
|
|
the correct type }
|
|
list.concat(taillvm.op_size_undef(la_ret,retdef));
|
|
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
|
|
if not llvmaggregatetype(resdef) then
|
|
list.concat(taillvm.op_reg_size_undef(la_bitcast,resloc.location^.register,llvmgetcgparadef(resloc,true,calleeside)))
|
|
else
|
|
{ bitcast doesn't work for aggregates -> just load from the
|
|
(uninitialised) function result memory location }
|
|
gen_load_loc_function_result(list,resdef,tabstractnormalvarsym(pd.funcretsym).localloc)
|
|
end;
|
|
{ for empty record returns }
|
|
LOC_VOID:
|
|
;
|
|
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);
|
|
var
|
|
hl: tasmlabel;
|
|
begin
|
|
if not(cs_check_overflow in current_settings.localswitches) then
|
|
exit;
|
|
if ovloc.size<>OS_8 then
|
|
internalerror(2015122504);
|
|
current_asmdata.getjumplabel(hl);
|
|
a_cmp_const_loc_label(list,llvmbool1type,OC_EQ,0,ovloc,hl);
|
|
g_call_system_proc(list,'fpc_overflow',[],nil).resetiftemp;
|
|
a_label(list,hl);
|
|
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) and
|
|
not(llvmflag_opaque_ptr in llvmversion_properties[current_settings.llvmversion]) 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, todef: tdef; var ref: treference);
|
|
var
|
|
hreg: tregister;
|
|
begin
|
|
{ the reason for the array exception is that we sometimes generate
|
|
getelementptr array_element_ty, arrayref, 0, 0
|
|
to get a pointer to the first element of the array. That expression is
|
|
not valid if arrayref does not point to an array. Clang does the same.
|
|
}
|
|
if (llvmflag_opaque_ptr in llvmversion_properties[current_settings.llvmversion]) and
|
|
(((fromdef.typ=pointerdef) and (tpointerdef(fromdef).pointeddef.typ=arraydef)) <>
|
|
((todef.typ=pointerdef) and (tpointerdef(todef).pointeddef.typ=arraydef))
|
|
) then
|
|
exit;
|
|
hreg:=getaddressregister(list,todef);
|
|
a_loadaddr_ref_reg_intern(list,fromdef,todef,ref,hreg,false);
|
|
reference_reset_base(ref,todef,hreg,0,ref.temppos,ref.alignment,ref.volatility);
|
|
end;
|
|
|
|
|
|
procedure thlcgllvm.g_set_addr_nonbitpacked_field_ref(list: TAsmList; recdef: tabstractrecorddef; field: tfieldvarsym; var recref: treference);
|
|
var
|
|
parentdef,
|
|
subscriptdef,
|
|
currentstructdef,
|
|
llvmfielddef: tdef;
|
|
llvmfield: tllvmshadowsymtableentry;
|
|
newbase: tregister;
|
|
implicitpointer: boolean;
|
|
begin
|
|
implicitpointer:=is_implicit_pointer_object_type(recdef);
|
|
(*
|
|
This doesn't work with the way anonymous functions migrate symbols,
|
|
TBD on how to fix it or whether to permanently disable it (even if it's
|
|
the clean way to do it at the IR level)
|
|
|
|
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,recref.temppos,newalignment(recref.alignment,field.fieldoffset),recref.volatility);
|
|
{ go to the parent }
|
|
currentstructdef:=parentdef;
|
|
end;
|
|
*)
|
|
currentstructdef:=tdef(field.owner.defowner);
|
|
if implicitpointer then
|
|
g_ptrtypecast_ref(list,recdef,currentstructdef,recref)
|
|
else
|
|
g_ptrtypecast_ref(list,cpointerdef.getreusable(recdef),cpointerdef.getreusable(currentstructdef),recref);
|
|
{ get the corresponding field in the llvm shadow symtable }
|
|
llvmfield:=tabstractrecordsymtable(tabstractrecorddef(currentstructdef).symtable).llvmst[field];
|
|
if implicitpointer then
|
|
subscriptdef:=currentstructdef
|
|
else
|
|
subscriptdef:=cpointerdef.getreusable(currentstructdef);
|
|
{ load the address of that shadow field }
|
|
newbase:=getaddressregister(list,cpointerdef.getreusable(llvmfield.def));
|
|
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,recref.temppos,newalignment(recref.alignment,llvmfield.fieldoffset+field.offsetfromllvmfield),recref.volatility);
|
|
{ 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 (llvmfield.def.typ=floatdef) and
|
|
(tfloatdef(llvmfield.def).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
|
|
(llvmfield.def<>field.vardef) then
|
|
g_ptrtypecast_ref(list,cpointerdef.getreusable(llvmfield.def),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
|
|
if shuffle=mms_movescalar then
|
|
a_loadfpu_ref_reg(list,fromsize,tosize,ref,reg)
|
|
else
|
|
begin
|
|
href:=make_simple_ref(list,ref,fromsize);
|
|
if ref.refaddr=addr_full then
|
|
gen_load_refaddrfull_anyreg(list,fromsize,tosize,href,reg,shuffle)
|
|
else
|
|
begin
|
|
{ handle aggregate loads (happens if a struct needs to be passed
|
|
in an mmregister) }
|
|
if (fromsize.typ in [arraydef,recorddef]) or
|
|
(tosize.typ in [arraydef,recorddef]) then
|
|
begin
|
|
if handle_agg_load_ref_anyreg(list,fromsize,tosize,href,reg,mms_movescalar) then
|
|
exit;
|
|
end;
|
|
if fromsize<>tosize then
|
|
g_ptrtypecast_ref(list,cpointerdef.getreusable(fromsize),cpointerdef.getreusable(tosize),href);
|
|
{ %reg = load size* %ref }
|
|
list.concat(taillvm.op_reg_size_ref(la_load,reg,cpointerdef.getreusable(tosize),href));
|
|
end;
|
|
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,callerside);
|
|
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);
|
|
var
|
|
retlocpara: tcgpara;
|
|
begin
|
|
retlocpara:=get_call_result_cgpara(current_procinfo.procdef,nil);
|
|
gen_load_loc_cgpara(list,vardef,l,retlocpara);
|
|
retlocpara.resetiftemp;
|
|
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;
|
|
fielddef,
|
|
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,calleeside);
|
|
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.temppos,destloc.reference.alignment,destloc.reference.volatility);
|
|
end;
|
|
index:=0;
|
|
ploc:=para.location;
|
|
repeat
|
|
paraloctoloc(ploc,hloc);
|
|
g_setup_load_field_by_name(list,trecorddef(llvmparadef),'F'+tostr(index),href,href2,fielddef);
|
|
a_load_loc_ref(list,ploc^.def,fielddef,hloc,href2);
|
|
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;
|
|
|
|
|
|
procedure thlcgllvm.gen_stack_check_size_para(list: TAsmList);
|
|
begin
|
|
{ this is implemented in a very hackish way, whereby first the call
|
|
to fpc_stackcheck() is emitted, then the prolog is generated and
|
|
registers are allocated, and finally the code to load the parameter
|
|
is inserted before the call to fpc_stackcheck(). Since parameters are
|
|
explicitly passed to call instructions for llvm, that does not work
|
|
here. It could be solved by patching the call instruction later, but
|
|
that's a lot of engineering for functionality that's only marginally
|
|
useful at best. }
|
|
end;
|
|
|
|
|
|
procedure thlcgllvm.gen_stack_check_call(list: TAsmList);
|
|
begin
|
|
{ see explanation in thlcgllvm.gen_stack_check_size_para() }
|
|
end;
|
|
|
|
|
|
function thlcgllvm.make_simple_ref(list: TAsmList; const ref: treference; def: tdef): treference;
|
|
begin
|
|
result:=make_simple_ref_ptr(list,ref,cpointerdef.getreusable(def));
|
|
end;
|
|
|
|
|
|
function thlcgllvm.make_simple_ref_ptr(list: TAsmList; const ref: treference; ptrdef: tdef): treference;
|
|
var
|
|
ptrindex: tcgint;
|
|
hreg1,
|
|
hreg2: tregister;
|
|
tmpref: treference;
|
|
begin
|
|
if ref.alignment=0 then
|
|
internalerror(2016072203);
|
|
{ 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;
|
|
{ At this levevl, perform all calculations using plain pointer arithmetic.
|
|
Optimizations based on getelementptr for structured accesses need to be
|
|
performed at the node tree level.
|
|
|
|
Assumptions:
|
|
* symbol/base register: always type "ptrdef"
|
|
* 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,ref.volatility);
|
|
list.concat(taillvm.getelementptr_reg_size_ref_size_const(hreg1,ptrdef,tmpref,ptruinttype,0,true));
|
|
end
|
|
else if ref.base<>NR_NO then
|
|
begin
|
|
a_load_reg_reg(list,ptrdef,ptruinttype,ref.base,hreg1);
|
|
end
|
|
else
|
|
{ for absolute addresses }
|
|
a_load_const_reg(list,ptruinttype,0,hreg1);
|
|
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,ptrdef);
|
|
a_load_reg_reg(list,ptruinttype,ptrdef,hreg1,hreg2);
|
|
reference_reset_base(result,ptrdef,hreg2,0,ref.temppos,ref.alignment,ref.volatility);
|
|
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)) or
|
|
pd.generate_safecall_wrapper 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, llvmretdef, llvmretdef.size, tt_normal, rettemp);
|
|
case def2regtyp(llvmretdef) of
|
|
R_INTREGISTER,
|
|
R_ADDRESSREGISTER:
|
|
a_load_reg_ref(list,llvmretdef,llvmretdef,resval,rettemp);
|
|
R_FPUREGISTER:
|
|
a_loadfpu_reg_ref(list,llvmretdef,llvmretdef,resval,rettemp);
|
|
R_MMREGISTER:
|
|
a_loadmm_reg_ref(list,llvmretdef,llvmretdef,resval,rettemp,mms_movescalar);
|
|
else
|
|
;
|
|
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:=llvmretdef;
|
|
retpara.location^.def:=llvmretdef;
|
|
{ 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
|
|
retpara.def:=llvmretdef;
|
|
retpara.Location^.def:=llvmretdef;
|
|
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;
|
|
else
|
|
;
|
|
end;
|
|
end;
|
|
vs.localloc:=vs.initialloc;
|
|
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 wrappername, externalname: string; global: boolean);
|
|
var
|
|
asmsym: TAsmSymbol;
|
|
begin
|
|
if po_external in procdef.procoptions then
|
|
exit;
|
|
asmsym:=current_asmdata.RefAsmSymbol(externalname,AT_FUNCTION);
|
|
list.concat(taillvmalias.create(asmsym,wrappername,procdef,asmsym.bind));
|
|
end;
|
|
|
|
|
|
procedure create_hlcodegen_llvm;
|
|
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;
|
|
create_hlcodegen_cpu;
|
|
{ todo: handle/remove chlcgobj }
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
chlcgobj:=thlcgllvm;
|
|
{ this unit must initialise after hlcgobj;
|
|
message system has not been initialised yet here }
|
|
if not assigned(create_hlcodegen) then
|
|
begin
|
|
writeln('Internalerror 2018052003');
|
|
halt(1);
|
|
end;
|
|
create_hlcodegen_cpu:=create_hlcodegen;
|
|
create_hlcodegen:=@create_hlcodegen_llvm;
|
|
end.
|