agllvm.pas 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876
  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,
  22. aasmbase,aasmtai,aasmdata,
  23. assemble;
  24. type
  25. TLLVMInstrWriter = class;
  26. { TLLVMAssember }
  27. TLLVMAssember=class(texternalassembler)
  28. protected
  29. procedure WriteExtraHeader;virtual;
  30. procedure WriteExtraFooter;virtual;
  31. procedure WriteInstruction(hp: tai);
  32. procedure WriteLlvmInstruction(hp: tai);
  33. // procedure WriteWeakSymbolDef(s: tasmsymbol); virtual;
  34. procedure WriteDirectiveName(dir: TAsmDirective); virtual;
  35. procedure WriteWeakSymbolDef(s: tasmsymbol);
  36. procedure WriteRealConst(hp: tai_realconst; do_line: boolean);
  37. public
  38. constructor create(smart: boolean); override;
  39. function MakeCmdLine: TCmdStr; override;
  40. procedure WriteTree(p:TAsmList);override;
  41. procedure WriteAsmList;override;
  42. destructor destroy; override;
  43. protected
  44. InstrWriter: TLLVMInstrWriter;
  45. end;
  46. {# This is the base class for writing instructions.
  47. The WriteInstruction() method must be overridden
  48. to write a single instruction to the assembler
  49. file.
  50. }
  51. TLLVMInstrWriter = class
  52. constructor create(_owner: TLLVMAssember);
  53. procedure WriteInstruction(hp : tai);
  54. protected
  55. owner: TLLVMAssember;
  56. end;
  57. implementation
  58. uses
  59. SysUtils,
  60. cutils,cfileutl,systems,
  61. fmodule,verbose,
  62. symconst,symdef,
  63. llvmbase,aasmllvm,itllvm,llvmdef,
  64. cgbase,cgutils,cpubase;
  65. const
  66. line_length = 70;
  67. var
  68. symendcount : longint;
  69. type
  70. {$ifdef cpuextended}
  71. t80bitarray = array[0..9] of byte;
  72. {$endif cpuextended}
  73. t64bitarray = array[0..7] of byte;
  74. t32bitarray = array[0..3] of byte;
  75. {****************************************************************************}
  76. { Support routines }
  77. {****************************************************************************}
  78. function single2str(d : single) : string;
  79. var
  80. hs : string;
  81. begin
  82. str(d,hs);
  83. { replace space with + }
  84. if hs[1]=' ' then
  85. hs[1]:='+';
  86. single2str:=hs
  87. end;
  88. function double2str(d : double) : string;
  89. var
  90. hs : string;
  91. begin
  92. str(d,hs);
  93. { replace space with + }
  94. if hs[1]=' ' then
  95. hs[1]:='+';
  96. double2str:=hs
  97. end;
  98. function extended2str(e : extended) : string;
  99. var
  100. hs : string;
  101. begin
  102. str(e,hs);
  103. { replace space with + }
  104. if hs[1]=' ' then
  105. hs[1]:='+';
  106. extended2str:=hs
  107. end;
  108. {****************************************************************************}
  109. { LLVM Instruction writer }
  110. {****************************************************************************}
  111. function getregisterstring(reg: tregister): ansistring;
  112. begin
  113. if getregtype(reg)=R_TEMPREGISTER then
  114. result:='%tmp.'
  115. else
  116. result:='%reg.'+tostr(byte(getregtype(reg)))+'_';
  117. result:=result+tostr(getsupreg(reg));
  118. end;
  119. function getreferencealignstring(var ref: treference) : ansistring;
  120. begin
  121. result:=', align '+tostr(ref.alignment);
  122. end;
  123. function getreferencestring(var ref : treference; withalign: boolean) : ansistring;
  124. begin
  125. result:='';
  126. if assigned(ref.relsymbol) or
  127. (assigned(ref.symbol) =
  128. (ref.base<>NR_NO)) or
  129. (ref.index<>NR_NO) or
  130. (ref.offset<>0) then
  131. begin
  132. result:=' **(error ref: ';
  133. if assigned(ref.symbol) then
  134. result:=result+'sym='+ref.symbol.name+', ';
  135. if assigned(ref.relsymbol) then
  136. result:=result+'sym='+ref.relsymbol.name+', ';
  137. if ref.base=NR_NO then
  138. result:=result+'base=NR_NO, ';
  139. if ref.index<>NR_NO then
  140. result:=result+'index<>NR_NO, ';
  141. if ref.offset<>0 then
  142. result:=result+'offset='+tostr(ref.offset);
  143. result:=result+')**'
  144. // internalerror(2013060225);
  145. end;
  146. if ref.base<>NR_NO then
  147. result:=result+getregisterstring(ref.base)
  148. else
  149. result:=result+ref.symbol.name;
  150. if withalign then
  151. result:=result+getreferencealignstring(ref);
  152. end;
  153. function getparas(const o: toper): ansistring;
  154. var
  155. i: longint;
  156. para: pllvmcallpara;
  157. begin
  158. result:='(';
  159. for i:=0 to o.paras.count-1 do
  160. begin
  161. if i<>0 then
  162. result:=result+', ';
  163. para:=pllvmcallpara(o.paras[i]);
  164. result:=result+llvmencodetype(para^.def);
  165. if para^.valueext<>lve_none then
  166. result:=result+llvmvalueextension2str[para^.valueext];
  167. case para^.loc of
  168. LOC_REGISTER,
  169. LOC_FPUREGISTER,
  170. LOC_MMREGISTER:
  171. result:=result+' '+getregisterstring(para^.reg);
  172. else
  173. internalerror(2014010801);
  174. end;
  175. end;
  176. result:=result+')';
  177. end;
  178. function getopstr(const o:toper; refwithalign: boolean) : ansistring;
  179. var
  180. hs : ansistring;
  181. doubleval: record
  182. case byte of
  183. 1: (d: double);
  184. 2: (i: int64);
  185. end;
  186. {$ifdef cpuextended}
  187. extendedval: record
  188. case byte of
  189. 1: (e: extended);
  190. 2: (r: record
  191. {$ifdef FPC_LITTLE_ENDIAN}
  192. l: int64;
  193. h: word;
  194. {$else FPC_LITTLE_ENDIAN}
  195. h: int64;
  196. l: word;
  197. {$endif FPC_LITTLE_ENDIAN}
  198. end;
  199. );
  200. end;
  201. {$endif cpuextended}
  202. begin
  203. case o.typ of
  204. top_reg:
  205. getopstr:=getregisterstring(o.reg);
  206. top_const:
  207. getopstr:=tostr(int64(o.val));
  208. top_ref:
  209. if o.ref^.refaddr=addr_full then
  210. begin
  211. getopstr:='';
  212. if o.ref^.symbol.typ=AT_LABEL then
  213. getopstr:='label %';
  214. hs:=o.ref^.symbol.name;
  215. if o.ref^.offset<>0 then
  216. internalerror(2013060223);
  217. getopstr:=getopstr+hs;
  218. end
  219. else
  220. getopstr:=getreferencestring(o.ref^,refwithalign);
  221. top_def:
  222. begin
  223. getopstr:=llvmencodetype(o.def);
  224. end;
  225. top_cond:
  226. begin
  227. getopstr:=llvm_cond2str[o.cond];
  228. end;
  229. top_fpcond:
  230. begin
  231. getopstr:=llvm_fpcond2str[o.fpcond];
  232. end;
  233. top_single,
  234. top_double:
  235. begin
  236. { "When using the hexadecimal form, constants of types half,
  237. float, and double are represented using the 16-digit form shown
  238. above (which matches the IEEE754 representation for double)"
  239. And always in big endian form (sign bit leftmost)
  240. }
  241. if o.typ=top_double then
  242. doubleval.d:=o.dval
  243. else
  244. doubleval.d:=o.sval;
  245. result:='0x'+hexstr(doubleval.i,16);
  246. end;
  247. top_para:
  248. begin
  249. result:=getparas(o);
  250. end;
  251. {$ifdef cpuextended}
  252. top_extended80:
  253. begin
  254. { hex format is always big endian in llvm }
  255. extendedval.e:=o.eval;
  256. result:='0xK'+hexstr(extendedval.r.h,sizeof(extendedval.r.h)*2)+hexstr(extendedval.r.l,sizeof(extendedval.r.l)*2);
  257. end;
  258. {$endif cpuextended}
  259. else
  260. internalerror(2013060227);
  261. end;
  262. end;
  263. procedure TLlvmInstrWriter.WriteInstruction(hp: tai);
  264. var
  265. op: tllvmop;
  266. s: string;
  267. i, opstart: byte;
  268. sep: string[3];
  269. done: boolean;
  270. begin
  271. op:=taillvm(hp).llvmopcode;
  272. s:=#9;
  273. sep:=' ';
  274. done:=false;
  275. opstart:=0;
  276. case op of
  277. la_ret, la_br, la_switch, la_indirectbr,
  278. la_invoke, la_resume,
  279. la_unreachable,
  280. la_store,
  281. la_fence,
  282. la_cmpxchg,
  283. la_atomicrmw:
  284. begin
  285. { instructions that never have a result }
  286. end;
  287. la_call:
  288. begin
  289. if taillvm(hp).oper[0]^.reg<>NR_NO then
  290. s:=s+getregisterstring(taillvm(hp).oper[0]^.reg)+' = ';
  291. sep:=' ';
  292. opstart:=1;
  293. end;
  294. la_alloca:
  295. begin
  296. s:=s+getreferencestring(taillvm(hp).oper[0]^.ref^,false)+' = ';
  297. sep:=' ';
  298. opstart:=1;
  299. end;
  300. la_trunc, la_zext, la_sext, la_fptrunc, la_fpext,
  301. la_fptoui, la_fptosi, la_uitofp, la_sitofp,
  302. la_ptrtoint, la_inttoptr,
  303. la_bitcast:
  304. begin
  305. s:=s+getopstr(taillvm(hp).oper[0]^,false)+' = '+
  306. llvm_op2str[op]+' '+
  307. getopstr(taillvm(hp).oper[1]^,false)+' '+
  308. getopstr(taillvm(hp).oper[2]^,false)+' to '+
  309. getopstr(taillvm(hp).oper[3]^,false);
  310. done:=true;
  311. end
  312. else
  313. begin
  314. s:=s+getopstr(taillvm(hp).oper[0]^,true)+' = ';
  315. sep:=' ';
  316. opstart:=1
  317. end;
  318. end;
  319. { process operands }
  320. if not done then
  321. begin
  322. s:=s+llvm_op2str[op];
  323. if taillvm(hp).ops<>0 then
  324. begin
  325. for i:=opstart to taillvm(hp).ops-1 do
  326. begin
  327. s:=s+sep+getopstr(taillvm(hp).oper[i]^,op in [la_load,la_store]);
  328. if (taillvm(hp).oper[i]^.typ in [top_def,top_cond,top_fpcond]) or
  329. (op=la_call) then
  330. sep :=' '
  331. else
  332. sep:=', ';
  333. end;
  334. end;
  335. end;
  336. if op=la_alloca then
  337. begin
  338. s:=s+getreferencealignstring(taillvm(hp).oper[0]^.ref^)
  339. end;
  340. owner.AsmWriteLn(s);
  341. end;
  342. {****************************************************************************}
  343. { LLVM Assembler writer }
  344. {****************************************************************************}
  345. destructor TLLVMAssember.Destroy;
  346. begin
  347. InstrWriter.free;
  348. inherited destroy;
  349. end;
  350. function TLLVMAssember.MakeCmdLine: TCmdStr;
  351. var
  352. optstr: TCmdStr;
  353. begin
  354. result := inherited MakeCmdLine;
  355. { standard optimization flags for llc -- todo: this needs to be split
  356. into a call to opt and one to llc }
  357. if cs_opt_level3 in current_settings.optimizerswitches then
  358. optstr:='-O3'
  359. else if cs_opt_level2 in current_settings.optimizerswitches then
  360. optstr:='-O2'
  361. else if cs_opt_level1 in current_settings.optimizerswitches then
  362. optstr:='-O1'
  363. else
  364. optstr:='-O0';
  365. { stack frame elimination }
  366. if not(cs_opt_stackframe in current_settings.optimizerswitches) then
  367. optstr:=optstr+' -disable-fp-elim';
  368. { fast math }
  369. if cs_opt_fastmath in current_settings.optimizerswitches then
  370. optstr:=optstr+' -enable-unsafe-fp-math -enable-fp-mad -fp-contract=fast';
  371. { smart linking }
  372. if cs_create_smart in current_settings.moduleswitches then
  373. optstr:=optstr+' -fdata-sections -fcode-sections';
  374. { pic }
  375. if cs_create_pic in current_settings.moduleswitches then
  376. optstr:=optstr+' -relocation-model=pic'
  377. else if not(target_info.system in systems_darwin) then
  378. optstr:=optstr+' -relocation-model=static'
  379. else
  380. optstr:=optstr+' -relocation-model=dynamic-no-pic';
  381. { our stack alignment is non-standard on some targets. The following
  382. parameter is however ignored on some targets by llvm, so it may not
  383. be enough }
  384. optstr:=optstr+' -stack-alignment='+tostr(target_info.stackalign*8);
  385. { force object output instead of textual assembler code }
  386. optstr:=optstr+' -filetype=obj';
  387. replace(result,'$OPT',optstr);
  388. end;
  389. procedure TLLVMAssember.WriteTree(p:TAsmList);
  390. var
  391. ch : char;
  392. lasthp,
  393. hp : tai;
  394. constdef : taiconst_type;
  395. s,t : string;
  396. i,pos,l : longint;
  397. InlineLevel : cardinal;
  398. last_align : longint;
  399. co : comp;
  400. sin : single;
  401. d : double;
  402. {$ifdef cpuextended}
  403. e : extended;
  404. {$endif cpuextended}
  405. do_line : boolean;
  406. sepChar : char;
  407. replaceforbidden: boolean;
  408. begin
  409. if not assigned(p) then
  410. exit;
  411. replaceforbidden:=target_asm.dollarsign<>'$';
  412. last_align := 2;
  413. InlineLevel:=0;
  414. { lineinfo is only needed for al_procedures (PFV) }
  415. do_line:=(cs_asm_source in current_settings.globalswitches) or
  416. ((cs_lineinfo in current_settings.moduleswitches)
  417. and (p=current_asmdata.asmlists[al_procedures]));
  418. lasthp:=nil;
  419. hp:=tai(p.first);
  420. while assigned(hp) do
  421. begin
  422. prefetch(pointer(hp.next)^);
  423. if not(hp.typ in SkipLineInfo) then
  424. begin
  425. current_filepos:=tailineinfo(hp).fileinfo;
  426. { no line info for inlined code }
  427. if do_line and (inlinelevel=0) then
  428. WriteSourceLine(hp as tailineinfo);
  429. end;
  430. case hp.typ of
  431. ait_comment :
  432. Begin
  433. AsmWrite(target_asm.comment);
  434. AsmWritePChar(tai_comment(hp).str);
  435. AsmLn;
  436. End;
  437. ait_regalloc :
  438. begin
  439. if (cs_asm_regalloc in current_settings.globalswitches) then
  440. begin
  441. AsmWrite(#9+target_asm.comment+'Register ');
  442. repeat
  443. AsmWrite(std_regname(Tai_regalloc(hp).reg));
  444. if (hp.next=nil) or
  445. (tai(hp.next).typ<>ait_regalloc) or
  446. (tai_regalloc(hp.next).ratype<>tai_regalloc(hp).ratype) then
  447. break;
  448. hp:=tai(hp.next);
  449. AsmWrite(',');
  450. until false;
  451. AsmWrite(' ');
  452. AsmWriteLn(regallocstr[tai_regalloc(hp).ratype]);
  453. end;
  454. end;
  455. ait_tempalloc :
  456. begin
  457. if (cs_asm_tempalloc in current_settings.globalswitches) then
  458. WriteTempalloc(tai_tempalloc(hp));
  459. end;
  460. ait_align :
  461. begin
  462. { has to be specified as part of the symbol declaration }
  463. AsmWriteln('; error: explicit aligns are forbidden');
  464. // internalerror(2013010714);
  465. end;
  466. ait_section :
  467. begin
  468. AsmWrite(target_asm.comment);
  469. AsmWriteln('section');
  470. end;
  471. ait_datablock :
  472. begin
  473. AsmWrite(target_asm.comment);
  474. AsmWriteln('datablock');
  475. end;
  476. ait_const:
  477. begin
  478. AsmWrite(target_asm.comment);
  479. AsmWriteln('const');
  480. end;
  481. ait_realconst :
  482. begin
  483. WriteRealConst(tai_realconst(hp),do_line);
  484. end;
  485. ait_string :
  486. begin
  487. AsmWrite(target_asm.comment);
  488. AsmWriteln('string');
  489. end;
  490. ait_label :
  491. begin
  492. if (tai_label(hp).labsym.is_used) then
  493. begin
  494. if (tai_label(hp).labsym.bind=AB_PRIVATE_EXTERN) then
  495. begin
  496. { should be emitted as part of the variable/function def }
  497. internalerror(2013010703);
  498. end;
  499. if tai_label(hp).labsym.bind in [AB_GLOBAL,AB_PRIVATE_EXTERN] then
  500. begin
  501. { should be emitted as part of the variable/function def }
  502. //internalerror(2013010704);
  503. AsmWriteln(target_asm.comment+'global/privateextern label: '+tai_label(hp).labsym.name);
  504. end;
  505. if replaceforbidden then
  506. AsmWrite(ReplaceForbiddenAsmSymbolChars(tai_label(hp).labsym.name))
  507. else
  508. AsmWrite(tai_label(hp).labsym.name);
  509. AsmWriteLn(':');
  510. end;
  511. end;
  512. ait_symbol :
  513. begin
  514. { should be emitted as part of the variable/function def }
  515. asmwrite('; (ait_symbol error, should be part of variable/function def) :');
  516. asmwriteln(tai_symbol(hp).sym.name);
  517. // internalerror(2013010705);
  518. end;
  519. ait_llvmdecl:
  520. begin
  521. if taillvmdecl(hp).def.typ=procdef then
  522. begin
  523. if taillvmdecl(hp).namesym.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL] then
  524. begin
  525. asmwrite('declare');
  526. asmwriteln(llvmencodeproctype(tprocdef(taillvmdecl(hp).def),taillvmdecl(hp).namesym.name,lpd_decl));
  527. end
  528. else
  529. begin
  530. asmwrite('define');
  531. asmwrite(llvmencodeproctype(tprocdef(taillvmdecl(hp).def),'',lpd_decl));
  532. asmwriteln(' {');
  533. end;
  534. end
  535. else
  536. begin
  537. asmwrite(taillvmdecl(hp).namesym.name);
  538. case taillvmdecl(hp).namesym.bind of
  539. AB_EXTERNAL:
  540. asmwrite(' = external global ');
  541. AB_COMMON:
  542. asmwrite(' = common global ');
  543. AB_LOCAL:
  544. asmwrite(' = internal global ');
  545. AB_GLOBAL:
  546. asmwrite(' = global ');
  547. AB_WEAK_EXTERNAL:
  548. asmwrite(' = extern_weak global ');
  549. AB_PRIVATE_EXTERN:
  550. asmwrite('= linker_private global ');
  551. else
  552. internalerror(2014020104);
  553. end;
  554. asmwrite(llvmencodetype(taillvmdecl(hp).def));
  555. if not(taillvmdecl(hp).namesym.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) then
  556. asmwrite(' zeroinitializer');
  557. asmwrite(', align ');
  558. asmwriteln(tostr(taillvmdecl(hp).def.alignment));
  559. end;
  560. end;
  561. ait_llvmalias:
  562. begin
  563. asmwrite('@'+taillvmalias(hp).newsym.name);
  564. asmwrite(' = alias ');
  565. if taillvmalias(hp).linkage<>lll_default then
  566. begin
  567. str(taillvmalias(hp).linkage,s);
  568. asmwrite(copy(s,length('lll_'),255));
  569. asmwrite(' ');
  570. end
  571. else
  572. asmwrite('external ');
  573. if taillvmalias(hp).vis<>llv_default then
  574. begin
  575. str(taillvmalias(hp).vis,s);
  576. asmwrite(copy(s,length('llv_'),255));
  577. asmwrite(' ');
  578. end;
  579. asmwrite(llvmencodeproctype(tabstractprocdef(taillvmalias(hp).def),'',lpd_alias));
  580. asmwrite('* ');
  581. asmwriteln(taillvmalias(hp).oldsym.name);
  582. end;
  583. {$ifdef arm}
  584. ait_thumb_func:
  585. begin
  586. { should be emitted as part of the function def }
  587. internalerror(2013010706);
  588. end;
  589. ait_thumb_set:
  590. begin
  591. { should be emitted as part of the symbol def }
  592. internalerror(2013010707);
  593. end;
  594. {$endif arm}
  595. ait_set:
  596. begin
  597. { should be emitted as part of the symbol def }
  598. internalerror(2013010708);
  599. end;
  600. ait_weak:
  601. begin
  602. { should be emitted as part of the symbol def }
  603. internalerror(2013010709);
  604. end;
  605. ait_symbol_end :
  606. begin
  607. if tai_symbol_end(hp).sym.typ=AT_FUNCTION then
  608. asmwriteln('}')
  609. else
  610. asmwriteln('; ait_symbol_end error, should not be generated');
  611. // internalerror(2013010711);
  612. end;
  613. ait_instruction :
  614. begin
  615. WriteInstruction(hp);
  616. end;
  617. ait_llvmins:
  618. begin
  619. WriteLlvmInstruction(hp);
  620. end;
  621. ait_stab :
  622. begin
  623. internalerror(2013010712);
  624. end;
  625. ait_force_line,
  626. ait_function_name :
  627. ;
  628. ait_cutobject :
  629. begin
  630. end;
  631. ait_marker :
  632. if tai_marker(hp).kind=mark_NoLineInfoStart then
  633. inc(InlineLevel)
  634. else if tai_marker(hp).kind=mark_NoLineInfoEnd then
  635. dec(InlineLevel);
  636. ait_directive :
  637. begin
  638. WriteDirectiveName(tai_directive(hp).directive);
  639. if tai_directive(hp).name <>'' then
  640. AsmWrite(tai_directive(hp).name);
  641. AsmLn;
  642. end;
  643. ait_seh_directive :
  644. begin
  645. internalerror(2013010713);
  646. end;
  647. ait_varloc:
  648. begin
  649. if tai_varloc(hp).newlocationhi<>NR_NO then
  650. AsmWrite(strpnew('Var '+tai_varloc(hp).varsym.realname+' located in register '+
  651. std_regname(tai_varloc(hp).newlocationhi)+':'+std_regname(tai_varloc(hp).newlocation)))
  652. else
  653. AsmWrite(strpnew('Var '+tai_varloc(hp).varsym.realname+' located in register '+
  654. std_regname(tai_varloc(hp).newlocation)));
  655. AsmLn;
  656. end;
  657. else
  658. internalerror(2006012201);
  659. end;
  660. lasthp:=hp;
  661. hp:=tai(hp.next);
  662. end;
  663. end;
  664. procedure TLLVMAssember.WriteExtraHeader;
  665. begin
  666. AsmWrite('target datalayout = "');
  667. AsmWrite(target_info.llvmdatalayout);
  668. AsmWriteln('"');
  669. AsmWrite('target triple = "');
  670. AsmWrite(llvm_target_name);
  671. AsmWriteln('"');
  672. end;
  673. procedure TLLVMAssember.WriteExtraFooter;
  674. begin
  675. end;
  676. procedure TLLVMAssember.WriteInstruction(hp: tai);
  677. begin
  678. end;
  679. procedure TLLVMAssember.WriteLlvmInstruction(hp: tai);
  680. begin
  681. InstrWriter.WriteInstruction(hp);
  682. end;
  683. procedure TLLVMAssember.WriteWeakSymbolDef(s: tasmsymbol);
  684. begin
  685. AsmWriteLn(#9'.weak '+s.name);
  686. end;
  687. procedure TLLVMAssember.WriteRealConst(hp: tai_realconst; do_line: boolean);
  688. var
  689. pdata: pbyte;
  690. index, step, swapmask, count: longint;
  691. begin
  692. // if do_line then
  693. begin
  694. case tai_realconst(hp).realtyp of
  695. aitrealconst_s32bit:
  696. AsmWriteLn(target_asm.comment+'value: '+single2str(tai_realconst(hp).value.s32val));
  697. aitrealconst_s64bit:
  698. AsmWriteLn(target_asm.comment+'value: '+double2str(tai_realconst(hp).value.s64val));
  699. {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
  700. { can't write full 80 bit floating point constants yet on non-x86 }
  701. aitrealconst_s80bit:
  702. AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_realconst(hp).value.s80val));
  703. {$endif cpuextended}
  704. aitrealconst_s64comp:
  705. AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_realconst(hp).value.s64compval));
  706. else
  707. internalerror(2014050604);
  708. end;
  709. end;
  710. end;
  711. constructor TLLVMAssember.create(smart: boolean);
  712. begin
  713. inherited create(smart);
  714. InstrWriter:=TLLVMInstrWriter.create(self);
  715. end;
  716. procedure TLLVMAssember.WriteDirectiveName(dir: TAsmDirective);
  717. begin
  718. AsmWrite('.'+directivestr[dir]+' ');
  719. end;
  720. procedure TLLVMAssember.WriteAsmList;
  721. var
  722. n : string;
  723. hal : tasmlisttype;
  724. i: longint;
  725. begin
  726. if current_module.mainsource<>'' then
  727. n:=ExtractFileName(current_module.mainsource)
  728. else
  729. n:=InputFileName;
  730. { gcc does not add it either for Darwin. Grep for
  731. TARGET_ASM_FILE_START_FILE_DIRECTIVE in gcc/config/*.h
  732. }
  733. if not(target_info.system in systems_darwin) then
  734. AsmWriteLn(#9'.file "'+FixFileName(n)+'"');
  735. WriteExtraHeader;
  736. AsmStartSize:=AsmSize;
  737. symendcount:=0;
  738. for hal:=low(TasmlistType) to high(TasmlistType) do
  739. begin
  740. AsmWriteLn(target_asm.comment+'Begin asmlist '+AsmlistTypeStr[hal]);
  741. writetree(current_asmdata.asmlists[hal]);
  742. AsmWriteLn(target_asm.comment+'End asmlist '+AsmlistTypeStr[hal]);
  743. end;
  744. { add weak symbol markers }
  745. for i:=0 to current_asmdata.asmsymboldict.count-1 do
  746. if (tasmsymbol(current_asmdata.asmsymboldict[i]).bind=AB_WEAK_EXTERNAL) then
  747. writeweaksymboldef(tasmsymbol(current_asmdata.asmsymboldict[i]));
  748. AsmLn;
  749. end;
  750. {****************************************************************************}
  751. { Abstract Instruction Writer }
  752. {****************************************************************************}
  753. constructor TLLVMInstrWriter.create(_owner: TLLVMAssember);
  754. begin
  755. inherited create;
  756. owner := _owner;
  757. end;
  758. const
  759. as_llvm_info : tasminfo =
  760. (
  761. id : as_llvm;
  762. idtxt : 'LLVM-AS';
  763. asmbin : 'llc';
  764. asmcmd: '$OPT -o $OBJ $ASM';
  765. supported_targets : [system_x86_64_linux,system_x86_64_darwin,system_powerpc64_darwin];
  766. flags : [af_smartlink_sections];
  767. labelprefix : 'L';
  768. comment : '; ';
  769. dollarsign: '$';
  770. );
  771. begin
  772. RegisterAssembler(as_llvm_info,TLLVMAssember);
  773. end.