2
0

agllvm.pas 56 KB

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