agllvm.pas 61 KB

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