aggas.pas 55 KB

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