aggas.pas 57 KB

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