aggas.pas 36 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074
  1. {
  2. Copyright (c) 1998-2006 by the Free Pascal team
  3. This unit implements the generic part of the GNU assembler
  4. (v2.8 or later) writer
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. { Base unit for writing GNU assembler output.
  19. }
  20. unit aggas;
  21. {$i fpcdefs.inc}
  22. interface
  23. uses
  24. {$IFDEF USE_SYSUTILS}
  25. SysUtils,
  26. {$ELSE USE_SYSUTILS}
  27. dos,
  28. {$ENDIF USE_SYSUTILS}
  29. cclasses,
  30. globtype,globals,
  31. aasmbase,aasmtai,aasmdata,aasmcpu,
  32. assemble;
  33. type
  34. TCPUInstrWriter = class;
  35. {# This is a derived class which is used to write
  36. GAS styled assembler.
  37. }
  38. TGNUAssembler=class(texternalassembler)
  39. protected
  40. function sectionname(atype:TAsmSectiontype;const aname:string):string;virtual;
  41. procedure WriteSection(atype:TAsmSectiontype;const aname:string);
  42. procedure WriteExtraHeader;virtual;
  43. procedure WriteInstruction(hp: tai);
  44. public
  45. procedure WriteTree(p:TAsmList);override;
  46. procedure WriteAsmList;override;
  47. destructor destroy; override;
  48. private
  49. setcount: longint;
  50. procedure WriteDecodedSleb128(a: int64);
  51. procedure WriteDecodedUleb128(a: qword);
  52. function NextSetLabel: string;
  53. protected
  54. InstrWriter: TCPUInstrWriter;
  55. end;
  56. {# This is the base class for writing instructions.
  57. The WriteInstruction() method must be overriden
  58. to write a single instruction to the assembler
  59. file.
  60. }
  61. TCPUInstrWriter = class
  62. constructor create(_owner: TGNUAssembler);
  63. procedure WriteInstruction(hp : tai); virtual; abstract;
  64. protected
  65. owner: TGNUAssembler;
  66. end;
  67. TAppleGNUAssembler=class(TGNUAssembler)
  68. function sectionname(atype:TAsmSectiontype;const aname:string):string;override;
  69. private
  70. debugframecount: aint;
  71. end;
  72. implementation
  73. uses
  74. cutils,systems,
  75. fmodule,finput,verbose,
  76. itcpugas
  77. ;
  78. const
  79. line_length = 70;
  80. var
  81. CurrSecType : TAsmSectiontype; { last section type written }
  82. lastfileinfo : tfileposinfo;
  83. infile,
  84. lastinfile : tinputfile;
  85. symendcount : longint;
  86. type
  87. {$ifdef cpuextended}
  88. t80bitarray = array[0..9] of byte;
  89. {$endif cpuextended}
  90. t64bitarray = array[0..7] of byte;
  91. t32bitarray = array[0..3] of byte;
  92. {****************************************************************************}
  93. { Support routines }
  94. {****************************************************************************}
  95. function fixline(s:string):string;
  96. {
  97. return s with all leading and ending spaces and tabs removed
  98. }
  99. var
  100. i,j,k : integer;
  101. begin
  102. i:=length(s);
  103. while (i>0) and (s[i] in [#9,' ']) do
  104. dec(i);
  105. j:=1;
  106. while (j<i) and (s[j] in [#9,' ']) do
  107. inc(j);
  108. for k:=j to i do
  109. if s[k] in [#0..#31,#127..#255] then
  110. s[k]:='.';
  111. fixline:=Copy(s,j,i-j+1);
  112. end;
  113. function single2str(d : single) : string;
  114. var
  115. hs : string;
  116. begin
  117. str(d,hs);
  118. { replace space with + }
  119. if hs[1]=' ' then
  120. hs[1]:='+';
  121. single2str:='0d'+hs
  122. end;
  123. function double2str(d : double) : string;
  124. var
  125. hs : string;
  126. begin
  127. str(d,hs);
  128. { replace space with + }
  129. if hs[1]=' ' then
  130. hs[1]:='+';
  131. double2str:='0d'+hs
  132. end;
  133. function extended2str(e : extended) : string;
  134. var
  135. hs : string;
  136. begin
  137. str(e,hs);
  138. { replace space with + }
  139. if hs[1]=' ' then
  140. hs[1]:='+';
  141. extended2str:='0d'+hs
  142. end;
  143. { convert floating point values }
  144. { to correct endian }
  145. procedure swap64bitarray(var t: t64bitarray);
  146. var
  147. b: byte;
  148. begin
  149. b:= t[7];
  150. t[7] := t[0];
  151. t[0] := b;
  152. b := t[6];
  153. t[6] := t[1];
  154. t[1] := b;
  155. b:= t[5];
  156. t[5] := t[2];
  157. t[2] := b;
  158. b:= t[4];
  159. t[4] := t[3];
  160. t[3] := b;
  161. end;
  162. procedure swap32bitarray(var t: t32bitarray);
  163. var
  164. b: byte;
  165. begin
  166. b:= t[1];
  167. t[1]:= t[2];
  168. t[2]:= b;
  169. b:= t[0];
  170. t[0]:= t[3];
  171. t[3]:= b;
  172. end;
  173. const
  174. ait_const2str : array[aitconst_128bit..aitconst_indirect_symbol] of string[20]=(
  175. #9'.fixme128'#9,#9'.quad'#9,#9'.long'#9,#9'.short'#9,#9'.byte'#9,
  176. #9'.sleb128'#9,#9'.uleb128'#9,
  177. #9'.rva'#9,#9'.indirect_symbol'#9
  178. );
  179. {****************************************************************************}
  180. { GNU Assembler writer }
  181. {****************************************************************************}
  182. destructor TGNUAssembler.Destroy;
  183. begin
  184. InstrWriter.free;
  185. inherited destroy;
  186. end;
  187. function TGNUAssembler.NextSetLabel: string;
  188. begin
  189. inc(setcount);
  190. result := target_asm.labelprefix+'$set$'+tostr(setcount);
  191. end;
  192. function TGNUAssembler.sectionname(atype:TAsmSectiontype;const aname:string):string;
  193. const
  194. secnames : array[TAsmSectiontype] of string[17] = ('',
  195. '.text',
  196. '.data',
  197. {$warning TODO .rodata not yet working}
  198. '.data',
  199. '.bss',
  200. '.threadvar',
  201. '', { stubs }
  202. '.stab',
  203. '.stabstr',
  204. '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
  205. '.eh_frame',
  206. '.debug_frame','.debug_info','.debug_line','.debug_abbrev',
  207. 'fpc.resptrs',
  208. '.toc'
  209. );
  210. secnames_pic : array[TAsmSectiontype] of string[17] = ('',
  211. '.text',
  212. '.data.rel',
  213. '.data.rel',
  214. '.bss',
  215. '.threadvar',
  216. '', { stubs }
  217. '.stab',
  218. '.stabstr',
  219. '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
  220. '.eh_frame',
  221. '.debug_frame','.debug_info','.debug_line','.debug_abbrev',
  222. 'fpc.resptrs',
  223. '.toc'
  224. );
  225. var
  226. secname : string;
  227. begin
  228. if (cs_create_pic in aktmoduleswitches) and
  229. not(target_info.system in [system_powerpc_darwin,system_i386_darwin]) then
  230. secname:=secnames_pic[atype]
  231. else
  232. secname:=secnames[atype];
  233. if (atype=sec_threadvar) and
  234. (target_info.system=system_i386_win32) then
  235. secname:='.tls';
  236. if use_smartlink_section and
  237. (aname<>'') then
  238. result:=secname+'.'+aname
  239. else
  240. result:=secname;
  241. end;
  242. procedure TGNUAssembler.WriteSection(atype:TAsmSectiontype;const aname:string);
  243. var
  244. s : string;
  245. begin
  246. AsmLn;
  247. case target_info.system of
  248. system_i386_OS2,
  249. system_i386_EMX: ;
  250. system_powerpc_darwin,
  251. system_i386_darwin:
  252. begin
  253. if (atype = sec_stub) then
  254. AsmWrite('.section ');
  255. end
  256. else
  257. AsmWrite('.section ');
  258. end;
  259. s:=sectionname(atype,aname);
  260. AsmWrite(s);
  261. case atype of
  262. sec_fpc :
  263. AsmWrite(', "a", @progbits');
  264. sec_stub :
  265. begin
  266. case target_info.system of
  267. { there are processor-independent shortcuts available }
  268. { for this, namely .symbol_stub and .picsymbol_stub, but }
  269. { they don't work and gcc doesn't use them either... }
  270. system_powerpc_darwin:
  271. AsmWriteln('__TEXT,__symbol_stub1,symbol_stubs,pure_instructions,16');
  272. system_i386_darwin:
  273. AsmWriteln('__IMPORT,__jump_table,symbol_stubs,self_modifying_code+pure_instructions,5');
  274. else
  275. internalerror(2006031101);
  276. end;
  277. end;
  278. end;
  279. AsmLn;
  280. CurrSecType:=atype;
  281. end;
  282. procedure TGNUAssembler.WriteDecodedUleb128(a: qword);
  283. var
  284. i,len : longint;
  285. buf : array[0..63] of byte;
  286. begin
  287. len:=EncodeUleb128(a,buf);
  288. for i:=0 to len-1 do
  289. begin
  290. if (i > 0) then
  291. AsmWrite(',');
  292. AsmWrite(tostr(buf[i]));
  293. end;
  294. end;
  295. procedure TGNUAssembler.WriteDecodedSleb128(a: int64);
  296. var
  297. i,len : longint;
  298. buf : array[0..255] of byte;
  299. begin
  300. len:=EncodeSleb128(a,buf);
  301. for i:=0 to len-1 do
  302. begin
  303. if (i > 0) then
  304. AsmWrite(',');
  305. AsmWrite(tostr(buf[i]));
  306. end;
  307. end;
  308. procedure TGNUAssembler.WriteTree(p:TAsmList);
  309. function needsObject(hp : tai_symbol) : boolean;
  310. begin
  311. needsObject :=
  312. (
  313. assigned(hp.next) and
  314. (tai_symbol(hp.next).typ in [ait_const,ait_datablock,
  315. ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit])
  316. ) or
  317. (hp.sym.typ=AT_DATA);
  318. end;
  319. var
  320. ch : char;
  321. hp : tai;
  322. hp1 : tailineinfo;
  323. consttype : taiconst_type;
  324. s,t : string;
  325. i,pos,l : longint;
  326. InlineLevel : longint;
  327. last_align : longint;
  328. co : comp;
  329. sin : single;
  330. d : double;
  331. {$ifdef cpuextended}
  332. e : extended;
  333. {$endif cpuextended}
  334. do_line : boolean;
  335. sepChar : char;
  336. nextdwarffileidx : longint;
  337. begin
  338. if not assigned(p) then
  339. exit;
  340. nextdwarffileidx:=1;
  341. last_align := 2;
  342. InlineLevel:=0;
  343. { lineinfo is only needed for al_procedures (PFV) }
  344. do_line:=(cs_asm_source in aktglobalswitches) or
  345. ((cs_lineinfo in aktmoduleswitches)
  346. and (p=current_asmdata.asmlists[al_procedures]));
  347. hp:=tai(p.first);
  348. while assigned(hp) do
  349. begin
  350. if not(hp.typ in SkipLineInfo) then
  351. begin
  352. hp1 := hp as tailineinfo;
  353. aktfilepos:=hp1.fileinfo;
  354. { no line info for inlined code }
  355. if do_line and (inlinelevel=0) then
  356. begin
  357. { load infile }
  358. if lastfileinfo.fileindex<>hp1.fileinfo.fileindex then
  359. begin
  360. infile:=current_module.sourcefiles.get_file(hp1.fileinfo.fileindex);
  361. if assigned(infile) then
  362. begin
  363. { open only if needed !! }
  364. if (cs_asm_source in aktglobalswitches) then
  365. infile.open;
  366. end;
  367. { avoid unnecessary reopens of the same file !! }
  368. lastfileinfo.fileindex:=hp1.fileinfo.fileindex;
  369. { be sure to change line !! }
  370. lastfileinfo.line:=-1;
  371. end;
  372. { write source }
  373. if (cs_asm_source in aktglobalswitches) and
  374. assigned(infile) then
  375. begin
  376. if (infile<>lastinfile) then
  377. begin
  378. AsmWriteLn(target_asm.comment+'['+infile.name^+']');
  379. if assigned(lastinfile) then
  380. lastinfile.close;
  381. end;
  382. if (hp1.fileinfo.line<>lastfileinfo.line) and
  383. ((hp1.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then
  384. begin
  385. if (hp1.fileinfo.line<>0) and
  386. ((infile.linebuf^[hp1.fileinfo.line]>=0) or (InlineLevel>0)) then
  387. AsmWriteLn(target_asm.comment+'['+tostr(hp1.fileinfo.line)+'] '+
  388. fixline(infile.GetLineStr(hp1.fileinfo.line)));
  389. { set it to a negative value !
  390. to make that is has been read already !! PM }
  391. if (infile.linebuf^[hp1.fileinfo.line]>=0) then
  392. infile.linebuf^[hp1.fileinfo.line]:=-infile.linebuf^[hp1.fileinfo.line]-1;
  393. end;
  394. end;
  395. lastfileinfo:=hp1.fileinfo;
  396. lastinfile:=infile;
  397. end;
  398. end;
  399. case hp.typ of
  400. ait_comment :
  401. Begin
  402. AsmWrite(target_asm.comment);
  403. AsmWritePChar(tai_comment(hp).str);
  404. AsmLn;
  405. End;
  406. ait_regalloc :
  407. begin
  408. if (cs_asm_regalloc in aktglobalswitches) then
  409. begin
  410. AsmWrite(#9+target_asm.comment+'Register ');
  411. repeat
  412. AsmWrite(gas_regname(Tai_regalloc(hp).reg));
  413. if (hp.next=nil) or
  414. (tai(hp.next).typ<>ait_regalloc) or
  415. (tai_regalloc(hp.next).ratype<>tai_regalloc(hp).ratype) then
  416. break;
  417. hp:=tai(hp.next);
  418. AsmWrite(',');
  419. until false;
  420. AsmWrite(' ');
  421. AsmWriteLn(regallocstr[tai_regalloc(hp).ratype]);
  422. end;
  423. end;
  424. ait_tempalloc :
  425. begin
  426. if (cs_asm_tempalloc in aktglobalswitches) then
  427. begin
  428. {$ifdef EXTDEBUG}
  429. if assigned(tai_tempalloc(hp).problem) then
  430. AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+
  431. tostr(tai_tempalloc(hp).tempsize)+' '+tai_tempalloc(hp).problem^)
  432. else
  433. {$endif EXTDEBUG}
  434. AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+
  435. tostr(tai_tempalloc(hp).tempsize)+' '+tempallocstr[tai_tempalloc(hp).allocation]);
  436. end;
  437. end;
  438. ait_align :
  439. begin
  440. if tai_align_abstract(hp).aligntype>1 then
  441. begin
  442. if not(target_info.system in [system_powerpc_darwin,system_i386_darwin]) then
  443. begin
  444. AsmWrite(#9'.balign '+tostr(tai_align_abstract(hp).aligntype));
  445. if tai_align_abstract(hp).use_op then
  446. AsmWrite(','+tostr(tai_align_abstract(hp).fillop))
  447. end
  448. else
  449. begin
  450. { darwin as only supports .align }
  451. if not ispowerof2(tai_align_abstract(hp).aligntype,i) then
  452. internalerror(2003010305);
  453. AsmWrite(#9'.align '+tostr(i));
  454. last_align := i;
  455. end;
  456. AsmLn;
  457. end;
  458. end;
  459. ait_section :
  460. begin
  461. if tai_section(hp).sectype<>sec_none then
  462. WriteSection(tai_section(hp).sectype,tai_section(hp).name^)
  463. else
  464. begin
  465. {$ifdef EXTDEBUG}
  466. AsmWrite(target_asm.comment);
  467. AsmWriteln(' sec_none');
  468. {$endif EXTDEBUG}
  469. end;
  470. end;
  471. ait_datablock :
  472. begin
  473. if target_info.system in [system_powerpc_darwin,system_i386_darwin] then
  474. begin
  475. {On Mac OS X you can't have common symbols in a shared
  476. library, since those are in the TEXT section and the text section is
  477. read-only in shared libraries (so it can be shared among different
  478. processes). The alternate code creates some kind of common symbols in
  479. the data segment. The generic code no longer uses common symbols, but
  480. this doesn't work on Mac OS X as well.}
  481. if tai_datablock(hp).is_global then
  482. begin
  483. asmwrite('.globl ');
  484. asmwriteln(tai_datablock(hp).sym.name);
  485. asmwriteln('.data');
  486. asmwrite('.zerofill __DATA, __common, ');
  487. asmwrite(tai_datablock(hp).sym.name);
  488. asmwriteln(', '+tostr(tai_datablock(hp).size)+','+tostr(last_align));
  489. if not(CurrSecType in [sec_data,sec_none]) then
  490. writesection(CurrSecType,'');
  491. end
  492. else
  493. begin
  494. asmwrite(#9'.lcomm'#9);
  495. asmwrite(tai_datablock(hp).sym.name);
  496. asmwrite(','+tostr(tai_datablock(hp).size));
  497. asmwrite(','+tostr(last_align));
  498. asmwriteln('');
  499. end
  500. end
  501. else
  502. begin
  503. if Tai_datablock(hp).is_global then
  504. begin
  505. asmwrite(#9'.globl ');
  506. asmwriteln(Tai_datablock(hp).sym.name);
  507. end;
  508. if (target_info.system <> system_arm_linux) then
  509. sepChar := '@'
  510. else
  511. sepChar := '%';
  512. if (tf_needs_symbol_type in target_info.flags) then
  513. asmwriteln(#9'.type '+Tai_datablock(hp).sym.name+','+sepChar+'object');
  514. if (tf_needs_symbol_size in target_info.flags) and (tai_datablock(hp).size > 0) then
  515. asmwriteln(#9'.size '+Tai_datablock(hp).sym.name+','+tostr(Tai_datablock(hp).size));
  516. asmwrite(Tai_datablock(hp).sym.name);
  517. asmwriteln(':');
  518. asmwriteln(#9'.zero '+tostr(Tai_datablock(hp).size));
  519. end;
  520. end;
  521. ait_const:
  522. begin
  523. consttype:=tai_const(hp).consttype;
  524. case consttype of
  525. {$ifndef cpu64bit}
  526. aitconst_128bit :
  527. begin
  528. internalerror(200404291);
  529. end;
  530. aitconst_64bit :
  531. begin
  532. if assigned(tai_const(hp).sym) then
  533. internalerror(200404292);
  534. AsmWrite(ait_const2str[aitconst_32bit]);
  535. if target_info.endian = endian_little then
  536. begin
  537. AsmWrite(tostr(longint(lo(tai_const(hp).value))));
  538. AsmWrite(',');
  539. AsmWrite(tostr(longint(hi(tai_const(hp).value))));
  540. end
  541. else
  542. begin
  543. AsmWrite(tostr(longint(hi(tai_const(hp).value))));
  544. AsmWrite(',');
  545. AsmWrite(tostr(longint(lo(tai_const(hp).value))));
  546. end;
  547. AsmLn;
  548. end;
  549. {$endif cpu64bit}
  550. aitconst_uleb128bit,
  551. aitconst_sleb128bit,
  552. {$ifdef cpu64bit}
  553. aitconst_128bit,
  554. aitconst_64bit,
  555. {$endif cpu64bit}
  556. aitconst_32bit,
  557. aitconst_16bit,
  558. aitconst_8bit,
  559. aitconst_rva_symbol,
  560. aitconst_indirect_symbol :
  561. begin
  562. if (target_info.system in [system_powerpc_darwin,system_i386_darwin]) and
  563. (tai_const(hp).consttype in [aitconst_uleb128bit,aitconst_sleb128bit]) then
  564. begin
  565. AsmWrite(ait_const2str[aitconst_8bit]);
  566. case tai_const(hp).consttype of
  567. aitconst_uleb128bit:
  568. WriteDecodedUleb128(qword(tai_const(hp).value));
  569. aitconst_sleb128bit:
  570. WriteDecodedSleb128(int64(tai_const(hp).value));
  571. end
  572. end
  573. else
  574. begin
  575. AsmWrite(ait_const2str[tai_const(hp).consttype]);
  576. l:=0;
  577. t := '';
  578. repeat
  579. if assigned(tai_const(hp).sym) then
  580. begin
  581. if assigned(tai_const(hp).endsym) then
  582. begin
  583. if (target_info.system in [system_powerpc_darwin,system_i386_darwin]) then
  584. begin
  585. s := NextSetLabel;
  586. t := #9'.set '+s+','+tai_const(hp).endsym.name+'-'+tai_const(hp).sym.name;
  587. end
  588. else
  589. s:=tai_const(hp).endsym.name+'-'+tai_const(hp).sym.name
  590. end
  591. else
  592. s:=tai_const(hp).sym.name;
  593. if tai_const(hp).value<>0 then
  594. s:=s+tostr_with_plus(tai_const(hp).value);
  595. end
  596. else
  597. s:=tostr(tai_const(hp).value);
  598. AsmWrite(s);
  599. inc(l,length(s));
  600. { Values with symbols are written on a single line to improve
  601. reading of the .s file (PFV) }
  602. if assigned(tai_const(hp).sym) or
  603. not(CurrSecType in [sec_data,sec_rodata]) or
  604. (l>line_length) or
  605. (hp.next=nil) or
  606. (tai(hp.next).typ<>ait_const) or
  607. (tai_const(hp.next).consttype<>consttype) or
  608. assigned(tai_const(hp.next).sym) then
  609. break;
  610. hp:=tai(hp.next);
  611. AsmWrite(',');
  612. until false;
  613. if (t <> '') then
  614. begin
  615. AsmLn;
  616. AsmWrite(t);
  617. end;
  618. end;
  619. AsmLn;
  620. end;
  621. end;
  622. end;
  623. {$ifdef cpuextended}
  624. ait_real_80bit :
  625. begin
  626. if do_line then
  627. AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_real_80bit(hp).value));
  628. { Make sure e is a extended type, bestreal could be
  629. a different type (bestreal) !! (PFV) }
  630. e:=tai_real_80bit(hp).value;
  631. AsmWrite(#9'.byte'#9);
  632. for i:=0 to 9 do
  633. begin
  634. if i<>0 then
  635. AsmWrite(',');
  636. AsmWrite(tostr(t80bitarray(e)[i]));
  637. end;
  638. AsmLn;
  639. end;
  640. {$endif cpuextended}
  641. ait_real_64bit :
  642. begin
  643. if do_line then
  644. AsmWriteLn(target_asm.comment+'value: '+double2str(tai_real_64bit(hp).value));
  645. d:=tai_real_64bit(hp).value;
  646. { swap the values to correct endian if required }
  647. if source_info.endian <> target_info.endian then
  648. swap64bitarray(t64bitarray(d));
  649. AsmWrite(#9'.byte'#9);
  650. {$ifdef arm}
  651. { on a real arm cpu, it's already hi/lo swapped }
  652. {$ifndef cpuarm}
  653. if tai_real_64bit(hp).formatoptions=fo_hiloswapped then
  654. begin
  655. for i:=4 to 7 do
  656. begin
  657. if i<>4 then
  658. AsmWrite(',');
  659. AsmWrite(tostr(t64bitarray(d)[i]));
  660. end;
  661. for i:=0 to 3 do
  662. begin
  663. AsmWrite(',');
  664. AsmWrite(tostr(t64bitarray(d)[i]));
  665. end;
  666. end
  667. else
  668. {$endif cpuarm}
  669. {$endif arm}
  670. begin
  671. for i:=0 to 7 do
  672. begin
  673. if i<>0 then
  674. AsmWrite(',');
  675. AsmWrite(tostr(t64bitarray(d)[i]));
  676. end;
  677. end;
  678. AsmLn;
  679. end;
  680. ait_real_32bit :
  681. begin
  682. if do_line then
  683. AsmWriteLn(target_asm.comment+'value: '+single2str(tai_real_32bit(hp).value));
  684. sin:=tai_real_32bit(hp).value;
  685. { swap the values to correct endian if required }
  686. if source_info.endian <> target_info.endian then
  687. swap32bitarray(t32bitarray(sin));
  688. AsmWrite(#9'.byte'#9);
  689. for i:=0 to 3 do
  690. begin
  691. if i<>0 then
  692. AsmWrite(',');
  693. AsmWrite(tostr(t32bitarray(sin)[i]));
  694. end;
  695. AsmLn;
  696. end;
  697. ait_comp_64bit :
  698. begin
  699. if do_line then
  700. AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_comp_64bit(hp).value));
  701. AsmWrite(#9'.byte'#9);
  702. {$ifdef FPC}
  703. co:=comp(tai_comp_64bit(hp).value);
  704. {$else}
  705. co:=tai_comp_64bit(hp).value;
  706. {$endif}
  707. { swap the values to correct endian if required }
  708. if source_info.endian <> target_info.endian then
  709. swap64bitarray(t64bitarray(co));
  710. for i:=0 to 7 do
  711. begin
  712. if i<>0 then
  713. AsmWrite(',');
  714. AsmWrite(tostr(t64bitarray(co)[i]));
  715. end;
  716. AsmLn;
  717. end;
  718. ait_string :
  719. begin
  720. pos:=0;
  721. for i:=1 to tai_string(hp).len do
  722. begin
  723. if pos=0 then
  724. begin
  725. AsmWrite(#9'.ascii'#9'"');
  726. pos:=20;
  727. end;
  728. ch:=tai_string(hp).str[i-1];
  729. case ch of
  730. #0, {This can't be done by range, because a bug in FPC}
  731. #1..#31,
  732. #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7);
  733. '"' : s:='\"';
  734. '\' : s:='\\';
  735. else
  736. s:=ch;
  737. end;
  738. AsmWrite(s);
  739. inc(pos,length(s));
  740. if (pos>line_length) or (i=tai_string(hp).len) then
  741. begin
  742. AsmWriteLn('"');
  743. pos:=0;
  744. end;
  745. end;
  746. end;
  747. ait_label :
  748. begin
  749. if (tai_label(hp).labsym.is_used) then
  750. begin
  751. if tai_label(hp).labsym.bind=AB_GLOBAL then
  752. begin
  753. AsmWrite('.globl'#9);
  754. AsmWriteLn(tai_label(hp).labsym.name);
  755. end;
  756. AsmWrite(tai_label(hp).labsym.name);
  757. AsmWriteLn(':');
  758. end;
  759. end;
  760. ait_symbol :
  761. begin
  762. if tai_symbol(hp).is_global then
  763. begin
  764. AsmWrite('.globl'#9);
  765. AsmWriteLn(tai_symbol(hp).sym.name);
  766. end;
  767. if (target_info.system = system_powerpc64_linux) and
  768. (tai_symbol(hp).sym.typ = AT_FUNCTION) then
  769. begin
  770. AsmWriteLn('.section "opd", "aw"');
  771. AsmWriteLn('.align 3');
  772. AsmWriteLn(tai_symbol(hp).sym.name + ':');
  773. AsmWriteLn('.quad .' + tai_symbol(hp).sym.name + ', .TOC.@tocbase, 0');
  774. AsmWriteLn('.previous');
  775. AsmWriteLn('.size ' + tai_symbol(hp).sym.name + ', 24');
  776. AsmWriteLn('.globl .' + tai_symbol(hp).sym.name);
  777. AsmWriteLn('.type .' + tai_symbol(hp).sym.name + ', @function');
  778. { the dotted name is the name of the actual function entry }
  779. AsmWrite('.');
  780. end
  781. else
  782. begin
  783. if (target_info.system <> system_arm_linux) then
  784. sepChar := '@'
  785. else
  786. sepChar := '#';
  787. if (tf_needs_symbol_type in target_info.flags) then
  788. begin
  789. AsmWrite(#9'.type'#9 + tai_symbol(hp).sym.name);
  790. if (needsObject(tai_symbol(hp))) then
  791. AsmWriteLn(',' + sepChar + 'object')
  792. else
  793. AsmWriteLn(',' + sepChar + 'function');
  794. end;
  795. end;
  796. AsmWriteLn(tai_symbol(hp).sym.name + ':');
  797. end;
  798. ait_symbol_end :
  799. begin
  800. if tf_needs_symbol_size in target_info.flags then
  801. begin
  802. s:=target_asm.labelprefix+'e'+tostr(symendcount);
  803. inc(symendcount);
  804. AsmWriteLn(s+':');
  805. AsmWrite(#9'.size'#9);
  806. if (target_info.system = system_powerpc64_linux) and (tai_symbol_end(hp).sym.typ = AT_FUNCTION) then
  807. AsmWrite('.');
  808. AsmWrite(tai_symbol_end(hp).sym.name);
  809. AsmWrite(', '+s+' - ');
  810. if (target_info.system = system_powerpc64_linux) and (tai_symbol_end(hp).sym.typ = AT_FUNCTION) then
  811. AsmWrite('.');
  812. AsmWriteLn(tai_symbol_end(hp).sym.name);
  813. end;
  814. end;
  815. ait_instruction :
  816. begin
  817. WriteInstruction(hp);
  818. end;
  819. ait_stab :
  820. begin
  821. if assigned(tai_stab(hp).str) then
  822. begin
  823. AsmWrite(#9'.'+stabtypestr[tai_stab(hp).stabtype]+' ');
  824. AsmWritePChar(tai_stab(hp).str);
  825. AsmLn;
  826. end;
  827. end;
  828. ait_file :
  829. begin
  830. tai_file(hp).idx:=nextdwarffileidx;
  831. inc(nextdwarffileidx);
  832. AsmWrite(#9'.file '+tostr(tai_file(hp).idx)+' "');
  833. AsmWritePChar(tai_file(hp).str);
  834. AsmWrite('"');
  835. AsmLn;
  836. end;
  837. ait_loc :
  838. begin
  839. AsmWrite(#9'.loc '+tostr(tai_loc(hp).fileentry.idx)+' '+tostr(tai_loc(hp).line)+' '+tostr(tai_loc(hp).column));
  840. AsmLn;
  841. end;
  842. ait_force_line,
  843. ait_function_name : ;
  844. ait_cutobject :
  845. begin
  846. if SmartAsm then
  847. begin
  848. { only reset buffer if nothing has changed }
  849. if AsmSize=AsmStartSize then
  850. AsmClear
  851. else
  852. begin
  853. AsmClose;
  854. DoAssemble;
  855. AsmCreate(tai_cutobject(hp).place);
  856. end;
  857. { avoid empty files }
  858. while assigned(hp.next) and (tai(hp.next).typ in [ait_cutobject,ait_section,ait_comment]) do
  859. begin
  860. if tai(hp.next).typ=ait_section then
  861. CurrSecType:=tai_section(hp.next).sectype;
  862. hp:=tai(hp.next);
  863. end;
  864. if CurrSecType<>sec_none then
  865. WriteSection(CurrSecType,'');
  866. AsmStartSize:=AsmSize;
  867. { reset dwarf file index }
  868. nextdwarffileidx:=1;
  869. end;
  870. end;
  871. ait_marker :
  872. if tai_marker(hp).kind=mark_InlineStart then
  873. inc(InlineLevel)
  874. else if tai_marker(hp).kind=mark_InlineEnd then
  875. dec(InlineLevel);
  876. ait_directive :
  877. begin
  878. AsmWrite('.'+directivestr[tai_directive(hp).directive]+' ');
  879. if assigned(tai_directive(hp).name) then
  880. AsmWrite(tai_directive(hp).name^);
  881. AsmLn;
  882. end;
  883. else
  884. internalerror(2006012201);
  885. end;
  886. hp:=tai(hp.next);
  887. end;
  888. end;
  889. procedure TGNUAssembler.WriteExtraHeader;
  890. begin
  891. end;
  892. procedure TGNUAssembler.WriteInstruction(hp: tai);
  893. begin
  894. InstrWriter.WriteInstruction(hp);
  895. end;
  896. procedure TGNUAssembler.WriteAsmList;
  897. var
  898. p:dirstr;
  899. n:namestr;
  900. e:extstr;
  901. hal : tasmlisttype;
  902. begin
  903. {$ifdef EXTDEBUG}
  904. if assigned(current_module.mainsource) then
  905. Comment(V_Debug,'Start writing gas-styled assembler output for '+current_module.mainsource^);
  906. {$endif}
  907. CurrSecType:=sec_none;
  908. FillChar(lastfileinfo,sizeof(lastfileinfo),0);
  909. LastInfile:=nil;
  910. if assigned(current_module.mainsource) then
  911. {$IFDEF USE_SYSUTILS}
  912. begin
  913. p := SplitPath(current_module.mainsource^);
  914. n := SplitName(current_module.mainsource^);
  915. e := SplitExtension(current_module.mainsource^);
  916. end
  917. {$ELSE USE_SYSUTILS}
  918. fsplit(current_module.mainsource^,p,n,e)
  919. {$ENDIF USE_SYSUTILS}
  920. else
  921. begin
  922. p:=inputdir;
  923. n:=inputfile;
  924. e:=inputextension;
  925. end;
  926. { to get symify to work }
  927. AsmWriteLn(#9'.file "'+FixFileName(n+e)+'"');
  928. WriteExtraHeader;
  929. AsmStartSize:=AsmSize;
  930. symendcount:=0;
  931. for hal:=low(TasmlistType) to high(TasmlistType) do
  932. begin
  933. AsmWriteLn(target_asm.comment+'Begin asmlist '+AsmlistTypeStr[hal]);
  934. writetree(current_asmdata.asmlists[hal]);
  935. AsmWriteLn(target_asm.comment+'End asmlist '+AsmlistTypeStr[hal]);
  936. end;
  937. AsmLn;
  938. {$ifdef EXTDEBUG}
  939. if assigned(current_module.mainsource) then
  940. Comment(V_Debug,'Done writing gas-styled assembler output for '+current_module.mainsource^);
  941. {$endif EXTDEBUG}
  942. end;
  943. {****************************************************************************}
  944. { Apple/GNU Assembler writer }
  945. {****************************************************************************}
  946. function TAppleGNUAssembler.sectionname(atype:TAsmSectiontype;const aname:string):string;
  947. begin
  948. if (target_info.system in [system_powerpc_darwin,system_i386_darwin]) then
  949. case atype of
  950. sec_bss:
  951. { all bss (lcomm) symbols are automatically put in the right }
  952. { place by using the lcomm assembler directive }
  953. atype := sec_none;
  954. sec_debug_frame,
  955. sec_eh_frame:
  956. begin
  957. result := '.section __DWARFA,__debug_frame,coalesced,no_toc+strip_static_syms'#10'EH_frame'+tostr(debugframecount)+':';
  958. inc(debugframecount);
  959. exit;
  960. end;
  961. end;
  962. result := inherited sectionname(atype,aname);
  963. end;
  964. {****************************************************************************}
  965. { Abstract Instruction Writer }
  966. {****************************************************************************}
  967. constructor TCPUInstrWriter.create(_owner: TGNUAssembler);
  968. begin
  969. inherited create;
  970. owner := _owner;
  971. end;
  972. end.