2
0

agllvm.pas 58 KB

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