agllvm.pas 56 KB

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