agllvm.pas 61 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788
  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).val.typ=ait_string) then
  1024. begin
  1025. gotstring:=true;
  1026. end
  1027. else
  1028. begin
  1029. if metadatakind=mk_none then
  1030. begin
  1031. writer.AsmWrite('[');
  1032. end
  1033. else
  1034. begin
  1035. writer.AsmWrite('!{');
  1036. end;
  1037. end;
  1038. first:=false;
  1039. end;
  1040. { cannot concat strings and other things }
  1041. if gotstring and
  1042. (metadatakind=mk_none) and
  1043. ((tai_abstracttypedconst(p).adetyp<>tck_simple) or
  1044. (tai_simpletypedconst(p).val.typ<>ait_string)) then
  1045. internalerror(2014062701);
  1046. WriteTypedConstData(p,metadatakind);
  1047. end;
  1048. if not gotstring then
  1049. begin
  1050. if first then
  1051. begin
  1052. if metadatakind=mk_none then
  1053. begin
  1054. writer.AsmWrite(' [');
  1055. end
  1056. else
  1057. begin
  1058. writer.AsmWrite(' !{');
  1059. end;
  1060. end;
  1061. if metadatakind=mk_none then
  1062. begin
  1063. writer.AsmWrite(']');
  1064. end
  1065. else
  1066. begin
  1067. writer.AsmWrite('}');
  1068. end;
  1069. end;
  1070. end;
  1071. tck_simple:
  1072. begin
  1073. pval:=tai_simpletypedconst(hp).val;
  1074. if not assigned(pval) then
  1075. begin
  1076. if metadatakind>=mk_normal then
  1077. writer.asmWrite('null')
  1078. else
  1079. internalerror(2022041301);
  1080. exit;
  1081. end;
  1082. if (pval.typ<>ait_string) and
  1083. (defstr<>'') then
  1084. begin
  1085. writer.AsmWrite(defstr);
  1086. writer.AsmWrite(' ');
  1087. end;
  1088. WriteTai(replaceforbidden,do_line,metadatakind,InlineLevel,asmblock,pval);
  1089. end;
  1090. end;
  1091. end;
  1092. procedure WriteString(hp: tai_string);
  1093. var
  1094. i: longint;
  1095. s: string;
  1096. ch: ansichar;
  1097. endQuotes: boolean;
  1098. begin
  1099. if fdecllevel=0 then
  1100. internalerror(2016120201);
  1101. endQuotes:=true;
  1102. case inmetadatakind of
  1103. mk_none:
  1104. writer.AsmWrite('c"');
  1105. mk_normal:
  1106. writer.AsmWrite('!"');
  1107. mk_specialised:
  1108. writer.AsmWrite('"');
  1109. mk_specialised_bool:
  1110. internalerror(2022041201);
  1111. mk_specialised_enum:
  1112. endQuotes:=false;
  1113. end;
  1114. for i:=1 to tai_string(hp).len do
  1115. begin
  1116. ch:=tai_string(hp).str[i-1];
  1117. case ch of
  1118. #0, {This can't be done by range, because a bug in FPC}
  1119. #1..#31,
  1120. #128..#255,
  1121. '"',
  1122. '\' : s:='\'+hexStr(ord(ch),2);
  1123. else
  1124. s:=ch;
  1125. end;
  1126. writer.AsmWrite(s);
  1127. end;
  1128. if endQuotes then
  1129. writer.AsmWrite('"');
  1130. end;
  1131. procedure WriteSpecialisedMetadataNode(hp: tai_llvmspecialisedmetadatanode);
  1132. var
  1133. element: tai_abstracttypedconst;
  1134. specialised_element: tllvmspecialisedmetaitem;
  1135. s: shortstring;
  1136. metadatakind: tmetadatakind;
  1137. first: boolean;
  1138. begin
  1139. if hp.IsDistinct then
  1140. writer.AsmWrite(' distinct !')
  1141. else
  1142. writer.AsmWrite(' !');
  1143. str(hp.kind,s);
  1144. writer.AsmWrite(s);
  1145. writer.AsmWrite('(');
  1146. first:=true;
  1147. for element in hp do
  1148. begin
  1149. if not first then
  1150. writer.AsmWrite(', ')
  1151. else
  1152. first:=false;
  1153. specialised_element:=tllvmspecialisedmetaitem(element);
  1154. if specialised_element.itemname<>'' then
  1155. begin
  1156. writer.AsmWrite(specialised_element.itemname);
  1157. writer.AsmWrite(': ');
  1158. end;
  1159. case specialised_element.itemkind of
  1160. lsmik_boolean:
  1161. metadatakind:=mk_specialised_bool;
  1162. lsmik_enum:
  1163. metadatakind:=mk_specialised_enum;
  1164. else
  1165. metadatakind:=mk_specialised;
  1166. end;
  1167. WriteTypedConstData(specialised_element,metadatakind);
  1168. end;
  1169. writer.AsmWrite(')');
  1170. end;
  1171. procedure WriteLlvmMetadataNode(hp: tai_llvmbasemetadatanode);
  1172. begin
  1173. { must only appear at the top level }
  1174. if fdecllevel<>0 then
  1175. internalerror(2019050111);
  1176. writer.AsmWrite('!');
  1177. writer.AsmWrite(tai_llvmbasemetadatanode(hp).name);
  1178. writer.AsmWrite(' =');
  1179. inc(fdecllevel);
  1180. if hp.isspecialised then
  1181. WriteSpecialisedMetadataNode(tai_llvmspecialisedmetadatanode(hp))
  1182. else
  1183. WriteTypedConstData(hp,mk_normal);
  1184. writer.AsmLn;
  1185. dec(fdecllevel);
  1186. end;
  1187. var
  1188. hp2: tai;
  1189. sstr: TSymStr;
  1190. i: longint;
  1191. begin
  1192. case hp.typ of
  1193. ait_align,
  1194. ait_section :
  1195. begin
  1196. { ignore, specified as part of declarations -- don't write
  1197. comment, because could appear in the middle of an aggregate
  1198. constant definition }
  1199. end;
  1200. ait_datablock :
  1201. begin
  1202. writer.AsmWrite(asminfo^.comment);
  1203. writer.AsmWriteln('datablock');
  1204. end;
  1205. ait_const:
  1206. begin
  1207. WriteOrdConst(tai_const(hp),inmetadatakind);
  1208. end;
  1209. ait_realconst :
  1210. begin
  1211. WriteRealConst(tai_realconst(hp), do_line);
  1212. end;
  1213. ait_string :
  1214. begin
  1215. WriteString(tai_string(hp));
  1216. end;
  1217. ait_label :
  1218. begin
  1219. if not asmblock and
  1220. (tai_label(hp).labsym.is_used) then
  1221. begin
  1222. if (tai_label(hp).labsym.bind=AB_PRIVATE_EXTERN) then
  1223. begin
  1224. { should be emitted as part of the variable/function def }
  1225. internalerror(2013010703);
  1226. end;
  1227. if tai_label(hp).labsym.bind in [AB_GLOBAL, AB_PRIVATE_EXTERN] then
  1228. begin
  1229. { should be emitted as part of the variable/function def }
  1230. //internalerror(2013010704);
  1231. writer.AsmWriteln(asminfo^.comment+'global/privateextern label: '+tai_label(hp).labsym.name);
  1232. end;
  1233. if replaceforbidden then
  1234. writer.AsmWrite(ApplyAsmSymbolRestrictions(tai_label(hp).labsym.name))
  1235. else
  1236. writer.AsmWrite(tai_label(hp).labsym.name);
  1237. writer.AsmWriteLn(':');
  1238. end;
  1239. end;
  1240. ait_symbol :
  1241. begin
  1242. if fdecllevel=0 then
  1243. writer.AsmWrite(asminfo^.comment);
  1244. writer.AsmWriteln(LlvmAsmSymName(tai_symbol(hp).sym));
  1245. { todo }
  1246. if tai_symbol(hp).has_value then
  1247. internalerror(2014062402);
  1248. end;
  1249. ait_llvmdecl:
  1250. begin
  1251. if taillvmdecl(hp).def.typ=procdef then
  1252. begin
  1253. if not(ldf_definition in taillvmdecl(hp).flags) then
  1254. begin
  1255. writer.AsmWrite('declare');
  1256. writer.AsmWrite(llvmencodeproctype(tprocdef(taillvmdecl(hp).def), taillvmdecl(hp).namesym.name, lpd_decl));
  1257. WriteFunctionFlags(tprocdef(taillvmdecl(hp).def));
  1258. writer.AsmLn;
  1259. end
  1260. else
  1261. begin
  1262. writer.AsmWrite('define');
  1263. if ldf_weak in taillvmdecl(hp).flags then
  1264. writer.AsmWrite(' weak');
  1265. WriteLinkageVibilityFlags(taillvmdecl(hp).namesym.bind, true);
  1266. writer.AsmWrite(llvmencodeproctype(tprocdef(taillvmdecl(hp).def), '', lpd_def));
  1267. WriteFunctionFlags(tprocdef(taillvmdecl(hp).def));
  1268. if assigned(tprocdef(taillvmdecl(hp).def).personality) then
  1269. begin
  1270. if not(llvmflag_opaque_ptr in llvmversion_properties[current_settings.llvmversion]) then
  1271. begin
  1272. writer.AsmWrite(' personality i8* bitcast (');
  1273. writer.AsmWrite(llvmencodeproctype(tprocdef(taillvmdecl(hp).def).personality, '', lpd_procvar));
  1274. writer.AsmWrite('* ');
  1275. writer.AsmWrite(llvmmangledname(tprocdef(taillvmdecl(hp).def).personality.mangledname));
  1276. writer.AsmWrite(' to i8*)');
  1277. end
  1278. else
  1279. begin
  1280. writer.AsmWrite(' personality ptr ');
  1281. writer.AsmWrite(llvmmangledname(tprocdef(taillvmdecl(hp).def).personality.mangledname));
  1282. end;
  1283. end;
  1284. InstrWriter.WriterInstructionMetadata(' ', taillvmdecl(hp).metadata);
  1285. writer.AsmWriteln(' {');
  1286. end;
  1287. end
  1288. else
  1289. begin
  1290. writer.AsmWrite(LlvmAsmSymName(taillvmdecl(hp).namesym));
  1291. writer.AsmWrite(' =');
  1292. if ldf_weak in taillvmdecl(hp).flags then
  1293. writer.AsmWrite(' weak');
  1294. if ldf_appending in taillvmdecl(hp).flags then
  1295. writer.AsmWrite(' appending');
  1296. WriteLinkageVibilityFlags(taillvmdecl(hp).namesym.bind, ldf_definition in taillvmdecl(hp).flags);
  1297. writer.AsmWrite(' ');
  1298. if (ldf_tls in taillvmdecl(hp).flags) then
  1299. writer.AsmWrite('thread_local ');
  1300. if ldf_unnamed_addr in taillvmdecl(hp).flags then
  1301. writer.AsmWrite('unnamed_addr ');
  1302. if taillvmdecl(hp).sec in [sec_rodata,sec_rodata_norel] then
  1303. writer.AsmWrite('constant ')
  1304. else
  1305. writer.AsmWrite('global ');
  1306. if not assigned(taillvmdecl(hp).initdata) then
  1307. begin
  1308. writer.AsmWrite(llvmencodetypename(taillvmdecl(hp).def));
  1309. if ldf_definition in taillvmdecl(hp).flags then
  1310. writer.AsmWrite(' zeroinitializer');
  1311. end
  1312. else
  1313. begin
  1314. inc(fdecllevel);
  1315. { can't have an external symbol with initialisation data }
  1316. if taillvmdecl(hp).namesym.bind in [AB_EXTERNAL, AB_WEAK_EXTERNAL] then
  1317. internalerror(2014052905);
  1318. { bitcast initialisation data to the type of the constant }
  1319. { write initialisation data }
  1320. hp2:=tai(taillvmdecl(hp).initdata.first);
  1321. while assigned(hp2) do
  1322. begin
  1323. WriteTai(replaceforbidden,do_line,inmetadatakind,InlineLevel,asmblock,hp2);
  1324. hp2:=tai(hp2.next);
  1325. end;
  1326. dec(fdecllevel);
  1327. end;
  1328. { custom section name? }
  1329. case taillvmdecl(hp).sec of
  1330. sec_user:
  1331. begin
  1332. writer.AsmWrite(', section "');
  1333. writer.AsmWrite(taillvmdecl(hp).secname);
  1334. writer.AsmWrite('"');
  1335. end;
  1336. low(TObjCAsmSectionType)..high(TObjCAsmSectionType):
  1337. begin
  1338. writer.AsmWrite(', section "');
  1339. writer.AsmWrite(objc_section_name(taillvmdecl(hp).sec));
  1340. writer.AsmWrite('"');
  1341. end;
  1342. else
  1343. ;
  1344. end;
  1345. { sections whose name starts with 'llvm.' are for LLVM
  1346. internal use and don't have an alignment }
  1347. if pos('llvm.',taillvmdecl(hp).secname)<>1 then
  1348. begin
  1349. { alignment }
  1350. writer.AsmWrite(', align ');
  1351. writer.AsmWrite(tostr(taillvmdecl(hp).alignment));
  1352. end;
  1353. InstrWriter.WriterInstructionMetadata(', ',taillvmdecl(hp).metadata);
  1354. writer.AsmLn;
  1355. end;
  1356. end;
  1357. ait_llvmalias:
  1358. begin
  1359. writer.AsmWrite(LlvmAsmSymName(taillvmalias(hp).newsym));
  1360. writer.AsmWrite(' = alias ');
  1361. WriteLinkageVibilityFlags(taillvmalias(hp).bind, true);
  1362. if taillvmalias(hp).def.typ=procdef then
  1363. sstr:=llvmencodeproctype(tabstractprocdef(taillvmalias(hp).def), '', lpd_alias)
  1364. else
  1365. sstr:=llvmencodetypename(taillvmalias(hp).def);
  1366. writer.AsmWrite(sstr);
  1367. writer.AsmWrite(', ');
  1368. writer.AsmWrite(sstr);
  1369. writer.AsmWrite('* ');
  1370. writer.AsmWriteln(LlvmAsmSymName(taillvmalias(hp).oldsym));
  1371. end;
  1372. ait_llvmmetadatanode:
  1373. begin
  1374. WriteLlvmMetadataNode(tai_llvmbasemetadatanode(hp));
  1375. end;
  1376. ait_llvmmetadatareftypedconst:
  1377. begin
  1378. { must only appear as an element in a typed const }
  1379. if fdecllevel=0 then
  1380. internalerror(2019050110);
  1381. writer.AsmWrite('!');
  1382. writer.AsmWrite(tai_llvmbasemetadatanode(tai_llvmmetadatareftypedconst(hp).val).name);
  1383. end;
  1384. ait_llvmmetadatarefoperand:
  1385. begin
  1386. inc(fdecllevel);
  1387. writer.AsmWrite('!');
  1388. writer.AsmWrite(tai_llvmmetadatareferenceoperand(hp).id);
  1389. writer.AsmWrite(' ');
  1390. hp2:=tai_llvmmetadatareferenceoperand(hp).value;
  1391. WriteTai(replaceforbidden,do_line,mk_normal,inlinelevel,asmblock,hp2);
  1392. dec(fdecllevel);
  1393. end;
  1394. ait_symbolpair:
  1395. begin
  1396. { should be emitted as part of the symbol def }
  1397. internalerror(2013010708);
  1398. end;
  1399. ait_symbol_end :
  1400. begin
  1401. if tai_symbol_end(hp).sym.typ=AT_FUNCTION then
  1402. writer.AsmWriteln('}')
  1403. else
  1404. writer.AsmWriteln('; ait_symbol_end error, should not be generated');
  1405. // internalerror(2013010711);
  1406. end;
  1407. ait_instruction :
  1408. begin
  1409. WriteInstruction(hp);
  1410. end;
  1411. ait_llvmins:
  1412. begin
  1413. WriteLlvmInstruction(hp);
  1414. end;
  1415. ait_stab :
  1416. begin
  1417. internalerror(2013010712);
  1418. end;
  1419. ait_force_line,
  1420. ait_function_name :
  1421. ;
  1422. ait_cutobject :
  1423. begin
  1424. end;
  1425. ait_marker :
  1426. case
  1427. tai_marker(hp).kind of
  1428. mark_NoLineInfoStart:
  1429. inc(InlineLevel);
  1430. mark_NoLineInfoEnd:
  1431. dec(InlineLevel);
  1432. { these cannot be nested }
  1433. mark_AsmBlockStart:
  1434. asmblock:=true;
  1435. mark_AsmBlockEnd:
  1436. asmblock:=false;
  1437. else
  1438. ;
  1439. end;
  1440. ait_directive :
  1441. begin
  1442. { CPU directive is commented out for the LLVM }
  1443. if tai_directive(hp).directive=asd_cpu then
  1444. writer.AsmWrite(asminfo^.comment);
  1445. WriteDirectiveName(tai_directive(hp).directive);
  1446. if tai_directive(hp).name <>'' then
  1447. writer.AsmWrite(tai_directive(hp).name);
  1448. if fdecllevel<>0 then
  1449. internalerror(2015090602);
  1450. writer.AsmLn;
  1451. end;
  1452. ait_seh_directive :
  1453. begin
  1454. internalerror(2013010713);
  1455. end;
  1456. ait_typedconst:
  1457. begin
  1458. WriteTypedConstData(tai_abstracttypedconst(hp),inmetadatakind);
  1459. end
  1460. else
  1461. if not WriteComments(hp) then
  1462. internalerror(2019012010);
  1463. end;
  1464. end;
  1465. constructor TLLVMAssember.CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter, smart: boolean);
  1466. begin
  1467. inherited;
  1468. InstrWriter:=TLLVMInstrWriter.create(self);
  1469. end;
  1470. procedure TLLVMAssember.WriteDirectiveName(dir: TAsmDirective);
  1471. begin
  1472. writer.AsmWrite('.'+directivestr[dir]+' ');
  1473. end;
  1474. procedure TLLVMAssember.WriteAsmList;
  1475. var
  1476. hal : tasmlisttype;
  1477. a: TExternalAssembler;
  1478. decorator: TLLVMModuleInlineAssemblyDecorator;
  1479. begin
  1480. WriteExtraHeader;
  1481. for hal:=low(TasmlistType) to high(TasmlistType) do
  1482. begin
  1483. if not assigned(current_asmdata.asmlists[hal]) or
  1484. current_asmdata.asmlists[hal].Empty then
  1485. continue;
  1486. writer.AsmWriteLn(asminfo^.comment+'Begin asmlist '+AsmlistTypeStr[hal]);
  1487. if not(hal in [al_pure_assembler,al_dwarf_frame]) then
  1488. writetree(current_asmdata.asmlists[hal])
  1489. else
  1490. begin
  1491. { write routines using the target-specific external assembler
  1492. writer, filtered using the LLVM module-level assembly
  1493. decorator }
  1494. decorator:=TLLVMModuleInlineAssemblyDecorator.Create;
  1495. writer.decorator:=decorator;
  1496. a:=GetExternalGnuAssemblerWithAsmInfoWriter(asminfo,writer);
  1497. a.WriteTree(current_asmdata.asmlists[hal]);
  1498. writer.decorator:=nil;
  1499. decorator.free;
  1500. a.free;
  1501. end;
  1502. writer.AsmWriteLn(asminfo^.comment+'End asmlist '+AsmlistTypeStr[hal]);
  1503. end;
  1504. writer.AsmLn;
  1505. end;
  1506. procedure TLLVMAssember.WriteFunctionInlineAsmList(list: tasmlist);
  1507. var
  1508. a: TExternalAssembler;
  1509. begin
  1510. if not assigned(ffuncinlasmdecorator) then
  1511. ffuncinlasmdecorator:=TLLVMFunctionInlineAssemblyDecorator.create;
  1512. if assigned(writer.decorator) then
  1513. internalerror(2016110201);
  1514. writer.decorator:=ffuncinlasmdecorator;
  1515. a:=GetExternalGnuAssemblerWithAsmInfoWriter(asminfo,writer);
  1516. a.WriteTree(list);
  1517. a.free;
  1518. writer.decorator:=nil;
  1519. end;
  1520. {****************************************************************************}
  1521. { LLVM Instruction Writer }
  1522. {****************************************************************************}
  1523. constructor TLLVMInstrWriter.create(_owner: TLLVMAssember);
  1524. begin
  1525. inherited create;
  1526. owner := _owner;
  1527. end;
  1528. {****************************************************************************}
  1529. { clang Assember }
  1530. {****************************************************************************}
  1531. function TLLVMClangAssember.MakeCmdLine: TCmdStr;
  1532. var
  1533. wpostr,
  1534. optstr: TCmdStr;
  1535. begin
  1536. wpostr:='';
  1537. if cs_lto in current_settings.moduleswitches then
  1538. begin
  1539. case fnextpass of
  1540. 0:
  1541. begin
  1542. ObjFileName:=ChangeFileExt(ObjFileName,'.bc');
  1543. wpostr:=' -flto';
  1544. end;
  1545. 1:
  1546. begin
  1547. ObjFileName:=ChangeFileExt(ObjFileName,'.o');
  1548. end;
  1549. end;
  1550. end;
  1551. result:=inherited;
  1552. if cs_opt_level3 in current_settings.optimizerswitches then
  1553. optstr:='-O3'
  1554. else if cs_opt_level2 in current_settings.optimizerswitches then
  1555. optstr:='-O2'
  1556. else if cs_opt_level1 in current_settings.optimizerswitches then
  1557. optstr:='-O1'
  1558. else
  1559. optstr:='-O0';
  1560. optstr:=optstr+wpostr;
  1561. { stack frame elimination }
  1562. if not(cs_opt_stackframe in current_settings.optimizerswitches) then
  1563. optstr:=optstr+' -fno-omit-frame-pointer'
  1564. else
  1565. optstr:=optstr+' -fomit-frame-pointer';
  1566. { fast math }
  1567. if cs_opt_fastmath in current_settings.optimizerswitches then
  1568. optstr:=optstr+' -ffast-math';
  1569. { smart linking }
  1570. if cs_create_smart in current_settings.moduleswitches then
  1571. optstr:=optstr+' -fdata-sections -ffunction-sections';
  1572. { pic }
  1573. if cs_create_pic in current_settings.moduleswitches then
  1574. optstr:=optstr+' -fpic'
  1575. else if not(target_info.system in systems_darwin) then
  1576. optstr:=optstr+' -static'
  1577. else
  1578. optstr:=optstr+' -mdynamic-no-pic';
  1579. if fputypestrllvm[current_settings.fputype]<>'' then
  1580. optstr:=optstr+' -m'+fputypestrllvm[current_settings.fputype];
  1581. { restrict march to aarch64 for now to fix x86_64 compilation failure }
  1582. if (cputypestr[current_settings.cputype]<>'')
  1583. and (target_info.system in [system_aarch64_darwin, system_aarch64_linux]) then
  1584. optstr:=optstr+' -march='+cputypestr[current_settings.cputype];
  1585. replace(result,'$OPT',optstr);
  1586. inc(fnextpass);
  1587. end;
  1588. function TLLVMClangAssember.DoAssemble: boolean;
  1589. begin
  1590. fnextpass:=0;
  1591. result:=inherited;
  1592. end;
  1593. function TLLVMClangAssember.RerunAssembler: boolean;
  1594. begin
  1595. result:=
  1596. (cs_lto in current_settings.moduleswitches) and
  1597. (fnextpass<=1);
  1598. end;
  1599. function TLLVMClangAssember.DoPipe: boolean;
  1600. begin
  1601. result:=
  1602. not(cs_lto in current_settings.moduleswitches) and
  1603. inherited;
  1604. end;
  1605. const
  1606. as_clang_llvm_info : tasminfo =
  1607. (
  1608. id : as_clang_llvm;
  1609. idtxt : 'CLANG-LLVM';
  1610. asmbin : 'clang';
  1611. asmcmd: '-x ir $OPT -target $TRIPLET -c -o $OBJ $ASM $EXTRAOPT';
  1612. supported_targets : [system_x86_64_linux,system_aarch64_linux,system_arm_linux];
  1613. flags : [af_smartlink_sections,af_llvm];
  1614. labelprefix : '.L';
  1615. labelmaxlen : -1;
  1616. comment : '; ';
  1617. dollarsign: '$';
  1618. );
  1619. as_clang_llvm_darwin_info : tasminfo =
  1620. (
  1621. id : as_clang_llvm_darwin;
  1622. idtxt : 'CLANG-LLVM-DARWIN';
  1623. asmbin : 'clang';
  1624. asmcmd: '-x ir $OPT -target $TRIPLET -c -o $OBJ $ASM $EXTRAOPT';
  1625. supported_targets : [system_x86_64_darwin,system_aarch64_darwin];
  1626. flags : [af_smartlink_sections,af_llvm];
  1627. labelprefix : 'L';
  1628. labelmaxlen : -1;
  1629. comment : '; ';
  1630. dollarsign: '$';
  1631. );
  1632. begin
  1633. RegisterAssembler(as_clang_llvm_info,TLLVMClangAssember);
  1634. RegisterAssembler(as_clang_llvm_darwin_info,TLLVMClangAssember);
  1635. end.