aggas.pas 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by the Free Pascal team
  4. This unit implements generic GNU assembler (v2.8 or later)
  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. cclasses,
  25. globals,
  26. aasmbase,aasmtai,aasmcpu,
  27. assemble;
  28. type
  29. {# This is a derived class which is used to write
  30. GAS styled assembler.
  31. The WriteInstruction() method must be overriden
  32. to write a single instruction to the assembler
  33. file.
  34. }
  35. TGNUAssembler=class(texternalassembler)
  36. public
  37. procedure WriteTree(p:TAAsmoutput);override;
  38. procedure WriteAsmList;override;
  39. procedure WriteExtraHeader;virtual;
  40. {$ifdef GDB}
  41. procedure WriteFileLineInfo(var fileinfo : tfileposinfo);
  42. procedure WriteFileEndInfo;
  43. {$endif}
  44. procedure WriteInstruction(hp: tai); virtual; abstract;
  45. end;
  46. implementation
  47. uses
  48. {$ifdef Delphi}
  49. dmisc,
  50. {$else Delphi}
  51. dos,
  52. {$endif Delphi}
  53. cutils,globtype,systems,
  54. fmodule,finput,verbose,cpubase
  55. {$ifdef GDB}
  56. {$ifdef delphi}
  57. ,sysutils
  58. {$else}
  59. ,strings
  60. {$endif}
  61. ,gdb
  62. {$endif GDB}
  63. ;
  64. const
  65. line_length = 70;
  66. var
  67. {$ifdef GDB}
  68. n_line : byte; { different types of source lines }
  69. linecount,
  70. includecount : longint;
  71. funcname : pchar;
  72. stabslastfileinfo : tfileposinfo;
  73. {$endif}
  74. lasTSec : TSection; { last section type written }
  75. lastfileinfo : tfileposinfo;
  76. infile,
  77. lastinfile : tinputfile;
  78. symendcount : longint;
  79. type
  80. t80bitarray = array[0..9] of byte;
  81. t64bitarray = array[0..7] of byte;
  82. t32bitarray = array[0..3] of byte;
  83. {****************************************************************************}
  84. { Support routines }
  85. {****************************************************************************}
  86. function fixline(s:string):string;
  87. {
  88. return s with all leading and ending spaces and tabs removed
  89. }
  90. var
  91. i,j,k : integer;
  92. begin
  93. i:=length(s);
  94. while (i>0) and (s[i] in [#9,' ']) do
  95. dec(i);
  96. j:=1;
  97. while (j<i) and (s[j] in [#9,' ']) do
  98. inc(j);
  99. for k:=j to i do
  100. if s[k] in [#0..#31,#127..#255] then
  101. s[k]:='.';
  102. fixline:=Copy(s,j,i-j+1);
  103. end;
  104. function single2str(d : single) : string;
  105. var
  106. hs : string;
  107. begin
  108. str(d,hs);
  109. { replace space with + }
  110. if hs[1]=' ' then
  111. hs[1]:='+';
  112. single2str:='0d'+hs
  113. end;
  114. function double2str(d : double) : string;
  115. var
  116. hs : string;
  117. begin
  118. str(d,hs);
  119. { replace space with + }
  120. if hs[1]=' ' then
  121. hs[1]:='+';
  122. double2str:='0d'+hs
  123. end;
  124. function extended2str(e : extended) : string;
  125. var
  126. hs : string;
  127. begin
  128. str(e,hs);
  129. { replace space with + }
  130. if hs[1]=' ' then
  131. hs[1]:='+';
  132. extended2str:='0d'+hs
  133. end;
  134. { convert floating point values }
  135. { to correct endian }
  136. procedure swap64bitarray(var t: t64bitarray);
  137. var
  138. b: byte;
  139. begin
  140. b:= t[7];
  141. t[7] := t[0];
  142. t[0] := b;
  143. b := t[6];
  144. t[6] := t[1];
  145. t[1] := b;
  146. b:= t[5];
  147. t[5] := t[2];
  148. t[2] := b;
  149. b:= t[4];
  150. t[4] := t[3];
  151. t[3] := b;
  152. end;
  153. procedure swap32bitarray(var t: t32bitarray);
  154. var
  155. b: byte;
  156. begin
  157. b:= t[1];
  158. t[1]:= t[2];
  159. t[2]:= b;
  160. b:= t[0];
  161. t[0]:= t[3];
  162. t[3]:= b;
  163. end;
  164. procedure swap80bitarray(var t: t80bitarray);
  165. begin
  166. {!!!!!!!!!!!!}
  167. end;
  168. const
  169. ait_const2str : array[ait_const_32bit..ait_const_8bit] of string[8]=
  170. (#9'.long'#9,#9'.short'#9,#9'.byte'#9);
  171. function ait_section2str(s:TSection):string;
  172. begin
  173. ait_section2str:=target_asm.secnames[s];
  174. {$ifdef GDB}
  175. { this is needed for line info in data }
  176. funcname:=nil;
  177. case s of
  178. sec_code : n_line:=n_textline;
  179. sec_data : n_line:=n_dataline;
  180. sec_bss : n_line:=n_bssline;
  181. else n_line:=n_dataline;
  182. end;
  183. {$endif GDB}
  184. LasTSec:=s;
  185. end;
  186. {****************************************************************************}
  187. { GNU Assembler writer }
  188. {****************************************************************************}
  189. {$ifdef GDB}
  190. procedure TGNUAssembler.WriteFileLineInfo(var fileinfo : tfileposinfo);
  191. var
  192. curr_n : byte;
  193. begin
  194. if not ((cs_debuginfo in aktmoduleswitches) or
  195. (cs_gdb_lineinfo in aktglobalswitches)) then
  196. exit;
  197. { file changed ? (must be before line info) }
  198. if (fileinfo.fileindex<>0) and
  199. (stabslastfileinfo.fileindex<>fileinfo.fileindex) then
  200. begin
  201. infile:=current_module.sourcefiles.get_file(fileinfo.fileindex);
  202. if assigned(infile) then
  203. begin
  204. if includecount=0 then
  205. curr_n:=n_sourcefile
  206. else
  207. curr_n:=n_includefile;
  208. if (infile.path^<>'') then
  209. begin
  210. AsmWriteLn(#9'.stabs "'+lower(BsToSlash(FixPath(infile.path^,false)))+'",'+
  211. tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount));
  212. end;
  213. AsmWriteLn(#9'.stabs "'+lower(FixFileName(infile.name^))+'",'+
  214. tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount));
  215. AsmWriteLn('Ltext'+ToStr(IncludeCount)+':');
  216. inc(includecount);
  217. end;
  218. end;
  219. { line changed ? }
  220. if (stabslastfileinfo.line<>fileinfo.line) and (fileinfo.line<>0) then
  221. begin
  222. if (n_line=n_textline) and assigned(funcname) and
  223. (target_info.use_function_relative_addresses) then
  224. begin
  225. AsmWriteLn(target_asm.labelprefix+'l'+tostr(linecount)+':');
  226. AsmWrite(#9'.stabn '+tostr(n_line)+',0,'+tostr(fileinfo.line)+','+
  227. target_asm.labelprefix+'l'+tostr(linecount)+' - ');
  228. AsmWritePChar(FuncName);
  229. AsmLn;
  230. inc(linecount);
  231. end
  232. else
  233. AsmWriteLn(#9'.stabd'#9+tostr(n_line)+',0,'+tostr(fileinfo.line));
  234. end;
  235. stabslastfileinfo:=fileinfo;
  236. end;
  237. procedure TGNUAssembler.WriteFileEndInfo;
  238. begin
  239. if not ((cs_debuginfo in aktmoduleswitches) or
  240. (cs_gdb_lineinfo in aktglobalswitches)) then
  241. exit;
  242. AsmLn;
  243. AsmWriteLn(ait_section2str(sec_code));
  244. AsmWriteLn(#9'.stabs "",'+tostr(n_sourcefile)+',0,0,Letext');
  245. AsmWriteLn('Letext:');
  246. end;
  247. {$endif GDB}
  248. procedure TGNUAssembler.WriteTree(p:TAAsmoutput);
  249. const
  250. allocstr : array[boolean] of string[10]=(' released',' allocated');
  251. nolinetai =[ait_label,
  252. ait_regalloc,ait_tempalloc,
  253. {$ifdef GDB}
  254. ait_stabn,ait_stabs,ait_stab_function_name,
  255. {$endif GDB}
  256. ait_cut,ait_marker,ait_align,ait_section];
  257. type
  258. t80bitarray = array[0..9] of byte;
  259. t64bitarray = array[0..7] of byte;
  260. t32bitarray = array[0..3] of byte;
  261. var
  262. ch : char;
  263. hp : tai;
  264. consttyp : taitype;
  265. s : string;
  266. found : boolean;
  267. i,pos,l : longint;
  268. InlineLevel : longint;
  269. co : comp;
  270. sin : single;
  271. d : double;
  272. e : extended;
  273. do_line : boolean;
  274. sep : char;
  275. {$ifdef delphi}
  276. _64bitarray : t64bitarray;
  277. {$endif}
  278. begin
  279. if not assigned(p) then
  280. exit;
  281. InlineLevel:=0;
  282. { lineinfo is only needed for codesegment (PFV) }
  283. do_line:=(cs_asm_source in aktglobalswitches) or
  284. ((cs_lineinfo in aktmoduleswitches)
  285. and (p=codesegment));
  286. hp:=tai(p.first);
  287. while assigned(hp) do
  288. begin
  289. aktfilepos:=hp.fileinfo;
  290. if not(hp.typ in nolinetai) then
  291. begin
  292. {$ifdef GDB}
  293. { write stabs }
  294. if (cs_debuginfo in aktmoduleswitches) or
  295. (cs_gdb_lineinfo in aktglobalswitches) then
  296. WriteFileLineInfo(hp.fileinfo);
  297. {$endif GDB}
  298. { no line info for inlined code }
  299. if do_line and (inlinelevel=0) then
  300. begin
  301. { load infile }
  302. if lastfileinfo.fileindex<>hp.fileinfo.fileindex then
  303. begin
  304. infile:=current_module.sourcefiles.get_file(hp.fileinfo.fileindex);
  305. if assigned(infile) then
  306. begin
  307. { open only if needed !! }
  308. if (cs_asm_source in aktglobalswitches) then
  309. infile.open;
  310. end;
  311. { avoid unnecessary reopens of the same file !! }
  312. lastfileinfo.fileindex:=hp.fileinfo.fileindex;
  313. { be sure to change line !! }
  314. lastfileinfo.line:=-1;
  315. end;
  316. { write source }
  317. if (cs_asm_source in aktglobalswitches) and
  318. assigned(infile) then
  319. begin
  320. if (infile<>lastinfile) then
  321. begin
  322. AsmWriteLn(target_asm.comment+'['+infile.name^+']');
  323. if assigned(lastinfile) then
  324. lastinfile.close;
  325. end;
  326. if (hp.fileinfo.line<>lastfileinfo.line) and
  327. ((hp.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then
  328. begin
  329. if (hp.fileinfo.line<>0) and
  330. ((infile.linebuf^[hp.fileinfo.line]>=0) or (InlineLevel>0)) then
  331. AsmWriteLn(target_asm.comment+'['+tostr(hp.fileinfo.line)+'] '+
  332. fixline(infile.GetLineStr(hp.fileinfo.line)));
  333. { set it to a negative value !
  334. to make that is has been read already !! PM }
  335. if (infile.linebuf^[hp.fileinfo.line]>=0) then
  336. infile.linebuf^[hp.fileinfo.line]:=-infile.linebuf^[hp.fileinfo.line]-1;
  337. end;
  338. end;
  339. lastfileinfo:=hp.fileinfo;
  340. lastinfile:=infile;
  341. end;
  342. end;
  343. case hp.typ of
  344. ait_comment :
  345. Begin
  346. AsmWrite(target_asm.comment);
  347. AsmWritePChar(tai_comment(hp).str);
  348. AsmLn;
  349. End;
  350. ait_regalloc :
  351. begin
  352. if (cs_asm_regalloc in aktglobalswitches) then
  353. AsmWriteLn(target_asm.comment+'Register '+std_reg2str[tai_regalloc(hp).reg]+
  354. allocstr[tai_regalloc(hp).allocation]);
  355. end;
  356. ait_tempalloc :
  357. begin
  358. if (cs_asm_tempalloc in aktglobalswitches) then
  359. AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+
  360. tostr(tai_tempalloc(hp).tempsize)+allocstr[tai_tempalloc(hp).allocation]);
  361. end;
  362. ait_align :
  363. begin
  364. AsmWrite(#9'.balign '+tostr(tai_align(hp).aligntype));
  365. if tai_align(hp).use_op then
  366. AsmWrite(','+tostr(tai_align(hp).fillop));
  367. AsmLn;
  368. end;
  369. ait_section :
  370. begin
  371. if tai_section(hp).sec<>sec_none then
  372. begin
  373. AsmLn;
  374. AsmWriteLn(ait_section2str(tai_section(hp).sec));
  375. {$ifdef GDB}
  376. lastfileinfo.line:=-1;
  377. {$endif GDB}
  378. end;
  379. end;
  380. ait_datablock :
  381. begin
  382. if tai_datablock(hp).is_global then
  383. AsmWrite(#9'.comm'#9)
  384. else
  385. AsmWrite(#9'.lcomm'#9);
  386. AsmWrite(tai_datablock(hp).sym.name);
  387. AsmWriteLn(','+tostr(tai_datablock(hp).size));
  388. end;
  389. ait_const_32bit,
  390. ait_const_16bit,
  391. ait_const_8bit :
  392. begin
  393. AsmWrite(ait_const2str[hp.typ]+tostr(tai_const(hp).value));
  394. consttyp:=hp.typ;
  395. l:=0;
  396. repeat
  397. found:=(not (tai(hp.next)=nil)) and (tai(hp.next).typ=consttyp);
  398. if found then
  399. begin
  400. hp:=tai(hp.next);
  401. s:=','+tostr(tai_const(hp).value);
  402. AsmWrite(s);
  403. inc(l,length(s));
  404. end;
  405. until (not found) or (l>line_length);
  406. AsmLn;
  407. end;
  408. ait_const_symbol :
  409. begin
  410. AsmWrite(#9'.long'#9+tai_const_symbol(hp).sym.name);
  411. if tai_const_symbol(hp).offset>0 then
  412. AsmWrite('+'+tostr(tai_const_symbol(hp).offset))
  413. else if tai_const_symbol(hp).offset<0 then
  414. AsmWrite(tostr(tai_const_symbol(hp).offset));
  415. AsmLn;
  416. end;
  417. ait_const_rva :
  418. AsmWriteLn(#9'.rva'#9+tai_const_symbol(hp).sym.name);
  419. ait_real_80bit :
  420. begin
  421. if do_line then
  422. AsmWriteLn(target_asm.comment+target_asm.comment+extended2str(tai_real_80bit(hp).value));
  423. { Make sure e is a extended type, bestreal could be
  424. a different type (bestreal) !! (PFV) }
  425. e:=tai_real_80bit(hp).value;
  426. AsmWrite(#9'.byte'#9);
  427. for i:=0 to 9 do
  428. begin
  429. if i<>0 then
  430. AsmWrite(',');
  431. AsmWrite(tostr(t80bitarray(e)[i]));
  432. end;
  433. AsmLn;
  434. end;
  435. ait_real_64bit :
  436. begin
  437. if do_line then
  438. AsmWriteLn(target_asm.comment+target_asm.comment+double2str(tai_real_64bit(hp).value));
  439. d:=tai_real_64bit(hp).value;
  440. { swap the values to correct endian if required }
  441. {$ifdef fpc}
  442. if source_info.endian <> target_info.endian then
  443. swap64bitarray(t64bitarray(d));
  444. {$endif}
  445. AsmWrite(#9'.byte'#9);
  446. for i:=0 to 7 do
  447. begin
  448. if i<>0 then
  449. AsmWrite(',');
  450. AsmWrite(tostr(t64bitarray(d)[i]));
  451. end;
  452. AsmLn;
  453. end;
  454. ait_real_32bit :
  455. begin
  456. if do_line then
  457. AsmWriteLn(target_asm.comment+target_asm.comment+single2str(tai_real_32bit(hp).value));
  458. sin:=tai_real_32bit(hp).value;
  459. {$ifdef fpc}
  460. { swap the values to correct endian if required }
  461. if source_info.endian <> target_info.endian then
  462. swap32bitarray(t32bitarray(sin));
  463. {$endif}
  464. AsmWrite(#9'.byte'#9);
  465. for i:=0 to 3 do
  466. begin
  467. if i<>0 then
  468. AsmWrite(',');
  469. AsmWrite(tostr(t32bitarray(sin)[i]));
  470. end;
  471. AsmLn;
  472. end;
  473. ait_comp_64bit :
  474. begin
  475. if do_line then
  476. AsmWriteLn(target_asm.comment+target_asm.comment+extended2str(tai_comp_64bit(hp).value));
  477. AsmWrite(#9'.byte'#9);
  478. {$ifdef FPC}
  479. co:=comp(tai_comp_64bit(hp).value);
  480. {$else}
  481. co:=tai_comp_64bit(hp).value;
  482. {$endif}
  483. {$ifdef fpc}
  484. { swap the values to correct endian if required }
  485. if source_info.endian <> target_info.endian then
  486. swap64bitarray(t64bitarray(co));
  487. {$endif}
  488. for i:=0 to 7 do
  489. begin
  490. if i<>0 then
  491. AsmWrite(',');
  492. AsmWrite(tostr(t64bitarray(co)[i]));
  493. end;
  494. AsmLn;
  495. end;
  496. ait_direct :
  497. begin
  498. AsmWritePChar(tai_direct(hp).str);
  499. AsmLn;
  500. {$IfDef GDB}
  501. if strpos(tai_direct(hp).str,'.data')<>nil then
  502. n_line:=n_dataline
  503. else if strpos(tai_direct(hp).str,'.text')<>nil then
  504. n_line:=n_textline
  505. else if strpos(tai_direct(hp).str,'.bss')<>nil then
  506. n_line:=n_bssline;
  507. {$endif GDB}
  508. end;
  509. ait_string :
  510. begin
  511. pos:=0;
  512. for i:=1 to tai_string(hp).len do
  513. begin
  514. if pos=0 then
  515. begin
  516. AsmWrite(#9'.ascii'#9'"');
  517. pos:=20;
  518. end;
  519. ch:=tai_string(hp).str[i-1];
  520. case ch of
  521. #0, {This can't be done by range, because a bug in FPC}
  522. #1..#31,
  523. #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7);
  524. '"' : s:='\"';
  525. '\' : s:='\\';
  526. else
  527. s:=ch;
  528. end;
  529. AsmWrite(s);
  530. inc(pos,length(s));
  531. if (pos>line_length) or (i=tai_string(hp).len) then
  532. begin
  533. AsmWriteLn('"');
  534. pos:=0;
  535. end;
  536. end;
  537. end;
  538. ait_label :
  539. begin
  540. if (tai_label(hp).l.is_used) then
  541. begin
  542. if tai_label(hp).l.defbind=AB_GLOBAL then
  543. begin
  544. AsmWrite('.globl'#9);
  545. AsmWriteLn(tai_label(hp).l.name);
  546. end;
  547. AsmWrite(tai_label(hp).l.name);
  548. AsmWriteLn(':');
  549. end;
  550. end;
  551. ait_symbol :
  552. begin
  553. if tai_symbol(hp).is_global then
  554. begin
  555. AsmWrite('.globl'#9);
  556. AsmWriteLn(tai_symbol(hp).sym.name);
  557. end;
  558. if target_info.system in [system_i386_linux,system_i386_beos] then
  559. begin
  560. AsmWrite(#9'.type'#9);
  561. AsmWrite(tai_symbol(hp).sym.name);
  562. if assigned(tai(hp.next)) and
  563. (tai(hp.next).typ in [ait_const_symbol,ait_const_rva,
  564. ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_datablock,
  565. ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit]) then
  566. AsmWriteLn(',@object')
  567. else
  568. AsmWriteLn(',@function');
  569. if tai_symbol(hp).sym.size>0 then
  570. begin
  571. AsmWrite(#9'.size'#9);
  572. AsmWrite(tai_symbol(hp).sym.name);
  573. AsmWrite(', ');
  574. AsmWriteLn(tostr(tai_symbol(hp).sym.size));
  575. end;
  576. end;
  577. AsmWrite(tai_symbol(hp).sym.name);
  578. AsmWriteLn(':');
  579. end;
  580. ait_symbol_end :
  581. begin
  582. if target_info.system in [system_i386_linux,system_i386_beos] then
  583. begin
  584. s:=target_asm.labelprefix+'e'+tostr(symendcount);
  585. inc(symendcount);
  586. AsmWriteLn(s+':');
  587. AsmWrite(#9'.size'#9);
  588. AsmWrite(tai_symbol_end(hp).sym.name);
  589. AsmWrite(', '+s+' - ');
  590. AsmWriteLn(tai_symbol_end(hp).sym.name);
  591. end;
  592. end;
  593. ait_instruction :
  594. begin
  595. WriteInstruction(hp);
  596. end;
  597. {$ifdef GDB}
  598. ait_stabs :
  599. begin
  600. AsmWrite(#9'.stabs ');
  601. AsmWritePChar(tai_stabs(hp).str);
  602. AsmLn;
  603. end;
  604. ait_stabn :
  605. begin
  606. AsmWrite(#9'.stabn ');
  607. AsmWritePChar(tai_stabn(hp).str);
  608. AsmLn;
  609. end;
  610. ait_force_line :
  611. stabslastfileinfo.line:=0;
  612. ait_stab_function_name:
  613. funcname:=tai_stab_function_name(hp).str;
  614. {$endif GDB}
  615. ait_cut :
  616. begin
  617. if SmartAsm then
  618. begin
  619. { only reset buffer if nothing has changed }
  620. if AsmSize=AsmStartSize then
  621. AsmClear
  622. else
  623. begin
  624. AsmClose;
  625. DoAssemble;
  626. AsmCreate(tai_cut(hp).place);
  627. end;
  628. { avoid empty files }
  629. while assigned(hp.next) and (tai(hp.next).typ in [ait_cut,ait_section,ait_comment]) do
  630. begin
  631. if tai(hp.next).typ=ait_section then
  632. lasTSec:=tai_section(hp.next).sec;
  633. hp:=tai(hp.next);
  634. end;
  635. {$ifdef GDB}
  636. { force write of filename }
  637. FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0);
  638. includecount:=0;
  639. funcname:=nil;
  640. WriteFileLineInfo(hp.fileinfo);
  641. {$endif GDB}
  642. if lasTSec<>sec_none then
  643. AsmWriteLn(ait_section2str(lasTSec));
  644. AsmStartSize:=AsmSize;
  645. end;
  646. end;
  647. ait_marker :
  648. if tai_marker(hp).kind=InlineStart then
  649. inc(InlineLevel)
  650. else if tai_marker(hp).kind=InlineEnd then
  651. dec(InlineLevel);
  652. else
  653. internalerror(10000);
  654. end;
  655. hp:=tai(hp.next);
  656. end;
  657. end;
  658. procedure TGNUAssembler.WriteExtraHeader;
  659. begin
  660. end;
  661. procedure TGNUAssembler.WriteAsmList;
  662. var
  663. p:dirstr;
  664. n:namestr;
  665. e:extstr;
  666. {$ifdef GDB}
  667. fileinfo : tfileposinfo;
  668. {$endif GDB}
  669. begin
  670. {$ifdef EXTDEBUG}
  671. if assigned(current_module.mainsource) then
  672. Comment(v_info,'Start writing gas-styled assembler output for '+current_module.mainsource^);
  673. {$endif}
  674. LasTSec:=sec_none;
  675. {$ifdef GDB}
  676. FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0);
  677. {$endif GDB}
  678. FillChar(lastfileinfo,sizeof(lastfileinfo),0);
  679. LastInfile:=nil;
  680. if assigned(current_module.mainsource) then
  681. fsplit(current_module.mainsource^,p,n,e)
  682. else
  683. begin
  684. p:=inputdir;
  685. n:=inputfile;
  686. e:=inputextension;
  687. end;
  688. { to get symify to work }
  689. AsmWriteLn(#9'.file "'+FixFileName(n+e)+'"');
  690. WriteExtraHeader;
  691. {$ifdef GDB}
  692. n_line:=n_bssline;
  693. funcname:=nil;
  694. linecount:=1;
  695. includecount:=0;
  696. fileinfo.fileindex:=1;
  697. fileinfo.line:=1;
  698. { Write main file }
  699. WriteFileLineInfo(fileinfo);
  700. {$endif GDB}
  701. AsmStartSize:=AsmSize;
  702. symendcount:=0;
  703. If (cs_debuginfo in aktmoduleswitches) then
  704. WriteTree(debuglist);
  705. WriteTree(codesegment);
  706. WriteTree(datasegment);
  707. WriteTree(consts);
  708. WriteTree(rttilist);
  709. Writetree(resourcestringlist);
  710. WriteTree(bsssegment);
  711. Writetree(importssection);
  712. { exports are written by DLLTOOL
  713. if we use it so don't insert it twice (PM) }
  714. if not UseDeffileForExport and assigned(exportssection) then
  715. Writetree(exportssection);
  716. Writetree(resourcesection);
  717. {$ifdef GDB}
  718. WriteFileEndInfo;
  719. {$ENDIF}
  720. AsmLn;
  721. {$ifdef EXTDEBUG}
  722. if assigned(current_module.mainsource) then
  723. comment(v_info,'Done writing gas-styled assembler output for '+current_module.mainsource^);
  724. {$endif EXTDEBUG}
  725. end;
  726. end.
  727. {
  728. $Log$
  729. Revision 1.13 2002-10-05 12:43:23 carl
  730. * fixes for Delphi 6 compilation
  731. (warning : Some features do not work under Delphi)
  732. Revision 1.12 2002/08/31 16:05:17 florian
  733. * write double # before float constants when -al is turned on
  734. else some gas versions interpret it as line number
  735. Revision 1.11 2002/08/20 16:55:38 peter
  736. * don't write (stabs)line info when inlining a procedure
  737. Revision 1.10 2002/08/18 22:16:14 florian
  738. + the ppc gas assembler writer adds now registers aliases
  739. to the assembler file
  740. Revision 1.9 2002/08/18 20:06:23 peter
  741. * inlining is now also allowed in interface
  742. * renamed write/load to ppuwrite/ppuload
  743. * tnode storing in ppu
  744. * nld,ncon,nbas are already updated for storing in ppu
  745. Revision 1.8 2002/07/26 21:15:37 florian
  746. * rewrote the system handling
  747. Revision 1.7 2002/07/07 09:52:32 florian
  748. * powerpc target fixed, very simple units can be compiled
  749. * some basic stuff for better callparanode handling, far from being finished
  750. Revision 1.6 2002/07/01 18:46:20 peter
  751. * internal linker
  752. * reorganized aasm layer
  753. Revision 1.5 2002/05/18 13:34:05 peter
  754. * readded missing revisions
  755. Revision 1.4 2002/05/16 19:46:34 carl
  756. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  757. + try to fix temp allocation (still in ifdef)
  758. + generic constructor calls
  759. + start of tassembler / tmodulebase class cleanup
  760. Revision 1.2 2002/04/15 18:53:48 carl
  761. + comments in register allocator uses std_Reg2str
  762. Revision 1.1 2002/04/14 16:51:54 carl
  763. + basic GNU assembler writer class
  764. }