agllvm.pas 61 KB

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