aggas.pas 66 KB

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