hlcgllvm.pas 58 KB

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