hlcgllvm.pas 30 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816
  1. {
  2. Copyright (c) 2010, 2013 by Jonas Maebe
  3. Member of the Free Pascal development team
  4. This unit implements the LLVM high level code generator
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit hlcgllvm;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. globtype,
  23. aasmbase,aasmdata,
  24. symbase,symconst,symtype,symdef,symsym,
  25. cpubase, hlcgobj, cgbase, cgutils, parabase;
  26. type
  27. { thlcgllvm }
  28. thlcgllvm = class(thlcgobj)
  29. constructor create;
  30. function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef; weak: boolean): tcgpara;override;
  31. procedure a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister); override;
  32. procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : tcgint;register : tregister);override;
  33. procedure a_load_const_ref(list: TAsmList; tosize: tdef; a: tcgint; const ref: treference);override;
  34. procedure a_load_reg_ref(list : TAsmList;fromsize, tosize : tdef;register : tregister;const ref : treference);override;
  35. procedure a_load_reg_reg(list : TAsmList;fromsize, tosize : tdef;reg1,reg2 : tregister);override;
  36. procedure a_load_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;register : tregister);override;
  37. procedure a_loadaddr_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;r : tregister);override;
  38. procedure a_op_const_reg(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; reg: TRegister); override;
  39. procedure a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister); override;
  40. procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister); override;
  41. procedure a_op_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; reg1, reg2: TRegister); override;
  42. procedure a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister;setflags : boolean;var ovloc : tlocation); override;
  43. procedure a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation); override;
  44. procedure a_cmp_const_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel); override;
  45. procedure a_cmp_reg_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel); override;
  46. procedure a_jmp_always(list : TAsmList;l: tasmlabel); override;
  47. procedure g_concatcopy(list : TAsmList;size: tdef; const source,dest : treference);override;
  48. procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister); override;
  49. procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference); override;
  50. procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister); override;
  51. procedure gen_proc_symbol(list: TAsmList); override;
  52. procedure gen_proc_symbol_end(list: TAsmList); override;
  53. procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); override;
  54. procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean); override;
  55. procedure g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef); override;
  56. procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;var ovloc : tlocation); override;
  57. procedure a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle); override;
  58. procedure a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle); override;
  59. procedure a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister; shuffle: pmmshuffle); override;
  60. procedure a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; src, dst: tregister; shuffle: pmmshuffle); override;
  61. procedure a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize: tdef; intreg, mmreg: tregister; shuffle: pmmshuffle); override;
  62. procedure a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize: tdef; mmreg, intreg: tregister; shuffle: pmmshuffle); override;
  63. procedure gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean); override;
  64. {$ifdef cpuflags}
  65. { llvm doesn't have flags, but cpuflags is defined in case the real cpu
  66. has flags and we have to override the abstract methods to prevent
  67. warnings }
  68. procedure a_jmp_flags(list: TAsmList; const f: TResFlags; l: tasmlabel); override;
  69. procedure g_flags2reg(list: TAsmList; size: tdef; const f: tresflags; reg: TRegister); override;
  70. procedure g_flags2ref(list: TAsmList; size: tdef; const f: tresflags; const ref: TReference); override;
  71. {$endif cpuflags}
  72. { unimplemented or unnecessary routines }
  73. procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: tdef; src, dst: tregister); override;
  74. procedure g_stackpointer_alloc(list: TAsmList; size: longint); override;
  75. procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint); override;
  76. procedure g_adjust_self_value(list: TAsmList; procdef: tprocdef; ioffset: aint); override;
  77. procedure g_local_unwind(list: TAsmList; l: TAsmLabel); override;
  78. protected
  79. { def is the type of the data stored in memory pointed to by ref, not
  80. a pointer to this type }
  81. function make_simple_ref(list: TAsmList; const ref: treference; def: tdef): treference;
  82. end;
  83. procedure create_hlcodegen;
  84. implementation
  85. uses
  86. verbose,cutils,cclasses,globals,fmodule,constexp,
  87. defutil,llvmdef,llvmsym,
  88. aasmtai,aasmcpu,
  89. aasmllvm,llvmbase,tgllvm,
  90. symtable,
  91. paramgr,
  92. procinfo,cpuinfo,tgobj,cgobj,cgllvm,cghlcpu;
  93. const
  94. topcg2llvmop: array[topcg] of tllvmop =
  95. { OP_NONE OP_MOVE OP_ADD OP_AND OP_DIV OP_IDIV OP_IMUL OP_MUL }
  96. (la_none, la_none, la_add, la_and, la_udiv, la_sdiv, la_mul, la_mul,
  97. { OP_NEG OP_NOT OP_OR OP_SAR OP_SHL OP_SHR OP_SUB OP_XOR }
  98. la_none, la_none, la_or, la_ashr, la_shl, la_lshr, la_sub, la_xor,
  99. { OP_ROL OP_ROR }
  100. la_none, la_none);
  101. constructor thlcgllvm.create;
  102. begin
  103. inherited
  104. end;
  105. function thlcgllvm.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara;
  106. begin
  107. { todo: we also need the parameter locations here for llvm! }
  108. list.concat(tai_comment.create(strpnew('call '+s)));
  109. result:=get_call_result_cgpara(pd,forceresdef);
  110. end;
  111. procedure thlcgllvm.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister);
  112. begin
  113. internalerror(2012042824);
  114. end;
  115. procedure thlcgllvm.a_load_const_reg(list: TAsmList; tosize: tdef; a: tcgint; register: tregister);
  116. begin
  117. list.concat(taillvm.op_reg_size_const_size(la_bitcast,register,tosize,a,tosize))
  118. end;
  119. procedure thlcgllvm.a_load_const_ref(list: TAsmList; tosize: tdef; a: tcgint; const ref: treference);
  120. var
  121. sref: treference;
  122. begin
  123. sref:=make_simple_ref(list,ref,tosize);
  124. list.concat(taillvm.op_size_const_size_ref(la_store,tosize,a,getpointerdef(tosize),sref))
  125. end;
  126. procedure thlcgllvm.a_load_reg_ref(list: TAsmList; fromsize, tosize: tdef; register: tregister; const ref: treference);
  127. var
  128. sref: treference;
  129. hreg: tregister;
  130. begin
  131. sref:=make_simple_ref(list,ref,tosize);
  132. hreg:=register;
  133. if fromsize.size<>tosize.size then
  134. begin
  135. hreg:=getregisterfordef(list,tosize);
  136. a_load_reg_reg(list,fromsize,tosize,register,hreg);
  137. end;
  138. list.concat(taillvm.op_size_reg_size_ref(la_store,tosize,hreg,getpointerdef(tosize),sref))
  139. end;
  140. procedure thlcgllvm.a_load_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister);
  141. var
  142. fromregtyp,
  143. toregtyp: tregistertype;
  144. op: tllvmop;
  145. begin
  146. fromregtyp:=def2regtyp(fromsize);
  147. toregtyp:=def2regtyp(tosize);
  148. { int to pointer or vice versa }
  149. if (fromregtyp=R_ADDRESSREGISTER) and
  150. (toregtyp=R_INTREGISTER) then
  151. op:=la_ptrtoint
  152. else if (fromregtyp=R_INTREGISTER) and
  153. (toregtyp=R_ADDRESSREGISTER) then
  154. op:=la_inttoptr
  155. { int to int or ptr to ptr: need zero/sign extension, or plain bitcast? }
  156. else if tosize.size<>fromsize.size then
  157. begin
  158. if tosize.size<fromsize.size then
  159. op:=la_trunc
  160. else if is_signed(fromsize) then
  161. { fromsize is signed -> sign extension }
  162. op:=la_sext
  163. else
  164. op:=la_zext;
  165. end
  166. else
  167. op:=la_bitcast;
  168. { reg2 = bitcast fromsize reg1 to tosize }
  169. list.concat(taillvm.op_reg_size_reg_size(op,reg2,fromsize,reg1,tosize));
  170. end;
  171. procedure thlcgllvm.a_load_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; register: tregister);
  172. var
  173. sref: treference;
  174. hreg: tregister;
  175. begin
  176. sref:=make_simple_ref(list,ref,fromsize);
  177. { "named register"? }
  178. if sref.refaddr=addr_full then
  179. list.concat(taillvm.op_reg_size_ref_size(la_bitcast,register,fromsize,sref,tosize))
  180. else
  181. begin
  182. hreg:=register;
  183. if fromsize<>tosize then
  184. hreg:=getregisterfordef(list,fromsize);
  185. list.concat(taillvm.op_reg_size_ref(la_load,hreg,getpointerdef(fromsize),sref));
  186. if hreg<>register then
  187. a_load_reg_reg(list,fromsize,tosize,hreg,register);
  188. end;
  189. end;
  190. procedure thlcgllvm.a_loadaddr_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; r: tregister);
  191. var
  192. sref: treference;
  193. begin
  194. { can't take the address of a 'named register' }
  195. if ref.refaddr=addr_full then
  196. internalerror(2013102306);
  197. sref:=make_simple_ref(list,ref,fromsize);
  198. list.concat(taillvm.op_reg_size_ref_size(la_bitcast,r,fromsize,sref,tosize));
  199. end;
  200. procedure thlcgllvm.a_op_const_reg(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; reg: TRegister);
  201. begin
  202. a_op_const_reg_reg(list,op,size,a,reg,reg);
  203. end;
  204. procedure thlcgllvm.a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister);
  205. var
  206. tmpreg: tregister;
  207. begin
  208. if (def2regtyp(size)=R_INTREGISTER) and
  209. (topcg2llvmop[op]<>la_none) then
  210. list.concat(taillvm.op_reg_size_reg_const(topcg2llvmop[op],dst,size,src,a))
  211. else
  212. begin
  213. { default implementation is not SSA-safe }
  214. tmpreg:=getregisterfordef(list,size);
  215. a_load_const_reg(list,size,a,tmpreg);
  216. a_op_reg_reg_reg(list,op,size,tmpreg,src,dst);
  217. end;
  218. end;
  219. procedure thlcgllvm.a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister);
  220. var
  221. orgdst,
  222. tmpreg1,
  223. tmpreg2,
  224. tmpreg3: tregister;
  225. opsize: tdef;
  226. begin
  227. orgdst:=dst;
  228. opsize:=size;
  229. { always perform using integer registers, because math operations on
  230. pointers are not supported (except via getelementptr, possible future
  231. optimization) }
  232. if def2regtyp(size)=R_ADDRESSREGISTER then
  233. begin
  234. opsize:=ptruinttype;
  235. tmpreg1:=getintregister(list,ptruinttype);
  236. a_load_reg_reg(list,size,ptruinttype,src1,tmpreg1);
  237. src1:=tmpreg1;
  238. tmpreg1:=getintregister(list,ptruinttype);
  239. a_load_reg_reg(list,size,ptruinttype,src2,tmpreg1);
  240. src2:=tmpreg1;
  241. dst:=getintregister(list,ptruinttype);
  242. end;
  243. if topcg2llvmop[op]<>la_none then
  244. list.concat(taillvm.op_reg_size_reg_reg(topcg2llvmop[op],dst,opsize,src2,src1))
  245. else
  246. begin
  247. case op of
  248. OP_NEG:
  249. { %dst = sub size 0, %src1 }
  250. list.concat(taillvm.op_reg_size_const_reg(la_sub,dst,opsize,0,src1));
  251. OP_NOT:
  252. { %dst = xor size -1, %src1 }
  253. list.concat(taillvm.op_reg_size_const_reg(la_xor,dst,opsize,-1,src1));
  254. OP_ROL:
  255. begin
  256. tmpreg1:=getintregister(list,opsize);
  257. tmpreg2:=getintregister(list,opsize);
  258. tmpreg3:=getintregister(list,opsize);
  259. { tmpreg1 := tcgsize2size[size] - src1 }
  260. list.concat(taillvm.op_reg_size_const_reg(la_sub,tmpreg1,opsize,opsize.size,src1));
  261. { tmpreg2 := src2 shr tmpreg1 }
  262. a_op_reg_reg_reg(list,OP_SHR,opsize,tmpreg1,src2,tmpreg2);
  263. { tmpreg3 := src2 shl src1 }
  264. a_op_reg_reg_reg(list,OP_SHL,opsize,src1,src2,tmpreg3);
  265. { dst := tmpreg2 or tmpreg3 }
  266. a_op_reg_reg_reg(list,OP_OR,opsize,tmpreg2,tmpreg3,dst);
  267. end;
  268. OP_ROR:
  269. begin
  270. tmpreg1:=getintregister(list,size);
  271. tmpreg2:=getintregister(list,size);
  272. tmpreg3:=getintregister(list,size);
  273. { tmpreg1 := tcgsize2size[size] - src1 }
  274. list.concat(taillvm.op_reg_size_const_reg(la_sub,tmpreg1,opsize,opsize.size,src1));
  275. { tmpreg2 := src2 shl tmpreg1 }
  276. a_op_reg_reg_reg(list,OP_SHL,opsize,tmpreg1,src2,tmpreg2);
  277. { tmpreg3 := src2 shr src1 }
  278. a_op_reg_reg_reg(list,OP_SHR,opsize,src1,src2,tmpreg3);
  279. { dst := tmpreg2 or tmpreg3 }
  280. a_op_reg_reg_reg(list,OP_OR,opsize,tmpreg2,tmpreg3,dst);
  281. end;
  282. else
  283. internalerror(2010081310);
  284. end;
  285. end;
  286. if dst<>orgdst then
  287. a_load_reg_reg(list,opsize,size,dst,orgdst);
  288. end;
  289. procedure thlcgllvm.a_op_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; reg1, reg2: TRegister);
  290. begin
  291. a_op_reg_reg_reg(list,op,size,reg1,reg2,reg2);
  292. end;
  293. procedure thlcgllvm.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister; setflags: boolean; var ovloc: tlocation);
  294. begin
  295. if not setflags then
  296. begin
  297. inherited;
  298. exit;
  299. end;
  300. { use xxx.with.overflow intrinsics }
  301. internalerror(2012111102);
  302. end;
  303. procedure thlcgllvm.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister; setflags: boolean; var ovloc: tlocation);
  304. begin
  305. if not setflags then
  306. begin
  307. inherited;
  308. exit;
  309. end;
  310. { use xxx.with.overflow intrinsics }
  311. internalerror(2012111103);
  312. end;
  313. procedure thlcgllvm.a_cmp_const_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel);
  314. var
  315. tmpreg : tregister;
  316. invert: boolean;
  317. falselab, tmplab: tasmlabel;
  318. begin
  319. { since all comparisons return their results in a register, we'll often
  320. get comparisons against true/false -> optimise }
  321. if (size=pasbool8type) and
  322. (cmp_op in [OC_EQ,OC_NE]) then
  323. begin
  324. case cmp_op of
  325. OC_EQ:
  326. invert:=a=0;
  327. OC_NE:
  328. invert:=a=1;
  329. end;
  330. current_asmdata.getjumplabel(falselab);
  331. if invert then
  332. begin
  333. tmplab:=l;
  334. l:=falselab;
  335. falselab:=tmplab;
  336. end;
  337. list.concat(taillvm.op_size_reg_lab_lab(la_br,pasbool8type,reg,l,falselab));
  338. a_label(list,falselab);
  339. exit;
  340. end;
  341. tmpreg:=getregisterfordef(list,size);
  342. a_load_const_reg(list,size,a,tmpreg);
  343. a_cmp_reg_reg_label(list,size,cmp_op,tmpreg,reg,l);
  344. end;
  345. procedure thlcgllvm.a_cmp_reg_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel);
  346. var
  347. resreg: tregister;
  348. falselab: tasmlabel;
  349. begin
  350. if getregtype(reg1)<>getregtype(reg2) then
  351. internalerror(2012111105);
  352. resreg:=getintregister(list,pasbool8type);
  353. current_asmdata.getjumplabel(falselab);
  354. { invert order of registers. In FPC, cmp_reg_reg(reg1,reg2) means that
  355. e.g. OC_GT is true if "subl %reg1,%reg2" in x86 AT&T is >0. In LLVM,
  356. OC_GT is true if op1>op2 }
  357. list.concat(taillvm.op_reg_cond_size_reg_reg(la_icmp,resreg,cmp_op,size,reg2,reg1));
  358. list.concat(taillvm.op_size_reg_lab_lab(la_br,pasbool8type,resreg,l,falselab));
  359. a_label(list,falselab);
  360. end;
  361. procedure thlcgllvm.a_jmp_always(list: TAsmList; l: tasmlabel);
  362. begin
  363. { implement in tcg because required by the overridden a_label; doesn't use
  364. any high level stuff anyway }
  365. cg.a_jmp_always(list,l);
  366. end;
  367. procedure thlcgllvm.g_concatcopy(list: TAsmList; size: tdef; const source, dest: treference);
  368. begin
  369. { todo }
  370. inherited;
  371. end;
  372. procedure thlcgllvm.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister);
  373. var
  374. tmpreg: tregister;
  375. href: treference;
  376. begin
  377. href:=make_simple_ref(list,ref,fromsize);
  378. { don't generate different code for loading e.g. extended into cextended,
  379. but to take care of loading e.g. comp (=int64) into double }
  380. if (fromsize.size<>tosize.size) or
  381. ((tfloatdef(fromsize).floattype in [s64currency,s64comp])<>
  382. (tfloatdef(tosize).floattype in [s64currency,s64comp])) then
  383. tmpreg:=getfpuregister(list,fromsize)
  384. else
  385. tmpreg:=reg;
  386. { %tmpreg = load size* %ref }
  387. list.concat(taillvm.op_reg_size_ref(la_load,tmpreg,getpointerdef(fromsize),href));
  388. if tmpreg<>reg then
  389. a_loadfpu_reg_reg(list,fromsize,tosize,tmpreg,reg);
  390. end;
  391. procedure thlcgllvm.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference);
  392. var
  393. tmpreg: tregister;
  394. href: treference;
  395. begin
  396. href:=make_simple_ref(list,ref,tosize);
  397. { don't generate different code for loading e.g. extended into cextended,
  398. but to take care of storing e.g. comp (=int64) into double }
  399. if (fromsize.size<>tosize.size) or
  400. ((tfloatdef(fromsize).floattype in [s64currency,s64comp])<>
  401. (tfloatdef(tosize).floattype in [s64currency,s64comp])) then
  402. begin
  403. tmpreg:=getfpuregister(list,tosize);
  404. a_loadfpu_reg_reg(list,fromsize,tosize,reg,tmpreg);
  405. end
  406. else
  407. tmpreg:=reg;
  408. { store tosize tmpreg, tosize* href }
  409. list.concat(taillvm.op_size_reg_size_ref(la_store,tosize,tmpreg,getpointerdef(tosize),href));
  410. end;
  411. procedure thlcgllvm.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister);
  412. var
  413. op: tllvmop;
  414. intfromsize,
  415. inttosize: longint;
  416. fromcompcurr,
  417. tocompcurr: boolean;
  418. begin
  419. { at the value level, s80real and sc80real are the same }
  420. if fromsize<>s80floattype then
  421. intfromsize:=fromsize.size
  422. else
  423. intfromsize:=sc80floattype.size;
  424. if tosize<>s80floattype then
  425. inttosize:=tosize.size
  426. else
  427. inttosize:=sc80floattype.size;
  428. { s64comp and s64real are handled as int64 by llvm, which complicates
  429. things here for us }
  430. fromcompcurr:=tfloatdef(fromsize).floattype in [s64comp,s64currency];
  431. tocompcurr:=tfloatdef(tosize).floattype in [s64comp,s64currency];
  432. if fromcompcurr=tocompcurr then
  433. begin
  434. if intfromsize<inttosize then
  435. op:=la_fpext
  436. else if intfromsize>inttosize then
  437. op:=la_fptrunc
  438. else
  439. op:=la_bitcast
  440. end
  441. else if fromcompcurr then
  442. op:=la_sitofp
  443. else
  444. op:=la_fptosi;
  445. { reg2 = bitcast fromllsize reg1 to tollsize }
  446. list.concat(taillvm.op_reg_size_reg_size(op,reg2,fromsize,reg1,tosize));
  447. end;
  448. procedure thlcgllvm.gen_proc_symbol(list: TAsmList);
  449. var
  450. item: TCmdStrListItem;
  451. mangledname: TSymStr;
  452. begin
  453. item:=TCmdStrListItem(current_procinfo.procdef.aliasnames.first);
  454. mangledname:=current_procinfo.procdef.mangledname;
  455. { predefine the real function name as local/global, so the aliases can
  456. refer to the symbol and get the binding correct }
  457. if (cs_profile in current_settings.moduleswitches) or
  458. (po_global in current_procinfo.procdef.procoptions) then
  459. current_asmdata.DefineAsmSymbol(mangledname,AB_GLOBAL,AT_FUNCTION)
  460. else
  461. current_asmdata.DefineAsmSymbol(mangledname,AB_LOCAL,AT_FUNCTION);
  462. while assigned(item) do
  463. begin
  464. if mangledname<>item.Str then
  465. list.concat(taillvmalias.Create(mangledname,item.str,current_procinfo.procdef,llv_default,lll_default));
  466. item:=TCmdStrListItem(item.next);
  467. end;
  468. list.concat(taillvmprocdef.create(current_procinfo.procdef));
  469. end;
  470. procedure thlcgllvm.gen_proc_symbol_end(list: TAsmList);
  471. begin
  472. list.concat(Tai_symbol_end.Createname(current_procinfo.procdef.mangledname));
  473. { todo: darwin main proc, or handle in other way? }
  474. end;
  475. procedure thlcgllvm.g_proc_entry(list: TAsmList; localsize: longint; nostackframe: boolean);
  476. begin
  477. list.concatlist(ttgllvm(tg).alloclist)
  478. { rest: todo }
  479. end;
  480. procedure thlcgllvm.g_proc_exit(list: TAsmList; parasize: longint; nostackframe: boolean);
  481. var
  482. retdef: tdef;
  483. begin
  484. if current_procinfo.procdef.proctypeoption in [potype_constructor,potype_class_constructor] then
  485. if is_implicit_pointer_object_type(current_procinfo.procdef.struct) then
  486. retdef:=current_procinfo.procdef.struct
  487. else
  488. retdef:=getpointerdef(current_procinfo.procdef.struct)
  489. else
  490. retdef:=current_procinfo.procdef.returndef;
  491. if is_void(retdef) then
  492. list.concat(taillvm.op_size(la_ret,retdef))
  493. else
  494. begin
  495. case current_procinfo.procdef.funcretloc[calleeside].location^.loc of
  496. LOC_REGISTER,
  497. LOC_FPUREGISTER:
  498. list.concat(taillvm.op_size_reg(la_ret,retdef,current_procinfo.procdef.funcretloc[calleeside].location^.register))
  499. else
  500. { todo: complex returns }
  501. internalerror(2012111106);
  502. end;
  503. end;
  504. end;
  505. procedure thlcgllvm.g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef);
  506. begin
  507. { not possible, need ovloc }
  508. internalerror(2012111107);
  509. end;
  510. procedure thlcgllvm.g_overflowCheck_loc(List: TAsmList; const Loc: TLocation; def: TDef; var ovloc: tlocation);
  511. begin
  512. { todo }
  513. internalerror(2012111108);
  514. end;
  515. procedure thlcgllvm.a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle);
  516. var
  517. href: treference;
  518. begin
  519. if shuffle=mms_movescalar then
  520. a_loadfpu_ref_reg(list,fromsize,tosize,ref,reg)
  521. else
  522. begin
  523. { todo }
  524. if fromsize<>tosize then
  525. internalerror(2013060220);
  526. href:=make_simple_ref(list,ref,fromsize);
  527. { %reg = load size* %ref }
  528. list.concat(taillvm.op_reg_size_ref(la_load,reg,getpointerdef(fromsize),href));
  529. end;
  530. end;
  531. procedure thlcgllvm.a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle);
  532. var
  533. href: treference;
  534. begin
  535. if shuffle=mms_movescalar then
  536. a_loadfpu_reg_ref(list,fromsize,tosize,reg,ref)
  537. else
  538. begin
  539. { todo }
  540. if fromsize<>tosize then
  541. internalerror(2013060220);
  542. href:=make_simple_ref(list,ref,tosize);
  543. { store tosize reg, tosize* href }
  544. list.concat(taillvm.op_size_reg_size_ref(la_store,tosize,reg,getpointerdef(tosize),href))
  545. end;
  546. end;
  547. procedure thlcgllvm.a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister; shuffle: pmmshuffle);
  548. begin
  549. if shuffle=mms_movescalar then
  550. a_loadfpu_reg_reg(list,fromsize,tosize,reg1,reg2)
  551. else
  552. { reg2 = bitcast fromllsize reg1 to tollsize }
  553. list.concat(taillvm.op_reg_size_reg_size(la_bitcast,reg2,fromsize,reg1,tosize));
  554. end;
  555. procedure thlcgllvm.a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; src, dst: tregister; shuffle: pmmshuffle);
  556. begin
  557. if (op=OP_XOR) and
  558. (src=dst) then
  559. a_load_const_reg(list,size,0,dst)
  560. else
  561. { todo }
  562. internalerror(2013060221);
  563. end;
  564. procedure thlcgllvm.a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize: tdef; intreg, mmreg: tregister; shuffle: pmmshuffle);
  565. begin
  566. internalerror(2013060222);
  567. end;
  568. procedure thlcgllvm.a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize: tdef; mmreg, intreg: tregister; shuffle: pmmshuffle);
  569. begin
  570. internalerror(2013060223);
  571. end;
  572. procedure thlcgllvm.gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean);
  573. var
  574. href : treference;
  575. begin
  576. { skip e.g. empty records }
  577. if (para.location^.loc = LOC_VOID) then
  578. exit;
  579. para.check_simple_location;
  580. case destloc.loc of
  581. LOC_REFERENCE :
  582. begin
  583. { If the parameter location is reused we don't need to copy
  584. anything }
  585. if not reusepara then
  586. begin
  587. reference_reset_symbol(href,para.location^.llvmloc,0,para.location^.def.alignment);
  588. if para.location^.llvmvalueloc then
  589. href.refaddr:=addr_full;
  590. { TODO: if more than one location, use para.location^.def instead (otherwise para.def, because can be
  591. zext/sext -> paraloc.location^.def will be larger) }
  592. a_load_ref_ref(list,para.def,para.def,href,destloc.reference);
  593. end;
  594. end;
  595. { TODO other possible locations }
  596. else
  597. internalerror(2013102304);
  598. end;
  599. end;
  600. procedure thlcgllvm.a_jmp_flags(list: TAsmList; const f: TResFlags; l: tasmlabel);
  601. begin
  602. internalerror(2013060224);
  603. end;
  604. procedure thlcgllvm.g_flags2reg(list: TAsmList; size: tdef; const f: tresflags; reg: TRegister);
  605. begin
  606. internalerror(2013060225);
  607. end;
  608. procedure thlcgllvm.g_flags2ref(list: TAsmList; size: tdef; const f: tresflags; const ref: TReference);
  609. begin
  610. internalerror(2013060226);
  611. end;
  612. procedure thlcgllvm.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: tdef; src, dst: tregister);
  613. begin
  614. internalerror(2012090201);
  615. end;
  616. procedure thlcgllvm.g_stackpointer_alloc(list: TAsmList; size: longint);
  617. begin
  618. internalerror(2012090203);
  619. end;
  620. procedure thlcgllvm.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
  621. begin
  622. internalerror(2012090204);
  623. end;
  624. procedure thlcgllvm.g_adjust_self_value(list: TAsmList; procdef: tprocdef; ioffset: aint);
  625. begin
  626. internalerror(2012090205);
  627. end;
  628. procedure thlcgllvm.g_local_unwind(list: TAsmList; l: TAsmLabel);
  629. begin
  630. internalerror(2012090206);
  631. end;
  632. function thlcgllvm.make_simple_ref(list: TAsmList; const ref: treference; def: tdef): treference;
  633. var
  634. hreg1,
  635. hreg2: tregister;
  636. tmpref: treference;
  637. begin
  638. { already simple? }
  639. if (not assigned(ref.symbol) or
  640. (ref.base=NR_NO)) and
  641. (ref.index=NR_NO) and
  642. (ref.offset=0) then
  643. begin
  644. result:=ref;
  645. exit;
  646. end;
  647. { for now, perform all calculations using plain pointer arithmetic. Later
  648. we can look into optimizations based on getelementptr for structured
  649. accesses (if only to prevent running out of virtual registers).
  650. Assumptions:
  651. * symbol/base register: always type "def*"
  652. * index/offset: always type "ptruinttype" (llvm bitcode has no sign information, so sign doesn't matter) }
  653. hreg1:=getintregister(list,ptruinttype);
  654. if assigned(ref.symbol) then
  655. begin
  656. if ref.base<>NR_NO then
  657. internalerror(2012111301);
  658. reference_reset_symbol(tmpref,ref.symbol,0,ref.alignment);
  659. list.concat(taillvm.getelementptr_reg_size_ref_size_const(hreg1,getpointerdef(def),tmpref,ptruinttype,0));
  660. end
  661. else if ref.base<>NR_NO then
  662. begin
  663. a_load_reg_reg(list,getpointerdef(def),ptruinttype,ref.base,hreg1);
  664. end
  665. else
  666. { todo: support for absolute addresses on embedded platforms }
  667. internalerror(2012111302);
  668. if ref.index<>NR_NO then
  669. begin
  670. { SSA... }
  671. hreg2:=getintregister(list,ptruinttype);
  672. a_op_reg_reg_reg(list,OP_ADD,ptruinttype,ref.index,hreg1,hreg2);
  673. hreg1:=hreg2;
  674. end;
  675. if ref.offset<>0 then
  676. begin
  677. hreg2:=getintregister(list,ptruinttype);
  678. a_op_const_reg_reg(list,OP_ADD,ptruinttype,ref.offset,hreg1,hreg2);
  679. hreg1:=hreg2;
  680. end;
  681. hreg2:=getaddressregister(list,getpointerdef(def));
  682. a_load_reg_reg(list,ptruinttype,getpointerdef(def),hreg1,hreg2);
  683. reference_reset_base(result,hreg2,0,ref.alignment);
  684. end;
  685. procedure create_hlcodegen;
  686. begin
  687. hlcg:=thlcgllvm.create;
  688. cgllvm.create_codegen
  689. end;
  690. end.