aggas.pas 56 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625
  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_half16bit] 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,#9'.short'#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. {$ifdef avr}
  621. WriteSection(tai_section(hp).sectype,ReplaceForbiddenChars(tai_section(hp).name^),tai_section(hp).secorder)
  622. {$else avr}
  623. WriteSection(tai_section(hp).sectype,tai_section(hp).name^,tai_section(hp).secorder)
  624. {$endif avr}
  625. else
  626. begin
  627. {$ifdef EXTDEBUG}
  628. AsmWrite(target_asm.comment);
  629. AsmWriteln(' sec_none');
  630. {$endif EXTDEBUG}
  631. end;
  632. end;
  633. ait_datablock :
  634. begin
  635. if (target_info.system in systems_darwin) then
  636. begin
  637. { On Mac OS X you can't have common symbols in a shared library
  638. since those are in the TEXT section and the text section is
  639. read-only in shared libraries (so it can be shared among different
  640. processes). The alternate code creates some kind of common symbols
  641. in the data segment.
  642. }
  643. if tai_datablock(hp).is_global then
  644. begin
  645. asmwrite('.globl ');
  646. asmwriteln(tai_datablock(hp).sym.name);
  647. asmwriteln('.data');
  648. asmwrite('.zerofill __DATA, __common, ');
  649. asmwrite(tai_datablock(hp).sym.name);
  650. asmwriteln(', '+tostr(tai_datablock(hp).size)+','+tostr(last_align));
  651. if not(LastSecType in [sec_data,sec_none]) then
  652. writesection(LastSecType,'',secorder_default);
  653. end
  654. else
  655. begin
  656. asmwrite(#9'.lcomm'#9);
  657. asmwrite(tai_datablock(hp).sym.name);
  658. asmwrite(','+tostr(tai_datablock(hp).size));
  659. asmwrite(','+tostr(last_align));
  660. asmln;
  661. end;
  662. end
  663. else
  664. begin
  665. {$ifdef USE_COMM_IN_BSS}
  666. if writingpackages then
  667. begin
  668. { The .comm is required for COMMON symbols. These are used
  669. in the shared library loading. All the symbols declared in
  670. the .so file need to resolve to the data allocated in the main
  671. program (PFV) }
  672. if tai_datablock(hp).is_global then
  673. begin
  674. asmwrite(#9'.comm'#9);
  675. {$ifdef avr}
  676. asmwrite(ReplaceForbiddenChars(tai_datablock(hp).sym.name));
  677. {$else avr}
  678. asmwrite(tai_datablock(hp).sym.name);
  679. {$endif avr}
  680. asmwrite(','+tostr(tai_datablock(hp).size));
  681. asmwrite(','+tostr(last_align));
  682. asmln;
  683. end
  684. else
  685. begin
  686. asmwrite(#9'.lcomm'#9);
  687. {$ifdef avr}
  688. asmwrite(ReplaceForbiddenChars(tai_datablock(hp).sym.name));
  689. {$else avr}
  690. asmwrite(tai_datablock(hp).sym.name);
  691. {$endif avr}
  692. asmwrite(','+tostr(tai_datablock(hp).size));
  693. asmwrite(','+tostr(last_align));
  694. asmln;
  695. end
  696. end
  697. else
  698. {$endif USE_COMM_IN_BSS}
  699. begin
  700. if Tai_datablock(hp).is_global then
  701. begin
  702. asmwrite(#9'.globl ');
  703. {$ifdef avr}
  704. asmwriteln(ReplaceForbiddenChars(Tai_datablock(hp).sym.name));
  705. {$else avr}
  706. asmwriteln(Tai_datablock(hp).sym.name);
  707. {$endif avr}
  708. end;
  709. if (target_info.system <> system_arm_linux) then
  710. sepChar := '@'
  711. else
  712. sepChar := '%';
  713. if (tf_needs_symbol_type in target_info.flags) then
  714. {$ifdef avr}
  715. if (tf_needs_symbol_type in target_info.flags) then
  716. asmwriteln(#9'.type '+ReplaceForbiddenChars(Tai_datablock(hp).sym.name)+','+sepChar+'object');
  717. if (tf_needs_symbol_size in target_info.flags) and (tai_datablock(hp).size > 0) then
  718. asmwriteln(#9'.size '+ReplaceForbiddenChars(Tai_datablock(hp).sym.name)+','+tostr(Tai_datablock(hp).size));
  719. asmwrite(ReplaceForbiddenChars(Tai_datablock(hp).sym.name));
  720. {$else avr}
  721. if (tf_needs_symbol_type in target_info.flags) then
  722. asmwriteln(#9'.type '+Tai_datablock(hp).sym.name+','+sepChar+'object');
  723. if (tf_needs_symbol_size in target_info.flags) and (tai_datablock(hp).size > 0) then
  724. asmwriteln(#9'.size '+Tai_datablock(hp).sym.name+','+tostr(Tai_datablock(hp).size));
  725. asmwrite(Tai_datablock(hp).sym.name);
  726. {$endif avr}
  727. asmwriteln(':');
  728. asmwriteln(#9'.zero '+tostr(Tai_datablock(hp).size));
  729. end;
  730. end;
  731. end;
  732. ait_const:
  733. begin
  734. constdef:=tai_const(hp).consttype;
  735. case constdef of
  736. {$ifndef cpu64bitaddr}
  737. aitconst_128bit :
  738. begin
  739. internalerror(200404291);
  740. end;
  741. aitconst_64bit :
  742. begin
  743. if assigned(tai_const(hp).sym) then
  744. internalerror(200404292);
  745. AsmWrite(ait_const2str[aitconst_32bit]);
  746. if target_info.endian = endian_little then
  747. begin
  748. AsmWrite(tostr(longint(lo(tai_const(hp).value))));
  749. AsmWrite(',');
  750. AsmWrite(tostr(longint(hi(tai_const(hp).value))));
  751. end
  752. else
  753. begin
  754. AsmWrite(tostr(longint(hi(tai_const(hp).value))));
  755. AsmWrite(',');
  756. AsmWrite(tostr(longint(lo(tai_const(hp).value))));
  757. end;
  758. AsmLn;
  759. end;
  760. {$endif cpu64bitaddr}
  761. aitconst_uleb128bit,
  762. aitconst_sleb128bit,
  763. {$ifdef cpu64bitaddr}
  764. aitconst_128bit,
  765. aitconst_64bit,
  766. {$endif cpu64bitaddr}
  767. aitconst_32bit,
  768. aitconst_16bit,
  769. aitconst_8bit,
  770. aitconst_rva_symbol,
  771. aitconst_secrel32_symbol,
  772. aitconst_darwin_dwarf_delta32,
  773. aitconst_darwin_dwarf_delta64,
  774. aitconst_half16bit:
  775. begin
  776. if (target_info.system in systems_darwin) and
  777. (constdef in [aitconst_uleb128bit,aitconst_sleb128bit]) then
  778. begin
  779. AsmWrite(ait_const2str[aitconst_8bit]);
  780. case tai_const(hp).consttype of
  781. aitconst_uleb128bit:
  782. WriteDecodedUleb128(qword(tai_const(hp).value));
  783. aitconst_sleb128bit:
  784. WriteDecodedSleb128(int64(tai_const(hp).value));
  785. end
  786. end
  787. else
  788. begin
  789. AsmWrite(ait_const2str[constdef]);
  790. l:=0;
  791. t := '';
  792. repeat
  793. if assigned(tai_const(hp).sym) then
  794. begin
  795. if assigned(tai_const(hp).endsym) then
  796. begin
  797. if (constdef in [aitconst_darwin_dwarf_delta32,aitconst_darwin_dwarf_delta64]) then
  798. begin
  799. s := NextSetLabel;
  800. t := #9'.set '+s+','+tai_const(hp).endsym.name+'-'+tai_const(hp).sym.name;
  801. end
  802. else
  803. s:=tai_const(hp).endsym.name+'-'+tai_const(hp).sym.name
  804. end
  805. else
  806. s:=tai_const(hp).sym.name;
  807. {$ifdef avr}
  808. s:=ReplaceForbiddenChars(s);
  809. {$endif avr}
  810. if tai_const(hp).value<>0 then
  811. s:=s+tostr_with_plus(tai_const(hp).value);
  812. end
  813. else
  814. {$ifdef cpu64bitaddr}
  815. s:=tostr(tai_const(hp).value);
  816. {$else cpu64bitaddr}
  817. { 64 bit constants are already handled above in this case }
  818. s:=tostr(longint(tai_const(hp).value));
  819. {$endif cpu64bitaddr}
  820. if constdef = aitconst_half16bit then
  821. s:='('+s+')/2';
  822. AsmWrite(s);
  823. inc(l,length(s));
  824. { Values with symbols are written on a single line to improve
  825. reading of the .s file (PFV) }
  826. if assigned(tai_const(hp).sym) or
  827. not(LastSecType in [sec_data,sec_rodata,sec_rodata_norel]) or
  828. (l>line_length) or
  829. (hp.next=nil) or
  830. (tai(hp.next).typ<>ait_const) or
  831. (tai_const(hp.next).consttype<>constdef) or
  832. assigned(tai_const(hp.next).sym) then
  833. break;
  834. hp:=tai(hp.next);
  835. AsmWrite(',');
  836. until false;
  837. if (t <> '') then
  838. begin
  839. AsmLn;
  840. AsmWrite(t);
  841. end;
  842. end;
  843. AsmLn;
  844. end;
  845. else
  846. internalerror(200704251);
  847. end;
  848. end;
  849. { the "and defined(FPC_HAS_TYPE_EXTENDED)" isn't optimal but currently the only solution
  850. it prevents proper cross compilation to i386 though
  851. }
  852. {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
  853. ait_real_80bit :
  854. begin
  855. if do_line then
  856. AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_real_80bit(hp).value));
  857. { Make sure e is a extended type, bestreal could be
  858. a different type (bestreal) !! (PFV) }
  859. e:=tai_real_80bit(hp).value;
  860. AsmWrite(#9'.byte'#9);
  861. for i:=0 to 9 do
  862. begin
  863. if i<>0 then
  864. AsmWrite(',');
  865. AsmWrite(tostr(t80bitarray(e)[i]));
  866. end;
  867. for i:=11 to tai_real_80bit(hp).savesize do
  868. AsmWrite(',0');
  869. AsmLn;
  870. end;
  871. {$endif cpuextended}
  872. ait_real_64bit :
  873. begin
  874. if do_line then
  875. AsmWriteLn(target_asm.comment+'value: '+double2str(tai_real_64bit(hp).value));
  876. d:=tai_real_64bit(hp).value;
  877. { swap the values to correct endian if required }
  878. if source_info.endian <> target_info.endian then
  879. swap64bitarray(t64bitarray(d));
  880. AsmWrite(#9'.byte'#9);
  881. {$ifdef arm}
  882. if tai_real_64bit(hp).formatoptions=fo_hiloswapped then
  883. begin
  884. for i:=4 to 7 do
  885. begin
  886. if i<>4 then
  887. AsmWrite(',');
  888. AsmWrite(tostr(t64bitarray(d)[i]));
  889. end;
  890. for i:=0 to 3 do
  891. begin
  892. AsmWrite(',');
  893. AsmWrite(tostr(t64bitarray(d)[i]));
  894. end;
  895. end
  896. else
  897. {$endif arm}
  898. begin
  899. for i:=0 to 7 do
  900. begin
  901. if i<>0 then
  902. AsmWrite(',');
  903. AsmWrite(tostr(t64bitarray(d)[i]));
  904. end;
  905. end;
  906. AsmLn;
  907. end;
  908. ait_real_32bit :
  909. begin
  910. if do_line then
  911. AsmWriteLn(target_asm.comment+'value: '+single2str(tai_real_32bit(hp).value));
  912. sin:=tai_real_32bit(hp).value;
  913. { swap the values to correct endian if required }
  914. if source_info.endian <> target_info.endian then
  915. swap32bitarray(t32bitarray(sin));
  916. AsmWrite(#9'.byte'#9);
  917. for i:=0 to 3 do
  918. begin
  919. if i<>0 then
  920. AsmWrite(',');
  921. AsmWrite(tostr(t32bitarray(sin)[i]));
  922. end;
  923. AsmLn;
  924. end;
  925. ait_comp_64bit :
  926. begin
  927. if do_line then
  928. AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_comp_64bit(hp).value));
  929. AsmWrite(#9'.byte'#9);
  930. co:=comp(tai_comp_64bit(hp).value);
  931. { swap the values to correct endian if required }
  932. if source_info.endian <> target_info.endian then
  933. swap64bitarray(t64bitarray(co));
  934. for i:=0 to 7 do
  935. begin
  936. if i<>0 then
  937. AsmWrite(',');
  938. AsmWrite(tostr(t64bitarray(co)[i]));
  939. end;
  940. AsmLn;
  941. end;
  942. ait_string :
  943. begin
  944. pos:=0;
  945. for i:=1 to tai_string(hp).len do
  946. begin
  947. if pos=0 then
  948. begin
  949. AsmWrite(#9'.ascii'#9'"');
  950. pos:=20;
  951. end;
  952. ch:=tai_string(hp).str[i-1];
  953. case ch of
  954. #0, {This can't be done by range, because a bug in FPC}
  955. #1..#31,
  956. #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7);
  957. '"' : s:='\"';
  958. '\' : s:='\\';
  959. else
  960. s:=ch;
  961. end;
  962. AsmWrite(s);
  963. inc(pos,length(s));
  964. if (pos>line_length) or (i=tai_string(hp).len) then
  965. begin
  966. AsmWriteLn('"');
  967. pos:=0;
  968. end;
  969. end;
  970. end;
  971. ait_label :
  972. begin
  973. if (tai_label(hp).labsym.is_used) then
  974. begin
  975. if (tai_label(hp).labsym.bind=AB_PRIVATE_EXTERN) then
  976. begin
  977. AsmWrite(#9'.private_extern ');
  978. AsmWriteln(tai_label(hp).labsym.name);
  979. end;
  980. if tai_label(hp).labsym.bind in [AB_GLOBAL,AB_PRIVATE_EXTERN] then
  981. begin
  982. AsmWrite('.globl'#9);
  983. {$ifdef avr}
  984. AsmWriteLn(ReplaceForbiddenChars(tai_label(hp).labsym.name));
  985. {$else avr}
  986. AsmWriteLn(tai_label(hp).labsym.name);
  987. {$endif avr}
  988. end;
  989. {$ifdef avr}
  990. AsmWrite(ReplaceForbiddenChars(tai_label(hp).labsym.name));
  991. {$else avr}
  992. AsmWrite(tai_label(hp).labsym.name);
  993. {$endif avr}
  994. AsmWriteLn(':');
  995. end;
  996. end;
  997. ait_symbol :
  998. begin
  999. if (tai_symbol(hp).sym.bind=AB_PRIVATE_EXTERN) then
  1000. begin
  1001. AsmWrite(#9'.private_extern ');
  1002. {$ifdef avr}
  1003. AsmWriteln(ReplaceForbiddenChars(tai_symbol(hp).sym.name));
  1004. {$else avr}
  1005. AsmWriteln(tai_symbol(hp).sym.name);
  1006. {$endif avr}
  1007. end;
  1008. if (target_info.system = system_powerpc64_linux) and
  1009. (tai_symbol(hp).sym.typ = AT_FUNCTION) and (cs_profile in current_settings.moduleswitches) then
  1010. AsmWriteLn('.globl _mcount');
  1011. if tai_symbol(hp).is_global then
  1012. begin
  1013. AsmWrite('.globl'#9);
  1014. {$ifdef avr}
  1015. AsmWriteln(ReplaceForbiddenChars(tai_symbol(hp).sym.name));
  1016. {$else avr}
  1017. AsmWriteln(tai_symbol(hp).sym.name);
  1018. {$endif avr}
  1019. end;
  1020. if (target_info.system = system_powerpc64_linux) and
  1021. (tai_symbol(hp).sym.typ = AT_FUNCTION) then
  1022. begin
  1023. AsmWriteLn('.section ".opd", "aw"');
  1024. AsmWriteLn('.align 3');
  1025. AsmWriteLn(tai_symbol(hp).sym.name + ':');
  1026. AsmWriteLn('.quad .' + tai_symbol(hp).sym.name + ', .TOC.@tocbase, 0');
  1027. AsmWriteLn('.previous');
  1028. AsmWriteLn('.size ' + tai_symbol(hp).sym.name + ', 24');
  1029. if (tai_symbol(hp).is_global) then
  1030. AsmWriteLn('.globl .' + tai_symbol(hp).sym.name);
  1031. AsmWriteLn('.type .' + tai_symbol(hp).sym.name + ', @function');
  1032. { the dotted name is the name of the actual function entry }
  1033. AsmWrite('.');
  1034. end
  1035. else
  1036. begin
  1037. if (target_info.system <> system_arm_linux) then
  1038. sepChar := '@'
  1039. else
  1040. sepChar := '#';
  1041. if (tf_needs_symbol_type in target_info.flags) then
  1042. begin
  1043. AsmWrite(#9'.type'#9 + tai_symbol(hp).sym.name);
  1044. if (needsObject(tai_symbol(hp))) then
  1045. AsmWriteLn(',' + sepChar + 'object')
  1046. else
  1047. AsmWriteLn(',' + sepChar + 'function');
  1048. end;
  1049. end;
  1050. {$ifdef avr}
  1051. if not(tai_symbol(hp).has_value) then
  1052. AsmWriteLn(ReplaceForbiddenChars(tai_symbol(hp).sym.name + ':'))
  1053. else
  1054. AsmWriteLn(ReplaceForbiddenChars(tai_symbol(hp).sym.name + '=' + tostr(tai_symbol(hp).value)));
  1055. {$else avr}
  1056. if not(tai_symbol(hp).has_value) then
  1057. AsmWriteLn(tai_symbol(hp).sym.name + ':')
  1058. else
  1059. AsmWriteLn(tai_symbol(hp).sym.name + '=' + tostr(tai_symbol(hp).value));
  1060. {$endif avr}
  1061. end;
  1062. {$ifdef arm}
  1063. ait_thumb_func:
  1064. begin
  1065. AsmWriteLn(#9'.thumb_func');
  1066. end;
  1067. {$endif arm}
  1068. ait_symbol_end :
  1069. begin
  1070. if tf_needs_symbol_size in target_info.flags then
  1071. begin
  1072. s:=target_asm.labelprefix+'e'+tostr(symendcount);
  1073. inc(symendcount);
  1074. AsmWriteLn(s+':');
  1075. AsmWrite(#9'.size'#9);
  1076. if (target_info.system = system_powerpc64_linux) and (tai_symbol_end(hp).sym.typ = AT_FUNCTION) then
  1077. AsmWrite('.');
  1078. {$ifdef avr}
  1079. AsmWrite(ReplaceForbiddenChars(tai_symbol_end(hp).sym.name));
  1080. {$else avr}
  1081. AsmWrite(tai_symbol_end(hp).sym.name);
  1082. {$endif avr}
  1083. AsmWrite(', '+s+' - ');
  1084. if (target_info.system = system_powerpc64_linux) and (tai_symbol_end(hp).sym.typ = AT_FUNCTION) then
  1085. AsmWrite('.');
  1086. {$ifdef avr}
  1087. AsmWriteLn(ReplaceForbiddenChars(tai_symbol_end(hp).sym.name));
  1088. {$else avr}
  1089. AsmWriteLn(tai_symbol_end(hp).sym.name);
  1090. {$endif avr}
  1091. end;
  1092. end;
  1093. ait_instruction :
  1094. begin
  1095. WriteInstruction(hp);
  1096. end;
  1097. ait_stab :
  1098. begin
  1099. if assigned(tai_stab(hp).str) then
  1100. begin
  1101. AsmWrite(#9'.'+stabtypestr[tai_stab(hp).stabtype]+' ');
  1102. AsmWritePChar(tai_stab(hp).str);
  1103. AsmLn;
  1104. end;
  1105. end;
  1106. ait_force_line,
  1107. ait_function_name :
  1108. ;
  1109. ait_cutobject :
  1110. begin
  1111. if SmartAsm then
  1112. begin
  1113. { only reset buffer if nothing has changed }
  1114. if AsmSize=AsmStartSize then
  1115. AsmClear
  1116. else
  1117. begin
  1118. AsmClose;
  1119. DoAssemble;
  1120. AsmCreate(tai_cutobject(hp).place);
  1121. end;
  1122. { avoid empty files }
  1123. while assigned(hp.next) and (tai(hp.next).typ in [ait_cutobject,ait_section,ait_comment]) do
  1124. begin
  1125. if tai(hp.next).typ=ait_section then
  1126. LastSecType:=tai_section(hp.next).sectype;
  1127. hp:=tai(hp.next);
  1128. end;
  1129. if LastSecType<>sec_none then
  1130. WriteSection(LastSecType,'',secorder_default);
  1131. AsmStartSize:=AsmSize;
  1132. end;
  1133. end;
  1134. ait_marker :
  1135. if tai_marker(hp).kind=mark_NoLineInfoStart then
  1136. inc(InlineLevel)
  1137. else if tai_marker(hp).kind=mark_NoLineInfoEnd then
  1138. dec(InlineLevel);
  1139. ait_directive :
  1140. begin
  1141. AsmWrite('.'+directivestr[tai_directive(hp).directive]+' ');
  1142. if assigned(tai_directive(hp).name) then
  1143. AsmWrite(tai_directive(hp).name^);
  1144. AsmLn;
  1145. end;
  1146. else
  1147. internalerror(2006012201);
  1148. end;
  1149. hp:=tai(hp.next);
  1150. end;
  1151. end;
  1152. procedure TGNUAssembler.WriteExtraHeader;
  1153. begin
  1154. end;
  1155. procedure TGNUAssembler.WriteInstruction(hp: tai);
  1156. begin
  1157. InstrWriter.WriteInstruction(hp);
  1158. end;
  1159. procedure TGNUAssembler.WriteWeakSymbolDef(s: tasmsymbol);
  1160. begin
  1161. AsmWriteLn(#9'.weak '+s.name);
  1162. end;
  1163. procedure TGNUAssembler.WriteAsmList;
  1164. var
  1165. n : string;
  1166. hal : tasmlisttype;
  1167. i: longint;
  1168. begin
  1169. {$ifdef EXTDEBUG}
  1170. if assigned(current_module.mainsource) then
  1171. Comment(V_Debug,'Start writing gas-styled assembler output for '+current_module.mainsource^);
  1172. {$endif}
  1173. if assigned(current_module.mainsource) then
  1174. n:=ExtractFileName(current_module.mainsource^)
  1175. else
  1176. n:=InputFileName;
  1177. { gcc does not add it either for Darwin (and AIX). Grep for
  1178. TARGET_ASM_FILE_START_FILE_DIRECTIVE in gcc/config/*.h
  1179. }
  1180. if not(target_info.system in systems_darwin) then
  1181. AsmWriteLn(#9'.file "'+FixFileName(n)+'"');
  1182. WriteExtraHeader;
  1183. AsmStartSize:=AsmSize;
  1184. symendcount:=0;
  1185. for hal:=low(TasmlistType) to high(TasmlistType) do
  1186. begin
  1187. AsmWriteLn(target_asm.comment+'Begin asmlist '+AsmlistTypeStr[hal]);
  1188. writetree(current_asmdata.asmlists[hal]);
  1189. AsmWriteLn(target_asm.comment+'End asmlist '+AsmlistTypeStr[hal]);
  1190. end;
  1191. { add weak symbol markers }
  1192. for i:=0 to current_asmdata.asmsymboldict.count-1 do
  1193. if (tasmsymbol(current_asmdata.asmsymboldict[i]).bind=AB_WEAK_EXTERNAL) then
  1194. writeweaksymboldef(tasmsymbol(current_asmdata.asmsymboldict[i]));
  1195. if create_smartlink_sections and
  1196. (target_info.system in systems_darwin) then
  1197. AsmWriteLn(#9'.subsections_via_symbols');
  1198. { "no executable stack" marker for Linux }
  1199. if (target_info.system in systems_linux) and
  1200. not(cs_executable_stack in current_settings.moduleswitches) then
  1201. begin
  1202. AsmWriteLn('.section .note.GNU-stack,"",%progbits');
  1203. end;
  1204. AsmLn;
  1205. {$ifdef EXTDEBUG}
  1206. if assigned(current_module.mainsource) then
  1207. Comment(V_Debug,'Done writing gas-styled assembler output for '+current_module.mainsource^);
  1208. {$endif EXTDEBUG}
  1209. end;
  1210. {****************************************************************************}
  1211. { Apple/GNU Assembler writer }
  1212. {****************************************************************************}
  1213. function TAppleGNUAssembler.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;
  1214. begin
  1215. if (target_info.system in systems_darwin) then
  1216. case atype of
  1217. sec_bss:
  1218. { all bss (lcomm) symbols are automatically put in the right }
  1219. { place by using the lcomm assembler directive }
  1220. atype := sec_none;
  1221. sec_debug_frame,
  1222. sec_eh_frame:
  1223. begin
  1224. result := '.section __DWARF,__debug_info,regular,debug';
  1225. exit;
  1226. end;
  1227. sec_debug_line:
  1228. begin
  1229. result := '.section __DWARF,__debug_line,regular,debug';
  1230. exit;
  1231. end;
  1232. sec_debug_info:
  1233. begin
  1234. result := '.section __DWARF,__debug_info,regular,debug';
  1235. exit;
  1236. end;
  1237. sec_debug_abbrev:
  1238. begin
  1239. result := '.section __DWARF,__debug_abbrev,regular,debug';
  1240. exit;
  1241. end;
  1242. sec_rodata:
  1243. begin
  1244. result := '.const_data';
  1245. exit;
  1246. end;
  1247. sec_rodata_norel:
  1248. begin
  1249. result := '.const';
  1250. exit;
  1251. end;
  1252. sec_fpc:
  1253. begin
  1254. result := '.section __TEXT, .fpc, regular, no_dead_strip';
  1255. exit;
  1256. end;
  1257. sec_code:
  1258. begin
  1259. if (aname='fpc_geteipasebx') or
  1260. (aname='fpc_geteipasecx') then
  1261. begin
  1262. result:='.section __TEXT,__textcoal_nt,coalesced,pure_instructions'#10'.weak_definition '+aname+
  1263. #10'.private_extern '+aname;
  1264. exit;
  1265. end;
  1266. end;
  1267. sec_data_nonlazy:
  1268. begin
  1269. result:='.section __DATA, __nl_symbol_ptr,non_lazy_symbol_pointers';
  1270. exit;
  1271. end;
  1272. sec_data_lazy:
  1273. begin
  1274. result:='.section __DATA, __la_symbol_ptr,lazy_symbol_pointers';
  1275. exit;
  1276. end;
  1277. sec_init_func:
  1278. begin
  1279. result:='.section __DATA, __mod_init_func, mod_init_funcs';
  1280. exit;
  1281. end;
  1282. sec_term_func:
  1283. begin
  1284. result:='.section __DATA, __mod_term_func, mod_term_funcs';
  1285. exit;
  1286. end;
  1287. sec_objc_protocol_ext:
  1288. begin
  1289. result:='.section __OBJC, __protocol_ext, regular, no_dead_strip';
  1290. exit;
  1291. end;
  1292. sec_objc_class_ext:
  1293. begin
  1294. result:='.section __OBJC, __class_ext, regular, no_dead_strip';
  1295. exit;
  1296. end;
  1297. sec_objc_property:
  1298. begin
  1299. result:='.section __OBJC, __property, regular, no_dead_strip';
  1300. exit;
  1301. end;
  1302. sec_objc_image_info:
  1303. begin
  1304. result:='.section __OBJC, __image_info, regular, no_dead_strip';
  1305. exit;
  1306. end;
  1307. sec_objc_cstring_object:
  1308. begin
  1309. result:='.section __OBJC, __cstring_object, regular, no_dead_strip';
  1310. exit;
  1311. end;
  1312. sec_objc_sel_fixup:
  1313. begin
  1314. result:='.section __OBJC, __sel_fixup, regular, no_dead_strip';
  1315. exit;
  1316. end;
  1317. sec_objc_message_refs:
  1318. begin
  1319. if (target_info.system in systems_objc_nfabi) then
  1320. begin
  1321. result:='.section __DATA, __objc_selrefs, literal_pointers, no_dead_strip';
  1322. exit;
  1323. end;
  1324. end;
  1325. sec_objc_cls_refs:
  1326. begin
  1327. if (target_info.system in systems_objc_nfabi) then
  1328. begin
  1329. result:='.section __DATA, __objc_clsrefs, regular, no_dead_strip';
  1330. exit;
  1331. end;
  1332. end;
  1333. sec_objc_meth_var_names,
  1334. sec_objc_class_names:
  1335. begin
  1336. if (target_info.system in systems_objc_nfabi) then
  1337. begin
  1338. result:='.cstring';
  1339. exit
  1340. end;
  1341. end;
  1342. sec_objc_inst_meth,
  1343. sec_objc_cls_meth,
  1344. sec_objc_cat_inst_meth,
  1345. sec_objc_cat_cls_meth:
  1346. begin
  1347. if (target_info.system in systems_objc_nfabi) then
  1348. begin
  1349. result:='.section __DATA, __objc_const';
  1350. exit;
  1351. end;
  1352. end;
  1353. sec_objc_meta_class,
  1354. sec_objc_class:
  1355. begin
  1356. if (target_info.system in systems_objc_nfabi) then
  1357. begin
  1358. result:='.section __DATA, __objc_data';
  1359. exit;
  1360. end;
  1361. end;
  1362. sec_objc_sup_refs:
  1363. begin
  1364. result:='.section __DATA, __objc_superrefs, regular, no_dead_strip';
  1365. exit
  1366. end;
  1367. sec_objc_classlist:
  1368. begin
  1369. result:='.section __DATA, __objc_classlist, regular, no_dead_strip';
  1370. exit
  1371. end;
  1372. sec_objc_nlclasslist:
  1373. begin
  1374. result:='.section __DATA, __objc_nlclasslist, regular, no_dead_strip';
  1375. exit
  1376. end;
  1377. sec_objc_catlist:
  1378. begin
  1379. result:='.section __DATA, __objc_catlist, regular, no_dead_strip';
  1380. exit
  1381. end;
  1382. sec_objc_nlcatlist:
  1383. begin
  1384. result:='.section __DATA, __objc_nlcatlist, regular, no_dead_strip';
  1385. exit
  1386. end;
  1387. sec_objc_protolist:
  1388. begin
  1389. result:='.section __DATA, __objc_protolist, coalesced, no_dead_strip';
  1390. exit;
  1391. end;
  1392. end;
  1393. result := inherited sectionname(atype,aname,aorder);
  1394. end;
  1395. procedure TAppleGNUAssembler.WriteWeakSymbolDef(s: tasmsymbol);
  1396. begin
  1397. AsmWriteLn(#9'.weak_reference '+s.name);
  1398. end;
  1399. {****************************************************************************}
  1400. { a.out/GNU Assembler writer }
  1401. {****************************************************************************}
  1402. function TAoutGNUAssembler.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;
  1403. const
  1404. (* Translation table - replace unsupported section types with basic ones. *)
  1405. SecXTable: array[TAsmSectionType] of TAsmSectionType = (
  1406. sec_none,
  1407. sec_none,
  1408. sec_code,
  1409. sec_data,
  1410. sec_data (* sec_rodata *),
  1411. sec_data (* sec_rodata_norel *),
  1412. sec_bss,
  1413. sec_data (* sec_threadvar *),
  1414. { used for wince exception handling }
  1415. sec_code (* sec_pdata *),
  1416. { used for darwin import stubs }
  1417. sec_code (* sec_stub *),
  1418. sec_data,(* sec_data_nonlazy *)
  1419. sec_data,(* sec_data_lazy *)
  1420. sec_data,(* sec_init_func *)
  1421. sec_data,(* sec_term_func *)
  1422. { stabs }
  1423. sec_stab,sec_stabstr,
  1424. { win32 }
  1425. sec_data (* sec_idata2 *),
  1426. sec_data (* sec_idata4 *),
  1427. sec_data (* sec_idata5 *),
  1428. sec_data (* sec_idata6 *),
  1429. sec_data (* sec_idata7 *),
  1430. sec_data (* sec_edata *),
  1431. { C++ exception handling unwinding (uses dwarf) }
  1432. sec_eh_frame,
  1433. { dwarf }
  1434. sec_debug_frame,
  1435. sec_debug_info,
  1436. sec_debug_line,
  1437. sec_debug_abbrev,
  1438. { ELF resources (+ references to stabs debug information sections) }
  1439. sec_code (* sec_fpc *),
  1440. { Table of contents section }
  1441. sec_code (* sec_toc *),
  1442. sec_code (* sec_init *),
  1443. sec_code (* sec_fini *),
  1444. sec_none (* sec_objc_class *),
  1445. sec_none (* sec_objc_meta_class *),
  1446. sec_none (* sec_objc_cat_cls_meth *),
  1447. sec_none (* sec_objc_cat_inst_meth *),
  1448. sec_none (* sec_objc_protocol *),
  1449. sec_none (* sec_objc_string_object *),
  1450. sec_none (* sec_objc_cls_meth *),
  1451. sec_none (* sec_objc_inst_meth *),
  1452. sec_none (* sec_objc_cls_refs *),
  1453. sec_none (* sec_objc_message_refs *),
  1454. sec_none (* sec_objc_symbols *),
  1455. sec_none (* sec_objc_category *),
  1456. sec_none (* sec_objc_class_vars *),
  1457. sec_none (* sec_objc_instance_vars *),
  1458. sec_none (* sec_objc_module_info *),
  1459. sec_none (* sec_objc_class_names *),
  1460. sec_none (* sec_objc_meth_var_types *),
  1461. sec_none (* sec_objc_meth_var_names *),
  1462. sec_none (* sec_objc_selector_strs *),
  1463. sec_none (* sec_objc_protocol_ext *),
  1464. sec_none (* sec_objc_class_ext *),
  1465. sec_none (* sec_objc_property *),
  1466. sec_none (* sec_objc_image_info *),
  1467. sec_none (* sec_objc_cstring_object *),
  1468. sec_none (* sec_objc_sel_fixup *),
  1469. sec_none (* sec_objc_data *),
  1470. sec_none (* sec_objc_const *),
  1471. sec_none (* sec_objc_sup_refs *),
  1472. sec_none (* sec_data_coalesced *),
  1473. sec_none (* sec_objc_classlist *),
  1474. sec_none (* sec_objc_nlclasslist *),
  1475. sec_none (* sec_objc_catlist *),
  1476. sec_none (* sec_objc_nlcatlist *),
  1477. sec_none (* sec_objc_protlist *)
  1478. );
  1479. begin
  1480. Result := inherited SectionName (SecXTable [AType], AName, AOrder);
  1481. end;
  1482. {****************************************************************************}
  1483. { Abstract Instruction Writer }
  1484. {****************************************************************************}
  1485. constructor TCPUInstrWriter.create(_owner: TGNUAssembler);
  1486. begin
  1487. inherited create;
  1488. owner := _owner;
  1489. end;
  1490. end.