agllvm.pas 60 KB

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