agllvm.pas 50 KB

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