hlcgllvm.pas 58 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502
  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. fallthroughlab, 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. fallthroughlab:=falselab;
  711. if invert then
  712. begin
  713. tmplab:=l;
  714. l:=falselab;
  715. falselab:=tmplab;
  716. end;
  717. list.concat(taillvm.op_size_reg_lab_lab(la_br,pasbool8type,reg,l,falselab));
  718. a_label(list,fallthroughlab);
  719. exit;
  720. end;
  721. tmpreg:=getregisterfordef(list,size);
  722. a_load_const_reg(list,size,a,tmpreg);
  723. a_cmp_reg_reg_label(list,size,cmp_op,tmpreg,reg,l);
  724. end;
  725. procedure thlcgllvm.a_cmp_reg_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel);
  726. var
  727. resreg: tregister;
  728. falselab: tasmlabel;
  729. begin
  730. if getregtype(reg1)<>getregtype(reg2) then
  731. internalerror(2012111105);
  732. resreg:=getintregister(list,pasbool8type);
  733. current_asmdata.getjumplabel(falselab);
  734. { invert order of registers. In FPC, cmp_reg_reg(reg1,reg2) means that
  735. e.g. OC_GT is true if "subl %reg1,%reg2" in x86 AT&T is >0. In LLVM,
  736. OC_GT is true if op1>op2 }
  737. list.concat(taillvm.op_reg_cond_size_reg_reg(la_icmp,resreg,cmp_op,size,reg2,reg1));
  738. list.concat(taillvm.op_size_reg_lab_lab(la_br,pasbool8type,resreg,l,falselab));
  739. a_label(list,falselab);
  740. end;
  741. procedure thlcgllvm.a_jmp_always(list: TAsmList; l: tasmlabel);
  742. begin
  743. { implement in tcg because required by the overridden a_label; doesn't use
  744. any high level stuff anyway }
  745. cg.a_jmp_always(list,l);
  746. end;
  747. procedure thlcgllvm.g_concatcopy(list: TAsmList; size: tdef; const source, dest: treference);
  748. begin
  749. a_load_ref_ref(list,size,size,source,dest);
  750. end;
  751. procedure thlcgllvm.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister);
  752. var
  753. tmpreg: tregister;
  754. href: treference;
  755. fromcompcurr,
  756. tocompcurr: boolean;
  757. begin
  758. { comp and currency are handled by the x87 in this case. They cannot
  759. be represented directly in llvm, and llvmdef translates them into i64
  760. (since that's their storage size and internally they also are int64).
  761. Solve this by changing the type to s80real once they are loaded into
  762. a register. }
  763. fromcompcurr:=tfloatdef(fromsize).floattype in [s64comp,s64currency];
  764. tocompcurr:=tfloatdef(tosize).floattype in [s64comp,s64currency];
  765. if tocompcurr then
  766. tosize:=s80floattype;
  767. href:=make_simple_ref(list,ref,fromsize);
  768. { don't generate different code for loading e.g. extended into cextended,
  769. but to take care of loading e.g. comp (=int64) into double }
  770. if (fromsize.size<>tosize.size) then
  771. tmpreg:=getfpuregister(list,fromsize)
  772. else
  773. tmpreg:=reg;
  774. { %tmpreg = load size* %ref }
  775. list.concat(taillvm.op_reg_size_ref(la_load,tmpreg,getpointerdef(fromsize),href));
  776. if tmpreg<>reg then
  777. if fromcompcurr then
  778. { treat as extended as long as it's in a register }
  779. list.concat(taillvm.op_reg_size_reg_size(la_sitofp,reg,fromsize,tmpreg,tosize))
  780. else
  781. a_loadfpu_reg_reg(list,fromsize,tosize,tmpreg,reg);
  782. end;
  783. procedure thlcgllvm.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference);
  784. var
  785. tmpreg: tregister;
  786. href: treference;
  787. fromcompcurr,
  788. tocompcurr: boolean;
  789. begin
  790. { see comment in a_loadfpu_ref_reg }
  791. fromcompcurr:=tfloatdef(fromsize).floattype in [s64comp,s64currency];
  792. tocompcurr:=tfloatdef(tosize).floattype in [s64comp,s64currency];
  793. if fromcompcurr then
  794. fromsize:=s80floattype;
  795. href:=make_simple_ref(list,ref,tosize);
  796. { don't generate different code for loading e.g. extended into cextended,
  797. but to take care of storing e.g. comp (=int64) into double }
  798. if (fromsize.size<>tosize.size) then
  799. begin
  800. tmpreg:=getfpuregister(list,tosize);
  801. if tocompcurr then
  802. { store back an int64 rather than an extended }
  803. list.concat(taillvm.op_reg_size_reg_size(la_fptosi,tmpreg,fromsize,reg,tosize))
  804. else
  805. a_loadfpu_reg_reg(list,fromsize,tosize,reg,tmpreg);
  806. end
  807. else
  808. tmpreg:=reg;
  809. { store tosize tmpreg, tosize* href }
  810. list.concat(taillvm.op_size_reg_size_ref(la_store,tosize,tmpreg,getpointerdef(tosize),href));
  811. end;
  812. procedure thlcgllvm.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister);
  813. var
  814. op: tllvmop;
  815. intfromsize,
  816. inttosize: longint;
  817. begin
  818. { treat comp and currency as extended in registers (see comment at start
  819. of a_loadfpu_ref_reg) }
  820. if tfloatdef(fromsize).floattype in [s64comp,s64currency] then
  821. fromsize:=sc80floattype;
  822. if tfloatdef(tosize).floattype in [s64comp,s64currency] then
  823. tosize:=sc80floattype;
  824. { at the value level, s80real and sc80real are the same }
  825. if fromsize<>s80floattype then
  826. intfromsize:=fromsize.size
  827. else
  828. intfromsize:=sc80floattype.size;
  829. if tosize<>s80floattype then
  830. inttosize:=tosize.size
  831. else
  832. inttosize:=sc80floattype.size;
  833. if intfromsize<inttosize then
  834. op:=la_fpext
  835. else if intfromsize>inttosize then
  836. op:=la_fptrunc
  837. else
  838. op:=la_bitcast;
  839. { reg2 = bitcast fromllsize reg1 to tollsize }
  840. list.concat(taillvm.op_reg_size_reg_size(op,reg2,fromsize,reg1,tosize));
  841. end;
  842. procedure thlcgllvm.gen_proc_symbol(list: TAsmList);
  843. var
  844. item: TCmdStrListItem;
  845. mangledname: TSymStr;
  846. asmsym: tasmsymbol;
  847. begin
  848. item:=TCmdStrListItem(current_procinfo.procdef.aliasnames.first);
  849. mangledname:=current_procinfo.procdef.mangledname;
  850. { predefine the real function name as local/global, so the aliases can
  851. refer to the symbol and get the binding correct }
  852. if (cs_profile in current_settings.moduleswitches) or
  853. (po_global in current_procinfo.procdef.procoptions) then
  854. asmsym:=current_asmdata.DefineAsmSymbol(mangledname,AB_GLOBAL,AT_FUNCTION)
  855. else
  856. asmsym:=current_asmdata.DefineAsmSymbol(mangledname,AB_LOCAL,AT_FUNCTION);
  857. while assigned(item) do
  858. begin
  859. if mangledname<>item.Str then
  860. list.concat(taillvmalias.create(asmsym,item.str,current_procinfo.procdef,llv_default,lll_default));
  861. item:=TCmdStrListItem(item.next);
  862. end;
  863. list.concat(taillvmdecl.create(asmsym,current_procinfo.procdef,nil,sec_code));
  864. end;
  865. procedure thlcgllvm.gen_proc_symbol_end(list: TAsmList);
  866. begin
  867. list.concat(Tai_symbol_end.Createname(current_procinfo.procdef.mangledname));
  868. { todo: darwin main proc, or handle in other way? }
  869. end;
  870. procedure thlcgllvm.g_proc_entry(list: TAsmList; localsize: longint; nostackframe: boolean);
  871. begin
  872. list.concatlist(ttgllvm(tg).alloclist)
  873. { rest: todo }
  874. end;
  875. procedure thlcgllvm.g_proc_exit(list: TAsmList; parasize: longint; nostackframe: boolean);
  876. var
  877. retdef: tdef;
  878. retreg,
  879. hreg: tregister;
  880. retpara: tcgpara;
  881. begin
  882. { the function result type is the type of the first location, which can
  883. differ from the real result type (e.g. int64 for a record consisting of
  884. two longint fields on x86-64 -- we are responsible for lowering the
  885. result types like that) }
  886. retpara:=get_call_result_cgpara(current_procinfo.procdef,nil);
  887. retpara.check_simple_location;
  888. retdef:=retpara.location^.def;
  889. if is_void(retdef) or
  890. { don't check retdef here, it is e.g. a pshortstring in case it's
  891. shortstring that's returned in a parameter }
  892. paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then
  893. list.concat(taillvm.op_size(la_ret,voidtype))
  894. else
  895. begin
  896. case retpara.location^.loc of
  897. LOC_REGISTER,
  898. LOC_FPUREGISTER,
  899. LOC_MMREGISTER:
  900. begin
  901. { sign/zeroextension of function results is handled implicitly
  902. via the signext/zeroext modifiers of the result, rather than
  903. in the code generator -> remove any explicit extensions here }
  904. retreg:=retpara.location^.register;
  905. if (current_procinfo.procdef.returndef.typ in [orddef,enumdef]) and
  906. (retdef.typ in [orddef,enumdef]) then
  907. begin
  908. if (current_procinfo.procdef.returndef.size<retpara.location^.def.size) then
  909. begin
  910. hreg:=getintregister(list,current_procinfo.procdef.returndef);
  911. a_load_reg_reg(list,retdef,current_procinfo.procdef.returndef,retreg,hreg);
  912. retreg:=hreg;
  913. retdef:=current_procinfo.procdef.returndef;
  914. end;
  915. end;
  916. list.concat(taillvm.op_size_reg(la_ret,retdef,retreg))
  917. end
  918. else
  919. { todo: complex returns }
  920. internalerror(2012111106);
  921. end;
  922. end;
  923. retpara.resetiftemp;
  924. end;
  925. procedure thlcgllvm.g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef);
  926. begin
  927. { not possible, need ovloc }
  928. internalerror(2012111107);
  929. end;
  930. procedure thlcgllvm.g_overflowCheck_loc(List: TAsmList; const Loc: TLocation; def: TDef; var ovloc: tlocation);
  931. begin
  932. { todo }
  933. internalerror(2012111108);
  934. end;
  935. procedure thlcgllvm.a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle);
  936. var
  937. href: treference;
  938. begin
  939. if shuffle=mms_movescalar then
  940. a_loadfpu_ref_reg(list,fromsize,tosize,ref,reg)
  941. else
  942. begin
  943. { todo }
  944. if fromsize<>tosize then
  945. internalerror(2013060220);
  946. href:=make_simple_ref(list,ref,fromsize);
  947. { %reg = load size* %ref }
  948. list.concat(taillvm.op_reg_size_ref(la_load,reg,getpointerdef(fromsize),href));
  949. end;
  950. end;
  951. procedure thlcgllvm.a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle);
  952. var
  953. href: treference;
  954. begin
  955. if shuffle=mms_movescalar then
  956. a_loadfpu_reg_ref(list,fromsize,tosize,reg,ref)
  957. else
  958. begin
  959. { todo }
  960. if fromsize<>tosize then
  961. internalerror(2013060220);
  962. href:=make_simple_ref(list,ref,tosize);
  963. { store tosize reg, tosize* href }
  964. list.concat(taillvm.op_size_reg_size_ref(la_store,tosize,reg,getpointerdef(tosize),href))
  965. end;
  966. end;
  967. procedure thlcgllvm.a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister; shuffle: pmmshuffle);
  968. begin
  969. if shuffle=mms_movescalar then
  970. a_loadfpu_reg_reg(list,fromsize,tosize,reg1,reg2)
  971. else
  972. { reg2 = bitcast fromllsize reg1 to tollsize }
  973. list.concat(taillvm.op_reg_size_reg_size(la_bitcast,reg2,fromsize,reg1,tosize));
  974. end;
  975. procedure thlcgllvm.a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; src, dst: tregister; shuffle: pmmshuffle);
  976. begin
  977. if (op=OP_XOR) and
  978. (src=dst) then
  979. a_load_const_reg(list,size,0,dst)
  980. else
  981. { todo }
  982. internalerror(2013060221);
  983. end;
  984. procedure thlcgllvm.a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize: tdef; intreg, mmreg: tregister; shuffle: pmmshuffle);
  985. begin
  986. internalerror(2013060222);
  987. end;
  988. procedure thlcgllvm.a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize: tdef; mmreg, intreg: tregister; shuffle: pmmshuffle);
  989. begin
  990. internalerror(2013060223);
  991. end;
  992. function thlcgllvm.get_call_result_cgpara(pd: tabstractprocdef; forceresdef: tdef): tcgpara;
  993. var
  994. paraloc: pcgparalocation;
  995. begin
  996. result:=inherited;
  997. { we'll change the paraloc, make sure we don't modify the original one }
  998. if not result.temporary then
  999. begin
  1000. result:=result.getcopy;
  1001. result.temporary:=true;
  1002. end;
  1003. { get the LLVM representation of the function result (e.g. a
  1004. struct with two i64 fields for a record with 4 i32 fields) }
  1005. result.def:=llvmgetcgparadef(result,false);
  1006. if assigned(result.location^.next) then
  1007. begin
  1008. { unify the result into a sinlge location; unlike for parameters,
  1009. we are not responsible for splitting up results into multiple
  1010. locations }
  1011. { set the first location to the type of the function result }
  1012. result.location^.def:=result.def;
  1013. result.location^.size:=result.size;
  1014. { free all extra paralocs }
  1015. while assigned(result.location^.next) do
  1016. begin
  1017. paraloc:=result.location^.next^.next;
  1018. freemem(result.location^.next);
  1019. result.location^.next:=paraloc;
  1020. end;
  1021. end;
  1022. paraloc:=result.location;
  1023. paraloc^.def:=result.def;
  1024. case paraloc^.loc of
  1025. LOC_VOID:
  1026. ;
  1027. LOC_REGISTER,
  1028. LOC_FPUREGISTER,
  1029. LOC_MMREGISTER:
  1030. begin
  1031. paraloc^.llvmloc.loc:=paraloc^.loc;
  1032. paraloc^.llvmloc.reg:=paraloc^.register;
  1033. paraloc^.llvmvalueloc:=true;
  1034. end;
  1035. LOC_REFERENCE:
  1036. if not paramanager.ret_in_param(pd.returndef,pd) then
  1037. { TODO, if this can happen at all }
  1038. internalerror(2014011901);
  1039. else
  1040. internalerror(2014011902);
  1041. end;
  1042. end;
  1043. procedure thlcgllvm.gen_load_loc_function_result(list: TAsmList; vardef: tdef; const l: tlocation);
  1044. begin
  1045. gen_load_loc_cgpara(list,vardef,l,get_call_result_cgpara(current_procinfo.procdef,nil));
  1046. end;
  1047. procedure thlcgllvm.gen_load_loc_cgpara(list: TAsmList; vardef: tdef; const l: tlocation; const cgpara: tcgpara);
  1048. var
  1049. memloc: tlocation;
  1050. begin
  1051. if not(cgpara.location^.llvmvalueloc) then
  1052. begin
  1053. memloc:=l;
  1054. location_force_mem(list,memloc,vardef);
  1055. a_loadaddr_ref_cgpara(list,vardef,memloc.reference,cgpara);
  1056. end
  1057. else
  1058. inherited;
  1059. end;
  1060. procedure thlcgllvm.gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean);
  1061. var
  1062. ploc : pcgparalocation;
  1063. hloc : tlocation;
  1064. href, href2 : treference;
  1065. hreg : tregister;
  1066. llvmparadef : tdef;
  1067. index : longint;
  1068. offset : pint;
  1069. userecord : boolean;
  1070. begin
  1071. { ignore e.g. empty records }
  1072. if (para.location^.loc=LOC_VOID) then
  1073. exit;
  1074. { If the parameter location is reused we don't need to copy
  1075. anything }
  1076. if reusepara then
  1077. exit;
  1078. { get the equivalent llvm def used to pass the parameter (e.g. a record
  1079. with two int64 fields for passing a record consisiting of 8 bytes on
  1080. x86-64) }
  1081. llvmparadef:=llvmgetcgparadef(para,true);
  1082. userecord:=
  1083. (llvmparadef<>para.def) and
  1084. assigned(para.location^.next);
  1085. if userecord then
  1086. begin
  1087. { llvmparadef is a record in this case, with every field corresponding
  1088. to a single paraloc }
  1089. if destloc.loc<>LOC_REFERENCE then
  1090. tg.gethltemp(list,llvmparadef,llvmparadef.size,tt_normal,href)
  1091. else
  1092. begin
  1093. hreg:=getaddressregister(list,getpointerdef(llvmparadef));
  1094. a_loadaddr_ref_reg(list,vardef,getpointerdef(llvmparadef),destloc.reference,hreg);
  1095. reference_reset_base(href,getpointerdef(llvmparadef),hreg,0,destloc.reference.alignment);
  1096. end;
  1097. index:=0;
  1098. offset:=0;
  1099. ploc:=para.location;
  1100. repeat
  1101. paraloctoloc(ploc,hloc);
  1102. hreg:=getaddressregister(list,getpointerdef(ploc^.def));
  1103. list.concat(taillvm.getelementptr_reg_size_ref_size_const(hreg,getpointerdef(llvmparadef),href,s32inttype,index,true));
  1104. reference_reset_base(href2,getpointerdef(ploc^.def),hreg,0,newalignment(href.alignment,offset));
  1105. a_load_loc_ref(list,ploc^.def,ploc^.def,hloc,href2);
  1106. inc(offset,ploc^.def.size);
  1107. inc(index);
  1108. ploc:=ploc^.next;
  1109. until not assigned(ploc);
  1110. if destloc.loc<>LOC_REFERENCE then
  1111. tg.ungettemp(list,href);
  1112. end
  1113. else
  1114. begin
  1115. para.check_simple_location;
  1116. paraloctoloc(para.location,hloc);
  1117. case destloc.loc of
  1118. LOC_REFERENCE :
  1119. begin
  1120. a_load_loc_ref(list,llvmparadef,para.def,hloc,destloc.reference);
  1121. end;
  1122. LOC_REGISTER:
  1123. begin
  1124. a_load_loc_reg(list,llvmparadef,para.def,hloc,destloc.register);
  1125. end;
  1126. LOC_FPUREGISTER:
  1127. begin
  1128. a_loadfpu_loc_reg(list,llvmparadef,para.def,hloc,destloc.register);
  1129. end;
  1130. LOC_MMREGISTER:
  1131. begin
  1132. a_loadmm_loc_reg(list,llvmparadef,para.def,hloc,destloc.register,nil);
  1133. end;
  1134. { TODO other possible locations }
  1135. else
  1136. internalerror(2013102304);
  1137. end;
  1138. end;
  1139. end;
  1140. procedure thlcgllvm.a_jmp_flags(list: TAsmList; const f: TResFlags; l: tasmlabel);
  1141. begin
  1142. internalerror(2013060224);
  1143. end;
  1144. procedure thlcgllvm.g_flags2reg(list: TAsmList; size: tdef; const f: tresflags; reg: TRegister);
  1145. begin
  1146. internalerror(2013060225);
  1147. end;
  1148. procedure thlcgllvm.g_flags2ref(list: TAsmList; size: tdef; const f: tresflags; const ref: TReference);
  1149. begin
  1150. internalerror(2013060226);
  1151. end;
  1152. procedure thlcgllvm.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: tdef; src, dst: tregister);
  1153. begin
  1154. internalerror(2012090201);
  1155. end;
  1156. procedure thlcgllvm.g_stackpointer_alloc(list: TAsmList; size: longint);
  1157. begin
  1158. internalerror(2012090203);
  1159. end;
  1160. procedure thlcgllvm.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
  1161. begin
  1162. internalerror(2012090204);
  1163. end;
  1164. procedure thlcgllvm.g_adjust_self_value(list: TAsmList; procdef: tprocdef; ioffset: aint);
  1165. begin
  1166. internalerror(2012090205);
  1167. end;
  1168. procedure thlcgllvm.g_local_unwind(list: TAsmList; l: TAsmLabel);
  1169. begin
  1170. internalerror(2012090206);
  1171. end;
  1172. function thlcgllvm.make_simple_ref(list: TAsmList; const ref: treference; def: tdef): treference;
  1173. var
  1174. ptrindex: tcgint;
  1175. hreg1,
  1176. hreg2: tregister;
  1177. tmpref: treference;
  1178. begin
  1179. { already simple? }
  1180. if (not assigned(ref.symbol) or
  1181. (ref.base=NR_NO)) and
  1182. (ref.index=NR_NO) and
  1183. (ref.offset=0) then
  1184. begin
  1185. result:=ref;
  1186. exit;
  1187. end;
  1188. hreg2:=getaddressregister(list,getpointerdef(def));
  1189. { symbol+offset or base+offset with offset a multiple of the size ->
  1190. use getelementptr }
  1191. if (ref.index=NR_NO) and
  1192. (ref.offset mod def.size=0) then
  1193. begin
  1194. ptrindex:=ref.offset div def.size;
  1195. if assigned(ref.symbol) then
  1196. reference_reset_symbol(tmpref,ref.symbol,0,ref.alignment)
  1197. else
  1198. reference_reset_base(tmpref,getpointerdef(def),ref.base,0,ref.alignment);
  1199. list.concat(taillvm.getelementptr_reg_size_ref_size_const(hreg2,getpointerdef(def),tmpref,ptruinttype,ptrindex,assigned(ref.symbol)));
  1200. reference_reset_base(result,getpointerdef(def),hreg2,0,ref.alignment);
  1201. exit;
  1202. end;
  1203. { for now, perform all calculations using plain pointer arithmetic. Later
  1204. we can look into optimizations based on getelementptr for structured
  1205. accesses (if only to prevent running out of virtual registers).
  1206. Assumptions:
  1207. * symbol/base register: always type "def*"
  1208. * index/offset: always type "ptruinttype" (llvm bitcode has no sign information, so sign doesn't matter) }
  1209. hreg1:=getintregister(list,ptruinttype);
  1210. if assigned(ref.symbol) then
  1211. begin
  1212. if ref.base<>NR_NO then
  1213. internalerror(2012111301);
  1214. reference_reset_symbol(tmpref,ref.symbol,0,ref.alignment);
  1215. list.concat(taillvm.getelementptr_reg_size_ref_size_const(hreg1,getpointerdef(def),tmpref,ptruinttype,0,true));
  1216. end
  1217. else if ref.base<>NR_NO then
  1218. begin
  1219. a_load_reg_reg(list,getpointerdef(def),ptruinttype,ref.base,hreg1);
  1220. end
  1221. else
  1222. { todo: support for absolute addresses on embedded platforms }
  1223. internalerror(2012111302);
  1224. if ref.index<>NR_NO then
  1225. begin
  1226. { SSA... }
  1227. hreg2:=getintregister(list,ptruinttype);
  1228. a_op_reg_reg_reg(list,OP_ADD,ptruinttype,ref.index,hreg1,hreg2);
  1229. hreg1:=hreg2;
  1230. end;
  1231. if ref.offset<>0 then
  1232. begin
  1233. hreg2:=getintregister(list,ptruinttype);
  1234. a_op_const_reg_reg(list,OP_ADD,ptruinttype,ref.offset,hreg1,hreg2);
  1235. hreg1:=hreg2;
  1236. end;
  1237. a_load_reg_reg(list,ptruinttype,getpointerdef(def),hreg1,hreg2);
  1238. reference_reset_base(result,getpointerdef(def),hreg2,0,ref.alignment);
  1239. end;
  1240. procedure thlcgllvm.set_call_function_result(const list: TAsmList; const pd: tabstractprocdef; const llvmretdef, hlretdef: tdef; const resval: tregister; var retpara: tcgpara);
  1241. var
  1242. rettemp: treference;
  1243. begin
  1244. if not is_void(hlretdef) and
  1245. not paramanager.ret_in_param(hlretdef, pd) then
  1246. begin
  1247. { should already be a copy, because it currently describes the llvm
  1248. return location }
  1249. if not retpara.temporary then
  1250. internalerror(2014020101);
  1251. { to ease the handling of aggregate types here, we just store
  1252. everything to memory rather than potentially dealing with aggregates
  1253. in "registers" }
  1254. tg.gethltemp(list, hlretdef, hlretdef.size, tt_normal, rettemp);
  1255. a_load_reg_ref(list, llvmretdef, hlretdef, resval, rettemp);
  1256. { the return parameter now contains a value whose type matches the one
  1257. that the high level code generator expects instead of the llvm shim
  1258. }
  1259. retpara.def:=hlretdef;
  1260. retpara.location^.def:=hlretdef;
  1261. { for llvm-specific code: }
  1262. retpara.location^.llvmvalueloc:=false;
  1263. retpara.location^.llvmloc.loc:=LOC_REGISTER;
  1264. retpara.location^.llvmloc.reg:=rettemp.base;
  1265. { for the rest (normally not used, but cleaner to set it correclty) }
  1266. retpara.location^.loc:=LOC_REFERENCE;
  1267. retpara.location^.reference.index:=rettemp.base;
  1268. retpara.location^.reference.offset:=0;
  1269. end
  1270. else
  1271. retpara.location^.llvmloc.loc:=LOC_VOID;
  1272. end;
  1273. procedure thlcgllvm.paraloctoloc(const paraloc: pcgparalocation; out hloc: tlocation);
  1274. begin
  1275. case paraloc^.llvmloc.loc of
  1276. LOC_REFERENCE:
  1277. begin
  1278. location_reset_ref(hloc,LOC_REFERENCE,def_cgsize(paraloc^.def),paraloc^.def.alignment);
  1279. hloc.reference.symbol:=paraloc^.llvmloc.sym;
  1280. if paraloc^.llvmvalueloc then
  1281. hloc.reference.refaddr:=addr_full;
  1282. end;
  1283. LOC_REGISTER:
  1284. begin
  1285. if paraloc^.llvmvalueloc then
  1286. begin
  1287. location_reset(hloc,LOC_REGISTER,def_cgsize(paraloc^.def));
  1288. hloc.register:=paraloc^.llvmloc.reg;
  1289. end
  1290. else
  1291. begin
  1292. if getregtype(paraloc^.llvmloc.reg)<>R_TEMPREGISTER then
  1293. internalerror(2014011903);
  1294. location_reset_ref(hloc,LOC_REFERENCE,def_cgsize(paraloc^.def),paraloc^.def.alignment);
  1295. hloc.reference.base:=paraloc^.llvmloc.reg;
  1296. end;
  1297. end;
  1298. LOC_FPUREGISTER,
  1299. LOC_MMREGISTER:
  1300. begin
  1301. if paraloc^.llvmvalueloc then
  1302. begin
  1303. location_reset(hloc,paraloc^.llvmloc.loc,def_cgsize(paraloc^.def));
  1304. hloc.register:=paraloc^.llvmloc.reg;
  1305. end
  1306. else
  1307. internalerror(2014012401);
  1308. end
  1309. else
  1310. internalerror(2014010706);
  1311. end;
  1312. end;
  1313. procedure thlcgllvm.varsym_set_localloc(list: TAsmList; vs: tabstractnormalvarsym);
  1314. begin
  1315. if cs_asm_source in current_settings.globalswitches then
  1316. begin
  1317. case vs.initialloc.loc of
  1318. LOC_REFERENCE :
  1319. begin
  1320. if assigned(vs.initialloc.reference.symbol) then
  1321. list.concat(Tai_comment.Create(strpnew('Var '+vs.realname+' located at '+
  1322. vs.initialloc.reference.symbol.name)))
  1323. else
  1324. list.concat(Tai_comment.Create(strpnew('Var '+vs.realname+' located at %tmp.'+
  1325. tostr(getsupreg(vs.initialloc.reference.base)))));
  1326. end;
  1327. end;
  1328. end;
  1329. vs.localloc:=vs.initialloc;
  1330. FillChar(vs.currentregloc,sizeof(vs.currentregloc),0);
  1331. end;
  1332. procedure thlcgllvm.paravarsym_set_initialloc_to_paraloc(vs: tparavarsym);
  1333. var
  1334. parasym : tasmsymbol;
  1335. begin
  1336. if vs.paraloc[calleeside].location^.llvmloc.loc<>LOC_REFERENCE then
  1337. internalerror(2014010708);
  1338. parasym:=vs.paraloc[calleeside].location^.llvmloc.sym;
  1339. reference_reset_symbol(vs.initialloc.reference,parasym,0,vs.paraloc[calleeside].alignment);
  1340. if vs.paraloc[calleeside].location^.llvmvalueloc then
  1341. vs.initialloc.reference.refaddr:=addr_full;
  1342. end;
  1343. procedure create_hlcodegen;
  1344. begin
  1345. hlcg:=thlcgllvm.create;
  1346. cgllvm.create_codegen
  1347. end;
  1348. begin
  1349. chlcgobj:=thlcgllvm;
  1350. end.