aggas.pas 55 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603
  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. cclasses,
  25. globtype,globals,
  26. aasmbase,aasmtai,aasmdata,aasmcpu,
  27. assemble;
  28. type
  29. TCPUInstrWriter = class;
  30. {# This is a derived class which is used to write
  31. GAS styled assembler.
  32. }
  33. { TGNUAssembler }
  34. TGNUAssembler=class(texternalassembler)
  35. protected
  36. function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;virtual;
  37. procedure WriteSection(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder);
  38. procedure WriteExtraHeader;virtual;
  39. procedure WriteInstruction(hp: tai);
  40. procedure WriteWeakSymbolDef(s: tasmsymbol); virtual;
  41. public
  42. function MakeCmdLine: TCmdStr; override;
  43. procedure WriteTree(p:TAsmList);override;
  44. procedure WriteAsmList;override;
  45. destructor destroy; override;
  46. private
  47. setcount: longint;
  48. procedure WriteDecodedSleb128(a: int64);
  49. procedure WriteDecodedUleb128(a: qword);
  50. function NextSetLabel: string;
  51. protected
  52. InstrWriter: TCPUInstrWriter;
  53. end;
  54. {# This is the base class for writing instructions.
  55. The WriteInstruction() method must be overridden
  56. to write a single instruction to the assembler
  57. file.
  58. }
  59. TCPUInstrWriter = class
  60. constructor create(_owner: TGNUAssembler);
  61. procedure WriteInstruction(hp : tai); virtual; abstract;
  62. protected
  63. owner: TGNUAssembler;
  64. end;
  65. { TAppleGNUAssembler }
  66. TAppleGNUAssembler=class(TGNUAssembler)
  67. protected
  68. function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override;
  69. procedure WriteWeakSymbolDef(s: tasmsymbol); override;
  70. end;
  71. TAoutGNUAssembler=class(TGNUAssembler)
  72. function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override;
  73. end;
  74. function ReplaceForbiddenChars(const s: string): string;
  75. implementation
  76. uses
  77. SysUtils,
  78. cutils,cfileutl,systems,
  79. fmodule,finput,verbose,
  80. itcpugas,cpubase;
  81. const
  82. line_length = 70;
  83. var
  84. symendcount : longint;
  85. type
  86. {$ifdef cpuextended}
  87. t80bitarray = array[0..9] of byte;
  88. {$endif cpuextended}
  89. t64bitarray = array[0..7] of byte;
  90. t32bitarray = array[0..3] of byte;
  91. {****************************************************************************}
  92. { Support routines }
  93. {****************************************************************************}
  94. function fixline(s:string):string;
  95. {
  96. return s with all leading and ending spaces and tabs removed
  97. }
  98. var
  99. i,j,k : integer;
  100. begin
  101. i:=length(s);
  102. while (i>0) and (s[i] in [#9,' ']) do
  103. dec(i);
  104. j:=1;
  105. while (j<i) and (s[j] in [#9,' ']) do
  106. inc(j);
  107. for k:=j to i do
  108. if s[k] in [#0..#31,#127..#255] then
  109. s[k]:='.';
  110. fixline:=Copy(s,j,i-j+1);
  111. end;
  112. function single2str(d : single) : string;
  113. var
  114. hs : string;
  115. begin
  116. str(d,hs);
  117. { replace space with + }
  118. if hs[1]=' ' then
  119. hs[1]:='+';
  120. single2str:='0d'+hs
  121. end;
  122. function double2str(d : double) : string;
  123. var
  124. hs : string;
  125. begin
  126. str(d,hs);
  127. { replace space with + }
  128. if hs[1]=' ' then
  129. hs[1]:='+';
  130. double2str:='0d'+hs
  131. end;
  132. function extended2str(e : extended) : string;
  133. var
  134. hs : string;
  135. begin
  136. str(e,hs);
  137. { replace space with + }
  138. if hs[1]=' ' then
  139. hs[1]:='+';
  140. extended2str:='0d'+hs
  141. end;
  142. { convert floating point values }
  143. { to correct endian }
  144. procedure swap64bitarray(var t: t64bitarray);
  145. var
  146. b: byte;
  147. begin
  148. b:= t[7];
  149. t[7] := t[0];
  150. t[0] := b;
  151. b := t[6];
  152. t[6] := t[1];
  153. t[1] := b;
  154. b:= t[5];
  155. t[5] := t[2];
  156. t[2] := b;
  157. b:= t[4];
  158. t[4] := t[3];
  159. t[3] := b;
  160. end;
  161. procedure swap32bitarray(var t: t32bitarray);
  162. var
  163. b: byte;
  164. begin
  165. b:= t[1];
  166. t[1]:= t[2];
  167. t[2]:= b;
  168. b:= t[0];
  169. t[0]:= t[3];
  170. t[3]:= b;
  171. end;
  172. const
  173. ait_const2str : array[aitconst_128bit..aitconst_darwin_dwarf_delta32] of string[20]=(
  174. #9'.fixme128'#9,#9'.quad'#9,#9'.long'#9,#9'.short'#9,#9'.byte'#9,
  175. #9'.sleb128'#9,#9'.uleb128'#9,
  176. #9'.rva'#9,#9'.secrel32'#9,#9'.quad'#9,#9'.long'#9
  177. );
  178. function ReplaceForbiddenChars(const s: string): string;
  179. var
  180. i : longint;
  181. begin
  182. Result:=s;
  183. for i:=1 to Length(Result) do
  184. if Result[i]='$' then
  185. Result[i]:='s';
  186. end;
  187. {****************************************************************************}
  188. { GNU Assembler writer }
  189. {****************************************************************************}
  190. destructor TGNUAssembler.Destroy;
  191. begin
  192. InstrWriter.free;
  193. inherited destroy;
  194. end;
  195. function TGNUAssembler.MakeCmdLine: TCmdStr;
  196. begin
  197. result := inherited MakeCmdLine;
  198. // MWE: disabled again. It generates dwarf info for the generated .s
  199. // files as well. This conflicts with the info we generate
  200. // if target_dbg.id = dbg_dwarf then
  201. // result := result + ' --gdwarf-2';
  202. end;
  203. function TGNUAssembler.NextSetLabel: string;
  204. begin
  205. inc(setcount);
  206. result := target_asm.labelprefix+'$set$'+tostr(setcount);
  207. end;
  208. function TGNUAssembler.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;
  209. const
  210. secnames : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('',
  211. '.text',
  212. '.data',
  213. { why doesn't .rodata work? (FK) }
  214. { sometimes we have to create a data.rel.ro instead of .rodata, e.g. for }
  215. { vtables (and anything else containing relocations), otherwise those are }
  216. { not relocated properly on e.g. linux/ppc64. g++ generates there for a }
  217. { vtable for a class called Window: }
  218. { .section .data.rel.ro._ZTV6Window,"awG",@progbits,_ZTV6Window,comdat }
  219. { TODO: .data.ro not yet working}
  220. {$if defined(arm) or defined(powerpc)}
  221. '.rodata',
  222. {$else arm}
  223. '.data',
  224. {$endif arm}
  225. {$if defined(m68k)} { Amiga/m68k GNU AS doesn't seem to like .rodata (KB) }
  226. '.data',
  227. {$else}
  228. '.rodata',
  229. {$endif}
  230. '.bss',
  231. '.threadvar',
  232. '.pdata',
  233. '', { stubs }
  234. '__DATA,__nl_symbol_ptr',
  235. '__DATA,__la_symbol_ptr',
  236. '__DATA,__mod_init_func',
  237. '__DATA,__mod_term_func',
  238. '.stab',
  239. '.stabstr',
  240. '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
  241. '.eh_frame',
  242. '.debug_frame','.debug_info','.debug_line','.debug_abbrev',
  243. '.fpc',
  244. '.toc',
  245. '.init',
  246. '.fini',
  247. '.objc_class',
  248. '.objc_meta_class',
  249. '.objc_cat_cls_meth',
  250. '.objc_cat_inst_meth',
  251. '.objc_protocol',
  252. '.objc_string_object',
  253. '.objc_cls_meth',
  254. '.objc_inst_meth',
  255. '.objc_cls_refs',
  256. '.objc_message_refs',
  257. '.objc_symbols',
  258. '.objc_category',
  259. '.objc_class_vars',
  260. '.objc_instance_vars',
  261. '.objc_module_info',
  262. '.objc_class_names',
  263. '.objc_meth_var_types',
  264. '.objc_meth_var_names',
  265. '.objc_selector_strs',
  266. '.objc_protocol_ext',
  267. '.objc_class_ext',
  268. '.objc_property',
  269. '.objc_image_info',
  270. '.objc_cstring_object',
  271. '.objc_sel_fixup',
  272. '__DATA,__objc_data',
  273. '__DATA,__objc_const',
  274. '.objc_superrefs',
  275. '__DATA, __datacoal_nt,coalesced',
  276. '.objc_classlist',
  277. '.objc_nlclasslist',
  278. '.objc_catlist',
  279. '.obcj_nlcatlist',
  280. '.objc_protolist'
  281. );
  282. secnames_pic : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('',
  283. '.text',
  284. '.data.rel',
  285. '.data.rel',
  286. '.data.rel',
  287. '.bss',
  288. '.threadvar',
  289. '.pdata',
  290. '', { stubs }
  291. '__DATA,__nl_symbol_ptr',
  292. '__DATA,__la_symbol_ptr',
  293. '__DATA,__mod_init_func',
  294. '__DATA,__mod_term_func',
  295. '.stab',
  296. '.stabstr',
  297. '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
  298. '.eh_frame',
  299. '.debug_frame','.debug_info','.debug_line','.debug_abbrev',
  300. '.fpc',
  301. '.toc',
  302. '.init',
  303. '.fini',
  304. '.objc_class',
  305. '.objc_meta_class',
  306. '.objc_cat_cls_meth',
  307. '.objc_cat_inst_meth',
  308. '.objc_protocol',
  309. '.objc_string_object',
  310. '.objc_cls_meth',
  311. '.objc_inst_meth',
  312. '.objc_cls_refs',
  313. '.objc_message_refs',
  314. '.objc_symbols',
  315. '.objc_category',
  316. '.objc_class_vars',
  317. '.objc_instance_vars',
  318. '.objc_module_info',
  319. '.objc_class_names',
  320. '.objc_meth_var_types',
  321. '.objc_meth_var_names',
  322. '.objc_selector_strs',
  323. '.objc_protocol_ext',
  324. '.objc_class_ext',
  325. '.objc_property',
  326. '.objc_image_info',
  327. '.objc_cstring_object',
  328. '.objc_sel_fixup',
  329. '__DATA, __objc_data',
  330. '__DATA, __objc_const',
  331. '.objc_superrefs',
  332. '__DATA, __datacoal_nt,coalesced',
  333. '.objc_classlist',
  334. '.objc_nlclasslist',
  335. '.objc_catlist',
  336. '.obcj_nlcatlist',
  337. '.objc_protolist'
  338. );
  339. var
  340. sep : string[3];
  341. secname : string;
  342. begin
  343. if (cs_create_pic in current_settings.moduleswitches) and
  344. not(target_info.system in systems_darwin) then
  345. secname:=secnames_pic[atype]
  346. else
  347. secname:=secnames[atype];
  348. {$ifdef m68k}
  349. { old Amiga GNU AS doesn't support .section .fpc }
  350. if (atype=sec_fpc) and (target_info.system = system_m68k_amiga) then
  351. secname:=secnames[sec_data];
  352. {$endif}
  353. if (atype=sec_fpc) and (Copy(aname,1,3)='res') then
  354. begin
  355. result:=secname+'.'+aname;
  356. exit;
  357. end;
  358. if (atype=sec_threadvar) and
  359. (target_info.system=system_i386_win32) then
  360. secname:='.tls';
  361. { go32v2 stub only loads .text and .data sections, and allocates space for .bss.
  362. Thus, data which normally goes into .rodata and .rodata_norel sections must
  363. end up in .data section }
  364. if (atype in [sec_rodata,sec_rodata_norel]) and
  365. (target_info.system=system_i386_go32v2) then
  366. secname:='.data';
  367. { For bss we need to set some flags that are target dependent,
  368. it is easier to disable it for smartlinking. It doesn't take up
  369. filespace }
  370. if not(target_info.system in systems_darwin) and
  371. create_smartlink_sections and
  372. (aname<>'') and
  373. (atype<>sec_toc) and
  374. { on embedded systems every byte counts, so smartlink bss too }
  375. ((atype<>sec_bss) or (target_info.system in systems_embedded)) then
  376. begin
  377. case aorder of
  378. secorder_begin :
  379. sep:='.b_';
  380. secorder_end :
  381. sep:='.z_';
  382. else
  383. sep:='.n_';
  384. end;
  385. result:=secname+sep+aname
  386. end
  387. else
  388. result:=secname;
  389. end;
  390. procedure TGNUAssembler.WriteSection(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder);
  391. var
  392. s : string;
  393. begin
  394. AsmLn;
  395. case target_info.system of
  396. system_i386_OS2,
  397. system_i386_EMX,
  398. system_m68k_amiga, { amiga has old GNU AS (2.14), which blews up from .section (KB) }
  399. system_m68k_linux: ;
  400. system_powerpc_darwin,
  401. system_i386_darwin,
  402. system_i386_iphonesim,
  403. system_powerpc64_darwin,
  404. system_x86_64_darwin,
  405. system_arm_darwin:
  406. begin
  407. if (atype in [sec_stub,sec_objc_data,sec_objc_const,sec_data_coalesced]) then
  408. AsmWrite('.section ');
  409. end
  410. else
  411. AsmWrite('.section ');
  412. end;
  413. s:=sectionname(atype,aname,aorder);
  414. AsmWrite(s);
  415. case atype of
  416. sec_fpc :
  417. if aname = 'resptrs' then
  418. AsmWrite(', "a", @progbits');
  419. sec_stub :
  420. begin
  421. case target_info.system of
  422. { there are processor-independent shortcuts available }
  423. { for this, namely .symbol_stub and .picsymbol_stub, but }
  424. { they don't work and gcc doesn't use them either... }
  425. system_powerpc_darwin,
  426. system_powerpc64_darwin:
  427. if (cs_create_pic in current_settings.moduleswitches) then
  428. AsmWriteln('__TEXT,__picsymbolstub1,symbol_stubs,pure_instructions,32')
  429. else
  430. AsmWriteln('__TEXT,__symbol_stub1,symbol_stubs,pure_instructions,16');
  431. system_i386_darwin,
  432. system_i386_iphonesim:
  433. AsmWriteln('__IMPORT,__jump_table,symbol_stubs,self_modifying_code+pure_instructions,5');
  434. system_arm_darwin:
  435. if (cs_create_pic in current_settings.moduleswitches) then
  436. AsmWriteln('.section __TEXT,__picsymbolstub4,symbol_stubs,none,16')
  437. else
  438. AsmWriteln('.section __TEXT,__symbol_stub4,symbol_stubs,none,12')
  439. { darwin/x86-64 uses RIP-based GOT addressing, no symbol stubs }
  440. else
  441. internalerror(2006031101);
  442. end;
  443. end;
  444. end;
  445. AsmLn;
  446. LastSecType:=atype;
  447. end;
  448. procedure TGNUAssembler.WriteDecodedUleb128(a: qword);
  449. var
  450. i,len : longint;
  451. buf : array[0..63] of byte;
  452. begin
  453. len:=EncodeUleb128(a,buf);
  454. for i:=0 to len-1 do
  455. begin
  456. if (i > 0) then
  457. AsmWrite(',');
  458. AsmWrite(tostr(buf[i]));
  459. end;
  460. end;
  461. procedure TGNUAssembler.WriteDecodedSleb128(a: int64);
  462. var
  463. i,len : longint;
  464. buf : array[0..255] of byte;
  465. begin
  466. len:=EncodeSleb128(a,buf);
  467. for i:=0 to len-1 do
  468. begin
  469. if (i > 0) then
  470. AsmWrite(',');
  471. AsmWrite(tostr(buf[i]));
  472. end;
  473. end;
  474. procedure TGNUAssembler.WriteTree(p:TAsmList);
  475. function needsObject(hp : tai_symbol) : boolean;
  476. begin
  477. needsObject :=
  478. (
  479. assigned(hp.next) and
  480. (tai(hp.next).typ in [ait_const,ait_datablock,
  481. ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit])
  482. ) or
  483. (hp.sym.typ=AT_DATA);
  484. end;
  485. procedure doalign(alignment: byte; use_op: boolean; fillop: byte; out last_align: longint);
  486. var
  487. i: longint;
  488. begin
  489. last_align:=alignment;
  490. if alignment>1 then
  491. begin
  492. if not(target_info.system in systems_darwin) then
  493. begin
  494. AsmWrite(#9'.balign '+tostr(alignment));
  495. if use_op then
  496. AsmWrite(','+tostr(fillop))
  497. {$ifdef x86}
  498. { force NOP as alignment op code }
  499. else if LastSecType=sec_code then
  500. AsmWrite(',0x90');
  501. {$endif x86}
  502. end
  503. else
  504. begin
  505. { darwin as only supports .align }
  506. if not ispowerof2(alignment,i) then
  507. internalerror(2003010305);
  508. AsmWrite(#9'.align '+tostr(i));
  509. last_align:=i;
  510. end;
  511. AsmLn;
  512. end;
  513. end;
  514. var
  515. ch : char;
  516. hp : tai;
  517. hp1 : tailineinfo;
  518. constdef : taiconst_type;
  519. s,t : string;
  520. i,pos,l : longint;
  521. InlineLevel : longint;
  522. last_align : longint;
  523. co : comp;
  524. sin : single;
  525. d : double;
  526. {$ifdef cpuextended}
  527. e : extended;
  528. {$endif cpuextended}
  529. do_line : boolean;
  530. sepChar : char;
  531. begin
  532. if not assigned(p) then
  533. exit;
  534. last_align := 2;
  535. InlineLevel:=0;
  536. { lineinfo is only needed for al_procedures (PFV) }
  537. do_line:=(cs_asm_source in current_settings.globalswitches) or
  538. ((cs_lineinfo in current_settings.moduleswitches)
  539. and (p=current_asmdata.asmlists[al_procedures]));
  540. hp:=tai(p.first);
  541. while assigned(hp) do
  542. begin
  543. prefetch(pointer(hp.next)^);
  544. if not(hp.typ in SkipLineInfo) then
  545. begin
  546. hp1 := hp as tailineinfo;
  547. current_filepos:=hp1.fileinfo;
  548. { no line info for inlined code }
  549. if do_line and (inlinelevel=0) then
  550. begin
  551. { load infile }
  552. if lastfileinfo.fileindex<>hp1.fileinfo.fileindex then
  553. begin
  554. infile:=current_module.sourcefiles.get_file(hp1.fileinfo.fileindex);
  555. if assigned(infile) then
  556. begin
  557. { open only if needed !! }
  558. if (cs_asm_source in current_settings.globalswitches) then
  559. infile.open;
  560. end;
  561. { avoid unnecessary reopens of the same file !! }
  562. lastfileinfo.fileindex:=hp1.fileinfo.fileindex;
  563. { be sure to change line !! }
  564. lastfileinfo.line:=-1;
  565. end;
  566. { write source }
  567. if (cs_asm_source in current_settings.globalswitches) and
  568. assigned(infile) then
  569. begin
  570. if (infile<>lastinfile) then
  571. begin
  572. AsmWriteLn(target_asm.comment+'['+infile.name^+']');
  573. if assigned(lastinfile) then
  574. lastinfile.close;
  575. end;
  576. if (hp1.fileinfo.line<>lastfileinfo.line) and
  577. ((hp1.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then
  578. begin
  579. if (hp1.fileinfo.line<>0) and
  580. ((infile.linebuf^[hp1.fileinfo.line]>=0) or (InlineLevel>0)) then
  581. AsmWriteLn(target_asm.comment+'['+tostr(hp1.fileinfo.line)+'] '+
  582. fixline(infile.GetLineStr(hp1.fileinfo.line)));
  583. { set it to a negative value !
  584. to make that is has been read already !! PM }
  585. if (infile.linebuf^[hp1.fileinfo.line]>=0) then
  586. infile.linebuf^[hp1.fileinfo.line]:=-infile.linebuf^[hp1.fileinfo.line]-1;
  587. end;
  588. end;
  589. lastfileinfo:=hp1.fileinfo;
  590. lastinfile:=infile;
  591. end;
  592. end;
  593. case hp.typ of
  594. ait_comment :
  595. Begin
  596. AsmWrite(target_asm.comment);
  597. AsmWritePChar(tai_comment(hp).str);
  598. AsmLn;
  599. End;
  600. ait_regalloc :
  601. begin
  602. if (cs_asm_regalloc in current_settings.globalswitches) then
  603. begin
  604. AsmWrite(#9+target_asm.comment+'Register ');
  605. repeat
  606. AsmWrite(std_regname(Tai_regalloc(hp).reg));
  607. if (hp.next=nil) or
  608. (tai(hp.next).typ<>ait_regalloc) or
  609. (tai_regalloc(hp.next).ratype<>tai_regalloc(hp).ratype) then
  610. break;
  611. hp:=tai(hp.next);
  612. AsmWrite(',');
  613. until false;
  614. AsmWrite(' ');
  615. AsmWriteLn(regallocstr[tai_regalloc(hp).ratype]);
  616. end;
  617. end;
  618. ait_tempalloc :
  619. begin
  620. if (cs_asm_tempalloc in current_settings.globalswitches) then
  621. begin
  622. {$ifdef EXTDEBUG}
  623. if assigned(tai_tempalloc(hp).problem) then
  624. AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+
  625. tostr(tai_tempalloc(hp).tempsize)+' '+tai_tempalloc(hp).problem^)
  626. else
  627. {$endif EXTDEBUG}
  628. AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+
  629. tostr(tai_tempalloc(hp).tempsize)+' '+tempallocstr[tai_tempalloc(hp).allocation]);
  630. end;
  631. end;
  632. ait_align :
  633. begin
  634. doalign(tai_align_abstract(hp).aligntype,tai_align_abstract(hp).use_op,tai_align_abstract(hp).fillop,last_align);
  635. end;
  636. ait_section :
  637. begin
  638. if tai_section(hp).sectype<>sec_none then
  639. WriteSection(tai_section(hp).sectype,tai_section(hp).name^,tai_section(hp).secorder)
  640. else
  641. begin
  642. {$ifdef EXTDEBUG}
  643. AsmWrite(target_asm.comment);
  644. AsmWriteln(' sec_none');
  645. {$endif EXTDEBUG}
  646. end;
  647. end;
  648. ait_datablock :
  649. begin
  650. if (target_info.system in systems_darwin) then
  651. begin
  652. { On Mac OS X you can't have common symbols in a shared library
  653. since those are in the TEXT section and the text section is
  654. read-only in shared libraries (so it can be shared among different
  655. processes). The alternate code creates some kind of common symbols
  656. in the data segment.
  657. }
  658. if tai_datablock(hp).is_global then
  659. begin
  660. asmwrite('.globl ');
  661. asmwriteln(tai_datablock(hp).sym.name);
  662. asmwriteln('.data');
  663. asmwrite('.zerofill __DATA, __common, ');
  664. asmwrite(tai_datablock(hp).sym.name);
  665. asmwriteln(', '+tostr(tai_datablock(hp).size)+','+tostr(last_align));
  666. if not(LastSecType in [sec_data,sec_none]) then
  667. writesection(LastSecType,'',secorder_default);
  668. end
  669. else
  670. begin
  671. asmwrite(#9'.lcomm'#9);
  672. asmwrite(tai_datablock(hp).sym.name);
  673. asmwrite(','+tostr(tai_datablock(hp).size));
  674. asmwrite(','+tostr(last_align));
  675. asmln;
  676. end;
  677. end
  678. else
  679. begin
  680. {$ifdef USE_COMM_IN_BSS}
  681. if writingpackages then
  682. begin
  683. { The .comm is required for COMMON symbols. These are used
  684. in the shared library loading. All the symbols declared in
  685. the .so file need to resolve to the data allocated in the main
  686. program (PFV) }
  687. if tai_datablock(hp).is_global then
  688. begin
  689. asmwrite(#9'.comm'#9);
  690. asmwrite(tai_datablock(hp).sym.name);
  691. asmwrite(','+tostr(tai_datablock(hp).size));
  692. asmwrite(','+tostr(last_align));
  693. asmln;
  694. end
  695. else
  696. begin
  697. asmwrite(#9'.lcomm'#9);
  698. asmwrite(tai_datablock(hp).sym.name);
  699. asmwrite(','+tostr(tai_datablock(hp).size));
  700. asmwrite(','+tostr(last_align));
  701. asmln;
  702. end
  703. end
  704. else
  705. {$endif USE_COMM_IN_BSS}
  706. begin
  707. if Tai_datablock(hp).is_global then
  708. begin
  709. asmwrite(#9'.globl ');
  710. asmwriteln(Tai_datablock(hp).sym.name);
  711. end;
  712. if (target_info.system <> system_arm_linux) then
  713. sepChar := '@'
  714. else
  715. sepChar := '%';
  716. if (tf_needs_symbol_type in target_info.flags) then
  717. asmwriteln(#9'.type '+Tai_datablock(hp).sym.name+','+sepChar+'object');
  718. if (tf_needs_symbol_size in target_info.flags) and (tai_datablock(hp).size > 0) then
  719. asmwriteln(#9'.size '+Tai_datablock(hp).sym.name+','+tostr(Tai_datablock(hp).size));
  720. asmwrite(Tai_datablock(hp).sym.name);
  721. asmwriteln(':');
  722. asmwriteln(#9'.zero '+tostr(Tai_datablock(hp).size));
  723. end;
  724. end;
  725. end;
  726. ait_const:
  727. begin
  728. constdef:=tai_const(hp).consttype;
  729. case constdef of
  730. {$ifndef cpu64bitaddr}
  731. aitconst_128bit :
  732. begin
  733. internalerror(200404291);
  734. end;
  735. aitconst_64bit :
  736. begin
  737. if assigned(tai_const(hp).sym) then
  738. internalerror(200404292);
  739. AsmWrite(ait_const2str[aitconst_32bit]);
  740. if target_info.endian = endian_little then
  741. begin
  742. AsmWrite(tostr(longint(lo(tai_const(hp).value))));
  743. AsmWrite(',');
  744. AsmWrite(tostr(longint(hi(tai_const(hp).value))));
  745. end
  746. else
  747. begin
  748. AsmWrite(tostr(longint(hi(tai_const(hp).value))));
  749. AsmWrite(',');
  750. AsmWrite(tostr(longint(lo(tai_const(hp).value))));
  751. end;
  752. AsmLn;
  753. end;
  754. {$endif cpu64bitaddr}
  755. aitconst_uleb128bit,
  756. aitconst_sleb128bit,
  757. {$ifdef cpu64bitaddr}
  758. aitconst_128bit,
  759. aitconst_64bit,
  760. {$endif cpu64bitaddr}
  761. aitconst_32bit,
  762. aitconst_16bit,
  763. aitconst_8bit,
  764. aitconst_rva_symbol,
  765. aitconst_secrel32_symbol,
  766. aitconst_darwin_dwarf_delta32,
  767. aitconst_darwin_dwarf_delta64:
  768. begin
  769. if (target_info.system in systems_darwin) and
  770. (constdef in [aitconst_uleb128bit,aitconst_sleb128bit]) then
  771. begin
  772. AsmWrite(ait_const2str[aitconst_8bit]);
  773. case tai_const(hp).consttype of
  774. aitconst_uleb128bit:
  775. WriteDecodedUleb128(qword(tai_const(hp).value));
  776. aitconst_sleb128bit:
  777. WriteDecodedSleb128(int64(tai_const(hp).value));
  778. end
  779. end
  780. else
  781. begin
  782. AsmWrite(ait_const2str[constdef]);
  783. l:=0;
  784. t := '';
  785. repeat
  786. if assigned(tai_const(hp).sym) then
  787. begin
  788. if assigned(tai_const(hp).endsym) then
  789. begin
  790. if (constdef in [aitconst_darwin_dwarf_delta32,aitconst_darwin_dwarf_delta64]) then
  791. begin
  792. s := NextSetLabel;
  793. t := #9'.set '+s+','+tai_const(hp).endsym.name+'-'+tai_const(hp).sym.name;
  794. end
  795. else
  796. s:=tai_const(hp).endsym.name+'-'+tai_const(hp).sym.name
  797. end
  798. else
  799. s:=tai_const(hp).sym.name;
  800. {$ifdef avr}
  801. s:=ReplaceForbiddenChars(s);
  802. {$endif avr}
  803. if tai_const(hp).value<>0 then
  804. s:=s+tostr_with_plus(tai_const(hp).value);
  805. end
  806. else
  807. {$ifdef cpu64bitaddr}
  808. s:=tostr(tai_const(hp).value);
  809. {$else cpu64bitaddr}
  810. { 64 bit constants are already handled above in this case }
  811. s:=tostr(longint(tai_const(hp).value));
  812. {$endif cpu64bitaddr}
  813. AsmWrite(s);
  814. inc(l,length(s));
  815. { Values with symbols are written on a single line to improve
  816. reading of the .s file (PFV) }
  817. if assigned(tai_const(hp).sym) or
  818. not(LastSecType in [sec_data,sec_rodata,sec_rodata_norel]) or
  819. (l>line_length) or
  820. (hp.next=nil) or
  821. (tai(hp.next).typ<>ait_const) or
  822. (tai_const(hp.next).consttype<>constdef) or
  823. assigned(tai_const(hp.next).sym) then
  824. break;
  825. hp:=tai(hp.next);
  826. AsmWrite(',');
  827. until false;
  828. if (t <> '') then
  829. begin
  830. AsmLn;
  831. AsmWrite(t);
  832. end;
  833. end;
  834. AsmLn;
  835. end;
  836. else
  837. internalerror(200704251);
  838. end;
  839. end;
  840. { the "and defined(FPC_HAS_TYPE_EXTENDED)" isn't optimal but currently the only solution
  841. it prevents proper cross compilation to i386 though
  842. }
  843. {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
  844. ait_real_80bit :
  845. begin
  846. if do_line then
  847. AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_real_80bit(hp).value));
  848. { Make sure e is a extended type, bestreal could be
  849. a different type (bestreal) !! (PFV) }
  850. e:=tai_real_80bit(hp).value;
  851. AsmWrite(#9'.byte'#9);
  852. for i:=0 to 9 do
  853. begin
  854. if i<>0 then
  855. AsmWrite(',');
  856. AsmWrite(tostr(t80bitarray(e)[i]));
  857. end;
  858. for i:=11 to tai_real_80bit(hp).savesize do
  859. AsmWrite(',0');
  860. AsmLn;
  861. end;
  862. {$endif cpuextended}
  863. ait_real_64bit :
  864. begin
  865. if do_line then
  866. AsmWriteLn(target_asm.comment+'value: '+double2str(tai_real_64bit(hp).value));
  867. d:=tai_real_64bit(hp).value;
  868. { swap the values to correct endian if required }
  869. if source_info.endian <> target_info.endian then
  870. swap64bitarray(t64bitarray(d));
  871. AsmWrite(#9'.byte'#9);
  872. {$ifdef arm}
  873. if tai_real_64bit(hp).formatoptions=fo_hiloswapped then
  874. begin
  875. for i:=4 to 7 do
  876. begin
  877. if i<>4 then
  878. AsmWrite(',');
  879. AsmWrite(tostr(t64bitarray(d)[i]));
  880. end;
  881. for i:=0 to 3 do
  882. begin
  883. AsmWrite(',');
  884. AsmWrite(tostr(t64bitarray(d)[i]));
  885. end;
  886. end
  887. else
  888. {$endif arm}
  889. begin
  890. for i:=0 to 7 do
  891. begin
  892. if i<>0 then
  893. AsmWrite(',');
  894. AsmWrite(tostr(t64bitarray(d)[i]));
  895. end;
  896. end;
  897. AsmLn;
  898. end;
  899. ait_real_32bit :
  900. begin
  901. if do_line then
  902. AsmWriteLn(target_asm.comment+'value: '+single2str(tai_real_32bit(hp).value));
  903. sin:=tai_real_32bit(hp).value;
  904. { swap the values to correct endian if required }
  905. if source_info.endian <> target_info.endian then
  906. swap32bitarray(t32bitarray(sin));
  907. AsmWrite(#9'.byte'#9);
  908. for i:=0 to 3 do
  909. begin
  910. if i<>0 then
  911. AsmWrite(',');
  912. AsmWrite(tostr(t32bitarray(sin)[i]));
  913. end;
  914. AsmLn;
  915. end;
  916. ait_comp_64bit :
  917. begin
  918. if do_line then
  919. AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_comp_64bit(hp).value));
  920. AsmWrite(#9'.byte'#9);
  921. co:=comp(tai_comp_64bit(hp).value);
  922. { swap the values to correct endian if required }
  923. if source_info.endian <> target_info.endian then
  924. swap64bitarray(t64bitarray(co));
  925. for i:=0 to 7 do
  926. begin
  927. if i<>0 then
  928. AsmWrite(',');
  929. AsmWrite(tostr(t64bitarray(co)[i]));
  930. end;
  931. AsmLn;
  932. end;
  933. ait_string :
  934. begin
  935. pos:=0;
  936. for i:=1 to tai_string(hp).len do
  937. begin
  938. if pos=0 then
  939. begin
  940. AsmWrite(#9'.ascii'#9'"');
  941. pos:=20;
  942. end;
  943. ch:=tai_string(hp).str[i-1];
  944. case ch of
  945. #0, {This can't be done by range, because a bug in FPC}
  946. #1..#31,
  947. #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7);
  948. '"' : s:='\"';
  949. '\' : s:='\\';
  950. else
  951. s:=ch;
  952. end;
  953. AsmWrite(s);
  954. inc(pos,length(s));
  955. if (pos>line_length) or (i=tai_string(hp).len) then
  956. begin
  957. AsmWriteLn('"');
  958. pos:=0;
  959. end;
  960. end;
  961. end;
  962. ait_label :
  963. begin
  964. if (tai_label(hp).labsym.is_used) then
  965. begin
  966. if (tai_label(hp).labsym.bind=AB_PRIVATE_EXTERN) then
  967. begin
  968. AsmWrite(#9'.private_extern ');
  969. AsmWriteln(tai_label(hp).labsym.name);
  970. end;
  971. if tai_label(hp).labsym.bind in [AB_GLOBAL,AB_PRIVATE_EXTERN] then
  972. begin
  973. AsmWrite('.globl'#9);
  974. {$ifdef avr}
  975. AsmWriteLn(ReplaceForbiddenChars(tai_label(hp).labsym.name));
  976. {$else avr}
  977. AsmWriteLn(tai_label(hp).labsym.name);
  978. {$endif avr}
  979. end;
  980. {$ifdef avr}
  981. AsmWrite(ReplaceForbiddenChars(tai_label(hp).labsym.name));
  982. {$else avr}
  983. AsmWrite(tai_label(hp).labsym.name);
  984. {$endif avr}
  985. AsmWriteLn(':');
  986. end;
  987. end;
  988. ait_symbol :
  989. begin
  990. if (tai_symbol(hp).sym.bind=AB_PRIVATE_EXTERN) then
  991. begin
  992. AsmWrite(#9'.private_extern ');
  993. {$ifdef avr}
  994. AsmWriteln(ReplaceForbiddenChars(tai_symbol(hp).sym.name));
  995. {$else avr}
  996. AsmWriteln(tai_symbol(hp).sym.name);
  997. {$endif avr}
  998. end;
  999. if (target_info.system = system_powerpc64_linux) and
  1000. (tai_symbol(hp).sym.typ = AT_FUNCTION) and (cs_profile in current_settings.moduleswitches) then
  1001. AsmWriteLn('.globl _mcount');
  1002. if tai_symbol(hp).is_global then
  1003. begin
  1004. AsmWrite('.globl'#9);
  1005. {$ifdef avr}
  1006. AsmWriteln(ReplaceForbiddenChars(tai_symbol(hp).sym.name));
  1007. {$else avr}
  1008. AsmWriteln(tai_symbol(hp).sym.name);
  1009. {$endif avr}
  1010. end;
  1011. if (target_info.system = system_powerpc64_linux) and
  1012. (tai_symbol(hp).sym.typ = AT_FUNCTION) then
  1013. begin
  1014. AsmWriteLn('.section ".opd", "aw"');
  1015. AsmWriteLn('.align 3');
  1016. AsmWriteLn(tai_symbol(hp).sym.name + ':');
  1017. AsmWriteLn('.quad .' + tai_symbol(hp).sym.name + ', .TOC.@tocbase, 0');
  1018. AsmWriteLn('.previous');
  1019. AsmWriteLn('.size ' + tai_symbol(hp).sym.name + ', 24');
  1020. if (tai_symbol(hp).is_global) then
  1021. AsmWriteLn('.globl .' + tai_symbol(hp).sym.name);
  1022. AsmWriteLn('.type .' + tai_symbol(hp).sym.name + ', @function');
  1023. { the dotted name is the name of the actual function entry }
  1024. AsmWrite('.');
  1025. end
  1026. else
  1027. begin
  1028. if (target_info.system <> system_arm_linux) then
  1029. sepChar := '@'
  1030. else
  1031. sepChar := '#';
  1032. if (tf_needs_symbol_type in target_info.flags) then
  1033. begin
  1034. AsmWrite(#9'.type'#9 + tai_symbol(hp).sym.name);
  1035. if (needsObject(tai_symbol(hp))) then
  1036. AsmWriteLn(',' + sepChar + 'object')
  1037. else
  1038. AsmWriteLn(',' + sepChar + 'function');
  1039. end;
  1040. end;
  1041. {$ifdef avr}
  1042. if not(tai_symbol(hp).has_value) then
  1043. AsmWriteLn(ReplaceForbiddenChars(tai_symbol(hp).sym.name + ':'))
  1044. else
  1045. AsmWriteLn(ReplaceForbiddenChars(tai_symbol(hp).sym.name + '=' + tostr(tai_symbol(hp).value)));
  1046. {$else avr}
  1047. if not(tai_symbol(hp).has_value) then
  1048. AsmWriteLn(tai_symbol(hp).sym.name + ':')
  1049. else
  1050. AsmWriteLn(tai_symbol(hp).sym.name + '=' + tostr(tai_symbol(hp).value));
  1051. {$endif avr}
  1052. end;
  1053. {$ifdef arm}
  1054. ait_thumb_func:
  1055. begin
  1056. AsmWriteLn(#9'.thumb_func');
  1057. end;
  1058. {$endif arm}
  1059. ait_symbol_end :
  1060. begin
  1061. if tf_needs_symbol_size in target_info.flags then
  1062. begin
  1063. s:=target_asm.labelprefix+'e'+tostr(symendcount);
  1064. inc(symendcount);
  1065. AsmWriteLn(s+':');
  1066. AsmWrite(#9'.size'#9);
  1067. if (target_info.system = system_powerpc64_linux) and (tai_symbol_end(hp).sym.typ = AT_FUNCTION) then
  1068. AsmWrite('.');
  1069. {$ifdef avr}
  1070. AsmWrite(ReplaceForbiddenChars(tai_symbol_end(hp).sym.name));
  1071. {$else avr}
  1072. AsmWrite(tai_symbol_end(hp).sym.name);
  1073. {$endif avr}
  1074. AsmWrite(', '+s+' - ');
  1075. if (target_info.system = system_powerpc64_linux) and (tai_symbol_end(hp).sym.typ = AT_FUNCTION) then
  1076. AsmWrite('.');
  1077. {$ifdef avr}
  1078. AsmWriteLn(ReplaceForbiddenChars(tai_symbol_end(hp).sym.name));
  1079. {$else avr}
  1080. AsmWriteLn(tai_symbol_end(hp).sym.name);
  1081. {$endif avr}
  1082. end;
  1083. end;
  1084. ait_instruction :
  1085. begin
  1086. WriteInstruction(hp);
  1087. end;
  1088. ait_stab :
  1089. begin
  1090. if assigned(tai_stab(hp).str) then
  1091. begin
  1092. AsmWrite(#9'.'+stabtypestr[tai_stab(hp).stabtype]+' ');
  1093. AsmWritePChar(tai_stab(hp).str);
  1094. AsmLn;
  1095. end;
  1096. end;
  1097. ait_force_line,
  1098. ait_function_name :
  1099. ;
  1100. ait_cutobject :
  1101. begin
  1102. if SmartAsm then
  1103. begin
  1104. { only reset buffer if nothing has changed }
  1105. if AsmSize=AsmStartSize then
  1106. AsmClear
  1107. else
  1108. begin
  1109. AsmClose;
  1110. DoAssemble;
  1111. AsmCreate(tai_cutobject(hp).place);
  1112. end;
  1113. { avoid empty files }
  1114. while assigned(hp.next) and (tai(hp.next).typ in [ait_cutobject,ait_section,ait_comment]) do
  1115. begin
  1116. if tai(hp.next).typ=ait_section then
  1117. LastSecType:=tai_section(hp.next).sectype;
  1118. hp:=tai(hp.next);
  1119. end;
  1120. if LastSecType<>sec_none then
  1121. WriteSection(LastSecType,'',secorder_default);
  1122. AsmStartSize:=AsmSize;
  1123. end;
  1124. end;
  1125. ait_marker :
  1126. if tai_marker(hp).kind=mark_NoLineInfoStart then
  1127. inc(InlineLevel)
  1128. else if tai_marker(hp).kind=mark_NoLineInfoEnd then
  1129. dec(InlineLevel);
  1130. ait_directive :
  1131. begin
  1132. AsmWrite('.'+directivestr[tai_directive(hp).directive]+' ');
  1133. if assigned(tai_directive(hp).name) then
  1134. AsmWrite(tai_directive(hp).name^);
  1135. AsmLn;
  1136. end;
  1137. else
  1138. internalerror(2006012201);
  1139. end;
  1140. hp:=tai(hp.next);
  1141. end;
  1142. end;
  1143. procedure TGNUAssembler.WriteExtraHeader;
  1144. begin
  1145. end;
  1146. procedure TGNUAssembler.WriteInstruction(hp: tai);
  1147. begin
  1148. InstrWriter.WriteInstruction(hp);
  1149. end;
  1150. procedure TGNUAssembler.WriteWeakSymbolDef(s: tasmsymbol);
  1151. begin
  1152. AsmWriteLn(#9'.weak '+s.name);
  1153. end;
  1154. procedure TGNUAssembler.WriteAsmList;
  1155. var
  1156. n : string;
  1157. hal : tasmlisttype;
  1158. i: longint;
  1159. begin
  1160. {$ifdef EXTDEBUG}
  1161. if assigned(current_module.mainsource) then
  1162. Comment(V_Debug,'Start writing gas-styled assembler output for '+current_module.mainsource^);
  1163. {$endif}
  1164. if assigned(current_module.mainsource) then
  1165. n:=ExtractFileName(current_module.mainsource^)
  1166. else
  1167. n:=InputFileName;
  1168. { gcc does not add it either for Darwin (and AIX). Grep for
  1169. TARGET_ASM_FILE_START_FILE_DIRECTIVE in gcc/config/*.h
  1170. }
  1171. if not(target_info.system in systems_darwin) then
  1172. AsmWriteLn(#9'.file "'+FixFileName(n)+'"');
  1173. WriteExtraHeader;
  1174. AsmStartSize:=AsmSize;
  1175. symendcount:=0;
  1176. for hal:=low(TasmlistType) to high(TasmlistType) do
  1177. begin
  1178. AsmWriteLn(target_asm.comment+'Begin asmlist '+AsmlistTypeStr[hal]);
  1179. writetree(current_asmdata.asmlists[hal]);
  1180. AsmWriteLn(target_asm.comment+'End asmlist '+AsmlistTypeStr[hal]);
  1181. end;
  1182. { add weak symbol markers }
  1183. for i:=0 to current_asmdata.asmsymboldict.count-1 do
  1184. if (tasmsymbol(current_asmdata.asmsymboldict[i]).bind=AB_WEAK_EXTERNAL) then
  1185. writeweaksymboldef(tasmsymbol(current_asmdata.asmsymboldict[i]));
  1186. if create_smartlink_sections and
  1187. (target_info.system in systems_darwin) then
  1188. AsmWriteLn(#9'.subsections_via_symbols');
  1189. { "no executable stack" marker for Linux }
  1190. if (target_info.system in systems_linux) and
  1191. not(cs_executable_stack in current_settings.moduleswitches) then
  1192. begin
  1193. AsmWriteLn('.section .note.GNU-stack,"",%progbits');
  1194. end;
  1195. AsmLn;
  1196. {$ifdef EXTDEBUG}
  1197. if assigned(current_module.mainsource) then
  1198. Comment(V_Debug,'Done writing gas-styled assembler output for '+current_module.mainsource^);
  1199. {$endif EXTDEBUG}
  1200. end;
  1201. {****************************************************************************}
  1202. { Apple/GNU Assembler writer }
  1203. {****************************************************************************}
  1204. function TAppleGNUAssembler.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;
  1205. begin
  1206. if (target_info.system in systems_darwin) then
  1207. case atype of
  1208. sec_bss:
  1209. { all bss (lcomm) symbols are automatically put in the right }
  1210. { place by using the lcomm assembler directive }
  1211. atype := sec_none;
  1212. sec_debug_frame,
  1213. sec_eh_frame:
  1214. begin
  1215. result := '.section __DWARF,__debug_info,regular,debug';
  1216. exit;
  1217. end;
  1218. sec_debug_line:
  1219. begin
  1220. result := '.section __DWARF,__debug_line,regular,debug';
  1221. exit;
  1222. end;
  1223. sec_debug_info:
  1224. begin
  1225. result := '.section __DWARF,__debug_info,regular,debug';
  1226. exit;
  1227. end;
  1228. sec_debug_abbrev:
  1229. begin
  1230. result := '.section __DWARF,__debug_abbrev,regular,debug';
  1231. exit;
  1232. end;
  1233. sec_rodata:
  1234. begin
  1235. result := '.const_data';
  1236. exit;
  1237. end;
  1238. sec_rodata_norel:
  1239. begin
  1240. result := '.const';
  1241. exit;
  1242. end;
  1243. sec_fpc:
  1244. begin
  1245. result := '.section __TEXT, .fpc, regular, no_dead_strip';
  1246. exit;
  1247. end;
  1248. sec_code:
  1249. begin
  1250. if (aname='fpc_geteipasebx') or
  1251. (aname='fpc_geteipasecx') then
  1252. begin
  1253. result:='.section __TEXT,__textcoal_nt,coalesced,pure_instructions'#10'.weak_definition '+aname+
  1254. #10'.private_extern '+aname;
  1255. exit;
  1256. end;
  1257. end;
  1258. sec_data_nonlazy:
  1259. begin
  1260. result:='.section __DATA, __nl_symbol_ptr,non_lazy_symbol_pointers';
  1261. exit;
  1262. end;
  1263. sec_data_lazy:
  1264. begin
  1265. result:='.section __DATA, __la_symbol_ptr,lazy_symbol_pointers';
  1266. exit;
  1267. end;
  1268. sec_init_func:
  1269. begin
  1270. result:='.section __DATA, __mod_init_func, mod_init_funcs';
  1271. exit;
  1272. end;
  1273. sec_term_func:
  1274. begin
  1275. result:='.section __DATA, __mod_term_func, mod_term_funcs';
  1276. exit;
  1277. end;
  1278. sec_objc_protocol_ext:
  1279. begin
  1280. result:='.section __OBJC, __protocol_ext, regular, no_dead_strip';
  1281. exit;
  1282. end;
  1283. sec_objc_class_ext:
  1284. begin
  1285. result:='.section __OBJC, __class_ext, regular, no_dead_strip';
  1286. exit;
  1287. end;
  1288. sec_objc_property:
  1289. begin
  1290. result:='.section __OBJC, __property, regular, no_dead_strip';
  1291. exit;
  1292. end;
  1293. sec_objc_image_info:
  1294. begin
  1295. result:='.section __OBJC, __image_info, regular, no_dead_strip';
  1296. exit;
  1297. end;
  1298. sec_objc_cstring_object:
  1299. begin
  1300. result:='.section __OBJC, __cstring_object, regular, no_dead_strip';
  1301. exit;
  1302. end;
  1303. sec_objc_sel_fixup:
  1304. begin
  1305. result:='.section __OBJC, __sel_fixup, regular, no_dead_strip';
  1306. exit;
  1307. end;
  1308. sec_objc_message_refs:
  1309. begin
  1310. if (target_info.system in systems_objc_nfabi) then
  1311. begin
  1312. result:='.section __DATA, __objc_selrefs, literal_pointers, no_dead_strip';
  1313. exit;
  1314. end;
  1315. end;
  1316. sec_objc_cls_refs:
  1317. begin
  1318. if (target_info.system in systems_objc_nfabi) then
  1319. begin
  1320. result:='.section __DATA, __objc_clsrefs, regular, no_dead_strip';
  1321. exit;
  1322. end;
  1323. end;
  1324. sec_objc_meth_var_names,
  1325. sec_objc_class_names:
  1326. begin
  1327. if (target_info.system in systems_objc_nfabi) then
  1328. begin
  1329. result:='.cstring';
  1330. exit
  1331. end;
  1332. end;
  1333. sec_objc_inst_meth,
  1334. sec_objc_cls_meth,
  1335. sec_objc_cat_inst_meth,
  1336. sec_objc_cat_cls_meth:
  1337. begin
  1338. if (target_info.system in systems_objc_nfabi) then
  1339. begin
  1340. result:='.section __DATA, __objc_const';
  1341. exit;
  1342. end;
  1343. end;
  1344. sec_objc_meta_class,
  1345. sec_objc_class:
  1346. begin
  1347. if (target_info.system in systems_objc_nfabi) then
  1348. begin
  1349. result:='.section __DATA, __objc_data';
  1350. exit;
  1351. end;
  1352. end;
  1353. sec_objc_sup_refs:
  1354. begin
  1355. result:='.section __DATA, __objc_superrefs, regular, no_dead_strip';
  1356. exit
  1357. end;
  1358. sec_objc_classlist:
  1359. begin
  1360. result:='.section __DATA, __objc_classlist, regular, no_dead_strip';
  1361. exit
  1362. end;
  1363. sec_objc_nlclasslist:
  1364. begin
  1365. result:='.section __DATA, __objc_nlclasslist, regular, no_dead_strip';
  1366. exit
  1367. end;
  1368. sec_objc_catlist:
  1369. begin
  1370. result:='.section __DATA, __objc_catlist, regular, no_dead_strip';
  1371. exit
  1372. end;
  1373. sec_objc_nlcatlist:
  1374. begin
  1375. result:='.section __DATA, __objc_nlcatlist, regular, no_dead_strip';
  1376. exit
  1377. end;
  1378. sec_objc_protolist:
  1379. begin
  1380. result:='.section __DATA, __objc_protolist, coalesced, no_dead_strip';
  1381. exit;
  1382. end;
  1383. end;
  1384. result := inherited sectionname(atype,aname,aorder);
  1385. end;
  1386. procedure TAppleGNUAssembler.WriteWeakSymbolDef(s: tasmsymbol);
  1387. begin
  1388. AsmWriteLn(#9'.weak_reference '+s.name);
  1389. end;
  1390. {****************************************************************************}
  1391. { a.out/GNU Assembler writer }
  1392. {****************************************************************************}
  1393. function TAoutGNUAssembler.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;
  1394. const
  1395. (* Translation table - replace unsupported section types with basic ones. *)
  1396. SecXTable: array[TAsmSectionType] of TAsmSectionType = (
  1397. sec_none,
  1398. sec_code,
  1399. sec_data,
  1400. sec_data (* sec_rodata *),
  1401. sec_data (* sec_rodata_norel *),
  1402. sec_bss,
  1403. sec_data (* sec_threadvar *),
  1404. { used for wince exception handling }
  1405. sec_code (* sec_pdata *),
  1406. { used for darwin import stubs }
  1407. sec_code (* sec_stub *),
  1408. sec_data,(* sec_data_nonlazy *)
  1409. sec_data,(* sec_data_lazy *)
  1410. sec_data,(* sec_init_func *)
  1411. sec_data,(* sec_term_func *)
  1412. { stabs }
  1413. sec_stab,sec_stabstr,
  1414. { win32 }
  1415. sec_data (* sec_idata2 *),
  1416. sec_data (* sec_idata4 *),
  1417. sec_data (* sec_idata5 *),
  1418. sec_data (* sec_idata6 *),
  1419. sec_data (* sec_idata7 *),
  1420. sec_data (* sec_edata *),
  1421. { C++ exception handling unwinding (uses dwarf) }
  1422. sec_eh_frame,
  1423. { dwarf }
  1424. sec_debug_frame,
  1425. sec_debug_info,
  1426. sec_debug_line,
  1427. sec_debug_abbrev,
  1428. { ELF resources (+ references to stabs debug information sections) }
  1429. sec_code (* sec_fpc *),
  1430. { Table of contents section }
  1431. sec_code (* sec_toc *),
  1432. sec_code (* sec_init *),
  1433. sec_code (* sec_fini *),
  1434. sec_none (* sec_objc_class *),
  1435. sec_none (* sec_objc_meta_class *),
  1436. sec_none (* sec_objc_cat_cls_meth *),
  1437. sec_none (* sec_objc_cat_inst_meth *),
  1438. sec_none (* sec_objc_protocol *),
  1439. sec_none (* sec_objc_string_object *),
  1440. sec_none (* sec_objc_cls_meth *),
  1441. sec_none (* sec_objc_inst_meth *),
  1442. sec_none (* sec_objc_cls_refs *),
  1443. sec_none (* sec_objc_message_refs *),
  1444. sec_none (* sec_objc_symbols *),
  1445. sec_none (* sec_objc_category *),
  1446. sec_none (* sec_objc_class_vars *),
  1447. sec_none (* sec_objc_instance_vars *),
  1448. sec_none (* sec_objc_module_info *),
  1449. sec_none (* sec_objc_class_names *),
  1450. sec_none (* sec_objc_meth_var_types *),
  1451. sec_none (* sec_objc_meth_var_names *),
  1452. sec_none (* sec_objc_selector_strs *),
  1453. sec_none (* sec_objc_protocol_ext *),
  1454. sec_none (* sec_objc_class_ext *),
  1455. sec_none (* sec_objc_property *),
  1456. sec_none (* sec_objc_image_info *),
  1457. sec_none (* sec_objc_cstring_object *),
  1458. sec_none (* sec_objc_sel_fixup *),
  1459. sec_none (* sec_objc_data *),
  1460. sec_none (* sec_objc_const *),
  1461. sec_none (* sec_objc_sup_refs *),
  1462. sec_none (* sec_data_coalesced *),
  1463. sec_none (* sec_objc_classlist *),
  1464. sec_none (* sec_objc_nlclasslist *),
  1465. sec_none (* sec_objc_catlist *),
  1466. sec_none (* sec_objc_nlcatlist *),
  1467. sec_none (* sec_objc_protlist *)
  1468. );
  1469. begin
  1470. Result := inherited SectionName (SecXTable [AType], AName, AOrder);
  1471. end;
  1472. {****************************************************************************}
  1473. { Abstract Instruction Writer }
  1474. {****************************************************************************}
  1475. constructor TCPUInstrWriter.create(_owner: TGNUAssembler);
  1476. begin
  1477. inherited create;
  1478. owner := _owner;
  1479. end;
  1480. end.