aasmbase.pas 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. This unit implements an abstract asmoutput class for all processor types
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. { @abstract(This unit implements an abstract asm output class for all processor types)
  18. This unit implements an abstract assembler output class for all processors, these
  19. are then overriden for each assembler writer to actually write the data in these
  20. classes to an assembler file.
  21. }
  22. unit aasmbase;
  23. {$i fpcdefs.inc}
  24. interface
  25. uses
  26. cutils,cclasses,
  27. globtype,globals,systems
  28. ;
  29. type
  30. TAsmSection = class;
  31. TAsmObjectData = class;
  32. TAsmsymbind=(AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL);
  33. TAsmsymtype=(AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION,AT_LABEL);
  34. TAsmRelocationType = (RELOC_ABSOLUTE,RELOC_RELATIVE,RELOC_RVA);
  35. TAsmSectionType=(sec_none,
  36. sec_code,sec_data,sec_rodata,sec_bss,sec_threadvar,
  37. { used for executable creation }
  38. sec_common,
  39. { custom section, no prefix }
  40. sec_custom,
  41. { used for darwin import stubs }
  42. sec_stub,
  43. { stabs }
  44. sec_stab,sec_stabstr,
  45. { win32 }
  46. sec_idata2,sec_idata4,sec_idata5,sec_idata6,sec_idata7,sec_edata,
  47. { C++ exception handling unwinding (uses dwarf) }
  48. sec_eh_frame,
  49. { dwarf }
  50. sec_debug_frame,
  51. sec_debug_info,
  52. sec_debug_line,
  53. sec_debug_abrev,
  54. { ELF resources }
  55. sec_fpc,
  56. { Table of contents section }
  57. sec_toc
  58. );
  59. TAsmSectionOption = (aso_alloconly,aso_executable);
  60. TAsmSectionOptions = set of TAsmSectionOption;
  61. TAsmSymbol = class(TNamedIndexItem)
  62. private
  63. { this need to be incremented with every symbol loading into the
  64. paasmoutput, thus in loadsym/loadref/const_symbol (PFV) }
  65. refs : longint;
  66. public
  67. defbind,
  68. currbind : TAsmsymbind;
  69. typ : TAsmsymtype;
  70. { the next fields are filled in the binary writer }
  71. section : TAsmSection;
  72. address,
  73. size : aint;
  74. { Alternate symbol which can be used for 'renaming' needed for
  75. inlining }
  76. altsymbol : tasmsymbol;
  77. { pointer to objectdata that is the owner of this symbol }
  78. owner : tasmobjectdata;
  79. { Is the symbol in the used list }
  80. inusedlist : boolean;
  81. { assembler pass label is set, used for detecting multiple labels }
  82. pass : byte;
  83. ppuidx : longint;
  84. constructor create(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
  85. procedure reset;
  86. function is_used:boolean;
  87. procedure increfs;
  88. procedure decrefs;
  89. function getrefs: longint;
  90. procedure setaddress(_pass:byte;sec:TAsmSection;offset,len:aint);
  91. end;
  92. { is the label only there for getting an address (e.g. for i/o
  93. checks -> alt_addr) or is it a jump target (alt_jump), for debug
  94. info alt_dbgline and alt_dbgfile }
  95. TAsmLabelType = (alt_jump,alt_addr,alt_data,alt_dbgline,alt_dbgfile,alt_dbgtype,alt_dbgframe);
  96. TAsmLabel = class(TAsmSymbol)
  97. labelnr : longint;
  98. labeltype : TAsmLabelType;
  99. is_set : boolean;
  100. constructor createlocal(nr:longint;ltyp:TAsmLabelType);
  101. constructor createglobal(const modulename:string;nr:longint;ltyp:TAsmLabelType);
  102. function getname:string;override;
  103. end;
  104. TAsmRelocation = class(TLinkedListItem)
  105. address,
  106. orgsize : aint; { original size of the symbol to relocate, required for COFF }
  107. symbol : TAsmSymbol;
  108. section : TAsmSection; { only used if symbol=nil }
  109. typ : TAsmRelocationType;
  110. constructor CreateSymbol(Aaddress:aint;s:Tasmsymbol;Atyp:TAsmRelocationType);
  111. constructor CreateSymbolSize(Aaddress:aint;s:Tasmsymbol;Aorgsize:aint;Atyp:TAsmRelocationType);
  112. constructor CreateSection(Aaddress:aint;sec:TAsmSection;Atyp:TAsmRelocationType);
  113. end;
  114. TAsmSection = class(TNamedIndexItem)
  115. owner : TAsmObjectData;
  116. secoptions : TAsmSectionOptions;
  117. sectype : TAsmSectionType;
  118. secsymidx : longint; { index for the section in symtab }
  119. addralign : longint; { alignment of the section }
  120. { size of the data and in the file }
  121. dataalignbytes : longint;
  122. data : TDynamicArray;
  123. datasize,
  124. datapos : aint;
  125. { size and position in memory }
  126. memsize,
  127. mempos : aint;
  128. { relocation }
  129. relocations : TLinkedList;
  130. constructor create(const Aname:string;Atype:TAsmSectionType;Aalign:longint;Aoptions:TAsmSectionOptions);virtual;
  131. destructor destroy;override;
  132. function write(const d;l:aint):aint;
  133. function writestr(const s:string):aint;
  134. procedure writealign(l:longint);
  135. function aligneddatasize:aint;
  136. procedure setdatapos(var dpos:aint);
  137. procedure alignsection;
  138. procedure alloc(l:aint);
  139. procedure addsymreloc(ofs:aint;p:tasmsymbol;relative:TAsmRelocationType);
  140. procedure addsectionreloc(ofs:aint;sec:TAsmSection;relative:TAsmRelocationType);
  141. procedure fixuprelocs;virtual;
  142. end;
  143. TAsmSectionClass = class of TAsmSection;
  144. TAsmObjectData = class(TLinkedListItem)
  145. private
  146. FName : string[80];
  147. FCurrSec : TAsmSection;
  148. { Sections will be stored in order in SectsIndex, this is at least
  149. required for stabs debuginfo. The SectsDict is only used for lookups (PFV) }
  150. FSectsDict : TDictionary;
  151. FSectsIndex : TIndexArray;
  152. FCAsmSection : TAsmSectionClass;
  153. { Symbols that will be defined in this object file }
  154. FSymbols : TIndexArray;
  155. { Special info sections that are written to during object generation }
  156. FStabsRecSize : longint;
  157. FStabsSec,
  158. FStabStrSec : TAsmSection;
  159. procedure section_reset(p:tnamedindexitem;arg:pointer);
  160. procedure section_fixuprelocs(p:tnamedindexitem;arg:pointer);
  161. protected
  162. property StabsRecSize:longint read FStabsRecSize write FStabsRecSize;
  163. property StabsSec:TAsmSection read FStabsSec write FStabsSec;
  164. property StabStrSec:TAsmSection read FStabStrSec write FStabStrSec;
  165. property CAsmSection:TAsmSectionClass read FCAsmSection write FCAsmSection;
  166. public
  167. constructor create(const n:string);virtual;
  168. destructor destroy;override;
  169. function sectionname(atype:tasmsectiontype;const aname:string):string;virtual;
  170. function createsection(atype:tasmsectiontype;const aname:string;aalign:longint;aoptions:TAsmSectionOptions):tasmsection;virtual;
  171. procedure setsection(asec:tasmsection);
  172. procedure alloc(len:aint);
  173. procedure allocalign(len:longint);
  174. procedure allocstab(p:pchar);
  175. procedure allocsymbol(currpass:byte;p:tasmsymbol;len:aint);
  176. procedure writebytes(var data;len:aint);
  177. procedure writereloc(data,len:aint;p:tasmsymbol;relative:TAsmRelocationType);virtual;abstract;
  178. procedure writesymbol(p:tasmsymbol);virtual;abstract;
  179. procedure writestab(offset:aint;ps:tasmsymbol;nidx,nother,line:longint;p:pchar);virtual;abstract;
  180. procedure beforealloc;virtual;
  181. procedure beforewrite;virtual;
  182. procedure afteralloc;virtual;
  183. procedure afterwrite;virtual;
  184. procedure resetsections;
  185. procedure fixuprelocs;
  186. property Name:string[80] read FName;
  187. property CurrSec:TAsmSection read FCurrSec;
  188. property Symbols:TindexArray read FSymbols;
  189. property Sects:TIndexArray read FSectsIndex;
  190. end;
  191. TAsmObjectDataClass = class of TAsmObjectData;
  192. tasmsymbolidxarr = array[0..($7fffffff div sizeof(pointer))-1] of tasmsymbol;
  193. pasmsymbolidxarr = ^tasmsymbolidxarr;
  194. TAsmLibraryData = class(TLinkedListItem)
  195. private
  196. nextaltnr : longint;
  197. nextlabelnr : array[Tasmlabeltype] of longint;
  198. public
  199. name,
  200. realname : string[80];
  201. symbolsearch : tdictionary; { contains ALL assembler symbols }
  202. usedasmsymbollist : tsinglelist;
  203. { ppu }
  204. asmsymbolppuidx : longint;
  205. asmsymbolidx : pasmsymbolidxarr; { used for translating ppu index->asmsymbol }
  206. constructor create(const n:string);
  207. destructor destroy;override;
  208. procedure Freeasmsymbolidx;
  209. procedure DerefAsmsymbol(var s:tasmsymbol);
  210. { asmsymbol }
  211. function newasmsymbol(const s : string;_bind:TAsmSymBind;_typ:TAsmsymtype) : tasmsymbol;
  212. function getasmsymbol(const s : string) : tasmsymbol;
  213. function renameasmsymbol(const sold, snew : string):tasmsymbol;
  214. function newasmlabel(nr:longint;alt:tasmlabeltype;is_global:boolean) : tasmlabel;
  215. {# create a new assembler label }
  216. procedure getlabel(var l : tasmlabel;alt:tasmlabeltype);
  217. {# create a new assembler label for jumps }
  218. procedure getjumplabel(var l : tasmlabel);
  219. { make l as a new label and flag is_addr }
  220. procedure getaddrlabel(var l : tasmlabel);
  221. { make l as a new label and flag is_data }
  222. procedure getdatalabel(var l : tasmlabel);
  223. {# return a label number }
  224. procedure CreateUsedAsmSymbolList;
  225. procedure DestroyUsedAsmSymbolList;
  226. procedure UsedAsmSymbolListInsert(p:tasmsymbol);
  227. { generate an alternative (duplicate) symbol }
  228. procedure GenerateAltSymbol(p:tasmsymbol);
  229. { reset alternative symbol information }
  230. procedure UsedAsmSymbolListResetAltSym;
  231. procedure UsedAsmSymbolListReset;
  232. procedure UsedAsmSymbolListCheckUndefined;
  233. end;
  234. const
  235. { alt_jump,alt_addr,alt_data,alt_dbgline,alt_dbgfile }
  236. asmlabeltypeprefix : array[tasmlabeltype] of char = ('j','a','d','l','f','t','c');
  237. var
  238. objectlibrary : tasmlibrarydata;
  239. implementation
  240. uses
  241. strings,
  242. verbose;
  243. const
  244. sectsgrow = 100;
  245. symbolsgrow = 100;
  246. {*****************************************************************************
  247. TAsmSymbol
  248. *****************************************************************************}
  249. constructor tasmsymbol.create(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
  250. begin;
  251. inherited createname(s);
  252. reset;
  253. defbind:=_bind;
  254. typ:=_typ;
  255. inusedlist:=false;
  256. pass:=255;
  257. ppuidx:=-1;
  258. { mainly used to remove unused labels from the al_procedures }
  259. refs:=0;
  260. end;
  261. procedure tasmsymbol.reset;
  262. begin
  263. { reset section info }
  264. section:=nil;
  265. address:=0;
  266. size:=0;
  267. indexnr:=-1;
  268. pass:=255;
  269. currbind:=AB_EXTERNAL;
  270. altsymbol:=nil;
  271. { taiowner:=nil;}
  272. end;
  273. function tasmsymbol.is_used:boolean;
  274. begin
  275. is_used:=(refs>0);
  276. end;
  277. procedure tasmsymbol.increfs;
  278. begin
  279. inc(refs);
  280. end;
  281. procedure tasmsymbol.decrefs;
  282. begin
  283. dec(refs);
  284. if refs<0 then
  285. internalerror(200211121);
  286. end;
  287. function tasmsymbol.getrefs: longint;
  288. begin
  289. getrefs := refs;
  290. end;
  291. procedure tasmsymbol.setaddress(_pass:byte;sec:TAsmSection;offset,len:aint);
  292. begin
  293. if (_pass=pass) then
  294. begin
  295. Message1(asmw_e_duplicate_label,name);
  296. exit;
  297. end;
  298. pass:=_pass;
  299. section:=sec;
  300. address:=offset;
  301. size:=len;
  302. { when the bind was reset to External, set it back to the default
  303. bind it got when defined }
  304. if (currbind=AB_EXTERNAL) and (defbind<>AB_NONE) then
  305. currbind:=defbind;
  306. end;
  307. {*****************************************************************************
  308. TAsmLabel
  309. *****************************************************************************}
  310. constructor tasmlabel.createlocal(nr:longint;ltyp:TAsmLabelType);
  311. begin;
  312. inherited create(target_asm.labelprefix+asmlabeltypeprefix[ltyp]+tostr(nr),AB_LOCAL,AT_LABEL);
  313. labelnr:=nr;
  314. labeltype:=ltyp;
  315. is_set:=false;
  316. end;
  317. constructor tasmlabel.createglobal(const modulename:string;nr:longint;ltyp:TAsmLabelType);
  318. begin;
  319. inherited create('_$'+modulename+'$_L'+asmlabeltypeprefix[ltyp]+tostr(nr),AB_GLOBAL,AT_DATA);
  320. labelnr:=nr;
  321. labeltype:=ltyp;
  322. is_set:=false;
  323. { write it always }
  324. increfs;
  325. end;
  326. function tasmlabel.getname:string;
  327. begin
  328. getname:=inherited getname;
  329. increfs;
  330. end;
  331. {****************************************************************************
  332. TAsmRelocation
  333. ****************************************************************************}
  334. constructor TAsmRelocation.CreateSymbol(Aaddress:aint;s:Tasmsymbol;Atyp:TAsmRelocationType);
  335. begin
  336. Address:=Aaddress;
  337. Symbol:=s;
  338. OrgSize:=0;
  339. Section:=nil;
  340. Typ:=Atyp;
  341. end;
  342. constructor TAsmRelocation.CreateSymbolSize(Aaddress:aint;s:Tasmsymbol;Aorgsize:aint;Atyp:TAsmRelocationType);
  343. begin
  344. Address:=Aaddress;
  345. Symbol:=s;
  346. OrgSize:=Aorgsize;
  347. Section:=nil;
  348. Typ:=Atyp;
  349. end;
  350. constructor TAsmRelocation.CreateSection(Aaddress:aint;sec:TAsmSection;Atyp:TAsmRelocationType);
  351. begin
  352. Address:=Aaddress;
  353. Symbol:=nil;
  354. OrgSize:=0;
  355. Section:=sec;
  356. Typ:=Atyp;
  357. end;
  358. {****************************************************************************
  359. TAsmSection
  360. ****************************************************************************}
  361. constructor TAsmSection.create(const Aname:string;Atype:TAsmSectionType;Aalign:longint;Aoptions:TAsmSectionOptions);
  362. begin
  363. inherited createname(Aname);
  364. sectype:=Atype;
  365. name:=Aname;
  366. secoptions:=Aoptions;
  367. secsymidx:=0;
  368. addralign:=Aalign;
  369. { data }
  370. datasize:=0;
  371. datapos:=0;
  372. if (aso_alloconly in aoptions) then
  373. data:=nil
  374. else
  375. Data:=TDynamicArray.Create(8192);
  376. { memory }
  377. mempos:=0;
  378. memsize:=0;
  379. { relocation }
  380. relocations:=TLinkedList.Create;
  381. end;
  382. destructor TAsmSection.destroy;
  383. begin
  384. if assigned(Data) then
  385. Data.Free;
  386. relocations.free;
  387. end;
  388. function TAsmSection.write(const d;l:aint):aint;
  389. begin
  390. write:=datasize;
  391. if assigned(Data) then
  392. Data.write(d,l);
  393. inc(datasize,l);
  394. end;
  395. function TAsmSection.writestr(const s:string):aint;
  396. begin
  397. writestr:=datasize;
  398. if assigned(Data) then
  399. Data.write(s[1],length(s));
  400. inc(datasize,length(s));
  401. end;
  402. procedure TAsmSection.writealign(l:longint);
  403. var
  404. i : longint;
  405. empty : array[0..63] of char;
  406. begin
  407. { no alignment needed for 0 or 1 }
  408. if l<=1 then
  409. exit;
  410. i:=datasize mod l;
  411. if i>0 then
  412. begin
  413. if assigned(data) then
  414. begin
  415. fillchar(empty,sizeof(empty),0);
  416. Data.write(empty,l-i);
  417. end;
  418. inc(datasize,l-i);
  419. end;
  420. end;
  421. function TAsmSection.aligneddatasize:aint;
  422. begin
  423. aligneddatasize:=align(datasize,addralign);
  424. end;
  425. procedure TAsmSection.setdatapos(var dpos:aint);
  426. var
  427. alignedpos : aint;
  428. begin
  429. { get aligned datapos }
  430. alignedpos:=align(dpos,addralign);
  431. dataalignbytes:=alignedpos-dpos;
  432. datapos:=alignedpos;
  433. { update datapos }
  434. dpos:=datapos+aligneddatasize;
  435. end;
  436. procedure TAsmSection.alignsection;
  437. begin
  438. writealign(addralign);
  439. end;
  440. procedure TAsmSection.alloc(l:aint);
  441. begin
  442. inc(datasize,l);
  443. end;
  444. procedure TAsmSection.addsymreloc(ofs:aint;p:tasmsymbol;relative:TAsmRelocationType);
  445. var
  446. r : TAsmRelocation;
  447. begin
  448. r:=TAsmRelocation.Create;
  449. r.address:=ofs;
  450. r.orgsize:=0;
  451. r.symbol:=p;
  452. r.section:=nil;
  453. r.typ:=relative;
  454. relocations.concat(r);
  455. end;
  456. procedure TAsmSection.addsectionreloc(ofs:aint;sec:TAsmSection;relative:TAsmRelocationType);
  457. var
  458. r : TAsmRelocation;
  459. begin
  460. r:=TAsmRelocation.Create;
  461. r.address:=ofs;
  462. r.symbol:=nil;
  463. r.orgsize:=0;
  464. r.section:=sec;
  465. r.typ:=relative;
  466. relocations.concat(r);
  467. end;
  468. procedure TAsmSection.fixuprelocs;
  469. begin
  470. end;
  471. {****************************************************************************
  472. TAsmObjectData
  473. ****************************************************************************}
  474. constructor TAsmObjectData.create(const n:string);
  475. begin
  476. inherited create;
  477. FName:=n;
  478. { sections, the SectsIndex owns the items, the FSectsDict
  479. is only used for lookups }
  480. FSectsDict:=tdictionary.create;
  481. FSectsDict.noclear:=true;
  482. FSectsIndex:=tindexarray.create(sectsgrow);
  483. FStabsRecSize:=1;
  484. FStabsSec:=nil;
  485. FStabStrSec:=nil;
  486. { symbols }
  487. FSymbols:=tindexarray.create(symbolsgrow);
  488. FSymbols.noclear:=true;
  489. { section class type for creating of new sections }
  490. FCAsmSection:=TAsmSection;
  491. end;
  492. destructor TAsmObjectData.destroy;
  493. begin
  494. FSectsDict.free;
  495. FSectsIndex.free;
  496. FSymbols.free;
  497. end;
  498. function TAsmObjectData.sectionname(atype:tasmsectiontype;const aname:string):string;
  499. const
  500. secnames : array[tasmsectiontype] of string[12] = ('',
  501. 'code','data','rodata','bss','threadvar',
  502. 'common',
  503. 'note',
  504. 'text',
  505. 'stab','stabstr',
  506. 'idata2','idata4','idata5','idata6','idata7','edata',
  507. 'eh_frame',
  508. 'debug_frame','debug_info','debug_line','debug_abrev',
  509. 'fpc',
  510. 'toc'
  511. );
  512. begin
  513. if aname<>'' then
  514. result:=secnames[atype]+'.'+aname
  515. else
  516. result:=secnames[atype];
  517. end;
  518. function TAsmObjectData.createsection(atype:tasmsectiontype;const aname:string;aalign:longint;aoptions:TAsmSectionOptions):TAsmSection;
  519. var
  520. secname : string;
  521. begin
  522. secname:=sectionname(atype,aname);
  523. result:=TasmSection(FSectsDict.search(secname));
  524. if not assigned(result) then
  525. begin
  526. {$warning TODO make alloconly configurable}
  527. if atype=sec_bss then
  528. include(aoptions,aso_alloconly);
  529. result:=CAsmSection.create(secname,atype,aalign,aoptions);
  530. FSectsDict.Insert(result);
  531. FSectsIndex.Insert(result);
  532. result.owner:=self;
  533. end;
  534. FCurrSec:=result;
  535. end;
  536. procedure TAsmObjectData.setsection(asec:tasmsection);
  537. begin
  538. if asec.owner<>self then
  539. internalerror(200403041);
  540. FCurrSec:=asec;
  541. end;
  542. procedure TAsmObjectData.writebytes(var data;len:aint);
  543. begin
  544. if not assigned(currsec) then
  545. internalerror(200402251);
  546. currsec.write(data,len);
  547. end;
  548. procedure TAsmObjectData.alloc(len:aint);
  549. begin
  550. if not assigned(currsec) then
  551. internalerror(200402252);
  552. currsec.alloc(len);
  553. end;
  554. procedure TAsmObjectData.allocalign(len:longint);
  555. var
  556. modulo : aint;
  557. begin
  558. if not assigned(currsec) then
  559. internalerror(200402253);
  560. modulo:=currsec.datasize mod len;
  561. if modulo > 0 then
  562. currsec.alloc(len-modulo);
  563. end;
  564. procedure TAsmObjectData.allocsymbol(currpass:byte;p:tasmsymbol;len:aint);
  565. begin
  566. p.setaddress(currpass,currsec,currsec.datasize,len);
  567. end;
  568. procedure TAsmObjectData.allocstab(p:pchar);
  569. begin
  570. if not(assigned(FStabsSec) and assigned(FStabStrSec)) then
  571. internalerror(200402254);
  572. FStabsSec.alloc(FStabsRecSize);
  573. if assigned(p) and (p[0]<>#0) then
  574. FStabStrSec.alloc(strlen(p)+1);
  575. end;
  576. procedure TAsmObjectData.section_reset(p:tnamedindexitem;arg:pointer);
  577. begin
  578. with tasmsection(p) do
  579. begin
  580. datasize:=0;
  581. datapos:=0;
  582. end;
  583. end;
  584. procedure TAsmObjectData.section_fixuprelocs(p:tnamedindexitem;arg:pointer);
  585. begin
  586. tasmsection(p).fixuprelocs;
  587. end;
  588. procedure TAsmObjectData.beforealloc;
  589. begin
  590. end;
  591. procedure TAsmObjectData.beforewrite;
  592. begin
  593. end;
  594. procedure TAsmObjectData.afteralloc;
  595. begin
  596. end;
  597. procedure TAsmObjectData.afterwrite;
  598. begin
  599. end;
  600. procedure TAsmObjectData.resetsections;
  601. begin
  602. FSectsDict.foreach(@section_reset,nil);
  603. end;
  604. procedure TAsmObjectData.fixuprelocs;
  605. begin
  606. FSectsDict.foreach(@section_fixuprelocs,nil);
  607. end;
  608. {****************************************************************************
  609. TAsmLibraryData
  610. ****************************************************************************}
  611. constructor TAsmLibraryData.create(const n:string);
  612. var
  613. alt : TAsmLabelType;
  614. begin
  615. inherited create;
  616. realname:=n;
  617. name:=upper(n);
  618. { symbols }
  619. symbolsearch:=tdictionary.create;
  620. symbolsearch.usehash;
  621. { labels }
  622. nextaltnr:=1;
  623. for alt:=low(TAsmLabelType) to high(TAsmLabelType) do
  624. nextlabelnr[alt]:=1;
  625. { ppu }
  626. asmsymbolppuidx:=0;
  627. asmsymbolidx:=nil;
  628. end;
  629. destructor TAsmLibraryData.destroy;
  630. begin
  631. symbolsearch.free;
  632. Freeasmsymbolidx;
  633. end;
  634. procedure TAsmLibraryData.Freeasmsymbolidx;
  635. begin
  636. if assigned(asmsymbolidx) then
  637. begin
  638. Freemem(asmsymbolidx);
  639. asmsymbolidx:=nil;
  640. end;
  641. end;
  642. procedure TAsmLibraryData.DerefAsmsymbol(var s:tasmsymbol);
  643. begin
  644. if assigned(s) then
  645. begin
  646. if not assigned(asmsymbolidx) then
  647. internalerror(200208072);
  648. if (ptrint(pointer(s))<1) or (ptrint(pointer(s))>asmsymbolppuidx) then
  649. internalerror(200208073);
  650. s:=asmsymbolidx^[ptrint(pointer(s))-1];
  651. end;
  652. end;
  653. function TAsmLibraryData.newasmsymbol(const s : string;_bind:TAsmSymBind;_typ:Tasmsymtype) : tasmsymbol;
  654. var
  655. hp : tasmsymbol;
  656. begin
  657. hp:=tasmsymbol(symbolsearch.search(s));
  658. if assigned(hp) then
  659. begin
  660. {$IFDEF EXTDEBUG}
  661. if (_typ <> AT_NONE) and
  662. (hp.typ <> _typ) and
  663. not(cs_compilesystem in aktmoduleswitches) and
  664. (target_info.system <> system_powerpc_darwin) then
  665. begin
  666. //Writeln('Error symbol '+hp.name+' type is ',Ord(_typ),', should be ',Ord(hp.typ));
  667. InternalError(2004031501);
  668. end;
  669. {$ENDIF}
  670. if (_bind<>AB_EXTERNAL) then
  671. hp.defbind:=_bind
  672. end
  673. else
  674. begin
  675. { Not found, insert it. }
  676. hp:=tasmsymbol.create(s,_bind,_typ);
  677. symbolsearch.insert(hp);
  678. end;
  679. newasmsymbol:=hp;
  680. end;
  681. function TAsmLibraryData.getasmsymbol(const s : string) : tasmsymbol;
  682. begin
  683. getasmsymbol:=tasmsymbol(symbolsearch.search(s));
  684. end;
  685. function TAsmLibraryData.renameasmsymbol(const sold, snew : string):tasmsymbol;
  686. begin
  687. renameasmsymbol:=tasmsymbol(symbolsearch.rename(sold,snew));
  688. end;
  689. procedure TAsmLibraryData.CreateUsedAsmSymbolList;
  690. begin
  691. if assigned(usedasmsymbollist) then
  692. internalerror(78455782);
  693. usedasmsymbollist:=TSingleList.create;
  694. end;
  695. procedure TAsmLibraryData.DestroyUsedAsmSymbolList;
  696. begin
  697. usedasmsymbollist.destroy;
  698. usedasmsymbollist:=nil;
  699. end;
  700. procedure TAsmLibraryData.UsedAsmSymbolListInsert(p:tasmsymbol);
  701. begin
  702. if not p.inusedlist then
  703. usedasmsymbollist.insert(p);
  704. p.inusedlist:=true;
  705. end;
  706. procedure TAsmLibraryData.GenerateAltSymbol(p:tasmsymbol);
  707. begin
  708. if not assigned(p.altsymbol) then
  709. begin
  710. p.altsymbol:=tasmsymbol.create(p.name+'_'+tostr(nextaltnr),p.defbind,p.typ);
  711. symbolsearch.insert(p.altsymbol);
  712. { add also the original sym to the usedasmsymbollist,
  713. that list is used to reset the altsymbol }
  714. if not p.inusedlist then
  715. usedasmsymbollist.insert(p);
  716. p.inusedlist:=true;
  717. end;
  718. end;
  719. procedure TAsmLibraryData.UsedAsmSymbolListReset;
  720. var
  721. hp : tasmsymbol;
  722. begin
  723. hp:=tasmsymbol(usedasmsymbollist.first);
  724. while assigned(hp) do
  725. begin
  726. with hp do
  727. begin
  728. reset;
  729. inusedlist:=false;
  730. end;
  731. hp:=tasmsymbol(hp.listnext);
  732. end;
  733. end;
  734. procedure TAsmLibraryData.UsedAsmSymbolListResetAltSym;
  735. var
  736. hp : tasmsymbol;
  737. begin
  738. hp:=tasmsymbol(usedasmsymbollist.first);
  739. inc(nextaltnr);
  740. while assigned(hp) do
  741. begin
  742. with hp do
  743. begin
  744. altsymbol:=nil;
  745. inusedlist:=false;
  746. end;
  747. hp:=tasmsymbol(hp.listnext);
  748. end;
  749. end;
  750. procedure TAsmLibraryData.UsedAsmSymbolListCheckUndefined;
  751. var
  752. hp : tasmsymbol;
  753. begin
  754. hp:=tasmsymbol(usedasmsymbollist.first);
  755. while assigned(hp) do
  756. begin
  757. with hp do
  758. begin
  759. if is_used and
  760. (section=nil) and
  761. not(currbind in [AB_EXTERNAL,AB_COMMON]) then
  762. Message1(asmw_e_undefined_label,name);
  763. end;
  764. hp:=tasmsymbol(hp.listnext);
  765. end;
  766. end;
  767. function TAsmLibraryData.newasmlabel(nr:longint;alt:tasmlabeltype;is_global:boolean) : tasmlabel;
  768. var
  769. hp : tasmlabel;
  770. begin
  771. if is_global then
  772. hp:=tasmlabel.createglobal(name,nr,alt)
  773. else
  774. hp:=tasmlabel.createlocal(nr,alt);
  775. symbolsearch.insert(hp);
  776. newasmlabel:=hp;
  777. end;
  778. procedure TAsmLibraryData.getlabel(var l : tasmlabel;alt:tasmlabeltype);
  779. begin
  780. l:=tasmlabel.createlocal(nextlabelnr[alt],alt);
  781. inc(nextlabelnr[alt]);
  782. symbolsearch.insert(l);
  783. end;
  784. procedure TAsmLibraryData.getjumplabel(var l : tasmlabel);
  785. begin
  786. l:=tasmlabel.createlocal(nextlabelnr[alt_jump],alt_jump);
  787. inc(nextlabelnr[alt_jump]);
  788. symbolsearch.insert(l);
  789. end;
  790. procedure TAsmLibraryData.getdatalabel(var l : tasmlabel);
  791. begin
  792. l:=tasmlabel.createglobal(name,nextlabelnr[alt_data],alt_data);
  793. inc(nextlabelnr[alt_data]);
  794. symbolsearch.insert(l);
  795. end;
  796. procedure TAsmLibraryData.getaddrlabel(var l : tasmlabel);
  797. begin
  798. l:=tasmlabel.createlocal(nextlabelnr[alt_addr],alt_addr);
  799. inc(nextlabelnr[alt_addr]);
  800. symbolsearch.insert(l);
  801. end;
  802. end.