aggas.pas 36 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096
  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,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:TAAsmoutput);override;
  46. procedure WriteAsmList;override;
  47. destructor destroy; override;
  48. private
  49. setcount: longint;
  50. procedure WriteDecodedSleb128(a: aint);
  51. procedure WriteDecodedUleb128(a: aword);
  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[13] = ('',
  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[13] = ('',
  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: aword);
  283. var
  284. b: byte;
  285. begin
  286. repeat
  287. b := a and $7f;
  288. a := a shr 7;
  289. if (a <> 0) then
  290. b := b or $80;
  291. AsmWrite(tostr(b));
  292. if (a <> 0) then
  293. AsmWrite(',')
  294. else
  295. break;
  296. until false;
  297. end;
  298. procedure TGNUAssembler.WriteDecodedSleb128(a: aint);
  299. var
  300. b, size: byte;
  301. neg, more: boolean;
  302. begin
  303. more := true;
  304. neg := a < 0;
  305. size := sizeof(a)*8;
  306. repeat
  307. b := a and $7f;
  308. a := a shr 7;
  309. if (neg) then
  310. a := a or -(1 shl (size - 7));
  311. if (((a = 0) and
  312. (b and $40 = 0)) or
  313. ((a = -1) and
  314. (b and $40 <> 0))) then
  315. more := false
  316. else
  317. b := b or $80;
  318. AsmWrite(tostr(b));
  319. if (more) then
  320. AsmWrite(',')
  321. else
  322. break;
  323. until false;
  324. end;
  325. procedure TGNUAssembler.WriteTree(p:TAAsmoutput);
  326. function needsObject(hp : tai_symbol) : boolean;
  327. begin
  328. needsObject :=
  329. (
  330. assigned(hp.next) and
  331. (tai_symbol(hp.next).typ in [ait_const,ait_datablock,
  332. ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit])
  333. ) or
  334. (hp.sym.typ=AT_DATA);
  335. end;
  336. var
  337. ch : char;
  338. hp : tai;
  339. hp1 : tailineinfo;
  340. consttype : taiconst_type;
  341. s,t : string;
  342. i,pos,l : longint;
  343. InlineLevel : longint;
  344. last_align : longint;
  345. co : comp;
  346. sin : single;
  347. d : double;
  348. {$ifdef cpuextended}
  349. e : extended;
  350. {$endif cpuextended}
  351. do_line : boolean;
  352. sepChar : char;
  353. nextdwarffileidx : longint;
  354. begin
  355. if not assigned(p) then
  356. exit;
  357. nextdwarffileidx:=1;
  358. last_align := 2;
  359. InlineLevel:=0;
  360. { lineinfo is only needed for al_procedures (PFV) }
  361. do_line:=(cs_asm_source in aktglobalswitches) or
  362. ((cs_lineinfo in aktmoduleswitches)
  363. and (p=asmlist[al_procedures]));
  364. hp:=tai(p.first);
  365. while assigned(hp) do
  366. begin
  367. if not(hp.typ in SkipLineInfo) then
  368. begin
  369. hp1 := hp as tailineinfo;
  370. aktfilepos:=hp1.fileinfo;
  371. { no line info for inlined code }
  372. if do_line and (inlinelevel=0) then
  373. begin
  374. { load infile }
  375. if lastfileinfo.fileindex<>hp1.fileinfo.fileindex then
  376. begin
  377. infile:=current_module.sourcefiles.get_file(hp1.fileinfo.fileindex);
  378. if assigned(infile) then
  379. begin
  380. { open only if needed !! }
  381. if (cs_asm_source in aktglobalswitches) then
  382. infile.open;
  383. end;
  384. { avoid unnecessary reopens of the same file !! }
  385. lastfileinfo.fileindex:=hp1.fileinfo.fileindex;
  386. { be sure to change line !! }
  387. lastfileinfo.line:=-1;
  388. end;
  389. { write source }
  390. if (cs_asm_source in aktglobalswitches) and
  391. assigned(infile) then
  392. begin
  393. if (infile<>lastinfile) then
  394. begin
  395. AsmWriteLn(target_asm.comment+'['+infile.name^+']');
  396. if assigned(lastinfile) then
  397. lastinfile.close;
  398. end;
  399. if (hp1.fileinfo.line<>lastfileinfo.line) and
  400. ((hp1.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then
  401. begin
  402. if (hp1.fileinfo.line<>0) and
  403. ((infile.linebuf^[hp1.fileinfo.line]>=0) or (InlineLevel>0)) then
  404. AsmWriteLn(target_asm.comment+'['+tostr(hp1.fileinfo.line)+'] '+
  405. fixline(infile.GetLineStr(hp1.fileinfo.line)));
  406. { set it to a negative value !
  407. to make that is has been read already !! PM }
  408. if (infile.linebuf^[hp1.fileinfo.line]>=0) then
  409. infile.linebuf^[hp1.fileinfo.line]:=-infile.linebuf^[hp1.fileinfo.line]-1;
  410. end;
  411. end;
  412. lastfileinfo:=hp1.fileinfo;
  413. lastinfile:=infile;
  414. end;
  415. end;
  416. case hp.typ of
  417. ait_comment :
  418. Begin
  419. AsmWrite(target_asm.comment);
  420. AsmWritePChar(tai_comment(hp).str);
  421. AsmLn;
  422. End;
  423. ait_regalloc :
  424. begin
  425. if (cs_asm_regalloc in aktglobalswitches) then
  426. begin
  427. AsmWrite(#9+target_asm.comment+'Register ');
  428. repeat
  429. AsmWrite(gas_regname(Tai_regalloc(hp).reg));
  430. if (hp.next=nil) or
  431. (tai(hp.next).typ<>ait_regalloc) or
  432. (tai_regalloc(hp.next).ratype<>tai_regalloc(hp).ratype) then
  433. break;
  434. hp:=tai(hp.next);
  435. AsmWrite(',');
  436. until false;
  437. AsmWrite(' ');
  438. AsmWriteLn(regallocstr[tai_regalloc(hp).ratype]);
  439. end;
  440. end;
  441. ait_tempalloc :
  442. begin
  443. if (cs_asm_tempalloc in aktglobalswitches) then
  444. begin
  445. {$ifdef EXTDEBUG}
  446. if assigned(tai_tempalloc(hp).problem) then
  447. AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+
  448. tostr(tai_tempalloc(hp).tempsize)+' '+tai_tempalloc(hp).problem^)
  449. else
  450. {$endif EXTDEBUG}
  451. AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+
  452. tostr(tai_tempalloc(hp).tempsize)+' '+tempallocstr[tai_tempalloc(hp).allocation]);
  453. end;
  454. end;
  455. ait_align :
  456. begin
  457. if tai_align_abstract(hp).aligntype>1 then
  458. begin
  459. if not(target_info.system in [system_powerpc_darwin,system_i386_darwin]) then
  460. begin
  461. AsmWrite(#9'.balign '+tostr(tai_align_abstract(hp).aligntype));
  462. if tai_align_abstract(hp).use_op then
  463. AsmWrite(','+tostr(tai_align_abstract(hp).fillop))
  464. end
  465. else
  466. begin
  467. { darwin as only supports .align }
  468. if not ispowerof2(tai_align_abstract(hp).aligntype,i) then
  469. internalerror(2003010305);
  470. AsmWrite(#9'.align '+tostr(i));
  471. last_align := i;
  472. end;
  473. AsmLn;
  474. end;
  475. end;
  476. ait_section :
  477. begin
  478. if tai_section(hp).sectype<>sec_none then
  479. WriteSection(tai_section(hp).sectype,tai_section(hp).name^)
  480. else
  481. begin
  482. {$ifdef EXTDEBUG}
  483. AsmWrite(target_asm.comment);
  484. AsmWriteln(' sec_none');
  485. {$endif EXTDEBUG}
  486. end;
  487. end;
  488. ait_datablock :
  489. begin
  490. if target_info.system in [system_powerpc_darwin,system_i386_darwin] then
  491. begin
  492. {On Mac OS X you can't have common symbols in a shared
  493. library, since those are in the TEXT section and the text section is
  494. read-only in shared libraries (so it can be shared among different
  495. processes). The alternate code creates some kind of common symbols in
  496. the data segment. The generic code no longer uses common symbols, but
  497. this doesn't work on Mac OS X as well.}
  498. if tai_datablock(hp).is_global then
  499. begin
  500. asmwrite('.globl ');
  501. asmwriteln(tai_datablock(hp).sym.name);
  502. asmwriteln('.data');
  503. asmwrite('.zerofill __DATA, __common, ');
  504. asmwrite(tai_datablock(hp).sym.name);
  505. asmwriteln(', '+tostr(tai_datablock(hp).size)+','+tostr(last_align));
  506. if not(CurrSecType in [sec_data,sec_none]) then
  507. writesection(CurrSecType,'');
  508. end
  509. else
  510. begin
  511. asmwrite(#9'.lcomm'#9);
  512. asmwrite(tai_datablock(hp).sym.name);
  513. asmwrite(','+tostr(tai_datablock(hp).size));
  514. asmwrite(','+tostr(last_align));
  515. asmwriteln('');
  516. end
  517. end
  518. else
  519. begin
  520. if Tai_datablock(hp).is_global then
  521. begin
  522. asmwrite(#9'.globl ');
  523. asmwriteln(Tai_datablock(hp).sym.name);
  524. end;
  525. if (tf_needs_symbol_type in target_info.flags) then
  526. asmwriteln(#9'.type '+Tai_datablock(hp).sym.name+',@object');
  527. if (tf_needs_symbol_size in target_info.flags) and (tai_datablock(hp).size > 0) then
  528. asmwriteln(#9'.size '+Tai_datablock(hp).sym.name+','+tostr(Tai_datablock(hp).size));
  529. asmwrite(Tai_datablock(hp).sym.name);
  530. asmwriteln(':');
  531. asmwriteln(#9'.zero '+tostr(Tai_datablock(hp).size));
  532. end;
  533. end;
  534. ait_const:
  535. begin
  536. consttype:=tai_const(hp).consttype;
  537. case consttype of
  538. {$ifndef cpu64bit}
  539. aitconst_128bit :
  540. begin
  541. internalerror(200404291);
  542. end;
  543. aitconst_64bit :
  544. begin
  545. if assigned(tai_const(hp).sym) then
  546. internalerror(200404292);
  547. AsmWrite(ait_const2str[aitconst_32bit]);
  548. if target_info.endian = endian_little then
  549. begin
  550. AsmWrite(tostr(longint(lo(tai_const(hp).value))));
  551. AsmWrite(',');
  552. AsmWrite(tostr(longint(hi(tai_const(hp).value))));
  553. end
  554. else
  555. begin
  556. AsmWrite(tostr(longint(hi(tai_const(hp).value))));
  557. AsmWrite(',');
  558. AsmWrite(tostr(longint(lo(tai_const(hp).value))));
  559. end;
  560. AsmLn;
  561. end;
  562. {$endif cpu64bit}
  563. aitconst_uleb128bit,
  564. aitconst_sleb128bit,
  565. {$ifdef cpu64bit}
  566. aitconst_128bit,
  567. aitconst_64bit,
  568. {$endif cpu64bit}
  569. aitconst_32bit,
  570. aitconst_16bit,
  571. aitconst_8bit,
  572. aitconst_rva_symbol,
  573. aitconst_indirect_symbol :
  574. begin
  575. if (target_info.system in [system_powerpc_darwin,system_i386_darwin]) and
  576. (tai_const(hp).consttype in [aitconst_uleb128bit,aitconst_sleb128bit]) then
  577. begin
  578. AsmWrite(ait_const2str[aitconst_8bit]);
  579. case tai_const(hp).consttype of
  580. aitconst_uleb128bit:
  581. WriteDecodedUleb128(aword(tai_const(hp).value));
  582. aitconst_sleb128bit:
  583. WriteDecodedSleb128(aint(tai_const(hp).value));
  584. end
  585. end
  586. else
  587. begin
  588. AsmWrite(ait_const2str[tai_const(hp).consttype]);
  589. l:=0;
  590. t := '';
  591. repeat
  592. if assigned(tai_const(hp).sym) then
  593. begin
  594. if assigned(tai_const(hp).endsym) then
  595. begin
  596. if (target_info.system in [system_powerpc_darwin,system_i386_darwin]) then
  597. begin
  598. s := NextSetLabel;
  599. t := #9'.set '+s+','+tai_const(hp).endsym.name+'-'+tai_const(hp).sym.name;
  600. end
  601. else
  602. s:=tai_const(hp).endsym.name+'-'+tai_const(hp).sym.name
  603. end
  604. else
  605. s:=tai_const(hp).sym.name;
  606. if tai_const(hp).value<>0 then
  607. s:=s+tostr_with_plus(tai_const(hp).value);
  608. end
  609. else
  610. s:=tostr(tai_const(hp).value);
  611. AsmWrite(s);
  612. inc(l,length(s));
  613. { Values with symbols are written on a single line to improve
  614. reading of the .s file (PFV) }
  615. if assigned(tai_const(hp).sym) or
  616. not(CurrSecType in [sec_data,sec_rodata]) or
  617. (l>line_length) or
  618. (hp.next=nil) or
  619. (tai(hp.next).typ<>ait_const) or
  620. (tai_const(hp.next).consttype<>consttype) or
  621. assigned(tai_const(hp.next).sym) then
  622. break;
  623. hp:=tai(hp.next);
  624. AsmWrite(',');
  625. until false;
  626. if (t <> '') then
  627. begin
  628. AsmLn;
  629. AsmWrite(t);
  630. end;
  631. end;
  632. AsmLn;
  633. end;
  634. end;
  635. end;
  636. {$ifdef cpuextended}
  637. ait_real_80bit :
  638. begin
  639. if do_line then
  640. AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_real_80bit(hp).value));
  641. { Make sure e is a extended type, bestreal could be
  642. a different type (bestreal) !! (PFV) }
  643. e:=tai_real_80bit(hp).value;
  644. AsmWrite(#9'.byte'#9);
  645. for i:=0 to 9 do
  646. begin
  647. if i<>0 then
  648. AsmWrite(',');
  649. AsmWrite(tostr(t80bitarray(e)[i]));
  650. end;
  651. AsmLn;
  652. end;
  653. {$endif cpuextended}
  654. ait_real_64bit :
  655. begin
  656. if do_line then
  657. AsmWriteLn(target_asm.comment+'value: '+double2str(tai_real_64bit(hp).value));
  658. d:=tai_real_64bit(hp).value;
  659. { swap the values to correct endian if required }
  660. if source_info.endian <> target_info.endian then
  661. swap64bitarray(t64bitarray(d));
  662. AsmWrite(#9'.byte'#9);
  663. {$ifdef arm}
  664. { on a real arm cpu, it's already hi/lo swapped }
  665. {$ifndef cpuarm}
  666. if tai_real_64bit(hp).formatoptions=fo_hiloswapped then
  667. begin
  668. for i:=4 to 7 do
  669. begin
  670. if i<>4 then
  671. AsmWrite(',');
  672. AsmWrite(tostr(t64bitarray(d)[i]));
  673. end;
  674. for i:=0 to 3 do
  675. begin
  676. AsmWrite(',');
  677. AsmWrite(tostr(t64bitarray(d)[i]));
  678. end;
  679. end
  680. else
  681. {$endif cpuarm}
  682. {$endif arm}
  683. begin
  684. for i:=0 to 7 do
  685. begin
  686. if i<>0 then
  687. AsmWrite(',');
  688. AsmWrite(tostr(t64bitarray(d)[i]));
  689. end;
  690. end;
  691. AsmLn;
  692. end;
  693. ait_real_32bit :
  694. begin
  695. if do_line then
  696. AsmWriteLn(target_asm.comment+'value: '+single2str(tai_real_32bit(hp).value));
  697. sin:=tai_real_32bit(hp).value;
  698. { swap the values to correct endian if required }
  699. if source_info.endian <> target_info.endian then
  700. swap32bitarray(t32bitarray(sin));
  701. AsmWrite(#9'.byte'#9);
  702. for i:=0 to 3 do
  703. begin
  704. if i<>0 then
  705. AsmWrite(',');
  706. AsmWrite(tostr(t32bitarray(sin)[i]));
  707. end;
  708. AsmLn;
  709. end;
  710. ait_comp_64bit :
  711. begin
  712. if do_line then
  713. AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_comp_64bit(hp).value));
  714. AsmWrite(#9'.byte'#9);
  715. {$ifdef FPC}
  716. co:=comp(tai_comp_64bit(hp).value);
  717. {$else}
  718. co:=tai_comp_64bit(hp).value;
  719. {$endif}
  720. { swap the values to correct endian if required }
  721. if source_info.endian <> target_info.endian then
  722. swap64bitarray(t64bitarray(co));
  723. for i:=0 to 7 do
  724. begin
  725. if i<>0 then
  726. AsmWrite(',');
  727. AsmWrite(tostr(t64bitarray(co)[i]));
  728. end;
  729. AsmLn;
  730. end;
  731. ait_string :
  732. begin
  733. pos:=0;
  734. for i:=1 to tai_string(hp).len do
  735. begin
  736. if pos=0 then
  737. begin
  738. AsmWrite(#9'.ascii'#9'"');
  739. pos:=20;
  740. end;
  741. ch:=tai_string(hp).str[i-1];
  742. case ch of
  743. #0, {This can't be done by range, because a bug in FPC}
  744. #1..#31,
  745. #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7);
  746. '"' : s:='\"';
  747. '\' : s:='\\';
  748. else
  749. s:=ch;
  750. end;
  751. AsmWrite(s);
  752. inc(pos,length(s));
  753. if (pos>line_length) or (i=tai_string(hp).len) then
  754. begin
  755. AsmWriteLn('"');
  756. pos:=0;
  757. end;
  758. end;
  759. end;
  760. ait_label :
  761. begin
  762. if (tai_label(hp).labsym.is_used) then
  763. begin
  764. if tai_label(hp).labsym.bind=AB_GLOBAL then
  765. begin
  766. AsmWrite('.globl'#9);
  767. AsmWriteLn(tai_label(hp).labsym.name);
  768. end;
  769. AsmWrite(tai_label(hp).labsym.name);
  770. AsmWriteLn(':');
  771. end;
  772. end;
  773. ait_symbol :
  774. begin
  775. if tai_symbol(hp).is_global then
  776. begin
  777. AsmWrite('.globl'#9);
  778. AsmWriteLn(tai_symbol(hp).sym.name);
  779. end;
  780. if (target_info.system = system_powerpc64_linux) and
  781. (tai_symbol(hp).sym.typ = AT_FUNCTION) then
  782. begin
  783. AsmWriteLn('.section "opd", "aw"');
  784. AsmWriteLn('.align 3');
  785. AsmWriteLn(tai_symbol(hp).sym.name + ':');
  786. AsmWriteLn('.quad .' + tai_symbol(hp).sym.name + ', .TOC.@tocbase, 0');
  787. AsmWriteLn('.previous');
  788. AsmWriteLn('.size ' + tai_symbol(hp).sym.name + ', 24');
  789. AsmWriteLn('.globl .' + tai_symbol(hp).sym.name);
  790. AsmWriteLn('.type .' + tai_symbol(hp).sym.name + ', @function');
  791. { the dotted name is the name of the actual function entry }
  792. AsmWrite('.');
  793. end
  794. else
  795. begin
  796. if (target_info.system <> system_arm_linux) then
  797. begin
  798. sepChar := '@';
  799. end
  800. else
  801. begin
  802. sepChar := '#';
  803. end;
  804. if (tf_needs_symbol_type in target_info.flags) then
  805. begin
  806. AsmWrite(#9'.type'#9 + tai_symbol(hp).sym.name);
  807. if (needsObject(tai_symbol(hp))) then
  808. begin
  809. AsmWriteLn(',' + sepChar + 'object');
  810. end
  811. else
  812. begin
  813. AsmWriteLn(',' + sepChar + 'function');
  814. end;
  815. end;
  816. end;
  817. AsmWriteLn(tai_symbol(hp).sym.name + ':');
  818. end;
  819. ait_symbol_end :
  820. begin
  821. if tf_needs_symbol_size in target_info.flags then
  822. begin
  823. s:=target_asm.labelprefix+'e'+tostr(symendcount);
  824. inc(symendcount);
  825. AsmWriteLn(s+':');
  826. AsmWrite(#9'.size'#9);
  827. if (target_info.system = system_powerpc64_linux) and (tai_symbol_end(hp).sym.typ = AT_FUNCTION) then
  828. AsmWrite('.');
  829. AsmWrite(tai_symbol_end(hp).sym.name);
  830. AsmWrite(', '+s+' - ');
  831. if (target_info.system = system_powerpc64_linux) and (tai_symbol_end(hp).sym.typ = AT_FUNCTION) then
  832. AsmWrite('.');
  833. AsmWriteLn(tai_symbol_end(hp).sym.name);
  834. end;
  835. end;
  836. ait_instruction :
  837. begin
  838. WriteInstruction(hp);
  839. end;
  840. ait_stab :
  841. begin
  842. if assigned(tai_stab(hp).str) then
  843. begin
  844. AsmWrite(#9'.'+stabtypestr[tai_stab(hp).stabtype]+' ');
  845. AsmWritePChar(tai_stab(hp).str);
  846. AsmLn;
  847. end;
  848. end;
  849. ait_file :
  850. begin
  851. tai_file(hp).idx:=nextdwarffileidx;
  852. inc(nextdwarffileidx);
  853. AsmWrite(#9'.file '+tostr(tai_file(hp).idx)+' "');
  854. AsmWritePChar(tai_file(hp).str);
  855. AsmWrite('"');
  856. AsmLn;
  857. end;
  858. ait_loc :
  859. begin
  860. AsmWrite(#9'.loc '+tostr(tai_loc(hp).fileentry.idx)+' '+tostr(tai_loc(hp).line)+' '+tostr(tai_loc(hp).column));
  861. AsmLn;
  862. end;
  863. ait_force_line,
  864. ait_function_name : ;
  865. ait_cutobject :
  866. begin
  867. if SmartAsm then
  868. begin
  869. { only reset buffer if nothing has changed }
  870. if AsmSize=AsmStartSize then
  871. AsmClear
  872. else
  873. begin
  874. AsmClose;
  875. DoAssemble;
  876. AsmCreate(tai_cutobject(hp).place);
  877. end;
  878. { avoid empty files }
  879. while assigned(hp.next) and (tai(hp.next).typ in [ait_cutobject,ait_section,ait_comment]) do
  880. begin
  881. if tai(hp.next).typ=ait_section then
  882. CurrSecType:=tai_section(hp.next).sectype;
  883. hp:=tai(hp.next);
  884. end;
  885. if CurrSecType<>sec_none then
  886. WriteSection(CurrSecType,'');
  887. AsmStartSize:=AsmSize;
  888. { reset dwarf file index }
  889. nextdwarffileidx:=1;
  890. end;
  891. end;
  892. ait_marker :
  893. if tai_marker(hp).kind=InlineStart then
  894. inc(InlineLevel)
  895. else if tai_marker(hp).kind=InlineEnd then
  896. dec(InlineLevel);
  897. ait_directive :
  898. begin
  899. AsmWrite('.'+directivestr[tai_directive(hp).directive]+' ');
  900. if assigned(tai_directive(hp).name) then
  901. AsmWrite(tai_directive(hp).name^);
  902. AsmLn;
  903. end;
  904. else
  905. internalerror(2006012201);
  906. end;
  907. hp:=tai(hp.next);
  908. end;
  909. end;
  910. procedure TGNUAssembler.WriteExtraHeader;
  911. begin
  912. end;
  913. procedure TGNUAssembler.WriteInstruction(hp: tai);
  914. begin
  915. InstrWriter.WriteInstruction(hp);
  916. end;
  917. procedure TGNUAssembler.WriteAsmList;
  918. var
  919. p:dirstr;
  920. n:namestr;
  921. e:extstr;
  922. hal : tasmlist;
  923. begin
  924. {$ifdef EXTDEBUG}
  925. if assigned(current_module.mainsource) then
  926. Comment(V_Debug,'Start writing gas-styled assembler output for '+current_module.mainsource^);
  927. {$endif}
  928. CurrSecType:=sec_none;
  929. FillChar(lastfileinfo,sizeof(lastfileinfo),0);
  930. LastInfile:=nil;
  931. if assigned(current_module.mainsource) then
  932. {$IFDEF USE_SYSUTILS}
  933. begin
  934. p := SplitPath(current_module.mainsource^);
  935. n := SplitName(current_module.mainsource^);
  936. e := SplitExtension(current_module.mainsource^);
  937. end
  938. {$ELSE USE_SYSUTILS}
  939. fsplit(current_module.mainsource^,p,n,e)
  940. {$ENDIF USE_SYSUTILS}
  941. else
  942. begin
  943. p:=inputdir;
  944. n:=inputfile;
  945. e:=inputextension;
  946. end;
  947. { to get symify to work }
  948. AsmWriteLn(#9'.file "'+FixFileName(n+e)+'"');
  949. WriteExtraHeader;
  950. AsmStartSize:=AsmSize;
  951. symendcount:=0;
  952. for hal:=low(Tasmlist) to high(Tasmlist) do
  953. begin
  954. AsmWriteLn(target_asm.comment+'Begin asmlist '+TasmlistStr[hal]);
  955. writetree(asmlist[hal]);
  956. AsmWriteLn(target_asm.comment+'End asmlist '+TasmlistStr[hal]);
  957. end;
  958. AsmLn;
  959. {$ifdef EXTDEBUG}
  960. if assigned(current_module.mainsource) then
  961. Comment(V_Debug,'Done writing gas-styled assembler output for '+current_module.mainsource^);
  962. {$endif EXTDEBUG}
  963. end;
  964. {****************************************************************************}
  965. { Apple/GNU Assembler writer }
  966. {****************************************************************************}
  967. function TAppleGNUAssembler.sectionname(atype:TAsmSectiontype;const aname:string):string;
  968. begin
  969. if (target_info.system in [system_powerpc_darwin,system_i386_darwin]) then
  970. case atype of
  971. sec_bss:
  972. { all bss (lcomm) symbols are automatically put in the right }
  973. { place by using the lcomm assembler directive }
  974. atype := sec_none;
  975. sec_debug_frame,
  976. sec_eh_frame:
  977. begin
  978. result := '.section __DWARFA,__debug_frame,coalesced,no_toc+strip_static_syms'#10'EH_frame'+tostr(debugframecount)+':';
  979. inc(debugframecount);
  980. exit;
  981. end;
  982. end;
  983. result := inherited sectionname(atype,aname);
  984. end;
  985. {****************************************************************************}
  986. { Abstract Instruction Writer }
  987. {****************************************************************************}
  988. constructor TCPUInstrWriter.create(_owner: TGNUAssembler);
  989. begin
  990. inherited create;
  991. owner := _owner;
  992. end;
  993. end.