agllvm.pas 27 KB

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