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