12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243 |
- {
- 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 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 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_CREFERENCE;
- 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;
- begin
- newrefsize:=llvmgetcgparadef(para,true,callerside);
- if (refsize<>newrefsize) and
- (initialref.refaddr<>addr_full) 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
- 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.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);
- callpara^.def:=paraloc^.def;
- { if the paraloc doesn't contain the value itself, it's a byval
- parameter }
- if paraloc^.retvalloc then
- begin
- callpara^.sret:=true;
- callpara^.byval:=false;
- end
- else
- begin
- callpara^.sret:=false;
- callpara^.byval:=not paraloc^.llvmvalueloc;
- end;
- if firstparaloc and
- callpara^.byval then
- callpara^.alignment:=paras[i]^.Alignment
- else
- callpara^.alignment:=std_param_align;
- llvmextractvalueextinfo(paras[i]^.def, callpara^.def, callpara^.valueext);
- case paraloc^.llvmloc.loc of
- LOC_CONSTANT:
- begin
- callpara^.typ:=top_const;
- callpara^.value:=paraloc^.llvmloc.value;
- end;
- LOC_CREFERENCE:
- begin
- callpara^.typ:=top_ref;
- callpara^.sym:=paraloc^.llvmloc.sym;
- end
- else
- begin
- case paraloc^.loc of
- LOC_REFERENCE:
- begin
- if paraloc^.llvmvalueloc then
- internalerror(2014012307)
- else
- begin
- callpara^.typ:=top_reg;
- 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);
- end;
- callpara^.register:=res
- end;
- LOC_REGISTER,
- LOC_FPUREGISTER,
- LOC_MMREGISTER:
- begin
- callpara^.typ:=top_reg;
- { 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^.register:=paraloc^.register
- end;
- { empty records }
- LOC_VOID:
- begin
- callpara^.typ:=top_undef;
- 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; 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;
- 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.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
- tmpreg: tregister;
- 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
- { 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;
- 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,nil,sec_code,current_procinfo.procdef.alignment));
- 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 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
- 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);
- 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;
- { 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;
- pointedsize: asizeint;
- 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;
- case ptrdef.typ of
- pointerdef:
- begin
- pointedsize:=tpointerdef(ptrdef).pointeddef.size;
- { void, formaldef }
- if pointedsize=0 then
- pointedsize:=1;
- end;
- else
- begin
- { pointedsize is only used if the offset <> 0, to see whether we
- can use getelementptr if it's an exact multiple -> set pointedsize
- to a value that will never be a multiple as we can't "index" other
- types }
- pointedsize:=ref.offset+1;
- end;
- end;
- hreg2:=getaddressregister(list,ptrdef);
- { symbol+offset or base+offset with offset a multiple of the size ->
- use getelementptr }
- if (ref.index=NR_NO) and
- (ref.offset mod pointedsize=0) then
- begin
- ptrindex:=ref.offset div pointedsize;
- if assigned(ref.symbol) then
- reference_reset_symbol(tmpref,ref.symbol,0,ref.alignment,ref.volatility)
- else
- reference_reset_base(tmpref,ptrdef,ref.base,0,ref.temppos,ref.alignment,ref.volatility);
- list.concat(taillvm.getelementptr_reg_size_ref_size_const(hreg2,ptrdef,tmpref,ptruinttype,ptrindex,assigned(ref.symbol)));
- reference_reset_base(result,ptrdef,hreg2,0,ref.temppos,ref.alignment,ref.volatility);
- 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 "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.
|