agllvm.pas 55 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620
  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. top_callingconvention:
  434. result:=llvm_callingconvention_name(o.callingconvention);
  435. else
  436. internalerror(2013060227);
  437. end;
  438. end;
  439. procedure TLLVMInstrWriter.WriteAsmRegisterAllocationClobbers(list: tasmlist);
  440. var
  441. hp: tai;
  442. begin
  443. hp:=tai(list.first);
  444. while assigned(hp) do
  445. begin
  446. if (hp.typ=ait_regalloc) and
  447. (tai_regalloc(hp).ratype=ra_alloc) then
  448. begin
  449. owner.writer.AsmWrite(',~{');
  450. owner.writer.AsmWrite(std_regname(tai_regalloc(hp).reg));
  451. owner.writer.AsmWrite('}');
  452. end;
  453. hp:=tai(hp.next);
  454. end;
  455. end;
  456. procedure TLLVMInstrWriter.WriteInstruction(hp: tai);
  457. var
  458. op: tllvmop;
  459. tmpstr,
  460. sep: TSymStr;
  461. i, opstart: longint;
  462. nested: boolean;
  463. opdone,
  464. done: boolean;
  465. begin
  466. op:=taillvm(hp).llvmopcode;
  467. { we write everything immediately rather than adding it into a string,
  468. because operands may contain other tai that will also write things out
  469. (and their output must come after everything that was processed in this
  470. instruction, such as its opcode or previous operands) }
  471. if owner.fdecllevel=0 then
  472. owner.writer.AsmWrite(#9);
  473. sep:=' ';
  474. opdone:=false;
  475. done:=false;
  476. opstart:=0;
  477. nested:=false;
  478. case op of
  479. la_type:
  480. begin
  481. owner.writer.AsmWrite(llvmtypeidentifier(taillvm(hp).oper[0]^.def));
  482. owner.writer.AsmWrite(' = type ');
  483. owner.writer.AsmWrite(llvmencodetypedecl(taillvm(hp).oper[0]^.def));
  484. done:=true;
  485. end;
  486. la_asmblock:
  487. begin
  488. owner.writer.AsmWrite('call void asm sideeffect "');
  489. owner.WriteFunctionInlineAsmList(taillvm(hp).oper[0]^.asmlist);
  490. owner.writer.AsmWrite('","');
  491. { we pass all accessed local variables as in/out address parameters,
  492. since we don't analyze the assembly code to determine what exactly
  493. happens to them; this is also compatible with the regular code
  494. generators, which always place local place local variables
  495. accessed from assembly code in memory }
  496. for i:=0 to taillvm(hp).oper[1]^.paras.Count-1 do
  497. begin
  498. owner.writer.AsmWrite('=*m,');
  499. end;
  500. owner.writer.AsmWrite('~{memory},~{fpsr},~{flags}');
  501. WriteAsmRegisterAllocationClobbers(taillvm(hp).oper[0]^.asmlist);
  502. owner.writer.AsmWrite('"');
  503. writeparas(taillvm(hp).oper[1]^.paras);
  504. done:=true;
  505. end;
  506. la_load,
  507. la_getelementptr:
  508. begin
  509. if (taillvm(hp).oper[0]^.typ<>top_reg) or
  510. (taillvm(hp).oper[0]^.reg<>NR_NO) then
  511. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[0]^,false)+' = ')
  512. else
  513. nested:=true;
  514. opstart:=1;
  515. if llvmflag_load_getelptr_type in llvmversion_properties[current_settings.llvmversion] then
  516. begin
  517. owner.writer.AsmWrite(getopcodestr(taillvm(hp)));
  518. opdone:=true;
  519. if nested then
  520. owner.writer.AsmWrite(' (')
  521. else
  522. owner.writer.AsmWrite(' ');
  523. { can't just dereference the type, because it may be an
  524. implicit pointer type such as a class -> resort to string
  525. manipulation... Not very clean :( }
  526. tmpstr:=llvmencodetypename(taillvm(hp).spilling_get_reg_type(0));
  527. if op=la_getelementptr then
  528. begin
  529. if tmpstr[length(tmpstr)]<>'*' then
  530. begin
  531. writeln(tmpstr);
  532. internalerror(2016071101);
  533. end
  534. else
  535. setlength(tmpstr,length(tmpstr)-1);
  536. end;
  537. owner.writer.AsmWrite(tmpstr);
  538. owner.writer.AsmWrite(',');
  539. end
  540. end;
  541. la_ret, la_br, la_switch, la_indirectbr,
  542. la_resume,
  543. la_unreachable,
  544. la_store,
  545. la_fence,
  546. la_cmpxchg,
  547. la_atomicrmw,
  548. la_catch,
  549. la_filter,
  550. la_cleanup:
  551. begin
  552. { instructions that never have a result }
  553. end;
  554. la_call,
  555. la_invoke:
  556. begin
  557. if taillvm(hp).oper[1]^.reg<>NR_NO then
  558. owner.writer.AsmWrite(getregisterstring(taillvm(hp).oper[1]^.reg)+' = ');
  559. opstart:=2;
  560. if llvmflag_call_no_ptr in llvmversion_properties[current_settings.llvmversion] then
  561. begin
  562. owner.writer.AsmWrite(getopcodestr(taillvm(hp)));
  563. tmpstr:=llvm_callingconvention_name(taillvm(hp).oper[2]^.callingconvention);
  564. if tmpstr<>'' then
  565. begin
  566. owner.writer.AsmWrite(' "');
  567. owner.writer.AsmWrite(tmpstr);
  568. owner.writer.AsmWrite('"');
  569. end;
  570. opdone:=true;
  571. tmpstr:=llvmencodetypename(taillvm(hp).oper[3]^.def);
  572. if tmpstr[length(tmpstr)]<>'*' then
  573. begin
  574. writeln(tmpstr);
  575. internalerror(2016071102);
  576. end
  577. else
  578. setlength(tmpstr,length(tmpstr)-1);
  579. owner.writer.AsmWrite(tmpstr);
  580. opstart:=4;
  581. end;
  582. end;
  583. la_blockaddress:
  584. begin
  585. { nested -> no type }
  586. if owner.fdecllevel = 0 then
  587. begin
  588. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[0]^,false));
  589. owner.writer.AsmWrite(' ');
  590. end;
  591. owner.writer.AsmWrite('blockaddress(');
  592. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[1]^,false));
  593. { getopstr would add a "label" qualifier, which blockaddress does
  594. not want }
  595. owner.writer.AsmWrite(',%');
  596. with taillvm(hp).oper[2]^ do
  597. begin
  598. if (typ<>top_ref) or
  599. (ref^.refaddr<>addr_full) then
  600. internalerror(2016112001);
  601. owner.writer.AsmWrite(ref^.symbol.name);
  602. end;
  603. nested:=true;
  604. done:=true;
  605. end;
  606. la_alloca:
  607. begin
  608. owner.writer.AsmWrite(getreferencestring(taillvm(hp).oper[0]^.ref^,false)+' = ');
  609. sep:=' ';
  610. opstart:=1;
  611. end;
  612. la_trunc, la_zext, la_sext, la_fptrunc, la_fpext,
  613. la_fptoui, la_fptosi, la_uitofp, la_sitofp,
  614. la_ptrtoint, la_inttoptr,
  615. la_bitcast:
  616. begin
  617. { destination can be empty in case of nested constructs, or
  618. data initialisers }
  619. if (taillvm(hp).oper[0]^.typ<>top_reg) or
  620. (taillvm(hp).oper[0]^.reg<>NR_NO) then
  621. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[0]^,false)+' = ')
  622. else
  623. nested:=true;
  624. owner.writer.AsmWrite(getopcodestr(taillvm(hp)));
  625. if not nested then
  626. owner.writer.AsmWrite(' ')
  627. else
  628. owner.writer.AsmWrite(' (');
  629. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[1]^,false));
  630. { if there's a tai operand, its def is used instead of an
  631. explicit def operand }
  632. if taillvm(hp).ops=4 then
  633. begin
  634. owner.writer.AsmWrite(' ');
  635. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[2]^,false));
  636. opstart:=3;
  637. end
  638. else
  639. opstart:=2;
  640. owner.writer.AsmWrite(' to ');
  641. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[opstart]^,false));
  642. done:=true;
  643. end
  644. else
  645. begin
  646. if (taillvm(hp).oper[0]^.typ<>top_reg) or
  647. (taillvm(hp).oper[0]^.reg<>NR_NO) then
  648. begin
  649. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[0]^,true)+' = ');
  650. end
  651. else
  652. nested:=true;
  653. sep:=' ';
  654. opstart:=1
  655. end;
  656. end;
  657. { process operands }
  658. if not done then
  659. begin
  660. if not opdone then
  661. begin
  662. owner.writer.AsmWrite(getopcodestr(taillvm(hp)));
  663. if nested then
  664. owner.writer.AsmWrite(' (');
  665. end;
  666. if taillvm(hp).ops<>0 then
  667. begin
  668. for i:=opstart to taillvm(hp).ops-1 do
  669. begin
  670. owner.writer.AsmWrite(sep);
  671. { special invoke interjections: "to label X unwind label Y" }
  672. if (op=la_invoke) then
  673. case i of
  674. 6: owner.writer.AsmWrite('to ');
  675. 7: owner.writer.AsmWrite('unwind ');
  676. end;
  677. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[i]^,op in [la_load,la_store]));
  678. if (taillvm(hp).oper[i]^.typ in [top_def,top_cond,top_fpcond]) or
  679. (op in [la_call,la_invoke,la_landingpad,la_catch,la_filter,la_cleanup]) then
  680. sep :=' '
  681. else
  682. sep:=', ';
  683. end;
  684. end;
  685. end;
  686. if op=la_alloca then
  687. owner.writer.AsmWrite(getreferencealignstring(taillvm(hp).oper[0]^.ref^));
  688. if nested then
  689. owner.writer.AsmWrite(')')
  690. else if owner.fdecllevel=0 then
  691. owner.writer.AsmLn;
  692. end;
  693. function TLLVMInstrWriter.getopcodestr(hp: taillvm): TSymStr;
  694. begin
  695. result:=llvm_op2str[hp.llvmopcode];
  696. case hp.llvmopcode of
  697. la_load:
  698. begin
  699. if vol_read in hp.oper[2]^.ref^.volatility then
  700. result:=result+' volatile';
  701. end;
  702. la_store:
  703. begin
  704. if vol_write in hp.oper[3]^.ref^.volatility then
  705. result:=result+' volatile';
  706. end;
  707. end;
  708. end;
  709. {****************************************************************************}
  710. { LLVM Assembler writer }
  711. {****************************************************************************}
  712. destructor TLLVMAssember.Destroy;
  713. begin
  714. InstrWriter.free;
  715. ffuncinlasmdecorator.free;
  716. inherited destroy;
  717. end;
  718. procedure TLLVMAssember.WriteTree(p:TAsmList);
  719. var
  720. hp : tai;
  721. InlineLevel : cardinal;
  722. asmblock: boolean;
  723. do_line : boolean;
  724. replaceforbidden: boolean;
  725. begin
  726. if not assigned(p) then
  727. exit;
  728. replaceforbidden:=asminfo^.dollarsign<>'$';
  729. InlineLevel:=0;
  730. asmblock:=false;
  731. { lineinfo is only needed for al_procedures (PFV) }
  732. do_line:=(cs_asm_source in current_settings.globalswitches) or
  733. ((cs_lineinfo in current_settings.moduleswitches)
  734. and (p=current_asmdata.asmlists[al_procedures]));
  735. hp:=tai(p.first);
  736. while assigned(hp) do
  737. begin
  738. prefetch(pointer(hp.next)^);
  739. if not(hp.typ in SkipLineInfo) then
  740. begin
  741. current_filepos:=tailineinfo(hp).fileinfo;
  742. { no line info for inlined code }
  743. if do_line and (inlinelevel=0) then
  744. WriteSourceLine(hp as tailineinfo);
  745. end;
  746. WriteTai(replaceforbidden, do_line, InlineLevel, asmblock, hp);
  747. hp:=tai(hp.next);
  748. end;
  749. end;
  750. procedure TLLVMAssember.WriteExtraHeader;
  751. begin
  752. writer.AsmWrite('target datalayout = "');
  753. writer.AsmWrite(target_info.llvmdatalayout);
  754. writer.AsmWriteln('"');
  755. writer.AsmWrite('target triple = "');
  756. writer.AsmWrite(llvm_target_name);
  757. writer.AsmWriteln('"');
  758. end;
  759. procedure TLLVMAssember.WriteExtraFooter;
  760. begin
  761. end;
  762. procedure TLLVMAssember.WriteInstruction(hp: tai);
  763. begin
  764. end;
  765. procedure TLLVMAssember.WriteLlvmInstruction(hp: tai);
  766. begin
  767. InstrWriter.WriteInstruction(hp);
  768. end;
  769. procedure TLLVMAssember.WriteRealConst(hp: tai_realconst; do_line: boolean);
  770. begin
  771. if fdecllevel=0 then
  772. begin
  773. case tai_realconst(hp).realtyp of
  774. aitrealconst_s32bit:
  775. writer.AsmWriteLn(asminfo^.comment+'value: '+single2str(tai_realconst(hp).value.s32val));
  776. aitrealconst_s64bit:
  777. writer.AsmWriteLn(asminfo^.comment+'value: '+double2str(tai_realconst(hp).value.s64val));
  778. {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
  779. { can't write full 80 bit floating point constants yet on non-x86 }
  780. aitrealconst_s80bit:
  781. writer.AsmWriteLn(asminfo^.comment+'value: '+extended2str(tai_realconst(hp).value.s80val));
  782. {$endif cpuextended}
  783. aitrealconst_s64comp:
  784. writer.AsmWriteLn(asminfo^.comment+'value: '+extended2str(tai_realconst(hp).value.s64compval));
  785. else
  786. internalerror(2014050604);
  787. end;
  788. internalerror(2016120202);
  789. end;
  790. case hp.realtyp of
  791. aitrealconst_s32bit:
  792. writer.AsmWrite(llvmdoubletostr(hp.value.s32val));
  793. aitrealconst_s64bit:
  794. writer.AsmWriteln(llvmdoubletostr(hp.value.s64val));
  795. {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
  796. aitrealconst_s80bit:
  797. writer.AsmWrite(llvmextendedtostr(hp.value.s80val));
  798. {$endif defined(cpuextended)}
  799. aitrealconst_s64comp:
  800. { handled as int64 most of the time in llvm }
  801. writer.AsmWrite(tostr(round(hp.value.s64compval)));
  802. else
  803. internalerror(2014062401);
  804. end;
  805. end;
  806. procedure TLLVMAssember.WriteOrdConst(hp: tai_const);
  807. var
  808. consttyp: taiconst_type;
  809. begin
  810. if fdecllevel=0 then
  811. internalerror(2016120203);
  812. consttyp:=hp.consttype;
  813. case consttyp of
  814. aitconst_got,
  815. aitconst_gotoff_symbol,
  816. aitconst_uleb128bit,
  817. aitconst_sleb128bit,
  818. aitconst_rva_symbol,
  819. aitconst_secrel32_symbol,
  820. aitconst_darwin_dwarf_delta32,
  821. aitconst_darwin_dwarf_delta64,
  822. aitconst_half16bit,
  823. aitconst_gs:
  824. internalerror(2014052901);
  825. aitconst_128bit,
  826. aitconst_64bit,
  827. aitconst_32bit,
  828. aitconst_16bit,
  829. aitconst_8bit,
  830. aitconst_16bit_unaligned,
  831. aitconst_32bit_unaligned,
  832. aitconst_64bit_unaligned:
  833. begin
  834. if fdecllevel=0 then
  835. writer.AsmWrite(asminfo^.comment);
  836. { can't have compile-time differences between symbols; these are
  837. normally for PIC, but llvm takes care of that for us }
  838. if assigned(hp.endsym) then
  839. internalerror(2014052902);
  840. if assigned(hp.sym) then
  841. begin
  842. writer.AsmWrite(LlvmAsmSymName(hp.sym));
  843. { can't have offsets }
  844. if hp.value<>0 then
  845. if fdecllevel<>0 then
  846. internalerror(2014052903)
  847. else
  848. writer.AsmWrite(' -- symbol offset: ' + tostr(hp.value));
  849. end
  850. else if hp.value=0 then
  851. writer.AsmWrite('zeroinitializer')
  852. else
  853. writer.AsmWrite(tostr(hp.value));
  854. {
  855. // activate in case of debugging IE 2016120203
  856. if fdecllevel=0 then
  857. writer.AsmLn;
  858. }
  859. end;
  860. else
  861. internalerror(200704251);
  862. end;
  863. end;
  864. procedure TLLVMAssember.WriteTai(const replaceforbidden: boolean; const do_line: boolean; var InlineLevel: cardinal; var asmblock: boolean; var hp: tai);
  865. procedure WriteLinkageVibilityFlags(bind: TAsmSymBind);
  866. begin
  867. case bind of
  868. AB_EXTERNAL,
  869. AB_EXTERNAL_INDIRECT:
  870. writer.AsmWrite(' external');
  871. AB_COMMON:
  872. writer.AsmWrite(' common');
  873. AB_LOCAL:
  874. writer.AsmWrite(' internal');
  875. AB_GLOBAL,
  876. AB_INDIRECT:
  877. ;
  878. AB_WEAK_EXTERNAL:
  879. writer.AsmWrite(' extern_weak');
  880. AB_PRIVATE_EXTERN:
  881. begin
  882. if not(llvmflag_linker_private in llvmversion_properties[current_settings.llvmversion]) then
  883. writer.AsmWrite(' hidden')
  884. else
  885. writer.AsmWrite(' linker_private');
  886. end
  887. else
  888. internalerror(2014020104);
  889. end;
  890. end;
  891. procedure WriteFunctionFlags(pd: tprocdef);
  892. begin
  893. if (pos('FPC_SETJMP',upper(pd.mangledname))<>0) or
  894. (pd.mangledname=(target_info.cprefix+'setjmp')) then
  895. writer.AsmWrite(' returns_twice');
  896. if po_inline in pd.procoptions then
  897. writer.AsmWrite(' inlinehint');
  898. if po_noinline in pd.procoptions then
  899. writer.AsmWrite(' noinline');
  900. { ensure that functions that happen to have the same name as a
  901. standard C library function, but which are implemented in Pascal,
  902. are not considered to have the same semantics as the C function with
  903. the same name }
  904. if not(po_external in pd.procoptions) then
  905. writer.AsmWrite(' nobuiltin');
  906. if po_noreturn in pd.procoptions then
  907. writer.AsmWrite(' noreturn');
  908. end;
  909. procedure WriteTypedConstData(hp: tai_abstracttypedconst);
  910. var
  911. p: tai_abstracttypedconst;
  912. pval: tai;
  913. defstr: TSymStr;
  914. first, gotstring: boolean;
  915. begin
  916. defstr:=llvmencodetypename(hp.def);
  917. { write the struct, array or simple type }
  918. case hp.adetyp of
  919. tck_record:
  920. begin
  921. writer.AsmWrite(defstr);
  922. writer.AsmWrite(' <{');
  923. first:=true;
  924. for p in tai_aggregatetypedconst(hp) do
  925. begin
  926. if not first then
  927. writer.AsmWrite(', ')
  928. else
  929. first:=false;
  930. WriteTypedConstData(p);
  931. end;
  932. writer.AsmWrite('}>');
  933. end;
  934. tck_array:
  935. begin
  936. writer.AsmWrite(defstr);
  937. first:=true;
  938. gotstring:=false;
  939. for p in tai_aggregatetypedconst(hp) do
  940. begin
  941. if not first then
  942. writer.AsmWrite(',')
  943. else
  944. begin
  945. writer.AsmWrite(' ');
  946. if (tai_abstracttypedconst(p).adetyp=tck_simple) and
  947. (tai_simpletypedconst(p).val.typ=ait_string) then
  948. begin
  949. gotstring:=true;
  950. end
  951. else
  952. begin
  953. writer.AsmWrite('[');
  954. end;
  955. first:=false;
  956. end;
  957. { cannot concat strings and other things }
  958. if gotstring and
  959. ((tai_abstracttypedconst(p).adetyp<>tck_simple) or
  960. (tai_simpletypedconst(p).val.typ<>ait_string)) then
  961. internalerror(2014062701);
  962. WriteTypedConstData(p);
  963. end;
  964. if not gotstring then
  965. writer.AsmWrite(']');
  966. end;
  967. tck_simple:
  968. begin
  969. pval:=tai_simpletypedconst(hp).val;
  970. if pval.typ<>ait_string then
  971. begin
  972. writer.AsmWrite(defstr);
  973. writer.AsmWrite(' ');
  974. end;
  975. WriteTai(replaceforbidden,do_line,InlineLevel,asmblock,pval);
  976. end;
  977. end;
  978. end;
  979. var
  980. hp2: tai;
  981. s: string;
  982. sstr: TSymStr;
  983. i: longint;
  984. ch: ansichar;
  985. begin
  986. case hp.typ of
  987. ait_comment :
  988. begin
  989. writer.AsmWrite(asminfo^.comment);
  990. writer.AsmWritePChar(tai_comment(hp).str);
  991. if fdecllevel<>0 then
  992. internalerror(2015090601);
  993. writer.AsmLn;
  994. end;
  995. ait_regalloc :
  996. begin
  997. if (cs_asm_regalloc in current_settings.globalswitches) then
  998. begin
  999. writer.AsmWrite(#9+asminfo^.comment+'Register ');
  1000. repeat
  1001. writer.AsmWrite(std_regname(Tai_regalloc(hp).reg));
  1002. if (hp.next=nil) or
  1003. (tai(hp.next).typ<>ait_regalloc) or
  1004. (tai_regalloc(hp.next).ratype<>tai_regalloc(hp).ratype) then
  1005. break;
  1006. hp:=tai(hp.next);
  1007. writer.AsmWrite(',');
  1008. until false;
  1009. writer.AsmWrite(' ');
  1010. writer.AsmWriteLn(regallocstr[tai_regalloc(hp).ratype]);
  1011. end;
  1012. end;
  1013. ait_tempalloc :
  1014. begin
  1015. if (cs_asm_tempalloc in current_settings.globalswitches) then
  1016. WriteTempalloc(tai_tempalloc(hp));
  1017. end;
  1018. ait_align,
  1019. ait_section :
  1020. begin
  1021. { ignore, specified as part of declarations -- don't write
  1022. comment, because could appear in the middle of an aggregate
  1023. constant definition }
  1024. end;
  1025. ait_datablock :
  1026. begin
  1027. writer.AsmWrite(asminfo^.comment);
  1028. writer.AsmWriteln('datablock');
  1029. end;
  1030. ait_const:
  1031. begin
  1032. WriteOrdConst(tai_const(hp));
  1033. end;
  1034. ait_realconst :
  1035. begin
  1036. WriteRealConst(tai_realconst(hp), do_line);
  1037. end;
  1038. ait_string :
  1039. begin
  1040. if fdecllevel=0 then
  1041. internalerror(2016120201);
  1042. writer.AsmWrite('c"');
  1043. for i:=1 to tai_string(hp).len do
  1044. begin
  1045. ch:=tai_string(hp).str[i-1];
  1046. case ch of
  1047. #0, {This can't be done by range, because a bug in FPC}
  1048. #1..#31,
  1049. #128..#255,
  1050. '"',
  1051. '\' : s:='\'+hexStr(ord(ch),2);
  1052. else
  1053. s:=ch;
  1054. end;
  1055. writer.AsmWrite(s);
  1056. end;
  1057. writer.AsmWrite('"');
  1058. end;
  1059. ait_label :
  1060. begin
  1061. if not asmblock and
  1062. (tai_label(hp).labsym.is_used) then
  1063. begin
  1064. if (tai_label(hp).labsym.bind=AB_PRIVATE_EXTERN) then
  1065. begin
  1066. { should be emitted as part of the variable/function def }
  1067. internalerror(2013010703);
  1068. end;
  1069. if tai_label(hp).labsym.bind in [AB_GLOBAL, AB_PRIVATE_EXTERN] then
  1070. begin
  1071. { should be emitted as part of the variable/function def }
  1072. //internalerror(2013010704);
  1073. writer.AsmWriteln(asminfo^.comment+'global/privateextern label: '+tai_label(hp).labsym.name);
  1074. end;
  1075. if replaceforbidden then
  1076. writer.AsmWrite(ReplaceForbiddenAsmSymbolChars(tai_label(hp).labsym.name))
  1077. else
  1078. writer.AsmWrite(tai_label(hp).labsym.name);
  1079. writer.AsmWriteLn(':');
  1080. end;
  1081. end;
  1082. ait_symbol :
  1083. begin
  1084. if fdecllevel=0 then
  1085. writer.AsmWrite(asminfo^.comment);
  1086. writer.AsmWriteln(LlvmAsmSymName(tai_symbol(hp).sym));
  1087. { todo }
  1088. if tai_symbol(hp).has_value then
  1089. internalerror(2014062402);
  1090. end;
  1091. ait_llvmdecl:
  1092. begin
  1093. if taillvmdecl(hp).def.typ=procdef then
  1094. begin
  1095. if not(ldf_definition in taillvmdecl(hp).flags) then
  1096. begin
  1097. writer.AsmWrite('declare');
  1098. writer.AsmWrite(llvmencodeproctype(tprocdef(taillvmdecl(hp).def), taillvmdecl(hp).namesym.name, lpd_decl));
  1099. WriteFunctionFlags(tprocdef(taillvmdecl(hp).def));
  1100. writer.AsmLn;
  1101. end
  1102. else
  1103. begin
  1104. writer.AsmWrite('define');
  1105. if ldf_weak in taillvmdecl(hp).flags then
  1106. writer.AsmWrite(' weak');
  1107. WriteLinkageVibilityFlags(taillvmdecl(hp).namesym.bind);
  1108. writer.AsmWrite(llvmencodeproctype(tprocdef(taillvmdecl(hp).def), '', lpd_def));
  1109. WriteFunctionFlags(tprocdef(taillvmdecl(hp).def));
  1110. if assigned(tprocdef(taillvmdecl(hp).def).personality) then
  1111. begin
  1112. writer.AsmWrite(' personality i8* bitcast (');
  1113. writer.AsmWrite(llvmencodeproctype(tprocdef(taillvmdecl(hp).def).personality, '', lpd_procvar));
  1114. writer.AsmWrite('* ');
  1115. writer.AsmWrite(llvmmangledname(tprocdef(taillvmdecl(hp).def).personality.mangledname));
  1116. writer.AsmWrite(' to i8*)');
  1117. end;
  1118. writer.AsmWriteln(' {');
  1119. end;
  1120. end
  1121. else
  1122. begin
  1123. writer.AsmWrite(LlvmAsmSymName(taillvmdecl(hp).namesym));
  1124. writer.AsmWrite(' =');
  1125. if ldf_weak in taillvmdecl(hp).flags then
  1126. writer.AsmWrite(' weak');
  1127. if ldf_appending in taillvmdecl(hp).flags then
  1128. writer.AsmWrite(' appending');
  1129. WriteLinkageVibilityFlags(taillvmdecl(hp).namesym.bind);
  1130. writer.AsmWrite(' ');
  1131. if (ldf_tls in taillvmdecl(hp).flags) then
  1132. writer.AsmWrite('thread_local ');
  1133. if ldf_unnamed_addr in taillvmdecl(hp).flags then
  1134. writer.AsmWrite('unnamed_addr ');
  1135. if taillvmdecl(hp).sec in [sec_rodata,sec_rodata_norel] then
  1136. writer.AsmWrite('constant ')
  1137. else
  1138. writer.AsmWrite('global ');
  1139. if not assigned(taillvmdecl(hp).initdata) then
  1140. begin
  1141. writer.AsmWrite(llvmencodetypename(taillvmdecl(hp).def));
  1142. if not(taillvmdecl(hp).namesym.bind in [AB_EXTERNAL, AB_WEAK_EXTERNAL,AB_EXTERNAL_INDIRECT]) then
  1143. writer.AsmWrite(' zeroinitializer');
  1144. end
  1145. else
  1146. begin
  1147. inc(fdecllevel);
  1148. { can't have an external symbol with initialisation data }
  1149. if taillvmdecl(hp).namesym.bind in [AB_EXTERNAL, AB_WEAK_EXTERNAL] then
  1150. internalerror(2014052905);
  1151. { bitcast initialisation data to the type of the constant }
  1152. { write initialisation data }
  1153. hp2:=tai(taillvmdecl(hp).initdata.first);
  1154. while assigned(hp2) do
  1155. begin
  1156. WriteTai(replaceforbidden,do_line,InlineLevel,asmblock,hp2);
  1157. hp2:=tai(hp2.next);
  1158. end;
  1159. dec(fdecllevel);
  1160. end;
  1161. { custom section name? }
  1162. case taillvmdecl(hp).sec of
  1163. sec_user:
  1164. begin
  1165. writer.AsmWrite(', section "');
  1166. writer.AsmWrite(taillvmdecl(hp).secname);
  1167. writer.AsmWrite('"');
  1168. end;
  1169. low(TObjCAsmSectionType)..high(TObjCAsmSectionType):
  1170. begin
  1171. writer.AsmWrite(', section "');
  1172. writer.AsmWrite(objc_section_name(taillvmdecl(hp).sec));
  1173. writer.AsmWrite('"');
  1174. end;
  1175. end;
  1176. { sections whose name starts with 'llvm.' are for LLVM
  1177. internal use and don't have an alignment }
  1178. if pos('llvm.',taillvmdecl(hp).secname)<>1 then
  1179. begin
  1180. { alignment }
  1181. writer.AsmWrite(', align ');
  1182. writer.AsmWriteln(tostr(taillvmdecl(hp).alignment));
  1183. end
  1184. else
  1185. writer.AsmLn;
  1186. end;
  1187. end;
  1188. ait_llvmalias:
  1189. begin
  1190. writer.AsmWrite(LlvmAsmSymName(taillvmalias(hp).newsym));
  1191. writer.AsmWrite(' = alias ');
  1192. WriteLinkageVibilityFlags(taillvmalias(hp).bind);
  1193. if taillvmalias(hp).def.typ=procdef then
  1194. sstr:=llvmencodeproctype(tabstractprocdef(taillvmalias(hp).def), '', lpd_alias)
  1195. else
  1196. sstr:=llvmencodetypename(taillvmalias(hp).def);
  1197. writer.AsmWrite(sstr);
  1198. if llvmflag_alias_double_type in llvmversion_properties[current_settings.llvmversion] then
  1199. begin
  1200. writer.AsmWrite(', ');
  1201. writer.AsmWrite(sstr);
  1202. end;
  1203. writer.AsmWrite('* ');
  1204. writer.AsmWriteln(LlvmAsmSymName(taillvmalias(hp).oldsym));
  1205. end;
  1206. ait_symbolpair:
  1207. begin
  1208. { should be emitted as part of the symbol def }
  1209. internalerror(2013010708);
  1210. end;
  1211. ait_symbol_end :
  1212. begin
  1213. if tai_symbol_end(hp).sym.typ=AT_FUNCTION then
  1214. writer.AsmWriteln('}')
  1215. else
  1216. writer.AsmWriteln('; ait_symbol_end error, should not be generated');
  1217. // internalerror(2013010711);
  1218. end;
  1219. ait_instruction :
  1220. begin
  1221. WriteInstruction(hp);
  1222. end;
  1223. ait_llvmins:
  1224. begin
  1225. WriteLlvmInstruction(hp);
  1226. end;
  1227. ait_stab :
  1228. begin
  1229. internalerror(2013010712);
  1230. end;
  1231. ait_force_line,
  1232. ait_function_name :
  1233. ;
  1234. ait_cutobject :
  1235. begin
  1236. end;
  1237. ait_marker :
  1238. case
  1239. tai_marker(hp).kind of
  1240. mark_NoLineInfoStart:
  1241. inc(InlineLevel);
  1242. mark_NoLineInfoEnd:
  1243. dec(InlineLevel);
  1244. { these cannot be nested }
  1245. mark_AsmBlockStart:
  1246. asmblock:=true;
  1247. mark_AsmBlockEnd:
  1248. asmblock:=false;
  1249. end;
  1250. ait_directive :
  1251. begin
  1252. { CPU directive is commented out for the LLVM }
  1253. if tai_directive(hp).directive=asd_cpu then
  1254. writer.AsmWrite(asminfo^.comment);
  1255. WriteDirectiveName(tai_directive(hp).directive);
  1256. if tai_directive(hp).name <>'' then
  1257. writer.AsmWrite(tai_directive(hp).name);
  1258. if fdecllevel<>0 then
  1259. internalerror(2015090602);
  1260. writer.AsmLn;
  1261. end;
  1262. ait_seh_directive :
  1263. begin
  1264. internalerror(2013010713);
  1265. end;
  1266. ait_varloc:
  1267. begin
  1268. if tai_varloc(hp).newlocationhi<>NR_NO then
  1269. writer.AsmWrite(strpnew('Var '+tai_varloc(hp).varsym.realname+' located in register '+
  1270. std_regname(tai_varloc(hp).newlocationhi)+':'+std_regname(tai_varloc(hp).newlocation)))
  1271. else
  1272. writer.AsmWrite(strpnew('Var '+tai_varloc(hp).varsym.realname+' located in register '+
  1273. std_regname(tai_varloc(hp).newlocation)));
  1274. if fdecllevel<>0 then
  1275. internalerror(2015090603);
  1276. writer.AsmLn;
  1277. end;
  1278. ait_typedconst:
  1279. begin
  1280. WriteTypedConstData(tai_abstracttypedconst(hp));
  1281. end
  1282. else
  1283. internalerror(2019012001);
  1284. end;
  1285. end;
  1286. constructor TLLVMAssember.CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter, smart: boolean);
  1287. begin
  1288. inherited;
  1289. InstrWriter:=TLLVMInstrWriter.create(self);
  1290. end;
  1291. procedure TLLVMAssember.WriteDirectiveName(dir: TAsmDirective);
  1292. begin
  1293. writer.AsmWrite('.'+directivestr[dir]+' ');
  1294. end;
  1295. procedure TLLVMAssember.WriteAsmList;
  1296. var
  1297. hal : tasmlisttype;
  1298. i: longint;
  1299. a: TExternalAssembler;
  1300. decorator: TLLVMModuleInlineAssemblyDecorator;
  1301. begin
  1302. WriteExtraHeader;
  1303. for hal:=low(TasmlistType) to high(TasmlistType) do
  1304. begin
  1305. if not assigned(current_asmdata.asmlists[hal]) or
  1306. current_asmdata.asmlists[hal].Empty then
  1307. continue;
  1308. writer.AsmWriteLn(asminfo^.comment+'Begin asmlist '+AsmlistTypeStr[hal]);
  1309. if hal<>al_pure_assembler then
  1310. writetree(current_asmdata.asmlists[hal])
  1311. else
  1312. begin
  1313. { write routines using the target-specific external assembler
  1314. writer, filtered using the LLVM module-level assembly
  1315. decorator }
  1316. decorator:=TLLVMModuleInlineAssemblyDecorator.Create;
  1317. writer.decorator:=decorator;
  1318. a:=GetExternalGnuAssemblerWithAsmInfoWriter(asminfo,writer);
  1319. a.WriteTree(current_asmdata.asmlists[hal]);
  1320. writer.decorator:=nil;
  1321. decorator.free;
  1322. a.free;
  1323. end;
  1324. writer.AsmWriteLn(asminfo^.comment+'End asmlist '+AsmlistTypeStr[hal]);
  1325. end;
  1326. writer.AsmLn;
  1327. end;
  1328. procedure TLLVMAssember.WriteFunctionInlineAsmList(list: tasmlist);
  1329. var
  1330. a: TExternalAssembler;
  1331. begin
  1332. if not assigned(ffuncinlasmdecorator) then
  1333. ffuncinlasmdecorator:=TLLVMFunctionInlineAssemblyDecorator.create;
  1334. if assigned(writer.decorator) then
  1335. internalerror(2016110201);
  1336. writer.decorator:=ffuncinlasmdecorator;
  1337. a:=GetExternalGnuAssemblerWithAsmInfoWriter(asminfo,writer);
  1338. a.WriteTree(list);
  1339. a.free;
  1340. writer.decorator:=nil;
  1341. end;
  1342. {****************************************************************************}
  1343. { LLVM Instruction Writer }
  1344. {****************************************************************************}
  1345. constructor TLLVMInstrWriter.create(_owner: TLLVMAssember);
  1346. begin
  1347. inherited create;
  1348. owner := _owner;
  1349. end;
  1350. {****************************************************************************}
  1351. { llc Assember }
  1352. {****************************************************************************}
  1353. function TLLVMLLCAssember.MakeCmdLine: TCmdStr;
  1354. var
  1355. optstr: TCmdStr;
  1356. begin
  1357. result:=inherited;
  1358. { standard optimization flags for llc -- todo: this needs to be split
  1359. into a call to opt and one to llc }
  1360. if cs_opt_level3 in current_settings.optimizerswitches then
  1361. optstr:='-O3'
  1362. else if cs_opt_level2 in current_settings.optimizerswitches then
  1363. optstr:='-O2'
  1364. else if cs_opt_level1 in current_settings.optimizerswitches then
  1365. optstr:='-O1'
  1366. else
  1367. optstr:='-O0';
  1368. { stack frame elimination }
  1369. if not(cs_opt_stackframe in current_settings.optimizerswitches) then
  1370. optstr:=optstr+' -disable-fp-elim';
  1371. { fast math }
  1372. if cs_opt_fastmath in current_settings.optimizerswitches then
  1373. optstr:=optstr+' -enable-unsafe-fp-math -fp-contract=fast'; { -enable-fp-mad support depends on version }
  1374. { smart linking }
  1375. if cs_create_smart in current_settings.moduleswitches then
  1376. optstr:=optstr+' -data-sections -function-sections';
  1377. { pic }
  1378. if cs_create_pic in current_settings.moduleswitches then
  1379. optstr:=optstr+' -relocation-model=pic'
  1380. else if not(target_info.system in systems_darwin) then
  1381. optstr:=optstr+' -relocation-model=static'
  1382. else
  1383. optstr:=optstr+' -relocation-model=dynamic-no-pic';
  1384. { force object output instead of textual assembler code }
  1385. optstr:=optstr+' -filetype=obj';
  1386. if fputypestrllvm[current_settings.fputype]<>'' then
  1387. optstr:=optstr+' -mattr=+'+fputypestrllvm[current_settings.fputype];
  1388. replace(result,'$OPT',optstr);
  1389. end;
  1390. {****************************************************************************}
  1391. { clang Assember }
  1392. {****************************************************************************}
  1393. function TLLVMClangAssember.MakeCmdLine: TCmdStr;
  1394. var
  1395. optstr: TCmdStr;
  1396. begin
  1397. result:=inherited;
  1398. { standard optimization flags for llc -- todo: this needs to be split
  1399. into a call to opt and one to llc }
  1400. if cs_opt_level3 in current_settings.optimizerswitches then
  1401. optstr:='-O3'
  1402. else if cs_opt_level2 in current_settings.optimizerswitches then
  1403. optstr:='-O2'
  1404. else if cs_opt_level1 in current_settings.optimizerswitches then
  1405. optstr:='-O1'
  1406. else
  1407. optstr:='-O0';
  1408. { stack frame elimination }
  1409. if not(cs_opt_stackframe in current_settings.optimizerswitches) then
  1410. optstr:=optstr+' -fno-omit-frame-pointer'
  1411. else
  1412. optstr:=optstr+' -fomit-frame-pointer';
  1413. { fast math }
  1414. if cs_opt_fastmath in current_settings.optimizerswitches then
  1415. optstr:=optstr+' -ffast-math';
  1416. { smart linking }
  1417. if cs_create_smart in current_settings.moduleswitches then
  1418. optstr:=optstr+' -fdata-sections -ffunction-sections';
  1419. { pic }
  1420. if cs_create_pic in current_settings.moduleswitches then
  1421. optstr:=optstr+' -fpic'
  1422. else if not(target_info.system in systems_darwin) then
  1423. optstr:=optstr+' -static'
  1424. else
  1425. optstr:=optstr+' -mdynamic-no-pic';
  1426. if target_info.system in (systems_darwin-[system_i386_iphonesim,system_arm_darwin,system_aarch64_darwin,system_x86_64_iphonesim]) then
  1427. begin
  1428. if MacOSXVersionMin<>'' then
  1429. optstr:=optstr+' -mmacosx-version-min='+MacOSXVersionMin
  1430. end
  1431. else if target_info.system in [system_i386_iphonesim,system_arm_darwin,system_aarch64_darwin,system_x86_64_iphonesim] then
  1432. begin
  1433. if iPhoneOSVersionMin<>'' then
  1434. optstr:=optstr+' -mios-version-min='+iPhoneOSVersionMin;
  1435. end
  1436. else
  1437. begin
  1438. optstr:=optstr+' --target='+llvm_target_name;
  1439. end;
  1440. if fputypestrllvm[current_settings.fputype]<>'' then
  1441. optstr:=optstr+' -m'+fputypestrllvm[current_settings.fputype];
  1442. replace(result,'$OPT',optstr);
  1443. end;
  1444. const
  1445. as_llvm_llc_info : tasminfo =
  1446. (
  1447. id : as_llvm_llc;
  1448. idtxt : 'LLVM-LLC';
  1449. asmbin : 'llc';
  1450. asmcmd: '$OPT -o $OBJ $ASM';
  1451. supported_targets : [system_x86_64_linux,system_x86_64_darwin,system_aarch64_linux,system_arm_linux];
  1452. flags : [af_smartlink_sections];
  1453. labelprefix : 'L';
  1454. comment : '; ';
  1455. dollarsign: '$';
  1456. );
  1457. as_llvm_clang_info : tasminfo =
  1458. (
  1459. id : as_llvm_clang;
  1460. idtxt : 'LLVM-CLANG';
  1461. asmbin : 'clang';
  1462. asmcmd: '$OPT -c -o $OBJ $ASM';
  1463. supported_targets : [system_x86_64_linux,system_x86_64_darwin,system_aarch64_linux,system_arm_linux];
  1464. flags : [af_smartlink_sections];
  1465. labelprefix : 'L';
  1466. comment : '; ';
  1467. dollarsign: '$';
  1468. );
  1469. begin
  1470. RegisterAssembler(as_llvm_llc_info,TLLVMLLCAssember);
  1471. RegisterAssembler(as_llvm_clang_info,TLLVMClangAssember);
  1472. end.