aggas.pas 55 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609
  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. { section type user gives the user full controll on the section name }
  368. if atype=sec_user then
  369. secname:=aname;
  370. { For bss we need to set some flags that are target dependent,
  371. it is easier to disable it for smartlinking. It doesn't take up
  372. filespace }
  373. if not(target_info.system in systems_darwin) and
  374. create_smartlink_sections and
  375. (aname<>'') and
  376. (atype<>sec_toc) and
  377. (atype<>sec_user) and
  378. { on embedded systems every byte counts, so smartlink bss too }
  379. ((atype<>sec_bss) or (target_info.system in systems_embedded)) then
  380. begin
  381. case aorder of
  382. secorder_begin :
  383. sep:='.b_';
  384. secorder_end :
  385. sep:='.z_';
  386. else
  387. sep:='.n_';
  388. end;
  389. result:=secname+sep+aname
  390. end
  391. else
  392. result:=secname;
  393. end;
  394. procedure TGNUAssembler.WriteSection(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder);
  395. var
  396. s : string;
  397. begin
  398. AsmLn;
  399. case target_info.system of
  400. system_i386_OS2,
  401. system_i386_EMX,
  402. system_m68k_amiga, { amiga has old GNU AS (2.14), which blews up from .section (KB) }
  403. system_m68k_linux: ;
  404. system_powerpc_darwin,
  405. system_i386_darwin,
  406. system_i386_iphonesim,
  407. system_powerpc64_darwin,
  408. system_x86_64_darwin,
  409. system_arm_darwin:
  410. begin
  411. if (atype in [sec_stub,sec_objc_data,sec_objc_const,sec_data_coalesced]) then
  412. AsmWrite('.section ');
  413. end
  414. else
  415. AsmWrite('.section ');
  416. end;
  417. s:=sectionname(atype,aname,aorder);
  418. AsmWrite(s);
  419. case atype of
  420. sec_fpc :
  421. if aname = 'resptrs' then
  422. AsmWrite(', "a", @progbits');
  423. sec_stub :
  424. begin
  425. case target_info.system of
  426. { there are processor-independent shortcuts available }
  427. { for this, namely .symbol_stub and .picsymbol_stub, but }
  428. { they don't work and gcc doesn't use them either... }
  429. system_powerpc_darwin,
  430. system_powerpc64_darwin:
  431. if (cs_create_pic in current_settings.moduleswitches) then
  432. AsmWriteln('__TEXT,__picsymbolstub1,symbol_stubs,pure_instructions,32')
  433. else
  434. AsmWriteln('__TEXT,__symbol_stub1,symbol_stubs,pure_instructions,16');
  435. system_i386_darwin,
  436. system_i386_iphonesim:
  437. AsmWriteln('__IMPORT,__jump_table,symbol_stubs,self_modifying_code+pure_instructions,5');
  438. system_arm_darwin:
  439. if (cs_create_pic in current_settings.moduleswitches) then
  440. AsmWriteln('.section __TEXT,__picsymbolstub4,symbol_stubs,none,16')
  441. else
  442. AsmWriteln('.section __TEXT,__symbol_stub4,symbol_stubs,none,12')
  443. { darwin/x86-64 uses RIP-based GOT addressing, no symbol stubs }
  444. else
  445. internalerror(2006031101);
  446. end;
  447. end;
  448. end;
  449. AsmLn;
  450. LastSecType:=atype;
  451. end;
  452. procedure TGNUAssembler.WriteDecodedUleb128(a: qword);
  453. var
  454. i,len : longint;
  455. buf : array[0..63] of byte;
  456. begin
  457. len:=EncodeUleb128(a,buf);
  458. for i:=0 to len-1 do
  459. begin
  460. if (i > 0) then
  461. AsmWrite(',');
  462. AsmWrite(tostr(buf[i]));
  463. end;
  464. end;
  465. procedure TGNUAssembler.WriteDecodedSleb128(a: int64);
  466. var
  467. i,len : longint;
  468. buf : array[0..255] of byte;
  469. begin
  470. len:=EncodeSleb128(a,buf);
  471. for i:=0 to len-1 do
  472. begin
  473. if (i > 0) then
  474. AsmWrite(',');
  475. AsmWrite(tostr(buf[i]));
  476. end;
  477. end;
  478. procedure TGNUAssembler.WriteTree(p:TAsmList);
  479. function needsObject(hp : tai_symbol) : boolean;
  480. begin
  481. needsObject :=
  482. (
  483. assigned(hp.next) and
  484. (tai(hp.next).typ in [ait_const,ait_datablock,
  485. ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit])
  486. ) or
  487. (hp.sym.typ=AT_DATA);
  488. end;
  489. procedure doalign(alignment: byte; use_op: boolean; fillop: byte; out last_align: longint);
  490. var
  491. i: longint;
  492. begin
  493. last_align:=alignment;
  494. if alignment>1 then
  495. begin
  496. if not(target_info.system in systems_darwin) then
  497. begin
  498. AsmWrite(#9'.balign '+tostr(alignment));
  499. if use_op then
  500. AsmWrite(','+tostr(fillop))
  501. {$ifdef x86}
  502. { force NOP as alignment op code }
  503. else if LastSecType=sec_code then
  504. AsmWrite(',0x90');
  505. {$endif x86}
  506. end
  507. else
  508. begin
  509. { darwin as only supports .align }
  510. if not ispowerof2(alignment,i) then
  511. internalerror(2003010305);
  512. AsmWrite(#9'.align '+tostr(i));
  513. last_align:=i;
  514. end;
  515. AsmLn;
  516. end;
  517. end;
  518. var
  519. ch : char;
  520. hp : tai;
  521. hp1 : tailineinfo;
  522. constdef : taiconst_type;
  523. s,t : string;
  524. i,pos,l : longint;
  525. InlineLevel : longint;
  526. last_align : longint;
  527. co : comp;
  528. sin : single;
  529. d : double;
  530. {$ifdef cpuextended}
  531. e : extended;
  532. {$endif cpuextended}
  533. do_line : boolean;
  534. sepChar : char;
  535. begin
  536. if not assigned(p) then
  537. exit;
  538. last_align := 2;
  539. InlineLevel:=0;
  540. { lineinfo is only needed for al_procedures (PFV) }
  541. do_line:=(cs_asm_source in current_settings.globalswitches) or
  542. ((cs_lineinfo in current_settings.moduleswitches)
  543. and (p=current_asmdata.asmlists[al_procedures]));
  544. hp:=tai(p.first);
  545. while assigned(hp) do
  546. begin
  547. prefetch(pointer(hp.next)^);
  548. if not(hp.typ in SkipLineInfo) then
  549. begin
  550. hp1 := hp as tailineinfo;
  551. current_filepos:=hp1.fileinfo;
  552. { no line info for inlined code }
  553. if do_line and (inlinelevel=0) then
  554. begin
  555. { load infile }
  556. if lastfileinfo.fileindex<>hp1.fileinfo.fileindex then
  557. begin
  558. infile:=current_module.sourcefiles.get_file(hp1.fileinfo.fileindex);
  559. if assigned(infile) then
  560. begin
  561. { open only if needed !! }
  562. if (cs_asm_source in current_settings.globalswitches) then
  563. infile.open;
  564. end;
  565. { avoid unnecessary reopens of the same file !! }
  566. lastfileinfo.fileindex:=hp1.fileinfo.fileindex;
  567. { be sure to change line !! }
  568. lastfileinfo.line:=-1;
  569. end;
  570. { write source }
  571. if (cs_asm_source in current_settings.globalswitches) and
  572. assigned(infile) then
  573. begin
  574. if (infile<>lastinfile) then
  575. begin
  576. AsmWriteLn(target_asm.comment+'['+infile.name^+']');
  577. if assigned(lastinfile) then
  578. lastinfile.close;
  579. end;
  580. if (hp1.fileinfo.line<>lastfileinfo.line) and
  581. ((hp1.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then
  582. begin
  583. if (hp1.fileinfo.line<>0) and
  584. ((infile.linebuf^[hp1.fileinfo.line]>=0) or (InlineLevel>0)) then
  585. AsmWriteLn(target_asm.comment+'['+tostr(hp1.fileinfo.line)+'] '+
  586. fixline(infile.GetLineStr(hp1.fileinfo.line)));
  587. { set it to a negative value !
  588. to make that is has been read already !! PM }
  589. if (infile.linebuf^[hp1.fileinfo.line]>=0) then
  590. infile.linebuf^[hp1.fileinfo.line]:=-infile.linebuf^[hp1.fileinfo.line]-1;
  591. end;
  592. end;
  593. lastfileinfo:=hp1.fileinfo;
  594. lastinfile:=infile;
  595. end;
  596. end;
  597. case hp.typ of
  598. ait_comment :
  599. Begin
  600. AsmWrite(target_asm.comment);
  601. AsmWritePChar(tai_comment(hp).str);
  602. AsmLn;
  603. End;
  604. ait_regalloc :
  605. begin
  606. if (cs_asm_regalloc in current_settings.globalswitches) then
  607. begin
  608. AsmWrite(#9+target_asm.comment+'Register ');
  609. repeat
  610. AsmWrite(std_regname(Tai_regalloc(hp).reg));
  611. if (hp.next=nil) or
  612. (tai(hp.next).typ<>ait_regalloc) or
  613. (tai_regalloc(hp.next).ratype<>tai_regalloc(hp).ratype) then
  614. break;
  615. hp:=tai(hp.next);
  616. AsmWrite(',');
  617. until false;
  618. AsmWrite(' ');
  619. AsmWriteLn(regallocstr[tai_regalloc(hp).ratype]);
  620. end;
  621. end;
  622. ait_tempalloc :
  623. begin
  624. if (cs_asm_tempalloc in current_settings.globalswitches) then
  625. begin
  626. {$ifdef EXTDEBUG}
  627. if assigned(tai_tempalloc(hp).problem) then
  628. AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+
  629. tostr(tai_tempalloc(hp).tempsize)+' '+tai_tempalloc(hp).problem^)
  630. else
  631. {$endif EXTDEBUG}
  632. AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+
  633. tostr(tai_tempalloc(hp).tempsize)+' '+tempallocstr[tai_tempalloc(hp).allocation]);
  634. end;
  635. end;
  636. ait_align :
  637. begin
  638. doalign(tai_align_abstract(hp).aligntype,tai_align_abstract(hp).use_op,tai_align_abstract(hp).fillop,last_align);
  639. end;
  640. ait_section :
  641. begin
  642. if tai_section(hp).sectype<>sec_none then
  643. WriteSection(tai_section(hp).sectype,tai_section(hp).name^,tai_section(hp).secorder)
  644. else
  645. begin
  646. {$ifdef EXTDEBUG}
  647. AsmWrite(target_asm.comment);
  648. AsmWriteln(' sec_none');
  649. {$endif EXTDEBUG}
  650. end;
  651. end;
  652. ait_datablock :
  653. begin
  654. if (target_info.system in systems_darwin) then
  655. begin
  656. { On Mac OS X you can't have common symbols in a shared library
  657. since those are in the TEXT section and the text section is
  658. read-only in shared libraries (so it can be shared among different
  659. processes). The alternate code creates some kind of common symbols
  660. in the data segment.
  661. }
  662. if tai_datablock(hp).is_global then
  663. begin
  664. asmwrite('.globl ');
  665. asmwriteln(tai_datablock(hp).sym.name);
  666. asmwriteln('.data');
  667. asmwrite('.zerofill __DATA, __common, ');
  668. asmwrite(tai_datablock(hp).sym.name);
  669. asmwriteln(', '+tostr(tai_datablock(hp).size)+','+tostr(last_align));
  670. if not(LastSecType in [sec_data,sec_none]) then
  671. writesection(LastSecType,'',secorder_default);
  672. end
  673. else
  674. begin
  675. asmwrite(#9'.lcomm'#9);
  676. asmwrite(tai_datablock(hp).sym.name);
  677. asmwrite(','+tostr(tai_datablock(hp).size));
  678. asmwrite(','+tostr(last_align));
  679. asmln;
  680. end;
  681. end
  682. else
  683. begin
  684. {$ifdef USE_COMM_IN_BSS}
  685. if writingpackages then
  686. begin
  687. { The .comm is required for COMMON symbols. These are used
  688. in the shared library loading. All the symbols declared in
  689. the .so file need to resolve to the data allocated in the main
  690. program (PFV) }
  691. if tai_datablock(hp).is_global then
  692. begin
  693. asmwrite(#9'.comm'#9);
  694. asmwrite(tai_datablock(hp).sym.name);
  695. asmwrite(','+tostr(tai_datablock(hp).size));
  696. asmwrite(','+tostr(last_align));
  697. asmln;
  698. end
  699. else
  700. begin
  701. asmwrite(#9'.lcomm'#9);
  702. asmwrite(tai_datablock(hp).sym.name);
  703. asmwrite(','+tostr(tai_datablock(hp).size));
  704. asmwrite(','+tostr(last_align));
  705. asmln;
  706. end
  707. end
  708. else
  709. {$endif USE_COMM_IN_BSS}
  710. begin
  711. if Tai_datablock(hp).is_global then
  712. begin
  713. asmwrite(#9'.globl ');
  714. asmwriteln(Tai_datablock(hp).sym.name);
  715. end;
  716. if (target_info.system <> system_arm_linux) then
  717. sepChar := '@'
  718. else
  719. sepChar := '%';
  720. if (tf_needs_symbol_type in target_info.flags) then
  721. asmwriteln(#9'.type '+Tai_datablock(hp).sym.name+','+sepChar+'object');
  722. if (tf_needs_symbol_size in target_info.flags) and (tai_datablock(hp).size > 0) then
  723. asmwriteln(#9'.size '+Tai_datablock(hp).sym.name+','+tostr(Tai_datablock(hp).size));
  724. asmwrite(Tai_datablock(hp).sym.name);
  725. asmwriteln(':');
  726. asmwriteln(#9'.zero '+tostr(Tai_datablock(hp).size));
  727. end;
  728. end;
  729. end;
  730. ait_const:
  731. begin
  732. constdef:=tai_const(hp).consttype;
  733. case constdef of
  734. {$ifndef cpu64bitaddr}
  735. aitconst_128bit :
  736. begin
  737. internalerror(200404291);
  738. end;
  739. aitconst_64bit :
  740. begin
  741. if assigned(tai_const(hp).sym) then
  742. internalerror(200404292);
  743. AsmWrite(ait_const2str[aitconst_32bit]);
  744. if target_info.endian = endian_little then
  745. begin
  746. AsmWrite(tostr(longint(lo(tai_const(hp).value))));
  747. AsmWrite(',');
  748. AsmWrite(tostr(longint(hi(tai_const(hp).value))));
  749. end
  750. else
  751. begin
  752. AsmWrite(tostr(longint(hi(tai_const(hp).value))));
  753. AsmWrite(',');
  754. AsmWrite(tostr(longint(lo(tai_const(hp).value))));
  755. end;
  756. AsmLn;
  757. end;
  758. {$endif cpu64bitaddr}
  759. aitconst_uleb128bit,
  760. aitconst_sleb128bit,
  761. {$ifdef cpu64bitaddr}
  762. aitconst_128bit,
  763. aitconst_64bit,
  764. {$endif cpu64bitaddr}
  765. aitconst_32bit,
  766. aitconst_16bit,
  767. aitconst_8bit,
  768. aitconst_rva_symbol,
  769. aitconst_secrel32_symbol,
  770. aitconst_darwin_dwarf_delta32,
  771. aitconst_darwin_dwarf_delta64:
  772. begin
  773. if (target_info.system in systems_darwin) and
  774. (constdef in [aitconst_uleb128bit,aitconst_sleb128bit]) then
  775. begin
  776. AsmWrite(ait_const2str[aitconst_8bit]);
  777. case tai_const(hp).consttype of
  778. aitconst_uleb128bit:
  779. WriteDecodedUleb128(qword(tai_const(hp).value));
  780. aitconst_sleb128bit:
  781. WriteDecodedSleb128(int64(tai_const(hp).value));
  782. end
  783. end
  784. else
  785. begin
  786. AsmWrite(ait_const2str[constdef]);
  787. l:=0;
  788. t := '';
  789. repeat
  790. if assigned(tai_const(hp).sym) then
  791. begin
  792. if assigned(tai_const(hp).endsym) then
  793. begin
  794. if (constdef in [aitconst_darwin_dwarf_delta32,aitconst_darwin_dwarf_delta64]) then
  795. begin
  796. s := NextSetLabel;
  797. t := #9'.set '+s+','+tai_const(hp).endsym.name+'-'+tai_const(hp).sym.name;
  798. end
  799. else
  800. s:=tai_const(hp).endsym.name+'-'+tai_const(hp).sym.name
  801. end
  802. else
  803. s:=tai_const(hp).sym.name;
  804. {$ifdef avr}
  805. s:=ReplaceForbiddenChars(s);
  806. {$endif avr}
  807. if tai_const(hp).value<>0 then
  808. s:=s+tostr_with_plus(tai_const(hp).value);
  809. end
  810. else
  811. {$ifdef cpu64bitaddr}
  812. s:=tostr(tai_const(hp).value);
  813. {$else cpu64bitaddr}
  814. { 64 bit constants are already handled above in this case }
  815. s:=tostr(longint(tai_const(hp).value));
  816. {$endif cpu64bitaddr}
  817. AsmWrite(s);
  818. inc(l,length(s));
  819. { Values with symbols are written on a single line to improve
  820. reading of the .s file (PFV) }
  821. if assigned(tai_const(hp).sym) or
  822. not(LastSecType in [sec_data,sec_rodata,sec_rodata_norel]) or
  823. (l>line_length) or
  824. (hp.next=nil) or
  825. (tai(hp.next).typ<>ait_const) or
  826. (tai_const(hp.next).consttype<>constdef) or
  827. assigned(tai_const(hp.next).sym) then
  828. break;
  829. hp:=tai(hp.next);
  830. AsmWrite(',');
  831. until false;
  832. if (t <> '') then
  833. begin
  834. AsmLn;
  835. AsmWrite(t);
  836. end;
  837. end;
  838. AsmLn;
  839. end;
  840. else
  841. internalerror(200704251);
  842. end;
  843. end;
  844. { the "and defined(FPC_HAS_TYPE_EXTENDED)" isn't optimal but currently the only solution
  845. it prevents proper cross compilation to i386 though
  846. }
  847. {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
  848. ait_real_80bit :
  849. begin
  850. if do_line then
  851. AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_real_80bit(hp).value));
  852. { Make sure e is a extended type, bestreal could be
  853. a different type (bestreal) !! (PFV) }
  854. e:=tai_real_80bit(hp).value;
  855. AsmWrite(#9'.byte'#9);
  856. for i:=0 to 9 do
  857. begin
  858. if i<>0 then
  859. AsmWrite(',');
  860. AsmWrite(tostr(t80bitarray(e)[i]));
  861. end;
  862. for i:=11 to tai_real_80bit(hp).savesize do
  863. AsmWrite(',0');
  864. AsmLn;
  865. end;
  866. {$endif cpuextended}
  867. ait_real_64bit :
  868. begin
  869. if do_line then
  870. AsmWriteLn(target_asm.comment+'value: '+double2str(tai_real_64bit(hp).value));
  871. d:=tai_real_64bit(hp).value;
  872. { swap the values to correct endian if required }
  873. if source_info.endian <> target_info.endian then
  874. swap64bitarray(t64bitarray(d));
  875. AsmWrite(#9'.byte'#9);
  876. {$ifdef arm}
  877. if tai_real_64bit(hp).formatoptions=fo_hiloswapped then
  878. begin
  879. for i:=4 to 7 do
  880. begin
  881. if i<>4 then
  882. AsmWrite(',');
  883. AsmWrite(tostr(t64bitarray(d)[i]));
  884. end;
  885. for i:=0 to 3 do
  886. begin
  887. AsmWrite(',');
  888. AsmWrite(tostr(t64bitarray(d)[i]));
  889. end;
  890. end
  891. else
  892. {$endif arm}
  893. begin
  894. for i:=0 to 7 do
  895. begin
  896. if i<>0 then
  897. AsmWrite(',');
  898. AsmWrite(tostr(t64bitarray(d)[i]));
  899. end;
  900. end;
  901. AsmLn;
  902. end;
  903. ait_real_32bit :
  904. begin
  905. if do_line then
  906. AsmWriteLn(target_asm.comment+'value: '+single2str(tai_real_32bit(hp).value));
  907. sin:=tai_real_32bit(hp).value;
  908. { swap the values to correct endian if required }
  909. if source_info.endian <> target_info.endian then
  910. swap32bitarray(t32bitarray(sin));
  911. AsmWrite(#9'.byte'#9);
  912. for i:=0 to 3 do
  913. begin
  914. if i<>0 then
  915. AsmWrite(',');
  916. AsmWrite(tostr(t32bitarray(sin)[i]));
  917. end;
  918. AsmLn;
  919. end;
  920. ait_comp_64bit :
  921. begin
  922. if do_line then
  923. AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_comp_64bit(hp).value));
  924. AsmWrite(#9'.byte'#9);
  925. co:=comp(tai_comp_64bit(hp).value);
  926. { swap the values to correct endian if required }
  927. if source_info.endian <> target_info.endian then
  928. swap64bitarray(t64bitarray(co));
  929. for i:=0 to 7 do
  930. begin
  931. if i<>0 then
  932. AsmWrite(',');
  933. AsmWrite(tostr(t64bitarray(co)[i]));
  934. end;
  935. AsmLn;
  936. end;
  937. ait_string :
  938. begin
  939. pos:=0;
  940. for i:=1 to tai_string(hp).len do
  941. begin
  942. if pos=0 then
  943. begin
  944. AsmWrite(#9'.ascii'#9'"');
  945. pos:=20;
  946. end;
  947. ch:=tai_string(hp).str[i-1];
  948. case ch of
  949. #0, {This can't be done by range, because a bug in FPC}
  950. #1..#31,
  951. #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7);
  952. '"' : s:='\"';
  953. '\' : s:='\\';
  954. else
  955. s:=ch;
  956. end;
  957. AsmWrite(s);
  958. inc(pos,length(s));
  959. if (pos>line_length) or (i=tai_string(hp).len) then
  960. begin
  961. AsmWriteLn('"');
  962. pos:=0;
  963. end;
  964. end;
  965. end;
  966. ait_label :
  967. begin
  968. if (tai_label(hp).labsym.is_used) then
  969. begin
  970. if (tai_label(hp).labsym.bind=AB_PRIVATE_EXTERN) then
  971. begin
  972. AsmWrite(#9'.private_extern ');
  973. AsmWriteln(tai_label(hp).labsym.name);
  974. end;
  975. if tai_label(hp).labsym.bind in [AB_GLOBAL,AB_PRIVATE_EXTERN] then
  976. begin
  977. AsmWrite('.globl'#9);
  978. {$ifdef avr}
  979. AsmWriteLn(ReplaceForbiddenChars(tai_label(hp).labsym.name));
  980. {$else avr}
  981. AsmWriteLn(tai_label(hp).labsym.name);
  982. {$endif avr}
  983. end;
  984. {$ifdef avr}
  985. AsmWrite(ReplaceForbiddenChars(tai_label(hp).labsym.name));
  986. {$else avr}
  987. AsmWrite(tai_label(hp).labsym.name);
  988. {$endif avr}
  989. AsmWriteLn(':');
  990. end;
  991. end;
  992. ait_symbol :
  993. begin
  994. if (tai_symbol(hp).sym.bind=AB_PRIVATE_EXTERN) then
  995. begin
  996. AsmWrite(#9'.private_extern ');
  997. {$ifdef avr}
  998. AsmWriteln(ReplaceForbiddenChars(tai_symbol(hp).sym.name));
  999. {$else avr}
  1000. AsmWriteln(tai_symbol(hp).sym.name);
  1001. {$endif avr}
  1002. end;
  1003. if (target_info.system = system_powerpc64_linux) and
  1004. (tai_symbol(hp).sym.typ = AT_FUNCTION) and (cs_profile in current_settings.moduleswitches) then
  1005. AsmWriteLn('.globl _mcount');
  1006. if tai_symbol(hp).is_global then
  1007. begin
  1008. AsmWrite('.globl'#9);
  1009. {$ifdef avr}
  1010. AsmWriteln(ReplaceForbiddenChars(tai_symbol(hp).sym.name));
  1011. {$else avr}
  1012. AsmWriteln(tai_symbol(hp).sym.name);
  1013. {$endif avr}
  1014. end;
  1015. if (target_info.system = system_powerpc64_linux) and
  1016. (tai_symbol(hp).sym.typ = AT_FUNCTION) then
  1017. begin
  1018. AsmWriteLn('.section ".opd", "aw"');
  1019. AsmWriteLn('.align 3');
  1020. AsmWriteLn(tai_symbol(hp).sym.name + ':');
  1021. AsmWriteLn('.quad .' + tai_symbol(hp).sym.name + ', .TOC.@tocbase, 0');
  1022. AsmWriteLn('.previous');
  1023. AsmWriteLn('.size ' + tai_symbol(hp).sym.name + ', 24');
  1024. if (tai_symbol(hp).is_global) then
  1025. AsmWriteLn('.globl .' + tai_symbol(hp).sym.name);
  1026. AsmWriteLn('.type .' + tai_symbol(hp).sym.name + ', @function');
  1027. { the dotted name is the name of the actual function entry }
  1028. AsmWrite('.');
  1029. end
  1030. else
  1031. begin
  1032. if (target_info.system <> system_arm_linux) then
  1033. sepChar := '@'
  1034. else
  1035. sepChar := '#';
  1036. if (tf_needs_symbol_type in target_info.flags) then
  1037. begin
  1038. AsmWrite(#9'.type'#9 + tai_symbol(hp).sym.name);
  1039. if (needsObject(tai_symbol(hp))) then
  1040. AsmWriteLn(',' + sepChar + 'object')
  1041. else
  1042. AsmWriteLn(',' + sepChar + 'function');
  1043. end;
  1044. end;
  1045. {$ifdef avr}
  1046. if not(tai_symbol(hp).has_value) then
  1047. AsmWriteLn(ReplaceForbiddenChars(tai_symbol(hp).sym.name + ':'))
  1048. else
  1049. AsmWriteLn(ReplaceForbiddenChars(tai_symbol(hp).sym.name + '=' + tostr(tai_symbol(hp).value)));
  1050. {$else avr}
  1051. if not(tai_symbol(hp).has_value) then
  1052. AsmWriteLn(tai_symbol(hp).sym.name + ':')
  1053. else
  1054. AsmWriteLn(tai_symbol(hp).sym.name + '=' + tostr(tai_symbol(hp).value));
  1055. {$endif avr}
  1056. end;
  1057. {$ifdef arm}
  1058. ait_thumb_func:
  1059. begin
  1060. AsmWriteLn(#9'.thumb_func');
  1061. end;
  1062. {$endif arm}
  1063. ait_symbol_end :
  1064. begin
  1065. if tf_needs_symbol_size in target_info.flags then
  1066. begin
  1067. s:=target_asm.labelprefix+'e'+tostr(symendcount);
  1068. inc(symendcount);
  1069. AsmWriteLn(s+':');
  1070. AsmWrite(#9'.size'#9);
  1071. if (target_info.system = system_powerpc64_linux) and (tai_symbol_end(hp).sym.typ = AT_FUNCTION) then
  1072. AsmWrite('.');
  1073. {$ifdef avr}
  1074. AsmWrite(ReplaceForbiddenChars(tai_symbol_end(hp).sym.name));
  1075. {$else avr}
  1076. AsmWrite(tai_symbol_end(hp).sym.name);
  1077. {$endif avr}
  1078. AsmWrite(', '+s+' - ');
  1079. if (target_info.system = system_powerpc64_linux) and (tai_symbol_end(hp).sym.typ = AT_FUNCTION) then
  1080. AsmWrite('.');
  1081. {$ifdef avr}
  1082. AsmWriteLn(ReplaceForbiddenChars(tai_symbol_end(hp).sym.name));
  1083. {$else avr}
  1084. AsmWriteLn(tai_symbol_end(hp).sym.name);
  1085. {$endif avr}
  1086. end;
  1087. end;
  1088. ait_instruction :
  1089. begin
  1090. WriteInstruction(hp);
  1091. end;
  1092. ait_stab :
  1093. begin
  1094. if assigned(tai_stab(hp).str) then
  1095. begin
  1096. AsmWrite(#9'.'+stabtypestr[tai_stab(hp).stabtype]+' ');
  1097. AsmWritePChar(tai_stab(hp).str);
  1098. AsmLn;
  1099. end;
  1100. end;
  1101. ait_force_line,
  1102. ait_function_name :
  1103. ;
  1104. ait_cutobject :
  1105. begin
  1106. if SmartAsm then
  1107. begin
  1108. { only reset buffer if nothing has changed }
  1109. if AsmSize=AsmStartSize then
  1110. AsmClear
  1111. else
  1112. begin
  1113. AsmClose;
  1114. DoAssemble;
  1115. AsmCreate(tai_cutobject(hp).place);
  1116. end;
  1117. { avoid empty files }
  1118. while assigned(hp.next) and (tai(hp.next).typ in [ait_cutobject,ait_section,ait_comment]) do
  1119. begin
  1120. if tai(hp.next).typ=ait_section then
  1121. LastSecType:=tai_section(hp.next).sectype;
  1122. hp:=tai(hp.next);
  1123. end;
  1124. if LastSecType<>sec_none then
  1125. WriteSection(LastSecType,'',secorder_default);
  1126. AsmStartSize:=AsmSize;
  1127. end;
  1128. end;
  1129. ait_marker :
  1130. if tai_marker(hp).kind=mark_NoLineInfoStart then
  1131. inc(InlineLevel)
  1132. else if tai_marker(hp).kind=mark_NoLineInfoEnd then
  1133. dec(InlineLevel);
  1134. ait_directive :
  1135. begin
  1136. AsmWrite('.'+directivestr[tai_directive(hp).directive]+' ');
  1137. if assigned(tai_directive(hp).name) then
  1138. AsmWrite(tai_directive(hp).name^);
  1139. AsmLn;
  1140. end;
  1141. else
  1142. internalerror(2006012201);
  1143. end;
  1144. hp:=tai(hp.next);
  1145. end;
  1146. end;
  1147. procedure TGNUAssembler.WriteExtraHeader;
  1148. begin
  1149. end;
  1150. procedure TGNUAssembler.WriteInstruction(hp: tai);
  1151. begin
  1152. InstrWriter.WriteInstruction(hp);
  1153. end;
  1154. procedure TGNUAssembler.WriteWeakSymbolDef(s: tasmsymbol);
  1155. begin
  1156. AsmWriteLn(#9'.weak '+s.name);
  1157. end;
  1158. procedure TGNUAssembler.WriteAsmList;
  1159. var
  1160. n : string;
  1161. hal : tasmlisttype;
  1162. i: longint;
  1163. begin
  1164. {$ifdef EXTDEBUG}
  1165. if assigned(current_module.mainsource) then
  1166. Comment(V_Debug,'Start writing gas-styled assembler output for '+current_module.mainsource^);
  1167. {$endif}
  1168. if assigned(current_module.mainsource) then
  1169. n:=ExtractFileName(current_module.mainsource^)
  1170. else
  1171. n:=InputFileName;
  1172. { gcc does not add it either for Darwin (and AIX). Grep for
  1173. TARGET_ASM_FILE_START_FILE_DIRECTIVE in gcc/config/*.h
  1174. }
  1175. if not(target_info.system in systems_darwin) then
  1176. AsmWriteLn(#9'.file "'+FixFileName(n)+'"');
  1177. WriteExtraHeader;
  1178. AsmStartSize:=AsmSize;
  1179. symendcount:=0;
  1180. for hal:=low(TasmlistType) to high(TasmlistType) do
  1181. begin
  1182. AsmWriteLn(target_asm.comment+'Begin asmlist '+AsmlistTypeStr[hal]);
  1183. writetree(current_asmdata.asmlists[hal]);
  1184. AsmWriteLn(target_asm.comment+'End asmlist '+AsmlistTypeStr[hal]);
  1185. end;
  1186. { add weak symbol markers }
  1187. for i:=0 to current_asmdata.asmsymboldict.count-1 do
  1188. if (tasmsymbol(current_asmdata.asmsymboldict[i]).bind=AB_WEAK_EXTERNAL) then
  1189. writeweaksymboldef(tasmsymbol(current_asmdata.asmsymboldict[i]));
  1190. if create_smartlink_sections and
  1191. (target_info.system in systems_darwin) then
  1192. AsmWriteLn(#9'.subsections_via_symbols');
  1193. { "no executable stack" marker for Linux }
  1194. if (target_info.system in systems_linux) and
  1195. not(cs_executable_stack in current_settings.moduleswitches) then
  1196. begin
  1197. AsmWriteLn('.section .note.GNU-stack,"",%progbits');
  1198. end;
  1199. AsmLn;
  1200. {$ifdef EXTDEBUG}
  1201. if assigned(current_module.mainsource) then
  1202. Comment(V_Debug,'Done writing gas-styled assembler output for '+current_module.mainsource^);
  1203. {$endif EXTDEBUG}
  1204. end;
  1205. {****************************************************************************}
  1206. { Apple/GNU Assembler writer }
  1207. {****************************************************************************}
  1208. function TAppleGNUAssembler.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;
  1209. begin
  1210. if (target_info.system in systems_darwin) then
  1211. case atype of
  1212. sec_bss:
  1213. { all bss (lcomm) symbols are automatically put in the right }
  1214. { place by using the lcomm assembler directive }
  1215. atype := sec_none;
  1216. sec_debug_frame,
  1217. sec_eh_frame:
  1218. begin
  1219. result := '.section __DWARF,__debug_info,regular,debug';
  1220. exit;
  1221. end;
  1222. sec_debug_line:
  1223. begin
  1224. result := '.section __DWARF,__debug_line,regular,debug';
  1225. exit;
  1226. end;
  1227. sec_debug_info:
  1228. begin
  1229. result := '.section __DWARF,__debug_info,regular,debug';
  1230. exit;
  1231. end;
  1232. sec_debug_abbrev:
  1233. begin
  1234. result := '.section __DWARF,__debug_abbrev,regular,debug';
  1235. exit;
  1236. end;
  1237. sec_rodata:
  1238. begin
  1239. result := '.const_data';
  1240. exit;
  1241. end;
  1242. sec_rodata_norel:
  1243. begin
  1244. result := '.const';
  1245. exit;
  1246. end;
  1247. sec_fpc:
  1248. begin
  1249. result := '.section __TEXT, .fpc, regular, no_dead_strip';
  1250. exit;
  1251. end;
  1252. sec_code:
  1253. begin
  1254. if (aname='fpc_geteipasebx') or
  1255. (aname='fpc_geteipasecx') then
  1256. begin
  1257. result:='.section __TEXT,__textcoal_nt,coalesced,pure_instructions'#10'.weak_definition '+aname+
  1258. #10'.private_extern '+aname;
  1259. exit;
  1260. end;
  1261. end;
  1262. sec_data_nonlazy:
  1263. begin
  1264. result:='.section __DATA, __nl_symbol_ptr,non_lazy_symbol_pointers';
  1265. exit;
  1266. end;
  1267. sec_data_lazy:
  1268. begin
  1269. result:='.section __DATA, __la_symbol_ptr,lazy_symbol_pointers';
  1270. exit;
  1271. end;
  1272. sec_init_func:
  1273. begin
  1274. result:='.section __DATA, __mod_init_func, mod_init_funcs';
  1275. exit;
  1276. end;
  1277. sec_term_func:
  1278. begin
  1279. result:='.section __DATA, __mod_term_func, mod_term_funcs';
  1280. exit;
  1281. end;
  1282. sec_objc_protocol_ext:
  1283. begin
  1284. result:='.section __OBJC, __protocol_ext, regular, no_dead_strip';
  1285. exit;
  1286. end;
  1287. sec_objc_class_ext:
  1288. begin
  1289. result:='.section __OBJC, __class_ext, regular, no_dead_strip';
  1290. exit;
  1291. end;
  1292. sec_objc_property:
  1293. begin
  1294. result:='.section __OBJC, __property, regular, no_dead_strip';
  1295. exit;
  1296. end;
  1297. sec_objc_image_info:
  1298. begin
  1299. result:='.section __OBJC, __image_info, regular, no_dead_strip';
  1300. exit;
  1301. end;
  1302. sec_objc_cstring_object:
  1303. begin
  1304. result:='.section __OBJC, __cstring_object, regular, no_dead_strip';
  1305. exit;
  1306. end;
  1307. sec_objc_sel_fixup:
  1308. begin
  1309. result:='.section __OBJC, __sel_fixup, regular, no_dead_strip';
  1310. exit;
  1311. end;
  1312. sec_objc_message_refs:
  1313. begin
  1314. if (target_info.system in systems_objc_nfabi) then
  1315. begin
  1316. result:='.section __DATA, __objc_selrefs, literal_pointers, no_dead_strip';
  1317. exit;
  1318. end;
  1319. end;
  1320. sec_objc_cls_refs:
  1321. begin
  1322. if (target_info.system in systems_objc_nfabi) then
  1323. begin
  1324. result:='.section __DATA, __objc_clsrefs, regular, no_dead_strip';
  1325. exit;
  1326. end;
  1327. end;
  1328. sec_objc_meth_var_names,
  1329. sec_objc_class_names:
  1330. begin
  1331. if (target_info.system in systems_objc_nfabi) then
  1332. begin
  1333. result:='.cstring';
  1334. exit
  1335. end;
  1336. end;
  1337. sec_objc_inst_meth,
  1338. sec_objc_cls_meth,
  1339. sec_objc_cat_inst_meth,
  1340. sec_objc_cat_cls_meth:
  1341. begin
  1342. if (target_info.system in systems_objc_nfabi) then
  1343. begin
  1344. result:='.section __DATA, __objc_const';
  1345. exit;
  1346. end;
  1347. end;
  1348. sec_objc_meta_class,
  1349. sec_objc_class:
  1350. begin
  1351. if (target_info.system in systems_objc_nfabi) then
  1352. begin
  1353. result:='.section __DATA, __objc_data';
  1354. exit;
  1355. end;
  1356. end;
  1357. sec_objc_sup_refs:
  1358. begin
  1359. result:='.section __DATA, __objc_superrefs, regular, no_dead_strip';
  1360. exit
  1361. end;
  1362. sec_objc_classlist:
  1363. begin
  1364. result:='.section __DATA, __objc_classlist, regular, no_dead_strip';
  1365. exit
  1366. end;
  1367. sec_objc_nlclasslist:
  1368. begin
  1369. result:='.section __DATA, __objc_nlclasslist, regular, no_dead_strip';
  1370. exit
  1371. end;
  1372. sec_objc_catlist:
  1373. begin
  1374. result:='.section __DATA, __objc_catlist, regular, no_dead_strip';
  1375. exit
  1376. end;
  1377. sec_objc_nlcatlist:
  1378. begin
  1379. result:='.section __DATA, __objc_nlcatlist, regular, no_dead_strip';
  1380. exit
  1381. end;
  1382. sec_objc_protolist:
  1383. begin
  1384. result:='.section __DATA, __objc_protolist, coalesced, no_dead_strip';
  1385. exit;
  1386. end;
  1387. end;
  1388. result := inherited sectionname(atype,aname,aorder);
  1389. end;
  1390. procedure TAppleGNUAssembler.WriteWeakSymbolDef(s: tasmsymbol);
  1391. begin
  1392. AsmWriteLn(#9'.weak_reference '+s.name);
  1393. end;
  1394. {****************************************************************************}
  1395. { a.out/GNU Assembler writer }
  1396. {****************************************************************************}
  1397. function TAoutGNUAssembler.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;
  1398. const
  1399. (* Translation table - replace unsupported section types with basic ones. *)
  1400. SecXTable: array[TAsmSectionType] of TAsmSectionType = (
  1401. sec_none,
  1402. sec_none,
  1403. sec_code,
  1404. sec_data,
  1405. sec_data (* sec_rodata *),
  1406. sec_data (* sec_rodata_norel *),
  1407. sec_bss,
  1408. sec_data (* sec_threadvar *),
  1409. { used for wince exception handling }
  1410. sec_code (* sec_pdata *),
  1411. { used for darwin import stubs }
  1412. sec_code (* sec_stub *),
  1413. sec_data,(* sec_data_nonlazy *)
  1414. sec_data,(* sec_data_lazy *)
  1415. sec_data,(* sec_init_func *)
  1416. sec_data,(* sec_term_func *)
  1417. { stabs }
  1418. sec_stab,sec_stabstr,
  1419. { win32 }
  1420. sec_data (* sec_idata2 *),
  1421. sec_data (* sec_idata4 *),
  1422. sec_data (* sec_idata5 *),
  1423. sec_data (* sec_idata6 *),
  1424. sec_data (* sec_idata7 *),
  1425. sec_data (* sec_edata *),
  1426. { C++ exception handling unwinding (uses dwarf) }
  1427. sec_eh_frame,
  1428. { dwarf }
  1429. sec_debug_frame,
  1430. sec_debug_info,
  1431. sec_debug_line,
  1432. sec_debug_abbrev,
  1433. { ELF resources (+ references to stabs debug information sections) }
  1434. sec_code (* sec_fpc *),
  1435. { Table of contents section }
  1436. sec_code (* sec_toc *),
  1437. sec_code (* sec_init *),
  1438. sec_code (* sec_fini *),
  1439. sec_none (* sec_objc_class *),
  1440. sec_none (* sec_objc_meta_class *),
  1441. sec_none (* sec_objc_cat_cls_meth *),
  1442. sec_none (* sec_objc_cat_inst_meth *),
  1443. sec_none (* sec_objc_protocol *),
  1444. sec_none (* sec_objc_string_object *),
  1445. sec_none (* sec_objc_cls_meth *),
  1446. sec_none (* sec_objc_inst_meth *),
  1447. sec_none (* sec_objc_cls_refs *),
  1448. sec_none (* sec_objc_message_refs *),
  1449. sec_none (* sec_objc_symbols *),
  1450. sec_none (* sec_objc_category *),
  1451. sec_none (* sec_objc_class_vars *),
  1452. sec_none (* sec_objc_instance_vars *),
  1453. sec_none (* sec_objc_module_info *),
  1454. sec_none (* sec_objc_class_names *),
  1455. sec_none (* sec_objc_meth_var_types *),
  1456. sec_none (* sec_objc_meth_var_names *),
  1457. sec_none (* sec_objc_selector_strs *),
  1458. sec_none (* sec_objc_protocol_ext *),
  1459. sec_none (* sec_objc_class_ext *),
  1460. sec_none (* sec_objc_property *),
  1461. sec_none (* sec_objc_image_info *),
  1462. sec_none (* sec_objc_cstring_object *),
  1463. sec_none (* sec_objc_sel_fixup *),
  1464. sec_none (* sec_objc_data *),
  1465. sec_none (* sec_objc_const *),
  1466. sec_none (* sec_objc_sup_refs *),
  1467. sec_none (* sec_data_coalesced *),
  1468. sec_none (* sec_objc_classlist *),
  1469. sec_none (* sec_objc_nlclasslist *),
  1470. sec_none (* sec_objc_catlist *),
  1471. sec_none (* sec_objc_nlcatlist *),
  1472. sec_none (* sec_objc_protlist *)
  1473. );
  1474. begin
  1475. Result := inherited SectionName (SecXTable [AType], AName, AOrder);
  1476. end;
  1477. {****************************************************************************}
  1478. { Abstract Instruction Writer }
  1479. {****************************************************************************}
  1480. constructor TCPUInstrWriter.create(_owner: TGNUAssembler);
  1481. begin
  1482. inherited create;
  1483. owner := _owner;
  1484. end;
  1485. end.