agllvm.pas 62 KB

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