agllvm.pas 56 KB

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