aasmbase.pas 28 KB

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