aggas.pas 54 KB

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