hlcgllvm.pas 64 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662
  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. protected
  33. procedure a_load_ref_cgpara_init_src(list: TAsmList; const para: tcgpara; const initialref: treference; var refsize: tdef; out newref: treference);
  34. public
  35. procedure getcpuregister(list: TAsmList; r: Tregister); override;
  36. procedure ungetcpuregister(list: TAsmList; r: Tregister); override;
  37. procedure alloccpuregisters(list: TAsmList; rt: Tregistertype; const r: Tcpuregisterset); override;
  38. procedure deallocallcpuregisters(list: TAsmList); override;
  39. protected
  40. procedure a_call_common(list: TAsmList; pd: tabstractprocdef; const paras: array of pcgpara; const forceresdef: tdef; out res: tregister; out calldef: tdef; out hlretdef: tdef; out llvmretdef: tdef; out callparas: tfplist);
  41. public
  42. function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;override;
  43. function a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara; override;
  44. procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : tcgint;register : tregister);override;
  45. procedure a_load_const_ref(list: TAsmList; tosize: tdef; a: tcgint; const ref: treference);override;
  46. procedure a_load_reg_ref(list : TAsmList;fromsize, tosize : tdef;register : tregister;const ref : treference);override;
  47. procedure a_load_reg_reg(list : TAsmList;fromsize, tosize : tdef;reg1,reg2 : tregister);override;
  48. procedure a_load_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;register : tregister);override;
  49. procedure a_load_ref_ref(list: TAsmList; fromsize, tosize: tdef; const sref: treference; const dref: treference); override;
  50. procedure a_loadaddr_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;r : tregister);override;
  51. procedure a_op_const_reg(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; reg: TRegister); override;
  52. procedure a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister); override;
  53. procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister); override;
  54. procedure a_op_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; reg1, reg2: TRegister); override;
  55. procedure a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister;setflags : boolean;var ovloc : tlocation); override;
  56. procedure a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation); override;
  57. procedure a_cmp_const_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel); override;
  58. procedure a_cmp_reg_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel); override;
  59. procedure a_jmp_always(list : TAsmList;l: tasmlabel); override;
  60. procedure g_concatcopy(list : TAsmList;size: tdef; const source,dest : treference);override;
  61. procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister); override;
  62. procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference); override;
  63. procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister); override;
  64. procedure gen_proc_symbol(list: TAsmList); override;
  65. procedure gen_proc_symbol_end(list: TAsmList); override;
  66. procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); override;
  67. procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean); override;
  68. protected
  69. procedure gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara); override;
  70. public
  71. procedure g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef); override;
  72. procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;var ovloc : tlocation); override;
  73. procedure g_ptrtypecast_reg(list: TAsmList; fromdef, todef: tpointerdef; reg: tregister); override;
  74. procedure g_ptrtypecast_ref(list: TAsmList; fromdef, todef: tpointerdef; var ref: treference); override;
  75. procedure a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle); override;
  76. procedure a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle); override;
  77. procedure a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister; shuffle: pmmshuffle); override;
  78. procedure a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; src, dst: tregister; shuffle: pmmshuffle); override;
  79. procedure a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize: tdef; intreg, mmreg: tregister; shuffle: pmmshuffle); override;
  80. procedure a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize: tdef; mmreg, intreg: tregister; shuffle: pmmshuffle); override;
  81. function get_call_result_cgpara(pd: tabstractprocdef; forceresdef: tdef): tcgpara; override;
  82. protected
  83. procedure gen_load_loc_function_result(list: TAsmList; vardef: tdef; const l: tlocation); override;
  84. public
  85. procedure gen_load_loc_cgpara(list: TAsmList; vardef: tdef; const l: tlocation; const cgpara: tcgpara); override;
  86. procedure gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean); override;
  87. {$ifdef cpuflags}
  88. { llvm doesn't have flags, but cpuflags is defined in case the real cpu
  89. has flags and we have to override the abstract methods to prevent
  90. warnings }
  91. procedure a_jmp_flags(list: TAsmList; const f: TResFlags; l: tasmlabel); override;
  92. procedure g_flags2reg(list: TAsmList; size: tdef; const f: tresflags; reg: TRegister); override;
  93. procedure g_flags2ref(list: TAsmList; size: tdef; const f: tresflags; const ref: TReference); override;
  94. {$endif cpuflags}
  95. { unimplemented or unnecessary routines }
  96. procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; srcsize, dstsize: tdef; src, dst: tregister); override;
  97. procedure g_stackpointer_alloc(list: TAsmList; size: longint); override;
  98. procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint); override;
  99. procedure g_adjust_self_value(list: TAsmList; procdef: tprocdef; ioffset: aint); override;
  100. procedure g_local_unwind(list: TAsmList; l: TAsmLabel); override;
  101. procedure varsym_set_localloc(list: TAsmList; vs: tabstractnormalvarsym); override;
  102. procedure paravarsym_set_initialloc_to_paraloc(vs: tparavarsym); override;
  103. procedure g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string); override;
  104. { def is the type of the data stored in memory pointed to by ref, not
  105. a pointer to this type }
  106. function make_simple_ref(list: TAsmList; const ref: treference; def: tdef): treference;
  107. protected
  108. procedure paraloctoloc(const paraloc: pcgparalocation; out hloc: tlocation);
  109. procedure set_call_function_result(const list: TAsmList; const pd: tabstractprocdef; const llvmretdef, hlretdef: tdef; const resval: tregister; var retpara: tcgpara);
  110. end;
  111. procedure create_hlcodegen;
  112. implementation
  113. uses
  114. verbose,cutils,globals,fmodule,constexp,systems,
  115. defutil,llvmdef,llvmsym,
  116. aasmtai,aasmcpu,
  117. aasmllvm,llvmbase,tgllvm,
  118. symtable,
  119. paramgr,llvmpara,
  120. procinfo,cpuinfo,cgobj,cgllvm,cghlcpu;
  121. const
  122. topcg2llvmop: array[topcg] of tllvmop =
  123. { OP_NONE OP_MOVE OP_ADD OP_AND OP_DIV OP_IDIV OP_IMUL OP_MUL }
  124. (la_none, la_none, la_add, la_and, la_udiv, la_sdiv, la_mul, la_mul,
  125. { OP_NEG OP_NOT OP_OR OP_SAR OP_SHL OP_SHR OP_SUB OP_XOR }
  126. la_none, la_none, la_or, la_ashr, la_shl, la_lshr, la_sub, la_xor,
  127. { OP_ROL OP_ROR }
  128. la_none, la_none);
  129. constructor thlcgllvm.create;
  130. begin
  131. inherited
  132. end;
  133. procedure thlcgllvm.temp_to_ref(p: ptemprecord; out ref: treference);
  134. begin
  135. { on the LLVM target, every temp is independent and encoded via a
  136. separate temp register whose superregister number is stored in p^.pos }
  137. reference_reset_base(ref,voidstackpointertype,newreg(R_TEMPREGISTER,p^.pos,R_SUBWHOLE),0,p^.alignment);
  138. end;
  139. procedure thlcgllvm.a_load_ref_cgpara(list: TAsmList; size: tdef; const r: treference; const cgpara: TCGPara);
  140. var
  141. tmpref, initialref, ref: treference;
  142. orgsize: tdef;
  143. tmpreg: tregister;
  144. hloc: tlocation;
  145. location: pcgparalocation;
  146. orgsizeleft,
  147. sizeleft,
  148. totaloffset: asizeint;
  149. paralocidx: longint;
  150. userecord,
  151. reghasvalue: boolean;
  152. begin
  153. location:=cgpara.location;
  154. sizeleft:=cgpara.intsize;
  155. totaloffset:=0;
  156. orgsize:=size;
  157. a_load_ref_cgpara_init_src(list,cgpara,r,size,initialref);
  158. userecord:=
  159. (orgsize<>size) and
  160. assigned(cgpara.location^.next);
  161. paralocidx:=0;
  162. while assigned(location) do
  163. begin
  164. if userecord then
  165. begin
  166. { llvmparadef is a record in this case, with every field corresponding
  167. to a single paraloc }
  168. paraloctoloc(location,hloc);
  169. tmpreg:=getaddressregister(list,getpointerdef(location^.def));
  170. list.concat(taillvm.getelementptr_reg_size_ref_size_const(tmpreg,getpointerdef(size),initialref,s32inttype,paralocidx,true));
  171. reference_reset_base(tmpref,getpointerdef(location^.def),tmpreg,0,newalignment(initialref.alignment,totaloffset));
  172. end
  173. else
  174. tmpref:=initialref;
  175. paramanager.allocparaloc(list,location);
  176. case location^.loc of
  177. LOC_REGISTER,LOC_CREGISTER:
  178. begin
  179. { byval parameter -> load the address rather than the value }
  180. if not location^.llvmvalueloc then
  181. a_loadaddr_ref_reg(list,tpointerdef(location^.def).pointeddef,location^.def,tmpref,location^.register)
  182. { if this parameter is split into multiple paralocs via
  183. record fields, load the current paraloc. The type of the
  184. paraloc and of the current record field will match by
  185. construction (the record is build from the paraloc
  186. types) }
  187. else if userecord then
  188. a_load_ref_reg(list,location^.def,location^.def,tmpref,location^.register)
  189. { if the parameter is passed in a single paraloc, the
  190. paraloc's type may be different from the declared type
  191. -> use the original complete parameter size as source so
  192. we can insert a type conversion if necessary }
  193. else
  194. a_load_ref_reg(list,size,location^.def,tmpref,location^.register)
  195. end;
  196. LOC_REFERENCE,LOC_CREFERENCE:
  197. begin
  198. if assigned(location^.next) then
  199. internalerror(2010052906);
  200. reference_reset_base(ref,getpointerdef(size),location^.reference.index,location^.reference.offset,newalignment(cgpara.alignment,cgpara.intsize-sizeleft));
  201. if (def_cgsize(size)<>OS_NO) and
  202. (size.size=sizeleft) and
  203. (sizeleft<=sizeof(aint)) then
  204. a_load_ref_ref(list,size,location^.def,tmpref,ref)
  205. else
  206. { use concatcopy, because the parameter can be larger than }
  207. { what the OS_* constants can handle }
  208. g_concatcopy(list,location^.def,tmpref,ref);
  209. end;
  210. LOC_MMREGISTER,LOC_CMMREGISTER:
  211. begin
  212. case location^.size of
  213. OS_F32,
  214. OS_F64,
  215. OS_F128:
  216. a_loadmm_ref_reg(list,location^.def,location^.def,tmpref,location^.register,mms_movescalar);
  217. OS_M8..OS_M128,
  218. OS_MS8..OS_MS128:
  219. a_loadmm_ref_reg(list,location^.def,location^.def,tmpref,location^.register,nil);
  220. else
  221. internalerror(2010053101);
  222. end;
  223. end
  224. else
  225. internalerror(2010053111);
  226. end;
  227. inc(totaloffset,tcgsize2size[location^.size]);
  228. dec(sizeleft,tcgsize2size[location^.size]);
  229. location:=location^.next;
  230. inc(paralocidx);
  231. end;
  232. end;
  233. procedure thlcgllvm.a_load_ref_cgpara_init_src(list: TAsmList; const para: tcgpara; const initialref: treference; var refsize: tdef; out newref: treference);
  234. var
  235. newrefsize: tdef;
  236. reg: tregister;
  237. begin
  238. newrefsize:=llvmgetcgparadef(para,true);
  239. if refsize<>newrefsize then
  240. begin
  241. reg:=getaddressregister(list,getpointerdef(newrefsize));
  242. a_loadaddr_ref_reg(list,refsize,getpointerdef(newrefsize),initialref,reg);
  243. reference_reset_base(newref,getpointerdef(newrefsize),reg,0,initialref.alignment);
  244. refsize:=newrefsize;
  245. end
  246. else
  247. newref:=initialref;
  248. end;
  249. procedure thlcgllvm.getcpuregister(list: TAsmList; r: Tregister);
  250. begin
  251. { don't do anything }
  252. end;
  253. procedure thlcgllvm.ungetcpuregister(list: TAsmList; r: Tregister);
  254. begin
  255. { don't do anything }
  256. end;
  257. procedure thlcgllvm.alloccpuregisters(list: TAsmList; rt: Tregistertype; const r: Tcpuregisterset);
  258. begin
  259. { don't do anything }
  260. end;
  261. procedure thlcgllvm.deallocallcpuregisters(list: TAsmList);
  262. begin
  263. { don't do anything }
  264. end;
  265. procedure thlcgllvm.a_call_common(list: TAsmList; pd: tabstractprocdef; const paras: array of pcgpara; const forceresdef: tdef; out res: tregister; out calldef: tdef; out hlretdef: tdef; out llvmretdef: tdef; out callparas: tfplist);
  266. procedure load_ref_anyreg(def: tdef; const ref: treference; reg: tregister; var callpara: pllvmcallpara);
  267. begin
  268. case getregtype(reg) of
  269. R_INTREGISTER,
  270. R_ADDRESSREGISTER:
  271. begin
  272. a_load_ref_reg(list,def,def,ref,reg);
  273. callpara^.loc:=LOC_REGISTER;
  274. end;
  275. R_FPUREGISTER:
  276. begin
  277. a_loadfpu_ref_reg(list,def,def,ref,reg);
  278. callpara^.loc:=LOC_FPUREGISTER;
  279. end;
  280. R_MMREGISTER:
  281. begin
  282. a_loadmm_ref_reg(list,def,def,ref,reg,mms_movescalar);
  283. callpara^.loc:=LOC_MMREGISTER;
  284. end;
  285. else
  286. internalerror(2014012213);
  287. end;
  288. end;
  289. var
  290. i: longint;
  291. href: treference;
  292. callpara: pllvmcallpara;
  293. paraloc: pcgparalocation;
  294. begin
  295. callparas:=tfplist.Create;
  296. for i:=0 to high(paras) do
  297. begin
  298. paraloc:=paras[i]^.location;
  299. while assigned(paraloc) and
  300. (paraloc^.loc<>LOC_VOID) do
  301. begin
  302. new(callpara);
  303. callpara^.def:=paraloc^.def;
  304. llvmextractvalueextinfo(paras[i]^.def, callpara^.def, callpara^.valueext);
  305. callpara^.loc:=paraloc^.loc;
  306. case callpara^.loc of
  307. LOC_REFERENCE:
  308. begin
  309. if paraloc^.llvmvalueloc then
  310. internalerror(2014012307)
  311. else
  312. begin
  313. reference_reset_base(href, getpointerdef(callpara^.def), paraloc^.reference.index, paraloc^.reference.offset, paraloc^.def.alignment);
  314. res:=getregisterfordef(list, paraloc^.def);
  315. load_ref_anyreg(callpara^.def, href, res, callpara);
  316. end;
  317. callpara^.reg:=res
  318. end;
  319. LOC_REGISTER,
  320. LOC_FPUREGISTER,
  321. LOC_MMREGISTER:
  322. begin
  323. { undo explicit value extension }
  324. if callpara^.valueext<>lve_none then
  325. begin
  326. res:=getregisterfordef(list, callpara^.def);
  327. a_load_reg_reg(list, paraloc^.def, callpara^.def, paraloc^.register, res);
  328. paraloc^.register:=res;
  329. end;
  330. callpara^.reg:=paraloc^.register
  331. end;
  332. else
  333. internalerror(2014010605);
  334. end;
  335. callparas.add(callpara);
  336. paraloc:=paraloc^.next;
  337. end;
  338. end;
  339. { the Pascal level may expect a different returndef compared to the
  340. declared one }
  341. if not assigned(forceresdef) then
  342. hlretdef:=pd.returndef
  343. else
  344. hlretdef:=forceresdef;
  345. { llvm will always expect the original return def }
  346. if not paramanager.ret_in_param(hlretdef, pd) then
  347. llvmretdef:=llvmgetcgparadef(pd.funcretloc[callerside], true)
  348. else
  349. llvmretdef:=voidtype;
  350. if not is_void(llvmretdef) then
  351. res:=getregisterfordef(list, llvmretdef)
  352. else
  353. res:=NR_NO;
  354. { if this is a complex procvar, get the non-tmethod-like equivalent }
  355. if (pd.typ=procvardef) and
  356. not pd.is_addressonly then
  357. pd:=tprocvardef(pd.getcopyas(procvardef,pc_address_only));
  358. { if the function returns a function pointer type or is varargs, we
  359. must specify the full function signature, otherwise we can only
  360. specify the return type }
  361. if (po_varargs in pd.procoptions) or
  362. ((pd.proccalloption in cdecl_pocalls) and
  363. (pd.paras.count>0) and
  364. is_array_of_const(tparavarsym(pd.paras[pd.paras.count-1]).vardef)) then
  365. if (pd.typ=procdef) or
  366. not pd.is_addressonly then
  367. calldef:=pd.getcopyas(procvardef,pc_address_only)
  368. else
  369. calldef:=pd
  370. else
  371. calldef:=llvmretdef;
  372. end;
  373. function thlcgllvm.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;
  374. var
  375. callparas: tfplist;
  376. asmsym: tasmsymbol;
  377. llvmretdef,
  378. hlretdef,
  379. calldef: tdef;
  380. res: tregister;
  381. begin
  382. if not pd.owner.iscurrentunit or
  383. (s<>pd.mangledname) or
  384. (po_external in pd.procoptions) then
  385. begin
  386. asmsym:=current_asmdata.RefAsmSymbol(tprocdef(pd).mangledname);
  387. if not asmsym.declared then
  388. current_asmdata.AsmLists[al_imports].Concat(taillvmdecl.create(asmsym,pd,nil,sec_code,pd.alignment));
  389. end;
  390. a_call_common(list,pd,paras,forceresdef,res,calldef,hlretdef,llvmretdef,callparas);
  391. list.concat(taillvm.call_size_name_paras(res,calldef,current_asmdata.RefAsmSymbol(pd.mangledname),callparas));
  392. result:=get_call_result_cgpara(pd,forceresdef);
  393. set_call_function_result(list,pd,llvmretdef,hlretdef,res,result);
  394. end;
  395. function thlcgllvm.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara;
  396. var
  397. callparas: tfplist;
  398. llvmretdef,
  399. hlretdef,
  400. calldef: tdef;
  401. res: tregister;
  402. begin
  403. a_call_common(list,pd,paras,nil,res,calldef,hlretdef,llvmretdef,callparas);
  404. list.concat(taillvm.call_size_reg_paras(res,calldef,reg,callparas));
  405. result:=get_call_result_cgpara(pd,nil);
  406. set_call_function_result(list,pd,llvmretdef,hlretdef,res,result);
  407. end;
  408. procedure thlcgllvm.a_load_const_reg(list: TAsmList; tosize: tdef; a: tcgint; register: tregister);
  409. begin
  410. list.concat(taillvm.op_reg_size_const_size(llvmconvop(ptrsinttype,tosize),register,ptrsinttype,a,tosize))
  411. end;
  412. procedure thlcgllvm.a_load_const_ref(list: TAsmList; tosize: tdef; a: tcgint; const ref: treference);
  413. var
  414. sref: treference;
  415. begin
  416. { llvm instructions do not support pointer constants -> only directly
  417. encode for integers; a_load_const_reg() handles pointers properly }
  418. if is_ordinal(tosize) or
  419. is_64bit(tosize) then
  420. begin
  421. sref:=make_simple_ref(list,ref,tosize);
  422. list.concat(taillvm.op_size_const_size_ref(la_store,tosize,a,getpointerdef(tosize),sref))
  423. end
  424. else
  425. inherited;
  426. end;
  427. function def2intdef(fromsize, tosize: tdef): tdef;
  428. begin
  429. { we cannot zero-extend from/to anything but ordinal/enum
  430. types }
  431. if not(tosize.typ in [orddef,enumdef]) then
  432. internalerror(2014012305);
  433. { will give an internalerror if def_cgsize() returns OS_NO, which is
  434. what we want }
  435. result:=cgsize_orddef(def_cgsize(fromsize));
  436. end;
  437. procedure thlcgllvm.a_load_reg_ref(list: TAsmList; fromsize, tosize: tdef; register: tregister; const ref: treference);
  438. var
  439. tmpref,
  440. sref: treference;
  441. hreg,
  442. hreg2: tregister;
  443. tmpsize: tdef;
  444. begin
  445. sref:=make_simple_ref(list,ref,tosize);
  446. hreg:=register;
  447. (* typecast the pointer to the value instead of the value itself if
  448. they have the same size but are of different kinds, because we can't
  449. e.g. typecast a loaded <{i32, i32}> to an i64 *)
  450. if (llvmaggregatetype(fromsize) or
  451. llvmaggregatetype(tosize)) and
  452. (fromsize<>tosize) then
  453. begin
  454. if fromsize.size>tosize.size then
  455. begin
  456. { if source size is larger than the target size, we have to
  457. truncate it before storing. Unfortunately, we cannot truncate
  458. records (nor bitcast them to integers), so we first have to
  459. store them to memory and then bitcast the pointer to them
  460. }
  461. if fromsize.typ in [arraydef,recorddef] then
  462. begin
  463. { store struct/array-in-register to memory }
  464. tmpsize:=def2intdef(fromsize,tosize);
  465. tg.gethltemp(list,fromsize,fromsize.size,tt_normal,tmpref);
  466. a_load_reg_ref(list,fromsize,fromsize,register,tmpref);
  467. { typecast pointer to memory into pointer to integer type }
  468. hreg:=getaddressregister(list,getpointerdef(tmpsize));
  469. a_loadaddr_ref_reg(list,fromsize,getpointerdef(tmpsize),tmpref,hreg);
  470. reference_reset_base(sref,getpointerdef(tmpsize),hreg,0,tmpref.alignment);
  471. { load the integer from the temp into the destination }
  472. a_load_ref_ref(list,tmpsize,tosize,tmpref,sref);
  473. tg.ungettemp(list,tmpref);
  474. end
  475. else
  476. begin
  477. tmpsize:=def2intdef(tosize,fromsize);
  478. hreg:=getintregister(list,tmpsize);
  479. { truncate the integer }
  480. a_load_reg_reg(list,fromsize,tmpsize,register,hreg);
  481. { store it to memory (it will now be of the same size as the
  482. struct, and hence another path will be followed in this
  483. method) }
  484. a_load_reg_ref(list,tmpsize,tosize,hreg,sref);
  485. end;
  486. exit;
  487. end
  488. else
  489. begin
  490. hreg2:=getaddressregister(list,getpointerdef(fromsize));
  491. a_loadaddr_ref_reg(list,tosize,getpointerdef(fromsize),sref,hreg2);
  492. reference_reset_base(sref,getpointerdef(fromsize),hreg2,0,sref.alignment);
  493. tosize:=fromsize;
  494. end;
  495. end
  496. else if fromsize<>tosize then
  497. begin
  498. hreg:=getregisterfordef(list,tosize);
  499. a_load_reg_reg(list,fromsize,tosize,register,hreg);
  500. end;
  501. list.concat(taillvm.op_size_reg_size_ref(la_store,tosize,hreg,getpointerdef(tosize),sref));
  502. end;
  503. procedure thlcgllvm.a_load_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister);
  504. var
  505. op: tllvmop;
  506. tmpreg: tregister;
  507. tmpintdef: tdef;
  508. begin
  509. op:=llvmconvop(fromsize,tosize);
  510. { converting from pointer to something else and vice versa is only
  511. possible via an intermediate pass to integer. Same for "something else"
  512. to pointer. }
  513. case op of
  514. la_ptrtoint_to_x,
  515. la_x_to_inttoptr:
  516. begin
  517. { convert via an integer with the same size as "x" }
  518. if op=la_ptrtoint_to_x then
  519. begin
  520. tmpintdef:=cgsize_orddef(def_cgsize(tosize));
  521. op:=la_bitcast
  522. end
  523. else
  524. begin
  525. tmpintdef:=cgsize_orddef(def_cgsize(fromsize));
  526. op:=la_inttoptr;
  527. end;
  528. tmpreg:=getintregister(list,tmpintdef);
  529. a_load_reg_reg(list,fromsize,tmpintdef,reg1,tmpreg);
  530. reg1:=tmpreg;
  531. fromsize:=tmpintdef;
  532. end;
  533. end;
  534. { reg2 = bitcast fromsize reg1 to tosize }
  535. list.concat(taillvm.op_reg_size_reg_size(op,reg2,fromsize,reg1,tosize));
  536. end;
  537. procedure thlcgllvm.a_load_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; register: tregister);
  538. var
  539. tmpref,
  540. sref: treference;
  541. hreg: tregister;
  542. tmpsize: tdef;
  543. begin
  544. sref:=make_simple_ref(list,ref,fromsize);
  545. { "named register"? }
  546. if sref.refaddr=addr_full then
  547. begin
  548. { can't bitcast records/arrays }
  549. if (llvmaggregatetype(fromsize) or
  550. llvmaggregatetype(tosize)) and
  551. (fromsize<>tosize) then
  552. begin
  553. tg.gethltemp(list,fromsize,fromsize.size,tt_normal,tmpref);
  554. list.concat(taillvm.op_size_ref_size_ref(la_store,fromsize,sref,getpointerdef(fromsize),tmpref));
  555. a_load_ref_reg(list,fromsize,tosize,tmpref,register);
  556. tg.ungettemp(list,tmpref);
  557. end
  558. else
  559. list.concat(taillvm.op_reg_size_ref_size(la_bitcast,register,fromsize,sref,tosize))
  560. end
  561. else
  562. begin
  563. if ((fromsize.typ in [arraydef,recorddef]) or
  564. (tosize.typ in [arraydef,recorddef])) and
  565. (fromsize<>tosize) then
  566. begin
  567. if fromsize.size<tosize.size then
  568. begin
  569. { if the target size is larger than the source size, we
  570. have to perform the zero-extension using an integer type
  571. (can't zero-extend a record/array) }
  572. if fromsize.typ in [arraydef,recorddef] then
  573. begin
  574. { typecast the pointer to the struct into a pointer to an
  575. integer of equal size }
  576. tmpsize:=def2intdef(fromsize,tosize);
  577. hreg:=getaddressregister(list,getpointerdef(tmpsize));
  578. a_loadaddr_ref_reg(list,fromsize,getpointerdef(tmpsize),sref,hreg);
  579. reference_reset_base(sref,getpointerdef(tmpsize),hreg,0,sref.alignment);
  580. { load that integer }
  581. a_load_ref_reg(list,tmpsize,tosize,sref,register);
  582. end
  583. else
  584. begin
  585. { load the integer into an integer memory location with
  586. the same size as the struct (the integer should be
  587. unsigned, we don't want sign extensions here) }
  588. if is_signed(fromsize) then
  589. internalerror(2014012309);
  590. tmpsize:=def2intdef(tosize,fromsize);
  591. tg.gethltemp(list,tmpsize,tmpsize.size,tt_normal,tmpref);
  592. { typecast the struct-sized integer location into the
  593. struct type }
  594. a_load_ref_ref(list,fromsize,tmpsize,sref,tmpref);
  595. { load the struct in the register }
  596. a_load_ref_reg(list,tmpsize,tosize,tmpref,register);
  597. tg.ungettemp(list,tmpref);
  598. end;
  599. exit;
  600. end
  601. else
  602. begin
  603. (* typecast the pointer to the value instead of the value
  604. itself if they have the same size but are of different
  605. kinds, because we can't e.g. typecast a loaded <{i32, i32}>
  606. to an i64 *)
  607. hreg:=getaddressregister(list,getpointerdef(tosize));
  608. a_loadaddr_ref_reg(list,fromsize,getpointerdef(tosize),sref,hreg);
  609. reference_reset_base(sref,getpointerdef(tosize),hreg,0,sref.alignment);
  610. fromsize:=tosize;
  611. end;
  612. end;
  613. hreg:=register;
  614. if fromsize<>tosize then
  615. hreg:=getregisterfordef(list,fromsize);
  616. list.concat(taillvm.op_reg_size_ref(la_load,hreg,getpointerdef(fromsize),sref));
  617. if hreg<>register then
  618. a_load_reg_reg(list,fromsize,tosize,hreg,register);
  619. end;
  620. end;
  621. procedure thlcgllvm.a_load_ref_ref(list: TAsmList; fromsize, tosize: tdef; const sref: treference; const dref: treference);
  622. var
  623. sdref: treference;
  624. begin
  625. if (fromsize=tosize) and
  626. (sref.refaddr=addr_full) then
  627. begin
  628. sdref:=make_simple_ref(list,dref,tosize);
  629. list.concat(taillvm.op_size_ref_size_ref(la_store,fromsize,sref,getpointerdef(tosize),sdref));
  630. end
  631. else
  632. inherited
  633. end;
  634. procedure thlcgllvm.a_loadaddr_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; r: tregister);
  635. var
  636. sref: treference;
  637. begin
  638. { can't take the address of a 'named register' }
  639. if ref.refaddr=addr_full then
  640. internalerror(2013102306);
  641. sref:=make_simple_ref(list,ref,fromsize);
  642. list.concat(taillvm.op_reg_size_ref_size(la_bitcast,r,getpointerdef(fromsize),sref,tosize));
  643. end;
  644. procedure thlcgllvm.a_op_const_reg(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; reg: TRegister);
  645. begin
  646. a_op_const_reg_reg(list,op,size,a,reg,reg);
  647. end;
  648. procedure thlcgllvm.a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister);
  649. var
  650. tmpreg: tregister;
  651. begin
  652. if (def2regtyp(size)=R_INTREGISTER) and
  653. (topcg2llvmop[op]<>la_none) then
  654. list.concat(taillvm.op_reg_size_reg_const(topcg2llvmop[op],dst,size,src,a))
  655. else
  656. begin
  657. { default implementation is not SSA-safe }
  658. tmpreg:=getregisterfordef(list,size);
  659. a_load_const_reg(list,size,a,tmpreg);
  660. a_op_reg_reg_reg(list,op,size,tmpreg,src,dst);
  661. end;
  662. end;
  663. procedure thlcgllvm.a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister);
  664. var
  665. orgdst,
  666. tmpreg1,
  667. tmpreg2,
  668. tmpreg3: tregister;
  669. opsize: tdef;
  670. begin
  671. orgdst:=dst;
  672. opsize:=size;
  673. { always perform using integer registers, because math operations on
  674. pointers are not supported (except via getelementptr, possible future
  675. optimization) }
  676. if def2regtyp(size)=R_ADDRESSREGISTER then
  677. begin
  678. opsize:=ptruinttype;
  679. tmpreg1:=getintregister(list,ptruinttype);
  680. a_load_reg_reg(list,size,ptruinttype,src1,tmpreg1);
  681. src1:=tmpreg1;
  682. tmpreg1:=getintregister(list,ptruinttype);
  683. a_load_reg_reg(list,size,ptruinttype,src2,tmpreg1);
  684. src2:=tmpreg1;
  685. dst:=getintregister(list,ptruinttype);
  686. end;
  687. if topcg2llvmop[op]<>la_none then
  688. list.concat(taillvm.op_reg_size_reg_reg(topcg2llvmop[op],dst,opsize,src2,src1))
  689. else
  690. begin
  691. case op of
  692. OP_NEG:
  693. { %dst = sub size 0, %src1 }
  694. list.concat(taillvm.op_reg_size_const_reg(la_sub,dst,opsize,0,src1));
  695. OP_NOT:
  696. { %dst = xor size -1, %src1 }
  697. list.concat(taillvm.op_reg_size_const_reg(la_xor,dst,opsize,-1,src1));
  698. OP_ROL:
  699. begin
  700. tmpreg1:=getintregister(list,opsize);
  701. tmpreg2:=getintregister(list,opsize);
  702. tmpreg3:=getintregister(list,opsize);
  703. { tmpreg1 := tcgsize2size[size] - src1 }
  704. list.concat(taillvm.op_reg_size_const_reg(la_sub,tmpreg1,opsize,opsize.size,src1));
  705. { tmpreg2 := src2 shr tmpreg1 }
  706. a_op_reg_reg_reg(list,OP_SHR,opsize,tmpreg1,src2,tmpreg2);
  707. { tmpreg3 := src2 shl src1 }
  708. a_op_reg_reg_reg(list,OP_SHL,opsize,src1,src2,tmpreg3);
  709. { dst := tmpreg2 or tmpreg3 }
  710. a_op_reg_reg_reg(list,OP_OR,opsize,tmpreg2,tmpreg3,dst);
  711. end;
  712. OP_ROR:
  713. begin
  714. tmpreg1:=getintregister(list,size);
  715. tmpreg2:=getintregister(list,size);
  716. tmpreg3:=getintregister(list,size);
  717. { tmpreg1 := tcgsize2size[size] - src1 }
  718. list.concat(taillvm.op_reg_size_const_reg(la_sub,tmpreg1,opsize,opsize.size,src1));
  719. { tmpreg2 := src2 shl tmpreg1 }
  720. a_op_reg_reg_reg(list,OP_SHL,opsize,tmpreg1,src2,tmpreg2);
  721. { tmpreg3 := src2 shr src1 }
  722. a_op_reg_reg_reg(list,OP_SHR,opsize,src1,src2,tmpreg3);
  723. { dst := tmpreg2 or tmpreg3 }
  724. a_op_reg_reg_reg(list,OP_OR,opsize,tmpreg2,tmpreg3,dst);
  725. end;
  726. else
  727. internalerror(2010081310);
  728. end;
  729. end;
  730. if dst<>orgdst then
  731. a_load_reg_reg(list,opsize,size,dst,orgdst);
  732. end;
  733. procedure thlcgllvm.a_op_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; reg1, reg2: TRegister);
  734. begin
  735. a_op_reg_reg_reg(list,op,size,reg1,reg2,reg2);
  736. end;
  737. procedure thlcgllvm.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister; setflags: boolean; var ovloc: tlocation);
  738. begin
  739. if not setflags then
  740. begin
  741. inherited;
  742. exit;
  743. end;
  744. { use xxx.with.overflow intrinsics }
  745. internalerror(2012111102);
  746. end;
  747. procedure thlcgllvm.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister; setflags: boolean; var ovloc: tlocation);
  748. begin
  749. if not setflags then
  750. begin
  751. inherited;
  752. exit;
  753. end;
  754. { use xxx.with.overflow intrinsics }
  755. internalerror(2012111103);
  756. end;
  757. procedure thlcgllvm.a_cmp_const_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel);
  758. var
  759. tmpreg : tregister;
  760. invert: boolean;
  761. fallthroughlab, falselab, tmplab: tasmlabel;
  762. begin
  763. { since all comparisons return their results in a register, we'll often
  764. get comparisons against true/false -> optimise }
  765. if (size=pasbool8type) and
  766. (cmp_op in [OC_EQ,OC_NE]) then
  767. begin
  768. case cmp_op of
  769. OC_EQ:
  770. invert:=a=0;
  771. OC_NE:
  772. invert:=a=1;
  773. else
  774. { avoid uninitialised warning }
  775. internalerror(2015031504);
  776. end;
  777. current_asmdata.getjumplabel(falselab);
  778. fallthroughlab:=falselab;
  779. if invert then
  780. begin
  781. tmplab:=l;
  782. l:=falselab;
  783. falselab:=tmplab;
  784. end;
  785. list.concat(taillvm.op_size_reg_lab_lab(la_br,pasbool8type,reg,l,falselab));
  786. a_label(list,fallthroughlab);
  787. exit;
  788. end;
  789. tmpreg:=getregisterfordef(list,size);
  790. a_load_const_reg(list,size,a,tmpreg);
  791. a_cmp_reg_reg_label(list,size,cmp_op,tmpreg,reg,l);
  792. end;
  793. procedure thlcgllvm.a_cmp_reg_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel);
  794. var
  795. resreg: tregister;
  796. falselab: tasmlabel;
  797. begin
  798. if getregtype(reg1)<>getregtype(reg2) then
  799. internalerror(2012111105);
  800. resreg:=getintregister(list,pasbool8type);
  801. current_asmdata.getjumplabel(falselab);
  802. { invert order of registers. In FPC, cmp_reg_reg(reg1,reg2) means that
  803. e.g. OC_GT is true if "subl %reg1,%reg2" in x86 AT&T is >0. In LLVM,
  804. OC_GT is true if op1>op2 }
  805. list.concat(taillvm.op_reg_cond_size_reg_reg(la_icmp,resreg,cmp_op,size,reg2,reg1));
  806. list.concat(taillvm.op_size_reg_lab_lab(la_br,pasbool8type,resreg,l,falselab));
  807. a_label(list,falselab);
  808. end;
  809. procedure thlcgllvm.a_jmp_always(list: TAsmList; l: tasmlabel);
  810. begin
  811. { implement in tcg because required by the overridden a_label; doesn't use
  812. any high level stuff anyway }
  813. cg.a_jmp_always(list,l);
  814. end;
  815. procedure thlcgllvm.g_concatcopy(list: TAsmList; size: tdef; const source, dest: treference);
  816. begin
  817. a_load_ref_ref(list,size,size,source,dest);
  818. end;
  819. procedure thlcgllvm.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister);
  820. var
  821. tmpreg: tregister;
  822. href: treference;
  823. fromcompcurr,
  824. tocompcurr: boolean;
  825. begin
  826. { named register -> use generic code }
  827. if ref.refaddr=addr_full then
  828. begin
  829. a_load_ref_reg(list,fromsize,tosize,ref,reg);
  830. exit
  831. end;
  832. { comp and currency are handled by the x87 in this case. They cannot
  833. be represented directly in llvm, and llvmdef translates them into i64
  834. (since that's their storage size and internally they also are int64).
  835. Solve this by changing the type to s80real once they are loaded into
  836. a register. }
  837. fromcompcurr:=tfloatdef(fromsize).floattype in [s64comp,s64currency];
  838. tocompcurr:=tfloatdef(tosize).floattype in [s64comp,s64currency];
  839. if tocompcurr then
  840. tosize:=s80floattype;
  841. href:=make_simple_ref(list,ref,fromsize);
  842. { don't generate different code for loading e.g. extended into cextended,
  843. but to take care of loading e.g. comp (=int64) into double }
  844. if (fromsize.size<>tosize.size) then
  845. tmpreg:=getfpuregister(list,fromsize)
  846. else
  847. tmpreg:=reg;
  848. { %tmpreg = load size* %ref }
  849. list.concat(taillvm.op_reg_size_ref(la_load,tmpreg,getpointerdef(fromsize),href));
  850. if tmpreg<>reg then
  851. if fromcompcurr then
  852. { treat as extended as long as it's in a register }
  853. list.concat(taillvm.op_reg_size_reg_size(la_sitofp,reg,fromsize,tmpreg,tosize))
  854. else
  855. a_loadfpu_reg_reg(list,fromsize,tosize,tmpreg,reg);
  856. end;
  857. procedure thlcgllvm.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference);
  858. var
  859. tmpreg: tregister;
  860. href: treference;
  861. fromcompcurr,
  862. tocompcurr: boolean;
  863. begin
  864. { see comment in a_loadfpu_ref_reg }
  865. fromcompcurr:=tfloatdef(fromsize).floattype in [s64comp,s64currency];
  866. tocompcurr:=tfloatdef(tosize).floattype in [s64comp,s64currency];
  867. if fromcompcurr then
  868. fromsize:=s80floattype;
  869. href:=make_simple_ref(list,ref,tosize);
  870. { don't generate different code for loading e.g. extended into cextended,
  871. but to take care of storing e.g. comp (=int64) into double }
  872. if (fromsize.size<>tosize.size) then
  873. begin
  874. tmpreg:=getfpuregister(list,tosize);
  875. if tocompcurr then
  876. { store back an int64 rather than an extended }
  877. list.concat(taillvm.op_reg_size_reg_size(la_fptosi,tmpreg,fromsize,reg,tosize))
  878. else
  879. a_loadfpu_reg_reg(list,fromsize,tosize,reg,tmpreg);
  880. end
  881. else
  882. tmpreg:=reg;
  883. { store tosize tmpreg, tosize* href }
  884. list.concat(taillvm.op_size_reg_size_ref(la_store,tosize,tmpreg,getpointerdef(tosize),href));
  885. end;
  886. procedure thlcgllvm.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister);
  887. var
  888. op: tllvmop;
  889. intfromsize,
  890. inttosize: longint;
  891. begin
  892. { treat comp and currency as extended in registers (see comment at start
  893. of a_loadfpu_ref_reg) }
  894. if tfloatdef(fromsize).floattype in [s64comp,s64currency] then
  895. fromsize:=sc80floattype;
  896. if tfloatdef(tosize).floattype in [s64comp,s64currency] then
  897. tosize:=sc80floattype;
  898. { at the value level, s80real and sc80real are the same }
  899. if fromsize<>s80floattype then
  900. intfromsize:=fromsize.size
  901. else
  902. intfromsize:=sc80floattype.size;
  903. if tosize<>s80floattype then
  904. inttosize:=tosize.size
  905. else
  906. inttosize:=sc80floattype.size;
  907. if intfromsize<inttosize then
  908. op:=la_fpext
  909. else if intfromsize>inttosize then
  910. op:=la_fptrunc
  911. else
  912. op:=la_bitcast;
  913. { reg2 = bitcast fromllsize reg1 to tollsize }
  914. list.concat(taillvm.op_reg_size_reg_size(op,reg2,fromsize,reg1,tosize));
  915. end;
  916. procedure thlcgllvm.gen_proc_symbol(list: TAsmList);
  917. var
  918. item: TCmdStrListItem;
  919. mangledname: TSymStr;
  920. asmsym: tasmsymbol;
  921. begin
  922. item:=TCmdStrListItem(current_procinfo.procdef.aliasnames.first);
  923. mangledname:=current_procinfo.procdef.mangledname;
  924. { predefine the real function name as local/global, so the aliases can
  925. refer to the symbol and get the binding correct }
  926. if (cs_profile in current_settings.moduleswitches) or
  927. (po_global in current_procinfo.procdef.procoptions) then
  928. asmsym:=current_asmdata.DefineAsmSymbol(mangledname,AB_GLOBAL,AT_FUNCTION)
  929. else
  930. asmsym:=current_asmdata.DefineAsmSymbol(mangledname,AB_LOCAL,AT_FUNCTION);
  931. while assigned(item) do
  932. begin
  933. if mangledname<>item.Str then
  934. list.concat(taillvmalias.create(asmsym,item.str,current_procinfo.procdef,llv_default,lll_default));
  935. item:=TCmdStrListItem(item.next);
  936. end;
  937. list.concat(taillvmdecl.create(asmsym,current_procinfo.procdef,nil,sec_code,current_procinfo.procdef.alignment));
  938. end;
  939. procedure thlcgllvm.gen_proc_symbol_end(list: TAsmList);
  940. begin
  941. list.concat(Tai_symbol_end.Createname(current_procinfo.procdef.mangledname));
  942. { todo: darwin main proc, or handle in other way? }
  943. end;
  944. procedure thlcgllvm.g_proc_entry(list: TAsmList; localsize: longint; nostackframe: boolean);
  945. begin
  946. list.concatlist(ttgllvm(tg).alloclist)
  947. { rest: todo }
  948. end;
  949. procedure thlcgllvm.g_proc_exit(list: TAsmList; parasize: longint; nostackframe: boolean);
  950. var
  951. retdef: tdef;
  952. retreg,
  953. hreg: tregister;
  954. retpara: tcgpara;
  955. begin
  956. { the function result type is the type of the first location, which can
  957. differ from the real result type (e.g. int64 for a record consisting of
  958. two longint fields on x86-64 -- we are responsible for lowering the
  959. result types like that) }
  960. retpara:=get_call_result_cgpara(current_procinfo.procdef,nil);
  961. retpara.check_simple_location;
  962. retdef:=retpara.location^.def;
  963. if is_void(retdef) or
  964. { don't check retdef here, it is e.g. a pshortstring in case it's
  965. shortstring that's returned in a parameter }
  966. paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then
  967. list.concat(taillvm.op_size(la_ret,voidtype))
  968. else
  969. begin
  970. case retpara.location^.loc of
  971. LOC_REGISTER,
  972. LOC_FPUREGISTER,
  973. LOC_MMREGISTER:
  974. begin
  975. { inline assembler routines contain a ret at the end and never
  976. get here, but we do need a return at the end -> return an
  977. undefined value in this case }
  978. if po_assembler in current_procinfo.procdef.procoptions then
  979. gen_load_uninitialized_function_result(list,current_procinfo.procdef,retpara.def,retpara);
  980. { sign/zeroextension of function results is handled implicitly
  981. via the signext/zeroext modifiers of the result, rather than
  982. in the code generator -> remove any explicit extensions here }
  983. retreg:=retpara.location^.register;
  984. if (current_procinfo.procdef.returndef.typ in [orddef,enumdef]) and
  985. (retdef.typ in [orddef,enumdef]) then
  986. begin
  987. if (current_procinfo.procdef.returndef.size<retpara.location^.def.size) then
  988. begin
  989. hreg:=getintregister(list,current_procinfo.procdef.returndef);
  990. a_load_reg_reg(list,retdef,current_procinfo.procdef.returndef,retreg,hreg);
  991. retreg:=hreg;
  992. retdef:=current_procinfo.procdef.returndef;
  993. end;
  994. end;
  995. list.concat(taillvm.op_size_reg(la_ret,retdef,retreg))
  996. end
  997. else
  998. { todo: complex returns }
  999. internalerror(2012111106);
  1000. end;
  1001. end;
  1002. retpara.resetiftemp;
  1003. end;
  1004. procedure thlcgllvm.gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara);
  1005. begin
  1006. if not paramanager.ret_in_param(resdef,pd) then
  1007. begin
  1008. case resloc.location^.loc of
  1009. LOC_REGISTER,
  1010. LOC_FPUREGISTER,
  1011. LOC_MMREGISTER:
  1012. begin
  1013. resloc.check_simple_location;
  1014. list.concat(taillvm.op_reg_size_undef(la_bitcast,resloc.location^.register,resloc.location^.def));
  1015. end;
  1016. else
  1017. internalerror(2015042301);
  1018. end;
  1019. end;
  1020. end;
  1021. procedure thlcgllvm.g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef);
  1022. begin
  1023. { not possible, need ovloc }
  1024. internalerror(2012111107);
  1025. end;
  1026. procedure thlcgllvm.g_overflowCheck_loc(List: TAsmList; const Loc: TLocation; def: TDef; var ovloc: tlocation);
  1027. begin
  1028. { todo }
  1029. internalerror(2012111108);
  1030. end;
  1031. procedure thlcgllvm.g_ptrtypecast_reg(list: TAsmList; fromdef, todef: tpointerdef; reg: tregister);
  1032. begin
  1033. { will insert a bitcast if necessary }
  1034. a_load_reg_reg(list,fromdef,todef,reg,reg);
  1035. end;
  1036. procedure thlcgllvm.g_ptrtypecast_ref(list: TAsmList; fromdef, todef: tpointerdef; var ref: treference);
  1037. var
  1038. hreg: tregister;
  1039. begin
  1040. hreg:=getaddressregister(list,todef);
  1041. a_loadaddr_ref_reg(list,fromdef.pointeddef,todef,ref,hreg);
  1042. reference_reset_base(ref,todef,hreg,0,ref.alignment);
  1043. end;
  1044. procedure thlcgllvm.a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle);
  1045. var
  1046. href: treference;
  1047. begin
  1048. { named register -> use generic code }
  1049. if ref.refaddr=addr_full then
  1050. a_load_ref_reg(list,fromsize,tosize,ref,reg)
  1051. else if shuffle=mms_movescalar then
  1052. a_loadfpu_ref_reg(list,fromsize,tosize,ref,reg)
  1053. else
  1054. begin
  1055. { todo }
  1056. if fromsize<>tosize then
  1057. internalerror(2013060220);
  1058. href:=make_simple_ref(list,ref,fromsize);
  1059. { %reg = load size* %ref }
  1060. list.concat(taillvm.op_reg_size_ref(la_load,reg,getpointerdef(fromsize),href));
  1061. end;
  1062. end;
  1063. procedure thlcgllvm.a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle);
  1064. var
  1065. href: treference;
  1066. begin
  1067. if shuffle=mms_movescalar then
  1068. a_loadfpu_reg_ref(list,fromsize,tosize,reg,ref)
  1069. else
  1070. begin
  1071. { todo }
  1072. if fromsize<>tosize then
  1073. internalerror(2013060220);
  1074. href:=make_simple_ref(list,ref,tosize);
  1075. { store tosize reg, tosize* href }
  1076. list.concat(taillvm.op_size_reg_size_ref(la_store,tosize,reg,getpointerdef(tosize),href))
  1077. end;
  1078. end;
  1079. procedure thlcgllvm.a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister; shuffle: pmmshuffle);
  1080. begin
  1081. if shuffle=mms_movescalar then
  1082. a_loadfpu_reg_reg(list,fromsize,tosize,reg1,reg2)
  1083. else
  1084. { reg2 = bitcast fromllsize reg1 to tollsize }
  1085. list.concat(taillvm.op_reg_size_reg_size(la_bitcast,reg2,fromsize,reg1,tosize));
  1086. end;
  1087. procedure thlcgllvm.a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; src, dst: tregister; shuffle: pmmshuffle);
  1088. begin
  1089. if (op=OP_XOR) and
  1090. (src=dst) then
  1091. a_load_const_reg(list,size,0,dst)
  1092. else
  1093. { todo }
  1094. internalerror(2013060221);
  1095. end;
  1096. procedure thlcgllvm.a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize: tdef; intreg, mmreg: tregister; shuffle: pmmshuffle);
  1097. begin
  1098. internalerror(2013060222);
  1099. end;
  1100. procedure thlcgllvm.a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize: tdef; mmreg, intreg: tregister; shuffle: pmmshuffle);
  1101. begin
  1102. internalerror(2013060223);
  1103. end;
  1104. function thlcgllvm.get_call_result_cgpara(pd: tabstractprocdef; forceresdef: tdef): tcgpara;
  1105. var
  1106. paraloc: pcgparalocation;
  1107. begin
  1108. result:=inherited;
  1109. { we'll change the paraloc, make sure we don't modify the original one }
  1110. if not result.temporary then
  1111. begin
  1112. result:=result.getcopy;
  1113. result.temporary:=true;
  1114. end;
  1115. { get the LLVM representation of the function result (e.g. a
  1116. struct with two i64 fields for a record with 4 i32 fields) }
  1117. result.def:=llvmgetcgparadef(result,true);
  1118. if assigned(result.location^.next) then
  1119. begin
  1120. { unify the result into a sinlge location; unlike for parameters,
  1121. we are not responsible for splitting up results into multiple
  1122. locations }
  1123. { set the first location to the type of the function result }
  1124. result.location^.def:=result.def;
  1125. result.location^.size:=result.size;
  1126. { free all extra paralocs }
  1127. while assigned(result.location^.next) do
  1128. begin
  1129. paraloc:=result.location^.next^.next;
  1130. freemem(result.location^.next);
  1131. result.location^.next:=paraloc;
  1132. end;
  1133. end;
  1134. paraloc:=result.location;
  1135. paraloc^.def:=result.def;
  1136. case paraloc^.loc of
  1137. LOC_VOID:
  1138. ;
  1139. LOC_REGISTER,
  1140. LOC_FPUREGISTER,
  1141. LOC_MMREGISTER:
  1142. begin
  1143. paraloc^.llvmloc.loc:=paraloc^.loc;
  1144. paraloc^.llvmloc.reg:=paraloc^.register;
  1145. paraloc^.llvmvalueloc:=true;
  1146. end;
  1147. LOC_REFERENCE:
  1148. if not paramanager.ret_in_param(pd.returndef,pd) then
  1149. { TODO, if this can happen at all }
  1150. internalerror(2014011901);
  1151. else
  1152. internalerror(2014011902);
  1153. end;
  1154. end;
  1155. procedure thlcgllvm.gen_load_loc_function_result(list: TAsmList; vardef: tdef; const l: tlocation);
  1156. begin
  1157. gen_load_loc_cgpara(list,vardef,l,get_call_result_cgpara(current_procinfo.procdef,nil));
  1158. end;
  1159. procedure thlcgllvm.gen_load_loc_cgpara(list: TAsmList; vardef: tdef; const l: tlocation; const cgpara: tcgpara);
  1160. var
  1161. memloc: tlocation;
  1162. begin
  1163. if not(cgpara.location^.llvmvalueloc) then
  1164. begin
  1165. memloc:=l;
  1166. location_force_mem(list,memloc,vardef);
  1167. a_loadaddr_ref_cgpara(list,vardef,memloc.reference,cgpara);
  1168. end
  1169. else
  1170. inherited;
  1171. end;
  1172. procedure thlcgllvm.gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean);
  1173. var
  1174. ploc : pcgparalocation;
  1175. hloc : tlocation;
  1176. href, href2 : treference;
  1177. hreg : tregister;
  1178. llvmparadef : tdef;
  1179. index : longint;
  1180. offset : pint;
  1181. userecord : boolean;
  1182. begin
  1183. { ignore e.g. empty records }
  1184. if (para.location^.loc=LOC_VOID) then
  1185. exit;
  1186. { If the parameter location is reused we don't need to copy
  1187. anything }
  1188. if (destloc.loc=LOC_REFERENCE) and
  1189. reusepara then
  1190. exit;
  1191. { get the equivalent llvm def used to pass the parameter (e.g. a record
  1192. with two int64 fields for passing a record consisiting of 8 bytes on
  1193. x86-64) }
  1194. llvmparadef:=llvmgetcgparadef(para,true);
  1195. userecord:=
  1196. (llvmparadef<>para.def) and
  1197. assigned(para.location^.next);
  1198. if userecord then
  1199. begin
  1200. { llvmparadef is a record in this case, with every field corresponding
  1201. to a single paraloc }
  1202. if destloc.loc<>LOC_REFERENCE then
  1203. tg.gethltemp(list,llvmparadef,llvmparadef.size,tt_normal,href)
  1204. else
  1205. begin
  1206. hreg:=getaddressregister(list,getpointerdef(llvmparadef));
  1207. a_loadaddr_ref_reg(list,vardef,getpointerdef(llvmparadef),destloc.reference,hreg);
  1208. reference_reset_base(href,getpointerdef(llvmparadef),hreg,0,destloc.reference.alignment);
  1209. end;
  1210. index:=0;
  1211. offset:=0;
  1212. ploc:=para.location;
  1213. repeat
  1214. paraloctoloc(ploc,hloc);
  1215. hreg:=getaddressregister(list,getpointerdef(ploc^.def));
  1216. list.concat(taillvm.getelementptr_reg_size_ref_size_const(hreg,getpointerdef(llvmparadef),href,s32inttype,index,true));
  1217. reference_reset_base(href2,getpointerdef(ploc^.def),hreg,0,newalignment(href.alignment,offset));
  1218. a_load_loc_ref(list,ploc^.def,ploc^.def,hloc,href2);
  1219. inc(offset,ploc^.def.size);
  1220. inc(index);
  1221. ploc:=ploc^.next;
  1222. until not assigned(ploc);
  1223. if destloc.loc<>LOC_REFERENCE then
  1224. tg.ungettemp(list,href);
  1225. end
  1226. else
  1227. begin
  1228. para.check_simple_location;
  1229. paraloctoloc(para.location,hloc);
  1230. case destloc.loc of
  1231. LOC_REFERENCE :
  1232. begin
  1233. case def2regtyp(llvmparadef) of
  1234. R_INTREGISTER,
  1235. R_ADDRESSREGISTER:
  1236. a_load_loc_ref(list,llvmparadef,para.def,hloc,destloc.reference);
  1237. R_FPUREGISTER:
  1238. a_loadfpu_loc_ref(list,llvmparadef,para.def,hloc,destloc.reference);
  1239. R_MMREGISTER:
  1240. a_loadmm_loc_ref(list,llvmparadef,para.def,hloc,destloc.reference,nil);
  1241. else
  1242. internalerror(2014080801);
  1243. end;
  1244. end;
  1245. LOC_REGISTER:
  1246. begin
  1247. a_load_loc_reg(list,llvmparadef,para.def,hloc,destloc.register);
  1248. end;
  1249. LOC_FPUREGISTER:
  1250. begin
  1251. a_loadfpu_loc_reg(list,llvmparadef,para.def,hloc,destloc.register);
  1252. end;
  1253. LOC_MMREGISTER:
  1254. begin
  1255. a_loadmm_loc_reg(list,llvmparadef,para.def,hloc,destloc.register,nil);
  1256. end;
  1257. { TODO other possible locations }
  1258. else
  1259. internalerror(2013102304);
  1260. end;
  1261. end;
  1262. end;
  1263. procedure thlcgllvm.a_jmp_flags(list: TAsmList; const f: TResFlags; l: tasmlabel);
  1264. begin
  1265. internalerror(2013060224);
  1266. end;
  1267. procedure thlcgllvm.g_flags2reg(list: TAsmList; size: tdef; const f: tresflags; reg: TRegister);
  1268. begin
  1269. internalerror(2013060225);
  1270. end;
  1271. procedure thlcgllvm.g_flags2ref(list: TAsmList; size: tdef; const f: tresflags; const ref: TReference);
  1272. begin
  1273. internalerror(2013060226);
  1274. end;
  1275. procedure thlcgllvm.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; srcsize, dstsize: tdef; src, dst: tregister);
  1276. begin
  1277. internalerror(2012090201);
  1278. end;
  1279. procedure thlcgllvm.g_stackpointer_alloc(list: TAsmList; size: longint);
  1280. begin
  1281. internalerror(2012090203);
  1282. end;
  1283. procedure thlcgllvm.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
  1284. begin
  1285. internalerror(2012090204);
  1286. end;
  1287. procedure thlcgllvm.g_adjust_self_value(list: TAsmList; procdef: tprocdef; ioffset: aint);
  1288. begin
  1289. internalerror(2012090205);
  1290. end;
  1291. procedure thlcgllvm.g_local_unwind(list: TAsmList; l: TAsmLabel);
  1292. begin
  1293. internalerror(2012090206);
  1294. end;
  1295. function thlcgllvm.make_simple_ref(list: TAsmList; const ref: treference; def: tdef): treference;
  1296. var
  1297. ptrindex: tcgint;
  1298. hreg1,
  1299. hreg2: tregister;
  1300. tmpref: treference;
  1301. defsize: asizeint;
  1302. begin
  1303. { already simple? }
  1304. if (not assigned(ref.symbol) or
  1305. (ref.base=NR_NO)) and
  1306. (ref.index=NR_NO) and
  1307. (ref.offset=0) then
  1308. begin
  1309. result:=ref;
  1310. exit;
  1311. end;
  1312. hreg2:=getaddressregister(list,getpointerdef(def));
  1313. defsize:=def.size;
  1314. { for voiddef/formaldef }
  1315. if defsize=0 then
  1316. defsize:=1;
  1317. { symbol+offset or base+offset with offset a multiple of the size ->
  1318. use getelementptr }
  1319. if (ref.index=NR_NO) and
  1320. (ref.offset mod defsize=0) then
  1321. begin
  1322. ptrindex:=ref.offset div defsize;
  1323. if assigned(ref.symbol) then
  1324. reference_reset_symbol(tmpref,ref.symbol,0,ref.alignment)
  1325. else
  1326. reference_reset_base(tmpref,getpointerdef(def),ref.base,0,ref.alignment);
  1327. list.concat(taillvm.getelementptr_reg_size_ref_size_const(hreg2,getpointerdef(def),tmpref,ptruinttype,ptrindex,assigned(ref.symbol)));
  1328. reference_reset_base(result,getpointerdef(def),hreg2,0,ref.alignment);
  1329. exit;
  1330. end;
  1331. { for now, perform all calculations using plain pointer arithmetic. Later
  1332. we can look into optimizations based on getelementptr for structured
  1333. accesses (if only to prevent running out of virtual registers).
  1334. Assumptions:
  1335. * symbol/base register: always type "def*"
  1336. * index/offset: always type "ptruinttype" (llvm bitcode has no sign information, so sign doesn't matter) }
  1337. hreg1:=getintregister(list,ptruinttype);
  1338. if assigned(ref.symbol) then
  1339. begin
  1340. if ref.base<>NR_NO then
  1341. internalerror(2012111301);
  1342. reference_reset_symbol(tmpref,ref.symbol,0,ref.alignment);
  1343. list.concat(taillvm.getelementptr_reg_size_ref_size_const(hreg1,getpointerdef(def),tmpref,ptruinttype,0,true));
  1344. end
  1345. else if ref.base<>NR_NO then
  1346. begin
  1347. a_load_reg_reg(list,getpointerdef(def),ptruinttype,ref.base,hreg1);
  1348. end
  1349. else
  1350. { todo: support for absolute addresses on embedded platforms }
  1351. internalerror(2012111302);
  1352. if ref.index<>NR_NO then
  1353. begin
  1354. { SSA... }
  1355. hreg2:=getintregister(list,ptruinttype);
  1356. a_op_reg_reg_reg(list,OP_ADD,ptruinttype,ref.index,hreg1,hreg2);
  1357. hreg1:=hreg2;
  1358. end;
  1359. if ref.offset<>0 then
  1360. begin
  1361. hreg2:=getintregister(list,ptruinttype);
  1362. a_op_const_reg_reg(list,OP_ADD,ptruinttype,ref.offset,hreg1,hreg2);
  1363. hreg1:=hreg2;
  1364. end;
  1365. hreg2:=getaddressregister(list,getpointerdef(def));
  1366. a_load_reg_reg(list,ptruinttype,getpointerdef(def),hreg1,hreg2);
  1367. reference_reset_base(result,getpointerdef(def),hreg2,0,ref.alignment);
  1368. end;
  1369. procedure thlcgllvm.set_call_function_result(const list: TAsmList; const pd: tabstractprocdef; const llvmretdef, hlretdef: tdef; const resval: tregister; var retpara: tcgpara);
  1370. var
  1371. rettemp: treference;
  1372. begin
  1373. if not is_void(hlretdef) and
  1374. not paramanager.ret_in_param(hlretdef, pd) then
  1375. begin
  1376. { should already be a copy, because it currently describes the llvm
  1377. return location }
  1378. if not retpara.temporary then
  1379. internalerror(2014020101);
  1380. if llvmaggregatetype(hlretdef) then
  1381. begin
  1382. { to ease the handling of aggregate types here, we just store
  1383. everything to memory rather than potentially dealing with aggregates
  1384. in "registers" }
  1385. tg.gethltemp(list, hlretdef, hlretdef.size, tt_normal, rettemp);
  1386. a_load_reg_ref(list, llvmretdef, hlretdef, resval, rettemp);
  1387. { the return parameter now contains a value whose type matches the one
  1388. that the high level code generator expects instead of the llvm shim
  1389. }
  1390. retpara.def:=hlretdef;
  1391. retpara.location^.def:=hlretdef;
  1392. { for llvm-specific code: }
  1393. retpara.location^.llvmvalueloc:=false;
  1394. retpara.location^.llvmloc.loc:=LOC_REGISTER;
  1395. retpara.location^.llvmloc.reg:=rettemp.base;
  1396. { for the rest (normally not used, but cleaner to set it correclty) }
  1397. retpara.location^.loc:=LOC_REFERENCE;
  1398. retpara.location^.reference.index:=rettemp.base;
  1399. retpara.location^.reference.offset:=0;
  1400. end
  1401. else
  1402. begin
  1403. retpara.Location^.llvmloc.loc:=retpara.location^.loc;
  1404. retpara.location^.llvmloc.reg:=resval;
  1405. retpara.Location^.llvmvalueloc:=true;
  1406. end;
  1407. end
  1408. else
  1409. retpara.location^.llvmloc.loc:=LOC_VOID;
  1410. end;
  1411. procedure thlcgllvm.paraloctoloc(const paraloc: pcgparalocation; out hloc: tlocation);
  1412. begin
  1413. case paraloc^.llvmloc.loc of
  1414. LOC_REFERENCE:
  1415. begin
  1416. location_reset_ref(hloc,LOC_REFERENCE,def_cgsize(paraloc^.def),paraloc^.def.alignment);
  1417. hloc.reference.symbol:=paraloc^.llvmloc.sym;
  1418. if paraloc^.llvmvalueloc then
  1419. hloc.reference.refaddr:=addr_full;
  1420. end;
  1421. LOC_REGISTER:
  1422. begin
  1423. if paraloc^.llvmvalueloc then
  1424. begin
  1425. location_reset(hloc,LOC_REGISTER,def_cgsize(paraloc^.def));
  1426. hloc.register:=paraloc^.llvmloc.reg;
  1427. end
  1428. else
  1429. begin
  1430. if getregtype(paraloc^.llvmloc.reg)<>R_TEMPREGISTER then
  1431. internalerror(2014011903);
  1432. location_reset_ref(hloc,LOC_REFERENCE,def_cgsize(paraloc^.def),paraloc^.def.alignment);
  1433. hloc.reference.base:=paraloc^.llvmloc.reg;
  1434. end;
  1435. end;
  1436. LOC_FPUREGISTER,
  1437. LOC_MMREGISTER:
  1438. begin
  1439. if paraloc^.llvmvalueloc then
  1440. begin
  1441. location_reset(hloc,paraloc^.llvmloc.loc,def_cgsize(paraloc^.def));
  1442. hloc.register:=paraloc^.llvmloc.reg;
  1443. end
  1444. else
  1445. internalerror(2014012401);
  1446. end
  1447. else
  1448. internalerror(2014010706);
  1449. end;
  1450. end;
  1451. procedure thlcgllvm.varsym_set_localloc(list: TAsmList; vs: tabstractnormalvarsym);
  1452. begin
  1453. if cs_asm_source in current_settings.globalswitches then
  1454. begin
  1455. case vs.initialloc.loc of
  1456. LOC_REFERENCE :
  1457. begin
  1458. if assigned(vs.initialloc.reference.symbol) then
  1459. list.concat(Tai_comment.Create(strpnew('Var '+vs.realname+' located at '+
  1460. vs.initialloc.reference.symbol.name)))
  1461. else
  1462. list.concat(Tai_comment.Create(strpnew('Var '+vs.realname+' located at %tmp.'+
  1463. tostr(getsupreg(vs.initialloc.reference.base)))));
  1464. end;
  1465. end;
  1466. end;
  1467. vs.localloc:=vs.initialloc;
  1468. FillChar(vs.currentregloc,sizeof(vs.currentregloc),0);
  1469. end;
  1470. procedure thlcgllvm.paravarsym_set_initialloc_to_paraloc(vs: tparavarsym);
  1471. var
  1472. parasym : tasmsymbol;
  1473. begin
  1474. if vs.paraloc[calleeside].location^.llvmloc.loc<>LOC_REFERENCE then
  1475. internalerror(2014010708);
  1476. parasym:=vs.paraloc[calleeside].location^.llvmloc.sym;
  1477. reference_reset_symbol(vs.initialloc.reference,parasym,0,vs.paraloc[calleeside].alignment);
  1478. if vs.paraloc[calleeside].location^.llvmvalueloc then
  1479. vs.initialloc.reference.refaddr:=addr_full;
  1480. end;
  1481. procedure create_hlcodegen;
  1482. begin
  1483. hlcg:=thlcgllvm.create;
  1484. cgllvm.create_codegen
  1485. end;
  1486. begin
  1487. chlcgobj:=thlcgllvm;
  1488. end.