aggas.pas 67 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872
  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 : cardinal;
  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 in [system_mipsel_linux,system_mips_linux] then
  1084. begin
  1085. AsmWrite(#9'.ent'#9);
  1086. if replaceforbidden then
  1087. AsmWriteln(ReplaceForbiddenAsmSymbolChars(tai_symbol(hp).sym.name))
  1088. else
  1089. AsmWriteln(tai_symbol(hp).sym.name);
  1090. end;
  1091. if (target_info.system = system_powerpc64_linux) and
  1092. (tai_symbol(hp).sym.typ = AT_FUNCTION) then
  1093. begin
  1094. AsmWriteLn('.section ".opd", "aw"');
  1095. AsmWriteLn('.align 3');
  1096. AsmWriteLn(tai_symbol(hp).sym.name + ':');
  1097. AsmWriteLn('.quad .' + tai_symbol(hp).sym.name + ', .TOC.@tocbase, 0');
  1098. AsmWriteLn('.previous');
  1099. AsmWriteLn('.size ' + tai_symbol(hp).sym.name + ', 24');
  1100. if (tai_symbol(hp).is_global) then
  1101. AsmWriteLn('.globl .' + tai_symbol(hp).sym.name);
  1102. AsmWriteLn('.type .' + tai_symbol(hp).sym.name + ', @function');
  1103. { the dotted name is the name of the actual function entry }
  1104. AsmWrite('.');
  1105. end
  1106. else if (target_info.system in systems_aix) and
  1107. (tai_symbol(hp).sym.typ = AT_FUNCTION) then
  1108. begin
  1109. if target_info.system=system_powerpc_aix then
  1110. begin
  1111. s:=#9'.long .';
  1112. ch:='2';
  1113. end
  1114. else
  1115. begin
  1116. s:=#9'.llong .';
  1117. ch:='3';
  1118. end;
  1119. AsmWriteLn(#9'.csect '+ReplaceForbiddenAsmSymbolChars(tai_symbol(hp).sym.name)+'[DS],'+ch);
  1120. AsmWriteLn(ReplaceForbiddenAsmSymbolChars(tai_symbol(hp).sym.name)+':');
  1121. AsmWriteln(s+ReplaceForbiddenAsmSymbolChars(tai_symbol(hp).sym.name)+', TOC[tc0], 0');
  1122. AsmWriteln(#9'.csect .text[PR]');
  1123. if (tai_symbol(hp).is_global) then
  1124. AsmWriteLn('.globl .'+ReplaceForbiddenAsmSymbolChars(tai_symbol(hp).sym.name))
  1125. else
  1126. AsmWriteLn('.lglobl .'+ReplaceForbiddenAsmSymbolChars(tai_symbol(hp).sym.name));
  1127. { the dotted name is the name of the actual function entry }
  1128. AsmWrite('.');
  1129. end
  1130. else
  1131. begin
  1132. if (target_info.system <> system_arm_linux) then
  1133. sepChar := '@'
  1134. else
  1135. sepChar := '#';
  1136. if (tf_needs_symbol_type in target_info.flags) then
  1137. begin
  1138. AsmWrite(#9'.type'#9 + tai_symbol(hp).sym.name);
  1139. if (needsObject(tai_symbol(hp))) then
  1140. AsmWriteLn(',' + sepChar + 'object')
  1141. else
  1142. AsmWriteLn(',' + sepChar + 'function');
  1143. end;
  1144. end;
  1145. if replaceforbidden then
  1146. if not(tai_symbol(hp).has_value) then
  1147. AsmWriteLn(ReplaceForbiddenAsmSymbolChars(tai_symbol(hp).sym.name + ':'))
  1148. else
  1149. AsmWriteLn(ReplaceForbiddenAsmSymbolChars(tai_symbol(hp).sym.name + '=' + tostr(tai_symbol(hp).value)))
  1150. else if not(tai_symbol(hp).has_value) then
  1151. AsmWriteLn(tai_symbol(hp).sym.name + ':')
  1152. else
  1153. AsmWriteLn(tai_symbol(hp).sym.name + '=' + tostr(tai_symbol(hp).value));
  1154. end;
  1155. {$ifdef arm}
  1156. ait_thumb_func:
  1157. begin
  1158. AsmWriteLn(#9'.thumb_func');
  1159. end;
  1160. {$endif arm}
  1161. {$if defined(alpha)}
  1162. ait_ent:
  1163. begin
  1164. AsmWriteLn(#9'.ent'#9+tai_ent(hp).Name);
  1165. end;
  1166. {$endif alpha}
  1167. ait_symbol_end :
  1168. begin
  1169. if tf_needs_symbol_size in target_info.flags then
  1170. begin
  1171. s:=target_asm.labelprefix+'e'+tostr(symendcount);
  1172. inc(symendcount);
  1173. AsmWriteLn(s+':');
  1174. AsmWrite(#9'.size'#9);
  1175. if (target_info.system = system_powerpc64_linux) and (tai_symbol_end(hp).sym.typ = AT_FUNCTION) then
  1176. AsmWrite('.');
  1177. if replaceforbidden then
  1178. AsmWrite(ReplaceForbiddenAsmSymbolChars(tai_symbol_end(hp).sym.name))
  1179. else
  1180. AsmWrite(tai_symbol_end(hp).sym.name);
  1181. AsmWrite(', '+s+' - ');
  1182. if (target_info.system = system_powerpc64_linux) and (tai_symbol_end(hp).sym.typ = AT_FUNCTION) then
  1183. AsmWrite('.');
  1184. if replaceforbidden then
  1185. AsmWriteLn(ReplaceForbiddenAsmSymbolChars(tai_symbol_end(hp).sym.name))
  1186. else
  1187. AsmWriteLn(tai_symbol_end(hp).sym.name);
  1188. end;
  1189. end;
  1190. ait_instruction :
  1191. begin
  1192. WriteInstruction(hp);
  1193. end;
  1194. ait_stab :
  1195. begin
  1196. if assigned(tai_stab(hp).str) then
  1197. begin
  1198. AsmWrite(#9'.'+stabtypestr[tai_stab(hp).stabtype]+' ');
  1199. AsmWritePChar(tai_stab(hp).str);
  1200. AsmLn;
  1201. end;
  1202. end;
  1203. ait_force_line,
  1204. ait_function_name :
  1205. ;
  1206. ait_cutobject :
  1207. begin
  1208. if SmartAsm then
  1209. begin
  1210. { only reset buffer if nothing has changed }
  1211. if AsmSize=AsmStartSize then
  1212. AsmClear
  1213. else
  1214. begin
  1215. AsmClose;
  1216. DoAssemble;
  1217. AsmCreate(tai_cutobject(hp).place);
  1218. end;
  1219. { avoid empty files }
  1220. while assigned(hp.next) and (tai(hp.next).typ in [ait_cutobject,ait_section,ait_comment]) do
  1221. begin
  1222. if tai(hp.next).typ=ait_section then
  1223. LastSecType:=tai_section(hp.next).sectype;
  1224. hp:=tai(hp.next);
  1225. end;
  1226. if LastSecType<>sec_none then
  1227. WriteSection(LastSecType,'',secorder_default,last_align);
  1228. AsmStartSize:=AsmSize;
  1229. end;
  1230. end;
  1231. ait_marker :
  1232. if tai_marker(hp).kind=mark_NoLineInfoStart then
  1233. inc(InlineLevel)
  1234. else if tai_marker(hp).kind=mark_NoLineInfoEnd then
  1235. dec(InlineLevel);
  1236. ait_directive :
  1237. begin
  1238. WriteDirectiveName(tai_directive(hp).directive);
  1239. if tai_directive(hp).name <>'' then
  1240. AsmWrite(tai_directive(hp).name);
  1241. AsmLn;
  1242. end;
  1243. ait_seh_directive :
  1244. begin
  1245. {$ifdef TEST_WIN64_SEH}
  1246. AsmWrite(sehdirectivestr[tai_seh_directive(hp).kind]);
  1247. case tai_seh_directive(hp).datatype of
  1248. sd_none:;
  1249. sd_string:
  1250. begin
  1251. AsmWrite(' '+tai_seh_directive(hp).data.name^);
  1252. if (tai_seh_directive(hp).data.flags and 1)<>0 then
  1253. AsmWrite(',@except');
  1254. if (tai_seh_directive(hp).data.flags and 2)<>0 then
  1255. AsmWrite(',@unwind');
  1256. end;
  1257. sd_reg:
  1258. AsmWrite(' '+gas_regname(tai_seh_directive(hp).data.reg));
  1259. sd_offset:
  1260. AsmWrite(' '+tostr(tai_seh_directive(hp).data.offset));
  1261. sd_regoffset:
  1262. AsmWrite(' '+gas_regname(tai_seh_directive(hp).data.reg)+', '+
  1263. tostr(tai_seh_directive(hp).data.offset));
  1264. end;
  1265. AsmLn;
  1266. {$endif TEST_WIN64_SEH}
  1267. end;
  1268. ait_varloc:
  1269. begin
  1270. if tai_varloc(hp).newlocationhi<>NR_NO then
  1271. AsmWrite(strpnew('Var '+tai_varloc(hp).varsym.realname+' located in register '+
  1272. std_regname(tai_varloc(hp).newlocationhi)+':'+std_regname(tai_varloc(hp).newlocation)))
  1273. else
  1274. AsmWrite(strpnew('Var '+tai_varloc(hp).varsym.realname+' located in register '+
  1275. std_regname(tai_varloc(hp).newlocation)));
  1276. AsmLn;
  1277. end;
  1278. else
  1279. internalerror(2006012201);
  1280. end;
  1281. hp:=tai(hp.next);
  1282. end;
  1283. end;
  1284. procedure TGNUAssembler.WriteExtraHeader;
  1285. begin
  1286. end;
  1287. procedure TGNUAssembler.WriteExtraFooter;
  1288. begin
  1289. end;
  1290. procedure TGNUAssembler.WriteInstruction(hp: tai);
  1291. begin
  1292. InstrWriter.WriteInstruction(hp);
  1293. end;
  1294. procedure TGNUAssembler.WriteWeakSymbolDef(s: tasmsymbol);
  1295. begin
  1296. AsmWriteLn(#9'.weak '+s.name);
  1297. end;
  1298. procedure TGNUAssembler.WriteAixStringConst(hp: tai_string);
  1299. type
  1300. tterminationkind = (term_none,term_string,term_nostring);
  1301. var
  1302. i: longint;
  1303. pos: longint;
  1304. s: string;
  1305. ch: char;
  1306. instring: boolean;
  1307. procedure newstatement(terminationkind: tterminationkind);
  1308. begin
  1309. case terminationkind of
  1310. term_none: ;
  1311. term_string:
  1312. AsmWriteLn('"');
  1313. term_nostring:
  1314. AsmLn;
  1315. end;
  1316. AsmWrite(#9'.byte'#9);
  1317. pos:=20;
  1318. instring:=false;
  1319. end;
  1320. begin
  1321. pos:=0;
  1322. for i:=1 to hp.len do
  1323. begin
  1324. if pos=0 then
  1325. newstatement(term_none);
  1326. ch:=hp.str[i-1];
  1327. case ch of
  1328. #0..#31,
  1329. #127..#255 :
  1330. begin
  1331. if instring then
  1332. newstatement(term_string);
  1333. if pos=20 then
  1334. s:=tostr(ord(ch))
  1335. else
  1336. s:=', '+tostr(ord(ch))
  1337. end;
  1338. '"' :
  1339. if instring then
  1340. s:='""'
  1341. else
  1342. begin
  1343. if pos<>20 then
  1344. newstatement(term_nostring);
  1345. s:='"""';
  1346. instring:=true;
  1347. end;
  1348. else
  1349. if not instring then
  1350. begin
  1351. if (pos<>20) then
  1352. newstatement(term_nostring);
  1353. s:='"'+ch;
  1354. instring:=true;
  1355. end
  1356. else
  1357. s:=ch;
  1358. end;
  1359. AsmWrite(s);
  1360. inc(pos,length(s));
  1361. if (pos>line_length) or (i=tai_string(hp).len) then
  1362. begin
  1363. if instring then
  1364. AsmWriteLn('"')
  1365. else
  1366. AsmLn;
  1367. pos:=0;
  1368. end;
  1369. end;
  1370. end;
  1371. procedure TGNUAssembler.WriteAixIntConst(hp: tai_const);
  1372. var
  1373. pos, size: longint;
  1374. begin
  1375. { only big endian AIX supported for now }
  1376. if target_info.endian<>endian_big then
  1377. internalerror(2012010401);
  1378. { limitation: can only write 4 bytes at a time }
  1379. pos:=0;
  1380. size:=tai_const(hp).size;
  1381. while pos<(size-4) do
  1382. begin
  1383. AsmWrite(#9'.vbyte'#9'4, ');
  1384. AsmWriteln(tostr(longint(tai_const(hp).value shr ((size-pos-4)*8))));
  1385. inc(pos,4);
  1386. end;
  1387. AsmWrite(#9'.vbyte'#9);
  1388. AsmWrite(tostr(size-pos));
  1389. AsmWrite(', ');
  1390. case size-pos of
  1391. 1: AsmWrite(tostr(byte(tai_const(hp).value)));
  1392. 2: AsmWrite(tostr(word(tai_const(hp).value)));
  1393. 4: AsmWrite(tostr(longint(tai_const(hp).value)));
  1394. else
  1395. internalerror(2012010402);
  1396. end;
  1397. end;
  1398. procedure TGNUAssembler.WriteDirectiveName(dir: TAsmDirective);
  1399. begin
  1400. AsmWrite('.'+directivestr[dir]+' ');
  1401. end;
  1402. procedure TGNUAssembler.WriteAsmList;
  1403. var
  1404. n : string;
  1405. hal : tasmlisttype;
  1406. i: longint;
  1407. begin
  1408. {$ifdef EXTDEBUG}
  1409. if assigned(current_module.mainsource) then
  1410. Comment(V_Debug,'Start writing gas-styled assembler output for '+current_module.mainsource);
  1411. {$endif}
  1412. if current_module.mainsource<>'' then
  1413. n:=ExtractFileName(current_module.mainsource)
  1414. else
  1415. n:=InputFileName;
  1416. { gcc does not add it either for Darwin. Grep for
  1417. TARGET_ASM_FILE_START_FILE_DIRECTIVE in gcc/config/*.h
  1418. }
  1419. if not(target_info.system in systems_darwin) then
  1420. AsmWriteLn(#9'.file "'+FixFileName(n)+'"');
  1421. WriteExtraHeader;
  1422. AsmStartSize:=AsmSize;
  1423. symendcount:=0;
  1424. for hal:=low(TasmlistType) to high(TasmlistType) do
  1425. begin
  1426. AsmWriteLn(target_asm.comment+'Begin asmlist '+AsmlistTypeStr[hal]);
  1427. writetree(current_asmdata.asmlists[hal]);
  1428. AsmWriteLn(target_asm.comment+'End asmlist '+AsmlistTypeStr[hal]);
  1429. end;
  1430. { add weak symbol markers }
  1431. for i:=0 to current_asmdata.asmsymboldict.count-1 do
  1432. if (tasmsymbol(current_asmdata.asmsymboldict[i]).bind=AB_WEAK_EXTERNAL) then
  1433. writeweaksymboldef(tasmsymbol(current_asmdata.asmsymboldict[i]));
  1434. if create_smartlink_sections and
  1435. (target_info.system in systems_darwin) then
  1436. AsmWriteLn(#9'.subsections_via_symbols');
  1437. { "no executable stack" marker for Linux }
  1438. if (target_info.system in systems_linux) and
  1439. not(cs_executable_stack in current_settings.moduleswitches) then
  1440. begin
  1441. AsmWriteLn('.section .note.GNU-stack,"",%progbits');
  1442. end;
  1443. AsmLn;
  1444. {$ifdef EXTDEBUG}
  1445. if assigned(current_module.mainsource) then
  1446. Comment(V_Debug,'Done writing gas-styled assembler output for '+current_module.mainsource);
  1447. {$endif EXTDEBUG}
  1448. end;
  1449. {****************************************************************************}
  1450. { Apple/GNU Assembler writer }
  1451. {****************************************************************************}
  1452. function TAppleGNUAssembler.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;
  1453. begin
  1454. if (target_info.system in systems_darwin) then
  1455. case atype of
  1456. sec_bss:
  1457. { all bss (lcomm) symbols are automatically put in the right }
  1458. { place by using the lcomm assembler directive }
  1459. atype := sec_none;
  1460. sec_debug_frame,
  1461. sec_eh_frame:
  1462. begin
  1463. result := '.section __DWARF,__debug_info,regular,debug';
  1464. exit;
  1465. end;
  1466. sec_debug_line:
  1467. begin
  1468. result := '.section __DWARF,__debug_line,regular,debug';
  1469. exit;
  1470. end;
  1471. sec_debug_info:
  1472. begin
  1473. result := '.section __DWARF,__debug_info,regular,debug';
  1474. exit;
  1475. end;
  1476. sec_debug_abbrev:
  1477. begin
  1478. result := '.section __DWARF,__debug_abbrev,regular,debug';
  1479. exit;
  1480. end;
  1481. sec_rodata:
  1482. begin
  1483. result := '.const_data';
  1484. exit;
  1485. end;
  1486. sec_rodata_norel:
  1487. begin
  1488. result := '.const';
  1489. exit;
  1490. end;
  1491. sec_fpc:
  1492. begin
  1493. result := '.section __TEXT, .fpc, regular, no_dead_strip';
  1494. exit;
  1495. end;
  1496. sec_code:
  1497. begin
  1498. if (aname='fpc_geteipasebx') or
  1499. (aname='fpc_geteipasecx') then
  1500. begin
  1501. result:='.section __TEXT,__textcoal_nt,coalesced,pure_instructions'#10'.weak_definition '+aname+
  1502. #10'.private_extern '+aname;
  1503. exit;
  1504. end;
  1505. end;
  1506. sec_data_nonlazy:
  1507. begin
  1508. result:='.section __DATA, __nl_symbol_ptr,non_lazy_symbol_pointers';
  1509. exit;
  1510. end;
  1511. sec_data_lazy:
  1512. begin
  1513. result:='.section __DATA, __la_symbol_ptr,lazy_symbol_pointers';
  1514. exit;
  1515. end;
  1516. sec_init_func:
  1517. begin
  1518. result:='.section __DATA, __mod_init_func, mod_init_funcs';
  1519. exit;
  1520. end;
  1521. sec_term_func:
  1522. begin
  1523. result:='.section __DATA, __mod_term_func, mod_term_funcs';
  1524. exit;
  1525. end;
  1526. sec_objc_protocol_ext:
  1527. begin
  1528. result:='.section __OBJC, __protocol_ext, regular, no_dead_strip';
  1529. exit;
  1530. end;
  1531. sec_objc_class_ext:
  1532. begin
  1533. result:='.section __OBJC, __class_ext, regular, no_dead_strip';
  1534. exit;
  1535. end;
  1536. sec_objc_property:
  1537. begin
  1538. result:='.section __OBJC, __property, regular, no_dead_strip';
  1539. exit;
  1540. end;
  1541. sec_objc_image_info:
  1542. begin
  1543. result:='.section __OBJC, __image_info, regular, no_dead_strip';
  1544. exit;
  1545. end;
  1546. sec_objc_cstring_object:
  1547. begin
  1548. result:='.section __OBJC, __cstring_object, regular, no_dead_strip';
  1549. exit;
  1550. end;
  1551. sec_objc_sel_fixup:
  1552. begin
  1553. result:='.section __OBJC, __sel_fixup, regular, no_dead_strip';
  1554. exit;
  1555. end;
  1556. sec_objc_message_refs:
  1557. begin
  1558. if (target_info.system in systems_objc_nfabi) then
  1559. begin
  1560. result:='.section __DATA, __objc_selrefs, literal_pointers, no_dead_strip';
  1561. exit;
  1562. end;
  1563. end;
  1564. sec_objc_cls_refs:
  1565. begin
  1566. if (target_info.system in systems_objc_nfabi) then
  1567. begin
  1568. result:='.section __DATA, __objc_clsrefs, regular, no_dead_strip';
  1569. exit;
  1570. end;
  1571. end;
  1572. sec_objc_meth_var_names,
  1573. sec_objc_class_names:
  1574. begin
  1575. if (target_info.system in systems_objc_nfabi) then
  1576. begin
  1577. result:='.cstring';
  1578. exit
  1579. end;
  1580. end;
  1581. sec_objc_inst_meth,
  1582. sec_objc_cls_meth,
  1583. sec_objc_cat_inst_meth,
  1584. sec_objc_cat_cls_meth:
  1585. begin
  1586. if (target_info.system in systems_objc_nfabi) then
  1587. begin
  1588. result:='.section __DATA, __objc_const';
  1589. exit;
  1590. end;
  1591. end;
  1592. sec_objc_meta_class,
  1593. sec_objc_class:
  1594. begin
  1595. if (target_info.system in systems_objc_nfabi) then
  1596. begin
  1597. result:='.section __DATA, __objc_data';
  1598. exit;
  1599. end;
  1600. end;
  1601. sec_objc_sup_refs:
  1602. begin
  1603. result:='.section __DATA, __objc_superrefs, regular, no_dead_strip';
  1604. exit
  1605. end;
  1606. sec_objc_classlist:
  1607. begin
  1608. result:='.section __DATA, __objc_classlist, regular, no_dead_strip';
  1609. exit
  1610. end;
  1611. sec_objc_nlclasslist:
  1612. begin
  1613. result:='.section __DATA, __objc_nlclasslist, regular, no_dead_strip';
  1614. exit
  1615. end;
  1616. sec_objc_catlist:
  1617. begin
  1618. result:='.section __DATA, __objc_catlist, regular, no_dead_strip';
  1619. exit
  1620. end;
  1621. sec_objc_nlcatlist:
  1622. begin
  1623. result:='.section __DATA, __objc_nlcatlist, regular, no_dead_strip';
  1624. exit
  1625. end;
  1626. sec_objc_protolist:
  1627. begin
  1628. result:='.section __DATA, __objc_protolist, coalesced, no_dead_strip';
  1629. exit;
  1630. end;
  1631. end;
  1632. result := inherited sectionname(atype,aname,aorder);
  1633. end;
  1634. procedure TAppleGNUAssembler.WriteWeakSymbolDef(s: tasmsymbol);
  1635. begin
  1636. AsmWriteLn(#9'.weak_reference '+s.name);
  1637. end;
  1638. {****************************************************************************}
  1639. { a.out/GNU Assembler writer }
  1640. {****************************************************************************}
  1641. function TAoutGNUAssembler.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;
  1642. const
  1643. (* Translation table - replace unsupported section types with basic ones. *)
  1644. SecXTable: array[TAsmSectionType] of TAsmSectionType = (
  1645. sec_none,
  1646. sec_none,
  1647. sec_code,
  1648. sec_data,
  1649. sec_data (* sec_rodata *),
  1650. sec_data (* sec_rodata_norel *),
  1651. sec_bss,
  1652. sec_data (* sec_threadvar *),
  1653. { used for wince exception handling }
  1654. sec_code (* sec_pdata *),
  1655. { used for darwin import stubs }
  1656. sec_code (* sec_stub *),
  1657. sec_data,(* sec_data_nonlazy *)
  1658. sec_data,(* sec_data_lazy *)
  1659. sec_data,(* sec_init_func *)
  1660. sec_data,(* sec_term_func *)
  1661. { stabs }
  1662. sec_stab,sec_stabstr,
  1663. { win32 }
  1664. sec_data (* sec_idata2 *),
  1665. sec_data (* sec_idata4 *),
  1666. sec_data (* sec_idata5 *),
  1667. sec_data (* sec_idata6 *),
  1668. sec_data (* sec_idata7 *),
  1669. sec_data (* sec_edata *),
  1670. { C++ exception handling unwinding (uses dwarf) }
  1671. sec_eh_frame,
  1672. { dwarf }
  1673. sec_debug_frame,
  1674. sec_debug_info,
  1675. sec_debug_line,
  1676. sec_debug_abbrev,
  1677. { ELF resources (+ references to stabs debug information sections) }
  1678. sec_code (* sec_fpc *),
  1679. { Table of contents section }
  1680. sec_code (* sec_toc *),
  1681. sec_code (* sec_init *),
  1682. sec_code (* sec_fini *),
  1683. sec_none (* sec_objc_class *),
  1684. sec_none (* sec_objc_meta_class *),
  1685. sec_none (* sec_objc_cat_cls_meth *),
  1686. sec_none (* sec_objc_cat_inst_meth *),
  1687. sec_none (* sec_objc_protocol *),
  1688. sec_none (* sec_objc_string_object *),
  1689. sec_none (* sec_objc_cls_meth *),
  1690. sec_none (* sec_objc_inst_meth *),
  1691. sec_none (* sec_objc_cls_refs *),
  1692. sec_none (* sec_objc_message_refs *),
  1693. sec_none (* sec_objc_symbols *),
  1694. sec_none (* sec_objc_category *),
  1695. sec_none (* sec_objc_class_vars *),
  1696. sec_none (* sec_objc_instance_vars *),
  1697. sec_none (* sec_objc_module_info *),
  1698. sec_none (* sec_objc_class_names *),
  1699. sec_none (* sec_objc_meth_var_types *),
  1700. sec_none (* sec_objc_meth_var_names *),
  1701. sec_none (* sec_objc_selector_strs *),
  1702. sec_none (* sec_objc_protocol_ext *),
  1703. sec_none (* sec_objc_class_ext *),
  1704. sec_none (* sec_objc_property *),
  1705. sec_none (* sec_objc_image_info *),
  1706. sec_none (* sec_objc_cstring_object *),
  1707. sec_none (* sec_objc_sel_fixup *),
  1708. sec_none (* sec_objc_data *),
  1709. sec_none (* sec_objc_const *),
  1710. sec_none (* sec_objc_sup_refs *),
  1711. sec_none (* sec_data_coalesced *),
  1712. sec_none (* sec_objc_classlist *),
  1713. sec_none (* sec_objc_nlclasslist *),
  1714. sec_none (* sec_objc_catlist *),
  1715. sec_none (* sec_objc_nlcatlist *),
  1716. sec_none (* sec_objc_protlist *)
  1717. );
  1718. begin
  1719. Result := inherited SectionName (SecXTable [AType], AName, AOrder);
  1720. end;
  1721. {****************************************************************************}
  1722. { Abstract Instruction Writer }
  1723. {****************************************************************************}
  1724. constructor TCPUInstrWriter.create(_owner: TGNUAssembler);
  1725. begin
  1726. inherited create;
  1727. owner := _owner;
  1728. end;
  1729. end.