hlcgllvm.pas 81 KB

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