hlcgllvm.pas 85 KB

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