aggas.pas 36 KB

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