aggas.pas 80 KB

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