agllvm.pas 61 KB

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