agllvm.pas 55 KB

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