aasmbase.pas 27 KB

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