hlcgllvm.pas 77 KB

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