aasmbase.pas 28 KB

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