agllvm.pas 56 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654
  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. cclasses,
  22. globtype,globals,systems,
  23. aasmbase,aasmtai,aasmdata,
  24. assemble,
  25. aasmllvm, aasmllvmmetadata;
  26. type
  27. TLLVMInstrWriter = class;
  28. TLLVMModuleInlineAssemblyDecorator = class(IExternalAssemblerOutputFileDecorator)
  29. function LineFilter(const s: AnsiString): AnsiString;
  30. function LinePrefix: AnsiString;
  31. function LinePostfix: AnsiString;
  32. function LineEnding(const deflineending: ShortString): ShortString;
  33. end;
  34. TLLVMFunctionInlineAssemblyDecorator = class(IExternalAssemblerOutputFileDecorator)
  35. function LineFilter(const s: AnsiString): AnsiString;
  36. function LinePrefix: AnsiString;
  37. function LinePostfix: AnsiString;
  38. function LineEnding(const deflineending: ShortString): ShortString;
  39. end;
  40. TLLVMAssember=class(texternalassembler)
  41. protected
  42. ffuncinlasmdecorator: TLLVMFunctionInlineAssemblyDecorator;
  43. fdecllevel: longint;
  44. procedure WriteExtraHeader;virtual;
  45. procedure WriteExtraFooter;virtual;
  46. procedure WriteInstruction(hp: tai);
  47. procedure WriteLlvmInstruction(hp: tai);
  48. procedure WriteDirectiveName(dir: TAsmDirective); virtual;
  49. procedure WriteRealConst(hp: tai_realconst; do_line: boolean);
  50. procedure WriteOrdConst(hp: tai_const);
  51. procedure WriteTai(const replaceforbidden: boolean; const do_line, inmetadata: boolean; var InlineLevel: cardinal; var asmblock: boolean; var hp: tai);
  52. public
  53. constructor CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter, smart: boolean); override;
  54. procedure WriteTree(p:TAsmList);override;
  55. procedure WriteAsmList;override;
  56. procedure WriteFunctionInlineAsmList(list: tasmlist);
  57. destructor destroy; override;
  58. protected
  59. InstrWriter: TLLVMInstrWriter;
  60. end;
  61. TLLVMClangAssember=class(TLLVMAssember)
  62. public
  63. function MakeCmdLine: TCmdStr; override;
  64. function DoAssemble: boolean; override;
  65. function RerunAssembler: boolean; override;
  66. protected
  67. function DoPipe: boolean; override;
  68. private
  69. fnextpass: byte;
  70. end;
  71. {# This is the base class for writing instructions.
  72. The WriteInstruction() method must be overridden
  73. to write a single instruction to the assembler
  74. file.
  75. }
  76. TLLVMInstrWriter = class
  77. constructor create(_owner: TLLVMAssember);
  78. procedure WriteInstruction(hp : tai);
  79. protected
  80. owner: TLLVMAssember;
  81. fstr: TSymStr;
  82. function getopcodestr(hp: taillvm): TSymStr;
  83. function getopstr(const o:toper; refwithalign: boolean) : TSymStr;
  84. procedure writeparas(const paras: tfplist);
  85. procedure WriteAsmRegisterAllocationClobbers(list: tasmlist);
  86. end;
  87. implementation
  88. uses
  89. SysUtils,
  90. cutils,cfileutl,
  91. fmodule,verbose,
  92. objcasm,
  93. aasmcnst,symconst,symdef,symtable,
  94. llvmbase,itllvm,llvmdef,
  95. cgbase,cgutils,cpubase,cpuinfo,triplet,llvminfo;
  96. const
  97. line_length = 70;
  98. type
  99. {$ifdef cpuextended}
  100. t80bitarray = array[0..9] of byte;
  101. {$endif cpuextended}
  102. t64bitarray = array[0..7] of byte;
  103. t32bitarray = array[0..3] of byte;
  104. {****************************************************************************}
  105. { Support routines }
  106. {****************************************************************************}
  107. function single2str(d : single) : string;
  108. var
  109. hs : string;
  110. begin
  111. str(d,hs);
  112. { replace space with + }
  113. if hs[1]=' ' then
  114. hs[1]:='+';
  115. single2str:=hs
  116. end;
  117. function double2str(d : double) : string;
  118. var
  119. hs : string;
  120. begin
  121. str(d,hs);
  122. { replace space with + }
  123. if hs[1]=' ' then
  124. hs[1]:='+';
  125. double2str:=hs
  126. end;
  127. function extended2str(e : extended) : string;
  128. var
  129. hs : string;
  130. begin
  131. str(e,hs);
  132. { replace space with + }
  133. if hs[1]=' ' then
  134. hs[1]:='+';
  135. extended2str:=hs
  136. end;
  137. {****************************************************************************}
  138. { Decorator for module-level inline assembly }
  139. {****************************************************************************}
  140. function TLLVMModuleInlineAssemblyDecorator.LineFilter(const s: AnsiString): AnsiString;
  141. var
  142. i: longint;
  143. begin
  144. result:='';
  145. for i:=1 to length(s) do
  146. begin
  147. case s[i] of
  148. #0..#31,
  149. #127..#255,
  150. '"','\':
  151. result:=result+
  152. '\'+
  153. chr((ord(s[i]) shr 4)+ord('0'))+
  154. chr((ord(s[i]) and $f)+ord('0'));
  155. else
  156. result:=result+s[i];
  157. end;
  158. end;
  159. end;
  160. function TLLVMModuleInlineAssemblyDecorator.LinePrefix: AnsiString;
  161. begin
  162. result:='module asm "';
  163. end;
  164. function TLLVMModuleInlineAssemblyDecorator.LinePostfix: AnsiString;
  165. begin
  166. result:='"';
  167. end;
  168. function TLLVMModuleInlineAssemblyDecorator.LineEnding(const deflineending: ShortString): ShortString;
  169. begin
  170. result:=deflineending
  171. end;
  172. {****************************************************************************}
  173. { Decorator for function-level inline assembly }
  174. {****************************************************************************}
  175. function TLLVMFunctionInlineAssemblyDecorator.LineFilter(const s: AnsiString): AnsiString;
  176. var
  177. i: longint;
  178. begin
  179. result:='';
  180. for i:=1 to length(s) do
  181. begin
  182. case s[i] of
  183. { escape dollars }
  184. '$':
  185. result:=result+'$$';
  186. { ` is used as placeholder for a single dollar (reference to
  187. argument to the inline assembly) }
  188. '`':
  189. result:=result+'$';
  190. #0..#31,
  191. #127..#255,
  192. '"','\':
  193. result:=result+
  194. '\'+
  195. chr((ord(s[i]) shr 4)+ord('0'))+
  196. chr((ord(s[i]) and $f)+ord('0'));
  197. else
  198. result:=result+s[i];
  199. end;
  200. end;
  201. end;
  202. function TLLVMFunctionInlineAssemblyDecorator.LinePrefix: AnsiString;
  203. begin
  204. result:='';
  205. end;
  206. function TLLVMFunctionInlineAssemblyDecorator.LinePostfix: AnsiString;
  207. begin
  208. result:='';
  209. end;
  210. function TLLVMFunctionInlineAssemblyDecorator.LineEnding(const deflineending: ShortString): ShortString;
  211. begin
  212. result:='\0A';
  213. end;
  214. {****************************************************************************}
  215. { LLVM Instruction writer }
  216. {****************************************************************************}
  217. function getregisterstring(reg: tregister): ansistring;
  218. begin
  219. if getregtype(reg)=R_METADATAREGISTER then
  220. result:='!"'+tllvmmetadata.getregstring(reg)+'"'
  221. else
  222. begin
  223. if getregtype(reg)=R_TEMPREGISTER then
  224. result:='%tmp.'
  225. else
  226. result:='%reg.'+tostr(byte(getregtype(reg)))+'_';
  227. result:=result+tostr(getsupreg(reg));
  228. end;
  229. end;
  230. function getreferencealignstring(var ref: treference) : ansistring;
  231. begin
  232. result:=', align '+tostr(ref.alignment);
  233. end;
  234. function getreferencestring(var ref : treference; withalign: boolean) : ansistring;
  235. begin
  236. result:='';
  237. if assigned(ref.relsymbol) or
  238. (assigned(ref.symbol) and
  239. (ref.base<>NR_NO)) or
  240. (ref.index<>NR_NO) or
  241. (ref.offset<>0) then
  242. begin
  243. result:=' **(error ref: ';
  244. if assigned(ref.symbol) then
  245. result:=result+'sym='+ref.symbol.name+', ';
  246. if assigned(ref.relsymbol) then
  247. result:=result+'sym='+ref.relsymbol.name+', ';
  248. if ref.base=NR_NO then
  249. result:=result+'base=NR_NO, ';
  250. if ref.index<>NR_NO then
  251. result:=result+'index<>NR_NO, ';
  252. if ref.offset<>0 then
  253. result:=result+'offset='+tostr(ref.offset);
  254. result:=result+')**';
  255. internalerror(2013060203);
  256. end;
  257. if ref.base<>NR_NO then
  258. result:=result+getregisterstring(ref.base)
  259. else if assigned(ref.symbol) then
  260. result:=result+LlvmAsmSymName(ref.symbol)
  261. else
  262. result:=result+'null';
  263. if withalign then
  264. result:=result+getreferencealignstring(ref);
  265. end;
  266. procedure TLLVMInstrWriter.writeparas(const paras: tfplist);
  267. var
  268. i: longint;
  269. tmpinline: cardinal;
  270. para: pllvmcallpara;
  271. tmpasmblock: boolean;
  272. hp: tai;
  273. begin
  274. tmpinline:=1;
  275. tmpasmblock:=false;
  276. owner.writer.AsmWrite(fstr);
  277. fstr:='';
  278. owner.writer.AsmWrite('(');
  279. for i:=0 to paras.count-1 do
  280. begin
  281. if i<>0 then
  282. owner.writer.AsmWrite(', ');
  283. para:=pllvmcallpara(paras[i]);
  284. owner.writer.AsmWrite(llvmencodetypename(para^.def));
  285. if para^.valueext<>lve_none then
  286. owner.writer.AsmWrite(llvmvalueextension2str[para^.valueext]);
  287. if para^.byval then
  288. owner.writer.AsmWrite(' byval');
  289. if para^.sret then
  290. owner.writer.AsmWrite(' sret');
  291. { For byval, this means "alignment on the stack" and of the passed source data.
  292. For other pointer parameters, this means "alignment of the passed source data" }
  293. if (para^.alignment<>std_param_align) or
  294. (para^.alignment<0) then
  295. begin
  296. owner.writer.AsmWrite(' align ');
  297. owner.writer.AsmWrite(tostr(abs(para^.alignment)));
  298. end;
  299. case para^.typ of
  300. top_reg:
  301. begin
  302. owner.writer.AsmWrite(' ');
  303. owner.writer.AsmWrite(getregisterstring(para^.register));
  304. end;
  305. top_ref:
  306. begin
  307. owner.writer.AsmWrite(' ');
  308. owner.writer.AsmWrite(llvmasmsymname(para^.sym));
  309. end;
  310. top_const:
  311. begin
  312. owner.writer.AsmWrite(' ');
  313. owner.writer.AsmWrite(tostr(para^.value));
  314. end;
  315. top_tai:
  316. begin
  317. tmpinline:=1;
  318. tmpasmblock:=false;
  319. hp:=para^.ai;
  320. owner.writer.AsmWrite(fstr);
  321. fstr:='';
  322. owner.WriteTai(false,false,para^.def=llvm_metadatatype,tmpinline,tmpasmblock,hp);
  323. end;
  324. { empty records }
  325. top_undef:
  326. owner.writer.AsmWrite(' undef');
  327. else
  328. internalerror(2014010801);
  329. end;
  330. end;
  331. owner.writer.AsmWrite(')');
  332. end;
  333. function llvmdoubletostr(const d: double): TSymStr;
  334. type
  335. tdoubleval = record
  336. case byte of
  337. 1: (d: double);
  338. 2: (i: int64);
  339. end;
  340. begin
  341. { "When using the hexadecimal form, constants of types half,
  342. float, and double are represented using the 16-digit form shown
  343. above (which matches the IEEE754 representation for double)"
  344. And always in big endian form (sign bit leftmost)
  345. }
  346. result:='0x'+hexstr(tdoubleval(d).i,16);
  347. end;
  348. {$if defined(cpuextended) and (defined(FPC_HAS_TYPE_EXTENDED) or defined(FPC_SOFT_FPUX80))}
  349. function llvmextendedtostr(const e: extended): TSymStr;
  350. var
  351. extendedval: record
  352. case byte of
  353. 1: (e: extended);
  354. 2: (r: packed record
  355. {$ifdef FPC_LITTLE_ENDIAN}
  356. l: int64;
  357. h: word;
  358. {$else FPC_LITTLE_ENDIAN}
  359. h: int64;
  360. l: word;
  361. {$endif FPC_LITTLE_ENDIAN}
  362. end;
  363. );
  364. end;
  365. begin
  366. extendedval.e:=e;
  367. { hex format is always big endian in llvm }
  368. result:='0xK'+hexstr(extendedval.r.h,sizeof(extendedval.r.h)*2)+
  369. hexstr(extendedval.r.l,sizeof(extendedval.r.l)*2);
  370. end;
  371. {$endif cpuextended}
  372. function TLLVMInstrWriter.getopstr(const o:toper; refwithalign: boolean) : TSymStr;
  373. var
  374. hp: tai;
  375. tmpinline: cardinal;
  376. tmpasmblock: boolean;
  377. begin
  378. case o.typ of
  379. top_reg:
  380. getopstr:=getregisterstring(o.reg);
  381. top_const:
  382. getopstr:=tostr(int64(o.val));
  383. top_ref:
  384. if o.ref^.refaddr=addr_full then
  385. begin
  386. getopstr:='';
  387. if assigned(o.ref^.symbol) then
  388. getopstr:=LlvmAsmSymName(o.ref^.symbol)
  389. else
  390. getopstr:='null';
  391. if o.ref^.offset<>0 then
  392. internalerror(2013060202);
  393. end
  394. else
  395. getopstr:=getreferencestring(o.ref^,refwithalign);
  396. top_def:
  397. begin
  398. getopstr:=llvmencodetypename(o.def);
  399. end;
  400. top_cond:
  401. begin
  402. getopstr:=llvm_cond2str[o.cond];
  403. end;
  404. top_fpcond:
  405. begin
  406. getopstr:=llvm_fpcond2str[o.fpcond];
  407. end;
  408. top_single,
  409. top_double:
  410. begin
  411. { "When using the hexadecimal form, constants of types half,
  412. float, and double are represented using the 16-digit form shown
  413. above (which matches the IEEE754 representation for double)"
  414. And always in big endian form (sign bit leftmost)
  415. }
  416. if o.typ=top_double then
  417. result:=llvmdoubletostr(o.dval)
  418. else
  419. result:=llvmdoubletostr(o.sval)
  420. end;
  421. top_para:
  422. begin
  423. writeparas(o.paras);
  424. result:='';
  425. end;
  426. top_tai:
  427. begin
  428. if assigned(o.ai) then
  429. begin
  430. tmpinline:=1;
  431. tmpasmblock:=false;
  432. hp:=o.ai;
  433. owner.writer.AsmWrite(fstr);
  434. fstr:='';
  435. owner.WriteTai(false,false,false,tmpinline,tmpasmblock,hp);
  436. end;
  437. result:='';
  438. end;
  439. {$if defined(cpuextended) and (defined(FPC_HAS_TYPE_EXTENDED) or defined(FPC_SOFT_FPUX80))}
  440. top_extended80:
  441. begin
  442. result:=llvmextendedtostr(o.eval);
  443. end;
  444. {$endif cpuextended}
  445. top_undef:
  446. result:='undef';
  447. top_callingconvention:
  448. result:=llvm_callingconvention_name(o.callingconvention);
  449. else
  450. internalerror(2013060227);
  451. end;
  452. end;
  453. procedure TLLVMInstrWriter.WriteAsmRegisterAllocationClobbers(list: tasmlist);
  454. var
  455. hp: tai;
  456. begin
  457. hp:=tai(list.first);
  458. while assigned(hp) do
  459. begin
  460. if (hp.typ=ait_regalloc) and
  461. (tai_regalloc(hp).ratype=ra_alloc) then
  462. begin
  463. owner.writer.AsmWrite(',~{');
  464. owner.writer.AsmWrite(std_regname(tai_regalloc(hp).reg));
  465. owner.writer.AsmWrite('}');
  466. end;
  467. hp:=tai(hp.next);
  468. end;
  469. end;
  470. procedure TLLVMInstrWriter.WriteInstruction(hp: tai);
  471. var
  472. op: tllvmop;
  473. tmpstr,
  474. sep: TSymStr;
  475. i, opstart: longint;
  476. nested: boolean;
  477. opdone,
  478. done: boolean;
  479. begin
  480. op:=taillvm(hp).llvmopcode;
  481. { we write everything immediately rather than adding it into a string,
  482. because operands may contain other tai that will also write things out
  483. (and their output must come after everything that was processed in this
  484. instruction, such as its opcode or previous operands) }
  485. if owner.fdecllevel=0 then
  486. owner.writer.AsmWrite(#9);
  487. sep:=' ';
  488. opdone:=false;
  489. done:=false;
  490. opstart:=0;
  491. nested:=false;
  492. case op of
  493. la_type:
  494. begin
  495. owner.writer.AsmWrite(llvmtypeidentifier(taillvm(hp).oper[0]^.def));
  496. owner.writer.AsmWrite(' = type ');
  497. owner.writer.AsmWrite(llvmencodetypedecl(taillvm(hp).oper[0]^.def));
  498. done:=true;
  499. end;
  500. la_asmblock:
  501. begin
  502. owner.writer.AsmWrite('call void asm sideeffect "');
  503. owner.WriteFunctionInlineAsmList(taillvm(hp).oper[0]^.asmlist);
  504. owner.writer.AsmWrite('","');
  505. { we pass all accessed local variables as in/out address parameters,
  506. since we don't analyze the assembly code to determine what exactly
  507. happens to them; this is also compatible with the regular code
  508. generators, which always place local place local variables
  509. accessed from assembly code in memory }
  510. for i:=0 to taillvm(hp).oper[1]^.paras.Count-1 do
  511. begin
  512. owner.writer.AsmWrite('=*m,');
  513. end;
  514. owner.writer.AsmWrite('~{memory},~{fpsr},~{flags}');
  515. WriteAsmRegisterAllocationClobbers(taillvm(hp).oper[0]^.asmlist);
  516. owner.writer.AsmWrite('"');
  517. writeparas(taillvm(hp).oper[1]^.paras);
  518. done:=true;
  519. end;
  520. la_load,
  521. la_getelementptr:
  522. begin
  523. if (taillvm(hp).oper[0]^.typ<>top_reg) or
  524. (taillvm(hp).oper[0]^.reg<>NR_NO) then
  525. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[0]^,false)+' = ')
  526. else
  527. nested:=true;
  528. opstart:=1;
  529. owner.writer.AsmWrite(getopcodestr(taillvm(hp)));
  530. opdone:=true;
  531. if nested then
  532. owner.writer.AsmWrite(' (')
  533. else
  534. owner.writer.AsmWrite(' ');
  535. { can't just dereference the type, because it may be an
  536. implicit pointer type such as a class -> resort to string
  537. manipulation... Not very clean :( }
  538. tmpstr:=llvmencodetypename(taillvm(hp).spilling_get_reg_type(0));
  539. if op=la_getelementptr then
  540. begin
  541. if tmpstr[length(tmpstr)]<>'*' then
  542. begin
  543. writeln(tmpstr);
  544. internalerror(2016071101);
  545. end
  546. else
  547. setlength(tmpstr,length(tmpstr)-1);
  548. end;
  549. owner.writer.AsmWrite(tmpstr);
  550. owner.writer.AsmWrite(',');
  551. end;
  552. la_ret, la_br, la_switch, la_indirectbr,
  553. la_resume,
  554. la_unreachable,
  555. la_store,
  556. la_fence,
  557. la_cmpxchg,
  558. la_atomicrmw,
  559. la_catch,
  560. la_filter,
  561. la_cleanup:
  562. begin
  563. { instructions that never have a result }
  564. end;
  565. la_call,
  566. la_invoke:
  567. begin
  568. if taillvm(hp).oper[1]^.reg<>NR_NO then
  569. owner.writer.AsmWrite(getregisterstring(taillvm(hp).oper[1]^.reg)+' = ');
  570. opstart:=2;
  571. owner.writer.AsmWrite(getopcodestr(taillvm(hp)));
  572. tmpstr:=llvm_callingconvention_name(taillvm(hp).oper[2]^.callingconvention);
  573. if tmpstr<>'' then
  574. begin
  575. owner.writer.AsmWrite(' ');
  576. owner.writer.AsmWrite(tmpstr);
  577. end;
  578. opdone:=true;
  579. tmpstr:=llvmencodetypename(taillvm(hp).oper[3]^.def);
  580. if tmpstr[length(tmpstr)]<>'*' then
  581. begin
  582. writeln(tmpstr);
  583. internalerror(2016071102);
  584. end
  585. else
  586. setlength(tmpstr,length(tmpstr)-1);
  587. owner.writer.AsmWrite(tmpstr);
  588. opstart:=4;
  589. end;
  590. la_blockaddress:
  591. begin
  592. { nested -> no type }
  593. if owner.fdecllevel = 0 then
  594. begin
  595. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[0]^,false));
  596. owner.writer.AsmWrite(' ');
  597. end;
  598. owner.writer.AsmWrite('blockaddress(');
  599. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[1]^,false));
  600. { getopstr would add a "label" qualifier, which blockaddress does
  601. not want }
  602. owner.writer.AsmWrite(',%');
  603. with taillvm(hp).oper[2]^ do
  604. begin
  605. if (typ<>top_ref) or
  606. (ref^.refaddr<>addr_full) then
  607. internalerror(2016112001);
  608. owner.writer.AsmWrite(ref^.symbol.name);
  609. end;
  610. nested:=true;
  611. done:=true;
  612. end;
  613. la_alloca:
  614. begin
  615. owner.writer.AsmWrite(getreferencestring(taillvm(hp).oper[0]^.ref^,false)+' = ');
  616. sep:=' ';
  617. opstart:=1;
  618. end;
  619. la_trunc, la_zext, la_sext, la_fptrunc, la_fpext,
  620. la_fptoui, la_fptosi, la_uitofp, la_sitofp,
  621. la_ptrtoint, la_inttoptr,
  622. la_bitcast:
  623. begin
  624. { destination can be empty in case of nested constructs, or
  625. data initialisers }
  626. if (taillvm(hp).oper[0]^.typ<>top_reg) or
  627. (taillvm(hp).oper[0]^.reg<>NR_NO) then
  628. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[0]^,false)+' = ')
  629. else
  630. nested:=true;
  631. owner.writer.AsmWrite(getopcodestr(taillvm(hp)));
  632. if not nested then
  633. owner.writer.AsmWrite(' ')
  634. else
  635. owner.writer.AsmWrite(' (');
  636. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[1]^,false));
  637. { if there's a tai operand, its def is used instead of an
  638. explicit def operand }
  639. if taillvm(hp).ops=4 then
  640. begin
  641. owner.writer.AsmWrite(' ');
  642. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[2]^,false));
  643. opstart:=3;
  644. end
  645. else
  646. opstart:=2;
  647. owner.writer.AsmWrite(' to ');
  648. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[opstart]^,false));
  649. done:=true;
  650. end
  651. else
  652. begin
  653. if (taillvm(hp).oper[0]^.typ<>top_reg) or
  654. (taillvm(hp).oper[0]^.reg<>NR_NO) then
  655. begin
  656. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[0]^,true)+' = ');
  657. end
  658. else
  659. nested:=true;
  660. sep:=' ';
  661. opstart:=1
  662. end;
  663. end;
  664. { process operands }
  665. if not done then
  666. begin
  667. if not opdone then
  668. begin
  669. owner.writer.AsmWrite(getopcodestr(taillvm(hp)));
  670. if nested then
  671. owner.writer.AsmWrite(' (');
  672. end;
  673. if taillvm(hp).ops<>0 then
  674. begin
  675. for i:=opstart to taillvm(hp).ops-1 do
  676. begin
  677. owner.writer.AsmWrite(sep);
  678. { special invoke interjections: "to label X unwind label Y" }
  679. if (op=la_invoke) then
  680. case i of
  681. 6: owner.writer.AsmWrite('to ');
  682. 7: owner.writer.AsmWrite('unwind ');
  683. end;
  684. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[i]^,op in [la_load,la_store]));
  685. if (taillvm(hp).oper[i]^.typ in [top_def,top_cond,top_fpcond]) or
  686. (op in [la_call,la_invoke,la_landingpad,la_catch,la_filter,la_cleanup]) then
  687. sep :=' '
  688. else
  689. sep:=', ';
  690. end;
  691. end;
  692. end;
  693. if op=la_alloca then
  694. owner.writer.AsmWrite(getreferencealignstring(taillvm(hp).oper[0]^.ref^));
  695. if nested then
  696. owner.writer.AsmWrite(')')
  697. else if owner.fdecllevel=0 then
  698. owner.writer.AsmLn;
  699. end;
  700. function TLLVMInstrWriter.getopcodestr(hp: taillvm): TSymStr;
  701. begin
  702. result:=llvm_op2str[hp.llvmopcode];
  703. case hp.llvmopcode of
  704. la_load:
  705. begin
  706. if vol_read in hp.oper[2]^.ref^.volatility then
  707. result:=result+' volatile';
  708. end;
  709. la_store:
  710. begin
  711. if vol_write in hp.oper[3]^.ref^.volatility then
  712. result:=result+' volatile';
  713. end;
  714. else
  715. ;
  716. end;
  717. end;
  718. {****************************************************************************}
  719. { LLVM Assembler writer }
  720. {****************************************************************************}
  721. destructor TLLVMAssember.Destroy;
  722. begin
  723. InstrWriter.free;
  724. ffuncinlasmdecorator.free;
  725. inherited destroy;
  726. end;
  727. procedure TLLVMAssember.WriteTree(p:TAsmList);
  728. var
  729. hp : tai;
  730. InlineLevel : cardinal;
  731. asmblock: boolean;
  732. do_line : boolean;
  733. replaceforbidden: boolean;
  734. begin
  735. if not assigned(p) then
  736. exit;
  737. replaceforbidden:=asminfo^.dollarsign<>'$';
  738. InlineLevel:=0;
  739. asmblock:=false;
  740. { lineinfo is only needed for al_procedures (PFV) }
  741. do_line:=(cs_asm_source in current_settings.globalswitches) or
  742. ((cs_lineinfo in current_settings.moduleswitches)
  743. and (p=current_asmdata.asmlists[al_procedures]));
  744. hp:=tai(p.first);
  745. while assigned(hp) do
  746. begin
  747. prefetch(pointer(hp.next)^);
  748. if not(hp.typ in SkipLineInfo) then
  749. begin
  750. current_filepos:=tailineinfo(hp).fileinfo;
  751. { no line info for inlined code }
  752. if do_line and (inlinelevel=0) then
  753. WriteSourceLine(hp as tailineinfo);
  754. end;
  755. WriteTai(replaceforbidden, do_line, false, InlineLevel, asmblock, hp);
  756. hp:=tai(hp.next);
  757. end;
  758. end;
  759. procedure TLLVMAssember.WriteExtraHeader;
  760. begin
  761. writer.AsmWrite('target datalayout = "');
  762. writer.AsmWrite(target_info.llvmdatalayout);
  763. writer.AsmWriteln('"');
  764. writer.AsmWrite('target triple = "');
  765. writer.AsmWrite(targettriplet(triplet_llvm));
  766. writer.AsmWriteln('"');
  767. end;
  768. procedure TLLVMAssember.WriteExtraFooter;
  769. begin
  770. end;
  771. procedure TLLVMAssember.WriteInstruction(hp: tai);
  772. begin
  773. end;
  774. procedure TLLVMAssember.WriteLlvmInstruction(hp: tai);
  775. begin
  776. InstrWriter.WriteInstruction(hp);
  777. end;
  778. procedure TLLVMAssember.WriteRealConst(hp: tai_realconst; do_line: boolean);
  779. begin
  780. if fdecllevel=0 then
  781. begin
  782. case tai_realconst(hp).realtyp of
  783. aitrealconst_s32bit:
  784. writer.AsmWriteLn(asminfo^.comment+'value: '+single2str(tai_realconst(hp).value.s32val));
  785. aitrealconst_s64bit:
  786. writer.AsmWriteLn(asminfo^.comment+'value: '+double2str(tai_realconst(hp).value.s64val));
  787. {$if defined(cpuextended) and (defined(FPC_HAS_TYPE_EXTENDED) or defined(FPC_SOFT_FPUX80))}
  788. { can't write full 80 bit floating point constants yet on non-x86 }
  789. aitrealconst_s80bit:
  790. writer.AsmWriteLn(asminfo^.comment+'value: '+extended2str(tai_realconst(hp).value.s80val));
  791. {$endif cpuextended}
  792. aitrealconst_s64comp:
  793. writer.AsmWriteLn(asminfo^.comment+'value: '+extended2str(tai_realconst(hp).value.s64compval));
  794. else
  795. internalerror(2014050603);
  796. end;
  797. internalerror(2016120202);
  798. end;
  799. case hp.realtyp of
  800. aitrealconst_s32bit:
  801. writer.AsmWrite(llvmdoubletostr(hp.value.s32val));
  802. aitrealconst_s64bit:
  803. writer.AsmWriteln(llvmdoubletostr(hp.value.s64val));
  804. {$if defined(cpuextended) and (defined(FPC_HAS_TYPE_EXTENDED) or defined(FPC_SOFT_FPUX80))}
  805. aitrealconst_s80bit:
  806. writer.AsmWrite(llvmextendedtostr(hp.value.s80val));
  807. {$endif defined(cpuextended)}
  808. aitrealconst_s64comp:
  809. { handled as int64 most of the time in llvm }
  810. writer.AsmWrite(tostr(round(hp.value.s64compval)));
  811. else
  812. internalerror(2014062401);
  813. end;
  814. end;
  815. procedure TLLVMAssember.WriteOrdConst(hp: tai_const);
  816. var
  817. consttyp: taiconst_type;
  818. begin
  819. if fdecllevel=0 then
  820. internalerror(2016120203);
  821. consttyp:=hp.consttype;
  822. case consttyp of
  823. aitconst_got,
  824. aitconst_gotoff_symbol,
  825. aitconst_uleb128bit,
  826. aitconst_sleb128bit,
  827. aitconst_rva_symbol,
  828. aitconst_secrel32_symbol,
  829. aitconst_darwin_dwarf_delta32,
  830. aitconst_darwin_dwarf_delta64,
  831. aitconst_half16bit,
  832. aitconst_gs:
  833. internalerror(2014052901);
  834. aitconst_128bit,
  835. aitconst_64bit,
  836. aitconst_32bit,
  837. aitconst_16bit,
  838. aitconst_8bit,
  839. aitconst_16bit_unaligned,
  840. aitconst_32bit_unaligned,
  841. aitconst_64bit_unaligned:
  842. begin
  843. if fdecllevel=0 then
  844. writer.AsmWrite(asminfo^.comment);
  845. { can't have compile-time differences between symbols; these are
  846. normally for PIC, but llvm takes care of that for us }
  847. if assigned(hp.endsym) then
  848. internalerror(2014052902);
  849. if assigned(hp.sym) then
  850. begin
  851. writer.AsmWrite(LlvmAsmSymName(hp.sym));
  852. { can't have offsets }
  853. if hp.value<>0 then
  854. if fdecllevel<>0 then
  855. internalerror(2014052903)
  856. else
  857. writer.AsmWrite(' -- symbol offset: ' + tostr(hp.value));
  858. end
  859. else if hp.value=0 then
  860. writer.AsmWrite('zeroinitializer')
  861. else
  862. writer.AsmWrite(tostr(hp.value));
  863. {
  864. // activate in case of debugging IE 2016120203
  865. if fdecllevel=0 then
  866. writer.AsmLn;
  867. }
  868. end;
  869. else
  870. internalerror(2007042504);
  871. end;
  872. end;
  873. procedure TLLVMAssember.WriteTai(const replaceforbidden: boolean; const do_line, inmetadata: boolean; var InlineLevel: cardinal; var asmblock: boolean; var hp: tai);
  874. procedure WriteLinkageVibilityFlags(bind: TAsmSymBind; is_definition: boolean);
  875. begin
  876. { re-declaration of a symbol defined in the current module (in an
  877. assembler block) }
  878. if not is_definition then
  879. begin
  880. writer.AsmWrite(' external');
  881. exit;
  882. end;
  883. case bind of
  884. AB_EXTERNAL,
  885. AB_EXTERNAL_INDIRECT:
  886. writer.AsmWrite(' external');
  887. AB_COMMON:
  888. writer.AsmWrite(' common');
  889. AB_LOCAL:
  890. writer.AsmWrite(' internal');
  891. AB_GLOBAL,
  892. AB_INDIRECT:
  893. ;
  894. AB_WEAK_EXTERNAL:
  895. writer.AsmWrite(' extern_weak');
  896. AB_PRIVATE_EXTERN:
  897. writer.AsmWrite(' hidden')
  898. else
  899. internalerror(2014020104);
  900. end;
  901. end;
  902. procedure WriteFunctionFlags(pd: tprocdef);
  903. begin
  904. { function attributes }
  905. if (pos('FPC_SETJMP',upper(pd.mangledname))<>0) or
  906. (pd.mangledname=(target_info.cprefix+'setjmp')) then
  907. writer.AsmWrite(' returns_twice');
  908. if po_inline in pd.procoptions then
  909. writer.AsmWrite(' inlinehint')
  910. else if (po_noinline in pd.procoptions) or
  911. (pio_inline_forbidden in pd.implprocoptions) then
  912. writer.AsmWrite(' noinline');
  913. { ensure that functions that happen to have the same name as a
  914. standard C library function, but which are implemented in Pascal,
  915. are not considered to have the same semantics as the C function with
  916. the same name }
  917. if not(po_external in pd.procoptions) then
  918. writer.AsmWrite(' nobuiltin');
  919. if po_noreturn in pd.procoptions then
  920. writer.AsmWrite(' noreturn');
  921. if pio_thunk in pd.implprocoptions then
  922. writer.AsmWrite(' "thunk"');
  923. if llvmflag_null_pointer_valid in llvmversion_properties[current_settings.llvmversion] then
  924. writer.AsmWrite(' "null-pointer-is-valid"="true"')
  925. else if llvmflag_null_pointer_valid_new in llvmversion_properties[current_settings.llvmversion] then
  926. writer.AsmWrite(' null_pointer_is_valid');
  927. if not(pio_fastmath in pd.implprocoptions) then
  928. writer.AsmWrite(' strictfp');
  929. end;
  930. procedure WriteTypedConstData(hp: tai_abstracttypedconst; metadata: boolean);
  931. var
  932. p: tai_abstracttypedconst;
  933. pval: tai;
  934. defstr: TSymStr;
  935. first, gotstring: boolean;
  936. begin
  937. if hp.def<>llvm_metadatatype then
  938. begin
  939. defstr:=llvmencodetypename(hp.def)
  940. end
  941. else
  942. begin
  943. defstr:=''
  944. end;
  945. { write the struct, array or simple type }
  946. case hp.adetyp of
  947. tck_record:
  948. begin
  949. if not(metadata) then
  950. begin
  951. writer.AsmWrite(defstr);
  952. if not(df_llvm_no_struct_packing in hp.def.defoptions) then
  953. writer.AsmWrite(' <{')
  954. else
  955. writer.AsmWrite(' {')
  956. end
  957. else
  958. begin
  959. writer.AsmWrite(' !{');
  960. end;
  961. first:=true;
  962. for p in tai_aggregatetypedconst(hp) do
  963. begin
  964. if not first then
  965. writer.AsmWrite(', ')
  966. else
  967. first:=false;
  968. WriteTypedConstData(p,metadata);
  969. end;
  970. if not(metadata) then
  971. begin
  972. if not(df_llvm_no_struct_packing in hp.def.defoptions) then
  973. writer.AsmWrite(' }>')
  974. else
  975. writer.AsmWrite(' }')
  976. end
  977. else
  978. begin
  979. writer.AsmWrite(' }');
  980. end;
  981. end;
  982. tck_array:
  983. begin
  984. if not(metadata) then
  985. begin
  986. writer.AsmWrite(defstr);
  987. end;
  988. first:=true;
  989. gotstring:=false;
  990. for p in tai_aggregatetypedconst(hp) do
  991. begin
  992. if not first then
  993. writer.AsmWrite(', ')
  994. else
  995. begin
  996. writer.AsmWrite(' ');
  997. if (tai_abstracttypedconst(p).adetyp=tck_simple) and
  998. (tai_simpletypedconst(p).val.typ=ait_string) then
  999. begin
  1000. gotstring:=true;
  1001. end
  1002. else
  1003. begin
  1004. if not metadata then
  1005. begin
  1006. writer.AsmWrite('[');
  1007. end
  1008. else
  1009. begin
  1010. writer.AsmWrite('!{');
  1011. end;
  1012. end;
  1013. first:=false;
  1014. end;
  1015. { cannot concat strings and other things }
  1016. if gotstring and
  1017. not metadata and
  1018. ((tai_abstracttypedconst(p).adetyp<>tck_simple) or
  1019. (tai_simpletypedconst(p).val.typ<>ait_string)) then
  1020. internalerror(2014062701);
  1021. WriteTypedConstData(p,metadata);
  1022. end;
  1023. if not gotstring then
  1024. begin
  1025. if not metadata then
  1026. begin
  1027. writer.AsmWrite(']');
  1028. end
  1029. else
  1030. begin
  1031. writer.AsmWrite('}');
  1032. end;
  1033. end;
  1034. end;
  1035. tck_simple:
  1036. begin
  1037. pval:=tai_simpletypedconst(hp).val;
  1038. if (pval.typ<>ait_string) and
  1039. (defstr<>'') then
  1040. begin
  1041. writer.AsmWrite(defstr);
  1042. writer.AsmWrite(' ');
  1043. end;
  1044. WriteTai(replaceforbidden,do_line,metadata,InlineLevel,asmblock,pval);
  1045. end;
  1046. end;
  1047. end;
  1048. procedure WriteLlvmMetadataNode(hp: tai_llvmbasemetadatanode);
  1049. begin
  1050. { must only appear at the top level }
  1051. if fdecllevel<>0 then
  1052. internalerror(2019050111);
  1053. writer.AsmWrite('!');
  1054. writer.AsmWrite(tai_llvmbasemetadatanode(hp).name);
  1055. writer.AsmWrite(' =');
  1056. inc(fdecllevel);
  1057. WriteTypedConstData(hp,true);
  1058. writer.AsmLn;
  1059. dec(fdecllevel);
  1060. end;
  1061. var
  1062. hp2: tai;
  1063. s: string;
  1064. sstr: TSymStr;
  1065. i: longint;
  1066. ch: ansichar;
  1067. begin
  1068. case hp.typ of
  1069. ait_align,
  1070. ait_section :
  1071. begin
  1072. { ignore, specified as part of declarations -- don't write
  1073. comment, because could appear in the middle of an aggregate
  1074. constant definition }
  1075. end;
  1076. ait_datablock :
  1077. begin
  1078. writer.AsmWrite(asminfo^.comment);
  1079. writer.AsmWriteln('datablock');
  1080. end;
  1081. ait_const:
  1082. begin
  1083. WriteOrdConst(tai_const(hp));
  1084. end;
  1085. ait_realconst :
  1086. begin
  1087. WriteRealConst(tai_realconst(hp), do_line);
  1088. end;
  1089. ait_string :
  1090. begin
  1091. if fdecllevel=0 then
  1092. internalerror(2016120201);
  1093. if not inmetadata then
  1094. writer.AsmWrite('c"')
  1095. else
  1096. writer.AsmWrite('!"');
  1097. for i:=1 to tai_string(hp).len do
  1098. begin
  1099. ch:=tai_string(hp).str[i-1];
  1100. case ch of
  1101. #0, {This can't be done by range, because a bug in FPC}
  1102. #1..#31,
  1103. #128..#255,
  1104. '"',
  1105. '\' : s:='\'+hexStr(ord(ch),2);
  1106. else
  1107. s:=ch;
  1108. end;
  1109. writer.AsmWrite(s);
  1110. end;
  1111. writer.AsmWrite('"');
  1112. end;
  1113. ait_label :
  1114. begin
  1115. if not asmblock and
  1116. (tai_label(hp).labsym.is_used) then
  1117. begin
  1118. if (tai_label(hp).labsym.bind=AB_PRIVATE_EXTERN) then
  1119. begin
  1120. { should be emitted as part of the variable/function def }
  1121. internalerror(2013010703);
  1122. end;
  1123. if tai_label(hp).labsym.bind in [AB_GLOBAL, AB_PRIVATE_EXTERN] then
  1124. begin
  1125. { should be emitted as part of the variable/function def }
  1126. //internalerror(2013010704);
  1127. writer.AsmWriteln(asminfo^.comment+'global/privateextern label: '+tai_label(hp).labsym.name);
  1128. end;
  1129. if replaceforbidden then
  1130. writer.AsmWrite(ApplyAsmSymbolRestrictions(tai_label(hp).labsym.name))
  1131. else
  1132. writer.AsmWrite(tai_label(hp).labsym.name);
  1133. writer.AsmWriteLn(':');
  1134. end;
  1135. end;
  1136. ait_symbol :
  1137. begin
  1138. if fdecllevel=0 then
  1139. writer.AsmWrite(asminfo^.comment);
  1140. writer.AsmWriteln(LlvmAsmSymName(tai_symbol(hp).sym));
  1141. { todo }
  1142. if tai_symbol(hp).has_value then
  1143. internalerror(2014062402);
  1144. end;
  1145. ait_llvmdecl:
  1146. begin
  1147. if taillvmdecl(hp).def.typ=procdef then
  1148. begin
  1149. if not(ldf_definition in taillvmdecl(hp).flags) then
  1150. begin
  1151. writer.AsmWrite('declare');
  1152. writer.AsmWrite(llvmencodeproctype(tprocdef(taillvmdecl(hp).def), taillvmdecl(hp).namesym.name, lpd_decl));
  1153. WriteFunctionFlags(tprocdef(taillvmdecl(hp).def));
  1154. writer.AsmLn;
  1155. end
  1156. else
  1157. begin
  1158. writer.AsmWrite('define');
  1159. if ldf_weak in taillvmdecl(hp).flags then
  1160. writer.AsmWrite(' weak');
  1161. WriteLinkageVibilityFlags(taillvmdecl(hp).namesym.bind, true);
  1162. writer.AsmWrite(llvmencodeproctype(tprocdef(taillvmdecl(hp).def), '', lpd_def));
  1163. WriteFunctionFlags(tprocdef(taillvmdecl(hp).def));
  1164. if assigned(tprocdef(taillvmdecl(hp).def).personality) then
  1165. begin
  1166. writer.AsmWrite(' personality i8* bitcast (');
  1167. writer.AsmWrite(llvmencodeproctype(tprocdef(taillvmdecl(hp).def).personality, '', lpd_procvar));
  1168. writer.AsmWrite('* ');
  1169. writer.AsmWrite(llvmmangledname(tprocdef(taillvmdecl(hp).def).personality.mangledname));
  1170. writer.AsmWrite(' to i8*)');
  1171. end;
  1172. writer.AsmWriteln(' {');
  1173. end;
  1174. end
  1175. else
  1176. begin
  1177. writer.AsmWrite(LlvmAsmSymName(taillvmdecl(hp).namesym));
  1178. writer.AsmWrite(' =');
  1179. if ldf_weak in taillvmdecl(hp).flags then
  1180. writer.AsmWrite(' weak');
  1181. if ldf_appending in taillvmdecl(hp).flags then
  1182. writer.AsmWrite(' appending');
  1183. WriteLinkageVibilityFlags(taillvmdecl(hp).namesym.bind, ldf_definition in taillvmdecl(hp).flags);
  1184. writer.AsmWrite(' ');
  1185. if (ldf_tls in taillvmdecl(hp).flags) then
  1186. writer.AsmWrite('thread_local ');
  1187. if ldf_unnamed_addr in taillvmdecl(hp).flags then
  1188. writer.AsmWrite('unnamed_addr ');
  1189. if taillvmdecl(hp).sec in [sec_rodata,sec_rodata_norel] then
  1190. writer.AsmWrite('constant ')
  1191. else
  1192. writer.AsmWrite('global ');
  1193. if not assigned(taillvmdecl(hp).initdata) then
  1194. begin
  1195. writer.AsmWrite(llvmencodetypename(taillvmdecl(hp).def));
  1196. if ldf_definition in taillvmdecl(hp).flags then
  1197. writer.AsmWrite(' zeroinitializer');
  1198. end
  1199. else
  1200. begin
  1201. inc(fdecllevel);
  1202. { can't have an external symbol with initialisation data }
  1203. if taillvmdecl(hp).namesym.bind in [AB_EXTERNAL, AB_WEAK_EXTERNAL] then
  1204. internalerror(2014052905);
  1205. { bitcast initialisation data to the type of the constant }
  1206. { write initialisation data }
  1207. hp2:=tai(taillvmdecl(hp).initdata.first);
  1208. while assigned(hp2) do
  1209. begin
  1210. WriteTai(replaceforbidden,do_line,inmetadata,InlineLevel,asmblock,hp2);
  1211. hp2:=tai(hp2.next);
  1212. end;
  1213. dec(fdecllevel);
  1214. end;
  1215. { custom section name? }
  1216. case taillvmdecl(hp).sec of
  1217. sec_user:
  1218. begin
  1219. writer.AsmWrite(', section "');
  1220. writer.AsmWrite(taillvmdecl(hp).secname);
  1221. writer.AsmWrite('"');
  1222. end;
  1223. low(TObjCAsmSectionType)..high(TObjCAsmSectionType):
  1224. begin
  1225. writer.AsmWrite(', section "');
  1226. writer.AsmWrite(objc_section_name(taillvmdecl(hp).sec));
  1227. writer.AsmWrite('"');
  1228. end;
  1229. else
  1230. ;
  1231. end;
  1232. { sections whose name starts with 'llvm.' are for LLVM
  1233. internal use and don't have an alignment }
  1234. if pos('llvm.',taillvmdecl(hp).secname)<>1 then
  1235. begin
  1236. { alignment }
  1237. writer.AsmWrite(', align ');
  1238. writer.AsmWriteln(tostr(taillvmdecl(hp).alignment));
  1239. end
  1240. else
  1241. writer.AsmLn;
  1242. end;
  1243. end;
  1244. ait_llvmalias:
  1245. begin
  1246. writer.AsmWrite(LlvmAsmSymName(taillvmalias(hp).newsym));
  1247. writer.AsmWrite(' = alias ');
  1248. WriteLinkageVibilityFlags(taillvmalias(hp).bind, true);
  1249. if taillvmalias(hp).def.typ=procdef then
  1250. sstr:=llvmencodeproctype(tabstractprocdef(taillvmalias(hp).def), '', lpd_alias)
  1251. else
  1252. sstr:=llvmencodetypename(taillvmalias(hp).def);
  1253. writer.AsmWrite(sstr);
  1254. writer.AsmWrite(', ');
  1255. writer.AsmWrite(sstr);
  1256. writer.AsmWrite('* ');
  1257. writer.AsmWriteln(LlvmAsmSymName(taillvmalias(hp).oldsym));
  1258. end;
  1259. ait_llvmmetadatanode:
  1260. begin
  1261. WriteLlvmMetadataNode(tai_llvmbasemetadatanode(hp));
  1262. end;
  1263. ait_llvmmetadatareftypedconst:
  1264. begin
  1265. { must only appear as an element in a typed const }
  1266. if fdecllevel=0 then
  1267. internalerror(2019050110);
  1268. writer.AsmWrite('!');
  1269. writer.AsmWrite(tai_llvmbasemetadatanode(tai_llvmmetadatareftypedconst(hp).val).name);
  1270. end;
  1271. ait_llvmmetadatarefoperand:
  1272. begin
  1273. { must only appear as an operand }
  1274. if fdecllevel=0 then
  1275. internalerror(2019050101);
  1276. writer.AsmWrite('!');
  1277. writer.AsmWrite(tai_llvmmetadatareferenceoperand(hp).id);
  1278. writer.AsmWrite(' !');
  1279. writer.AsmWrite(tai_llvmmetadatareferenceoperand(hp).value.name);
  1280. end;
  1281. ait_symbolpair:
  1282. begin
  1283. { should be emitted as part of the symbol def }
  1284. internalerror(2013010708);
  1285. end;
  1286. ait_symbol_end :
  1287. begin
  1288. if tai_symbol_end(hp).sym.typ=AT_FUNCTION then
  1289. writer.AsmWriteln('}')
  1290. else
  1291. writer.AsmWriteln('; ait_symbol_end error, should not be generated');
  1292. // internalerror(2013010711);
  1293. end;
  1294. ait_instruction :
  1295. begin
  1296. WriteInstruction(hp);
  1297. end;
  1298. ait_llvmins:
  1299. begin
  1300. WriteLlvmInstruction(hp);
  1301. end;
  1302. ait_stab :
  1303. begin
  1304. internalerror(2013010712);
  1305. end;
  1306. ait_force_line,
  1307. ait_function_name :
  1308. ;
  1309. ait_cutobject :
  1310. begin
  1311. end;
  1312. ait_marker :
  1313. case
  1314. tai_marker(hp).kind of
  1315. mark_NoLineInfoStart:
  1316. inc(InlineLevel);
  1317. mark_NoLineInfoEnd:
  1318. dec(InlineLevel);
  1319. { these cannot be nested }
  1320. mark_AsmBlockStart:
  1321. asmblock:=true;
  1322. mark_AsmBlockEnd:
  1323. asmblock:=false;
  1324. else
  1325. ;
  1326. end;
  1327. ait_directive :
  1328. begin
  1329. { CPU directive is commented out for the LLVM }
  1330. if tai_directive(hp).directive=asd_cpu then
  1331. writer.AsmWrite(asminfo^.comment);
  1332. WriteDirectiveName(tai_directive(hp).directive);
  1333. if tai_directive(hp).name <>'' then
  1334. writer.AsmWrite(tai_directive(hp).name);
  1335. if fdecllevel<>0 then
  1336. internalerror(2015090602);
  1337. writer.AsmLn;
  1338. end;
  1339. ait_seh_directive :
  1340. begin
  1341. internalerror(2013010713);
  1342. end;
  1343. ait_typedconst:
  1344. begin
  1345. WriteTypedConstData(tai_abstracttypedconst(hp),false);
  1346. end
  1347. else
  1348. if not WriteComments(hp) then
  1349. internalerror(2019012010);
  1350. end;
  1351. end;
  1352. constructor TLLVMAssember.CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter, smart: boolean);
  1353. begin
  1354. inherited;
  1355. InstrWriter:=TLLVMInstrWriter.create(self);
  1356. end;
  1357. procedure TLLVMAssember.WriteDirectiveName(dir: TAsmDirective);
  1358. begin
  1359. writer.AsmWrite('.'+directivestr[dir]+' ');
  1360. end;
  1361. procedure TLLVMAssember.WriteAsmList;
  1362. var
  1363. hal : tasmlisttype;
  1364. a: TExternalAssembler;
  1365. decorator: TLLVMModuleInlineAssemblyDecorator;
  1366. begin
  1367. WriteExtraHeader;
  1368. for hal:=low(TasmlistType) to high(TasmlistType) do
  1369. begin
  1370. if not assigned(current_asmdata.asmlists[hal]) or
  1371. current_asmdata.asmlists[hal].Empty then
  1372. continue;
  1373. writer.AsmWriteLn(asminfo^.comment+'Begin asmlist '+AsmlistTypeStr[hal]);
  1374. if not(hal in [al_pure_assembler,al_dwarf_frame]) then
  1375. writetree(current_asmdata.asmlists[hal])
  1376. else
  1377. begin
  1378. { write routines using the target-specific external assembler
  1379. writer, filtered using the LLVM module-level assembly
  1380. decorator }
  1381. decorator:=TLLVMModuleInlineAssemblyDecorator.Create;
  1382. writer.decorator:=decorator;
  1383. a:=GetExternalGnuAssemblerWithAsmInfoWriter(asminfo,writer);
  1384. a.WriteTree(current_asmdata.asmlists[hal]);
  1385. writer.decorator:=nil;
  1386. decorator.free;
  1387. a.free;
  1388. end;
  1389. writer.AsmWriteLn(asminfo^.comment+'End asmlist '+AsmlistTypeStr[hal]);
  1390. end;
  1391. writer.AsmLn;
  1392. end;
  1393. procedure TLLVMAssember.WriteFunctionInlineAsmList(list: tasmlist);
  1394. var
  1395. a: TExternalAssembler;
  1396. begin
  1397. if not assigned(ffuncinlasmdecorator) then
  1398. ffuncinlasmdecorator:=TLLVMFunctionInlineAssemblyDecorator.create;
  1399. if assigned(writer.decorator) then
  1400. internalerror(2016110201);
  1401. writer.decorator:=ffuncinlasmdecorator;
  1402. a:=GetExternalGnuAssemblerWithAsmInfoWriter(asminfo,writer);
  1403. a.WriteTree(list);
  1404. a.free;
  1405. writer.decorator:=nil;
  1406. end;
  1407. {****************************************************************************}
  1408. { LLVM Instruction Writer }
  1409. {****************************************************************************}
  1410. constructor TLLVMInstrWriter.create(_owner: TLLVMAssember);
  1411. begin
  1412. inherited create;
  1413. owner := _owner;
  1414. end;
  1415. {****************************************************************************}
  1416. { clang Assember }
  1417. {****************************************************************************}
  1418. function TLLVMClangAssember.MakeCmdLine: TCmdStr;
  1419. var
  1420. wpostr,
  1421. optstr: TCmdStr;
  1422. begin
  1423. wpostr:='';
  1424. if cs_lto in current_settings.moduleswitches then
  1425. begin
  1426. case fnextpass of
  1427. 0:
  1428. begin
  1429. ObjFileName:=ChangeFileExt(ObjFileName,'.bc');
  1430. wpostr:=' -flto';
  1431. end;
  1432. 1:
  1433. begin
  1434. ObjFileName:=ChangeFileExt(ObjFileName,'.o');
  1435. end;
  1436. end;
  1437. end;
  1438. result:=inherited;
  1439. if cs_opt_level3 in current_settings.optimizerswitches then
  1440. optstr:='-O3'
  1441. else if cs_opt_level2 in current_settings.optimizerswitches then
  1442. optstr:='-O2'
  1443. else if cs_opt_level1 in current_settings.optimizerswitches then
  1444. optstr:='-O1'
  1445. else
  1446. optstr:='-O0';
  1447. optstr:=optstr+wpostr;
  1448. { stack frame elimination }
  1449. if not(cs_opt_stackframe in current_settings.optimizerswitches) then
  1450. optstr:=optstr+' -fno-omit-frame-pointer'
  1451. else
  1452. optstr:=optstr+' -fomit-frame-pointer';
  1453. { fast math }
  1454. if cs_opt_fastmath in current_settings.optimizerswitches then
  1455. optstr:=optstr+' -ffast-math';
  1456. { smart linking }
  1457. if cs_create_smart in current_settings.moduleswitches then
  1458. optstr:=optstr+' -fdata-sections -ffunction-sections';
  1459. { pic }
  1460. if cs_create_pic in current_settings.moduleswitches then
  1461. optstr:=optstr+' -fpic'
  1462. else if not(target_info.system in systems_darwin) then
  1463. optstr:=optstr+' -static'
  1464. else
  1465. optstr:=optstr+' -mdynamic-no-pic';
  1466. if fputypestrllvm[current_settings.fputype]<>'' then
  1467. optstr:=optstr+' -m'+fputypestrllvm[current_settings.fputype];
  1468. { restrict march to aarch64 for now to fix x86_64 compilation failure }
  1469. if (cputypestr[current_settings.cputype]<>'')
  1470. and (target_info.system in [system_aarch64_darwin, system_aarch64_linux]) then
  1471. optstr:=optstr+' -march='+cputypestr[current_settings.cputype];
  1472. replace(result,'$OPT',optstr);
  1473. inc(fnextpass);
  1474. end;
  1475. function TLLVMClangAssember.DoAssemble: boolean;
  1476. begin
  1477. fnextpass:=0;
  1478. result:=inherited;
  1479. end;
  1480. function TLLVMClangAssember.RerunAssembler: boolean;
  1481. begin
  1482. result:=
  1483. (cs_lto in current_settings.moduleswitches) and
  1484. (fnextpass<=1);
  1485. end;
  1486. function TLLVMClangAssember.DoPipe: boolean;
  1487. begin
  1488. result:=
  1489. not(cs_lto in current_settings.moduleswitches) and
  1490. inherited;
  1491. end;
  1492. const
  1493. as_clang_llvm_info : tasminfo =
  1494. (
  1495. id : as_clang_llvm;
  1496. idtxt : 'CLANG-LLVM';
  1497. asmbin : 'clang';
  1498. asmcmd: '-x ir $OPT -target $TRIPLET -c -o $OBJ $ASM $EXTRAOPT';
  1499. supported_targets : [system_x86_64_linux,system_x86_64_darwin,system_aarch64_darwin,system_aarch64_linux,system_arm_linux];
  1500. flags : [af_smartlink_sections,af_llvm];
  1501. labelprefix : 'L';
  1502. labelmaxlen : -1;
  1503. comment : '; ';
  1504. dollarsign: '$';
  1505. );
  1506. begin
  1507. RegisterAssembler(as_clang_llvm_info,TLLVMClangAssember);
  1508. end.