aasmbase.pas 28 KB

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