agllvm.pas 59 KB

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