aggas.pas 32 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016
  1. {
  2. $Id$
  3. Copyright (c) 1998-2004 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. {$IFDEF USE_SYSUTILS}
  25. SysUtils,
  26. {$ELSE USE_SYSUTILS}
  27. dos,
  28. {$ENDIF USE_SYSUTILS}
  29. cclasses,
  30. globals,
  31. aasmbase,aasmtai,aasmcpu,
  32. assemble;
  33. type
  34. {# This is a derived class which is used to write
  35. GAS styled assembler.
  36. The WriteInstruction() method must be overriden
  37. to write a single instruction to the assembler
  38. file.
  39. }
  40. TGNUAssembler=class(texternalassembler)
  41. protected
  42. function sectionname(atype:tasmsectiontype;const aname:string):string;virtual;
  43. procedure WriteSection(atype:tasmsectiontype;const aname:string);
  44. procedure WriteExtraHeader;virtual;
  45. {$ifdef GDB}
  46. procedure WriteFileLineInfo(var fileinfo : tfileposinfo);
  47. procedure WriteFileEndInfo;
  48. {$endif}
  49. procedure WriteInstruction(hp: tai); virtual; abstract;
  50. public
  51. procedure WriteTree(p:TAAsmoutput);override;
  52. procedure WriteAsmList;override;
  53. end;
  54. const
  55. regname_count=45;
  56. regname_count_bsstart=32; { Largest power of 2 out of regname_count. }
  57. implementation
  58. uses
  59. cutils,globtype,systems,
  60. fmodule,finput,verbose,
  61. itcpugas
  62. {$ifdef GDB}
  63. {$IFDEF USE_SYSUTILS}
  64. {$ELSE USE_SYSUTILS}
  65. ,strings
  66. {$ENDIF USE_SYSUTILS}
  67. ,gdb
  68. {$endif GDB}
  69. ;
  70. const
  71. line_length = 70;
  72. var
  73. {$ifdef GDB}
  74. n_line : byte; { different types of source lines }
  75. linecount,
  76. includecount : longint;
  77. funcname : pchar;
  78. stabslastfileinfo : tfileposinfo;
  79. {$endif}
  80. lasTSecType : TAsmSectionType; { last section type written }
  81. lastfileinfo : tfileposinfo;
  82. infile,
  83. lastinfile : tinputfile;
  84. symendcount : longint;
  85. type
  86. {$ifdef cpuextended}
  87. t80bitarray = array[0..9] of byte;
  88. {$endif cpuextended}
  89. t64bitarray = array[0..7] of byte;
  90. t32bitarray = array[0..3] of byte;
  91. {****************************************************************************}
  92. { Support routines }
  93. {****************************************************************************}
  94. function fixline(s:string):string;
  95. {
  96. return s with all leading and ending spaces and tabs removed
  97. }
  98. var
  99. i,j,k : integer;
  100. begin
  101. i:=length(s);
  102. while (i>0) and (s[i] in [#9,' ']) do
  103. dec(i);
  104. j:=1;
  105. while (j<i) and (s[j] in [#9,' ']) do
  106. inc(j);
  107. for k:=j to i do
  108. if s[k] in [#0..#31,#127..#255] then
  109. s[k]:='.';
  110. fixline:=Copy(s,j,i-j+1);
  111. end;
  112. function single2str(d : single) : string;
  113. var
  114. hs : string;
  115. begin
  116. str(d,hs);
  117. { replace space with + }
  118. if hs[1]=' ' then
  119. hs[1]:='+';
  120. single2str:='0d'+hs
  121. end;
  122. function double2str(d : double) : string;
  123. var
  124. hs : string;
  125. begin
  126. str(d,hs);
  127. { replace space with + }
  128. if hs[1]=' ' then
  129. hs[1]:='+';
  130. double2str:='0d'+hs
  131. end;
  132. function extended2str(e : extended) : string;
  133. var
  134. hs : string;
  135. begin
  136. str(e,hs);
  137. { replace space with + }
  138. if hs[1]=' ' then
  139. hs[1]:='+';
  140. extended2str:='0d'+hs
  141. end;
  142. { convert floating point values }
  143. { to correct endian }
  144. procedure swap64bitarray(var t: t64bitarray);
  145. var
  146. b: byte;
  147. begin
  148. b:= t[7];
  149. t[7] := t[0];
  150. t[0] := b;
  151. b := t[6];
  152. t[6] := t[1];
  153. t[1] := b;
  154. b:= t[5];
  155. t[5] := t[2];
  156. t[2] := b;
  157. b:= t[4];
  158. t[4] := t[3];
  159. t[3] := b;
  160. end;
  161. procedure swap32bitarray(var t: t32bitarray);
  162. var
  163. b: byte;
  164. begin
  165. b:= t[1];
  166. t[1]:= t[2];
  167. t[2]:= b;
  168. b:= t[0];
  169. t[0]:= t[3];
  170. t[3]:= b;
  171. end;
  172. const
  173. ait_const2str : array[ait_const_128bit..ait_const_indirect_symbol] of string[20]=(
  174. #9'.fixme128'#9,#9'.quad'#9,#9'.long'#9,#9'.short'#9,#9'.byte'#9,
  175. #9'.sleb128'#9,#9'.uleb128'#9,
  176. #9'.rva'#9,#9'.indirect_symbol'#9
  177. );
  178. {****************************************************************************}
  179. { GNU Assembler writer }
  180. {****************************************************************************}
  181. {$ifdef GDB}
  182. procedure TGNUAssembler.WriteFileLineInfo(var fileinfo : tfileposinfo);
  183. var
  184. curr_n : byte;
  185. begin
  186. if not ((cs_debuginfo in aktmoduleswitches) or
  187. (cs_gdb_lineinfo in aktglobalswitches)) then
  188. exit;
  189. { file changed ? (must be before line info) }
  190. if (fileinfo.fileindex<>0) and
  191. (stabslastfileinfo.fileindex<>fileinfo.fileindex) then
  192. begin
  193. infile:=current_module.sourcefiles.get_file(fileinfo.fileindex);
  194. if assigned(infile) then
  195. begin
  196. if includecount=0 then
  197. curr_n:=n_sourcefile
  198. else
  199. curr_n:=n_includefile;
  200. if (infile.path^<>'') then
  201. begin
  202. AsmWriteLn(#9'.stabs "'+BsToSlash(FixPath(infile.path^,false))+'",'+
  203. tostr(curr_n)+',0,0,'+target_asm.labelprefix+'text'+ToStr(IncludeCount));
  204. end;
  205. AsmWriteLn(#9'.stabs "'+FixFileName(infile.name^)+'",'+
  206. tostr(curr_n)+',0,0,'+target_asm.labelprefix+'text'+ToStr(IncludeCount));
  207. AsmWriteLn(target_asm.labelprefix+'text'+ToStr(IncludeCount)+':');
  208. inc(includecount);
  209. { force new line info }
  210. stabslastfileinfo.line:=-1;
  211. end;
  212. end;
  213. { line changed ? }
  214. if (stabslastfileinfo.line<>fileinfo.line) and (fileinfo.line<>0) then
  215. begin
  216. if (n_line=n_textline) and assigned(funcname) and
  217. (target_info.use_function_relative_addresses) then
  218. begin
  219. AsmWriteLn(target_asm.labelprefix+'l'+tostr(linecount)+':');
  220. AsmWrite(#9'.stabn '+tostr(n_line)+',0,'+tostr(fileinfo.line)+','+
  221. target_asm.labelprefix+'l'+tostr(linecount)+' - ');
  222. AsmWritePChar(FuncName);
  223. AsmLn;
  224. inc(linecount);
  225. end
  226. else
  227. AsmWriteLn(#9'.stabd'#9+tostr(n_line)+',0,'+tostr(fileinfo.line));
  228. end;
  229. stabslastfileinfo:=fileinfo;
  230. end;
  231. procedure TGNUAssembler.WriteFileEndInfo;
  232. begin
  233. if not ((cs_debuginfo in aktmoduleswitches) or
  234. (cs_gdb_lineinfo in aktglobalswitches)) then
  235. exit;
  236. WriteSection(sec_code,'');
  237. AsmWriteLn(#9'.stabs "",'+tostr(n_sourcefile)+',0,0,'+target_asm.labelprefix+'etext');
  238. AsmWriteLn(target_asm.labelprefix+'etext:');
  239. end;
  240. {$endif GDB}
  241. function TGNUAssembler.sectionname(atype:tasmsectiontype;const aname:string):string;
  242. const
  243. secnames : array[tasmsectiontype] of string[12] = ('',
  244. {$warning TODO .rodata not yet working}
  245. '.text','.data','.data','.bss',
  246. 'common',
  247. '.note',
  248. '.stab','.stabstr',
  249. '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
  250. '.eh_frame',
  251. '.debug_frame'
  252. );
  253. begin
  254. if (target_info.system = system_powerpc_darwin) and
  255. (atype = sec_bss) then
  256. atype := sec_code;
  257. if use_smartlink_section and
  258. (atype<>sec_bss) and
  259. (aname<>'') then
  260. result:='.gnu.linkonce'+copy(secnames[atype],1,2)+'.'+aname
  261. else
  262. result:=secnames[atype];
  263. end;
  264. procedure TGNUAssembler.WriteSection(atype:tasmsectiontype;const aname:string);
  265. var
  266. s : string;
  267. begin
  268. AsmLn;
  269. case target_info.system of
  270. system_powerpc_darwin, system_i386_OS2, system_i386_EMX: ;
  271. else
  272. AsmWrite('.section ');
  273. end;
  274. s:=sectionname(atype,aname);
  275. AsmWrite(s);
  276. if copy(s,1,4)='.gnu' then
  277. begin
  278. case atype of
  279. sec_data :
  280. AsmWrite(',""');
  281. sec_code :
  282. AsmWrite(',"x"');
  283. end;
  284. end;
  285. AsmLn;
  286. {$ifdef GDB}
  287. { this is needed for line info in data }
  288. funcname:=nil;
  289. case atype of
  290. sec_code :
  291. n_line:=n_textline;
  292. sec_data :
  293. n_line:=n_dataline;
  294. sec_bss :
  295. n_line:=n_bssline;
  296. else
  297. n_line:=n_dataline;
  298. end;
  299. {$endif GDB}
  300. LasTSecType:=atype;
  301. end;
  302. procedure TGNUAssembler.WriteTree(p:TAAsmoutput);
  303. const
  304. regallocstr : array[tregalloctype] of string[10]=(' allocated',' released',' sync',' resized');
  305. tempallocstr : array[boolean] of string[10]=(' released',' allocated');
  306. var
  307. ch : char;
  308. hp : tai;
  309. hp1 : tailineinfo;
  310. consttyp : taitype;
  311. s : string;
  312. i,pos,l : longint;
  313. InlineLevel : longint;
  314. last_align : longint;
  315. co : comp;
  316. sin : single;
  317. d : double;
  318. {$ifdef cpuextended}
  319. e : extended;
  320. {$endif cpuextended}
  321. do_line : boolean;
  322. begin
  323. if not assigned(p) then
  324. exit;
  325. last_align := 2;
  326. InlineLevel:=0;
  327. { lineinfo is only needed for codesegment (PFV) }
  328. do_line:=(cs_asm_source in aktglobalswitches) or
  329. ((cs_lineinfo in aktmoduleswitches)
  330. and (p=codesegment));
  331. hp:=tai(p.first);
  332. while assigned(hp) do
  333. begin
  334. if not(hp.typ in SkipLineInfo) then
  335. begin
  336. hp1 := hp as tailineinfo;
  337. aktfilepos:=hp1.fileinfo;
  338. {$ifdef GDB}
  339. { write stabs }
  340. if (cs_debuginfo in aktmoduleswitches) or
  341. (cs_gdb_lineinfo in aktglobalswitches) then
  342. WriteFileLineInfo(hp1.fileinfo);
  343. {$endif GDB}
  344. { no line info for inlined code }
  345. if do_line and (inlinelevel=0) then
  346. begin
  347. { load infile }
  348. if lastfileinfo.fileindex<>hp1.fileinfo.fileindex then
  349. begin
  350. infile:=current_module.sourcefiles.get_file(hp1.fileinfo.fileindex);
  351. if assigned(infile) then
  352. begin
  353. { open only if needed !! }
  354. if (cs_asm_source in aktglobalswitches) then
  355. infile.open;
  356. end;
  357. { avoid unnecessary reopens of the same file !! }
  358. lastfileinfo.fileindex:=hp1.fileinfo.fileindex;
  359. { be sure to change line !! }
  360. lastfileinfo.line:=-1;
  361. end;
  362. { write source }
  363. if (cs_asm_source in aktglobalswitches) and
  364. assigned(infile) then
  365. begin
  366. if (infile<>lastinfile) then
  367. begin
  368. AsmWriteLn(target_asm.comment+'['+infile.name^+']');
  369. if assigned(lastinfile) then
  370. lastinfile.close;
  371. end;
  372. if (hp1.fileinfo.line<>lastfileinfo.line) and
  373. ((hp1.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then
  374. begin
  375. if (hp1.fileinfo.line<>0) and
  376. ((infile.linebuf^[hp1.fileinfo.line]>=0) or (InlineLevel>0)) then
  377. AsmWriteLn(target_asm.comment+'['+tostr(hp1.fileinfo.line)+'] '+
  378. fixline(infile.GetLineStr(hp1.fileinfo.line)));
  379. { set it to a negative value !
  380. to make that is has been read already !! PM }
  381. if (infile.linebuf^[hp1.fileinfo.line]>=0) then
  382. infile.linebuf^[hp1.fileinfo.line]:=-infile.linebuf^[hp1.fileinfo.line]-1;
  383. end;
  384. end;
  385. lastfileinfo:=hp1.fileinfo;
  386. lastinfile:=infile;
  387. end;
  388. end;
  389. case hp.typ of
  390. ait_comment :
  391. Begin
  392. AsmWrite(target_asm.comment);
  393. AsmWritePChar(tai_comment(hp).str);
  394. AsmLn;
  395. End;
  396. ait_regalloc :
  397. begin
  398. if (cs_asm_regalloc in aktglobalswitches) then
  399. begin
  400. AsmWrite(#9+target_asm.comment+'Register ');
  401. repeat
  402. AsmWrite(gas_regname(Tai_regalloc(hp).reg));
  403. if (hp.next=nil) or
  404. (tai(hp.next).typ<>ait_regalloc) or
  405. (tai_regalloc(hp.next).ratype<>tai_regalloc(hp).ratype) then
  406. break;
  407. hp:=tai(hp.next);
  408. AsmWrite(',');
  409. until false;
  410. AsmWriteLn(regallocstr[tai_regalloc(hp).ratype]);
  411. end;
  412. end;
  413. ait_tempalloc :
  414. begin
  415. if (cs_asm_tempalloc in aktglobalswitches) then
  416. begin
  417. {$ifdef EXTDEBUG}
  418. if assigned(tai_tempalloc(hp).problem) then
  419. AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+
  420. tostr(tai_tempalloc(hp).tempsize)+' '+tai_tempalloc(hp).problem^)
  421. else
  422. {$endif EXTDEBUG}
  423. AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+
  424. tostr(tai_tempalloc(hp).tempsize)+tempallocstr[tai_tempalloc(hp).allocation]);
  425. end;
  426. end;
  427. ait_align :
  428. begin
  429. if tai_align(hp).aligntype>1 then
  430. begin
  431. if target_info.system <> system_powerpc_darwin then
  432. begin
  433. AsmWrite(#9'.balign '+tostr(tai_align(hp).aligntype));
  434. if tai_align(hp).use_op then
  435. AsmWrite(','+tostr(tai_align(hp).fillop))
  436. end
  437. else
  438. begin
  439. { darwin as only supports .align }
  440. if not ispowerof2(tai_align(hp).aligntype,i) then
  441. internalerror(2003010305);
  442. AsmWrite(#9'.align '+tostr(i));
  443. last_align := i;
  444. end;
  445. AsmLn;
  446. end;
  447. end;
  448. ait_section :
  449. begin
  450. if tai_section(hp).sectype<>sec_none then
  451. begin
  452. WriteSection(tai_section(hp).sectype,tai_section(hp).name^);
  453. {$ifdef GDB}
  454. lastfileinfo.line:=-1;
  455. {$endif GDB}
  456. end
  457. else
  458. begin
  459. {$ifdef EXTDEBUG}
  460. AsmWrite(target_asm.comment);
  461. AsmWriteln(' sec_none');
  462. {$endif EXTDEBUG}
  463. end;
  464. end;
  465. ait_datablock :
  466. begin
  467. if tai_datablock(hp).is_global then
  468. AsmWrite(#9'.comm'#9)
  469. else
  470. AsmWrite(#9'.lcomm'#9);
  471. AsmWrite(tai_datablock(hp).sym.name);
  472. AsmWrite(','+tostr(tai_datablock(hp).size));
  473. if (target_info.system = system_powerpc_darwin) and
  474. not(tai_datablock(hp).is_global) then
  475. AsmWrite(','+tostr(last_align));
  476. AsmWriteln('');
  477. end;
  478. {$ifndef cpu64bit}
  479. ait_const_128bit :
  480. begin
  481. internalerror(200404291);
  482. end;
  483. ait_const_64bit :
  484. begin
  485. if assigned(tai_const(hp).sym) then
  486. internalerror(200404292);
  487. AsmWrite(ait_const2str[ait_const_32bit]);
  488. if target_info.endian = endian_little then
  489. begin
  490. AsmWrite(tostr(longint(lo(tai_const(hp).value))));
  491. AsmWrite(',');
  492. AsmWrite(tostr(longint(hi(tai_const(hp).value))));
  493. end
  494. else
  495. begin
  496. AsmWrite(tostr(longint(hi(tai_const(hp).value))));
  497. AsmWrite(',');
  498. AsmWrite(tostr(longint(lo(tai_const(hp).value))));
  499. end;
  500. AsmLn;
  501. end;
  502. {$endif cpu64bit}
  503. ait_const_uleb128bit,
  504. ait_const_sleb128bit,
  505. {$ifdef cpu64bit}
  506. ait_const_128bit,
  507. ait_const_64bit,
  508. {$endif cpu64bit}
  509. ait_const_32bit,
  510. ait_const_16bit,
  511. ait_const_8bit,
  512. ait_const_rva_symbol,
  513. ait_const_indirect_symbol :
  514. begin
  515. AsmWrite(ait_const2str[hp.typ]);
  516. consttyp:=hp.typ;
  517. l:=0;
  518. repeat
  519. if assigned(tai_const(hp).sym) then
  520. begin
  521. if assigned(tai_const(hp).endsym) then
  522. s:=tai_const(hp).endsym.name+'-'+tai_const(hp).sym.name
  523. else
  524. s:=tai_const(hp).sym.name;
  525. if tai_const(hp).value<>0 then
  526. s:=s+tostr_with_plus(tai_const(hp).value);
  527. end
  528. else
  529. s:=tostr(tai_const(hp).value);
  530. AsmWrite(s);
  531. inc(l,length(s));
  532. if (LasTSecType<>sec_data) or
  533. (l>line_length) or
  534. (hp.next=nil) or
  535. (tai(hp.next).typ<>consttyp) then
  536. break;
  537. hp:=tai(hp.next);
  538. AsmWrite(',');
  539. until false;
  540. AsmLn;
  541. end;
  542. {$ifdef cpuextended}
  543. ait_real_80bit :
  544. begin
  545. if do_line then
  546. AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_real_80bit(hp).value));
  547. { Make sure e is a extended type, bestreal could be
  548. a different type (bestreal) !! (PFV) }
  549. e:=tai_real_80bit(hp).value;
  550. AsmWrite(#9'.byte'#9);
  551. for i:=0 to 9 do
  552. begin
  553. if i<>0 then
  554. AsmWrite(',');
  555. AsmWrite(tostr(t80bitarray(e)[i]));
  556. end;
  557. AsmLn;
  558. end;
  559. {$endif cpuextended}
  560. ait_real_64bit :
  561. begin
  562. if do_line then
  563. AsmWriteLn(target_asm.comment+'value: '+double2str(tai_real_64bit(hp).value));
  564. d:=tai_real_64bit(hp).value;
  565. { swap the values to correct endian if required }
  566. if source_info.endian <> target_info.endian then
  567. swap64bitarray(t64bitarray(d));
  568. AsmWrite(#9'.byte'#9);
  569. {$ifdef arm}
  570. { on a real arm cpu, it's already hi/lo swapped }
  571. {$ifndef cpuarm}
  572. if tai_real_64bit(hp).formatoptions=fo_hiloswapped then
  573. begin
  574. for i:=4 to 7 do
  575. begin
  576. if i<>4 then
  577. AsmWrite(',');
  578. AsmWrite(tostr(t64bitarray(d)[i]));
  579. end;
  580. for i:=0 to 3 do
  581. begin
  582. AsmWrite(',');
  583. AsmWrite(tostr(t64bitarray(d)[i]));
  584. end;
  585. end
  586. else
  587. {$endif cpuarm}
  588. {$endif arm}
  589. begin
  590. for i:=0 to 7 do
  591. begin
  592. if i<>0 then
  593. AsmWrite(',');
  594. AsmWrite(tostr(t64bitarray(d)[i]));
  595. end;
  596. end;
  597. AsmLn;
  598. end;
  599. ait_real_32bit :
  600. begin
  601. if do_line then
  602. AsmWriteLn(target_asm.comment+'value: '+single2str(tai_real_32bit(hp).value));
  603. sin:=tai_real_32bit(hp).value;
  604. { swap the values to correct endian if required }
  605. if source_info.endian <> target_info.endian then
  606. swap32bitarray(t32bitarray(sin));
  607. AsmWrite(#9'.byte'#9);
  608. for i:=0 to 3 do
  609. begin
  610. if i<>0 then
  611. AsmWrite(',');
  612. AsmWrite(tostr(t32bitarray(sin)[i]));
  613. end;
  614. AsmLn;
  615. end;
  616. ait_comp_64bit :
  617. begin
  618. if do_line then
  619. AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_comp_64bit(hp).value));
  620. AsmWrite(#9'.byte'#9);
  621. {$ifdef FPC}
  622. co:=comp(tai_comp_64bit(hp).value);
  623. {$else}
  624. co:=tai_comp_64bit(hp).value;
  625. {$endif}
  626. { swap the values to correct endian if required }
  627. if source_info.endian <> target_info.endian then
  628. swap64bitarray(t64bitarray(co));
  629. for i:=0 to 7 do
  630. begin
  631. if i<>0 then
  632. AsmWrite(',');
  633. AsmWrite(tostr(t64bitarray(co)[i]));
  634. end;
  635. AsmLn;
  636. end;
  637. ait_direct :
  638. begin
  639. AsmWritePChar(tai_direct(hp).str);
  640. AsmLn;
  641. {$IfDef GDB}
  642. if strpos(tai_direct(hp).str,'.data')<>nil then
  643. n_line:=n_dataline
  644. else if strpos(tai_direct(hp).str,'.text')<>nil then
  645. n_line:=n_textline
  646. else if strpos(tai_direct(hp).str,'.bss')<>nil then
  647. n_line:=n_bssline;
  648. {$endif GDB}
  649. end;
  650. ait_string :
  651. begin
  652. pos:=0;
  653. for i:=1 to tai_string(hp).len do
  654. begin
  655. if pos=0 then
  656. begin
  657. AsmWrite(#9'.ascii'#9'"');
  658. pos:=20;
  659. end;
  660. ch:=tai_string(hp).str[i-1];
  661. case ch of
  662. #0, {This can't be done by range, because a bug in FPC}
  663. #1..#31,
  664. #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7);
  665. '"' : s:='\"';
  666. '\' : s:='\\';
  667. else
  668. s:=ch;
  669. end;
  670. AsmWrite(s);
  671. inc(pos,length(s));
  672. if (pos>line_length) or (i=tai_string(hp).len) then
  673. begin
  674. AsmWriteLn('"');
  675. pos:=0;
  676. end;
  677. end;
  678. end;
  679. ait_label :
  680. begin
  681. if (tai_label(hp).l.is_used) then
  682. begin
  683. if tai_label(hp).l.defbind=AB_GLOBAL then
  684. begin
  685. AsmWrite('.globl'#9);
  686. AsmWriteLn(tai_label(hp).l.name);
  687. end;
  688. AsmWrite(tai_label(hp).l.name);
  689. AsmWriteLn(':');
  690. end;
  691. end;
  692. ait_symbol :
  693. begin
  694. if tai_symbol(hp).is_global then
  695. begin
  696. AsmWrite('.globl'#9);
  697. AsmWriteLn(tai_symbol(hp).sym.name);
  698. end;
  699. if target_info.system in [system_i386_linux,system_i386_beos,
  700. system_powerpc_linux,system_m68k_linux,
  701. system_sparc_linux,system_alpha_linux,
  702. system_x86_64_linux,system_arm_linux] then
  703. begin
  704. AsmWrite(#9'.type'#9);
  705. AsmWrite(tai_symbol(hp).sym.name);
  706. if assigned(tai(hp.next)) and
  707. (tai(hp.next).typ in [ait_const_rva_symbol,
  708. ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_datablock,
  709. ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit]) then
  710. begin
  711. if target_info.system = system_arm_linux then
  712. AsmWriteLn(',#object')
  713. else
  714. AsmWriteLn(',@object')
  715. end
  716. else
  717. begin
  718. if target_info.system = system_arm_linux then
  719. AsmWriteLn(',#function')
  720. else
  721. AsmWriteLn(',@function');
  722. end;
  723. if tai_symbol(hp).sym.size>0 then
  724. begin
  725. AsmWrite(#9'.size'#9);
  726. AsmWrite(tai_symbol(hp).sym.name);
  727. AsmWrite(', ');
  728. AsmWriteLn(tostr(tai_symbol(hp).sym.size));
  729. end;
  730. end;
  731. AsmWrite(tai_symbol(hp).sym.name);
  732. AsmWriteLn(':');
  733. end;
  734. ait_symbol_end :
  735. begin
  736. if tf_needs_symbol_size in target_info.flags then
  737. begin
  738. s:=target_asm.labelprefix+'e'+tostr(symendcount);
  739. inc(symendcount);
  740. AsmWriteLn(s+':');
  741. AsmWrite(#9'.size'#9);
  742. AsmWrite(tai_symbol_end(hp).sym.name);
  743. AsmWrite(', '+s+' - ');
  744. AsmWriteLn(tai_symbol_end(hp).sym.name);
  745. end;
  746. end;
  747. ait_instruction :
  748. begin
  749. WriteInstruction(hp);
  750. end;
  751. {$ifdef GDB}
  752. ait_stabs :
  753. begin
  754. if assigned(tai_stabs(hp).str) then
  755. begin
  756. AsmWrite(#9'.stabs ');
  757. AsmWritePChar(tai_stabs(hp).str);
  758. AsmLn;
  759. end;
  760. end;
  761. ait_stabn :
  762. begin
  763. if assigned(tai_stabn(hp).str) then
  764. begin
  765. AsmWrite(#9'.stabn ');
  766. AsmWritePChar(tai_stabn(hp).str);
  767. AsmLn;
  768. end;
  769. end;
  770. ait_force_line :
  771. stabslastfileinfo.line:=0;
  772. ait_stab_function_name:
  773. funcname:=tai_stab_function_name(hp).str;
  774. {$endif GDB}
  775. ait_cutobject :
  776. begin
  777. if SmartAsm then
  778. begin
  779. { only reset buffer if nothing has changed }
  780. if AsmSize=AsmStartSize then
  781. AsmClear
  782. else
  783. begin
  784. AsmClose;
  785. DoAssemble;
  786. AsmCreate(tai_cutobject(hp).place);
  787. end;
  788. { avoid empty files }
  789. while assigned(hp.next) and (tai(hp.next).typ in [ait_cutobject,ait_section,ait_comment]) do
  790. begin
  791. if tai(hp.next).typ=ait_section then
  792. lasTSectype:=tai_section(hp.next).sectype;
  793. hp:=tai(hp.next);
  794. end;
  795. {$ifdef GDB}
  796. { force write of filename }
  797. FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0);
  798. includecount:=0;
  799. funcname:=nil;
  800. WriteFileLineInfo(aktfilepos);
  801. {$endif GDB}
  802. if lasTSectype<>sec_none then
  803. WriteSection(lasTSectype,'');
  804. AsmStartSize:=AsmSize;
  805. end;
  806. end;
  807. ait_marker :
  808. if tai_marker(hp).kind=InlineStart then
  809. inc(InlineLevel)
  810. else if tai_marker(hp).kind=InlineEnd then
  811. dec(InlineLevel);
  812. ait_non_lazy_symbol_pointer:
  813. AsmWriteLn('.non_lazy_symbol_pointer');
  814. else
  815. internalerror(10000);
  816. end;
  817. hp:=tai(hp.next);
  818. end;
  819. end;
  820. procedure TGNUAssembler.WriteExtraHeader;
  821. begin
  822. end;
  823. procedure TGNUAssembler.WriteAsmList;
  824. var
  825. p:dirstr;
  826. n:namestr;
  827. e:extstr;
  828. {$ifdef GDB}
  829. fileinfo : tfileposinfo;
  830. {$endif GDB}
  831. begin
  832. {$ifdef EXTDEBUG}
  833. if assigned(current_module.mainsource) then
  834. Comment(V_Debug,'Start writing gas-styled assembler output for '+current_module.mainsource^);
  835. {$endif}
  836. LasTSectype:=sec_none;
  837. {$ifdef GDB}
  838. FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0);
  839. {$endif GDB}
  840. FillChar(lastfileinfo,sizeof(lastfileinfo),0);
  841. LastInfile:=nil;
  842. if assigned(current_module.mainsource) then
  843. {$IFDEF USE_SYSUTILS}
  844. begin
  845. p := SplitPath(current_module.mainsource^);
  846. n := SplitName(current_module.mainsource^);
  847. e := SplitExtension(current_module.mainsource^);
  848. end
  849. {$ELSE USE_SYSUTILS}
  850. fsplit(current_module.mainsource^,p,n,e)
  851. {$ENDIF USE_SYSUTILS}
  852. else
  853. begin
  854. p:=inputdir;
  855. n:=inputfile;
  856. e:=inputextension;
  857. end;
  858. { to get symify to work }
  859. AsmWriteLn(#9'.file "'+FixFileName(n+e)+'"');
  860. WriteExtraHeader;
  861. {$ifdef GDB}
  862. n_line:=n_bssline;
  863. funcname:=nil;
  864. linecount:=1;
  865. includecount:=0;
  866. fileinfo.fileindex:=1;
  867. fileinfo.line:=1;
  868. { Write main file }
  869. WriteFileLineInfo(fileinfo);
  870. {$endif GDB}
  871. AsmStartSize:=AsmSize;
  872. symendcount:=0;
  873. If (cs_debuginfo in aktmoduleswitches) then
  874. WriteTree(debuglist);
  875. WriteTree(codesegment);
  876. WriteTree(datasegment);
  877. WriteTree(consts);
  878. WriteTree(rttilist);
  879. WriteTree(picdata);
  880. Writetree(resourcestringlist);
  881. WriteTree(bsssegment);
  882. Writetree(importssection);
  883. { exports are written by DLLTOOL
  884. if we use it so don't insert it twice (PM) }
  885. if not UseDeffileForExports and assigned(exportssection) then
  886. Writetree(exportssection);
  887. Writetree(resourcesection);
  888. Writetree(dwarflist);
  889. {$ifdef GDB}
  890. WriteFileEndInfo;
  891. {$ENDIF}
  892. AsmLn;
  893. {$ifdef EXTDEBUG}
  894. if assigned(current_module.mainsource) then
  895. Comment(V_Debug,'Done writing gas-styled assembler output for '+current_module.mainsource^);
  896. {$endif EXTDEBUG}
  897. end;
  898. end.
  899. {
  900. $Log$
  901. Revision 1.60 2004-10-14 16:49:14 mazen
  902. * Merge is complete for this file, cycles !
  903. Revision 1.59 2004/09/26 17:45:29 peter
  904. * simple regvar support, not yet finished
  905. Revision 1.58 2004/08/27 20:53:52 peter
  906. don't lowercase filenames in stabs
  907. Revision 1.57 2004/07/18 22:04:55 hajny
  908. * fix for OS/2 and EMX - .section not supported by as.exe
  909. Revision 1.56 2004/07/01 18:16:10 jonas
  910. * Darwin fixes
  911. Revision 1.55 2004/06/20 08:55:28 florian
  912. * logs truncated
  913. Revision 1.54 2004/06/16 20:07:06 florian
  914. * dwarf branch merged
  915. Revision 1.53 2004/05/28 21:13:08 peter
  916. * fix wrong regalloc comments
  917. Revision 1.52 2004/05/22 23:34:27 peter
  918. tai_regalloc.allocation changed to ratype to notify rgobj of register size changes
  919. Revision 1.51 2004/04/27 13:38:24 florian
  920. * fixed wrong commit from yesterday
  921. Revision 1.50 2004/04/25 21:26:16 florian
  922. * some m68k stuff fixed
  923. }