aggas.pas 65 KB

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