aggas.pas 80 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125
  1. { f
  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. { $define DEBUG_AGGAS}
  23. interface
  24. uses
  25. globtype,globals,
  26. cpubase,aasmbase,aasmtai,aasmdata,aasmcfi,
  27. {$ifdef wasm}
  28. aasmcpu,
  29. {$endif wasm}
  30. assemble;
  31. type
  32. TCPUInstrWriter = class;
  33. {# This is a derived class which is used to write
  34. GAS styled assembler.
  35. }
  36. { TGNUAssembler }
  37. TGNUAssembler=class(texternalassembler)
  38. protected
  39. function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;virtual;
  40. function sectionattrs(atype:TAsmSectiontype):string;virtual;
  41. function sectionattrs_coff(atype:TAsmSectiontype):string;virtual;
  42. function sectionalignment_aix(atype:TAsmSectiontype;secalign: longint):string;
  43. function sectionflags(secflags:TSectionFlags):string;virtual;
  44. procedure WriteSection(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder;secalign:longint;
  45. secflags:TSectionFlags=[];secprogbits:TSectionProgbits=SPB_None);virtual;
  46. procedure WriteExtraHeader;virtual;
  47. procedure WriteExtraFooter;virtual;
  48. procedure WriteInstruction(hp: tai);
  49. procedure WriteWeakSymbolRef(s: tasmsymbol); virtual;
  50. procedure WriteHiddenSymbol(sym: TAsmSymbol);
  51. procedure WriteAixStringConst(hp: tai_string);
  52. procedure WriteAixIntConst(hp: tai_const);
  53. procedure WriteUnalignedIntConst(hp: tai_const);
  54. procedure WriteDirectiveName(dir: TAsmDirective); virtual;
  55. public
  56. function MakeCmdLine: TCmdStr; override;
  57. procedure WriteTree(p:TAsmList);override;
  58. procedure WriteAsmList;override;
  59. destructor destroy; override;
  60. {$ifdef WASM}
  61. procedure WriteFuncType(functype: TWasmFuncType);
  62. {$endif WASM}
  63. private
  64. setcount: longint;
  65. procedure WriteCFI(hp: tai_cfi_base);
  66. function NextSetLabel: string;
  67. protected
  68. InstrWriter: TCPUInstrWriter;
  69. end;
  70. {# This is the base class for writing instructions.
  71. The WriteInstruction() method must be overridden
  72. to write a single instruction to the assembler
  73. file.
  74. }
  75. TCPUInstrWriter = class
  76. constructor create(_owner: TGNUAssembler);
  77. procedure WriteInstruction(hp : tai); virtual; abstract;
  78. protected
  79. owner: TGNUAssembler;
  80. end;
  81. { TAppleGNUAssembler }
  82. TAppleGNUAssembler=class(TGNUAssembler)
  83. protected
  84. function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override;
  85. procedure WriteWeakSymbolRef(s: tasmsymbol); override;
  86. procedure WriteDirectiveName(dir: TAsmDirective); override;
  87. end;
  88. TAoutGNUAssembler=class(TGNUAssembler)
  89. function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override;
  90. end;
  91. implementation
  92. uses
  93. SysUtils,
  94. cutils,cfileutl,systems,
  95. fmodule,verbose,
  96. {$ifndef DISABLE_WIN64_SEH}
  97. itcpugas,
  98. {$endif DISABLE_WIN64_SEH}
  99. {$ifdef m68k}
  100. cpuinfo,aasmcpu,
  101. {$endif m68k}
  102. objcasm;
  103. const
  104. line_length = 70;
  105. var
  106. symendcount : longint;
  107. {****************************************************************************}
  108. { Support routines }
  109. {****************************************************************************}
  110. const
  111. ait_const2str : array[aitconst_128bit..aitconst_64bit_unaligned] of string[20]=(
  112. #9'.fixme128'#9,#9'.quad'#9,#9'.long'#9,#9'.short'#9,#9'.byte'#9,
  113. #9'.sleb128'#9,#9'.uleb128'#9,
  114. #9'.rva'#9,#9'.secrel32'#9,#9'.quad'#9,#9'.long'#9,#9'.short'#9,#9'.short'#9,
  115. #9'.short'#9,#9'.long'#9,#9'.quad'#9
  116. );
  117. ait_solaris_const2str : array[aitconst_128bit..aitconst_64bit_unaligned] of string[20]=(
  118. #9'.fixme128'#9,#9'.8byte'#9,#9'.4byte'#9,#9'.2byte'#9,#9'.byte'#9,
  119. #9'.sleb128'#9,#9'.uleb128'#9,
  120. #9'.rva'#9,#9'.secrel32'#9,#9'.8byte'#9,#9'.4byte'#9,#9'.2byte'#9,#9'.2byte'#9,
  121. #9'.2byte'#9,#9'.4byte'#9,#9'.8byte'#9
  122. );
  123. ait_unaligned_consts = [aitconst_16bit_unaligned..aitconst_64bit_unaligned];
  124. { Sparc type of unaligned pseudo-instructions }
  125. use_ua_sparc_systems = [system_sparc_linux];
  126. ait_ua_sparc_const2str : array[aitconst_16bit_unaligned..aitconst_64bit_unaligned]
  127. of string[20]=(
  128. #9'.uahalf'#9,#9'.uaword'#9,#9'.uaxword'#9
  129. );
  130. { Generic unaligned pseudo-instructions, seems ELF specific }
  131. use_ua_elf_systems = [system_mipsel_linux,system_mipseb_linux,system_mipsel_android,system_mipsel_embedded,system_mipseb_embedded];
  132. ait_ua_elf_const2str : array[aitconst_128bit..aitconst_64bit_unaligned] of string[20]=(
  133. #9'.fixme128'#9,#9'.8byte'#9,#9'.4byte'#9,#9'.2byte'#9,#9'.byte'#9,
  134. #9'.sleb128'#9,#9'.uleb128'#9,
  135. #9'.rva'#9,#9'.secrel32'#9,#9'.8byte'#9,#9'.4byte'#9,#9'.2byte'#9,#9'.2byte'#9,
  136. #9'.2byte'#9,#9'.4byte'#9,#9'.8byte'#9
  137. );
  138. {****************************************************************************}
  139. { GNU Assembler writer }
  140. {****************************************************************************}
  141. destructor TGNUAssembler.Destroy;
  142. begin
  143. InstrWriter.free;
  144. inherited destroy;
  145. end;
  146. function TGNUAssembler.MakeCmdLine: TCmdStr;
  147. begin
  148. result := inherited MakeCmdLine;
  149. // MWE: disabled again. It generates dwarf info for the generated .s
  150. // files as well. This conflicts with the info we generate
  151. // if target_dbg.id = dbg_dwarf then
  152. // result := result + ' --gdwarf-2';
  153. end;
  154. function TGNUAssembler.NextSetLabel: string;
  155. begin
  156. inc(setcount);
  157. result := asminfo^.labelprefix+'$set$'+tostr(setcount);
  158. end;
  159. function is_smart_section(atype:TAsmSectiontype):boolean;
  160. begin
  161. { For bss we need to set some flags that are target dependent,
  162. it is easier to disable it for smartlinking. It doesn't take up
  163. filespace }
  164. result:=not(target_info.system in systems_darwin) and
  165. create_smartlink_sections and
  166. (atype<>sec_toc) and
  167. (atype<>sec_user) and
  168. { on embedded systems every byte counts, so smartlink bss too }
  169. ((atype<>sec_bss) or (target_info.system in (systems_embedded+systems_freertos)));
  170. end;
  171. function TGNUAssembler.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;
  172. const
  173. secnames : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('','',
  174. '.text',
  175. '.data',
  176. { why doesn't .rodata work? (FK) }
  177. { sometimes we have to create a data.rel.ro instead of .rodata, e.g. for }
  178. { vtables (and anything else containing relocations), otherwise those are }
  179. { not relocated properly on e.g. linux/ppc64. g++ generates there for a }
  180. { vtable for a class called Window: }
  181. { .section .data.rel.ro._ZTV6Window,"awG",@progbits,_ZTV6Window,comdat }
  182. { TODO: .data.ro not yet working}
  183. {$if defined(arm) or defined(riscv64) or defined(powerpc)}
  184. '.rodata',
  185. {$else defined(arm) or defined(riscv64) or defined(powerpc)}
  186. '.data',
  187. {$endif defined(arm) or defined(riscv64) or defined(powerpc)}
  188. '.rodata',
  189. '.bss',
  190. '.threadvar',
  191. '.pdata',
  192. '', { stubs }
  193. '__DATA,__nl_symbol_ptr',
  194. '__DATA,__la_symbol_ptr',
  195. '__DATA,__mod_init_func',
  196. '__DATA,__mod_term_func',
  197. '.stab',
  198. '.stabstr',
  199. '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
  200. '.eh_frame',
  201. '.debug_frame','.debug_info','.debug_line','.debug_abbrev','.debug_aranges','.debug_ranges',
  202. '.fpc',
  203. '.toc',
  204. '.init',
  205. '.fini',
  206. '.objc_class',
  207. '.objc_meta_class',
  208. '.objc_cat_cls_meth',
  209. '.objc_cat_inst_meth',
  210. '.objc_protocol',
  211. '.objc_string_object',
  212. '.objc_cls_meth',
  213. '.objc_inst_meth',
  214. '.objc_cls_refs',
  215. '.objc_message_refs',
  216. '.objc_symbols',
  217. '.objc_category',
  218. '.objc_class_vars',
  219. '.objc_instance_vars',
  220. '.objc_module_info',
  221. '.objc_class_names',
  222. '.objc_meth_var_types',
  223. '.objc_meth_var_names',
  224. '.objc_selector_strs',
  225. '.objc_protocol_ext',
  226. '.objc_class_ext',
  227. '.objc_property',
  228. '.objc_image_info',
  229. '.objc_cstring_object',
  230. '.objc_sel_fixup',
  231. '__DATA,__objc_data',
  232. '__DATA,__objc_const',
  233. '.objc_superrefs',
  234. '__DATA, __datacoal_nt,coalesced',
  235. '.objc_classlist',
  236. '.objc_nlclasslist',
  237. '.objc_catlist',
  238. '.obcj_nlcatlist',
  239. '.objc_protolist',
  240. '.stack',
  241. '.heap',
  242. '.gcc_except_table',
  243. '.ARM.attributes'
  244. );
  245. secnames_pic : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('','',
  246. '.text',
  247. '.data.rel',
  248. '.data.rel',
  249. '.data.rel',
  250. '.bss',
  251. '.threadvar',
  252. '.pdata',
  253. '', { stubs }
  254. '__DATA,__nl_symbol_ptr',
  255. '__DATA,__la_symbol_ptr',
  256. '__DATA,__mod_init_func',
  257. '__DATA,__mod_term_func',
  258. '.stab',
  259. '.stabstr',
  260. '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
  261. '.eh_frame',
  262. '.debug_frame','.debug_info','.debug_line','.debug_abbrev','.debug_aranges','.debug_ranges',
  263. '.fpc',
  264. '.toc',
  265. '.init',
  266. '.fini',
  267. '.objc_class',
  268. '.objc_meta_class',
  269. '.objc_cat_cls_meth',
  270. '.objc_cat_inst_meth',
  271. '.objc_protocol',
  272. '.objc_string_object',
  273. '.objc_cls_meth',
  274. '.objc_inst_meth',
  275. '.objc_cls_refs',
  276. '.objc_message_refs',
  277. '.objc_symbols',
  278. '.objc_category',
  279. '.objc_class_vars',
  280. '.objc_instance_vars',
  281. '.objc_module_info',
  282. '.objc_class_names',
  283. '.objc_meth_var_types',
  284. '.objc_meth_var_names',
  285. '.objc_selector_strs',
  286. '.objc_protocol_ext',
  287. '.objc_class_ext',
  288. '.objc_property',
  289. '.objc_image_info',
  290. '.objc_cstring_object',
  291. '.objc_sel_fixup',
  292. '__DATA, __objc_data',
  293. '__DATA, __objc_const',
  294. '.objc_superrefs',
  295. '__DATA, __datacoal_nt,coalesced',
  296. '.objc_classlist',
  297. '.objc_nlclasslist',
  298. '.objc_catlist',
  299. '.obcj_nlcatlist',
  300. '.objc_protolist',
  301. '.stack',
  302. '.heap',
  303. '.gcc_except_table',
  304. '..ARM.attributes'
  305. );
  306. var
  307. sep : string[3];
  308. secname : string;
  309. begin
  310. if (cs_create_pic in current_settings.moduleswitches) and
  311. not(target_info.system in systems_darwin) then
  312. secname:=secnames_pic[atype]
  313. else
  314. secname:=secnames[atype];
  315. if (atype=sec_fpc) and (Copy(aname,1,3)='res') then
  316. begin
  317. result:=secname+'.'+aname;
  318. exit;
  319. end;
  320. if atype=sec_threadvar then
  321. begin
  322. if (target_info.system in (systems_windows+systems_wince)) then
  323. secname:='.tls'
  324. else if (target_info.system in systems_linux) then
  325. secname:='.tbss';
  326. end;
  327. { go32v2 stub only loads .text and .data sections, and allocates space for .bss.
  328. Thus, data which normally goes into .rodata and .rodata_norel sections must
  329. end up in .data section }
  330. if (atype in [sec_rodata,sec_rodata_norel]) and
  331. (target_info.system in [system_i386_go32v2,system_m68k_palmos]) then
  332. secname:='.data';
  333. { Windows correctly handles reallocations in readonly sections }
  334. if (atype=sec_rodata) and
  335. (target_info.system in systems_all_windows+systems_nativent-[system_i8086_win16]) then
  336. secname:='.rodata';
  337. { Use .rodata and .data.rel.ro for Android with PIC }
  338. if (target_info.system in systems_android) and (cs_create_pic in current_settings.moduleswitches) then
  339. begin
  340. case atype of
  341. sec_rodata:
  342. secname:='.data.rel.ro';
  343. sec_rodata_norel:
  344. secname:='.rodata';
  345. else
  346. ;
  347. end;
  348. end;
  349. { section type user gives the user full controll on the section name }
  350. if atype=sec_user then
  351. secname:=aname;
  352. if is_smart_section(atype) and (aname<>'') then
  353. begin
  354. case aorder of
  355. secorder_begin :
  356. sep:='.b_';
  357. secorder_end :
  358. sep:='.z_';
  359. else
  360. sep:='.n_';
  361. end;
  362. result:=secname+sep+aname
  363. end
  364. else
  365. result:=secname;
  366. end;
  367. function TGNUAssembler.sectionattrs(atype:TAsmSectiontype):string;
  368. begin
  369. result:='';
  370. if (target_info.system in [system_i386_win32,system_x86_64_win64,system_aarch64_win64]) then
  371. begin
  372. result:=sectionattrs_coff(atype);
  373. end;
  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. if target_info.system=system_aarch64_win64 then
  389. result:='r'
  390. else
  391. result:='d';
  392. sec_bss:
  393. result:='b';
  394. { TODO: Somewhat questionable. FPC does not allow initialized threadvars,
  395. so no sense to mark it as containing data. But Windows allows it to
  396. contain data, and Linux even has .tdata and .tbss }
  397. sec_threadvar:
  398. result:='b';
  399. sec_pdata, sec_edata, sec_eh_frame, sec_toc:
  400. result:='r';
  401. sec_stab,sec_stabstr,
  402. sec_debug_frame,sec_debug_info,sec_debug_line,sec_debug_abbrev,sec_debug_aranges,sec_debug_ranges:
  403. result:='n';
  404. else
  405. result:=''; { defaults to data+load }
  406. end;
  407. end;
  408. function TGNUAssembler.sectionflags(secflags:TSectionFlags):string;
  409. var
  410. secflag : TSectionFlag;
  411. begin
  412. result:='';
  413. for secflag in secflags do begin
  414. case secflag of
  415. SF_A:
  416. result:=result+'a';
  417. SF_W:
  418. result:=result+'w';
  419. SF_X:
  420. result:=result+'x';
  421. end;
  422. end;
  423. end;
  424. function TGNUAssembler.sectionalignment_aix(atype:TAsmSectiontype;secalign: longint): string;
  425. var
  426. l: longint;
  427. begin
  428. if (secalign=0) or
  429. not(atype in [sec_code,sec_bss,sec_rodata_norel,sec_rodata,sec_data]) then
  430. begin
  431. result:='';
  432. exit;
  433. end;
  434. if not ispowerof2(secalign,l) then
  435. internalerror(2012022201);
  436. result:=tostr(l);
  437. end;
  438. procedure TGNUAssembler.WriteSection(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder;secalign:longint;secflags:TSectionFlags=[];secprogbits:TSectionProgbits=SPB_None);
  439. var
  440. s : string;
  441. usesectionprogbits,
  442. usesectionflags: boolean;
  443. begin
  444. writer.AsmLn;
  445. usesectionflags:=false;
  446. usesectionprogbits:=false;
  447. case target_info.system of
  448. system_i386_OS2,
  449. system_i386_EMX: ;
  450. system_m68k_atari, { atari tos/mint GNU AS also doesn't seem to like .section (KB) }
  451. system_m68k_amiga, { amiga has old GNU AS (2.14), which blews up from .section (KB) }
  452. system_m68k_sinclairql: { same story, only ancient GNU tools available (KB) }
  453. begin
  454. { ... but vasm is GAS compatible on amiga/atari, and supports named sections }
  455. if create_smartlink_sections then
  456. begin
  457. writer.AsmWrite('.section ');
  458. usesectionflags:=true;
  459. usesectionprogbits:=true;
  460. { hack, to avoid linker warnings on Amiga/Atari, when vlink merges
  461. rodata sections into data sections. Also avoid the warning when
  462. the linker realizes the code section cannot be write protected and
  463. adds the writable bit. }
  464. if atype in [sec_code,sec_rodata,sec_rodata_norel] then
  465. include(secflags,SF_W);
  466. end;
  467. end;
  468. system_i386_go32v2,
  469. system_i386_win32,
  470. system_x86_64_win64,
  471. system_i386_wince,
  472. system_arm_wince,
  473. system_aarch64_win64:
  474. begin
  475. { according to the GNU AS guide AS for COFF does not support the
  476. progbits }
  477. writer.AsmWrite('.section ');
  478. usesectionflags:=true;
  479. end;
  480. system_powerpc_darwin,
  481. system_i386_darwin,
  482. system_i386_iphonesim,
  483. system_powerpc64_darwin,
  484. system_x86_64_darwin,
  485. system_arm_ios,
  486. system_aarch64_ios,
  487. system_aarch64_darwin,
  488. system_x86_64_iphonesim,
  489. system_powerpc_aix,
  490. system_powerpc64_aix:
  491. begin
  492. if (atype in [sec_stub]) then
  493. writer.AsmWrite('.section ');
  494. end;
  495. system_wasm32_wasi,
  496. system_wasm32_embedded:
  497. begin
  498. writer.AsmWrite('.section ');
  499. end
  500. else
  501. begin
  502. writer.AsmWrite('.section ');
  503. { sectionname may rename those sections, so we do not write flags/progbits for them,
  504. the assembler will ignore them/spite out a warning anyways }
  505. if not(atype in [sec_data,sec_rodata,sec_rodata_norel]) then
  506. begin
  507. usesectionflags:=true;
  508. usesectionprogbits:=true;
  509. end;
  510. end
  511. end;
  512. s:=sectionname(atype,aname,aorder);
  513. writer.AsmWrite(s);
  514. { flags explicitly defined? }
  515. if (usesectionflags or usesectionprogbits) and
  516. ((secflags<>[]) or
  517. (secprogbits<>SPB_None)) then
  518. begin
  519. if usesectionflags then
  520. begin
  521. s:=',"'+sectionflags(secflags);
  522. writer.AsmWrite(s+'"');
  523. end;
  524. if usesectionprogbits then
  525. begin
  526. case secprogbits of
  527. SPB_PROGBITS:
  528. writer.AsmWrite(',%progbits');
  529. SPB_NOBITS:
  530. writer.AsmWrite(',%nobits');
  531. SPB_NOTE:
  532. writer.AsmWrite(',%note');
  533. SPB_None:
  534. ;
  535. else
  536. InternalError(2019100801);
  537. end;
  538. end;
  539. end
  540. else
  541. case atype of
  542. sec_fpc :
  543. if aname = 'resptrs' then
  544. writer.AsmWrite(', "a", @progbits');
  545. sec_stub :
  546. begin
  547. case target_info.system of
  548. { there are processor-independent shortcuts available }
  549. { for this, namely .symbol_stub and .picsymbol_stub, but }
  550. { they don't work and gcc doesn't use them either... }
  551. system_powerpc_darwin,
  552. system_powerpc64_darwin:
  553. if (cs_create_pic in current_settings.moduleswitches) then
  554. writer.AsmWriteln('__TEXT,__picsymbolstub1,symbol_stubs,pure_instructions,32')
  555. else
  556. writer.AsmWriteln('__TEXT,__symbol_stub1,symbol_stubs,pure_instructions,16');
  557. system_i386_darwin,
  558. system_i386_iphonesim:
  559. writer.AsmWriteln('__IMPORT,__jump_table,symbol_stubs,self_modifying_code+pure_instructions,5');
  560. system_arm_ios:
  561. if (cs_create_pic in current_settings.moduleswitches) then
  562. writer.AsmWriteln('__TEXT,__picsymbolstub4,symbol_stubs,none,16')
  563. else
  564. writer.AsmWriteln('__TEXT,__symbol_stub4,symbol_stubs,none,12')
  565. { darwin/(x86-64/AArch64) uses PC-based GOT addressing, no
  566. explicit symbol stubs }
  567. else
  568. internalerror(2006031101);
  569. end;
  570. end;
  571. else
  572. { GNU AS won't recognize '.text.n_something' section name as belonging
  573. to '.text' and assigns default attributes to it, which is not
  574. always correct. We have to fix it.
  575. TODO: This likely applies to all systems which smartlink without
  576. creating libraries }
  577. begin
  578. if is_smart_section(atype) and (aname<>'') then
  579. begin
  580. s:=sectionattrs(atype);
  581. if (s<>'') then
  582. writer.AsmWrite(',"'+s+'"');
  583. end;
  584. if target_info.system in systems_aix then
  585. begin
  586. s:=sectionalignment_aix(atype,secalign);
  587. if s<>'' then
  588. writer.AsmWrite(','+s);
  589. end;
  590. end;
  591. end;
  592. writer.AsmLn;
  593. LastSecType:=atype;
  594. end;
  595. procedure TGNUAssembler.WriteCFI(hp: tai_cfi_base);
  596. begin
  597. writer.AsmWrite(cfi2str[hp.cfityp]);
  598. case hp.cfityp of
  599. cfi_startproc,
  600. cfi_endproc:
  601. ;
  602. cfi_undefined,
  603. cfi_restore,
  604. cfi_def_cfa_register:
  605. begin
  606. writer.AsmWrite(' ');
  607. writer.AsmWrite(gas_regname(tai_cfi_op_reg(hp).reg1));
  608. end;
  609. cfi_def_cfa_offset:
  610. begin
  611. writer.AsmWrite(' ');
  612. writer.AsmWrite(tostr(tai_cfi_op_val(hp).val1));
  613. end;
  614. cfi_offset:
  615. begin
  616. writer.AsmWrite(' ');
  617. writer.AsmWrite(gas_regname(tai_cfi_op_reg_val(hp).reg1));
  618. writer.AsmWrite(',');
  619. writer.AsmWrite(tostr(tai_cfi_op_reg_val(hp).val));
  620. end;
  621. else
  622. internalerror(2019030203);
  623. end;
  624. writer.AsmLn;
  625. end;
  626. {$ifdef WASM}
  627. procedure TGNUAssembler.WriteFuncType(functype: TWasmFuncType);
  628. var
  629. wasm_basic_typ: TWasmBasicType;
  630. first: boolean;
  631. begin
  632. writer.AsmWrite('(');
  633. first:=true;
  634. for wasm_basic_typ in functype.params do
  635. begin
  636. if first then
  637. first:=false
  638. else
  639. writer.AsmWrite(',');
  640. writer.AsmWrite(gas_wasm_basic_type_str[wasm_basic_typ]);
  641. end;
  642. writer.AsmWrite(') -> (');
  643. first:=true;
  644. for wasm_basic_typ in functype.results do
  645. begin
  646. if first then
  647. first:=false
  648. else
  649. writer.AsmWrite(',');
  650. writer.AsmWrite(gas_wasm_basic_type_str[wasm_basic_typ]);
  651. end;
  652. writer.AsmWrite(')');
  653. end;
  654. {$endif WASM}
  655. procedure TGNUAssembler.WriteTree(p:TAsmList);
  656. function needsObject(hp : tai_symbol) : boolean;
  657. begin
  658. needsObject :=
  659. (
  660. assigned(hp.next) and
  661. (tai(hp.next).typ in [ait_const,ait_datablock,ait_realconst])
  662. ) or
  663. (hp.sym.typ in [AT_DATA,AT_METADATA]);
  664. end;
  665. procedure doalign(alignment: byte; use_op: boolean; fillop: byte; maxbytes: byte; out last_align: longint;lasthp:tai);
  666. var
  667. i: longint;
  668. alignment64 : int64;
  669. {$ifdef m68k}
  670. instr : string;
  671. {$endif}
  672. begin
  673. last_align:=alignment;
  674. if alignment>1 then
  675. begin
  676. if not(target_info.system in (systems_darwin+systems_aix)) then
  677. begin
  678. {$ifdef m68k}
  679. if not use_op and (lastsectype=sec_code) then
  680. begin
  681. if not ispowerof2(alignment,i) then
  682. internalerror(2014022201);
  683. { the Coldfire manual suggests the TBF instruction for
  684. alignments, but somehow QEMU does not interpret that
  685. correctly... }
  686. {if current_settings.cputype in cpu_coldfire then
  687. instr:='0x51fc'
  688. else}
  689. instr:='0x4e71';
  690. writer.AsmWrite(#9'.balignw '+tostr(alignment)+','+instr);
  691. end
  692. else
  693. begin
  694. {$endif m68k}
  695. alignment64:=alignment;
  696. if (maxbytes<>alignment) and ispowerof2(alignment64,i) then
  697. begin
  698. if use_op then
  699. begin
  700. writer.AsmWrite(#9'.p2align '+tostr(i)+','+tostr(fillop)+','+tostr(maxbytes));
  701. writer.AsmLn;
  702. writer.AsmWrite(#9'.p2align '+tostr(i-1)+','+tostr(fillop));
  703. end
  704. else
  705. begin
  706. writer.AsmWrite(#9'.p2align '+tostr(i)+',,'+tostr(maxbytes));
  707. writer.AsmLn;
  708. writer.AsmWrite(#9'.p2align '+tostr(i-1));
  709. end
  710. end
  711. else
  712. begin
  713. writer.AsmWrite(#9'.balign '+tostr(alignment));
  714. if use_op then
  715. writer.AsmWrite(','+tostr(fillop))
  716. {$ifdef x86}
  717. { force NOP as alignment op code }
  718. else if (LastSecType=sec_code) and (asminfo^.id<>as_solaris_as) then
  719. writer.AsmWrite(',0x90');
  720. {$endif x86}
  721. end;
  722. {$ifdef m68k}
  723. end;
  724. {$endif m68k}
  725. end
  726. else
  727. begin
  728. { darwin and aix as only support .align }
  729. if not ispowerof2(alignment,i) then
  730. internalerror(2003010305);
  731. writer.AsmWrite(#9'.align '+tostr(i));
  732. last_align:=i;
  733. end;
  734. writer.AsmLn;
  735. end;
  736. end;
  737. {$ifdef WASM}
  738. procedure WriteFuncTypeDirective(hp:tai_functype);
  739. begin
  740. writer.AsmWrite(#9'.functype'#9);
  741. writer.AsmWrite(hp.funcname);
  742. writer.AsmWrite(' ');
  743. WriteFuncType(hp.functype);
  744. writer.AsmLn;
  745. end;
  746. procedure WriteImportExport(hp:tai_impexp);
  747. var
  748. symstypestr: string;
  749. begin
  750. Str(hp.symstype,symstypestr);
  751. writer.AsmWriteLn(asminfo^.comment+'ait_importexport(extname='''+hp.extname+''', intname='''+hp.intname+''', extmodule='''+hp.extmodule+''', symstype='+symstypestr+')');
  752. if hp.extmodule='' then
  753. writer.AsmWriteLn(#9'.export_name '+hp.intname+', '+hp.extname);
  754. end;
  755. {$endif WASM}
  756. var
  757. ch : char;
  758. lasthp,
  759. hp : tai;
  760. constdef : taiconst_type;
  761. s,t : string;
  762. i,pos,l : longint;
  763. InlineLevel : cardinal;
  764. last_align : longint;
  765. do_line : boolean;
  766. sepChar : char;
  767. replaceforbidden: boolean;
  768. begin
  769. if not assigned(p) then
  770. exit;
  771. replaceforbidden:=asminfo^.dollarsign<>'$';
  772. last_align := 2;
  773. InlineLevel:=0;
  774. { lineinfo is only needed for al_procedures (PFV) }
  775. do_line:=(cs_asm_source in current_settings.globalswitches) or
  776. ((cs_lineinfo in current_settings.moduleswitches)
  777. and (p=current_asmdata.asmlists[al_procedures]));
  778. lasthp:=nil;
  779. hp:=tai(p.first);
  780. while assigned(hp) do
  781. begin
  782. prefetch(pointer(hp.next)^);
  783. if not(hp.typ in SkipLineInfo) then
  784. begin
  785. current_filepos:=tailineinfo(hp).fileinfo;
  786. { no line info for inlined code }
  787. if do_line and (inlinelevel=0) then
  788. WriteSourceLine(hp as tailineinfo);
  789. end;
  790. case hp.typ of
  791. ait_align :
  792. begin
  793. doalign(tai_align_abstract(hp).aligntype,tai_align_abstract(hp).use_op,tai_align_abstract(hp).fillop,tai_align_abstract(hp).maxbytes,last_align,lasthp);
  794. end;
  795. ait_section :
  796. begin
  797. if tai_section(hp).sectype<>sec_none then
  798. if replaceforbidden then
  799. WriteSection(tai_section(hp).sectype,ApplyAsmSymbolRestrictions(tai_section(hp).name^),tai_section(hp).secorder,
  800. tai_section(hp).secalign,tai_section(hp).secflags,tai_section(hp).secprogbits)
  801. else
  802. WriteSection(tai_section(hp).sectype,tai_section(hp).name^,tai_section(hp).secorder,
  803. tai_section(hp).secalign,tai_section(hp).secflags,tai_section(hp).secprogbits)
  804. else
  805. begin
  806. {$ifdef EXTDEBUG}
  807. writer.AsmWrite(asminfo^.comment);
  808. writer.AsmWriteln(' sec_none');
  809. {$endif EXTDEBUG}
  810. end;
  811. end;
  812. ait_datablock :
  813. begin
  814. if (target_info.system in systems_darwin) then
  815. begin
  816. { On Mac OS X you can't have common symbols in a shared library
  817. since those are in the TEXT section and the text section is
  818. read-only in shared libraries (so it can be shared among different
  819. processes). The alternate code creates some kind of common symbols
  820. in the data segment.
  821. }
  822. if tai_datablock(hp).is_global then
  823. begin
  824. if tai_datablock(hp).sym.bind=AB_PRIVATE_EXTERN then
  825. WriteHiddenSymbol(tai_datablock(hp).sym);
  826. writer.AsmWrite('.globl ');
  827. writer.AsmWriteln(tai_datablock(hp).sym.name);
  828. writer.AsmWriteln('.data');
  829. writer.AsmWrite('.zerofill __DATA, __common, ');
  830. writer.AsmWrite(tai_datablock(hp).sym.name);
  831. writer.AsmWriteln(', '+tostr(tai_datablock(hp).size)+','+tostr(last_align));
  832. if not(LastSecType in [sec_data,sec_none]) then
  833. writesection(LastSecType,'',secorder_default,1 shl last_align);
  834. end
  835. else
  836. begin
  837. writer.AsmWrite(#9'.lcomm'#9);
  838. writer.AsmWrite(tai_datablock(hp).sym.name);
  839. writer.AsmWrite(','+tostr(tai_datablock(hp).size));
  840. writer.AsmWrite(','+tostr(last_align));
  841. writer.AsmLn;
  842. end;
  843. end
  844. else if target_info.system in systems_aix then
  845. begin
  846. if tai_datablock(hp).is_global then
  847. begin
  848. writer.AsmWrite(#9'.globl ');
  849. writer.AsmWriteln(ApplyAsmSymbolRestrictions(tai_datablock(hp).sym.name));
  850. writer.AsmWrite(ApplyAsmSymbolRestrictions(tai_datablock(hp).sym.name));
  851. writer.AsmWriteln(':');
  852. writer.AsmWrite(#9'.space ');
  853. writer.AsmWriteln(tostr(tai_datablock(hp).size));
  854. if not(LastSecType in [sec_data,sec_none]) then
  855. writesection(LastSecType,'',secorder_default,1 shl last_align);
  856. end
  857. else
  858. begin
  859. writer.AsmWrite(#9'.lcomm ');
  860. writer.AsmWrite(ApplyAsmSymbolRestrictions(tai_datablock(hp).sym.name));
  861. writer.AsmWrite(',');
  862. writer.AsmWrite(tostr(tai_datablock(hp).size)+',');
  863. writer.AsmWrite('_data.bss_,');
  864. writer.AsmWriteln(tostr(last_align));
  865. end;
  866. end
  867. else
  868. begin
  869. {$ifdef USE_COMM_IN_BSS}
  870. if writingpackages then
  871. begin
  872. { The .comm is required for COMMON symbols. These are used
  873. in the shared library loading. All the symbols declared in
  874. the .so file need to resolve to the data allocated in the main
  875. program (PFV) }
  876. if tai_datablock(hp).is_global then
  877. begin
  878. writer.AsmWrite(#9'.comm'#9);
  879. if replaceforbidden then
  880. writer.AsmWrite(ApplyAsmSymbolRestrictions(tai_datablock(hp).sym.name))
  881. else
  882. writer.AsmWrite(tai_datablock(hp).sym.name);
  883. writer.AsmWrite(','+tostr(tai_datablock(hp).size));
  884. writer.AsmWrite(','+tostr(last_align));
  885. writer.AsmLn;
  886. end
  887. else
  888. begin
  889. writer.AsmWrite(#9'.lcomm'#9);
  890. if replaceforbidden then
  891. writer.AsmWrite(ApplyAsmSymbolRestrictions(tai_datablock(hp).sym.name));
  892. else
  893. writer.AsmWrite(tai_datablock(hp).sym.name);
  894. writer.AsmWrite(','+tostr(tai_datablock(hp).size));
  895. writer.AsmWrite(','+tostr(last_align));
  896. writer.AsmLn;
  897. end
  898. end
  899. else
  900. {$endif USE_COMM_IN_BSS}
  901. begin
  902. if Tai_datablock(hp).is_global then
  903. begin
  904. if (tai_datablock(hp).sym.bind=AB_PRIVATE_EXTERN) then
  905. WriteHiddenSymbol(tai_datablock(hp).sym);
  906. writer.AsmWrite(#9'.globl ');
  907. if replaceforbidden then
  908. writer.AsmWriteln(ApplyAsmSymbolRestrictions(Tai_datablock(hp).sym.name))
  909. else
  910. writer.AsmWriteln(Tai_datablock(hp).sym.name);
  911. end;
  912. if ((target_info.system <> system_arm_linux) and (target_info.system <> system_arm_android)) then
  913. sepChar := '@'
  914. else
  915. sepChar := '%';
  916. if replaceforbidden then
  917. begin
  918. if (tf_needs_symbol_type in target_info.flags) then
  919. writer.AsmWriteln(#9'.type '+ApplyAsmSymbolRestrictions(Tai_datablock(hp).sym.name)+','+sepChar+'object');
  920. if (tf_needs_symbol_size in target_info.flags) and (tai_datablock(hp).size > 0) then
  921. writer.AsmWriteln(#9'.size '+ApplyAsmSymbolRestrictions(Tai_datablock(hp).sym.name)+','+tostr(Tai_datablock(hp).size));
  922. writer.AsmWrite(ApplyAsmSymbolRestrictions(Tai_datablock(hp).sym.name))
  923. end
  924. else
  925. begin
  926. if (tf_needs_symbol_type in target_info.flags) then
  927. writer.AsmWriteln(#9'.type '+Tai_datablock(hp).sym.name+','+sepChar+'object');
  928. if (tf_needs_symbol_size in target_info.flags) and (tai_datablock(hp).size > 0) then
  929. writer.AsmWriteln(#9'.size '+Tai_datablock(hp).sym.name+','+tostr(Tai_datablock(hp).size));
  930. writer.AsmWrite(Tai_datablock(hp).sym.name);
  931. end;
  932. writer.AsmWriteln(':');
  933. writer.AsmWriteln(#9'.zero '+tostr(Tai_datablock(hp).size));
  934. end;
  935. end;
  936. end;
  937. ait_const:
  938. begin
  939. constdef:=tai_const(hp).consttype;
  940. case constdef of
  941. {$ifndef cpu64bitaddr}
  942. aitconst_128bit :
  943. begin
  944. internalerror(200404291);
  945. end;
  946. aitconst_64bit :
  947. begin
  948. if assigned(tai_const(hp).sym) then
  949. internalerror(200404292);
  950. if not(target_info.system in systems_aix) then
  951. begin
  952. writer.AsmWrite(ait_const2str[aitconst_32bit]);
  953. if target_info.endian = endian_little then
  954. begin
  955. writer.AsmWrite(tostr(longint(lo(tai_const(hp).value))));
  956. writer.AsmWrite(',');
  957. writer.AsmWrite(tostr(longint(hi(tai_const(hp).value))));
  958. end
  959. else
  960. begin
  961. writer.AsmWrite(tostr(longint(hi(tai_const(hp).value))));
  962. writer.AsmWrite(',');
  963. writer.AsmWrite(tostr(longint(lo(tai_const(hp).value))));
  964. end;
  965. end
  966. else
  967. WriteAixIntConst(tai_const(hp));
  968. writer.AsmLn;
  969. end;
  970. aitconst_gottpoff:
  971. begin
  972. writer.AsmWrite(#9'.word'#9+tai_const(hp).sym.name+'(gottpoff)+(.-'+tai_const(hp).endsym.name+tostr_with_plus(tai_const(hp).symofs)+')');
  973. writer.Asmln;
  974. end;
  975. aitconst_tlsgd:
  976. begin
  977. writer.AsmWrite(#9'.word'#9+tai_const(hp).sym.name+'(tlsgd)+(.-'+tai_const(hp).endsym.name+tostr_with_plus(tai_const(hp).symofs)+')');
  978. writer.Asmln;
  979. end;
  980. aitconst_tlsdesc:
  981. begin
  982. writer.AsmWrite(#9'.word'#9+tai_const(hp).sym.name+'(tlsdesc)+(.-'+tai_const(hp).endsym.name+tostr_with_plus(tai_const(hp).symofs)+')');
  983. writer.Asmln;
  984. end;
  985. aitconst_tpoff:
  986. begin
  987. if assigned(tai_const(hp).endsym) or (tai_const(hp).symofs<>0) then
  988. Internalerror(2019092805);
  989. writer.AsmWrite(#9'.word'#9+tai_const(hp).sym.name+'(tpoff)');
  990. writer.Asmln;
  991. end;
  992. {$endif cpu64bitaddr}
  993. aitconst_dtpoff:
  994. begin
  995. {$ifdef arm}
  996. writer.AsmWrite(#9'.word'#9+tai_const(hp).sym.name+'(tlsldo)');
  997. writer.Asmln;
  998. {$endif arm}
  999. {$ifdef x86_64}
  1000. writer.AsmWrite(#9'.long'#9+tai_const(hp).sym.name+'@dtpoff');
  1001. writer.Asmln;
  1002. {$endif x86_64}
  1003. {$ifdef i386}
  1004. writer.AsmWrite(#9'.word'#9+tai_const(hp).sym.name+'@tdpoff');
  1005. writer.Asmln;
  1006. {$endif i386}
  1007. end;
  1008. aitconst_got:
  1009. begin
  1010. if tai_const(hp).symofs<>0 then
  1011. InternalError(2015091401); // No symbol offset is allowed for GOT.
  1012. writer.AsmWrite(#9'.word'#9+tai_const(hp).sym.name+'(GOT)');
  1013. writer.AsmLn;
  1014. end;
  1015. aitconst_gotoff_symbol:
  1016. begin
  1017. if (tai_const(hp).sym=nil) then
  1018. InternalError(2014022601);
  1019. case target_info.cpu of
  1020. cpu_mipseb,cpu_mipsel:
  1021. begin
  1022. writer.AsmWrite(#9'.gpword'#9);
  1023. writer.AsmWrite(tai_const(hp).sym.name);
  1024. end;
  1025. cpu_i386:
  1026. begin
  1027. writer.AsmWrite(ait_const2str[aitconst_32bit]);
  1028. writer.AsmWrite(tai_const(hp).sym.name+'-_GLOBAL_OFFSET_TABLE_');
  1029. end;
  1030. else
  1031. InternalError(2014022602);
  1032. end;
  1033. if (tai_const(hp).value<>0) then
  1034. writer.AsmWrite(tostr_with_plus(tai_const(hp).value));
  1035. writer.AsmLn;
  1036. end;
  1037. aitconst_uleb128bit,
  1038. aitconst_sleb128bit,
  1039. {$ifdef cpu64bitaddr}
  1040. aitconst_128bit,
  1041. aitconst_64bit,
  1042. {$endif cpu64bitaddr}
  1043. aitconst_32bit,
  1044. aitconst_16bit,
  1045. aitconst_8bit,
  1046. aitconst_rva_symbol,
  1047. aitconst_secrel32_symbol,
  1048. aitconst_darwin_dwarf_delta32,
  1049. aitconst_darwin_dwarf_delta64,
  1050. aitconst_half16bit,
  1051. aitconst_gs,
  1052. aitconst_16bit_unaligned,
  1053. aitconst_32bit_unaligned,
  1054. aitconst_64bit_unaligned:
  1055. begin
  1056. { the AIX assembler (and for compatibility, the GNU
  1057. assembler when targeting AIX) automatically aligns
  1058. .short/.long/.llong to a multiple of 2/4/8 bytes. We
  1059. don't want that, since this may be data inside a packed
  1060. record -> use .vbyte instead (byte stream of fixed
  1061. length) }
  1062. if (target_info.system in systems_aix) and
  1063. (constdef in [aitconst_128bit,aitconst_64bit,aitconst_32bit,aitconst_16bit]) and
  1064. not assigned(tai_const(hp).sym) then
  1065. begin
  1066. WriteAixIntConst(tai_const(hp));
  1067. end
  1068. else if (target_info.system in systems_darwin) and
  1069. (constdef in [aitconst_uleb128bit,aitconst_sleb128bit]) then
  1070. begin
  1071. writer.AsmWrite(ait_const2str[aitconst_8bit]);
  1072. case tai_const(hp).consttype of
  1073. aitconst_uleb128bit:
  1074. writer.AsmWrite(uleb128tostr(qword(tai_const(hp).value)));
  1075. aitconst_sleb128bit:
  1076. writer.AsmWrite(sleb128tostr(tai_const(hp).value));
  1077. else
  1078. ;
  1079. end
  1080. end
  1081. else
  1082. begin
  1083. if (constdef in ait_unaligned_consts) and
  1084. (target_info.system in use_ua_sparc_systems) then
  1085. writer.AsmWrite(ait_ua_sparc_const2str[constdef])
  1086. else if (target_info.system in use_ua_elf_systems) then
  1087. writer.AsmWrite(ait_ua_elf_const2str[constdef])
  1088. { we can also have unaligned pointers in packed record
  1089. constants, which don't get translated into
  1090. unaligned tai -> always use vbyte }
  1091. else if target_info.system in systems_aix then
  1092. writer.AsmWrite(#9'.vbyte'#9+tostr(tai_const(hp).size)+',')
  1093. else if (asminfo^.id=as_solaris_as) then
  1094. writer.AsmWrite(ait_solaris_const2str[constdef])
  1095. else
  1096. writer.AsmWrite(ait_const2str[constdef]);
  1097. l:=0;
  1098. t := '';
  1099. repeat
  1100. if assigned(tai_const(hp).sym) then
  1101. begin
  1102. if assigned(tai_const(hp).endsym) then
  1103. begin
  1104. if (constdef in [aitconst_darwin_dwarf_delta32,aitconst_darwin_dwarf_delta64]) then
  1105. begin
  1106. s := NextSetLabel;
  1107. t := #9'.set '+s+','+tai_const(hp).endsym.name+'-'+tai_const(hp).sym.name;
  1108. end
  1109. else
  1110. s:=tai_const(hp).endsym.name+'-'+tai_const(hp).sym.name
  1111. end
  1112. else
  1113. s:=tai_const(hp).sym.name;
  1114. if replaceforbidden then
  1115. s:=ApplyAsmSymbolRestrictions(s);
  1116. if tai_const(hp).value<>0 then
  1117. s:=s+tostr_with_plus(tai_const(hp).value);
  1118. end
  1119. else
  1120. {$ifdef cpu64bitaddr}
  1121. s:=tostr(tai_const(hp).value);
  1122. {$else cpu64bitaddr}
  1123. { 64 bit constants are already handled above in this case }
  1124. s:=tostr(longint(tai_const(hp).value));
  1125. {$endif cpu64bitaddr}
  1126. if constdef = aitconst_half16bit then
  1127. s:='('+s+')/2';
  1128. if constdef = aitconst_gs then
  1129. s:='gs('+s+')';
  1130. writer.AsmWrite(s);
  1131. inc(l,length(s));
  1132. { Values with symbols are written on a single line to improve
  1133. reading of the .s file (PFV) }
  1134. if assigned(tai_const(hp).sym) or
  1135. not(LastSecType in [sec_data,sec_rodata,sec_rodata_norel]) or
  1136. (l>line_length) or
  1137. (hp.next=nil) or
  1138. (tai(hp.next).typ<>ait_const) or
  1139. (tai_const(hp.next).consttype<>constdef) or
  1140. assigned(tai_const(hp.next).sym) then
  1141. break;
  1142. hp:=tai(hp.next);
  1143. writer.AsmWrite(',');
  1144. until false;
  1145. if (t <> '') then
  1146. begin
  1147. writer.AsmLn;
  1148. writer.AsmWrite(t);
  1149. end;
  1150. end;
  1151. writer.AsmLn;
  1152. end;
  1153. else
  1154. internalerror(200704251);
  1155. end;
  1156. end;
  1157. ait_realconst :
  1158. begin
  1159. WriteRealConstAsBytes(tai_realconst(hp),#9'.byte'#9,do_line);
  1160. end;
  1161. ait_string :
  1162. begin
  1163. pos:=0;
  1164. if not(target_info.system in systems_aix) then
  1165. begin
  1166. for i:=1 to tai_string(hp).len do
  1167. begin
  1168. if pos=0 then
  1169. begin
  1170. writer.AsmWrite(#9'.ascii'#9'"');
  1171. pos:=20;
  1172. end;
  1173. ch:=tai_string(hp).str[i-1];
  1174. case ch of
  1175. #0, {This can't be done by range, because a bug in FPC}
  1176. #1..#31,
  1177. #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7);
  1178. '"' : s:='\"';
  1179. '\' : s:='\\';
  1180. else
  1181. s:=ch;
  1182. end;
  1183. writer.AsmWrite(s);
  1184. inc(pos,length(s));
  1185. if (pos>line_length) or (i=tai_string(hp).len) then
  1186. begin
  1187. writer.AsmWriteLn('"');
  1188. pos:=0;
  1189. end;
  1190. end;
  1191. end
  1192. else
  1193. WriteAixStringConst(tai_string(hp));
  1194. end;
  1195. ait_label :
  1196. begin
  1197. if (tai_label(hp).labsym.is_used) then
  1198. begin
  1199. {$ifdef DEBUG_LABEL}
  1200. writer.AsmWrite(asminfo^.comment);
  1201. writer.AsmWriteLn('References = ' + tostr(tai_label(hp).labsym.getrefs));
  1202. {$endif DEBUG_LABEL}
  1203. if tai_label(hp).labsym.bind in [AB_GLOBAL,AB_PRIVATE_EXTERN] then
  1204. begin
  1205. if (tai_label(hp).labsym.bind=AB_PRIVATE_EXTERN) then
  1206. begin
  1207. writer.AsmWrite(#9'.private_extern ');
  1208. writer.AsmWriteln(tai_label(hp).labsym.name);
  1209. end;
  1210. {$ifdef arm}
  1211. { do no change arm mode accidently, .globl seems to reset the mode }
  1212. if GenerateThumbCode or GenerateThumb2Code then
  1213. writer.AsmWriteln(#9'.thumb_func'#9);
  1214. {$endif arm}
  1215. writer.AsmWrite('.globl'#9);
  1216. if replaceforbidden then
  1217. writer.AsmWriteLn(ApplyAsmSymbolRestrictions(tai_label(hp).labsym.name))
  1218. else
  1219. writer.AsmWriteLn(tai_label(hp).labsym.name);
  1220. end;
  1221. if replaceforbidden then
  1222. writer.AsmWrite(ApplyAsmSymbolRestrictions(tai_label(hp).labsym.name))
  1223. else
  1224. writer.AsmWrite(tai_label(hp).labsym.name);
  1225. writer.AsmWriteLn(':');
  1226. end;
  1227. end;
  1228. ait_symbol :
  1229. begin
  1230. if (target_info.system=system_powerpc64_linux) and
  1231. (tai_symbol(hp).sym.typ=AT_FUNCTION) and
  1232. (cs_profile in current_settings.moduleswitches) then
  1233. writer.AsmWriteLn('.globl _mcount');
  1234. if tai_symbol(hp).is_global then
  1235. begin
  1236. writer.AsmWrite('.globl'#9);
  1237. if replaceforbidden then
  1238. writer.AsmWriteln(ApplyAsmSymbolRestrictions(tai_symbol(hp).sym.name))
  1239. else
  1240. writer.AsmWriteln(tai_symbol(hp).sym.name);
  1241. if (tai_symbol(hp).sym.bind=AB_PRIVATE_EXTERN) then
  1242. WriteHiddenSymbol(tai_symbol(hp).sym);
  1243. end;
  1244. if (target_info.system=system_powerpc64_linux) and
  1245. use_dotted_functions and
  1246. (tai_symbol(hp).sym.typ=AT_FUNCTION) then
  1247. begin
  1248. writer.AsmWriteLn('.section ".opd", "aw"');
  1249. writer.AsmWriteLn('.align 3');
  1250. writer.AsmWriteLn(tai_symbol(hp).sym.name + ':');
  1251. writer.AsmWriteLn('.quad .' + tai_symbol(hp).sym.name + ', .TOC.@tocbase, 0');
  1252. writer.AsmWriteLn('.previous');
  1253. writer.AsmWriteLn('.size ' + tai_symbol(hp).sym.name + ', 24');
  1254. if (tai_symbol(hp).is_global) then
  1255. writer.AsmWriteLn('.globl .' + tai_symbol(hp).sym.name);
  1256. writer.AsmWriteLn('.type .' + tai_symbol(hp).sym.name + ', @function');
  1257. { the dotted name is the name of the actual function entry }
  1258. writer.AsmWrite('.');
  1259. end
  1260. else if (target_info.system in systems_aix) and
  1261. (tai_symbol(hp).sym.typ = AT_FUNCTION) then
  1262. begin
  1263. if target_info.system=system_powerpc_aix then
  1264. begin
  1265. s:=#9'.long .';
  1266. ch:='2';
  1267. end
  1268. else
  1269. begin
  1270. s:=#9'.llong .';
  1271. ch:='3';
  1272. end;
  1273. writer.AsmWriteLn(#9'.csect '+ApplyAsmSymbolRestrictions(tai_symbol(hp).sym.name)+'[DS],'+ch);
  1274. writer.AsmWriteLn(ApplyAsmSymbolRestrictions(tai_symbol(hp).sym.name)+':');
  1275. writer.AsmWriteln(s+ApplyAsmSymbolRestrictions(tai_symbol(hp).sym.name)+', TOC[tc0], 0');
  1276. writer.AsmWriteln(#9'.csect .text[PR]');
  1277. if (tai_symbol(hp).is_global) then
  1278. writer.AsmWriteLn('.globl .'+ApplyAsmSymbolRestrictions(tai_symbol(hp).sym.name))
  1279. else
  1280. writer.AsmWriteLn('.lglobl .'+ApplyAsmSymbolRestrictions(tai_symbol(hp).sym.name));
  1281. { the dotted name is the name of the actual function entry }
  1282. writer.AsmWrite('.');
  1283. end
  1284. else
  1285. begin
  1286. if ((target_info.system <> system_arm_linux) and (target_info.system <> system_arm_android)) or
  1287. (target_asm.id=as_arm_vasm) then
  1288. sepChar := '@'
  1289. else
  1290. sepChar := '#';
  1291. if (tf_needs_symbol_type in target_info.flags) then
  1292. begin
  1293. writer.AsmWrite(#9'.type'#9 + tai_symbol(hp).sym.name);
  1294. if (needsObject(tai_symbol(hp))) then
  1295. writer.AsmWriteLn(',' + sepChar + 'object')
  1296. else
  1297. writer.AsmWriteLn(',' + sepChar + 'function');
  1298. end;
  1299. end;
  1300. if replaceforbidden then
  1301. if not(tai_symbol(hp).has_value) then
  1302. writer.AsmWriteLn(ApplyAsmSymbolRestrictions(tai_symbol(hp).sym.name + ':'))
  1303. else
  1304. writer.AsmWriteLn(ApplyAsmSymbolRestrictions(tai_symbol(hp).sym.name + '=' + tostr(tai_symbol(hp).value)))
  1305. else if not(tai_symbol(hp).has_value) then
  1306. writer.AsmWriteLn(tai_symbol(hp).sym.name + ':')
  1307. else
  1308. writer.AsmWriteLn(tai_symbol(hp).sym.name + '=' + tostr(tai_symbol(hp).value));
  1309. end;
  1310. ait_symbolpair:
  1311. begin
  1312. writer.AsmWrite(#9);
  1313. writer.AsmWrite(symbolpairkindstr[tai_symbolpair(hp).kind]);
  1314. writer.AsmWrite(' ');
  1315. if tai_symbolpair(hp).kind<>spk_localentry then
  1316. s:=', '
  1317. else
  1318. { the .localentry directive has to specify the size from the
  1319. start till here of the non-local entry code as second argument }
  1320. s:=', .-';
  1321. if ((target_info.system <> system_arm_linux) and (target_info.system <> system_arm_android)) then
  1322. sepChar := '@'
  1323. else
  1324. sepChar := '#';
  1325. if replaceforbidden then
  1326. begin
  1327. { avoid string truncation }
  1328. writer.AsmWrite(ApplyAsmSymbolRestrictions(tai_symbolpair(hp).sym^));
  1329. writer.AsmWrite(s);
  1330. writer.AsmWriteLn(ApplyAsmSymbolRestrictions(tai_symbolpair(hp).value^));
  1331. if tai_symbolpair(hp).kind=spk_set_global then
  1332. begin
  1333. writer.AsmWrite(#9'.globl ');
  1334. writer.AsmWriteLn(ApplyAsmSymbolRestrictions(tai_symbolpair(hp).sym^));
  1335. end;
  1336. if (tf_needs_symbol_type in target_info.flags) then
  1337. begin
  1338. writer.AsmWrite(#9'.type'#9 + ApplyAsmSymbolRestrictions(tai_symbolpair(hp).sym^));
  1339. writer.AsmWriteLn(',' + sepChar + 'function');
  1340. end;
  1341. end
  1342. else
  1343. begin
  1344. { avoid string truncation }
  1345. writer.AsmWrite(tai_symbolpair(hp).sym^);
  1346. writer.AsmWrite(s);
  1347. writer.AsmWriteLn(tai_symbolpair(hp).value^);
  1348. if tai_symbolpair(hp).kind=spk_set_global then
  1349. begin
  1350. writer.AsmWrite(#9'.globl ');
  1351. writer.AsmWriteLn(tai_symbolpair(hp).sym^);
  1352. end;
  1353. if (tf_needs_symbol_type in target_info.flags) then
  1354. begin
  1355. writer.AsmWrite(#9'.type'#9 + tai_symbolpair(hp).sym^);
  1356. writer.AsmWriteLn(',' + sepChar + 'function');
  1357. end;
  1358. end;
  1359. end;
  1360. ait_symbol_end :
  1361. begin
  1362. if tf_needs_symbol_size in target_info.flags then
  1363. begin
  1364. s:=asminfo^.labelprefix+'e'+tostr(symendcount);
  1365. inc(symendcount);
  1366. writer.AsmWriteLn(s+':');
  1367. writer.AsmWrite(#9'.size'#9);
  1368. if (target_info.system=system_powerpc64_linux) and
  1369. use_dotted_functions and
  1370. (tai_symbol_end(hp).sym.typ=AT_FUNCTION) then
  1371. writer.AsmWrite('.');
  1372. if replaceforbidden then
  1373. writer.AsmWrite(ApplyAsmSymbolRestrictions(tai_symbol_end(hp).sym.name))
  1374. else
  1375. writer.AsmWrite(tai_symbol_end(hp).sym.name);
  1376. writer.AsmWrite(', '+s+' - ');
  1377. if (target_info.system=system_powerpc64_linux) and
  1378. use_dotted_functions and
  1379. (tai_symbol_end(hp).sym.typ=AT_FUNCTION) then
  1380. writer.AsmWrite('.');
  1381. if replaceforbidden then
  1382. writer.AsmWriteLn(ApplyAsmSymbolRestrictions(tai_symbol_end(hp).sym.name))
  1383. else
  1384. writer.AsmWriteLn(tai_symbol_end(hp).sym.name);
  1385. end;
  1386. end;
  1387. ait_instruction :
  1388. begin
  1389. WriteInstruction(hp);
  1390. end;
  1391. ait_stab :
  1392. begin
  1393. if assigned(tai_stab(hp).str) then
  1394. begin
  1395. writer.AsmWrite(#9'.'+stabtypestr[tai_stab(hp).stabtype]+' ');
  1396. writer.AsmWritePChar(tai_stab(hp).str);
  1397. writer.AsmLn;
  1398. end;
  1399. end;
  1400. ait_force_line,
  1401. ait_function_name :
  1402. begin
  1403. {$ifdef DEBUG_AGGAS}
  1404. WriteStr(s,hp.typ);
  1405. writer.AsmWriteLn('# '+s);
  1406. {$endif DEBUG_AGGAS}
  1407. end;
  1408. ait_cutobject :
  1409. begin
  1410. {$ifdef DEBUG_AGGAS}
  1411. writer.AsmWriteLn('# ait_cutobject');
  1412. {$endif DEBUG_AGGAS}
  1413. if SmartAsm then
  1414. begin
  1415. { only reset buffer if nothing has changed }
  1416. if not(writer.ClearIfEmpty) then
  1417. begin
  1418. writer.AsmClose;
  1419. DoAssemble;
  1420. writer.AsmCreate(tai_cutobject(hp).place);
  1421. end;
  1422. { avoid empty files }
  1423. while assigned(hp.next) and (tai(hp.next).typ in [ait_cutobject,ait_section,ait_comment]) do
  1424. begin
  1425. if tai(hp.next).typ=ait_section then
  1426. LastSecType:=tai_section(hp.next).sectype;
  1427. hp:=tai(hp.next);
  1428. end;
  1429. if LastSecType<>sec_none then
  1430. WriteSection(LastSecType,'',secorder_default,last_align);
  1431. writer.MarkEmpty;
  1432. end;
  1433. end;
  1434. ait_marker :
  1435. begin
  1436. {$ifdef DEBUG_AGGAS}
  1437. WriteStr(s,tai_marker(hp).Kind);
  1438. writer.AsmWriteLn('# ait_marker, kind: '+s);
  1439. {$endif DEBUG_AGGAS}
  1440. if tai_marker(hp).kind=mark_NoLineInfoStart then
  1441. inc(InlineLevel)
  1442. else if tai_marker(hp).kind=mark_NoLineInfoEnd then
  1443. dec(InlineLevel);
  1444. end;
  1445. ait_directive :
  1446. begin
  1447. WriteDirectiveName(tai_directive(hp).directive);
  1448. if tai_directive(hp).name <>'' then
  1449. begin
  1450. if replaceforbidden then
  1451. writer.AsmWrite(ApplyAsmSymbolRestrictions(tai_directive(hp).name))
  1452. else
  1453. writer.AsmWrite(tai_directive(hp).name);
  1454. end;
  1455. writer.AsmLn;
  1456. end;
  1457. ait_seh_directive :
  1458. begin
  1459. {$ifndef DISABLE_WIN64_SEH}
  1460. writer.AsmWrite(sehdirectivestr[tai_seh_directive(hp).kind]);
  1461. case tai_seh_directive(hp).datatype of
  1462. sd_none:;
  1463. sd_string:
  1464. begin
  1465. writer.AsmWrite(' '+tai_seh_directive(hp).data.name^);
  1466. if (tai_seh_directive(hp).data.flags and 1)<>0 then
  1467. writer.AsmWrite(',@except');
  1468. if (tai_seh_directive(hp).data.flags and 2)<>0 then
  1469. writer.AsmWrite(',@unwind');
  1470. end;
  1471. sd_reg:
  1472. writer.AsmWrite(' '+gas_regname(tai_seh_directive(hp).data.reg));
  1473. sd_offset:
  1474. writer.AsmWrite(' '+tostr(tai_seh_directive(hp).data.offset));
  1475. sd_regoffset:
  1476. writer.AsmWrite(' '+gas_regname(tai_seh_directive(hp).data.reg)+', '+
  1477. tostr(tai_seh_directive(hp).data.offset));
  1478. end;
  1479. writer.AsmLn;
  1480. {$endif DISABLE_WIN64_SEH}
  1481. end;
  1482. ait_cfi:
  1483. begin
  1484. WriteCFI(tai_cfi_base(hp));
  1485. end;
  1486. ait_eabi_attribute:
  1487. begin
  1488. { as of today, vasm does not support the eabi directives }
  1489. if target_asm.id<>as_arm_vasm then
  1490. begin
  1491. case tai_eabi_attribute(hp).eattr_typ of
  1492. eattrtype_dword:
  1493. writer.AsmWrite(#9'.eabi_attribute '+tostr(tai_eabi_attribute(hp).tag)+','+tostr(tai_eabi_attribute(hp).value));
  1494. eattrtype_ntbs:
  1495. begin
  1496. if assigned(tai_eabi_attribute(hp).valuestr) then
  1497. writer.AsmWrite(#9'.eabi_attribute '+tostr(tai_eabi_attribute(hp).tag)+',"'+tai_eabi_attribute(hp).valuestr^+'"')
  1498. else
  1499. writer.AsmWrite(#9'.eabi_attribute '+tostr(tai_eabi_attribute(hp).tag)+',""');
  1500. end
  1501. else
  1502. Internalerror(2019100601);
  1503. end;
  1504. writer.AsmLn;
  1505. end;
  1506. end;
  1507. {$ifdef WASM}
  1508. ait_local:
  1509. begin
  1510. if tai_local(hp).first then
  1511. writer.AsmWrite(#9'.local'#9)
  1512. else
  1513. writer.AsmWrite(', ');
  1514. writer.AsmWrite(gas_wasm_basic_type_str[tai_local(hp).bastyp]);
  1515. if tai_local(hp).last then
  1516. writer.AsmLn;
  1517. end;
  1518. ait_functype:
  1519. WriteFuncTypeDirective(tai_functype(hp));
  1520. ait_importexport:
  1521. WriteImportExport(tai_impexp(hp));
  1522. {$endif WASM}
  1523. else
  1524. if not WriteComments(hp) then
  1525. internalerror(2006012201);
  1526. end;
  1527. lasthp:=hp;
  1528. hp:=tai(hp.next);
  1529. end;
  1530. end;
  1531. procedure TGNUAssembler.WriteExtraHeader;
  1532. begin
  1533. end;
  1534. procedure TGNUAssembler.WriteExtraFooter;
  1535. begin
  1536. end;
  1537. procedure TGNUAssembler.WriteInstruction(hp: tai);
  1538. begin
  1539. InstrWriter.WriteInstruction(hp);
  1540. end;
  1541. procedure TGNUAssembler.WriteWeakSymbolRef(s: tasmsymbol);
  1542. begin
  1543. writer.AsmWrite(#9'.weak ');
  1544. if asminfo^.dollarsign='$' then
  1545. writer.AsmWriteLn(s.name)
  1546. else
  1547. writer.AsmWriteLn(ApplyAsmSymbolRestrictions(s.name))
  1548. end;
  1549. procedure TGNUAssembler.WriteHiddenSymbol(sym: TAsmSymbol);
  1550. begin
  1551. { on Windows/(PE)COFF, global symbols are hidden by default: global
  1552. symbols that are not explicitly exported from an executable/library,
  1553. become hidden }
  1554. if (target_info.system in (systems_windows+systems_wince)) then
  1555. exit;
  1556. if target_info.system in systems_darwin then
  1557. writer.AsmWrite(#9'.private_extern ')
  1558. else
  1559. writer.AsmWrite(#9'.hidden ');
  1560. if asminfo^.dollarsign='$' then
  1561. writer.AsmWriteLn(sym.name)
  1562. else
  1563. writer.AsmWriteLn(ApplyAsmSymbolRestrictions(sym.name))
  1564. end;
  1565. procedure TGNUAssembler.WriteAixStringConst(hp: tai_string);
  1566. type
  1567. tterminationkind = (term_none,term_string,term_nostring);
  1568. var
  1569. i: longint;
  1570. pos: longint;
  1571. s: string;
  1572. ch: char;
  1573. instring: boolean;
  1574. procedure newstatement(terminationkind: tterminationkind);
  1575. begin
  1576. case terminationkind of
  1577. term_none: ;
  1578. term_string:
  1579. writer.AsmWriteLn('"');
  1580. term_nostring:
  1581. writer.AsmLn;
  1582. end;
  1583. writer.AsmWrite(#9'.byte'#9);
  1584. pos:=20;
  1585. instring:=false;
  1586. end;
  1587. begin
  1588. pos:=0;
  1589. instring:=false;
  1590. for i:=1 to hp.len do
  1591. begin
  1592. if pos=0 then
  1593. newstatement(term_none);
  1594. ch:=hp.str[i-1];
  1595. case ch of
  1596. #0..#31,
  1597. #127..#255 :
  1598. begin
  1599. if instring then
  1600. newstatement(term_string);
  1601. if pos=20 then
  1602. s:=tostr(ord(ch))
  1603. else
  1604. s:=', '+tostr(ord(ch))
  1605. end;
  1606. '"' :
  1607. if instring then
  1608. s:='""'
  1609. else
  1610. begin
  1611. if pos<>20 then
  1612. newstatement(term_nostring);
  1613. s:='"""';
  1614. instring:=true;
  1615. end;
  1616. else
  1617. if not instring then
  1618. begin
  1619. if (pos<>20) then
  1620. newstatement(term_nostring);
  1621. s:='"'+ch;
  1622. instring:=true;
  1623. end
  1624. else
  1625. s:=ch;
  1626. end;
  1627. writer.AsmWrite(s);
  1628. inc(pos,length(s));
  1629. if (pos>line_length) or (i=tai_string(hp).len) then
  1630. begin
  1631. if instring then
  1632. writer.AsmWriteLn('"')
  1633. else
  1634. writer.AsmLn;
  1635. pos:=0;
  1636. end;
  1637. end;
  1638. end;
  1639. procedure TGNUAssembler.WriteAixIntConst(hp: tai_const);
  1640. var
  1641. pos, size: longint;
  1642. begin
  1643. { only big endian AIX supported for now }
  1644. if target_info.endian<>endian_big then
  1645. internalerror(2012010401);
  1646. { limitation: can only write 4 bytes at a time }
  1647. pos:=0;
  1648. size:=tai_const(hp).size;
  1649. while pos<(size-4) do
  1650. begin
  1651. writer.AsmWrite(#9'.vbyte'#9'4, ');
  1652. writer.AsmWriteln(tostr(longint(tai_const(hp).value shr ((size-pos-4)*8))));
  1653. inc(pos,4);
  1654. end;
  1655. writer.AsmWrite(#9'.vbyte'#9);
  1656. writer.AsmWrite(tostr(size-pos));
  1657. writer.AsmWrite(', ');
  1658. case size-pos of
  1659. 1: writer.AsmWrite(tostr(byte(tai_const(hp).value)));
  1660. 2: writer.AsmWrite(tostr(word(tai_const(hp).value)));
  1661. 4: writer.AsmWrite(tostr(longint(tai_const(hp).value)));
  1662. else
  1663. internalerror(2012010402);
  1664. end;
  1665. end;
  1666. procedure TGNUAssembler.WriteUnalignedIntConst(hp: tai_const);
  1667. var
  1668. pos, size: longint;
  1669. begin
  1670. size:=tai_const(hp).size;
  1671. writer.AsmWrite(#9'.byte'#9);
  1672. if target_info.endian=endian_big then
  1673. begin
  1674. pos:=size-1;
  1675. while pos>=0 do
  1676. begin
  1677. writer.AsmWrite(tostr((tai_const(hp).value shr (pos*8)) and $ff));
  1678. dec(pos);
  1679. if pos>=0 then
  1680. writer.AsmWrite(', ')
  1681. else
  1682. writer.AsmLn;
  1683. end;
  1684. end
  1685. else
  1686. begin
  1687. pos:=0;
  1688. while pos<size do
  1689. begin
  1690. writer.AsmWriteln(tostr((tai_const(hp).value shr (pos*8)) and $ff));
  1691. inc(pos);
  1692. if pos<=size then
  1693. writer.AsmWrite(', ')
  1694. else
  1695. writer.AsmLn;
  1696. end;
  1697. end;
  1698. writer.AsmLn;
  1699. end;
  1700. procedure TGNUAssembler.WriteDirectiveName(dir: TAsmDirective);
  1701. begin
  1702. { TODO: implement asd_cpu for GAS => usually .arch or .cpu, but the CPU
  1703. name has to be translated as well }
  1704. if dir=asd_cpu then
  1705. writer.AsmWrite(asminfo^.comment+' CPU ')
  1706. else
  1707. writer.AsmWrite('.'+directivestr[dir]+' ');
  1708. end;
  1709. procedure TGNUAssembler.WriteAsmList;
  1710. var
  1711. n : string;
  1712. hal : tasmlisttype;
  1713. i: longint;
  1714. begin
  1715. {$ifdef EXTDEBUG}
  1716. if current_module.mainsource<>'' then
  1717. Comment(V_Debug,'Start writing gas-styled assembler output for '+current_module.mainsource);
  1718. {$endif}
  1719. if current_module.mainsource<>'' then
  1720. n:=ExtractFileName(current_module.mainsource)
  1721. else
  1722. n:=InputFileName;
  1723. { gcc does not add it either for Darwin. Grep for
  1724. TARGET_ASM_FILE_START_FILE_DIRECTIVE in gcc/config/*.h
  1725. }
  1726. if not(target_info.system in systems_darwin) then
  1727. writer.AsmWriteLn(#9'.file "'+FixFileName(n)+'"');
  1728. WriteExtraHeader;
  1729. writer.MarkEmpty;
  1730. symendcount:=0;
  1731. for hal:=low(TasmlistType) to high(TasmlistType) do
  1732. begin
  1733. if not (current_asmdata.asmlists[hal].empty) then
  1734. begin
  1735. writer.AsmWriteLn(asminfo^.comment+'Begin asmlist '+AsmlistTypeStr[hal]);
  1736. writetree(current_asmdata.asmlists[hal]);
  1737. writer.AsmWriteLn(asminfo^.comment+'End asmlist '+AsmlistTypeStr[hal]);
  1738. end;
  1739. end;
  1740. { add weak symbol markers }
  1741. for i:=0 to current_asmdata.asmsymboldict.count-1 do
  1742. if (tasmsymbol(current_asmdata.asmsymboldict[i]).bind=AB_WEAK_EXTERNAL) then
  1743. WriteWeakSymbolRef(tasmsymbol(current_asmdata.asmsymboldict[i]));
  1744. if create_smartlink_sections and
  1745. (target_info.system in systems_darwin) then
  1746. writer.AsmWriteLn(#9'.subsections_via_symbols');
  1747. { "no executable stack" marker }
  1748. { TODO: used by OpenBSD/NetBSD as well? }
  1749. if (target_info.system in (systems_linux + systems_android + systems_freebsd + systems_dragonfly)) and
  1750. not(cs_executable_stack in current_settings.moduleswitches) then
  1751. begin
  1752. writer.AsmWriteLn('.section .note.GNU-stack,"",%progbits');
  1753. end;
  1754. writer.AsmLn;
  1755. WriteExtraFooter;
  1756. {$ifdef EXTDEBUG}
  1757. if current_module.mainsource<>'' then
  1758. Comment(V_Debug,'Done writing gas-styled assembler output for '+current_module.mainsource);
  1759. {$endif EXTDEBUG}
  1760. end;
  1761. {****************************************************************************}
  1762. { Apple/GNU Assembler writer }
  1763. {****************************************************************************}
  1764. function TAppleGNUAssembler.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;
  1765. begin
  1766. if (target_info.system in systems_darwin) then
  1767. case atype of
  1768. sec_user:
  1769. begin
  1770. result:='.section '+aname;
  1771. exit;
  1772. end;
  1773. sec_bss:
  1774. { all bss (lcomm) symbols are automatically put in the right }
  1775. { place by using the lcomm assembler directive }
  1776. atype := sec_none;
  1777. sec_debug_frame,
  1778. sec_eh_frame:
  1779. begin
  1780. result := '.section __DWARF,__debug_info,regular,debug';
  1781. exit;
  1782. end;
  1783. sec_debug_line:
  1784. begin
  1785. result := '.section __DWARF,__debug_line,regular,debug';
  1786. exit;
  1787. end;
  1788. sec_debug_info:
  1789. begin
  1790. result := '.section __DWARF,__debug_info,regular,debug';
  1791. exit;
  1792. end;
  1793. sec_debug_abbrev:
  1794. begin
  1795. result := '.section __DWARF,__debug_abbrev,regular,debug';
  1796. exit;
  1797. end;
  1798. sec_debug_aranges:
  1799. begin
  1800. result := '.section __DWARF,__debug_aranges,regular,debug';
  1801. exit;
  1802. end;
  1803. sec_debug_ranges:
  1804. begin
  1805. result := '.section __DWARF,__debug_ranges,regular,debug';
  1806. exit;
  1807. end;
  1808. sec_rodata:
  1809. begin
  1810. result := '.const_data';
  1811. exit;
  1812. end;
  1813. sec_rodata_norel:
  1814. begin
  1815. result := '.const';
  1816. exit;
  1817. end;
  1818. sec_fpc:
  1819. begin
  1820. result := '.section __TEXT, .fpc, regular, no_dead_strip';
  1821. exit;
  1822. end;
  1823. sec_code:
  1824. begin
  1825. if (aname='fpc_geteipasebx') or
  1826. (aname='fpc_geteipasecx') then
  1827. begin
  1828. result:='.section __TEXT,__textcoal_nt,coalesced,pure_instructions'#10'.weak_definition '+aname+
  1829. #10'.private_extern '+aname;
  1830. exit;
  1831. end;
  1832. end;
  1833. sec_data_nonlazy:
  1834. begin
  1835. result:='.section __DATA, __nl_symbol_ptr,non_lazy_symbol_pointers';
  1836. exit;
  1837. end;
  1838. sec_data_lazy:
  1839. begin
  1840. result:='.section __DATA, __la_symbol_ptr,lazy_symbol_pointers';
  1841. exit;
  1842. end;
  1843. sec_init_func:
  1844. begin
  1845. result:='.section __DATA, __mod_init_func, mod_init_funcs';
  1846. exit;
  1847. end;
  1848. sec_term_func:
  1849. begin
  1850. result:='.section __DATA, __mod_term_func, mod_term_funcs';
  1851. exit;
  1852. end;
  1853. low(TObjCAsmSectionType)..high(TObjCAsmSectionType):
  1854. begin
  1855. result:='.section '+objc_section_name(atype);
  1856. exit
  1857. end;
  1858. else
  1859. ;
  1860. end;
  1861. result := inherited sectionname(atype,aname,aorder);
  1862. end;
  1863. procedure TAppleGNUAssembler.WriteWeakSymbolRef(s: tasmsymbol);
  1864. begin
  1865. writer.AsmWriteLn(#9'.weak_reference '+s.name);
  1866. end;
  1867. procedure TAppleGNUAssembler.WriteDirectiveName(dir: TAsmDirective);
  1868. begin
  1869. case dir of
  1870. asd_weak_reference:
  1871. writer.AsmWrite('.weak_reference ');
  1872. asd_weak_definition:
  1873. writer.AsmWrite('.weak_definition ');
  1874. else
  1875. inherited;
  1876. end;
  1877. end;
  1878. {****************************************************************************}
  1879. { a.out/GNU Assembler writer }
  1880. {****************************************************************************}
  1881. function TAoutGNUAssembler.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;
  1882. const
  1883. (* Translation table - replace unsupported section types with basic ones. *)
  1884. SecXTable: array[TAsmSectionType] of TAsmSectionType = (
  1885. sec_none,
  1886. sec_none,
  1887. sec_code,
  1888. sec_data,
  1889. sec_data (* sec_rodata *),
  1890. sec_data (* sec_rodata_norel *),
  1891. sec_bss,
  1892. sec_data (* sec_threadvar *),
  1893. { used for wince exception handling }
  1894. sec_code (* sec_pdata *),
  1895. { used for darwin import stubs }
  1896. sec_code (* sec_stub *),
  1897. sec_data,(* sec_data_nonlazy *)
  1898. sec_data,(* sec_data_lazy *)
  1899. sec_data,(* sec_init_func *)
  1900. sec_data,(* sec_term_func *)
  1901. { stabs }
  1902. sec_stab,sec_stabstr,
  1903. { win32 }
  1904. sec_data (* sec_idata2 *),
  1905. sec_data (* sec_idata4 *),
  1906. sec_data (* sec_idata5 *),
  1907. sec_data (* sec_idata6 *),
  1908. sec_data (* sec_idata7 *),
  1909. sec_data (* sec_edata *),
  1910. { C++ exception handling unwinding (uses dwarf) }
  1911. sec_eh_frame,
  1912. { dwarf }
  1913. sec_debug_frame,
  1914. sec_debug_info,
  1915. sec_debug_line,
  1916. sec_debug_abbrev,
  1917. sec_debug_aranges,
  1918. sec_debug_ranges,
  1919. { ELF resources (+ references to stabs debug information sections) }
  1920. sec_code (* sec_fpc *),
  1921. { Table of contents section }
  1922. sec_code (* sec_toc *),
  1923. sec_code (* sec_init *),
  1924. sec_code (* sec_fini *),
  1925. sec_none (* sec_objc_class *),
  1926. sec_none (* sec_objc_meta_class *),
  1927. sec_none (* sec_objc_cat_cls_meth *),
  1928. sec_none (* sec_objc_cat_inst_meth *),
  1929. sec_none (* sec_objc_protocol *),
  1930. sec_none (* sec_objc_string_object *),
  1931. sec_none (* sec_objc_cls_meth *),
  1932. sec_none (* sec_objc_inst_meth *),
  1933. sec_none (* sec_objc_cls_refs *),
  1934. sec_none (* sec_objc_message_refs *),
  1935. sec_none (* sec_objc_symbols *),
  1936. sec_none (* sec_objc_category *),
  1937. sec_none (* sec_objc_class_vars *),
  1938. sec_none (* sec_objc_instance_vars *),
  1939. sec_none (* sec_objc_module_info *),
  1940. sec_none (* sec_objc_class_names *),
  1941. sec_none (* sec_objc_meth_var_types *),
  1942. sec_none (* sec_objc_meth_var_names *),
  1943. sec_none (* sec_objc_selector_strs *),
  1944. sec_none (* sec_objc_protocol_ext *),
  1945. sec_none (* sec_objc_class_ext *),
  1946. sec_none (* sec_objc_property *),
  1947. sec_none (* sec_objc_image_info *),
  1948. sec_none (* sec_objc_cstring_object *),
  1949. sec_none (* sec_objc_sel_fixup *),
  1950. sec_none (* sec_objc_data *),
  1951. sec_none (* sec_objc_const *),
  1952. sec_none (* sec_objc_sup_refs *),
  1953. sec_none (* sec_data_coalesced *),
  1954. sec_none (* sec_objc_classlist *),
  1955. sec_none (* sec_objc_nlclasslist *),
  1956. sec_none (* sec_objc_catlist *),
  1957. sec_none (* sec_objc_nlcatlist *),
  1958. sec_none (* sec_objc_protlist *),
  1959. sec_none (* sec_stack *),
  1960. sec_none (* sec_heap *),
  1961. sec_none (* gcc_except_table *),
  1962. sec_none (* sec_arm_attribute *)
  1963. );
  1964. begin
  1965. Result := inherited SectionName (SecXTable [AType], AName, AOrder);
  1966. end;
  1967. {****************************************************************************}
  1968. { Abstract Instruction Writer }
  1969. {****************************************************************************}
  1970. constructor TCPUInstrWriter.create(_owner: TGNUAssembler);
  1971. begin
  1972. inherited create;
  1973. owner := _owner;
  1974. end;
  1975. end.