agllvm.pas 60 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759
  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. if llvmflag_load_getelptr_type in llvmversion_properties[current_settings.llvmversion] then
  529. begin
  530. owner.writer.AsmWrite(getopcodestr(taillvm(hp)));
  531. opdone:=true;
  532. if nested then
  533. owner.writer.AsmWrite(' (')
  534. else
  535. owner.writer.AsmWrite(' ');
  536. { can't just dereference the type, because it may be an
  537. implicit pointer type such as a class -> resort to string
  538. manipulation... Not very clean :( }
  539. tmpstr:=llvmencodetypename(taillvm(hp).spilling_get_reg_type(0));
  540. if op=la_getelementptr then
  541. begin
  542. if tmpstr[length(tmpstr)]<>'*' then
  543. begin
  544. writeln(tmpstr);
  545. internalerror(2016071101);
  546. end
  547. else
  548. setlength(tmpstr,length(tmpstr)-1);
  549. end;
  550. owner.writer.AsmWrite(tmpstr);
  551. owner.writer.AsmWrite(',');
  552. end
  553. end;
  554. la_ret, la_br, la_switch, la_indirectbr,
  555. la_resume,
  556. la_unreachable,
  557. la_store,
  558. la_fence,
  559. la_cmpxchg,
  560. la_atomicrmw,
  561. la_catch,
  562. la_filter,
  563. la_cleanup:
  564. begin
  565. { instructions that never have a result }
  566. end;
  567. la_call,
  568. la_invoke:
  569. begin
  570. if taillvm(hp).oper[1]^.reg<>NR_NO then
  571. owner.writer.AsmWrite(getregisterstring(taillvm(hp).oper[1]^.reg)+' = ');
  572. opstart:=2;
  573. if llvmflag_call_no_ptr in llvmversion_properties[current_settings.llvmversion] then
  574. begin
  575. owner.writer.AsmWrite(getopcodestr(taillvm(hp)));
  576. tmpstr:=llvm_callingconvention_name(taillvm(hp).oper[2]^.callingconvention);
  577. if tmpstr<>'' then
  578. begin
  579. owner.writer.AsmWrite(' "');
  580. owner.writer.AsmWrite(tmpstr);
  581. owner.writer.AsmWrite('"');
  582. end;
  583. opdone:=true;
  584. tmpstr:=llvmencodetypename(taillvm(hp).oper[3]^.def);
  585. if tmpstr[length(tmpstr)]<>'*' then
  586. begin
  587. writeln(tmpstr);
  588. internalerror(2016071102);
  589. end
  590. else
  591. setlength(tmpstr,length(tmpstr)-1);
  592. owner.writer.AsmWrite(tmpstr);
  593. opstart:=4;
  594. end;
  595. end;
  596. la_blockaddress:
  597. begin
  598. { nested -> no type }
  599. if owner.fdecllevel = 0 then
  600. begin
  601. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[0]^,false));
  602. owner.writer.AsmWrite(' ');
  603. end;
  604. owner.writer.AsmWrite('blockaddress(');
  605. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[1]^,false));
  606. { getopstr would add a "label" qualifier, which blockaddress does
  607. not want }
  608. owner.writer.AsmWrite(',%');
  609. with taillvm(hp).oper[2]^ do
  610. begin
  611. if (typ<>top_ref) or
  612. (ref^.refaddr<>addr_full) then
  613. internalerror(2016112001);
  614. owner.writer.AsmWrite(ref^.symbol.name);
  615. end;
  616. nested:=true;
  617. done:=true;
  618. end;
  619. la_alloca:
  620. begin
  621. owner.writer.AsmWrite(getreferencestring(taillvm(hp).oper[0]^.ref^,false)+' = ');
  622. sep:=' ';
  623. opstart:=1;
  624. end;
  625. la_trunc, la_zext, la_sext, la_fptrunc, la_fpext,
  626. la_fptoui, la_fptosi, la_uitofp, la_sitofp,
  627. la_ptrtoint, la_inttoptr,
  628. la_bitcast:
  629. begin
  630. { destination can be empty in case of nested constructs, or
  631. data initialisers }
  632. if (taillvm(hp).oper[0]^.typ<>top_reg) or
  633. (taillvm(hp).oper[0]^.reg<>NR_NO) then
  634. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[0]^,false)+' = ')
  635. else
  636. nested:=true;
  637. owner.writer.AsmWrite(getopcodestr(taillvm(hp)));
  638. if not nested then
  639. owner.writer.AsmWrite(' ')
  640. else
  641. owner.writer.AsmWrite(' (');
  642. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[1]^,false));
  643. { if there's a tai operand, its def is used instead of an
  644. explicit def operand }
  645. if taillvm(hp).ops=4 then
  646. begin
  647. owner.writer.AsmWrite(' ');
  648. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[2]^,false));
  649. opstart:=3;
  650. end
  651. else
  652. opstart:=2;
  653. owner.writer.AsmWrite(' to ');
  654. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[opstart]^,false));
  655. done:=true;
  656. end
  657. else
  658. begin
  659. if (taillvm(hp).oper[0]^.typ<>top_reg) or
  660. (taillvm(hp).oper[0]^.reg<>NR_NO) then
  661. begin
  662. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[0]^,true)+' = ');
  663. end
  664. else
  665. nested:=true;
  666. sep:=' ';
  667. opstart:=1
  668. end;
  669. end;
  670. { process operands }
  671. if not done then
  672. begin
  673. if not opdone then
  674. begin
  675. owner.writer.AsmWrite(getopcodestr(taillvm(hp)));
  676. if nested then
  677. owner.writer.AsmWrite(' (');
  678. end;
  679. if taillvm(hp).ops<>0 then
  680. begin
  681. for i:=opstart to taillvm(hp).ops-1 do
  682. begin
  683. owner.writer.AsmWrite(sep);
  684. { special invoke interjections: "to label X unwind label Y" }
  685. if (op=la_invoke) then
  686. case i of
  687. 6: owner.writer.AsmWrite('to ');
  688. 7: owner.writer.AsmWrite('unwind ');
  689. end;
  690. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[i]^,op in [la_load,la_store]));
  691. if (taillvm(hp).oper[i]^.typ in [top_def,top_cond,top_fpcond]) or
  692. (op in [la_call,la_invoke,la_landingpad,la_catch,la_filter,la_cleanup]) then
  693. sep :=' '
  694. else
  695. sep:=', ';
  696. end;
  697. end;
  698. end;
  699. if op=la_alloca then
  700. owner.writer.AsmWrite(getreferencealignstring(taillvm(hp).oper[0]^.ref^));
  701. if nested then
  702. owner.writer.AsmWrite(')')
  703. else if owner.fdecllevel=0 then
  704. owner.writer.AsmLn;
  705. end;
  706. function TLLVMInstrWriter.getopcodestr(hp: taillvm): TSymStr;
  707. begin
  708. result:=llvm_op2str[hp.llvmopcode];
  709. case hp.llvmopcode of
  710. la_load:
  711. begin
  712. if vol_read in hp.oper[2]^.ref^.volatility then
  713. result:=result+' volatile';
  714. end;
  715. la_store:
  716. begin
  717. if vol_write in hp.oper[3]^.ref^.volatility then
  718. result:=result+' volatile';
  719. end;
  720. else
  721. ;
  722. end;
  723. end;
  724. {****************************************************************************}
  725. { LLVM Assembler writer }
  726. {****************************************************************************}
  727. destructor TLLVMAssember.Destroy;
  728. begin
  729. InstrWriter.free;
  730. ffuncinlasmdecorator.free;
  731. inherited destroy;
  732. end;
  733. procedure TLLVMAssember.WriteTree(p:TAsmList);
  734. var
  735. hp : tai;
  736. InlineLevel : cardinal;
  737. asmblock: boolean;
  738. do_line : boolean;
  739. replaceforbidden: boolean;
  740. begin
  741. if not assigned(p) then
  742. exit;
  743. replaceforbidden:=asminfo^.dollarsign<>'$';
  744. InlineLevel:=0;
  745. asmblock:=false;
  746. { lineinfo is only needed for al_procedures (PFV) }
  747. do_line:=(cs_asm_source in current_settings.globalswitches) or
  748. ((cs_lineinfo in current_settings.moduleswitches)
  749. and (p=current_asmdata.asmlists[al_procedures]));
  750. hp:=tai(p.first);
  751. while assigned(hp) do
  752. begin
  753. prefetch(pointer(hp.next)^);
  754. if not(hp.typ in SkipLineInfo) then
  755. begin
  756. current_filepos:=tailineinfo(hp).fileinfo;
  757. { no line info for inlined code }
  758. if do_line and (inlinelevel=0) then
  759. WriteSourceLine(hp as tailineinfo);
  760. end;
  761. WriteTai(replaceforbidden, do_line, false, InlineLevel, asmblock, hp);
  762. hp:=tai(hp.next);
  763. end;
  764. end;
  765. procedure TLLVMAssember.WriteExtraHeader;
  766. begin
  767. writer.AsmWrite('target datalayout = "');
  768. writer.AsmWrite(target_info.llvmdatalayout);
  769. writer.AsmWriteln('"');
  770. writer.AsmWrite('target triple = "');
  771. writer.AsmWrite(llvm_target_name);
  772. writer.AsmWriteln('"');
  773. end;
  774. procedure TLLVMAssember.WriteExtraFooter;
  775. begin
  776. end;
  777. procedure TLLVMAssember.WriteInstruction(hp: tai);
  778. begin
  779. end;
  780. procedure TLLVMAssember.WriteLlvmInstruction(hp: tai);
  781. begin
  782. InstrWriter.WriteInstruction(hp);
  783. end;
  784. procedure TLLVMAssember.WriteRealConst(hp: tai_realconst; do_line: boolean);
  785. begin
  786. if fdecllevel=0 then
  787. begin
  788. case tai_realconst(hp).realtyp of
  789. aitrealconst_s32bit:
  790. writer.AsmWriteLn(asminfo^.comment+'value: '+single2str(tai_realconst(hp).value.s32val));
  791. aitrealconst_s64bit:
  792. writer.AsmWriteLn(asminfo^.comment+'value: '+double2str(tai_realconst(hp).value.s64val));
  793. {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
  794. { can't write full 80 bit floating point constants yet on non-x86 }
  795. aitrealconst_s80bit:
  796. writer.AsmWriteLn(asminfo^.comment+'value: '+extended2str(tai_realconst(hp).value.s80val));
  797. {$endif cpuextended}
  798. aitrealconst_s64comp:
  799. writer.AsmWriteLn(asminfo^.comment+'value: '+extended2str(tai_realconst(hp).value.s64compval));
  800. else
  801. internalerror(2014050604);
  802. end;
  803. internalerror(2016120202);
  804. end;
  805. case hp.realtyp of
  806. aitrealconst_s32bit:
  807. writer.AsmWrite(llvmdoubletostr(hp.value.s32val));
  808. aitrealconst_s64bit:
  809. writer.AsmWriteln(llvmdoubletostr(hp.value.s64val));
  810. {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
  811. aitrealconst_s80bit:
  812. writer.AsmWrite(llvmextendedtostr(hp.value.s80val));
  813. {$endif defined(cpuextended)}
  814. aitrealconst_s64comp:
  815. { handled as int64 most of the time in llvm }
  816. writer.AsmWrite(tostr(round(hp.value.s64compval)));
  817. else
  818. internalerror(2014062401);
  819. end;
  820. end;
  821. procedure TLLVMAssember.WriteOrdConst(hp: tai_const);
  822. var
  823. consttyp: taiconst_type;
  824. begin
  825. if fdecllevel=0 then
  826. internalerror(2016120203);
  827. consttyp:=hp.consttype;
  828. case consttyp of
  829. aitconst_got,
  830. aitconst_gotoff_symbol,
  831. aitconst_uleb128bit,
  832. aitconst_sleb128bit,
  833. aitconst_rva_symbol,
  834. aitconst_secrel32_symbol,
  835. aitconst_darwin_dwarf_delta32,
  836. aitconst_darwin_dwarf_delta64,
  837. aitconst_half16bit,
  838. aitconst_gs:
  839. internalerror(2014052901);
  840. aitconst_128bit,
  841. aitconst_64bit,
  842. aitconst_32bit,
  843. aitconst_16bit,
  844. aitconst_8bit,
  845. aitconst_16bit_unaligned,
  846. aitconst_32bit_unaligned,
  847. aitconst_64bit_unaligned:
  848. begin
  849. if fdecllevel=0 then
  850. writer.AsmWrite(asminfo^.comment);
  851. { can't have compile-time differences between symbols; these are
  852. normally for PIC, but llvm takes care of that for us }
  853. if assigned(hp.endsym) then
  854. internalerror(2014052902);
  855. if assigned(hp.sym) then
  856. begin
  857. writer.AsmWrite(LlvmAsmSymName(hp.sym));
  858. { can't have offsets }
  859. if hp.value<>0 then
  860. if fdecllevel<>0 then
  861. internalerror(2014052903)
  862. else
  863. writer.AsmWrite(' -- symbol offset: ' + tostr(hp.value));
  864. end
  865. else if hp.value=0 then
  866. writer.AsmWrite('zeroinitializer')
  867. else
  868. writer.AsmWrite(tostr(hp.value));
  869. {
  870. // activate in case of debugging IE 2016120203
  871. if fdecllevel=0 then
  872. writer.AsmLn;
  873. }
  874. end;
  875. else
  876. internalerror(200704251);
  877. end;
  878. end;
  879. procedure TLLVMAssember.WriteTai(const replaceforbidden: boolean; const do_line, inmetadata: boolean; var InlineLevel: cardinal; var asmblock: boolean; var hp: tai);
  880. procedure WriteLinkageVibilityFlags(bind: TAsmSymBind);
  881. begin
  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. begin
  897. if not(llvmflag_linker_private in llvmversion_properties[current_settings.llvmversion]) then
  898. writer.AsmWrite(' hidden')
  899. else
  900. writer.AsmWrite(' linker_private');
  901. end
  902. else
  903. internalerror(2014020104);
  904. end;
  905. end;
  906. procedure WriteFunctionFlags(pd: tprocdef);
  907. begin
  908. { function attributes }
  909. if (pos('FPC_SETJMP',upper(pd.mangledname))<>0) or
  910. (pd.mangledname=(target_info.cprefix+'setjmp')) then
  911. writer.AsmWrite(' returns_twice');
  912. if po_inline in pd.procoptions then
  913. writer.AsmWrite(' inlinehint');
  914. if po_noinline in pd.procoptions then
  915. writer.AsmWrite(' noinline');
  916. { ensure that functions that happen to have the same name as a
  917. standard C library function, but which are implemented in Pascal,
  918. are not considered to have the same semantics as the C function with
  919. the same name }
  920. if not(po_external in pd.procoptions) then
  921. writer.AsmWrite(' nobuiltin');
  922. if po_noreturn in pd.procoptions then
  923. writer.AsmWrite(' noreturn');
  924. if llvmflag_null_pointer_valid in llvmversion_properties[current_settings.llvmversion] then
  925. writer.AsmWrite(' "null-pointer-is-valid"="true"');
  926. end;
  927. procedure WriteTypedConstData(hp: tai_abstracttypedconst; metadata: boolean);
  928. var
  929. p: tai_abstracttypedconst;
  930. pval: tai;
  931. defstr: TSymStr;
  932. first, gotstring: boolean;
  933. begin
  934. if hp.def<>llvm_metadatatype then
  935. begin
  936. defstr:=llvmencodetypename(hp.def)
  937. end
  938. else
  939. begin
  940. defstr:=''
  941. end;
  942. { write the struct, array or simple type }
  943. case hp.adetyp of
  944. tck_record:
  945. begin
  946. if not(metadata) then
  947. begin
  948. writer.AsmWrite(defstr);
  949. if not(df_llvm_no_struct_packing in hp.def.defoptions) then
  950. writer.AsmWrite(' <{')
  951. else
  952. writer.AsmWrite(' {')
  953. end
  954. else
  955. begin
  956. writer.AsmWrite(' !{');
  957. end;
  958. first:=true;
  959. for p in tai_aggregatetypedconst(hp) do
  960. begin
  961. if not first then
  962. writer.AsmWrite(', ')
  963. else
  964. first:=false;
  965. WriteTypedConstData(p,metadata);
  966. end;
  967. if not(metadata) then
  968. begin
  969. if not(df_llvm_no_struct_packing in hp.def.defoptions) then
  970. writer.AsmWrite(' }>')
  971. else
  972. writer.AsmWrite(' }')
  973. end
  974. else
  975. begin
  976. writer.AsmWrite(' }');
  977. end;
  978. end;
  979. tck_array:
  980. begin
  981. if not(metadata) then
  982. begin
  983. writer.AsmWrite(defstr);
  984. end;
  985. first:=true;
  986. gotstring:=false;
  987. for p in tai_aggregatetypedconst(hp) do
  988. begin
  989. if not first then
  990. writer.AsmWrite(', ')
  991. else
  992. begin
  993. writer.AsmWrite(' ');
  994. if (tai_abstracttypedconst(p).adetyp=tck_simple) and
  995. (tai_simpletypedconst(p).val.typ=ait_string) then
  996. begin
  997. gotstring:=true;
  998. end
  999. else
  1000. begin
  1001. if not metadata then
  1002. begin
  1003. writer.AsmWrite('[');
  1004. end
  1005. else
  1006. begin
  1007. writer.AsmWrite('!{');
  1008. end;
  1009. end;
  1010. first:=false;
  1011. end;
  1012. { cannot concat strings and other things }
  1013. if gotstring and
  1014. not metadata and
  1015. ((tai_abstracttypedconst(p).adetyp<>tck_simple) or
  1016. (tai_simpletypedconst(p).val.typ<>ait_string)) then
  1017. internalerror(2014062701);
  1018. WriteTypedConstData(p,metadata);
  1019. end;
  1020. if not gotstring then
  1021. begin
  1022. if not metadata then
  1023. begin
  1024. writer.AsmWrite(']');
  1025. end
  1026. else
  1027. begin
  1028. writer.AsmWrite('}');
  1029. end;
  1030. end;
  1031. end;
  1032. tck_simple:
  1033. begin
  1034. pval:=tai_simpletypedconst(hp).val;
  1035. if (pval.typ<>ait_string) and
  1036. (defstr<>'') then
  1037. begin
  1038. writer.AsmWrite(defstr);
  1039. writer.AsmWrite(' ');
  1040. end;
  1041. WriteTai(replaceforbidden,do_line,metadata,InlineLevel,asmblock,pval);
  1042. end;
  1043. end;
  1044. end;
  1045. procedure WriteLlvmMetadataNode(hp: tai_llvmbasemetadatanode);
  1046. begin
  1047. { must only appear at the top level }
  1048. if fdecllevel<>0 then
  1049. internalerror(2019050111);
  1050. writer.AsmWrite('!');
  1051. writer.AsmWrite(tai_llvmbasemetadatanode(hp).name);
  1052. writer.AsmWrite(' =');
  1053. inc(fdecllevel);
  1054. WriteTypedConstData(hp,true);
  1055. writer.AsmLn;
  1056. dec(fdecllevel);
  1057. end;
  1058. var
  1059. hp2: tai;
  1060. s: string;
  1061. sstr: TSymStr;
  1062. i: longint;
  1063. ch: ansichar;
  1064. begin
  1065. case hp.typ of
  1066. ait_comment :
  1067. begin
  1068. writer.AsmWrite(asminfo^.comment);
  1069. writer.AsmWritePChar(tai_comment(hp).str);
  1070. if fdecllevel<>0 then
  1071. internalerror(2015090601);
  1072. writer.AsmLn;
  1073. end;
  1074. ait_regalloc :
  1075. begin
  1076. if (cs_asm_regalloc in current_settings.globalswitches) then
  1077. begin
  1078. writer.AsmWrite(#9+asminfo^.comment+'Register ');
  1079. repeat
  1080. writer.AsmWrite(std_regname(Tai_regalloc(hp).reg));
  1081. if (hp.next=nil) or
  1082. (tai(hp.next).typ<>ait_regalloc) or
  1083. (tai_regalloc(hp.next).ratype<>tai_regalloc(hp).ratype) then
  1084. break;
  1085. hp:=tai(hp.next);
  1086. writer.AsmWrite(',');
  1087. until false;
  1088. writer.AsmWrite(' ');
  1089. writer.AsmWriteLn(regallocstr[tai_regalloc(hp).ratype]);
  1090. end;
  1091. end;
  1092. ait_tempalloc :
  1093. begin
  1094. if (cs_asm_tempalloc in current_settings.globalswitches) then
  1095. WriteTempalloc(tai_tempalloc(hp));
  1096. end;
  1097. ait_align,
  1098. ait_section :
  1099. begin
  1100. { ignore, specified as part of declarations -- don't write
  1101. comment, because could appear in the middle of an aggregate
  1102. constant definition }
  1103. end;
  1104. ait_datablock :
  1105. begin
  1106. writer.AsmWrite(asminfo^.comment);
  1107. writer.AsmWriteln('datablock');
  1108. end;
  1109. ait_const:
  1110. begin
  1111. WriteOrdConst(tai_const(hp));
  1112. end;
  1113. ait_realconst :
  1114. begin
  1115. WriteRealConst(tai_realconst(hp), do_line);
  1116. end;
  1117. ait_string :
  1118. begin
  1119. if fdecllevel=0 then
  1120. internalerror(2016120201);
  1121. if not inmetadata then
  1122. writer.AsmWrite('c"')
  1123. else
  1124. writer.AsmWrite('!"');
  1125. for i:=1 to tai_string(hp).len do
  1126. begin
  1127. ch:=tai_string(hp).str[i-1];
  1128. case ch of
  1129. #0, {This can't be done by range, because a bug in FPC}
  1130. #1..#31,
  1131. #128..#255,
  1132. '"',
  1133. '\' : s:='\'+hexStr(ord(ch),2);
  1134. else
  1135. s:=ch;
  1136. end;
  1137. writer.AsmWrite(s);
  1138. end;
  1139. writer.AsmWrite('"');
  1140. end;
  1141. ait_label :
  1142. begin
  1143. if not asmblock and
  1144. (tai_label(hp).labsym.is_used) then
  1145. begin
  1146. if (tai_label(hp).labsym.bind=AB_PRIVATE_EXTERN) then
  1147. begin
  1148. { should be emitted as part of the variable/function def }
  1149. internalerror(2013010703);
  1150. end;
  1151. if tai_label(hp).labsym.bind in [AB_GLOBAL, AB_PRIVATE_EXTERN] then
  1152. begin
  1153. { should be emitted as part of the variable/function def }
  1154. //internalerror(2013010704);
  1155. writer.AsmWriteln(asminfo^.comment+'global/privateextern label: '+tai_label(hp).labsym.name);
  1156. end;
  1157. if replaceforbidden then
  1158. writer.AsmWrite(ReplaceForbiddenAsmSymbolChars(tai_label(hp).labsym.name))
  1159. else
  1160. writer.AsmWrite(tai_label(hp).labsym.name);
  1161. writer.AsmWriteLn(':');
  1162. end;
  1163. end;
  1164. ait_symbol :
  1165. begin
  1166. if fdecllevel=0 then
  1167. writer.AsmWrite(asminfo^.comment);
  1168. writer.AsmWriteln(LlvmAsmSymName(tai_symbol(hp).sym));
  1169. { todo }
  1170. if tai_symbol(hp).has_value then
  1171. internalerror(2014062402);
  1172. end;
  1173. ait_llvmdecl:
  1174. begin
  1175. if taillvmdecl(hp).def.typ=procdef then
  1176. begin
  1177. if not(ldf_definition in taillvmdecl(hp).flags) then
  1178. begin
  1179. writer.AsmWrite('declare');
  1180. writer.AsmWrite(llvmencodeproctype(tprocdef(taillvmdecl(hp).def), taillvmdecl(hp).namesym.name, lpd_decl));
  1181. WriteFunctionFlags(tprocdef(taillvmdecl(hp).def));
  1182. writer.AsmLn;
  1183. end
  1184. else
  1185. begin
  1186. writer.AsmWrite('define');
  1187. if ldf_weak in taillvmdecl(hp).flags then
  1188. writer.AsmWrite(' weak');
  1189. WriteLinkageVibilityFlags(taillvmdecl(hp).namesym.bind);
  1190. writer.AsmWrite(llvmencodeproctype(tprocdef(taillvmdecl(hp).def), '', lpd_def));
  1191. WriteFunctionFlags(tprocdef(taillvmdecl(hp).def));
  1192. if assigned(tprocdef(taillvmdecl(hp).def).personality) then
  1193. begin
  1194. writer.AsmWrite(' personality i8* bitcast (');
  1195. writer.AsmWrite(llvmencodeproctype(tprocdef(taillvmdecl(hp).def).personality, '', lpd_procvar));
  1196. writer.AsmWrite('* ');
  1197. writer.AsmWrite(llvmmangledname(tprocdef(taillvmdecl(hp).def).personality.mangledname));
  1198. writer.AsmWrite(' to i8*)');
  1199. end;
  1200. writer.AsmWriteln(' {');
  1201. end;
  1202. end
  1203. else
  1204. begin
  1205. writer.AsmWrite(LlvmAsmSymName(taillvmdecl(hp).namesym));
  1206. writer.AsmWrite(' =');
  1207. if ldf_weak in taillvmdecl(hp).flags then
  1208. writer.AsmWrite(' weak');
  1209. if ldf_appending in taillvmdecl(hp).flags then
  1210. writer.AsmWrite(' appending');
  1211. WriteLinkageVibilityFlags(taillvmdecl(hp).namesym.bind);
  1212. writer.AsmWrite(' ');
  1213. if (ldf_tls in taillvmdecl(hp).flags) then
  1214. writer.AsmWrite('thread_local ');
  1215. if ldf_unnamed_addr in taillvmdecl(hp).flags then
  1216. writer.AsmWrite('unnamed_addr ');
  1217. if taillvmdecl(hp).sec in [sec_rodata,sec_rodata_norel] then
  1218. writer.AsmWrite('constant ')
  1219. else
  1220. writer.AsmWrite('global ');
  1221. if not assigned(taillvmdecl(hp).initdata) then
  1222. begin
  1223. writer.AsmWrite(llvmencodetypename(taillvmdecl(hp).def));
  1224. if not(taillvmdecl(hp).namesym.bind in [AB_EXTERNAL, AB_WEAK_EXTERNAL,AB_EXTERNAL_INDIRECT]) then
  1225. writer.AsmWrite(' zeroinitializer');
  1226. end
  1227. else
  1228. begin
  1229. inc(fdecllevel);
  1230. { can't have an external symbol with initialisation data }
  1231. if taillvmdecl(hp).namesym.bind in [AB_EXTERNAL, AB_WEAK_EXTERNAL] then
  1232. internalerror(2014052905);
  1233. { bitcast initialisation data to the type of the constant }
  1234. { write initialisation data }
  1235. hp2:=tai(taillvmdecl(hp).initdata.first);
  1236. while assigned(hp2) do
  1237. begin
  1238. WriteTai(replaceforbidden,do_line,inmetadata,InlineLevel,asmblock,hp2);
  1239. hp2:=tai(hp2.next);
  1240. end;
  1241. dec(fdecllevel);
  1242. end;
  1243. { custom section name? }
  1244. case taillvmdecl(hp).sec of
  1245. sec_user:
  1246. begin
  1247. writer.AsmWrite(', section "');
  1248. writer.AsmWrite(taillvmdecl(hp).secname);
  1249. writer.AsmWrite('"');
  1250. end;
  1251. low(TObjCAsmSectionType)..high(TObjCAsmSectionType):
  1252. begin
  1253. writer.AsmWrite(', section "');
  1254. writer.AsmWrite(objc_section_name(taillvmdecl(hp).sec));
  1255. writer.AsmWrite('"');
  1256. end;
  1257. else
  1258. ;
  1259. end;
  1260. { sections whose name starts with 'llvm.' are for LLVM
  1261. internal use and don't have an alignment }
  1262. if pos('llvm.',taillvmdecl(hp).secname)<>1 then
  1263. begin
  1264. { alignment }
  1265. writer.AsmWrite(', align ');
  1266. writer.AsmWriteln(tostr(taillvmdecl(hp).alignment));
  1267. end
  1268. else
  1269. writer.AsmLn;
  1270. end;
  1271. end;
  1272. ait_llvmalias:
  1273. begin
  1274. writer.AsmWrite(LlvmAsmSymName(taillvmalias(hp).newsym));
  1275. writer.AsmWrite(' = alias ');
  1276. WriteLinkageVibilityFlags(taillvmalias(hp).bind);
  1277. if taillvmalias(hp).def.typ=procdef then
  1278. sstr:=llvmencodeproctype(tabstractprocdef(taillvmalias(hp).def), '', lpd_alias)
  1279. else
  1280. sstr:=llvmencodetypename(taillvmalias(hp).def);
  1281. writer.AsmWrite(sstr);
  1282. if llvmflag_alias_double_type in llvmversion_properties[current_settings.llvmversion] then
  1283. begin
  1284. writer.AsmWrite(', ');
  1285. writer.AsmWrite(sstr);
  1286. end;
  1287. writer.AsmWrite('* ');
  1288. writer.AsmWriteln(LlvmAsmSymName(taillvmalias(hp).oldsym));
  1289. end;
  1290. ait_llvmmetadatanode:
  1291. begin
  1292. WriteLlvmMetadataNode(tai_llvmbasemetadatanode(hp));
  1293. end;
  1294. ait_llvmmetadatareftypedconst:
  1295. begin
  1296. { must only appear as an element in a typed const }
  1297. if fdecllevel=0 then
  1298. internalerror(2019050110);
  1299. writer.AsmWrite('!');
  1300. writer.AsmWrite(tai_llvmbasemetadatanode(tai_llvmmetadatareftypedconst(hp).val).name);
  1301. end;
  1302. ait_llvmmetadatarefoperand:
  1303. begin
  1304. { must only appear as an operand }
  1305. if fdecllevel=0 then
  1306. internalerror(2019050110);
  1307. writer.AsmWrite('!');
  1308. writer.AsmWrite(tai_llvmmetadatareferenceoperand(hp).id);
  1309. writer.AsmWrite(' !');
  1310. writer.AsmWrite(tai_llvmmetadatareferenceoperand(hp).value.name);
  1311. end;
  1312. ait_symbolpair:
  1313. begin
  1314. { should be emitted as part of the symbol def }
  1315. internalerror(2013010708);
  1316. end;
  1317. ait_symbol_end :
  1318. begin
  1319. if tai_symbol_end(hp).sym.typ=AT_FUNCTION then
  1320. writer.AsmWriteln('}')
  1321. else
  1322. writer.AsmWriteln('; ait_symbol_end error, should not be generated');
  1323. // internalerror(2013010711);
  1324. end;
  1325. ait_instruction :
  1326. begin
  1327. WriteInstruction(hp);
  1328. end;
  1329. ait_llvmins:
  1330. begin
  1331. WriteLlvmInstruction(hp);
  1332. end;
  1333. ait_stab :
  1334. begin
  1335. internalerror(2013010712);
  1336. end;
  1337. ait_force_line,
  1338. ait_function_name :
  1339. ;
  1340. ait_cutobject :
  1341. begin
  1342. end;
  1343. ait_marker :
  1344. case
  1345. tai_marker(hp).kind of
  1346. mark_NoLineInfoStart:
  1347. inc(InlineLevel);
  1348. mark_NoLineInfoEnd:
  1349. dec(InlineLevel);
  1350. { these cannot be nested }
  1351. mark_AsmBlockStart:
  1352. asmblock:=true;
  1353. mark_AsmBlockEnd:
  1354. asmblock:=false;
  1355. else
  1356. ;
  1357. end;
  1358. ait_directive :
  1359. begin
  1360. { CPU directive is commented out for the LLVM }
  1361. if tai_directive(hp).directive=asd_cpu then
  1362. writer.AsmWrite(asminfo^.comment);
  1363. WriteDirectiveName(tai_directive(hp).directive);
  1364. if tai_directive(hp).name <>'' then
  1365. writer.AsmWrite(tai_directive(hp).name);
  1366. if fdecllevel<>0 then
  1367. internalerror(2015090602);
  1368. writer.AsmLn;
  1369. end;
  1370. ait_seh_directive :
  1371. begin
  1372. internalerror(2013010713);
  1373. end;
  1374. ait_varloc:
  1375. begin
  1376. if tai_varloc(hp).newlocationhi<>NR_NO then
  1377. writer.AsmWrite(strpnew('Var '+tai_varloc(hp).varsym.realname+' located in register '+
  1378. std_regname(tai_varloc(hp).newlocationhi)+':'+std_regname(tai_varloc(hp).newlocation)))
  1379. else
  1380. writer.AsmWrite(strpnew('Var '+tai_varloc(hp).varsym.realname+' located in register '+
  1381. std_regname(tai_varloc(hp).newlocation)));
  1382. if fdecllevel<>0 then
  1383. internalerror(2015090603);
  1384. writer.AsmLn;
  1385. end;
  1386. ait_typedconst:
  1387. begin
  1388. WriteTypedConstData(tai_abstracttypedconst(hp),false);
  1389. end
  1390. else
  1391. internalerror(2019012010);
  1392. end;
  1393. end;
  1394. constructor TLLVMAssember.CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter, smart: boolean);
  1395. begin
  1396. inherited;
  1397. InstrWriter:=TLLVMInstrWriter.create(self);
  1398. end;
  1399. procedure TLLVMAssember.WriteDirectiveName(dir: TAsmDirective);
  1400. begin
  1401. writer.AsmWrite('.'+directivestr[dir]+' ');
  1402. end;
  1403. procedure TLLVMAssember.WriteAsmList;
  1404. var
  1405. hal : tasmlisttype;
  1406. a: TExternalAssembler;
  1407. decorator: TLLVMModuleInlineAssemblyDecorator;
  1408. begin
  1409. WriteExtraHeader;
  1410. for hal:=low(TasmlistType) to high(TasmlistType) do
  1411. begin
  1412. if not assigned(current_asmdata.asmlists[hal]) or
  1413. current_asmdata.asmlists[hal].Empty then
  1414. continue;
  1415. writer.AsmWriteLn(asminfo^.comment+'Begin asmlist '+AsmlistTypeStr[hal]);
  1416. if not(hal in [al_pure_assembler,al_dwarf_frame]) then
  1417. writetree(current_asmdata.asmlists[hal])
  1418. else
  1419. begin
  1420. { write routines using the target-specific external assembler
  1421. writer, filtered using the LLVM module-level assembly
  1422. decorator }
  1423. decorator:=TLLVMModuleInlineAssemblyDecorator.Create;
  1424. writer.decorator:=decorator;
  1425. a:=GetExternalGnuAssemblerWithAsmInfoWriter(asminfo,writer);
  1426. a.WriteTree(current_asmdata.asmlists[hal]);
  1427. writer.decorator:=nil;
  1428. decorator.free;
  1429. a.free;
  1430. end;
  1431. writer.AsmWriteLn(asminfo^.comment+'End asmlist '+AsmlistTypeStr[hal]);
  1432. end;
  1433. writer.AsmLn;
  1434. end;
  1435. procedure TLLVMAssember.WriteFunctionInlineAsmList(list: tasmlist);
  1436. var
  1437. a: TExternalAssembler;
  1438. begin
  1439. if not assigned(ffuncinlasmdecorator) then
  1440. ffuncinlasmdecorator:=TLLVMFunctionInlineAssemblyDecorator.create;
  1441. if assigned(writer.decorator) then
  1442. internalerror(2016110201);
  1443. writer.decorator:=ffuncinlasmdecorator;
  1444. a:=GetExternalGnuAssemblerWithAsmInfoWriter(asminfo,writer);
  1445. a.WriteTree(list);
  1446. a.free;
  1447. writer.decorator:=nil;
  1448. end;
  1449. {****************************************************************************}
  1450. { LLVM Instruction Writer }
  1451. {****************************************************************************}
  1452. constructor TLLVMInstrWriter.create(_owner: TLLVMAssember);
  1453. begin
  1454. inherited create;
  1455. owner := _owner;
  1456. end;
  1457. {****************************************************************************}
  1458. { llc Assember }
  1459. {****************************************************************************}
  1460. function TLLVMLLCAssember.MakeCmdLine: TCmdStr;
  1461. var
  1462. optstr: TCmdStr;
  1463. begin
  1464. result:=inherited;
  1465. { standard optimization flags for llc -- todo: this needs to be split
  1466. into a call to opt and one to llc }
  1467. if cs_opt_level3 in current_settings.optimizerswitches then
  1468. optstr:='-O3'
  1469. else if cs_opt_level2 in current_settings.optimizerswitches then
  1470. optstr:='-O2'
  1471. else if cs_opt_level1 in current_settings.optimizerswitches then
  1472. optstr:='-O1'
  1473. else
  1474. optstr:='-O0';
  1475. { stack frame elimination }
  1476. if not(cs_opt_stackframe in current_settings.optimizerswitches) then
  1477. optstr:=optstr+' -disable-fp-elim';
  1478. { fast math }
  1479. if cs_opt_fastmath in current_settings.optimizerswitches then
  1480. optstr:=optstr+' -enable-unsafe-fp-math -fp-contract=fast'; { -enable-fp-mad support depends on version }
  1481. { smart linking }
  1482. if cs_create_smart in current_settings.moduleswitches then
  1483. optstr:=optstr+' -data-sections -function-sections';
  1484. { pic }
  1485. if cs_create_pic in current_settings.moduleswitches then
  1486. optstr:=optstr+' -relocation-model=pic'
  1487. else if not(target_info.system in systems_darwin) then
  1488. optstr:=optstr+' -relocation-model=static'
  1489. else
  1490. optstr:=optstr+' -relocation-model=dynamic-no-pic';
  1491. { force object output instead of textual assembler code }
  1492. optstr:=optstr+' -filetype=obj';
  1493. if fputypestrllvm[current_settings.fputype]<>'' then
  1494. optstr:=optstr+' -mattr=+'+fputypestrllvm[current_settings.fputype];
  1495. replace(result,'$OPT',optstr);
  1496. end;
  1497. {****************************************************************************}
  1498. { clang Assember }
  1499. {****************************************************************************}
  1500. function TLLVMClangAssember.MakeCmdLine: TCmdStr;
  1501. var
  1502. wpostr,
  1503. optstr: TCmdStr;
  1504. begin
  1505. wpostr:='';
  1506. if cs_lto in current_settings.moduleswitches then
  1507. begin
  1508. case fnextpass of
  1509. 0:
  1510. begin
  1511. ObjFileName:=ChangeFileExt(ObjFileName,'.bc');
  1512. wpostr:=' -flto';
  1513. end;
  1514. 1:
  1515. begin
  1516. ObjFileName:=ChangeFileExt(ObjFileName,'.o');
  1517. end;
  1518. end;
  1519. end;
  1520. result:=inherited;
  1521. { standard optimization flags for llc -- todo: this needs to be split
  1522. into a call to opt and one to llc }
  1523. if cs_opt_level3 in current_settings.optimizerswitches then
  1524. optstr:='-O3'
  1525. else if cs_opt_level2 in current_settings.optimizerswitches then
  1526. optstr:='-O2'
  1527. else if cs_opt_level1 in current_settings.optimizerswitches then
  1528. optstr:='-O1'
  1529. else
  1530. optstr:='-O0';
  1531. optstr:=optstr+wpostr;
  1532. { stack frame elimination }
  1533. if not(cs_opt_stackframe in current_settings.optimizerswitches) then
  1534. optstr:=optstr+' -fno-omit-frame-pointer'
  1535. else
  1536. optstr:=optstr+' -fomit-frame-pointer';
  1537. { fast math }
  1538. if cs_opt_fastmath in current_settings.optimizerswitches then
  1539. optstr:=optstr+' -ffast-math';
  1540. { smart linking }
  1541. if cs_create_smart in current_settings.moduleswitches then
  1542. optstr:=optstr+' -fdata-sections -ffunction-sections';
  1543. { pic }
  1544. if cs_create_pic in current_settings.moduleswitches then
  1545. optstr:=optstr+' -fpic'
  1546. else if not(target_info.system in systems_darwin) then
  1547. optstr:=optstr+' -static'
  1548. else
  1549. optstr:=optstr+' -mdynamic-no-pic';
  1550. if not(target_info.system in systems_darwin) then
  1551. begin
  1552. optstr:=optstr+' --target='+llvm_target_name;
  1553. end;
  1554. if fputypestrllvm[current_settings.fputype]<>'' then
  1555. optstr:=optstr+' -m'+fputypestrllvm[current_settings.fputype];
  1556. replace(result,'$OPT',optstr);
  1557. inc(fnextpass);
  1558. end;
  1559. function TLLVMClangAssember.DoAssemble: boolean;
  1560. begin
  1561. fnextpass:=0;
  1562. result:=inherited;
  1563. end;
  1564. function TLLVMClangAssember.RerunAssembler: boolean;
  1565. begin
  1566. result:=
  1567. (cs_lto in current_settings.moduleswitches) and
  1568. (fnextpass<=1);
  1569. end;
  1570. function TLLVMClangAssember.DoPipe: boolean;
  1571. begin
  1572. result:=
  1573. not(cs_lto in current_settings.moduleswitches) and
  1574. inherited;
  1575. end;
  1576. const
  1577. as_llvm_llc_info : tasminfo =
  1578. (
  1579. id : as_llvm_llc;
  1580. idtxt : 'LLVM-LLC';
  1581. asmbin : 'llc';
  1582. asmcmd: '$OPT -o $OBJ $ASM';
  1583. supported_targets : [system_x86_64_linux,system_x86_64_darwin,system_aarch64_linux,system_arm_linux];
  1584. flags : [af_smartlink_sections];
  1585. labelprefix : 'L';
  1586. comment : '; ';
  1587. dollarsign: '$';
  1588. );
  1589. as_llvm_clang_info : tasminfo =
  1590. (
  1591. id : as_llvm_clang;
  1592. idtxt : 'LLVM-CLANG';
  1593. asmbin : 'clang';
  1594. asmcmd: '$OPT $DARWINVERSION -c -o $OBJ $ASM';
  1595. supported_targets : [system_x86_64_linux,system_x86_64_darwin,system_aarch64_linux,system_arm_linux];
  1596. flags : [af_smartlink_sections];
  1597. labelprefix : 'L';
  1598. comment : '; ';
  1599. dollarsign: '$';
  1600. );
  1601. begin
  1602. RegisterAssembler(as_llvm_llc_info,TLLVMLLCAssember);
  1603. RegisterAssembler(as_llvm_clang_info,TLLVMClangAssember);
  1604. end.