aggas.pas 36 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091
  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: 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[17] = ('',
  195. '.text',
  196. '.data',
  197. {$warning TODO .rodata not yet working}
  198. '.data',
  199. '.bss',
  200. '.threadvar',
  201. '', { stubs }
  202. '.stab',
  203. '.stabstr',
  204. '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
  205. '.eh_frame',
  206. '.debug_frame','.debug_info','.debug_line','.debug_abbrev',
  207. 'fpc.resptrs',
  208. '.toc'
  209. );
  210. secnames_pic : array[TAsmSectiontype] of string[17] = ('',
  211. '.text',
  212. '.data.rel',
  213. '.data.rel',
  214. '.bss',
  215. '.threadvar',
  216. '', { stubs }
  217. '.stab',
  218. '.stabstr',
  219. '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
  220. '.eh_frame',
  221. '.debug_frame','.debug_info','.debug_line','.debug_abbrev',
  222. 'fpc.resptrs',
  223. '.toc'
  224. );
  225. var
  226. secname : string;
  227. begin
  228. if (cs_create_pic in aktmoduleswitches) and
  229. not(target_info.system in [system_powerpc_darwin,system_i386_darwin]) then
  230. secname:=secnames_pic[atype]
  231. else
  232. secname:=secnames[atype];
  233. if (atype=sec_threadvar) and
  234. (target_info.system=system_i386_win32) then
  235. secname:='.tls';
  236. if use_smartlink_section and
  237. (aname<>'') then
  238. result:=secname+'.'+aname
  239. else
  240. result:=secname;
  241. end;
  242. procedure TGNUAssembler.WriteSection(atype:TAsmSectiontype;const aname:string);
  243. var
  244. s : string;
  245. begin
  246. AsmLn;
  247. case target_info.system of
  248. system_i386_OS2,
  249. system_i386_EMX: ;
  250. system_powerpc_darwin,
  251. system_i386_darwin:
  252. begin
  253. if (atype = sec_stub) then
  254. AsmWrite('.section ');
  255. end
  256. else
  257. AsmWrite('.section ');
  258. end;
  259. s:=sectionname(atype,aname);
  260. AsmWrite(s);
  261. case atype of
  262. sec_fpc :
  263. AsmWrite(', "a", @progbits');
  264. sec_stub :
  265. begin
  266. case target_info.system of
  267. { there are processor-independent shortcuts available }
  268. { for this, namely .symbol_stub and .picsymbol_stub, but }
  269. { they don't work and gcc doesn't use them either... }
  270. system_powerpc_darwin:
  271. AsmWriteln('__TEXT,__symbol_stub1,symbol_stubs,pure_instructions,16');
  272. system_i386_darwin:
  273. AsmWriteln('__IMPORT,__jump_table,symbol_stubs,self_modifying_code+pure_instructions,5');
  274. else
  275. internalerror(2006031101);
  276. end;
  277. end;
  278. end;
  279. AsmLn;
  280. CurrSecType:=atype;
  281. end;
  282. procedure TGNUAssembler.WriteDecodedUleb128(a: 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:TAsmList);
  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=current_asmdata.asmlists[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 (target_info.system <> system_arm_linux) then
  526. sepChar := '@'
  527. else
  528. sepChar := '%';
  529. if (tf_needs_symbol_type in target_info.flags) then
  530. asmwriteln(#9'.type '+Tai_datablock(hp).sym.name+','+sepChar+'object');
  531. if (tf_needs_symbol_size in target_info.flags) and (tai_datablock(hp).size > 0) then
  532. asmwriteln(#9'.size '+Tai_datablock(hp).sym.name+','+tostr(Tai_datablock(hp).size));
  533. asmwrite(Tai_datablock(hp).sym.name);
  534. asmwriteln(':');
  535. asmwriteln(#9'.zero '+tostr(Tai_datablock(hp).size));
  536. end;
  537. end;
  538. ait_const:
  539. begin
  540. consttype:=tai_const(hp).consttype;
  541. case consttype of
  542. {$ifndef cpu64bit}
  543. aitconst_128bit :
  544. begin
  545. internalerror(200404291);
  546. end;
  547. aitconst_64bit :
  548. begin
  549. if assigned(tai_const(hp).sym) then
  550. internalerror(200404292);
  551. AsmWrite(ait_const2str[aitconst_32bit]);
  552. if target_info.endian = endian_little then
  553. begin
  554. AsmWrite(tostr(longint(lo(tai_const(hp).value))));
  555. AsmWrite(',');
  556. AsmWrite(tostr(longint(hi(tai_const(hp).value))));
  557. end
  558. else
  559. begin
  560. AsmWrite(tostr(longint(hi(tai_const(hp).value))));
  561. AsmWrite(',');
  562. AsmWrite(tostr(longint(lo(tai_const(hp).value))));
  563. end;
  564. AsmLn;
  565. end;
  566. {$endif cpu64bit}
  567. aitconst_uleb128bit,
  568. aitconst_sleb128bit,
  569. {$ifdef cpu64bit}
  570. aitconst_128bit,
  571. aitconst_64bit,
  572. {$endif cpu64bit}
  573. aitconst_32bit,
  574. aitconst_16bit,
  575. aitconst_8bit,
  576. aitconst_rva_symbol,
  577. aitconst_indirect_symbol :
  578. begin
  579. if (target_info.system in [system_powerpc_darwin,system_i386_darwin]) and
  580. (tai_const(hp).consttype in [aitconst_uleb128bit,aitconst_sleb128bit]) then
  581. begin
  582. AsmWrite(ait_const2str[aitconst_8bit]);
  583. case tai_const(hp).consttype of
  584. aitconst_uleb128bit:
  585. WriteDecodedUleb128(aword(tai_const(hp).value));
  586. aitconst_sleb128bit:
  587. WriteDecodedSleb128(aint(tai_const(hp).value));
  588. end
  589. end
  590. else
  591. begin
  592. AsmWrite(ait_const2str[tai_const(hp).consttype]);
  593. l:=0;
  594. t := '';
  595. repeat
  596. if assigned(tai_const(hp).sym) then
  597. begin
  598. if assigned(tai_const(hp).endsym) then
  599. begin
  600. if (target_info.system in [system_powerpc_darwin,system_i386_darwin]) then
  601. begin
  602. s := NextSetLabel;
  603. t := #9'.set '+s+','+tai_const(hp).endsym.name+'-'+tai_const(hp).sym.name;
  604. end
  605. else
  606. s:=tai_const(hp).endsym.name+'-'+tai_const(hp).sym.name
  607. end
  608. else
  609. s:=tai_const(hp).sym.name;
  610. if tai_const(hp).value<>0 then
  611. s:=s+tostr_with_plus(tai_const(hp).value);
  612. end
  613. else
  614. s:=tostr(tai_const(hp).value);
  615. AsmWrite(s);
  616. inc(l,length(s));
  617. { Values with symbols are written on a single line to improve
  618. reading of the .s file (PFV) }
  619. if assigned(tai_const(hp).sym) or
  620. not(CurrSecType in [sec_data,sec_rodata]) or
  621. (l>line_length) or
  622. (hp.next=nil) or
  623. (tai(hp.next).typ<>ait_const) or
  624. (tai_const(hp.next).consttype<>consttype) or
  625. assigned(tai_const(hp.next).sym) then
  626. break;
  627. hp:=tai(hp.next);
  628. AsmWrite(',');
  629. until false;
  630. if (t <> '') then
  631. begin
  632. AsmLn;
  633. AsmWrite(t);
  634. end;
  635. end;
  636. AsmLn;
  637. end;
  638. end;
  639. end;
  640. {$ifdef cpuextended}
  641. ait_real_80bit :
  642. begin
  643. if do_line then
  644. AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_real_80bit(hp).value));
  645. { Make sure e is a extended type, bestreal could be
  646. a different type (bestreal) !! (PFV) }
  647. e:=tai_real_80bit(hp).value;
  648. AsmWrite(#9'.byte'#9);
  649. for i:=0 to 9 do
  650. begin
  651. if i<>0 then
  652. AsmWrite(',');
  653. AsmWrite(tostr(t80bitarray(e)[i]));
  654. end;
  655. AsmLn;
  656. end;
  657. {$endif cpuextended}
  658. ait_real_64bit :
  659. begin
  660. if do_line then
  661. AsmWriteLn(target_asm.comment+'value: '+double2str(tai_real_64bit(hp).value));
  662. d:=tai_real_64bit(hp).value;
  663. { swap the values to correct endian if required }
  664. if source_info.endian <> target_info.endian then
  665. swap64bitarray(t64bitarray(d));
  666. AsmWrite(#9'.byte'#9);
  667. {$ifdef arm}
  668. { on a real arm cpu, it's already hi/lo swapped }
  669. {$ifndef cpuarm}
  670. if tai_real_64bit(hp).formatoptions=fo_hiloswapped then
  671. begin
  672. for i:=4 to 7 do
  673. begin
  674. if i<>4 then
  675. AsmWrite(',');
  676. AsmWrite(tostr(t64bitarray(d)[i]));
  677. end;
  678. for i:=0 to 3 do
  679. begin
  680. AsmWrite(',');
  681. AsmWrite(tostr(t64bitarray(d)[i]));
  682. end;
  683. end
  684. else
  685. {$endif cpuarm}
  686. {$endif arm}
  687. begin
  688. for i:=0 to 7 do
  689. begin
  690. if i<>0 then
  691. AsmWrite(',');
  692. AsmWrite(tostr(t64bitarray(d)[i]));
  693. end;
  694. end;
  695. AsmLn;
  696. end;
  697. ait_real_32bit :
  698. begin
  699. if do_line then
  700. AsmWriteLn(target_asm.comment+'value: '+single2str(tai_real_32bit(hp).value));
  701. sin:=tai_real_32bit(hp).value;
  702. { swap the values to correct endian if required }
  703. if source_info.endian <> target_info.endian then
  704. swap32bitarray(t32bitarray(sin));
  705. AsmWrite(#9'.byte'#9);
  706. for i:=0 to 3 do
  707. begin
  708. if i<>0 then
  709. AsmWrite(',');
  710. AsmWrite(tostr(t32bitarray(sin)[i]));
  711. end;
  712. AsmLn;
  713. end;
  714. ait_comp_64bit :
  715. begin
  716. if do_line then
  717. AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_comp_64bit(hp).value));
  718. AsmWrite(#9'.byte'#9);
  719. {$ifdef FPC}
  720. co:=comp(tai_comp_64bit(hp).value);
  721. {$else}
  722. co:=tai_comp_64bit(hp).value;
  723. {$endif}
  724. { swap the values to correct endian if required }
  725. if source_info.endian <> target_info.endian then
  726. swap64bitarray(t64bitarray(co));
  727. for i:=0 to 7 do
  728. begin
  729. if i<>0 then
  730. AsmWrite(',');
  731. AsmWrite(tostr(t64bitarray(co)[i]));
  732. end;
  733. AsmLn;
  734. end;
  735. ait_string :
  736. begin
  737. pos:=0;
  738. for i:=1 to tai_string(hp).len do
  739. begin
  740. if pos=0 then
  741. begin
  742. AsmWrite(#9'.ascii'#9'"');
  743. pos:=20;
  744. end;
  745. ch:=tai_string(hp).str[i-1];
  746. case ch of
  747. #0, {This can't be done by range, because a bug in FPC}
  748. #1..#31,
  749. #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7);
  750. '"' : s:='\"';
  751. '\' : s:='\\';
  752. else
  753. s:=ch;
  754. end;
  755. AsmWrite(s);
  756. inc(pos,length(s));
  757. if (pos>line_length) or (i=tai_string(hp).len) then
  758. begin
  759. AsmWriteLn('"');
  760. pos:=0;
  761. end;
  762. end;
  763. end;
  764. ait_label :
  765. begin
  766. if (tai_label(hp).labsym.is_used) then
  767. begin
  768. if tai_label(hp).labsym.bind=AB_GLOBAL then
  769. begin
  770. AsmWrite('.globl'#9);
  771. AsmWriteLn(tai_label(hp).labsym.name);
  772. end;
  773. AsmWrite(tai_label(hp).labsym.name);
  774. AsmWriteLn(':');
  775. end;
  776. end;
  777. ait_symbol :
  778. begin
  779. if tai_symbol(hp).is_global then
  780. begin
  781. AsmWrite('.globl'#9);
  782. AsmWriteLn(tai_symbol(hp).sym.name);
  783. end;
  784. if (target_info.system = system_powerpc64_linux) and
  785. (tai_symbol(hp).sym.typ = AT_FUNCTION) then
  786. begin
  787. AsmWriteLn('.section "opd", "aw"');
  788. AsmWriteLn('.align 3');
  789. AsmWriteLn(tai_symbol(hp).sym.name + ':');
  790. AsmWriteLn('.quad .' + tai_symbol(hp).sym.name + ', .TOC.@tocbase, 0');
  791. AsmWriteLn('.previous');
  792. AsmWriteLn('.size ' + tai_symbol(hp).sym.name + ', 24');
  793. AsmWriteLn('.globl .' + tai_symbol(hp).sym.name);
  794. AsmWriteLn('.type .' + tai_symbol(hp).sym.name + ', @function');
  795. { the dotted name is the name of the actual function entry }
  796. AsmWrite('.');
  797. end
  798. else
  799. begin
  800. if (target_info.system <> system_arm_linux) then
  801. sepChar := '@'
  802. else
  803. sepChar := '#';
  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. AsmWriteLn(',' + sepChar + 'object')
  809. else
  810. AsmWriteLn(',' + sepChar + 'function');
  811. end;
  812. end;
  813. AsmWriteLn(tai_symbol(hp).sym.name + ':');
  814. end;
  815. ait_symbol_end :
  816. begin
  817. if tf_needs_symbol_size in target_info.flags then
  818. begin
  819. s:=target_asm.labelprefix+'e'+tostr(symendcount);
  820. inc(symendcount);
  821. AsmWriteLn(s+':');
  822. AsmWrite(#9'.size'#9);
  823. if (target_info.system = system_powerpc64_linux) and (tai_symbol_end(hp).sym.typ = AT_FUNCTION) then
  824. AsmWrite('.');
  825. AsmWrite(tai_symbol_end(hp).sym.name);
  826. AsmWrite(', '+s+' - ');
  827. if (target_info.system = system_powerpc64_linux) and (tai_symbol_end(hp).sym.typ = AT_FUNCTION) then
  828. AsmWrite('.');
  829. AsmWriteLn(tai_symbol_end(hp).sym.name);
  830. end;
  831. end;
  832. ait_instruction :
  833. begin
  834. WriteInstruction(hp);
  835. end;
  836. ait_stab :
  837. begin
  838. if assigned(tai_stab(hp).str) then
  839. begin
  840. AsmWrite(#9'.'+stabtypestr[tai_stab(hp).stabtype]+' ');
  841. AsmWritePChar(tai_stab(hp).str);
  842. AsmLn;
  843. end;
  844. end;
  845. ait_file :
  846. begin
  847. tai_file(hp).idx:=nextdwarffileidx;
  848. inc(nextdwarffileidx);
  849. AsmWrite(#9'.file '+tostr(tai_file(hp).idx)+' "');
  850. AsmWritePChar(tai_file(hp).str);
  851. AsmWrite('"');
  852. AsmLn;
  853. end;
  854. ait_loc :
  855. begin
  856. AsmWrite(#9'.loc '+tostr(tai_loc(hp).fileentry.idx)+' '+tostr(tai_loc(hp).line)+' '+tostr(tai_loc(hp).column));
  857. AsmLn;
  858. end;
  859. ait_force_line,
  860. ait_function_name : ;
  861. ait_cutobject :
  862. begin
  863. if SmartAsm then
  864. begin
  865. { only reset buffer if nothing has changed }
  866. if AsmSize=AsmStartSize then
  867. AsmClear
  868. else
  869. begin
  870. AsmClose;
  871. DoAssemble;
  872. AsmCreate(tai_cutobject(hp).place);
  873. end;
  874. { avoid empty files }
  875. while assigned(hp.next) and (tai(hp.next).typ in [ait_cutobject,ait_section,ait_comment]) do
  876. begin
  877. if tai(hp.next).typ=ait_section then
  878. CurrSecType:=tai_section(hp.next).sectype;
  879. hp:=tai(hp.next);
  880. end;
  881. if CurrSecType<>sec_none then
  882. WriteSection(CurrSecType,'');
  883. AsmStartSize:=AsmSize;
  884. { reset dwarf file index }
  885. nextdwarffileidx:=1;
  886. end;
  887. end;
  888. ait_marker :
  889. if tai_marker(hp).kind=mark_InlineStart then
  890. inc(InlineLevel)
  891. else if tai_marker(hp).kind=mark_InlineEnd then
  892. dec(InlineLevel);
  893. ait_directive :
  894. begin
  895. AsmWrite('.'+directivestr[tai_directive(hp).directive]+' ');
  896. if assigned(tai_directive(hp).name) then
  897. AsmWrite(tai_directive(hp).name^);
  898. AsmLn;
  899. end;
  900. else
  901. internalerror(2006012201);
  902. end;
  903. hp:=tai(hp.next);
  904. end;
  905. end;
  906. procedure TGNUAssembler.WriteExtraHeader;
  907. begin
  908. end;
  909. procedure TGNUAssembler.WriteInstruction(hp: tai);
  910. begin
  911. InstrWriter.WriteInstruction(hp);
  912. end;
  913. procedure TGNUAssembler.WriteAsmList;
  914. var
  915. p:dirstr;
  916. n:namestr;
  917. e:extstr;
  918. hal : tasmlisttype;
  919. begin
  920. {$ifdef EXTDEBUG}
  921. if assigned(current_module.mainsource) then
  922. Comment(V_Debug,'Start writing gas-styled assembler output for '+current_module.mainsource^);
  923. {$endif}
  924. CurrSecType:=sec_none;
  925. FillChar(lastfileinfo,sizeof(lastfileinfo),0);
  926. LastInfile:=nil;
  927. if assigned(current_module.mainsource) then
  928. {$IFDEF USE_SYSUTILS}
  929. begin
  930. p := SplitPath(current_module.mainsource^);
  931. n := SplitName(current_module.mainsource^);
  932. e := SplitExtension(current_module.mainsource^);
  933. end
  934. {$ELSE USE_SYSUTILS}
  935. fsplit(current_module.mainsource^,p,n,e)
  936. {$ENDIF USE_SYSUTILS}
  937. else
  938. begin
  939. p:=inputdir;
  940. n:=inputfile;
  941. e:=inputextension;
  942. end;
  943. { to get symify to work }
  944. AsmWriteLn(#9'.file "'+FixFileName(n+e)+'"');
  945. WriteExtraHeader;
  946. AsmStartSize:=AsmSize;
  947. symendcount:=0;
  948. for hal:=low(TasmlistType) to high(TasmlistType) do
  949. begin
  950. AsmWriteLn(target_asm.comment+'Begin asmlist '+AsmlistTypeStr[hal]);
  951. writetree(current_asmdata.asmlists[hal]);
  952. AsmWriteLn(target_asm.comment+'End asmlist '+AsmlistTypeStr[hal]);
  953. end;
  954. AsmLn;
  955. {$ifdef EXTDEBUG}
  956. if assigned(current_module.mainsource) then
  957. Comment(V_Debug,'Done writing gas-styled assembler output for '+current_module.mainsource^);
  958. {$endif EXTDEBUG}
  959. end;
  960. {****************************************************************************}
  961. { Apple/GNU Assembler writer }
  962. {****************************************************************************}
  963. function TAppleGNUAssembler.sectionname(atype:TAsmSectiontype;const aname:string):string;
  964. begin
  965. if (target_info.system in [system_powerpc_darwin,system_i386_darwin]) then
  966. case atype of
  967. sec_bss:
  968. { all bss (lcomm) symbols are automatically put in the right }
  969. { place by using the lcomm assembler directive }
  970. atype := sec_none;
  971. sec_debug_frame,
  972. sec_eh_frame:
  973. begin
  974. result := '.section __DWARFA,__debug_frame,coalesced,no_toc+strip_static_syms'#10'EH_frame'+tostr(debugframecount)+':';
  975. inc(debugframecount);
  976. exit;
  977. end;
  978. end;
  979. result := inherited sectionname(atype,aname);
  980. end;
  981. {****************************************************************************}
  982. { Abstract Instruction Writer }
  983. {****************************************************************************}
  984. constructor TCPUInstrWriter.create(_owner: TGNUAssembler);
  985. begin
  986. inherited create;
  987. owner := _owner;
  988. end;
  989. end.