agllvm.pas 56 KB

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