aggas.pas 57 KB

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