hlcgllvm.pas 92 KB

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