hlcgllvm.pas 81 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045
  1. {
  2. Copyright (c) 2010, 2013 by Jonas Maebe
  3. Member of the Free Pascal development team
  4. This unit implements the LLVM high level code generator
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit hlcgllvm;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. globtype,cclasses,
  23. aasmbase,aasmdata,
  24. symbase,symconst,symtype,symdef,symsym,
  25. cpubase, hlcgobj, cgbase, cgutils, parabase, tgobj;
  26. type
  27. { thlcgllvm }
  28. thlcgllvm = class(thlcgobj)
  29. constructor create;
  30. procedure temp_to_ref(p: ptemprecord; out ref: treference); override;
  31. procedure a_load_ref_cgpara(list: TAsmList; size: tdef; const r: treference; const cgpara: TCGPara); override;
  32. procedure a_load_const_cgpara(list: TAsmList; tosize: tdef; a: tcgint; const cgpara: TCGPara); override;
  33. protected
  34. procedure a_load_ref_cgpara_init_src(list: TAsmList; const para: tcgpara; const initialref: treference; var refsize: tdef; out newref: treference);
  35. public
  36. procedure getcpuregister(list: TAsmList; r: Tregister); override;
  37. procedure ungetcpuregister(list: TAsmList; r: Tregister); override;
  38. procedure alloccpuregisters(list: TAsmList; rt: Tregistertype; const r: Tcpuregisterset); override;
  39. procedure deallocallcpuregisters(list: TAsmList); override;
  40. procedure a_bit_test_reg_reg_reg(list: TAsmList; bitnumbersize, valuesize, destsize: tdef; bitnumber, value, destreg: tregister); override;
  41. procedure a_bit_set_reg_reg(list: TAsmList; doset: boolean; bitnumbersize, destsize: tdef; bitnumber, dest: tregister); override;
  42. protected
  43. 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);
  44. public
  45. function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;override;
  46. function a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara; override;
  47. procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : tcgint;register : tregister);override;
  48. procedure a_load_const_ref(list: TAsmList; tosize: tdef; a: tcgint; const ref: treference);override;
  49. procedure a_load_reg_ref(list : TAsmList;fromsize, tosize : tdef;register : tregister;const ref : treference);override;
  50. procedure a_load_reg_reg(list : TAsmList;fromsize, tosize : tdef;reg1,reg2 : tregister);override;
  51. protected
  52. procedure gen_load_refaddrfull_anyreg(list: TAsmList; fromsize, tosize : tdef; const simpleref: treference; register: tregister; shuffle: pmmshuffle);
  53. function handle_agg_load_ref_anyreg(list: TasmList; var fromsize, tosize: tdef; var simpleref: treference; register: tregister; shuffle: pmmshuffle): boolean;
  54. public
  55. procedure a_load_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;register : tregister);override;
  56. procedure a_load_ref_ref(list: TAsmList; fromsize, tosize: tdef; const sref: treference; const dref: treference); override;
  57. protected
  58. procedure a_loadaddr_ref_reg_intern(list : TAsmList;fromsize, tosize : tdef;const ref : treference;r : tregister; makefromsizepointer: boolean);
  59. public
  60. procedure a_loadaddr_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;r : tregister);override;
  61. procedure a_op_const_reg(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; reg: TRegister); override;
  62. procedure a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister); override;
  63. procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister); override;
  64. procedure a_op_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; reg1, reg2: TRegister); override;
  65. procedure a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister;setflags : boolean;var ovloc : tlocation); override;
  66. procedure a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation); override;
  67. procedure a_cmp_const_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel); override;
  68. procedure a_cmp_reg_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel); override;
  69. procedure a_jmp_always(list : TAsmList;l: tasmlabel); override;
  70. procedure g_concatcopy(list : TAsmList;size: tdef; const source,dest : treference);override;
  71. procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister); override;
  72. procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference); override;
  73. procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister); override;
  74. procedure gen_proc_symbol(list: TAsmList); override;
  75. procedure handle_external_proc(list: TAsmList; pd: tprocdef; const importname: TSymStr); override;
  76. procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); override;
  77. procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean); override;
  78. protected
  79. procedure gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara); override;
  80. public
  81. procedure g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef); override;
  82. procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;var ovloc : tlocation); override;
  83. procedure g_ptrtypecast_reg(list: TAsmList; fromdef, todef: tdef; var reg: tregister); override;
  84. procedure g_ptrtypecast_ref(list: TAsmList; fromdef, todef: tdef; var ref: treference); override;
  85. procedure g_set_addr_nonbitpacked_field_ref(list: TAsmList; recdef: tabstractrecorddef; field: tfieldvarsym; var recref: treference); override;
  86. procedure a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle); override;
  87. procedure a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle); override;
  88. procedure a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister; shuffle: pmmshuffle); override;
  89. procedure a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; src, dst: tregister; shuffle: pmmshuffle); override;
  90. procedure a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize: tdef; intreg, mmreg: tregister; shuffle: pmmshuffle); override;
  91. procedure a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize: tdef; mmreg, intreg: tregister; shuffle: pmmshuffle); override;
  92. function get_call_result_cgpara(pd: tabstractprocdef; forceresdef: tdef): tcgpara; override;
  93. protected
  94. procedure gen_load_loc_function_result(list: TAsmList; vardef: tdef; const l: tlocation); override;
  95. public
  96. procedure gen_load_loc_cgpara(list: TAsmList; vardef: tdef; const l: tlocation; const cgpara: tcgpara); override;
  97. procedure gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean); override;
  98. {$ifdef cpuflags}
  99. { llvm doesn't have flags, but cpuflags is defined in case the real cpu
  100. has flags and we have to override the abstract methods to prevent
  101. warnings }
  102. procedure a_jmp_flags(list: TAsmList; const f: TResFlags; l: tasmlabel); override;
  103. procedure g_flags2reg(list: TAsmList; size: tdef; const f: tresflags; reg: TRegister); override;
  104. procedure g_flags2ref(list: TAsmList; size: tdef; const f: tresflags; const ref: TReference); override;
  105. {$endif cpuflags}
  106. { unimplemented or unnecessary routines }
  107. procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; srcsize, dstsize: tdef; src, dst: tregister); override;
  108. procedure g_stackpointer_alloc(list: TAsmList; size: longint); override;
  109. procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint); override;
  110. procedure g_adjust_self_value(list: TAsmList; procdef: tprocdef; ioffset: aint); override;
  111. procedure g_local_unwind(list: TAsmList; l: TAsmLabel); override;
  112. procedure gen_stack_check_size_para(list: TAsmList); override;
  113. procedure gen_stack_check_call(list: TAsmList); override;
  114. procedure varsym_set_localloc(list: TAsmList; vs: tabstractnormalvarsym); override;
  115. procedure paravarsym_set_initialloc_to_paraloc(vs: tparavarsym); override;
  116. procedure g_external_wrapper(list: TAsmList; procdef: tprocdef; const wrappername, externalname: string; global: boolean); override;
  117. { def is a pointerdef or implicit pointer type (class, classref, procvar,
  118. dynamic array, ...). }
  119. function make_simple_ref_ptr(list: TAsmList; const ref: treference; ptrdef: tdef): treference;
  120. { def is the type of the data stored in memory pointed to by ref, not
  121. a pointer to this type }
  122. function make_simple_ref(list: TAsmList; const ref: treference; def: tdef): treference;
  123. protected
  124. procedure paraloctoloc(const paraloc: pcgparalocation; out hloc: tlocation);
  125. procedure set_call_function_result(const list: TAsmList; const pd: tabstractprocdef; const llvmretdef, hlretdef: tdef; const resval: tregister; var retpara: tcgpara);
  126. end;
  127. procedure create_hlcodegen;
  128. implementation
  129. uses
  130. verbose,cutils,globals,fmodule,constexp,systems,
  131. defutil,llvmdef,llvmsym,
  132. aasmtai,aasmcpu,
  133. aasmllvm,llvmbase,tgllvm,
  134. symtable,symllvm,
  135. paramgr,llvmpara,
  136. procinfo,cpuinfo,cgobj,cgllvm,cghlcpu,
  137. cgcpu,hlcgcpu;
  138. const
  139. topcg2llvmop: array[topcg] of tllvmop =
  140. { OP_NONE OP_MOVE OP_ADD OP_AND OP_DIV OP_IDIV OP_IMUL OP_MUL }
  141. (la_none, la_none, la_add, la_and, la_udiv, la_sdiv, la_mul, la_mul,
  142. { OP_NEG OP_NOT OP_OR OP_SAR OP_SHL OP_SHR OP_SUB OP_XOR }
  143. la_none, la_none, la_or, la_ashr, la_shl, la_lshr, la_sub, la_xor,
  144. { OP_ROL OP_ROR }
  145. la_none, la_none);
  146. constructor thlcgllvm.create;
  147. begin
  148. inherited
  149. end;
  150. procedure thlcgllvm.temp_to_ref(p: ptemprecord; out ref: treference);
  151. begin
  152. { on the LLVM target, every temp is independent and encoded via a
  153. separate temp register whose superregister number is stored in p^.pos }
  154. reference_reset_base(ref,voidstackpointertype,newreg(R_TEMPREGISTER,p^.pos,R_SUBWHOLE),0,p^.alignment);
  155. end;
  156. procedure thlcgllvm.a_load_ref_cgpara(list: TAsmList; size: tdef; const r: treference; const cgpara: TCGPara);
  157. var
  158. tmpref, initialref, ref: treference;
  159. fielddef,
  160. orgsize: tdef;
  161. location: pcgparalocation;
  162. sizeleft,
  163. totaloffset: asizeint;
  164. paralocidx: longint;
  165. userecord: boolean;
  166. begin
  167. location:=cgpara.location;
  168. sizeleft:=cgpara.intsize;
  169. totaloffset:=0;
  170. orgsize:=size;
  171. a_load_ref_cgpara_init_src(list,cgpara,r,size,initialref);
  172. userecord:=
  173. (orgsize<>size) and
  174. assigned(cgpara.location^.next);
  175. paralocidx:=0;
  176. while assigned(location) do
  177. begin
  178. if userecord then
  179. begin
  180. { llvmparadef is a record in this case, with every field
  181. corresponding to a single paraloc (fielddef is unused, because
  182. it will be equivalent to location^.def -- see below) }
  183. g_setup_load_field_by_name(list,trecorddef(size),'F'+tostr(paralocidx),initialref,tmpref,fielddef);
  184. end
  185. else
  186. tmpref:=initialref;
  187. paramanager.allocparaloc(list,location);
  188. case location^.loc of
  189. LOC_REGISTER,LOC_CREGISTER:
  190. begin
  191. { byval parameter -> load the address rather than the value }
  192. if not location^.llvmvalueloc then
  193. a_loadaddr_ref_reg(list,tpointerdef(location^.def).pointeddef,location^.def,tmpref,location^.register)
  194. { if this parameter is split into multiple paralocs via
  195. record fields, load the current paraloc. The type of the
  196. paraloc and of the current record field will match by
  197. construction (the record is build from the paraloc
  198. types) }
  199. else if userecord then
  200. a_load_ref_reg(list,location^.def,location^.def,tmpref,location^.register)
  201. { if the parameter is passed in a single paraloc, the
  202. paraloc's type may be different from the declared type
  203. -> use the original complete parameter size as source so
  204. we can insert a type conversion if necessary }
  205. else
  206. a_load_ref_reg(list,size,location^.def,tmpref,location^.register)
  207. end;
  208. LOC_REFERENCE,LOC_CREFERENCE:
  209. begin
  210. if assigned(location^.next) then
  211. internalerror(2010052906);
  212. reference_reset_base(ref,cpointerdef.getreusable(size),location^.reference.index,location^.reference.offset,newalignment(cgpara.alignment,cgpara.intsize-sizeleft));
  213. if (def_cgsize(size)<>OS_NO) and
  214. (size.size=sizeleft) and
  215. (sizeleft<=sizeof(aint)) then
  216. a_load_ref_ref(list,size,location^.def,tmpref,ref)
  217. else
  218. { use concatcopy, because the parameter can be larger than }
  219. { what the OS_* constants can handle }
  220. g_concatcopy(list,location^.def,tmpref,ref);
  221. end;
  222. LOC_MMREGISTER,LOC_CMMREGISTER:
  223. begin
  224. case location^.size of
  225. OS_F32,
  226. OS_F64,
  227. OS_F128:
  228. a_loadmm_ref_reg(list,location^.def,location^.def,tmpref,location^.register,mms_movescalar);
  229. OS_M8..OS_M128,
  230. OS_MS8..OS_MS128,
  231. OS_32..OS_128,
  232. { OS_NO is for records of non-power-of-two sizes that have to
  233. be passed in MM registers -> never scalar floats }
  234. OS_NO:
  235. a_loadmm_ref_reg(list,location^.def,location^.def,tmpref,location^.register,nil);
  236. else
  237. internalerror(2010053101);
  238. end;
  239. end
  240. else
  241. internalerror(2010053111);
  242. end;
  243. inc(totaloffset,tcgsize2size[location^.size]);
  244. dec(sizeleft,tcgsize2size[location^.size]);
  245. location:=location^.next;
  246. inc(paralocidx);
  247. end;
  248. end;
  249. procedure thlcgllvm.a_load_const_cgpara(list: TAsmList; tosize: tdef; a: tcgint; const cgpara: TCGPara);
  250. begin
  251. if is_ordinal(cgpara.def) then
  252. begin
  253. cgpara.check_simple_location;
  254. paramanager.alloccgpara(list,cgpara);
  255. if cgpara.location^.shiftval<0 then
  256. a:=a shl -cgpara.location^.shiftval;
  257. cgpara.location^.llvmloc.loc:=LOC_CONSTANT;
  258. cgpara.location^.llvmloc.value:=a;
  259. end
  260. else
  261. inherited;
  262. end;
  263. procedure thlcgllvm.a_load_ref_cgpara_init_src(list: TAsmList; const para: tcgpara; const initialref: treference; var refsize: tdef; out newref: treference);
  264. var
  265. newrefsize: tdef;
  266. reg: tregister;
  267. begin
  268. newrefsize:=llvmgetcgparadef(para,true);
  269. if refsize<>newrefsize then
  270. begin
  271. reg:=getaddressregister(list,cpointerdef.getreusable(newrefsize));
  272. a_loadaddr_ref_reg(list,refsize,cpointerdef.getreusable(newrefsize),initialref,reg);
  273. reference_reset_base(newref,cpointerdef.getreusable(newrefsize),reg,0,initialref.alignment);
  274. refsize:=newrefsize;
  275. end
  276. else
  277. newref:=initialref;
  278. end;
  279. procedure thlcgllvm.getcpuregister(list: TAsmList; r: Tregister);
  280. begin
  281. { don't do anything }
  282. end;
  283. procedure thlcgllvm.ungetcpuregister(list: TAsmList; r: Tregister);
  284. begin
  285. { don't do anything }
  286. end;
  287. procedure thlcgllvm.alloccpuregisters(list: TAsmList; rt: Tregistertype; const r: Tcpuregisterset);
  288. begin
  289. { don't do anything }
  290. end;
  291. procedure thlcgllvm.deallocallcpuregisters(list: TAsmList);
  292. begin
  293. { don't do anything }
  294. end;
  295. procedure thlcgllvm.a_bit_test_reg_reg_reg(list: TAsmList; bitnumbersize, valuesize, destsize: tdef; bitnumber, value, destreg: tregister);
  296. var
  297. tmpbitnumberreg: tregister;
  298. begin
  299. { unlike other architectures, llvm requires the bitnumber register to
  300. have the same size as the shifted register }
  301. if bitnumbersize.size<>valuesize.size then
  302. begin
  303. tmpbitnumberreg:=hlcg.getintregister(list,valuesize);
  304. a_load_reg_reg(list,bitnumbersize,valuesize,bitnumber,tmpbitnumberreg);
  305. bitnumbersize:=valuesize;
  306. bitnumber:=tmpbitnumberreg;
  307. end;
  308. inherited;
  309. end;
  310. procedure thlcgllvm.a_bit_set_reg_reg(list: TAsmList; doset: boolean; bitnumbersize, destsize: tdef; bitnumber, dest: tregister);
  311. var
  312. tmpbitnumberreg: tregister;
  313. begin
  314. { unlike other architectures, llvm requires the bitnumber register to
  315. have the same size as the shifted register }
  316. if bitnumbersize.size<>destsize.size then
  317. begin
  318. tmpbitnumberreg:=hlcg.getintregister(list,destsize);
  319. a_load_reg_reg(list,bitnumbersize,destsize,bitnumber,tmpbitnumberreg);
  320. bitnumbersize:=destsize;
  321. bitnumber:=tmpbitnumberreg;
  322. end;
  323. inherited;
  324. end;
  325. function get_call_pd(pd: tabstractprocdef): tdef;
  326. begin
  327. if (pd.typ=procdef) or
  328. not pd.is_addressonly then
  329. { we get a pointerdef rather than a procvardef so that if we have to
  330. insert an external declaration for this procdef in llvmtype, we don't
  331. have to create another procdef from the procvardef we've just created.
  332. With a pointerdef, we can just get the pointeddef again. A pointerdef
  333. is also much cheaper to create, and in llvm a provardef is a "function
  334. pointer", so a pointer to a procdef is the same as a procvar as far
  335. as llvm is concerned }
  336. result:=cpointerdef.getreusable(pd)
  337. else
  338. result:=pd
  339. end;
  340. 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);
  341. procedure load_ref_anyreg(def: tdef; const ref: treference; reg: tregister; var callpara: pllvmcallpara);
  342. begin
  343. case getregtype(reg) of
  344. R_INTREGISTER,
  345. R_ADDRESSREGISTER:
  346. begin
  347. a_load_ref_reg(list,def,def,ref,reg);
  348. callpara^.loc:=LOC_REGISTER;
  349. end;
  350. R_FPUREGISTER:
  351. begin
  352. a_loadfpu_ref_reg(list,def,def,ref,reg);
  353. callpara^.loc:=LOC_FPUREGISTER;
  354. end;
  355. R_MMREGISTER:
  356. begin
  357. a_loadmm_ref_reg(list,def,def,ref,reg,mms_movescalar);
  358. callpara^.loc:=LOC_MMREGISTER;
  359. end;
  360. else
  361. internalerror(2014012213);
  362. end;
  363. end;
  364. var
  365. i: longint;
  366. href: treference;
  367. callpara: pllvmcallpara;
  368. paraloc: pcgparalocation;
  369. begin
  370. callparas:=tfplist.Create;
  371. for i:=0 to high(paras) do
  372. begin
  373. paraloc:=paras[i]^.location;
  374. while assigned(paraloc) do
  375. begin
  376. new(callpara);
  377. callpara^.def:=paraloc^.def;
  378. llvmextractvalueextinfo(paras[i]^.def, callpara^.def, callpara^.valueext);
  379. if paraloc^.llvmloc.loc=LOC_CONSTANT then
  380. begin
  381. callpara^.loc:=LOC_CONSTANT;
  382. callpara^.value:=paraloc^.llvmloc.value;
  383. end
  384. else
  385. begin
  386. callpara^.loc:=paraloc^.loc;
  387. case callpara^.loc of
  388. LOC_REFERENCE:
  389. begin
  390. if paraloc^.llvmvalueloc then
  391. internalerror(2014012307)
  392. else
  393. begin
  394. reference_reset_base(href, cpointerdef.getreusable(callpara^.def), paraloc^.reference.index, paraloc^.reference.offset, paraloc^.def.alignment);
  395. res:=getregisterfordef(list, paraloc^.def);
  396. load_ref_anyreg(callpara^.def, href, res, callpara);
  397. end;
  398. callpara^.reg:=res
  399. end;
  400. LOC_REGISTER,
  401. LOC_FPUREGISTER,
  402. LOC_MMREGISTER:
  403. begin
  404. { undo explicit value extension }
  405. if callpara^.valueext<>lve_none then
  406. begin
  407. res:=getregisterfordef(list, callpara^.def);
  408. a_load_reg_reg(list, paraloc^.def, callpara^.def, paraloc^.register, res);
  409. paraloc^.register:=res;
  410. end;
  411. callpara^.reg:=paraloc^.register
  412. end;
  413. { empty records }
  414. LOC_VOID:
  415. begin
  416. end
  417. else
  418. internalerror(2014010605);
  419. end;
  420. end;
  421. callparas.add(callpara);
  422. paraloc:=paraloc^.next;
  423. end;
  424. end;
  425. { the Pascal level may expect a different returndef compared to the
  426. declared one }
  427. if not assigned(forceresdef) then
  428. hlretdef:=pd.returndef
  429. else
  430. hlretdef:=forceresdef;
  431. { llvm will always expect the original return def }
  432. if not paramanager.ret_in_param(hlretdef, pd) then
  433. llvmretdef:=llvmgetcgparadef(pd.funcretloc[callerside], true)
  434. else
  435. llvmretdef:=voidtype;
  436. if not is_void(llvmretdef) then
  437. res:=getregisterfordef(list, llvmretdef)
  438. else
  439. res:=NR_NO;
  440. { if this is a complex procvar, get the non-tmethod-like equivalent }
  441. if (pd.typ=procvardef) and
  442. not pd.is_addressonly then
  443. pd:=tprocvardef(cprocvardef.getreusableprocaddr(pd));
  444. end;
  445. function thlcgllvm.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;
  446. var
  447. callparas: tfplist;
  448. llvmretdef,
  449. hlretdef: tdef;
  450. res: tregister;
  451. begin
  452. a_call_common(list,pd,paras,forceresdef,res,hlretdef,llvmretdef,callparas);
  453. list.concat(taillvm.call_size_name_paras(get_call_pd(pd),res,llvmretdef,current_asmdata.RefAsmSymbol(s,AT_FUNCTION),callparas));
  454. result:=get_call_result_cgpara(pd,forceresdef);
  455. set_call_function_result(list,pd,llvmretdef,hlretdef,res,result);
  456. end;
  457. function thlcgllvm.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara;
  458. var
  459. callparas: tfplist;
  460. llvmretdef,
  461. hlretdef: tdef;
  462. res: tregister;
  463. begin
  464. a_call_common(list,pd,paras,nil,res,hlretdef,llvmretdef,callparas);
  465. list.concat(taillvm.call_size_reg_paras(get_call_pd(pd),res,llvmretdef,reg,callparas));
  466. result:=get_call_result_cgpara(pd,nil);
  467. set_call_function_result(list,pd,llvmretdef,hlretdef,res,result);
  468. end;
  469. procedure thlcgllvm.a_load_const_reg(list: TAsmList; tosize: tdef; a: tcgint; register: tregister);
  470. begin
  471. list.concat(taillvm.op_reg_size_const_size(llvmconvop(ptrsinttype,tosize,false),register,ptrsinttype,a,tosize))
  472. end;
  473. procedure thlcgllvm.a_load_const_ref(list: TAsmList; tosize: tdef; a: tcgint; const ref: treference);
  474. var
  475. sref: treference;
  476. begin
  477. { llvm instructions do not support pointer constants -> only directly
  478. encode for integers; a_load_const_reg() handles pointers properly }
  479. if is_ordinal(tosize) or
  480. is_64bit(tosize) then
  481. begin
  482. sref:=make_simple_ref(list,ref,tosize);
  483. list.concat(taillvm.op_size_const_size_ref(la_store,tosize,a,cpointerdef.getreusable(tosize),sref))
  484. end
  485. else
  486. inherited;
  487. end;
  488. function def2intdef(fromsize, tosize: tdef): tdef;
  489. begin
  490. { we cannot zero-extend from/to anything but ordinal/enum
  491. types }
  492. if not(tosize.typ in [orddef,enumdef]) then
  493. internalerror(2014012305);
  494. { will give an internalerror if def_cgsize() returns OS_NO, which is
  495. what we want }
  496. result:=cgsize_orddef(def_cgsize(fromsize));
  497. end;
  498. procedure thlcgllvm.a_load_reg_ref(list: TAsmList; fromsize, tosize: tdef; register: tregister; const ref: treference);
  499. var
  500. tmpref,
  501. sref: treference;
  502. hreg,
  503. hreg2: tregister;
  504. tmpsize: tdef;
  505. begin
  506. sref:=make_simple_ref(list,ref,tosize);
  507. hreg:=register;
  508. (* typecast the pointer to the value instead of the value itself if
  509. they have the same size but are of different kinds, because we can't
  510. e.g. typecast a loaded <{i32, i32}> to an i64 *)
  511. if (llvmaggregatetype(fromsize) or
  512. llvmaggregatetype(tosize)) and
  513. (fromsize<>tosize) then
  514. begin
  515. if fromsize.size>tosize.size then
  516. begin
  517. { if source size is larger than the target size, we have to
  518. truncate it before storing. Unfortunately, we cannot truncate
  519. records (nor bitcast them to integers), so we first have to
  520. store them to memory and then bitcast the pointer to them
  521. We can't truncate an integer to 3/5/6/7 bytes either, so also
  522. pass via a temp in that case
  523. }
  524. if (fromsize.typ in [arraydef,recorddef]) or
  525. (tosize.size in [3,5,6,7]) then
  526. begin
  527. { store struct/array-in-register to memory }
  528. tg.gethltemp(list,fromsize,fromsize.size,tt_normal,tmpref);
  529. a_load_reg_ref(list,fromsize,fromsize,register,tmpref);
  530. { typecast pointer to memory into pointer to integer type }
  531. hreg:=getaddressregister(list,cpointerdef.getreusable(tosize));
  532. a_loadaddr_ref_reg(list,fromsize,cpointerdef.getreusable(tosize),tmpref,hreg);
  533. reference_reset_base(sref,cpointerdef.getreusable(tosize),hreg,0,tmpref.alignment);
  534. { load the integer from the temp into the destination }
  535. a_load_ref_ref(list,tosize,tosize,sref,ref);
  536. tg.ungettemp(list,tmpref);
  537. end
  538. else
  539. begin
  540. tmpsize:=def2intdef(tosize,fromsize);
  541. hreg:=getintregister(list,tmpsize);
  542. { truncate the integer }
  543. a_load_reg_reg(list,fromsize,tmpsize,register,hreg);
  544. { store it to memory (it will now be of the same size as the
  545. struct, and hence another path will be followed in this
  546. method) }
  547. a_load_reg_ref(list,tmpsize,tosize,hreg,sref);
  548. end;
  549. exit;
  550. end
  551. else
  552. begin
  553. hreg2:=getaddressregister(list,cpointerdef.getreusable(fromsize));
  554. a_loadaddr_ref_reg(list,tosize,cpointerdef.getreusable(fromsize),sref,hreg2);
  555. reference_reset_base(sref,cpointerdef.getreusable(fromsize),hreg2,0,sref.alignment);
  556. tosize:=fromsize;
  557. end;
  558. end
  559. else if fromsize<>tosize then
  560. begin
  561. hreg:=getregisterfordef(list,tosize);
  562. a_load_reg_reg(list,fromsize,tosize,register,hreg);
  563. end;
  564. list.concat(taillvm.op_size_reg_size_ref(la_store,tosize,hreg,cpointerdef.getreusable(tosize),sref));
  565. end;
  566. procedure thlcgllvm.a_load_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister);
  567. var
  568. op: tllvmop;
  569. tmpreg: tregister;
  570. tmpintdef: tdef;
  571. begin
  572. op:=llvmconvop(fromsize,tosize,true);
  573. { converting from pointer to something else and vice versa is only
  574. possible via an intermediate pass to integer. Same for "something else"
  575. to pointer. }
  576. case op of
  577. la_ptrtoint_to_x,
  578. la_x_to_inttoptr:
  579. begin
  580. { convert via an integer with the same size as "x" }
  581. if op=la_ptrtoint_to_x then
  582. begin
  583. tmpintdef:=cgsize_orddef(def_cgsize(tosize));
  584. op:=la_bitcast
  585. end
  586. else
  587. begin
  588. tmpintdef:=cgsize_orddef(def_cgsize(fromsize));
  589. op:=la_inttoptr;
  590. end;
  591. tmpreg:=getintregister(list,tmpintdef);
  592. a_load_reg_reg(list,fromsize,tmpintdef,reg1,tmpreg);
  593. reg1:=tmpreg;
  594. fromsize:=tmpintdef;
  595. end;
  596. end;
  597. { reg2 = bitcast fromsize reg1 to tosize }
  598. list.concat(taillvm.op_reg_size_reg_size(op,reg2,fromsize,reg1,tosize));
  599. end;
  600. procedure thlcgllvm.gen_load_refaddrfull_anyreg(list: TAsmList; fromsize, tosize: tdef; const simpleref: treference; register: tregister; shuffle: pmmshuffle);
  601. var
  602. tmpref,
  603. tmpref2: treference;
  604. begin
  605. { can't bitcast records/arrays }
  606. if (llvmaggregatetype(fromsize) or
  607. llvmaggregatetype(tosize)) and
  608. (fromsize<>tosize) then
  609. begin
  610. if fromsize.size>tosize.size then
  611. begin
  612. tg.gethltemp(list,fromsize,fromsize.size,tt_normal,tmpref);
  613. tmpref2:=tmpref;
  614. g_ptrtypecast_ref(list,cpointerdef.getreusable(fromsize),cpointerdef.getreusable(tosize),tmpref2);
  615. end
  616. else
  617. begin
  618. tg.gethltemp(list,tosize,tosize.size,tt_normal,tmpref);
  619. tmpref2:=tmpref;
  620. g_ptrtypecast_ref(list,cpointerdef.getreusable(tosize),cpointerdef.getreusable(fromsize),tmpref);
  621. end;
  622. list.concat(taillvm.op_size_ref_size_ref(la_store,fromsize,simpleref,cpointerdef.getreusable(fromsize),tmpref));
  623. case getregtype(register) of
  624. R_INTREGISTER,
  625. R_ADDRESSREGISTER:
  626. a_load_ref_reg(list,tosize,tosize,tmpref2,register);
  627. R_FPUREGISTER:
  628. a_loadfpu_ref_reg(list,tosize,tosize,tmpref2,register);
  629. R_MMREGISTER:
  630. a_loadmm_ref_reg(list,tosize,tosize,tmpref2,register,shuffle);
  631. else
  632. internalerror(2016061901);
  633. end;
  634. tg.ungettemp(list,tmpref);
  635. end
  636. else
  637. list.concat(taillvm.op_reg_size_ref_size(llvmconvop(fromsize,tosize,false),register,fromsize,simpleref,tosize))
  638. end;
  639. function thlcgllvm.handle_agg_load_ref_anyreg(list: TasmList; var fromsize, tosize: tdef; var simpleref: treference; register: tregister; shuffle: pmmshuffle): boolean;
  640. var
  641. tmpref,
  642. tmpref2: treference;
  643. firstshuffle: pmmshuffle;
  644. begin
  645. if fromsize.size<tosize.size then
  646. begin
  647. { allocate a temp of size tosize, typecast it to the
  648. (smaller) fromsize, load the source in it, and then
  649. load the destination from it. The extra bits will contain
  650. garbage, but they should never be used. }
  651. tg.gethltemp(list,tosize,tosize.size,tt_persistent,tmpref);
  652. tmpref2:=tmpref;
  653. g_ptrtypecast_ref(list,cpointerdef.getreusable(tosize),cpointerdef.getreusable(fromsize),tmpref2);
  654. case getregtype(register) of
  655. R_INTREGISTER,
  656. R_ADDRESSREGISTER:
  657. begin
  658. a_load_ref_ref(list,fromsize,fromsize,simpleref,tmpref2);
  659. a_load_ref_reg(list,tosize,tosize,tmpref,register);
  660. end;
  661. R_FPUREGISTER:
  662. begin
  663. a_loadfpu_ref_ref(list,fromsize,fromsize,simpleref,tmpref2);
  664. a_loadfpu_ref_reg(list,tosize,tosize,tmpref,register);
  665. end;
  666. R_MMREGISTER:
  667. begin
  668. { don't shuffle twice }
  669. if shuffle=mms_movescalar then
  670. firstshuffle:=shuffle
  671. else
  672. firstshuffle:=nil;
  673. a_loadmm_ref_ref(list,fromsize,fromsize,simpleref,tmpref2,firstshuffle);
  674. a_loadmm_ref_reg(list,tosize,tosize,tmpref,register,shuffle);
  675. end;
  676. end;
  677. tg.ungettemp(list,tmpref);
  678. result:=true;
  679. end
  680. else
  681. begin
  682. (* typecast the pointer to the value instead of the value
  683. itself if tosize<=fromsize but they are of different
  684. kinds, because we can't e.g. bitcast a loaded <{i32, i32}>
  685. to an i64 *)
  686. g_ptrtypecast_ref(list,cpointerdef.getreusable(fromsize),cpointerdef.getreusable(tosize),simpleref);
  687. fromsize:=tosize;
  688. result:=false;
  689. end;
  690. end;
  691. procedure thlcgllvm.a_load_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; register: tregister);
  692. var
  693. sref: treference;
  694. hreg: tregister;
  695. begin
  696. sref:=make_simple_ref(list,ref,fromsize);
  697. { "named register"? }
  698. if sref.refaddr=addr_full then
  699. gen_load_refaddrfull_anyreg(list,fromsize,tosize,sref,register,nil)
  700. else
  701. begin
  702. if ((fromsize.typ in [arraydef,recorddef]) or
  703. (tosize.typ in [arraydef,recorddef])) and
  704. (fromsize<>tosize) then
  705. begin
  706. if handle_agg_load_ref_anyreg(list,fromsize,tosize,sref,register,nil) then
  707. exit;
  708. end;
  709. hreg:=register;
  710. if fromsize<>tosize then
  711. hreg:=getregisterfordef(list,fromsize);
  712. list.concat(taillvm.op_reg_size_ref(la_load,hreg,cpointerdef.getreusable(fromsize),sref));
  713. if hreg<>register then
  714. a_load_reg_reg(list,fromsize,tosize,hreg,register);
  715. end;
  716. end;
  717. procedure thlcgllvm.a_load_ref_ref(list: TAsmList; fromsize, tosize: tdef; const sref: treference; const dref: treference);
  718. var
  719. sdref: treference;
  720. begin
  721. if (fromsize=tosize) and
  722. (sref.refaddr=addr_full) then
  723. begin
  724. sdref:=make_simple_ref(list,dref,tosize);
  725. list.concat(taillvm.op_size_ref_size_ref(la_store,fromsize,sref,cpointerdef.getreusable(tosize),sdref));
  726. end
  727. else if (fromsize=tosize) and
  728. not(fromsize.typ in [orddef,floatdef,enumdef]) and
  729. (sref.refaddr<>addr_full) and
  730. (fromsize.size>2*sizeof(aint)) then
  731. g_concatcopy(list,fromsize,sref,dref)
  732. else
  733. inherited
  734. end;
  735. procedure thlcgllvm.a_loadaddr_ref_reg_intern(list: TAsmList; fromsize, tosize: tdef; const ref: treference; r: tregister; makefromsizepointer: boolean);
  736. var
  737. sref: treference;
  738. begin
  739. { can't take the address of a 'named register' }
  740. if ref.refaddr=addr_full then
  741. internalerror(2013102306);
  742. if makefromsizepointer then
  743. fromsize:=cpointerdef.getreusable(fromsize);
  744. sref:=make_simple_ref_ptr(list,ref,fromsize);
  745. list.concat(taillvm.op_reg_size_ref_size(la_bitcast,r,fromsize,sref,tosize));
  746. end;
  747. procedure thlcgllvm.a_loadaddr_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; r: tregister);
  748. begin
  749. a_loadaddr_ref_reg_intern(list,fromsize,tosize,ref,r,true);
  750. end;
  751. procedure thlcgllvm.a_op_const_reg(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; reg: TRegister);
  752. begin
  753. a_op_const_reg_reg(list,op,size,a,reg,reg);
  754. end;
  755. procedure thlcgllvm.a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister);
  756. var
  757. tmpreg: tregister;
  758. begin
  759. if (def2regtyp(size)=R_INTREGISTER) and
  760. (topcg2llvmop[op]<>la_none) then
  761. list.concat(taillvm.op_reg_size_reg_const(topcg2llvmop[op],dst,size,src,a))
  762. else
  763. begin
  764. { default implementation is not SSA-safe }
  765. tmpreg:=getregisterfordef(list,size);
  766. a_load_const_reg(list,size,a,tmpreg);
  767. a_op_reg_reg_reg(list,op,size,tmpreg,src,dst);
  768. end;
  769. end;
  770. procedure thlcgllvm.a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister);
  771. var
  772. orgdst,
  773. tmpreg1,
  774. tmpreg2,
  775. tmpreg3: tregister;
  776. opsize: tdef;
  777. begin
  778. orgdst:=dst;
  779. opsize:=size;
  780. { always perform using integer registers, because math operations on
  781. pointers are not supported (except via getelementptr, possible future
  782. optimization) }
  783. if def2regtyp(size)=R_ADDRESSREGISTER then
  784. begin
  785. opsize:=ptruinttype;
  786. tmpreg1:=getintregister(list,ptruinttype);
  787. a_load_reg_reg(list,size,ptruinttype,src1,tmpreg1);
  788. src1:=tmpreg1;
  789. tmpreg1:=getintregister(list,ptruinttype);
  790. a_load_reg_reg(list,size,ptruinttype,src2,tmpreg1);
  791. src2:=tmpreg1;
  792. dst:=getintregister(list,ptruinttype);
  793. end;
  794. if topcg2llvmop[op]<>la_none then
  795. list.concat(taillvm.op_reg_size_reg_reg(topcg2llvmop[op],dst,opsize,src2,src1))
  796. else
  797. begin
  798. case op of
  799. OP_NEG:
  800. { %dst = sub size 0, %src1 }
  801. list.concat(taillvm.op_reg_size_const_reg(la_sub,dst,opsize,0,src1));
  802. OP_NOT:
  803. { %dst = xor size -1, %src1 }
  804. list.concat(taillvm.op_reg_size_const_reg(la_xor,dst,opsize,-1,src1));
  805. OP_ROL:
  806. begin
  807. tmpreg1:=getintregister(list,opsize);
  808. tmpreg2:=getintregister(list,opsize);
  809. tmpreg3:=getintregister(list,opsize);
  810. { tmpreg1 := (tcgsize2size[size]*8 - (src1 and (tcgsize2size[size]*8-1) }
  811. list.concat(taillvm.op_reg_size_const_reg(la_and,tmpreg1,opsize,opsize.size*8-1,src1));
  812. list.concat(taillvm.op_reg_size_const_reg(la_sub,tmpreg2,opsize,opsize.size*8,tmpreg1));
  813. { tmpreg3 := src2 shr tmpreg2 }
  814. a_op_reg_reg_reg(list,OP_SHR,opsize,tmpreg2,src2,tmpreg3);
  815. { tmpreg2:= src2 shl tmpreg1 }
  816. tmpreg2:=getintregister(list,opsize);
  817. a_op_reg_reg_reg(list,OP_SHL,opsize,tmpreg1,src2,tmpreg2);
  818. { dst := tmpreg2 or tmpreg3 }
  819. a_op_reg_reg_reg(list,OP_OR,opsize,tmpreg2,tmpreg3,dst);
  820. end;
  821. OP_ROR:
  822. begin
  823. tmpreg1:=getintregister(list,size);
  824. tmpreg2:=getintregister(list,size);
  825. tmpreg3:=getintregister(list,size);
  826. { tmpreg1 := (tcgsize2size[size]*8 - (src1 and (tcgsize2size[size]*8-1) }
  827. list.concat(taillvm.op_reg_size_const_reg(la_and,tmpreg1,opsize,opsize.size*8-1,src1));
  828. list.concat(taillvm.op_reg_size_const_reg(la_sub,tmpreg2,opsize,opsize.size*8,tmpreg1));
  829. { tmpreg3 := src2 shl tmpreg2 }
  830. a_op_reg_reg_reg(list,OP_SHL,opsize,tmpreg2,src2,tmpreg3);
  831. { tmpreg2:= src2 shr tmpreg1 }
  832. tmpreg2:=getintregister(list,opsize);
  833. a_op_reg_reg_reg(list,OP_SHR,opsize,tmpreg1,src2,tmpreg2);
  834. { dst := tmpreg2 or tmpreg3 }
  835. a_op_reg_reg_reg(list,OP_OR,opsize,tmpreg2,tmpreg3,dst);
  836. end;
  837. else
  838. internalerror(2010081310);
  839. end;
  840. end;
  841. if dst<>orgdst then
  842. a_load_reg_reg(list,opsize,size,dst,orgdst);
  843. end;
  844. procedure thlcgllvm.a_op_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; reg1, reg2: TRegister);
  845. begin
  846. a_op_reg_reg_reg(list,op,size,reg1,reg2,reg2);
  847. end;
  848. procedure thlcgllvm.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister; setflags: boolean; var ovloc: tlocation);
  849. var
  850. hreg: tregister;
  851. begin
  852. if not setflags then
  853. begin
  854. inherited;
  855. exit;
  856. end;
  857. hreg:=getintregister(list,size);
  858. a_load_const_reg(list,size,a,hreg);
  859. a_op_reg_reg_reg_checkoverflow(list,op,size,hreg,src,dst,setflags,ovloc);
  860. end;
  861. procedure thlcgllvm.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister; setflags: boolean; var ovloc: tlocation);
  862. var
  863. calcsize: tdef;
  864. tmpsrc1,
  865. tmpsrc2,
  866. tmpdst: tregister;
  867. signed,
  868. docheck: boolean;
  869. begin
  870. docheck:=size.size>=ossinttype.size;
  871. if not setflags or
  872. not docheck then
  873. begin
  874. inherited a_op_reg_reg_reg_checkoverflow(list,op,size,src1,src2,dst,false,ovloc);
  875. exit;
  876. end;
  877. { extend values to twice their original width (one bit extra is enough,
  878. but adding support for 9/17/33/65 bit types just for this is overkill) }
  879. signed:=is_signed(size);
  880. case size.size of
  881. 1:
  882. if signed then
  883. calcsize:=s16inttype
  884. else
  885. calcsize:=u16inttype;
  886. 2:
  887. if signed then
  888. calcsize:=s32inttype
  889. else
  890. calcsize:=u32inttype;
  891. 4:
  892. if signed then
  893. calcsize:=s64inttype
  894. else
  895. calcsize:=u64inttype;
  896. 8:
  897. if signed then
  898. calcsize:=s128inttype
  899. else
  900. calcsize:=u128inttype;
  901. else
  902. internalerror(2015122503);
  903. end;
  904. tmpsrc1:=getintregister(list,calcsize);
  905. a_load_reg_reg(list,size,calcsize,src1,tmpsrc1);
  906. tmpsrc2:=getintregister(list,calcsize);
  907. a_load_reg_reg(list,size,calcsize,src2,tmpsrc2);
  908. tmpdst:=getintregister(list,calcsize);
  909. { perform the calculation with twice the width }
  910. a_op_reg_reg_reg(list,op,calcsize,tmpsrc1,tmpsrc2,tmpdst);
  911. { signed/unsigned overflow occurs if signed/unsigned truncation of the
  912. result is different from the actual result -> extend again and compare }
  913. a_load_reg_reg(list,calcsize,size,tmpdst,dst);
  914. tmpsrc1:=getintregister(list,calcsize);
  915. a_load_reg_reg(list,size,calcsize,dst,tmpsrc1);
  916. location_reset(ovloc,LOC_REGISTER,OS_8);
  917. ovloc.register:=getintregister(list,llvmbool1type);
  918. list.concat(taillvm.op_reg_cond_size_reg_reg(la_icmp,ovloc.register,OC_NE,calcsize,tmpsrc1,tmpdst));
  919. end;
  920. procedure thlcgllvm.a_cmp_const_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel);
  921. var
  922. tmpreg : tregister;
  923. invert: boolean;
  924. fallthroughlab, falselab, tmplab: tasmlabel;
  925. begin
  926. { since all comparisons return their results in a register, we'll often
  927. get comparisons against true/false -> optimise }
  928. if (size=pasbool8type) and
  929. (cmp_op in [OC_EQ,OC_NE]) then
  930. begin
  931. { convert to an llvmbool1type and use directly }
  932. tmpreg:=getintregister(list,llvmbool1type);
  933. a_load_reg_reg(list,size,llvmbool1type,reg,tmpreg);
  934. case cmp_op of
  935. OC_EQ:
  936. invert:=a=0;
  937. OC_NE:
  938. invert:=a=1;
  939. else
  940. { avoid uninitialised warning }
  941. internalerror(2015031504);
  942. end;
  943. current_asmdata.getjumplabel(falselab);
  944. fallthroughlab:=falselab;
  945. if invert then
  946. begin
  947. tmplab:=l;
  948. l:=falselab;
  949. falselab:=tmplab;
  950. end;
  951. list.concat(taillvm.op_size_reg_lab_lab(la_br,llvmbool1type,tmpreg,l,falselab));
  952. a_label(list,fallthroughlab);
  953. exit;
  954. end;
  955. tmpreg:=getregisterfordef(list,size);
  956. a_load_const_reg(list,size,a,tmpreg);
  957. a_cmp_reg_reg_label(list,size,cmp_op,tmpreg,reg,l);
  958. end;
  959. procedure thlcgllvm.a_cmp_reg_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel);
  960. var
  961. resreg: tregister;
  962. falselab: tasmlabel;
  963. begin
  964. if getregtype(reg1)<>getregtype(reg2) then
  965. internalerror(2012111105);
  966. resreg:=getintregister(list,llvmbool1type);
  967. current_asmdata.getjumplabel(falselab);
  968. { invert order of registers. In FPC, cmp_reg_reg(reg1,reg2) means that
  969. e.g. OC_GT is true if "subl %reg1,%reg2" in x86 AT&T is >0. In LLVM,
  970. OC_GT is true if op1>op2 }
  971. list.concat(taillvm.op_reg_cond_size_reg_reg(la_icmp,resreg,cmp_op,size,reg2,reg1));
  972. list.concat(taillvm.op_size_reg_lab_lab(la_br,llvmbool1type,resreg,l,falselab));
  973. a_label(list,falselab);
  974. end;
  975. procedure thlcgllvm.a_jmp_always(list: TAsmList; l: tasmlabel);
  976. begin
  977. { implement in tcg because required by the overridden a_label; doesn't use
  978. any high level stuff anyway }
  979. cg.a_jmp_always(list,l);
  980. end;
  981. procedure thlcgllvm.g_concatcopy(list: TAsmList; size: tdef; const source, dest: treference);
  982. var
  983. pd: tprocdef;
  984. sourcepara, destpara, sizepara, alignpara, volatilepara: tcgpara;
  985. maxalign: longint;
  986. begin
  987. { perform small copies directly; not larger ones, because then llvm
  988. will try to load the entire large datastructure into registers and
  989. starts spilling like crazy; too small copies must not be done via
  990. llvm.memcpy either, because then you get crashes in llvm }
  991. if (size.typ in [orddef,floatdef,enumdef]) or
  992. (size.size<=2*sizeof(aint)) then
  993. begin
  994. a_load_ref_ref(list,size,size,source,dest);
  995. exit;
  996. end;
  997. pd:=search_system_proc('llvm_memcpy64');
  998. sourcepara.init;
  999. destpara.init;
  1000. sizepara.init;
  1001. alignpara.init;
  1002. volatilepara.init;
  1003. paramanager.getintparaloc(list,pd,1,destpara);
  1004. paramanager.getintparaloc(list,pd,2,sourcepara);
  1005. paramanager.getintparaloc(list,pd,3,sizepara);
  1006. paramanager.getintparaloc(list,pd,4,alignpara);
  1007. paramanager.getintparaloc(list,pd,5,volatilepara);
  1008. a_loadaddr_ref_cgpara(list,size,dest,destpara);
  1009. a_loadaddr_ref_cgpara(list,size,source,sourcepara);
  1010. a_load_const_cgpara(list,u64inttype,size.size,sizepara);
  1011. maxalign:=newalignment(max(source.alignment,dest.alignment),min(source.alignment,dest.alignment));
  1012. a_load_const_cgpara(list,u32inttype,maxalign,alignpara);
  1013. { we don't know anything about volatility here, should become an extra
  1014. parameter to g_concatcopy }
  1015. a_load_const_cgpara(list,llvmbool1type,0,volatilepara);
  1016. g_call_system_proc(list,pd,[@destpara,@sourcepara,@sizepara,@alignpara,@volatilepara],nil).resetiftemp;
  1017. sourcepara.done;
  1018. destpara.done;
  1019. sizepara.done;
  1020. alignpara.done;
  1021. volatilepara.done;
  1022. end;
  1023. procedure thlcgllvm.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister);
  1024. var
  1025. tmpreg: tregister;
  1026. href: treference;
  1027. fromcompcurr,
  1028. tocompcurr: boolean;
  1029. begin
  1030. href:=make_simple_ref(list,ref,fromsize);
  1031. { named register -> use generic code }
  1032. if ref.refaddr=addr_full then
  1033. begin
  1034. gen_load_refaddrfull_anyreg(list,fromsize,tosize,href,reg,mms_movescalar);
  1035. exit
  1036. end;
  1037. { comp and currency are handled by the x87 in this case. They cannot
  1038. be represented directly in llvm, and llvmdef translates them into i64
  1039. (since that's their storage size and internally they also are int64).
  1040. Solve this by changing the type to s80real once they are loaded into
  1041. a register. }
  1042. fromcompcurr:=
  1043. (fromsize.typ=floatdef) and
  1044. (tfloatdef(fromsize).floattype in [s64comp,s64currency]);
  1045. tocompcurr:=
  1046. (tosize.typ=floatdef) and
  1047. (tfloatdef(tosize).floattype in [s64comp,s64currency]);
  1048. if tocompcurr then
  1049. tosize:=s80floattype;
  1050. { don't generate different code for loading e.g. extended into cextended,
  1051. but to take care of loading e.g. comp (=int64) into double }
  1052. if (fromsize.size<>tosize.size) then
  1053. tmpreg:=getfpuregister(list,fromsize)
  1054. else
  1055. tmpreg:=reg;
  1056. { handle aggregate loads (happens if a struct needs to be passed in a
  1057. floating point register) }
  1058. if (fromsize.typ in [arraydef,recorddef]) or
  1059. (tosize.typ in [arraydef,recorddef]) then
  1060. begin
  1061. if handle_agg_load_ref_anyreg(list,fromsize,tosize,href,reg,mms_movescalar) then
  1062. exit;
  1063. end;
  1064. { %tmpreg = load size* %ref }
  1065. list.concat(taillvm.op_reg_size_ref(la_load,tmpreg,cpointerdef.getreusable(fromsize),href));
  1066. if tmpreg<>reg then
  1067. if fromcompcurr then
  1068. { treat as extended as long as it's in a register }
  1069. list.concat(taillvm.op_reg_size_reg_size(la_sitofp,reg,fromsize,tmpreg,tosize))
  1070. else
  1071. a_loadfpu_reg_reg(list,fromsize,tosize,tmpreg,reg);
  1072. end;
  1073. procedure thlcgllvm.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference);
  1074. var
  1075. tmpreg: tregister;
  1076. href: treference;
  1077. fromcompcurr,
  1078. tocompcurr: boolean;
  1079. begin
  1080. { see comment in a_loadfpu_ref_reg }
  1081. fromcompcurr:=
  1082. (fromsize.typ=floatdef) and
  1083. (tfloatdef(fromsize).floattype in [s64comp,s64currency]);
  1084. tocompcurr:=
  1085. (tosize.typ=floatdef) and
  1086. (tfloatdef(tosize).floattype in [s64comp,s64currency]);
  1087. if fromcompcurr then
  1088. fromsize:=s80floattype;
  1089. href:=make_simple_ref(list,ref,tosize);
  1090. { don't generate different code for loading e.g. extended into cextended,
  1091. but to take care of storing e.g. comp (=int64) into double }
  1092. if (fromsize.size<>tosize.size) then
  1093. begin
  1094. tmpreg:=getfpuregister(list,tosize);
  1095. if tocompcurr then
  1096. { store back an int64 rather than an extended }
  1097. list.concat(taillvm.op_reg_size_reg_size(la_fptosi,tmpreg,fromsize,reg,tosize))
  1098. else
  1099. a_loadfpu_reg_reg(list,fromsize,tosize,reg,tmpreg);
  1100. end
  1101. else
  1102. tmpreg:=reg;
  1103. { store tosize tmpreg, tosize* href }
  1104. list.concat(taillvm.op_size_reg_size_ref(la_store,tosize,tmpreg,cpointerdef.getreusable(tosize),href));
  1105. end;
  1106. procedure thlcgllvm.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister);
  1107. var
  1108. op: tllvmop;
  1109. begin
  1110. op:=llvmconvop(fromsize,tosize,true);
  1111. { reg2 = bitcast fromllsize reg1 to tollsize }
  1112. list.concat(taillvm.op_reg_size_reg_size(op,reg2,fromsize,reg1,tosize));
  1113. end;
  1114. procedure thlcgllvm.gen_proc_symbol(list: TAsmList);
  1115. var
  1116. item: TCmdStrListItem;
  1117. mangledname: TSymStr;
  1118. asmsym: tasmsymbol;
  1119. begin
  1120. if po_external in current_procinfo.procdef.procoptions then
  1121. exit;
  1122. item:=TCmdStrListItem(current_procinfo.procdef.aliasnames.first);
  1123. mangledname:=current_procinfo.procdef.mangledname;
  1124. { predefine the real function name as local/global, so the aliases can
  1125. refer to the symbol and get the binding correct }
  1126. if (cs_profile in current_settings.moduleswitches) or
  1127. (po_global in current_procinfo.procdef.procoptions) then
  1128. asmsym:=current_asmdata.DefineAsmSymbol(mangledname,AB_GLOBAL,AT_FUNCTION,current_procinfo.procdef)
  1129. else
  1130. asmsym:=current_asmdata.DefineAsmSymbol(mangledname,AB_LOCAL,AT_FUNCTION,current_procinfo.procdef);
  1131. while assigned(item) do
  1132. begin
  1133. if mangledname<>item.Str then
  1134. list.concat(taillvmalias.create(asmsym,item.str,current_procinfo.procdef,asmsym.bind));
  1135. item:=TCmdStrListItem(item.next);
  1136. end;
  1137. list.concat(taillvmdecl.createdef(asmsym,current_procinfo.procdef,nil,sec_code,current_procinfo.procdef.alignment));
  1138. end;
  1139. procedure thlcgllvm.handle_external_proc(list: TAsmList; pd: tprocdef; const importname: TSymStr);
  1140. begin
  1141. { don't do anything, because at this point we can't know yet for certain
  1142. whether the aliased routine is internal to the current routine or not.
  1143. If it's internal, we would have to generate an llvm alias, while if it's
  1144. external, we would have to generate a declaration. Additionally, aliases
  1145. cannot refer to declarations, so always creating aliases doesn't work
  1146. either -> handle in llvmtype }
  1147. end;
  1148. procedure thlcgllvm.g_proc_entry(list: TAsmList; localsize: longint; nostackframe: boolean);
  1149. begin
  1150. list.concatlist(ttgllvm(tg).alloclist)
  1151. { rest: todo }
  1152. end;
  1153. procedure thlcgllvm.g_proc_exit(list: TAsmList; parasize: longint; nostackframe: boolean);
  1154. var
  1155. retdef: tdef;
  1156. retreg,
  1157. hreg: tregister;
  1158. retpara: tcgpara;
  1159. begin
  1160. { the function result type is the type of the first location, which can
  1161. differ from the real result type (e.g. int64 for a record consisting of
  1162. two longint fields on x86-64 -- we are responsible for lowering the
  1163. result types like that) }
  1164. retpara:=get_call_result_cgpara(current_procinfo.procdef,nil);
  1165. retpara.check_simple_location;
  1166. retdef:=retpara.location^.def;
  1167. if is_void(retdef) or
  1168. { don't check retdef here, it is e.g. a pshortstring in case it's
  1169. shortstring that's returned in a parameter }
  1170. paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then
  1171. list.concat(taillvm.op_size(la_ret,voidtype))
  1172. else
  1173. begin
  1174. case retpara.location^.loc of
  1175. LOC_REGISTER,
  1176. LOC_FPUREGISTER,
  1177. LOC_MMREGISTER:
  1178. begin
  1179. { sign/zeroextension of function results is handled implicitly
  1180. via the signext/zeroext modifiers of the result, rather than
  1181. in the code generator -> remove any explicit extensions here }
  1182. retreg:=retpara.location^.register;
  1183. if (current_procinfo.procdef.returndef.typ in [orddef,enumdef]) and
  1184. (retdef.typ in [orddef,enumdef]) then
  1185. begin
  1186. if (current_procinfo.procdef.returndef.size<retpara.location^.def.size) then
  1187. begin
  1188. hreg:=getintregister(list,current_procinfo.procdef.returndef);
  1189. a_load_reg_reg(list,retdef,current_procinfo.procdef.returndef,retreg,hreg);
  1190. retreg:=hreg;
  1191. retdef:=current_procinfo.procdef.returndef;
  1192. end;
  1193. end;
  1194. list.concat(taillvm.op_size_reg(la_ret,retdef,retreg))
  1195. end;
  1196. LOC_VOID:
  1197. begin
  1198. { zero-sized records: return an undefined zero-sized record of
  1199. the correct type }
  1200. list.concat(taillvm.op_size_undef(la_ret,retdef));
  1201. end
  1202. else
  1203. { todo: complex returns }
  1204. internalerror(2012111106);
  1205. end;
  1206. end;
  1207. retpara.resetiftemp;
  1208. end;
  1209. procedure thlcgllvm.gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara);
  1210. begin
  1211. if not paramanager.ret_in_param(resdef,pd) then
  1212. begin
  1213. case resloc.location^.loc of
  1214. LOC_REGISTER,
  1215. LOC_FPUREGISTER,
  1216. LOC_MMREGISTER:
  1217. begin
  1218. if not llvmaggregatetype(resdef) then
  1219. list.concat(taillvm.op_reg_size_undef(la_bitcast,resloc.location^.register,llvmgetcgparadef(resloc,true)))
  1220. else
  1221. { bitcast doesn't work for aggregates -> just load from the
  1222. (uninitialised) function result memory location }
  1223. gen_load_loc_function_result(list,resdef,tabstractnormalvarsym(pd.funcretsym).localloc)
  1224. end;
  1225. { for empty record returns }
  1226. LOC_VOID:
  1227. ;
  1228. else
  1229. internalerror(2015042301);
  1230. end;
  1231. end;
  1232. end;
  1233. procedure thlcgllvm.g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef);
  1234. begin
  1235. { not possible, need ovloc }
  1236. internalerror(2012111107);
  1237. end;
  1238. procedure thlcgllvm.g_overflowCheck_loc(List: TAsmList; const Loc: TLocation; def: TDef; var ovloc: tlocation);
  1239. var
  1240. hl: tasmlabel;
  1241. begin
  1242. if not(cs_check_overflow in current_settings.localswitches) then
  1243. exit;
  1244. if ovloc.size<>OS_8 then
  1245. internalerror(2015122504);
  1246. current_asmdata.getjumplabel(hl);
  1247. a_cmp_const_loc_label(list,llvmbool1type,OC_EQ,0,ovloc,hl);
  1248. g_call_system_proc(list,'fpc_overflow',[],nil);
  1249. a_label(list,hl);
  1250. end;
  1251. procedure thlcgllvm.g_ptrtypecast_reg(list: TAsmList; fromdef, todef: tdef; var reg: tregister);
  1252. var
  1253. hreg: tregister;
  1254. begin
  1255. { will insert a bitcast if necessary }
  1256. if fromdef<>todef then
  1257. begin
  1258. hreg:=getregisterfordef(list,todef);
  1259. a_load_reg_reg(list,fromdef,todef,reg,hreg);
  1260. reg:=hreg;
  1261. end;
  1262. end;
  1263. procedure thlcgllvm.g_ptrtypecast_ref(list: TAsmList; fromdef, todef: tdef; var ref: treference);
  1264. var
  1265. hreg: tregister;
  1266. begin
  1267. hreg:=getaddressregister(list,todef);
  1268. a_loadaddr_ref_reg_intern(list,fromdef,todef,ref,hreg,false);
  1269. reference_reset_base(ref,todef,hreg,0,ref.alignment);
  1270. end;
  1271. procedure thlcgllvm.g_set_addr_nonbitpacked_field_ref(list: TAsmList; recdef: tabstractrecorddef; field: tfieldvarsym; var recref: treference);
  1272. var
  1273. parentdef,
  1274. subscriptdef,
  1275. currentstructdef,
  1276. llvmfielddef: tdef;
  1277. llvmfield: tllvmshadowsymtableentry;
  1278. newbase: tregister;
  1279. implicitpointer: boolean;
  1280. begin
  1281. implicitpointer:=is_implicit_pointer_object_type(recdef);
  1282. currentstructdef:=recdef;
  1283. { in case the field is part of a parent of the current object,
  1284. index into the parents until we're at the parent containing the
  1285. field; if it's an implicit pointer type, these embedded parents
  1286. will be of the structure type of the class rather than of the
  1287. class time itself -> one indirection fewer }
  1288. while field.owner<>tabstractrecorddef(currentstructdef).symtable do
  1289. begin
  1290. { only objectdefs have parents and hence the owner of the
  1291. fieldvarsym can be different from the current def's owner }
  1292. parentdef:=tobjectdef(currentstructdef).childof;
  1293. if implicitpointer then
  1294. newbase:=getaddressregister(list,parentdef)
  1295. else
  1296. newbase:=getaddressregister(list,cpointerdef.getreusable(parentdef));
  1297. recref:=make_simple_ref(list,recref,recdef);
  1298. if implicitpointer then
  1299. subscriptdef:=currentstructdef
  1300. else
  1301. subscriptdef:=cpointerdef.getreusable(currentstructdef);
  1302. { recurse into the first field }
  1303. list.concat(taillvm.getelementptr_reg_size_ref_size_const(newbase,subscriptdef,recref,s32inttype,0,true));
  1304. reference_reset_base(recref,subscriptdef,newbase,field.offsetfromllvmfield,newalignment(recref.alignment,field.fieldoffset));
  1305. { go to the parent }
  1306. currentstructdef:=parentdef;
  1307. end;
  1308. { get the corresponding field in the llvm shadow symtable }
  1309. llvmfield:=tabstractrecordsymtable(tabstractrecorddef(currentstructdef).symtable).llvmst[field];
  1310. if implicitpointer then
  1311. subscriptdef:=currentstructdef
  1312. else
  1313. subscriptdef:=cpointerdef.getreusable(currentstructdef);
  1314. { load the address of that shadow field }
  1315. newbase:=getaddressregister(list,cpointerdef.getreusable(llvmfield.def));
  1316. recref:=make_simple_ref(list,recref,recdef);
  1317. list.concat(taillvm.getelementptr_reg_size_ref_size_const(newbase,subscriptdef,recref,s32inttype,field.llvmfieldnr,true));
  1318. reference_reset_base(recref,subscriptdef,newbase,field.offsetfromllvmfield,newalignment(recref.alignment,llvmfield.fieldoffset+field.offsetfromllvmfield));
  1319. { in case of an 80 bits extended type, typecast from an array of 10
  1320. bytes (used because otherwise llvm will allocate the ABI-defined
  1321. size for extended, which is usually larger) into an extended }
  1322. if (llvmfield.def.typ=floatdef) and
  1323. (tfloatdef(llvmfield.def).floattype=s80real) then
  1324. g_ptrtypecast_ref(list,cpointerdef.getreusable(carraydef.getreusable(u8inttype,10)),cpointerdef.getreusable(s80floattype),recref);
  1325. { if it doesn't match the requested field exactly (variant record),
  1326. adjust the type of the pointer }
  1327. if (field.offsetfromllvmfield<>0) or
  1328. (llvmfield.def<>field.vardef) then
  1329. g_ptrtypecast_ref(list,cpointerdef.getreusable(llvmfield.def),cpointerdef.getreusable(field.vardef),recref);
  1330. end;
  1331. procedure thlcgllvm.a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle);
  1332. var
  1333. href: treference;
  1334. begin
  1335. if shuffle=mms_movescalar then
  1336. a_loadfpu_ref_reg(list,fromsize,tosize,ref,reg)
  1337. else
  1338. begin
  1339. href:=make_simple_ref(list,ref,fromsize);
  1340. if ref.refaddr=addr_full then
  1341. gen_load_refaddrfull_anyreg(list,fromsize,tosize,href,reg,shuffle)
  1342. else
  1343. begin
  1344. { handle aggregate loads (happens if a struct needs to be passed
  1345. in an mmregister) }
  1346. if (fromsize.typ in [arraydef,recorddef]) or
  1347. (tosize.typ in [arraydef,recorddef]) then
  1348. begin
  1349. if handle_agg_load_ref_anyreg(list,fromsize,tosize,href,reg,mms_movescalar) then
  1350. exit;
  1351. end;
  1352. if fromsize<>tosize then
  1353. g_ptrtypecast_ref(list,cpointerdef.create(fromsize),cpointerdef.create(tosize),href);
  1354. { %reg = load size* %ref }
  1355. list.concat(taillvm.op_reg_size_ref(la_load,reg,cpointerdef.getreusable(tosize),href));
  1356. end;
  1357. end;
  1358. end;
  1359. procedure thlcgllvm.a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle);
  1360. var
  1361. href: treference;
  1362. begin
  1363. if shuffle=mms_movescalar then
  1364. a_loadfpu_reg_ref(list,fromsize,tosize,reg,ref)
  1365. else
  1366. begin
  1367. { todo }
  1368. if fromsize<>tosize then
  1369. internalerror(2013060220);
  1370. href:=make_simple_ref(list,ref,tosize);
  1371. { store tosize reg, tosize* href }
  1372. list.concat(taillvm.op_size_reg_size_ref(la_store,tosize,reg,cpointerdef.getreusable(tosize),href))
  1373. end;
  1374. end;
  1375. procedure thlcgllvm.a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister; shuffle: pmmshuffle);
  1376. begin
  1377. if shuffle=mms_movescalar then
  1378. a_loadfpu_reg_reg(list,fromsize,tosize,reg1,reg2)
  1379. else
  1380. { reg2 = bitcast fromllsize reg1 to tollsize }
  1381. list.concat(taillvm.op_reg_size_reg_size(la_bitcast,reg2,fromsize,reg1,tosize));
  1382. end;
  1383. procedure thlcgllvm.a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; src, dst: tregister; shuffle: pmmshuffle);
  1384. begin
  1385. if (op=OP_XOR) and
  1386. (src=dst) then
  1387. a_load_const_reg(list,size,0,dst)
  1388. else
  1389. { todo }
  1390. internalerror(2013060221);
  1391. end;
  1392. procedure thlcgllvm.a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize: tdef; intreg, mmreg: tregister; shuffle: pmmshuffle);
  1393. begin
  1394. internalerror(2013060222);
  1395. end;
  1396. procedure thlcgllvm.a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize: tdef; mmreg, intreg: tregister; shuffle: pmmshuffle);
  1397. begin
  1398. internalerror(2013060223);
  1399. end;
  1400. function thlcgllvm.get_call_result_cgpara(pd: tabstractprocdef; forceresdef: tdef): tcgpara;
  1401. var
  1402. paraloc: pcgparalocation;
  1403. begin
  1404. result:=inherited;
  1405. { we'll change the paraloc, make sure we don't modify the original one }
  1406. if not result.temporary then
  1407. begin
  1408. result:=result.getcopy;
  1409. result.temporary:=true;
  1410. end;
  1411. { get the LLVM representation of the function result (e.g. a
  1412. struct with two i64 fields for a record with 4 i32 fields) }
  1413. result.def:=llvmgetcgparadef(result,true);
  1414. if assigned(result.location^.next) then
  1415. begin
  1416. { unify the result into a sinlge location; unlike for parameters,
  1417. we are not responsible for splitting up results into multiple
  1418. locations }
  1419. { set the first location to the type of the function result }
  1420. result.location^.def:=result.def;
  1421. result.location^.size:=result.size;
  1422. { free all extra paralocs }
  1423. while assigned(result.location^.next) do
  1424. begin
  1425. paraloc:=result.location^.next^.next;
  1426. freemem(result.location^.next);
  1427. result.location^.next:=paraloc;
  1428. end;
  1429. end;
  1430. paraloc:=result.location;
  1431. paraloc^.def:=result.def;
  1432. case paraloc^.loc of
  1433. LOC_VOID:
  1434. ;
  1435. LOC_REGISTER,
  1436. LOC_FPUREGISTER,
  1437. LOC_MMREGISTER:
  1438. begin
  1439. paraloc^.llvmloc.loc:=paraloc^.loc;
  1440. paraloc^.llvmloc.reg:=paraloc^.register;
  1441. paraloc^.llvmvalueloc:=true;
  1442. end;
  1443. LOC_REFERENCE:
  1444. if not paramanager.ret_in_param(pd.returndef,pd) then
  1445. { TODO, if this can happen at all }
  1446. internalerror(2014011901);
  1447. else
  1448. internalerror(2014011902);
  1449. end;
  1450. end;
  1451. procedure thlcgllvm.gen_load_loc_function_result(list: TAsmList; vardef: tdef; const l: tlocation);
  1452. begin
  1453. gen_load_loc_cgpara(list,vardef,l,get_call_result_cgpara(current_procinfo.procdef,nil));
  1454. end;
  1455. procedure thlcgllvm.gen_load_loc_cgpara(list: TAsmList; vardef: tdef; const l: tlocation; const cgpara: tcgpara);
  1456. var
  1457. memloc: tlocation;
  1458. begin
  1459. if not(cgpara.location^.llvmvalueloc) then
  1460. begin
  1461. memloc:=l;
  1462. location_force_mem(list,memloc,vardef);
  1463. a_loadaddr_ref_cgpara(list,vardef,memloc.reference,cgpara);
  1464. end
  1465. else
  1466. inherited;
  1467. end;
  1468. procedure thlcgllvm.gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean);
  1469. var
  1470. ploc : pcgparalocation;
  1471. hloc : tlocation;
  1472. href, href2 : treference;
  1473. hreg : tregister;
  1474. fielddef,
  1475. llvmparadef : tdef;
  1476. index : longint;
  1477. offset : pint;
  1478. userecord : boolean;
  1479. begin
  1480. { ignore e.g. empty records }
  1481. if (para.location^.loc=LOC_VOID) then
  1482. exit;
  1483. { If the parameter location is reused we don't need to copy
  1484. anything }
  1485. if (destloc.loc=LOC_REFERENCE) and
  1486. reusepara then
  1487. exit;
  1488. { get the equivalent llvm def used to pass the parameter (e.g. a record
  1489. with two int64 fields for passing a record consisiting of 8 bytes on
  1490. x86-64) }
  1491. llvmparadef:=llvmgetcgparadef(para,true);
  1492. userecord:=
  1493. (llvmparadef<>para.def) and
  1494. assigned(para.location^.next);
  1495. if userecord then
  1496. begin
  1497. { llvmparadef is a record in this case, with every field corresponding
  1498. to a single paraloc }
  1499. if destloc.loc<>LOC_REFERENCE then
  1500. tg.gethltemp(list,llvmparadef,llvmparadef.size,tt_normal,href)
  1501. else
  1502. begin
  1503. hreg:=getaddressregister(list,cpointerdef.getreusable(llvmparadef));
  1504. a_loadaddr_ref_reg(list,vardef,cpointerdef.getreusable(llvmparadef),destloc.reference,hreg);
  1505. reference_reset_base(href,cpointerdef.getreusable(llvmparadef),hreg,0,destloc.reference.alignment);
  1506. end;
  1507. index:=0;
  1508. ploc:=para.location;
  1509. repeat
  1510. paraloctoloc(ploc,hloc);
  1511. g_setup_load_field_by_name(list,trecorddef(llvmparadef),'F'+tostr(index),href,href2,fielddef);
  1512. a_load_loc_ref(list,ploc^.def,fielddef,hloc,href2);
  1513. inc(index);
  1514. ploc:=ploc^.next;
  1515. until not assigned(ploc);
  1516. if destloc.loc<>LOC_REFERENCE then
  1517. tg.ungettemp(list,href);
  1518. end
  1519. else
  1520. begin
  1521. para.check_simple_location;
  1522. paraloctoloc(para.location,hloc);
  1523. case destloc.loc of
  1524. LOC_REFERENCE :
  1525. begin
  1526. case def2regtyp(llvmparadef) of
  1527. R_INTREGISTER,
  1528. R_ADDRESSREGISTER:
  1529. a_load_loc_ref(list,llvmparadef,vardef,hloc,destloc.reference);
  1530. R_FPUREGISTER:
  1531. a_loadfpu_loc_ref(list,llvmparadef,vardef,hloc,destloc.reference);
  1532. R_MMREGISTER:
  1533. a_loadmm_loc_ref(list,llvmparadef,vardef,hloc,destloc.reference,nil);
  1534. else
  1535. internalerror(2014080801);
  1536. end;
  1537. end;
  1538. LOC_REGISTER:
  1539. begin
  1540. a_load_loc_reg(list,llvmparadef,vardef,hloc,destloc.register);
  1541. end;
  1542. LOC_FPUREGISTER:
  1543. begin
  1544. a_loadfpu_loc_reg(list,llvmparadef,vardef,hloc,destloc.register);
  1545. end;
  1546. LOC_MMREGISTER:
  1547. begin
  1548. a_loadmm_loc_reg(list,llvmparadef,vardef,hloc,destloc.register,nil);
  1549. end;
  1550. { TODO other possible locations }
  1551. else
  1552. internalerror(2013102304);
  1553. end;
  1554. end;
  1555. end;
  1556. procedure thlcgllvm.a_jmp_flags(list: TAsmList; const f: TResFlags; l: tasmlabel);
  1557. begin
  1558. internalerror(2013060224);
  1559. end;
  1560. procedure thlcgllvm.g_flags2reg(list: TAsmList; size: tdef; const f: tresflags; reg: TRegister);
  1561. begin
  1562. internalerror(2013060225);
  1563. end;
  1564. procedure thlcgllvm.g_flags2ref(list: TAsmList; size: tdef; const f: tresflags; const ref: TReference);
  1565. begin
  1566. internalerror(2013060226);
  1567. end;
  1568. procedure thlcgllvm.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; srcsize, dstsize: tdef; src, dst: tregister);
  1569. begin
  1570. internalerror(2012090201);
  1571. end;
  1572. procedure thlcgllvm.g_stackpointer_alloc(list: TAsmList; size: longint);
  1573. begin
  1574. internalerror(2012090203);
  1575. end;
  1576. procedure thlcgllvm.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
  1577. begin
  1578. internalerror(2012090204);
  1579. end;
  1580. procedure thlcgllvm.g_adjust_self_value(list: TAsmList; procdef: tprocdef; ioffset: aint);
  1581. begin
  1582. internalerror(2012090205);
  1583. end;
  1584. procedure thlcgllvm.g_local_unwind(list: TAsmList; l: TAsmLabel);
  1585. begin
  1586. internalerror(2012090206);
  1587. end;
  1588. procedure thlcgllvm.gen_stack_check_size_para(list: TAsmList);
  1589. begin
  1590. { this is implemented in a very hackish way, whereby first the call
  1591. to fpc_stackcheck() is emitted, then the prolog is generated and
  1592. registers are allocated, and finally the code to load the parameter
  1593. is inserted before the call to fpc_stackcheck(). Since parameters are
  1594. explicitly passed to call instructions for llvm, that does not work
  1595. here. It could be solved by patching the call instruction later, but
  1596. that's a lot of engineering for functionality that's only marginally
  1597. useful at best. }
  1598. end;
  1599. procedure thlcgllvm.gen_stack_check_call(list: TAsmList);
  1600. begin
  1601. { see explanation in thlcgllvm.gen_stack_check_size_para() }
  1602. end;
  1603. function thlcgllvm.make_simple_ref(list: TAsmList; const ref: treference; def: tdef): treference;
  1604. begin
  1605. result:=make_simple_ref_ptr(list,ref,cpointerdef.create(def));
  1606. end;
  1607. function thlcgllvm.make_simple_ref_ptr(list: TAsmList; const ref: treference; ptrdef: tdef): treference;
  1608. var
  1609. ptrindex: tcgint;
  1610. hreg1,
  1611. hreg2: tregister;
  1612. tmpref: treference;
  1613. pointedsize: asizeint;
  1614. begin
  1615. if ref.alignment=0 then
  1616. internalerror(2016072203);
  1617. { already simple? }
  1618. if (not assigned(ref.symbol) or
  1619. (ref.base=NR_NO)) and
  1620. (ref.index=NR_NO) and
  1621. (ref.offset=0) then
  1622. begin
  1623. result:=ref;
  1624. exit;
  1625. end;
  1626. case ptrdef.typ of
  1627. pointerdef:
  1628. begin
  1629. pointedsize:=tpointerdef(ptrdef).pointeddef.size;
  1630. { void, formaldef }
  1631. if pointedsize=0 then
  1632. pointedsize:=1;
  1633. end;
  1634. else
  1635. begin
  1636. { pointedsize is only used if the offset <> 0, to see whether we
  1637. can use getelementptr if it's an exact multiple -> set pointedsize
  1638. to a value that will never be a multiple as we can't "index" other
  1639. types }
  1640. pointedsize:=ref.offset+1;
  1641. end;
  1642. end;
  1643. hreg2:=getaddressregister(list,ptrdef);
  1644. { symbol+offset or base+offset with offset a multiple of the size ->
  1645. use getelementptr }
  1646. if (ref.index=NR_NO) and
  1647. (ref.offset mod pointedsize=0) then
  1648. begin
  1649. ptrindex:=ref.offset div pointedsize;
  1650. if assigned(ref.symbol) then
  1651. reference_reset_symbol(tmpref,ref.symbol,0,ref.alignment)
  1652. else
  1653. reference_reset_base(tmpref,ptrdef,ref.base,0,ref.alignment);
  1654. list.concat(taillvm.getelementptr_reg_size_ref_size_const(hreg2,ptrdef,tmpref,ptruinttype,ptrindex,assigned(ref.symbol)));
  1655. reference_reset_base(result,ptrdef,hreg2,0,ref.alignment);
  1656. exit;
  1657. end;
  1658. { for now, perform all calculations using plain pointer arithmetic. Later
  1659. we can look into optimizations based on getelementptr for structured
  1660. accesses (if only to prevent running out of virtual registers).
  1661. Assumptions:
  1662. * symbol/base register: always type "ptrdef"
  1663. * index/offset: always type "ptruinttype" (llvm bitcode has no sign information, so sign doesn't matter) }
  1664. hreg1:=getintregister(list,ptruinttype);
  1665. if assigned(ref.symbol) then
  1666. begin
  1667. if ref.base<>NR_NO then
  1668. internalerror(2012111301);
  1669. reference_reset_symbol(tmpref,ref.symbol,0,ref.alignment);
  1670. list.concat(taillvm.getelementptr_reg_size_ref_size_const(hreg1,ptrdef,tmpref,ptruinttype,0,true));
  1671. end
  1672. else if ref.base<>NR_NO then
  1673. begin
  1674. a_load_reg_reg(list,ptrdef,ptruinttype,ref.base,hreg1);
  1675. end
  1676. else
  1677. { for absolute addresses }
  1678. a_load_const_reg(list,ptruinttype,0,hreg1);
  1679. if ref.index<>NR_NO then
  1680. begin
  1681. { SSA... }
  1682. hreg2:=getintregister(list,ptruinttype);
  1683. a_op_reg_reg_reg(list,OP_ADD,ptruinttype,ref.index,hreg1,hreg2);
  1684. hreg1:=hreg2;
  1685. end;
  1686. if ref.offset<>0 then
  1687. begin
  1688. hreg2:=getintregister(list,ptruinttype);
  1689. a_op_const_reg_reg(list,OP_ADD,ptruinttype,ref.offset,hreg1,hreg2);
  1690. hreg1:=hreg2;
  1691. end;
  1692. hreg2:=getaddressregister(list,ptrdef);
  1693. a_load_reg_reg(list,ptruinttype,ptrdef,hreg1,hreg2);
  1694. reference_reset_base(result,ptrdef,hreg2,0,ref.alignment);
  1695. end;
  1696. procedure thlcgllvm.set_call_function_result(const list: TAsmList; const pd: tabstractprocdef; const llvmretdef, hlretdef: tdef; const resval: tregister; var retpara: tcgpara);
  1697. var
  1698. hreg: tregister;
  1699. rettemp: treference;
  1700. begin
  1701. if not is_void(hlretdef) and
  1702. not paramanager.ret_in_param(hlretdef, pd) then
  1703. begin
  1704. { should already be a copy, because it currently describes the llvm
  1705. return location }
  1706. if not retpara.temporary then
  1707. internalerror(2014020101);
  1708. if llvmaggregatetype(hlretdef) then
  1709. begin
  1710. { to ease the handling of aggregate types here, we just store
  1711. everything to memory rather than potentially dealing with aggregates
  1712. in "registers" }
  1713. tg.gethltemp(list, llvmretdef, llvmretdef.size, tt_normal, rettemp);
  1714. case def2regtyp(llvmretdef) of
  1715. R_INTREGISTER,
  1716. R_ADDRESSREGISTER:
  1717. a_load_reg_ref(list,llvmretdef,llvmretdef,resval,rettemp);
  1718. R_FPUREGISTER:
  1719. a_loadfpu_reg_ref(list,llvmretdef,llvmretdef,resval,rettemp);
  1720. R_MMREGISTER:
  1721. a_loadmm_reg_ref(list,llvmretdef,llvmretdef,resval,rettemp,mms_movescalar);
  1722. end;
  1723. { the return parameter now contains a value whose type matches the one
  1724. that the high level code generator expects instead of the llvm shim
  1725. }
  1726. retpara.def:=llvmretdef;
  1727. retpara.location^.def:=llvmretdef;
  1728. { for llvm-specific code: }
  1729. retpara.location^.llvmvalueloc:=false;
  1730. retpara.location^.llvmloc.loc:=LOC_REGISTER;
  1731. retpara.location^.llvmloc.reg:=rettemp.base;
  1732. { for the rest (normally not used, but cleaner to set it correclty) }
  1733. retpara.location^.loc:=LOC_REFERENCE;
  1734. retpara.location^.reference.index:=rettemp.base;
  1735. retpara.location^.reference.offset:=0;
  1736. end
  1737. else
  1738. begin
  1739. retpara.def:=llvmretdef;
  1740. retpara.Location^.def:=llvmretdef;
  1741. retpara.location^.llvmloc.reg:=resval;
  1742. retpara.Location^.llvmloc.loc:=retpara.location^.loc;
  1743. retpara.Location^.llvmvalueloc:=true;
  1744. end;
  1745. end
  1746. else
  1747. retpara.location^.llvmloc.loc:=LOC_VOID;
  1748. end;
  1749. procedure thlcgllvm.paraloctoloc(const paraloc: pcgparalocation; out hloc: tlocation);
  1750. begin
  1751. case paraloc^.llvmloc.loc of
  1752. LOC_REFERENCE:
  1753. begin
  1754. location_reset_ref(hloc,LOC_REFERENCE,def_cgsize(paraloc^.def),paraloc^.def.alignment);
  1755. hloc.reference.symbol:=paraloc^.llvmloc.sym;
  1756. if paraloc^.llvmvalueloc then
  1757. hloc.reference.refaddr:=addr_full;
  1758. end;
  1759. LOC_REGISTER:
  1760. begin
  1761. if paraloc^.llvmvalueloc then
  1762. begin
  1763. location_reset(hloc,LOC_REGISTER,def_cgsize(paraloc^.def));
  1764. hloc.register:=paraloc^.llvmloc.reg;
  1765. end
  1766. else
  1767. begin
  1768. if getregtype(paraloc^.llvmloc.reg)<>R_TEMPREGISTER then
  1769. internalerror(2014011903);
  1770. location_reset_ref(hloc,LOC_REFERENCE,def_cgsize(paraloc^.def),paraloc^.def.alignment);
  1771. hloc.reference.base:=paraloc^.llvmloc.reg;
  1772. end;
  1773. end;
  1774. LOC_FPUREGISTER,
  1775. LOC_MMREGISTER:
  1776. begin
  1777. if paraloc^.llvmvalueloc then
  1778. begin
  1779. location_reset(hloc,paraloc^.llvmloc.loc,def_cgsize(paraloc^.def));
  1780. hloc.register:=paraloc^.llvmloc.reg;
  1781. end
  1782. else
  1783. internalerror(2014012401);
  1784. end
  1785. else
  1786. internalerror(2014010706);
  1787. end;
  1788. end;
  1789. procedure thlcgllvm.varsym_set_localloc(list: TAsmList; vs: tabstractnormalvarsym);
  1790. begin
  1791. if cs_asm_source in current_settings.globalswitches then
  1792. begin
  1793. case vs.initialloc.loc of
  1794. LOC_REFERENCE :
  1795. begin
  1796. if assigned(vs.initialloc.reference.symbol) then
  1797. list.concat(Tai_comment.Create(strpnew('Var '+vs.realname+' located at '+
  1798. vs.initialloc.reference.symbol.name)))
  1799. else
  1800. list.concat(Tai_comment.Create(strpnew('Var '+vs.realname+' located at %tmp.'+
  1801. tostr(getsupreg(vs.initialloc.reference.base)))));
  1802. end;
  1803. end;
  1804. end;
  1805. vs.localloc:=vs.initialloc;
  1806. end;
  1807. procedure thlcgllvm.paravarsym_set_initialloc_to_paraloc(vs: tparavarsym);
  1808. var
  1809. parasym : tasmsymbol;
  1810. begin
  1811. if vs.paraloc[calleeside].location^.llvmloc.loc<>LOC_REFERENCE then
  1812. internalerror(2014010708);
  1813. parasym:=vs.paraloc[calleeside].location^.llvmloc.sym;
  1814. reference_reset_symbol(vs.initialloc.reference,parasym,0,vs.paraloc[calleeside].alignment);
  1815. if vs.paraloc[calleeside].location^.llvmvalueloc then
  1816. vs.initialloc.reference.refaddr:=addr_full;
  1817. end;
  1818. procedure thlcgllvm.g_external_wrapper(list: TAsmList; procdef: tprocdef; const wrappername, externalname: string; global: boolean);
  1819. var
  1820. asmsym: TAsmSymbol;
  1821. begin
  1822. if po_external in procdef.procoptions then
  1823. exit;
  1824. asmsym:=current_asmdata.RefAsmSymbol(externalname,AT_FUNCTION);
  1825. list.concat(taillvmalias.create(asmsym,wrappername,procdef,asmsym.bind));
  1826. end;
  1827. procedure create_hlcodegen;
  1828. begin
  1829. if not assigned(current_procinfo) or
  1830. not(po_assembler in current_procinfo.procdef.procoptions) then
  1831. begin
  1832. tgobjclass:=ttgllvm;
  1833. hlcg:=thlcgllvm.create;
  1834. cgllvm.create_codegen
  1835. end
  1836. else
  1837. begin
  1838. tgobjclass:=orgtgclass;
  1839. hlcgcpu.create_hlcodegen;
  1840. { todo: handle/remove chlcgobj }
  1841. end;
  1842. end;
  1843. begin
  1844. chlcgobj:=thlcgllvm;
  1845. end.