agllvm.pas 37 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120
  1. {
  2. Copyright (c) 1998-2013 by the Free Pascal team
  3. This unit implements the generic part of the LLVM IR writer
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit agllvm;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. globtype,globals,systems,
  22. aasmbase,aasmtai,aasmdata,
  23. assemble;
  24. type
  25. TLLVMInstrWriter = class;
  26. TLLVMAssember=class(texternalassembler)
  27. protected
  28. fdecllevel: longint;
  29. procedure WriteExtraHeader;virtual;
  30. procedure WriteExtraFooter;virtual;
  31. procedure WriteInstruction(hp: tai);
  32. procedure WriteLlvmInstruction(hp: tai);
  33. procedure WriteDirectiveName(dir: TAsmDirective); virtual;
  34. procedure WriteRealConst(hp: tai_realconst; do_line: boolean);
  35. procedure WriteOrdConst(hp: tai_const);
  36. procedure WriteTai(const replaceforbidden: boolean; const do_line: boolean; var InlineLevel: cardinal; var asmblock: boolean; var hp: tai);
  37. public
  38. constructor create(info: pasminfo; smart: boolean); override;
  39. function MakeCmdLine: TCmdStr; override;
  40. procedure WriteTree(p:TAsmList);override;
  41. procedure WriteAsmList;override;
  42. destructor destroy; override;
  43. protected
  44. InstrWriter: TLLVMInstrWriter;
  45. end;
  46. {# This is the base class for writing instructions.
  47. The WriteInstruction() method must be overridden
  48. to write a single instruction to the assembler
  49. file.
  50. }
  51. TLLVMInstrWriter = class
  52. constructor create(_owner: TLLVMAssember);
  53. procedure WriteInstruction(hp : tai);
  54. protected
  55. owner: TLLVMAssember;
  56. fstr: TSymStr;
  57. function getopstr(const o:toper; refwithalign: boolean) : TSymStr;
  58. end;
  59. implementation
  60. uses
  61. SysUtils,
  62. cutils,cfileutl,
  63. fmodule,verbose,
  64. aasmcnst,symconst,symdef,symtable,
  65. llvmbase,aasmllvm,itllvm,llvmdef,
  66. cgbase,cgutils,cpubase;
  67. const
  68. line_length = 70;
  69. type
  70. {$ifdef cpuextended}
  71. t80bitarray = array[0..9] of byte;
  72. {$endif cpuextended}
  73. t64bitarray = array[0..7] of byte;
  74. t32bitarray = array[0..3] of byte;
  75. {****************************************************************************}
  76. { Support routines }
  77. {****************************************************************************}
  78. function single2str(d : single) : string;
  79. var
  80. hs : string;
  81. begin
  82. str(d,hs);
  83. { replace space with + }
  84. if hs[1]=' ' then
  85. hs[1]:='+';
  86. single2str:=hs
  87. end;
  88. function double2str(d : double) : string;
  89. var
  90. hs : string;
  91. begin
  92. str(d,hs);
  93. { replace space with + }
  94. if hs[1]=' ' then
  95. hs[1]:='+';
  96. double2str:=hs
  97. end;
  98. function extended2str(e : extended) : string;
  99. var
  100. hs : string;
  101. begin
  102. str(e,hs);
  103. { replace space with + }
  104. if hs[1]=' ' then
  105. hs[1]:='+';
  106. extended2str:=hs
  107. end;
  108. {****************************************************************************}
  109. { LLVM Instruction writer }
  110. {****************************************************************************}
  111. function getregisterstring(reg: tregister): ansistring;
  112. begin
  113. if getregtype(reg)=R_TEMPREGISTER then
  114. result:='%tmp.'
  115. else
  116. result:='%reg.'+tostr(byte(getregtype(reg)))+'_';
  117. result:=result+tostr(getsupreg(reg));
  118. end;
  119. function getreferencealignstring(var ref: treference) : ansistring;
  120. begin
  121. result:=', align '+tostr(ref.alignment);
  122. end;
  123. function getreferencestring(var ref : treference; withalign: boolean) : ansistring;
  124. begin
  125. result:='';
  126. if assigned(ref.relsymbol) or
  127. (assigned(ref.symbol) =
  128. (ref.base<>NR_NO)) or
  129. (ref.index<>NR_NO) or
  130. (ref.offset<>0) then
  131. begin
  132. result:=' **(error ref: ';
  133. if assigned(ref.symbol) then
  134. result:=result+'sym='+ref.symbol.name+', ';
  135. if assigned(ref.relsymbol) then
  136. result:=result+'sym='+ref.relsymbol.name+', ';
  137. if ref.base=NR_NO then
  138. result:=result+'base=NR_NO, ';
  139. if ref.index<>NR_NO then
  140. result:=result+'index<>NR_NO, ';
  141. if ref.offset<>0 then
  142. result:=result+'offset='+tostr(ref.offset);
  143. result:=result+')**'
  144. // internalerror(2013060225);
  145. end;
  146. if ref.base<>NR_NO then
  147. result:=result+getregisterstring(ref.base)
  148. else
  149. result:=result+LlvmAsmSymName(ref.symbol);
  150. if withalign then
  151. result:=result+getreferencealignstring(ref);
  152. end;
  153. function getparas(const o: toper): ansistring;
  154. var
  155. i: longint;
  156. para: pllvmcallpara;
  157. begin
  158. result:='(';
  159. for i:=0 to o.paras.count-1 do
  160. begin
  161. if i<>0 then
  162. result:=result+', ';
  163. para:=pllvmcallpara(o.paras[i]);
  164. result:=result+llvmencodetypename(para^.def);
  165. if para^.valueext<>lve_none then
  166. result:=result+llvmvalueextension2str[para^.valueext];
  167. case para^.loc of
  168. LOC_REGISTER,
  169. LOC_FPUREGISTER,
  170. LOC_MMREGISTER:
  171. result:=result+' '+getregisterstring(para^.reg);
  172. else
  173. internalerror(2014010801);
  174. end;
  175. end;
  176. result:=result+')';
  177. end;
  178. function llvmdoubletostr(const d: double): TSymStr;
  179. type
  180. tdoubleval = record
  181. case byte of
  182. 1: (d: double);
  183. 2: (i: int64);
  184. end;
  185. begin
  186. { "When using the hexadecimal form, constants of types half,
  187. float, and double are represented using the 16-digit form shown
  188. above (which matches the IEEE754 representation for double)"
  189. And always in big endian form (sign bit leftmost)
  190. }
  191. result:='0x'+hexstr(tdoubleval(d).i,16);
  192. end;
  193. {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
  194. function llvmextendedtostr(const e: extended): TSymStr;
  195. var
  196. extendedval: record
  197. case byte of
  198. 1: (e: extended);
  199. 2: (r: packed record
  200. {$ifdef FPC_LITTLE_ENDIAN}
  201. l: int64;
  202. h: word;
  203. {$else FPC_LITTLE_ENDIAN}
  204. h: int64;
  205. l: word;
  206. {$endif FPC_LITTLE_ENDIAN}
  207. end;
  208. );
  209. end;
  210. begin
  211. extendedval.e:=e;
  212. { hex format is always big endian in llvm }
  213. result:='0xK'+hexstr(extendedval.r.h,sizeof(extendedval.r.h)*2)+
  214. hexstr(extendedval.r.l,sizeof(extendedval.r.l)*2);
  215. end;
  216. {$endif cpuextended}
  217. function TLLVMInstrWriter.getopstr(const o:toper; refwithalign: boolean) : TSymStr;
  218. var
  219. hs : ansistring;
  220. hp: tai;
  221. tmpinline: cardinal;
  222. tmpasmblock: boolean;
  223. begin
  224. case o.typ of
  225. top_reg:
  226. getopstr:=getregisterstring(o.reg);
  227. top_const:
  228. getopstr:=tostr(int64(o.val));
  229. top_ref:
  230. if o.ref^.refaddr=addr_full then
  231. begin
  232. getopstr:='';
  233. getopstr:=LlvmAsmSymName(o.ref^.symbol);
  234. if o.ref^.offset<>0 then
  235. internalerror(2013060223);
  236. end
  237. else
  238. getopstr:=getreferencestring(o.ref^,refwithalign);
  239. top_def:
  240. begin
  241. getopstr:=llvmencodetypename(o.def);
  242. end;
  243. top_cond:
  244. begin
  245. getopstr:=llvm_cond2str[o.cond];
  246. end;
  247. top_fpcond:
  248. begin
  249. getopstr:=llvm_fpcond2str[o.fpcond];
  250. end;
  251. top_single,
  252. top_double:
  253. begin
  254. { "When using the hexadecimal form, constants of types half,
  255. float, and double are represented using the 16-digit form shown
  256. above (which matches the IEEE754 representation for double)"
  257. And always in big endian form (sign bit leftmost)
  258. }
  259. if o.typ=top_double then
  260. result:=llvmdoubletostr(o.dval)
  261. else
  262. result:=llvmdoubletostr(o.sval)
  263. end;
  264. top_para:
  265. begin
  266. result:=getparas(o);
  267. end;
  268. top_tai:
  269. begin
  270. tmpinline:=1;
  271. tmpasmblock:=false;
  272. hp:=o.ai;
  273. owner.writer.AsmWrite(fstr);
  274. fstr:='';
  275. owner.WriteTai(false,false,tmpinline,tmpasmblock,hp);
  276. result:='';
  277. end;
  278. {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
  279. top_extended80:
  280. begin
  281. result:=llvmextendedtostr(o.eval);
  282. end;
  283. {$endif cpuextended}
  284. top_undef:
  285. result:='undef'
  286. else
  287. internalerror(2013060227);
  288. end;
  289. end;
  290. procedure TLLVMInstrWriter.WriteInstruction(hp: tai);
  291. var
  292. op: tllvmop;
  293. sep: TSymStr;
  294. i, opstart: byte;
  295. nested: boolean;
  296. done: boolean;
  297. begin
  298. op:=taillvm(hp).llvmopcode;
  299. { we write everything immediately rather than adding it into a string,
  300. because operands may contain other tai that will also write things out
  301. (and their output must come after everything that was processed in this
  302. instruction, such as its opcode or previous operands) }
  303. if owner.fdecllevel=0 then
  304. owner.writer.AsmWrite(#9);
  305. sep:=' ';
  306. done:=false;
  307. opstart:=0;
  308. nested:=false;
  309. case op of
  310. la_type:
  311. begin
  312. owner.writer.AsmWrite(llvmtypeidentifier(taillvm(hp).oper[0]^.def));
  313. owner.writer.AsmWrite(' = type ');
  314. owner.writer.AsmWrite(llvmencodetypedecl(taillvm(hp).oper[0]^.def));
  315. done:=true;
  316. end;
  317. la_ret, la_br, la_switch, la_indirectbr,
  318. la_invoke, la_resume,
  319. la_unreachable,
  320. la_store,
  321. la_fence,
  322. la_cmpxchg,
  323. la_atomicrmw:
  324. begin
  325. { instructions that never have a result }
  326. end;
  327. la_call:
  328. begin
  329. if taillvm(hp).oper[1]^.reg<>NR_NO then
  330. owner.writer.AsmWrite(getregisterstring(taillvm(hp).oper[1]^.reg)+' = ');
  331. sep:=' ';
  332. opstart:=2;
  333. end;
  334. la_alloca:
  335. begin
  336. owner.writer.AsmWrite(getreferencestring(taillvm(hp).oper[0]^.ref^,false)+' = ');
  337. sep:=' ';
  338. opstart:=1;
  339. end;
  340. la_trunc, la_zext, la_sext, la_fptrunc, la_fpext,
  341. la_fptoui, la_fptosi, la_uitofp, la_sitofp,
  342. la_ptrtoint, la_inttoptr,
  343. la_bitcast:
  344. begin
  345. { destination can be empty in case of nested constructs, or
  346. data initialisers }
  347. if (taillvm(hp).oper[0]^.typ<>top_reg) or
  348. (taillvm(hp).oper[0]^.reg<>NR_NO) then
  349. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[0]^,false)+' = ')
  350. else
  351. nested:=true;
  352. owner.writer.AsmWrite(llvm_op2str[op]);
  353. if not nested then
  354. owner.writer.AsmWrite(' ')
  355. else
  356. owner.writer.AsmWrite(' (');
  357. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[1]^,false));
  358. { if there's a tai operand, its def is used instead of an
  359. explicit def operand }
  360. if taillvm(hp).ops=4 then
  361. begin
  362. owner.writer.AsmWrite(' ');
  363. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[2]^,false));
  364. opstart:=3;
  365. end
  366. else
  367. opstart:=2;
  368. owner.writer.AsmWrite(' to ');
  369. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[opstart]^,false));
  370. done:=true;
  371. end
  372. else
  373. begin
  374. if (taillvm(hp).oper[0]^.typ<>top_reg) or
  375. (taillvm(hp).oper[0]^.reg<>NR_NO) then
  376. begin
  377. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[0]^,true)+' = ');
  378. end
  379. else
  380. nested:=true;
  381. sep:=' ';
  382. opstart:=1
  383. end;
  384. end;
  385. { process operands }
  386. if not done then
  387. begin
  388. owner.writer.AsmWrite(llvm_op2str[op]);
  389. if nested then
  390. owner.writer.AsmWrite(' (');
  391. if taillvm(hp).ops<>0 then
  392. begin
  393. for i:=opstart to taillvm(hp).ops-1 do
  394. begin
  395. owner.writer.AsmWrite(sep);
  396. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[i]^,op in [la_load,la_store]));
  397. if (taillvm(hp).oper[i]^.typ in [top_def,top_cond,top_fpcond]) or
  398. (op=la_call) then
  399. sep :=' '
  400. else
  401. sep:=', ';
  402. end;
  403. end;
  404. end;
  405. if op=la_alloca then
  406. owner.writer.AsmWrite(getreferencealignstring(taillvm(hp).oper[0]^.ref^));
  407. if nested then
  408. owner.writer.AsmWrite(')')
  409. else if owner.fdecllevel=0 then
  410. owner.writer.AsmLn;
  411. end;
  412. {****************************************************************************}
  413. { LLVM Assembler writer }
  414. {****************************************************************************}
  415. destructor TLLVMAssember.Destroy;
  416. begin
  417. InstrWriter.free;
  418. inherited destroy;
  419. end;
  420. function TLLVMAssember.MakeCmdLine: TCmdStr;
  421. var
  422. optstr: TCmdStr;
  423. begin
  424. result := inherited MakeCmdLine;
  425. { standard optimization flags for llc -- todo: this needs to be split
  426. into a call to opt and one to llc }
  427. if cs_opt_level3 in current_settings.optimizerswitches then
  428. optstr:='-O3'
  429. else if cs_opt_level2 in current_settings.optimizerswitches then
  430. optstr:='-O2'
  431. else if cs_opt_level1 in current_settings.optimizerswitches then
  432. optstr:='-O1'
  433. else
  434. optstr:='-O0';
  435. { stack frame elimination }
  436. if not(cs_opt_stackframe in current_settings.optimizerswitches) then
  437. optstr:=optstr+' -disable-fp-elim';
  438. { fast math }
  439. if cs_opt_fastmath in current_settings.optimizerswitches then
  440. optstr:=optstr+' -enable-unsafe-fp-math -enable-fp-mad -fp-contract=fast';
  441. { smart linking }
  442. if cs_create_smart in current_settings.moduleswitches then
  443. optstr:=optstr+' -fdata-sections -fcode-sections';
  444. { pic }
  445. if cs_create_pic in current_settings.moduleswitches then
  446. optstr:=optstr+' -relocation-model=pic'
  447. else if not(target_info.system in systems_darwin) then
  448. optstr:=optstr+' -relocation-model=static'
  449. else
  450. optstr:=optstr+' -relocation-model=dynamic-no-pic';
  451. { our stack alignment is non-standard on some targets. The following
  452. parameter is however ignored on some targets by llvm, so it may not
  453. be enough }
  454. optstr:=optstr+' -stack-alignment='+tostr(target_info.stackalign*8);
  455. { force object output instead of textual assembler code }
  456. optstr:=optstr+' -filetype=obj';
  457. replace(result,'$OPT',optstr);
  458. end;
  459. procedure TLLVMAssember.WriteTree(p:TAsmList);
  460. var
  461. hp : tai;
  462. InlineLevel : cardinal;
  463. asmblock: boolean;
  464. do_line : boolean;
  465. replaceforbidden: boolean;
  466. begin
  467. if not assigned(p) then
  468. exit;
  469. replaceforbidden:=asminfo^.dollarsign<>'$';
  470. InlineLevel:=0;
  471. asmblock:=false;
  472. { lineinfo is only needed for al_procedures (PFV) }
  473. do_line:=(cs_asm_source in current_settings.globalswitches) or
  474. ((cs_lineinfo in current_settings.moduleswitches)
  475. and (p=current_asmdata.asmlists[al_procedures]));
  476. hp:=tai(p.first);
  477. while assigned(hp) do
  478. begin
  479. prefetch(pointer(hp.next)^);
  480. if not(hp.typ in SkipLineInfo) then
  481. begin
  482. current_filepos:=tailineinfo(hp).fileinfo;
  483. { no line info for inlined code }
  484. if do_line and (inlinelevel=0) then
  485. WriteSourceLine(hp as tailineinfo);
  486. end;
  487. WriteTai(replaceforbidden, do_line, InlineLevel, asmblock, hp);
  488. hp:=tai(hp.next);
  489. end;
  490. end;
  491. procedure TLLVMAssember.WriteExtraHeader;
  492. begin
  493. writer.AsmWrite('target datalayout = "');
  494. writer.AsmWrite(target_info.llvmdatalayout);
  495. writer.AsmWriteln('"');
  496. writer.AsmWrite('target triple = "');
  497. writer.AsmWrite(llvm_target_name);
  498. writer.AsmWriteln('"');
  499. end;
  500. procedure TLLVMAssember.WriteExtraFooter;
  501. begin
  502. end;
  503. procedure TLLVMAssember.WriteInstruction(hp: tai);
  504. begin
  505. end;
  506. procedure TLLVMAssember.WriteLlvmInstruction(hp: tai);
  507. begin
  508. InstrWriter.WriteInstruction(hp);
  509. end;
  510. procedure TLLVMAssember.WriteRealConst(hp: tai_realconst; do_line: boolean);
  511. begin
  512. if do_line and
  513. (fdecllevel=0) then
  514. begin
  515. case tai_realconst(hp).realtyp of
  516. aitrealconst_s32bit:
  517. writer.AsmWriteLn(asminfo^.comment+'value: '+single2str(tai_realconst(hp).value.s32val));
  518. aitrealconst_s64bit:
  519. writer.AsmWriteLn(asminfo^.comment+'value: '+double2str(tai_realconst(hp).value.s64val));
  520. {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
  521. { can't write full 80 bit floating point constants yet on non-x86 }
  522. aitrealconst_s80bit:
  523. writer.AsmWriteLn(asminfo^.comment+'value: '+extended2str(tai_realconst(hp).value.s80val));
  524. {$endif cpuextended}
  525. aitrealconst_s64comp:
  526. writer.AsmWriteLn(asminfo^.comment+'value: '+extended2str(tai_realconst(hp).value.s64compval));
  527. else
  528. internalerror(2014050604);
  529. end;
  530. end;
  531. case hp.realtyp of
  532. aitrealconst_s32bit:
  533. writer.AsmWriteln(llvmdoubletostr(hp.value.s32val));
  534. aitrealconst_s64bit:
  535. writer.AsmWriteln(llvmdoubletostr(hp.value.s64val));
  536. {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
  537. aitrealconst_s80bit:
  538. writer.AsmWriteln(llvmextendedtostr(hp.value.s80val));
  539. {$endif defined(cpuextended)}
  540. aitrealconst_s64comp:
  541. { handled as int64 most of the time in llvm }
  542. writer.AsmWriteln(tostr(round(hp.value.s64compval)));
  543. else
  544. internalerror(2014062401);
  545. end;
  546. end;
  547. procedure TLLVMAssember.WriteOrdConst(hp: tai_const);
  548. var
  549. consttyp: taiconst_type;
  550. begin
  551. if fdecllevel=0 then
  552. writer.AsmWrite(asminfo^.comment+' const ');
  553. consttyp:=hp.consttype;
  554. case consttyp of
  555. aitconst_got,
  556. aitconst_gotoff_symbol,
  557. aitconst_uleb128bit,
  558. aitconst_sleb128bit,
  559. aitconst_rva_symbol,
  560. aitconst_secrel32_symbol,
  561. aitconst_darwin_dwarf_delta32,
  562. aitconst_darwin_dwarf_delta64,
  563. aitconst_half16bit,
  564. aitconst_gs:
  565. internalerror(2014052901);
  566. aitconst_128bit,
  567. aitconst_64bit,
  568. aitconst_32bit,
  569. aitconst_16bit,
  570. aitconst_8bit,
  571. aitconst_16bit_unaligned,
  572. aitconst_32bit_unaligned,
  573. aitconst_64bit_unaligned:
  574. begin
  575. if fdecllevel=0 then
  576. writer.AsmWrite(asminfo^.comment);
  577. { can't have compile-time differences between symbols; these are
  578. normally for PIC, but llvm takes care of that for us }
  579. if assigned(hp.endsym) then
  580. internalerror(2014052902);
  581. if assigned(hp.sym) then
  582. begin
  583. writer.AsmWrite(LlvmAsmSymName(hp.sym));
  584. { can't have offsets }
  585. if hp.value<>0 then
  586. if fdecllevel<>0 then
  587. internalerror(2014052903)
  588. else
  589. writer.AsmWrite(' -- symbol offset: ' + tostr(hp.value));
  590. end
  591. else if hp.value=0 then
  592. writer.AsmWrite('zeroinitializer')
  593. else
  594. writer.AsmWrite(tostr(hp.value));
  595. if fdecllevel=0 then
  596. writer.AsmLn;
  597. end;
  598. else
  599. internalerror(200704251);
  600. end;
  601. end;
  602. procedure TLLVMAssember.WriteTai(const replaceforbidden: boolean; const do_line: boolean; var InlineLevel: cardinal; var asmblock: boolean; var hp: tai);
  603. procedure WriteTypedConstData(hp: tai_abstracttypedconst);
  604. var
  605. p: tai_abstracttypedconst;
  606. pval: tai;
  607. defstr: TSymStr;
  608. first, gotstring: boolean;
  609. begin
  610. defstr:=llvmencodetypename(hp.def);
  611. { write the struct, array or simple type }
  612. case hp.adetyp of
  613. tck_record:
  614. begin
  615. writer.AsmWrite(defstr);
  616. writer.AsmWrite(' ');
  617. if tabstractrecordsymtable(tabstractrecorddef(hp.def).symtable).usefieldalignment<>C_alignment then
  618. writer.AsmWrite('<{')
  619. else
  620. writer.AsmWrite('{');
  621. first:=true;
  622. for p in tai_aggregatetypedconst(hp) do
  623. begin
  624. if not first then
  625. writer.AsmWrite(', ')
  626. else
  627. first:=false;
  628. WriteTypedConstData(p);
  629. end;
  630. if tabstractrecordsymtable(tabstractrecorddef(hp.def).symtable).usefieldalignment<>C_alignment then
  631. writer.AsmWrite('}>')
  632. else
  633. writer.AsmWrite('}');
  634. end;
  635. tck_array:
  636. begin
  637. writer.AsmWrite(defstr);
  638. first:=true;
  639. gotstring:=false;
  640. for p in tai_aggregatetypedconst(hp) do
  641. begin
  642. if not first then
  643. writer.AsmWrite(',')
  644. else
  645. begin
  646. writer.AsmWrite(' ');
  647. if (tai_abstracttypedconst(p).adetyp=tck_simple) and
  648. (tai_simpletypedconst(p).val.typ=ait_string) then
  649. begin
  650. gotstring:=true;
  651. end
  652. else
  653. begin
  654. writer.AsmWrite('[');
  655. end;
  656. first:=false;
  657. end;
  658. { cannot concat strings and other things }
  659. if gotstring and
  660. ((tai_abstracttypedconst(p).adetyp<>tck_simple) or
  661. (tai_simpletypedconst(p).val.typ<>ait_string)) then
  662. internalerror(2014062701);
  663. WriteTypedConstData(p);
  664. end;
  665. if not gotstring then
  666. writer.AsmWrite(']');
  667. end;
  668. tck_simple:
  669. begin
  670. pval:=tai_simpletypedconst(hp).val;
  671. if pval.typ<>ait_string then
  672. begin
  673. writer.AsmWrite(defstr);
  674. writer.AsmWrite(' ');
  675. end;
  676. WriteTai(replaceforbidden,do_line,InlineLevel,asmblock,pval);
  677. end;
  678. end;
  679. end;
  680. var
  681. hp2: tai;
  682. s: string;
  683. i: longint;
  684. ch: ansichar;
  685. begin
  686. case hp.typ of
  687. ait_comment :
  688. begin
  689. writer.AsmWrite(asminfo^.comment);
  690. writer.AsmWritePChar(tai_comment(hp).str);
  691. if fdecllevel<>0 then
  692. internalerror(2015090601);
  693. writer.AsmLn;
  694. end;
  695. ait_regalloc :
  696. begin
  697. if (cs_asm_regalloc in current_settings.globalswitches) then
  698. begin
  699. writer.AsmWrite(#9+asminfo^.comment+'Register ');
  700. repeat
  701. writer.AsmWrite(std_regname(Tai_regalloc(hp).reg));
  702. if (hp.next=nil) or
  703. (tai(hp.next).typ<>ait_regalloc) or
  704. (tai_regalloc(hp.next).ratype<>tai_regalloc(hp).ratype) then
  705. break;
  706. hp:=tai(hp.next);
  707. writer.AsmWrite(',');
  708. until false;
  709. writer.AsmWrite(' ');
  710. writer.AsmWriteLn(regallocstr[tai_regalloc(hp).ratype]);
  711. end;
  712. end;
  713. ait_tempalloc :
  714. begin
  715. if (cs_asm_tempalloc in current_settings.globalswitches) then
  716. WriteTempalloc(tai_tempalloc(hp));
  717. end;
  718. ait_align,
  719. ait_section :
  720. begin
  721. { ignore, specified as part of declarations -- don't write
  722. comment, because could appear in the middle of an aggregate
  723. constant definition }
  724. end;
  725. ait_datablock :
  726. begin
  727. writer.AsmWrite(asminfo^.comment);
  728. writer.AsmWriteln('datablock');
  729. end;
  730. ait_const:
  731. begin
  732. WriteOrdConst(tai_const(hp));
  733. end;
  734. ait_realconst :
  735. begin
  736. WriteRealConst(tai_realconst(hp), do_line);
  737. end;
  738. ait_string :
  739. begin
  740. if fdecllevel=0 then
  741. writer.AsmWrite(asminfo^.comment);
  742. writer.AsmWrite('c"');
  743. for i:=1 to tai_string(hp).len do
  744. begin
  745. ch:=tai_string(hp).str[i-1];
  746. case ch of
  747. #0, {This can't be done by range, because a bug in FPC}
  748. #1..#31,
  749. #128..#255,
  750. '"',
  751. '\' : s:='\'+hexStr(ord(ch),2);
  752. else
  753. s:=ch;
  754. end;
  755. writer.AsmWrite(s);
  756. end;
  757. writer.AsmWriteLn('"');
  758. end;
  759. ait_label :
  760. begin
  761. if not asmblock and
  762. (tai_label(hp).labsym.is_used) then
  763. begin
  764. if (tai_label(hp).labsym.bind=AB_PRIVATE_EXTERN) then
  765. begin
  766. { should be emitted as part of the variable/function def }
  767. internalerror(2013010703);
  768. end;
  769. if tai_label(hp).labsym.bind in [AB_GLOBAL, AB_PRIVATE_EXTERN] then
  770. begin
  771. { should be emitted as part of the variable/function def }
  772. //internalerror(2013010704);
  773. writer.AsmWriteln(asminfo^.comment+'global/privateextern label: '+tai_label(hp).labsym.name);
  774. end;
  775. if replaceforbidden then
  776. writer.AsmWrite(ReplaceForbiddenAsmSymbolChars(tai_label(hp).labsym.name))
  777. else
  778. writer.AsmWrite(tai_label(hp).labsym.name);
  779. writer.AsmWriteLn(':');
  780. end;
  781. end;
  782. ait_symbol :
  783. begin
  784. if fdecllevel=0 then
  785. writer.AsmWrite(asminfo^.comment);
  786. writer.AsmWriteln(LlvmAsmSymName(tai_symbol(hp).sym));
  787. { todo }
  788. if tai_symbol(hp).has_value then
  789. internalerror(2014062402);
  790. end;
  791. ait_llvmdecl:
  792. begin
  793. if taillvmdecl(hp).def.typ=procdef then
  794. begin
  795. if taillvmdecl(hp).namesym.bind in [AB_EXTERNAL, AB_WEAK_EXTERNAL] then
  796. begin
  797. writer.AsmWrite('declare');
  798. writer.AsmWriteln(llvmencodeproctype(tprocdef(taillvmdecl(hp).def), taillvmdecl(hp).namesym.name, lpd_decl));
  799. end
  800. else
  801. begin
  802. writer.AsmWrite('define');
  803. writer.AsmWrite(llvmencodeproctype(tprocdef(taillvmdecl(hp).def), '', lpd_decl));
  804. writer.AsmWriteln(' {');
  805. end;
  806. end
  807. else
  808. begin
  809. writer.AsmWrite(LlvmAsmSymName(taillvmdecl(hp).namesym));
  810. case taillvmdecl(hp).namesym.bind of
  811. AB_EXTERNAL:
  812. writer.AsmWrite(' = external ');
  813. AB_COMMON:
  814. writer.AsmWrite(' = common ');
  815. AB_LOCAL:
  816. writer.AsmWrite(' = internal ');
  817. AB_GLOBAL:
  818. writer.AsmWrite(' = ');
  819. AB_WEAK_EXTERNAL:
  820. writer.AsmWrite(' = extern_weak ');
  821. AB_PRIVATE_EXTERN:
  822. writer.AsmWrite('= linker_private ');
  823. else
  824. internalerror(2014020104);
  825. end;
  826. if taillvmdecl(hp).tls then
  827. writer.AsmWrite('thread_local ');
  828. { todo: handle more different section types (mainly
  829. Objective-C }
  830. if taillvmdecl(hp).sec in [sec_rodata,sec_rodata_norel] then
  831. writer.AsmWrite('unnamed_addr constant ')
  832. else
  833. writer.AsmWrite('global ');
  834. if not assigned(taillvmdecl(hp).initdata) then
  835. begin
  836. writer.AsmWrite(llvmencodetypename(taillvmdecl(hp).def));
  837. if not(taillvmdecl(hp).namesym.bind in [AB_EXTERNAL, AB_WEAK_EXTERNAL]) then
  838. writer.AsmWrite(' zeroinitializer');
  839. end
  840. else
  841. begin
  842. inc(fdecllevel);
  843. { can't have an external symbol with initialisation data }
  844. if taillvmdecl(hp).namesym.bind in [AB_EXTERNAL, AB_WEAK_EXTERNAL] then
  845. internalerror(2014052905);
  846. { bitcast initialisation data to the type of the constant }
  847. { write initialisation data }
  848. hp2:=tai(taillvmdecl(hp).initdata.first);
  849. while assigned(hp2) do
  850. begin
  851. WriteTai(replaceforbidden,do_line,InlineLevel,asmblock,hp2);
  852. hp2:=tai(hp2.next);
  853. end;
  854. dec(fdecllevel);
  855. end;
  856. { alignment }
  857. writer.AsmWrite(', align ');
  858. writer.AsmWriteln(tostr(taillvmdecl(hp).alignment));
  859. end;
  860. end;
  861. ait_llvmalias:
  862. begin
  863. writer.AsmWrite(LlvmAsmSymName(taillvmalias(hp).newsym));
  864. writer.AsmWrite(' = alias ');
  865. if taillvmalias(hp).linkage<>lll_default then
  866. begin
  867. str(taillvmalias(hp).linkage, s);
  868. writer.AsmWrite(copy(s, length('lll_')+1, 255));
  869. writer.AsmWrite(' ');
  870. end;
  871. if taillvmalias(hp).vis<>llv_default then
  872. begin
  873. str(taillvmalias(hp).vis, s);
  874. writer.AsmWrite(copy(s, length('llv_')+1, 255));
  875. writer.AsmWrite(' ');
  876. end;
  877. if taillvmalias(hp).def.typ=procdef then
  878. writer.AsmWrite(llvmencodeproctype(tabstractprocdef(taillvmalias(hp).def), '', lpd_alias))
  879. else
  880. writer.AsmWrite(llvmencodetypename(taillvmalias(hp).def));
  881. writer.AsmWrite('* ');
  882. writer.AsmWriteln(LlvmAsmSymName(taillvmalias(hp).oldsym));
  883. end;
  884. ait_symbolpair:
  885. begin
  886. { should be emitted as part of the symbol def }
  887. internalerror(2013010708);
  888. end;
  889. ait_weak:
  890. begin
  891. { should be emitted as part of the symbol def }
  892. internalerror(2013010709);
  893. end;
  894. ait_symbol_end :
  895. begin
  896. if tai_symbol_end(hp).sym.typ=AT_FUNCTION then
  897. writer.AsmWriteln('}')
  898. else
  899. writer.AsmWriteln('; ait_symbol_end error, should not be generated');
  900. // internalerror(2013010711);
  901. end;
  902. ait_instruction :
  903. begin
  904. WriteInstruction(hp);
  905. end;
  906. ait_llvmins:
  907. begin
  908. WriteLlvmInstruction(hp);
  909. end;
  910. ait_stab :
  911. begin
  912. internalerror(2013010712);
  913. end;
  914. ait_force_line,
  915. ait_function_name :
  916. ;
  917. ait_cutobject :
  918. begin
  919. end;
  920. ait_marker :
  921. case
  922. tai_marker(hp).kind of
  923. mark_NoLineInfoStart:
  924. inc(InlineLevel);
  925. mark_NoLineInfoEnd:
  926. dec(InlineLevel);
  927. { these cannot be nested }
  928. mark_AsmBlockStart:
  929. asmblock:=true;
  930. mark_AsmBlockEnd:
  931. asmblock:=false;
  932. end;
  933. ait_directive :
  934. begin
  935. WriteDirectiveName(tai_directive(hp).directive);
  936. if tai_directive(hp).name <>'' then
  937. writer.AsmWrite(tai_directive(hp).name);
  938. if fdecllevel<>0 then
  939. internalerror(2015090602);
  940. writer.AsmLn;
  941. end;
  942. ait_seh_directive :
  943. begin
  944. internalerror(2013010713);
  945. end;
  946. ait_varloc:
  947. begin
  948. if tai_varloc(hp).newlocationhi<>NR_NO then
  949. writer.AsmWrite(strpnew('Var '+tai_varloc(hp).varsym.realname+' located in register '+
  950. std_regname(tai_varloc(hp).newlocationhi)+':'+std_regname(tai_varloc(hp).newlocation)))
  951. else
  952. writer.AsmWrite(strpnew('Var '+tai_varloc(hp).varsym.realname+' located in register '+
  953. std_regname(tai_varloc(hp).newlocation)));
  954. if fdecllevel<>0 then
  955. internalerror(2015090603);
  956. writer.AsmLn;
  957. end;
  958. ait_typedconst:
  959. begin
  960. WriteTypedConstData(tai_abstracttypedconst(hp));
  961. end
  962. else
  963. internalerror(2006012201);
  964. end;
  965. end;
  966. constructor TLLVMAssember.create(info: pasminfo; smart: boolean);
  967. begin
  968. inherited;
  969. InstrWriter:=TLLVMInstrWriter.create(self);
  970. end;
  971. procedure TLLVMAssember.WriteDirectiveName(dir: TAsmDirective);
  972. begin
  973. writer.AsmWrite('.'+directivestr[dir]+' ');
  974. end;
  975. procedure TLLVMAssember.WriteAsmList;
  976. var
  977. hal : tasmlisttype;
  978. i: longint;
  979. begin
  980. WriteExtraHeader;
  981. for hal:=low(TasmlistType) to high(TasmlistType) do
  982. begin
  983. writer.AsmWriteLn(target_asm.comment+'Begin asmlist '+AsmlistTypeStr[hal]);
  984. writetree(current_asmdata.asmlists[hal]);
  985. writer.AsmWriteLn(target_asm.comment+'End asmlist '+AsmlistTypeStr[hal]);
  986. end;
  987. writer.AsmLn;
  988. end;
  989. {****************************************************************************}
  990. { Abstract Instruction Writer }
  991. {****************************************************************************}
  992. constructor TLLVMInstrWriter.create(_owner: TLLVMAssember);
  993. begin
  994. inherited create;
  995. owner := _owner;
  996. end;
  997. const
  998. as_llvm_info : tasminfo =
  999. (
  1000. id : as_llvm;
  1001. idtxt : 'LLVM-AS';
  1002. asmbin : 'llc';
  1003. asmcmd: '$OPT -o $OBJ $ASM';
  1004. supported_targets : [system_x86_64_linux,system_x86_64_darwin,system_powerpc64_darwin];
  1005. flags : [af_smartlink_sections];
  1006. labelprefix : 'L';
  1007. comment : '; ';
  1008. dollarsign: '$';
  1009. );
  1010. begin
  1011. RegisterAssembler(as_llvm_info,TLLVMAssember);
  1012. end.