aggas.pas 66 KB

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