agllvm.pas 56 KB

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