agllvm.pas 57 KB

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