agllvm.pas 56 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658
  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. op: tllvmop;
  476. tmpstr,
  477. sep: TSymStr;
  478. i, opstart: longint;
  479. nested: boolean;
  480. opdone,
  481. done: boolean;
  482. begin
  483. op:=taillvm(hp).llvmopcode;
  484. { we write everything immediately rather than adding it into a string,
  485. because operands may contain other tai that will also write things out
  486. (and their output must come after everything that was processed in this
  487. instruction, such as its opcode or previous operands) }
  488. if owner.fdecllevel=0 then
  489. owner.writer.AsmWrite(#9);
  490. sep:=' ';
  491. opdone:=false;
  492. done:=false;
  493. opstart:=0;
  494. nested:=false;
  495. case op of
  496. la_type:
  497. begin
  498. owner.writer.AsmWrite(llvmtypeidentifier(taillvm(hp).oper[0]^.def));
  499. owner.writer.AsmWrite(' = type ');
  500. owner.writer.AsmWrite(llvmencodetypedecl(taillvm(hp).oper[0]^.def));
  501. done:=true;
  502. end;
  503. la_asmblock:
  504. begin
  505. owner.writer.AsmWrite('call void asm sideeffect "');
  506. owner.WriteFunctionInlineAsmList(taillvm(hp).oper[0]^.asmlist);
  507. owner.writer.AsmWrite('","');
  508. { we pass all accessed local variables as in/out address parameters,
  509. since we don't analyze the assembly code to determine what exactly
  510. happens to them; this is also compatible with the regular code
  511. generators, which always place local place local variables
  512. accessed from assembly code in memory }
  513. for i:=0 to taillvm(hp).oper[1]^.paras.Count-1 do
  514. begin
  515. owner.writer.AsmWrite('=*m,');
  516. end;
  517. owner.writer.AsmWrite('~{memory},~{fpsr},~{flags}');
  518. WriteAsmRegisterAllocationClobbers(taillvm(hp).oper[0]^.asmlist);
  519. owner.writer.AsmWrite('"');
  520. writeparas(taillvm(hp).oper[1]^.paras);
  521. done:=true;
  522. end;
  523. la_load,
  524. la_getelementptr:
  525. begin
  526. if (taillvm(hp).oper[0]^.typ<>top_reg) or
  527. (taillvm(hp).oper[0]^.reg<>NR_NO) then
  528. owner.writer.AsmWrite(getopstr(taillvm(hp).oper[0]^,false)+' = ')
  529. else
  530. nested:=true;
  531. opstart:=1;
  532. owner.writer.AsmWrite(getopcodestr(taillvm(hp)));
  533. opdone:=true;
  534. if nested then
  535. owner.writer.AsmWrite(' (')
  536. else
  537. owner.writer.AsmWrite(' ');
  538. { can't just dereference the type, because it may be an
  539. implicit pointer type such as a class -> resort to string
  540. manipulation... Not very clean :( }
  541. tmpstr:=llvmencodetypename(taillvm(hp).spilling_get_reg_type(0));
  542. if op=la_getelementptr then
  543. begin
  544. if tmpstr[length(tmpstr)]<>'*' then
  545. begin
  546. writeln(tmpstr);
  547. internalerror(2016071101);
  548. end
  549. else
  550. setlength(tmpstr,length(tmpstr)-1);
  551. end;
  552. owner.writer.AsmWrite(tmpstr);
  553. owner.writer.AsmWrite(',');
  554. end;
  555. la_ret, la_br, la_switch, la_indirectbr,
  556. la_resume,
  557. la_unreachable,
  558. la_store,
  559. la_fence,
  560. la_cmpxchg,
  561. la_atomicrmw,
  562. la_catch,
  563. la_filter,
  564. la_cleanup:
  565. begin
  566. { instructions that never have a result }
  567. end;
  568. la_call,
  569. la_invoke:
  570. begin
  571. if taillvm(hp).oper[1]^.reg<>NR_NO then
  572. owner.writer.AsmWrite(getregisterstring(taillvm(hp).oper[1]^.reg)+' = ');
  573. opstart:=2;
  574. owner.writer.AsmWrite(getopcodestr(taillvm(hp)));
  575. tmpstr:=llvm_callingconvention_name(taillvm(hp).oper[2]^.callingconvention);
  576. if tmpstr<>'' then
  577. begin
  578. owner.writer.AsmWrite(' ');
  579. owner.writer.AsmWrite(tmpstr);
  580. end;
  581. opdone:=true;
  582. tmpstr:=llvmencodetypename(taillvm(hp).oper[3]^.def);
  583. if tmpstr[length(tmpstr)]<>'*' then
  584. begin
  585. writeln(tmpstr);
  586. internalerror(2016071102);
  587. end
  588. else
  589. setlength(tmpstr,length(tmpstr)-1);
  590. owner.writer.AsmWrite(tmpstr);
  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. if nested then
  699. owner.writer.AsmWrite(')')
  700. else if owner.fdecllevel=0 then
  701. owner.writer.AsmLn;
  702. end;
  703. function TLLVMInstrWriter.getopcodestr(hp: taillvm): TSymStr;
  704. begin
  705. result:=llvm_op2str[hp.llvmopcode];
  706. case hp.llvmopcode of
  707. la_load:
  708. begin
  709. if vol_read in hp.oper[2]^.ref^.volatility then
  710. result:=result+' volatile';
  711. end;
  712. la_store:
  713. begin
  714. if vol_write in hp.oper[3]^.ref^.volatility then
  715. result:=result+' volatile';
  716. end;
  717. else
  718. ;
  719. end;
  720. end;
  721. {****************************************************************************}
  722. { LLVM Assembler writer }
  723. {****************************************************************************}
  724. destructor TLLVMAssember.Destroy;
  725. begin
  726. InstrWriter.free;
  727. ffuncinlasmdecorator.free;
  728. inherited destroy;
  729. end;
  730. procedure TLLVMAssember.WriteTree(p:TAsmList);
  731. var
  732. hp : tai;
  733. InlineLevel : cardinal;
  734. asmblock: boolean;
  735. do_line : boolean;
  736. replaceforbidden: boolean;
  737. begin
  738. if not assigned(p) then
  739. exit;
  740. replaceforbidden:=asminfo^.dollarsign<>'$';
  741. InlineLevel:=0;
  742. asmblock:=false;
  743. { lineinfo is only needed for al_procedures (PFV) }
  744. do_line:=(cs_asm_source in current_settings.globalswitches) or
  745. ((cs_lineinfo in current_settings.moduleswitches)
  746. and (p=current_asmdata.asmlists[al_procedures]));
  747. hp:=tai(p.first);
  748. while assigned(hp) do
  749. begin
  750. prefetch(pointer(hp.next)^);
  751. if not(hp.typ in SkipLineInfo) then
  752. begin
  753. current_filepos:=tailineinfo(hp).fileinfo;
  754. { no line info for inlined code }
  755. if do_line and (inlinelevel=0) then
  756. WriteSourceLine(hp as tailineinfo);
  757. end;
  758. WriteTai(replaceforbidden, do_line, false, InlineLevel, asmblock, hp);
  759. hp:=tai(hp.next);
  760. end;
  761. end;
  762. procedure TLLVMAssember.WriteExtraHeader;
  763. begin
  764. writer.AsmWrite('target datalayout = "');
  765. writer.AsmWrite(target_info.llvmdatalayout);
  766. writer.AsmWriteln('"');
  767. writer.AsmWrite('target triple = "');
  768. writer.AsmWrite(targettriplet(triplet_llvm));
  769. writer.AsmWriteln('"');
  770. end;
  771. procedure TLLVMAssember.WriteExtraFooter;
  772. begin
  773. end;
  774. procedure TLLVMAssember.WriteInstruction(hp: tai);
  775. begin
  776. end;
  777. procedure TLLVMAssember.WriteLlvmInstruction(hp: tai);
  778. begin
  779. InstrWriter.WriteInstruction(hp);
  780. end;
  781. procedure TLLVMAssember.WriteRealConst(hp: tai_realconst; do_line: boolean);
  782. begin
  783. if fdecllevel=0 then
  784. begin
  785. case tai_realconst(hp).realtyp of
  786. aitrealconst_s32bit:
  787. writer.AsmWriteLn(asminfo^.comment+'value: '+single2str(tai_realconst(hp).value.s32val));
  788. aitrealconst_s64bit:
  789. writer.AsmWriteLn(asminfo^.comment+'value: '+double2str(tai_realconst(hp).value.s64val));
  790. {$if defined(cpuextended) and (defined(FPC_HAS_TYPE_EXTENDED) or defined(FPC_SOFT_FPUX80))}
  791. { can't write full 80 bit floating point constants yet on non-x86 }
  792. aitrealconst_s80bit:
  793. writer.AsmWriteLn(asminfo^.comment+'value: '+extended2str(tai_realconst(hp).value.s80val));
  794. {$endif cpuextended}
  795. aitrealconst_s64comp:
  796. writer.AsmWriteLn(asminfo^.comment+'value: '+extended2str(tai_realconst(hp).value.s64compval));
  797. else
  798. internalerror(2014050603);
  799. end;
  800. internalerror(2016120202);
  801. end;
  802. case hp.realtyp of
  803. aitrealconst_s32bit:
  804. writer.AsmWrite(llvmdoubletostr(hp.value.s32val));
  805. aitrealconst_s64bit:
  806. writer.AsmWriteln(llvmdoubletostr(hp.value.s64val));
  807. {$if defined(cpuextended) and (defined(FPC_HAS_TYPE_EXTENDED) or defined(FPC_SOFT_FPUX80))}
  808. aitrealconst_s80bit:
  809. writer.AsmWrite(llvmextendedtostr(hp.value.s80val));
  810. {$endif defined(cpuextended)}
  811. aitrealconst_s64comp:
  812. { handled as int64 most of the time in llvm }
  813. writer.AsmWrite(tostr(round(hp.value.s64compval)));
  814. else
  815. internalerror(2014062401);
  816. end;
  817. end;
  818. procedure TLLVMAssember.WriteOrdConst(hp: tai_const);
  819. var
  820. consttyp: taiconst_type;
  821. begin
  822. if fdecllevel=0 then
  823. internalerror(2016120203);
  824. consttyp:=hp.consttype;
  825. case consttyp of
  826. aitconst_got,
  827. aitconst_gotoff_symbol,
  828. aitconst_uleb128bit,
  829. aitconst_sleb128bit,
  830. aitconst_rva_symbol,
  831. aitconst_secrel32_symbol,
  832. aitconst_darwin_dwarf_delta32,
  833. aitconst_darwin_dwarf_delta64,
  834. aitconst_half16bit,
  835. aitconst_gs:
  836. internalerror(2014052901);
  837. aitconst_128bit,
  838. aitconst_64bit,
  839. aitconst_32bit,
  840. aitconst_16bit,
  841. aitconst_8bit,
  842. aitconst_16bit_unaligned,
  843. aitconst_32bit_unaligned,
  844. aitconst_64bit_unaligned:
  845. begin
  846. if fdecllevel=0 then
  847. writer.AsmWrite(asminfo^.comment);
  848. { can't have compile-time differences between symbols; these are
  849. normally for PIC, but llvm takes care of that for us }
  850. if assigned(hp.endsym) then
  851. internalerror(2014052902);
  852. if assigned(hp.sym) then
  853. begin
  854. writer.AsmWrite(LlvmAsmSymName(hp.sym));
  855. { can't have offsets }
  856. if hp.value<>0 then
  857. if fdecllevel<>0 then
  858. internalerror(2014052903)
  859. else
  860. writer.AsmWrite(' -- symbol offset: ' + tostr(hp.value));
  861. end
  862. else if hp.value=0 then
  863. writer.AsmWrite('zeroinitializer')
  864. else
  865. writer.AsmWrite(tostr(hp.value));
  866. {
  867. // activate in case of debugging IE 2016120203
  868. if fdecllevel=0 then
  869. writer.AsmLn;
  870. }
  871. end;
  872. else
  873. internalerror(2007042504);
  874. end;
  875. end;
  876. procedure TLLVMAssember.WriteTai(const replaceforbidden: boolean; const do_line, inmetadata: boolean; var InlineLevel: cardinal; var asmblock: boolean; var hp: tai);
  877. procedure WriteLinkageVibilityFlags(bind: TAsmSymBind; is_definition: boolean);
  878. begin
  879. { re-declaration of a symbol defined in the current module (in an
  880. assembler block) }
  881. if not is_definition then
  882. begin
  883. writer.AsmWrite(' external');
  884. exit;
  885. end;
  886. case bind of
  887. AB_EXTERNAL,
  888. AB_EXTERNAL_INDIRECT:
  889. writer.AsmWrite(' external');
  890. AB_COMMON:
  891. writer.AsmWrite(' common');
  892. AB_LOCAL:
  893. writer.AsmWrite(' internal');
  894. AB_GLOBAL,
  895. AB_INDIRECT:
  896. ;
  897. AB_WEAK_EXTERNAL:
  898. writer.AsmWrite(' extern_weak');
  899. AB_PRIVATE_EXTERN:
  900. writer.AsmWrite(' hidden')
  901. else
  902. internalerror(2014020104);
  903. end;
  904. end;
  905. procedure WriteFunctionFlags(pd: tprocdef);
  906. begin
  907. { function attributes }
  908. if (pos('FPC_SETJMP',upper(pd.mangledname))<>0) or
  909. (pd.mangledname=(target_info.cprefix+'setjmp')) then
  910. writer.AsmWrite(' returns_twice');
  911. if po_inline in pd.procoptions then
  912. writer.AsmWrite(' inlinehint')
  913. else if (po_noinline in pd.procoptions) or
  914. (pio_inline_forbidden in pd.implprocoptions) then
  915. writer.AsmWrite(' noinline');
  916. { ensure that functions that happen to have the same name as a
  917. standard C library function, but which are implemented in Pascal,
  918. are not considered to have the same semantics as the C function with
  919. the same name }
  920. if not(po_external in pd.procoptions) then
  921. writer.AsmWrite(' nobuiltin');
  922. if po_noreturn in pd.procoptions then
  923. writer.AsmWrite(' noreturn');
  924. if pio_thunk in pd.implprocoptions then
  925. writer.AsmWrite(' "thunk"');
  926. if llvmflag_null_pointer_valid in llvmversion_properties[current_settings.llvmversion] then
  927. writer.AsmWrite(' "null-pointer-is-valid"="true"')
  928. else if llvmflag_null_pointer_valid_new in llvmversion_properties[current_settings.llvmversion] then
  929. writer.AsmWrite(' null_pointer_is_valid');
  930. if not(pio_fastmath in pd.implprocoptions) then
  931. writer.AsmWrite(' strictfp');
  932. end;
  933. procedure WriteTypedConstData(hp: tai_abstracttypedconst; metadata: boolean);
  934. var
  935. p: tai_abstracttypedconst;
  936. pval: tai;
  937. defstr: TSymStr;
  938. first, gotstring: boolean;
  939. begin
  940. if hp.def<>llvm_metadatatype then
  941. begin
  942. defstr:=llvmencodetypename(hp.def)
  943. end
  944. else
  945. begin
  946. defstr:=''
  947. end;
  948. { write the struct, array or simple type }
  949. case hp.adetyp of
  950. tck_record:
  951. begin
  952. if not(metadata) then
  953. begin
  954. writer.AsmWrite(defstr);
  955. if not(df_llvm_no_struct_packing in hp.def.defoptions) then
  956. writer.AsmWrite(' <{')
  957. else
  958. writer.AsmWrite(' {')
  959. end
  960. else
  961. begin
  962. writer.AsmWrite(' !{');
  963. end;
  964. first:=true;
  965. for p in tai_aggregatetypedconst(hp) do
  966. begin
  967. if not first then
  968. writer.AsmWrite(', ')
  969. else
  970. first:=false;
  971. WriteTypedConstData(p,metadata);
  972. end;
  973. if not(metadata) then
  974. begin
  975. if not(df_llvm_no_struct_packing in hp.def.defoptions) then
  976. writer.AsmWrite(' }>')
  977. else
  978. writer.AsmWrite(' }')
  979. end
  980. else
  981. begin
  982. writer.AsmWrite(' }');
  983. end;
  984. end;
  985. tck_array:
  986. begin
  987. if not(metadata) then
  988. begin
  989. writer.AsmWrite(defstr);
  990. end;
  991. first:=true;
  992. gotstring:=false;
  993. for p in tai_aggregatetypedconst(hp) do
  994. begin
  995. if not first then
  996. writer.AsmWrite(', ')
  997. else
  998. begin
  999. writer.AsmWrite(' ');
  1000. if (tai_abstracttypedconst(p).adetyp=tck_simple) and
  1001. (tai_simpletypedconst(p).val.typ=ait_string) then
  1002. begin
  1003. gotstring:=true;
  1004. end
  1005. else
  1006. begin
  1007. if not metadata then
  1008. begin
  1009. writer.AsmWrite('[');
  1010. end
  1011. else
  1012. begin
  1013. writer.AsmWrite('!{');
  1014. end;
  1015. end;
  1016. first:=false;
  1017. end;
  1018. { cannot concat strings and other things }
  1019. if gotstring and
  1020. not metadata and
  1021. ((tai_abstracttypedconst(p).adetyp<>tck_simple) or
  1022. (tai_simpletypedconst(p).val.typ<>ait_string)) then
  1023. internalerror(2014062701);
  1024. WriteTypedConstData(p,metadata);
  1025. end;
  1026. if not gotstring then
  1027. begin
  1028. if not metadata then
  1029. begin
  1030. writer.AsmWrite(']');
  1031. end
  1032. else
  1033. begin
  1034. writer.AsmWrite('}');
  1035. end;
  1036. end;
  1037. end;
  1038. tck_simple:
  1039. begin
  1040. pval:=tai_simpletypedconst(hp).val;
  1041. if (pval.typ<>ait_string) and
  1042. (defstr<>'') then
  1043. begin
  1044. writer.AsmWrite(defstr);
  1045. writer.AsmWrite(' ');
  1046. end;
  1047. WriteTai(replaceforbidden,do_line,metadata,InlineLevel,asmblock,pval);
  1048. end;
  1049. end;
  1050. end;
  1051. procedure WriteLlvmMetadataNode(hp: tai_llvmbasemetadatanode);
  1052. begin
  1053. { must only appear at the top level }
  1054. if fdecllevel<>0 then
  1055. internalerror(2019050111);
  1056. writer.AsmWrite('!');
  1057. writer.AsmWrite(tai_llvmbasemetadatanode(hp).name);
  1058. writer.AsmWrite(' =');
  1059. inc(fdecllevel);
  1060. WriteTypedConstData(hp,true);
  1061. writer.AsmLn;
  1062. dec(fdecllevel);
  1063. end;
  1064. var
  1065. hp2: tai;
  1066. s: string;
  1067. sstr: TSymStr;
  1068. i: longint;
  1069. ch: ansichar;
  1070. begin
  1071. case hp.typ of
  1072. ait_align,
  1073. ait_section :
  1074. begin
  1075. { ignore, specified as part of declarations -- don't write
  1076. comment, because could appear in the middle of an aggregate
  1077. constant definition }
  1078. end;
  1079. ait_datablock :
  1080. begin
  1081. writer.AsmWrite(asminfo^.comment);
  1082. writer.AsmWriteln('datablock');
  1083. end;
  1084. ait_const:
  1085. begin
  1086. WriteOrdConst(tai_const(hp));
  1087. end;
  1088. ait_realconst :
  1089. begin
  1090. WriteRealConst(tai_realconst(hp), do_line);
  1091. end;
  1092. ait_string :
  1093. begin
  1094. if fdecllevel=0 then
  1095. internalerror(2016120201);
  1096. if not inmetadata then
  1097. writer.AsmWrite('c"')
  1098. else
  1099. writer.AsmWrite('!"');
  1100. for i:=1 to tai_string(hp).len do
  1101. begin
  1102. ch:=tai_string(hp).str[i-1];
  1103. case ch of
  1104. #0, {This can't be done by range, because a bug in FPC}
  1105. #1..#31,
  1106. #128..#255,
  1107. '"',
  1108. '\' : s:='\'+hexStr(ord(ch),2);
  1109. else
  1110. s:=ch;
  1111. end;
  1112. writer.AsmWrite(s);
  1113. end;
  1114. writer.AsmWrite('"');
  1115. end;
  1116. ait_label :
  1117. begin
  1118. if not asmblock and
  1119. (tai_label(hp).labsym.is_used) then
  1120. begin
  1121. if (tai_label(hp).labsym.bind=AB_PRIVATE_EXTERN) then
  1122. begin
  1123. { should be emitted as part of the variable/function def }
  1124. internalerror(2013010703);
  1125. end;
  1126. if tai_label(hp).labsym.bind in [AB_GLOBAL, AB_PRIVATE_EXTERN] then
  1127. begin
  1128. { should be emitted as part of the variable/function def }
  1129. //internalerror(2013010704);
  1130. writer.AsmWriteln(asminfo^.comment+'global/privateextern label: '+tai_label(hp).labsym.name);
  1131. end;
  1132. if replaceforbidden then
  1133. writer.AsmWrite(ApplyAsmSymbolRestrictions(tai_label(hp).labsym.name))
  1134. else
  1135. writer.AsmWrite(tai_label(hp).labsym.name);
  1136. writer.AsmWriteLn(':');
  1137. end;
  1138. end;
  1139. ait_symbol :
  1140. begin
  1141. if fdecllevel=0 then
  1142. writer.AsmWrite(asminfo^.comment);
  1143. writer.AsmWriteln(LlvmAsmSymName(tai_symbol(hp).sym));
  1144. { todo }
  1145. if tai_symbol(hp).has_value then
  1146. internalerror(2014062402);
  1147. end;
  1148. ait_llvmdecl:
  1149. begin
  1150. if taillvmdecl(hp).def.typ=procdef then
  1151. begin
  1152. if not(ldf_definition in taillvmdecl(hp).flags) then
  1153. begin
  1154. writer.AsmWrite('declare');
  1155. writer.AsmWrite(llvmencodeproctype(tprocdef(taillvmdecl(hp).def), taillvmdecl(hp).namesym.name, lpd_decl));
  1156. WriteFunctionFlags(tprocdef(taillvmdecl(hp).def));
  1157. writer.AsmLn;
  1158. end
  1159. else
  1160. begin
  1161. writer.AsmWrite('define');
  1162. if ldf_weak in taillvmdecl(hp).flags then
  1163. writer.AsmWrite(' weak');
  1164. WriteLinkageVibilityFlags(taillvmdecl(hp).namesym.bind, true);
  1165. writer.AsmWrite(llvmencodeproctype(tprocdef(taillvmdecl(hp).def), '', lpd_def));
  1166. WriteFunctionFlags(tprocdef(taillvmdecl(hp).def));
  1167. if assigned(tprocdef(taillvmdecl(hp).def).personality) then
  1168. begin
  1169. writer.AsmWrite(' personality i8* bitcast (');
  1170. writer.AsmWrite(llvmencodeproctype(tprocdef(taillvmdecl(hp).def).personality, '', lpd_procvar));
  1171. writer.AsmWrite('* ');
  1172. writer.AsmWrite(llvmmangledname(tprocdef(taillvmdecl(hp).def).personality.mangledname));
  1173. writer.AsmWrite(' to i8*)');
  1174. end;
  1175. writer.AsmWriteln(' {');
  1176. end;
  1177. end
  1178. else
  1179. begin
  1180. writer.AsmWrite(LlvmAsmSymName(taillvmdecl(hp).namesym));
  1181. writer.AsmWrite(' =');
  1182. if ldf_weak in taillvmdecl(hp).flags then
  1183. writer.AsmWrite(' weak');
  1184. if ldf_appending in taillvmdecl(hp).flags then
  1185. writer.AsmWrite(' appending');
  1186. WriteLinkageVibilityFlags(taillvmdecl(hp).namesym.bind, ldf_definition in taillvmdecl(hp).flags);
  1187. writer.AsmWrite(' ');
  1188. if (ldf_tls in taillvmdecl(hp).flags) then
  1189. writer.AsmWrite('thread_local ');
  1190. if ldf_unnamed_addr in taillvmdecl(hp).flags then
  1191. writer.AsmWrite('unnamed_addr ');
  1192. if taillvmdecl(hp).sec in [sec_rodata,sec_rodata_norel] then
  1193. writer.AsmWrite('constant ')
  1194. else
  1195. writer.AsmWrite('global ');
  1196. if not assigned(taillvmdecl(hp).initdata) then
  1197. begin
  1198. writer.AsmWrite(llvmencodetypename(taillvmdecl(hp).def));
  1199. if ldf_definition in taillvmdecl(hp).flags then
  1200. writer.AsmWrite(' zeroinitializer');
  1201. end
  1202. else
  1203. begin
  1204. inc(fdecllevel);
  1205. { can't have an external symbol with initialisation data }
  1206. if taillvmdecl(hp).namesym.bind in [AB_EXTERNAL, AB_WEAK_EXTERNAL] then
  1207. internalerror(2014052905);
  1208. { bitcast initialisation data to the type of the constant }
  1209. { write initialisation data }
  1210. hp2:=tai(taillvmdecl(hp).initdata.first);
  1211. while assigned(hp2) do
  1212. begin
  1213. WriteTai(replaceforbidden,do_line,inmetadata,InlineLevel,asmblock,hp2);
  1214. hp2:=tai(hp2.next);
  1215. end;
  1216. dec(fdecllevel);
  1217. end;
  1218. { custom section name? }
  1219. case taillvmdecl(hp).sec of
  1220. sec_user:
  1221. begin
  1222. writer.AsmWrite(', section "');
  1223. writer.AsmWrite(taillvmdecl(hp).secname);
  1224. writer.AsmWrite('"');
  1225. end;
  1226. low(TObjCAsmSectionType)..high(TObjCAsmSectionType):
  1227. begin
  1228. writer.AsmWrite(', section "');
  1229. writer.AsmWrite(objc_section_name(taillvmdecl(hp).sec));
  1230. writer.AsmWrite('"');
  1231. end;
  1232. else
  1233. ;
  1234. end;
  1235. { sections whose name starts with 'llvm.' are for LLVM
  1236. internal use and don't have an alignment }
  1237. if pos('llvm.',taillvmdecl(hp).secname)<>1 then
  1238. begin
  1239. { alignment }
  1240. writer.AsmWrite(', align ');
  1241. writer.AsmWriteln(tostr(taillvmdecl(hp).alignment));
  1242. end
  1243. else
  1244. writer.AsmLn;
  1245. end;
  1246. end;
  1247. ait_llvmalias:
  1248. begin
  1249. writer.AsmWrite(LlvmAsmSymName(taillvmalias(hp).newsym));
  1250. writer.AsmWrite(' = alias ');
  1251. WriteLinkageVibilityFlags(taillvmalias(hp).bind, true);
  1252. if taillvmalias(hp).def.typ=procdef then
  1253. sstr:=llvmencodeproctype(tabstractprocdef(taillvmalias(hp).def), '', lpd_alias)
  1254. else
  1255. sstr:=llvmencodetypename(taillvmalias(hp).def);
  1256. writer.AsmWrite(sstr);
  1257. writer.AsmWrite(', ');
  1258. writer.AsmWrite(sstr);
  1259. writer.AsmWrite('* ');
  1260. writer.AsmWriteln(LlvmAsmSymName(taillvmalias(hp).oldsym));
  1261. end;
  1262. ait_llvmmetadatanode:
  1263. begin
  1264. WriteLlvmMetadataNode(tai_llvmbasemetadatanode(hp));
  1265. end;
  1266. ait_llvmmetadatareftypedconst:
  1267. begin
  1268. { must only appear as an element in a typed const }
  1269. if fdecllevel=0 then
  1270. internalerror(2019050110);
  1271. writer.AsmWrite('!');
  1272. writer.AsmWrite(tai_llvmbasemetadatanode(tai_llvmmetadatareftypedconst(hp).val).name);
  1273. end;
  1274. ait_llvmmetadatarefoperand:
  1275. begin
  1276. { must only appear as an operand }
  1277. if fdecllevel=0 then
  1278. internalerror(2019050101);
  1279. writer.AsmWrite('!');
  1280. writer.AsmWrite(tai_llvmmetadatareferenceoperand(hp).id);
  1281. writer.AsmWrite(' !');
  1282. writer.AsmWrite(tai_llvmmetadatareferenceoperand(hp).value.name);
  1283. end;
  1284. ait_symbolpair:
  1285. begin
  1286. { should be emitted as part of the symbol def }
  1287. internalerror(2013010708);
  1288. end;
  1289. ait_symbol_end :
  1290. begin
  1291. if tai_symbol_end(hp).sym.typ=AT_FUNCTION then
  1292. writer.AsmWriteln('}')
  1293. else
  1294. writer.AsmWriteln('; ait_symbol_end error, should not be generated');
  1295. // internalerror(2013010711);
  1296. end;
  1297. ait_instruction :
  1298. begin
  1299. WriteInstruction(hp);
  1300. end;
  1301. ait_llvmins:
  1302. begin
  1303. WriteLlvmInstruction(hp);
  1304. end;
  1305. ait_stab :
  1306. begin
  1307. internalerror(2013010712);
  1308. end;
  1309. ait_force_line,
  1310. ait_function_name :
  1311. ;
  1312. ait_cutobject :
  1313. begin
  1314. end;
  1315. ait_marker :
  1316. case
  1317. tai_marker(hp).kind of
  1318. mark_NoLineInfoStart:
  1319. inc(InlineLevel);
  1320. mark_NoLineInfoEnd:
  1321. dec(InlineLevel);
  1322. { these cannot be nested }
  1323. mark_AsmBlockStart:
  1324. asmblock:=true;
  1325. mark_AsmBlockEnd:
  1326. asmblock:=false;
  1327. else
  1328. ;
  1329. end;
  1330. ait_directive :
  1331. begin
  1332. { CPU directive is commented out for the LLVM }
  1333. if tai_directive(hp).directive=asd_cpu then
  1334. writer.AsmWrite(asminfo^.comment);
  1335. WriteDirectiveName(tai_directive(hp).directive);
  1336. if tai_directive(hp).name <>'' then
  1337. writer.AsmWrite(tai_directive(hp).name);
  1338. if fdecllevel<>0 then
  1339. internalerror(2015090602);
  1340. writer.AsmLn;
  1341. end;
  1342. ait_seh_directive :
  1343. begin
  1344. internalerror(2013010713);
  1345. end;
  1346. ait_typedconst:
  1347. begin
  1348. WriteTypedConstData(tai_abstracttypedconst(hp),false);
  1349. end
  1350. else
  1351. if not WriteComments(hp) then
  1352. internalerror(2019012010);
  1353. end;
  1354. end;
  1355. constructor TLLVMAssember.CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter, smart: boolean);
  1356. begin
  1357. inherited;
  1358. InstrWriter:=TLLVMInstrWriter.create(self);
  1359. end;
  1360. procedure TLLVMAssember.WriteDirectiveName(dir: TAsmDirective);
  1361. begin
  1362. writer.AsmWrite('.'+directivestr[dir]+' ');
  1363. end;
  1364. procedure TLLVMAssember.WriteAsmList;
  1365. var
  1366. hal : tasmlisttype;
  1367. a: TExternalAssembler;
  1368. decorator: TLLVMModuleInlineAssemblyDecorator;
  1369. begin
  1370. WriteExtraHeader;
  1371. for hal:=low(TasmlistType) to high(TasmlistType) do
  1372. begin
  1373. if not assigned(current_asmdata.asmlists[hal]) or
  1374. current_asmdata.asmlists[hal].Empty then
  1375. continue;
  1376. writer.AsmWriteLn(asminfo^.comment+'Begin asmlist '+AsmlistTypeStr[hal]);
  1377. if not(hal in [al_pure_assembler,al_dwarf_frame]) then
  1378. writetree(current_asmdata.asmlists[hal])
  1379. else
  1380. begin
  1381. { write routines using the target-specific external assembler
  1382. writer, filtered using the LLVM module-level assembly
  1383. decorator }
  1384. decorator:=TLLVMModuleInlineAssemblyDecorator.Create;
  1385. writer.decorator:=decorator;
  1386. a:=GetExternalGnuAssemblerWithAsmInfoWriter(asminfo,writer);
  1387. a.WriteTree(current_asmdata.asmlists[hal]);
  1388. writer.decorator:=nil;
  1389. decorator.free;
  1390. a.free;
  1391. end;
  1392. writer.AsmWriteLn(asminfo^.comment+'End asmlist '+AsmlistTypeStr[hal]);
  1393. end;
  1394. writer.AsmLn;
  1395. end;
  1396. procedure TLLVMAssember.WriteFunctionInlineAsmList(list: tasmlist);
  1397. var
  1398. a: TExternalAssembler;
  1399. begin
  1400. if not assigned(ffuncinlasmdecorator) then
  1401. ffuncinlasmdecorator:=TLLVMFunctionInlineAssemblyDecorator.create;
  1402. if assigned(writer.decorator) then
  1403. internalerror(2016110201);
  1404. writer.decorator:=ffuncinlasmdecorator;
  1405. a:=GetExternalGnuAssemblerWithAsmInfoWriter(asminfo,writer);
  1406. a.WriteTree(list);
  1407. a.free;
  1408. writer.decorator:=nil;
  1409. end;
  1410. {****************************************************************************}
  1411. { LLVM Instruction Writer }
  1412. {****************************************************************************}
  1413. constructor TLLVMInstrWriter.create(_owner: TLLVMAssember);
  1414. begin
  1415. inherited create;
  1416. owner := _owner;
  1417. end;
  1418. {****************************************************************************}
  1419. { clang Assember }
  1420. {****************************************************************************}
  1421. function TLLVMClangAssember.MakeCmdLine: TCmdStr;
  1422. var
  1423. wpostr,
  1424. optstr: TCmdStr;
  1425. begin
  1426. wpostr:='';
  1427. if cs_lto in current_settings.moduleswitches then
  1428. begin
  1429. case fnextpass of
  1430. 0:
  1431. begin
  1432. ObjFileName:=ChangeFileExt(ObjFileName,'.bc');
  1433. wpostr:=' -flto';
  1434. end;
  1435. 1:
  1436. begin
  1437. ObjFileName:=ChangeFileExt(ObjFileName,'.o');
  1438. end;
  1439. end;
  1440. end;
  1441. result:=inherited;
  1442. if cs_opt_level3 in current_settings.optimizerswitches then
  1443. optstr:='-O3'
  1444. else if cs_opt_level2 in current_settings.optimizerswitches then
  1445. optstr:='-O2'
  1446. else if cs_opt_level1 in current_settings.optimizerswitches then
  1447. optstr:='-O1'
  1448. else
  1449. optstr:='-O0';
  1450. optstr:=optstr+wpostr;
  1451. { stack frame elimination }
  1452. if not(cs_opt_stackframe in current_settings.optimizerswitches) then
  1453. optstr:=optstr+' -fno-omit-frame-pointer'
  1454. else
  1455. optstr:=optstr+' -fomit-frame-pointer';
  1456. { fast math }
  1457. if cs_opt_fastmath in current_settings.optimizerswitches then
  1458. optstr:=optstr+' -ffast-math';
  1459. { smart linking }
  1460. if cs_create_smart in current_settings.moduleswitches then
  1461. optstr:=optstr+' -fdata-sections -ffunction-sections';
  1462. { pic }
  1463. if cs_create_pic in current_settings.moduleswitches then
  1464. optstr:=optstr+' -fpic'
  1465. else if not(target_info.system in systems_darwin) then
  1466. optstr:=optstr+' -static'
  1467. else
  1468. optstr:=optstr+' -mdynamic-no-pic';
  1469. if fputypestrllvm[current_settings.fputype]<>'' then
  1470. optstr:=optstr+' -m'+fputypestrllvm[current_settings.fputype];
  1471. { restrict march to aarch64 for now to fix x86_64 compilation failure }
  1472. if (cputypestr[current_settings.cputype]<>'')
  1473. and (target_info.system in [system_aarch64_darwin, system_aarch64_linux]) then
  1474. optstr:=optstr+' -march='+cputypestr[current_settings.cputype];
  1475. replace(result,'$OPT',optstr);
  1476. inc(fnextpass);
  1477. end;
  1478. function TLLVMClangAssember.DoAssemble: boolean;
  1479. begin
  1480. fnextpass:=0;
  1481. result:=inherited;
  1482. end;
  1483. function TLLVMClangAssember.RerunAssembler: boolean;
  1484. begin
  1485. result:=
  1486. (cs_lto in current_settings.moduleswitches) and
  1487. (fnextpass<=1);
  1488. end;
  1489. function TLLVMClangAssember.DoPipe: boolean;
  1490. begin
  1491. result:=
  1492. not(cs_lto in current_settings.moduleswitches) and
  1493. inherited;
  1494. end;
  1495. const
  1496. as_clang_llvm_info : tasminfo =
  1497. (
  1498. id : as_clang_llvm;
  1499. idtxt : 'CLANG-LLVM';
  1500. asmbin : 'clang';
  1501. asmcmd: '-x ir $OPT -target $TRIPLET -c -o $OBJ $ASM $EXTRAOPT';
  1502. supported_targets : [system_x86_64_linux,system_x86_64_darwin,system_aarch64_darwin,system_aarch64_linux,system_arm_linux];
  1503. flags : [af_smartlink_sections,af_llvm];
  1504. labelprefix : 'L';
  1505. labelmaxlen : -1;
  1506. comment : '; ';
  1507. dollarsign: '$';
  1508. );
  1509. begin
  1510. RegisterAssembler(as_clang_llvm_info,TLLVMClangAssember);
  1511. end.