agllvm.pas 60 KB

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