aasmbase.pas 27 KB

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