aasmbase.pas 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963
  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. { asm symbol functions }
  30. type
  31. TAsmsymbind=(AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL);
  32. TAsmsymtype=(AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION);
  33. TAsmRelocationType = (RELOC_ABSOLUTE,RELOC_RELATIVE,RELOC_RVA);
  34. TAsmSectionSizes = array[TSection] of longint;
  35. TAsmSymbol = class(TNamedIndexItem)
  36. private
  37. { this need to be incremented with every symbol loading into the
  38. paasmoutput, thus in loadsym/loadref/const_symbol (PFV) }
  39. refs : longint;
  40. public
  41. defbind,
  42. currbind : TAsmsymbind;
  43. typ : TAsmsymtype;
  44. { the next fields are filled in the binary writer }
  45. section : TSection;
  46. address,
  47. size : longint;
  48. { Alternate symbol which can be used for 'renaming' needed for
  49. inlining }
  50. altsymbol : tasmsymbol;
  51. { pointer to objectdata that is the owner of this symbol }
  52. objectdata : pointer;
  53. { pointer to the tai that is the owner of this symbol }
  54. { taiowner : pointer;}
  55. { Is the symbol in the used list }
  56. inusedlist : boolean;
  57. { assembler pass label is set, used for detecting multiple labels }
  58. pass : byte;
  59. ppuidx : longint;
  60. constructor create(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
  61. procedure reset;
  62. function is_used:boolean;
  63. procedure increfs;
  64. procedure decrefs;
  65. procedure setaddress(_pass:byte;sec:TSection;offset,len:longint);
  66. end;
  67. TAsmLabel = class(TAsmSymbol)
  68. { this is set by the tai_label.Init }
  69. is_set,
  70. { is the label only there for getting an address (e.g. for i/o }
  71. { checks -> true) or is it a jump target (false) }
  72. is_addr : boolean;
  73. labelnr : longint;
  74. constructor create(nr:longint);
  75. constructor createdata(const modulename:string;nr:longint);
  76. constructor createaddr(nr:longint);
  77. function getname:string;override;
  78. end;
  79. TAsmRelocation = class(TLinkedListItem)
  80. address,
  81. orgsize : longint; { original size of the symbol to relocate, required for COFF }
  82. symbol : tasmsymbol;
  83. section : TSection; { only used if symbol=nil }
  84. typ : TAsmRelocationType;
  85. constructor CreateSymbol(Aaddress:longint;s:Tasmsymbol;Atyp:TAsmRelocationType);
  86. constructor CreateSymbolSize(Aaddress:longint;s:Tasmsymbol;Aorgsize:longint;Atyp:TAsmRelocationType);
  87. constructor CreateSection(Aaddress:longint;sec:TSection;Atyp:TAsmRelocationType);
  88. end;
  89. TAsmSection = class(TLinkedListItem)
  90. name : string[32];
  91. secsymidx : longint; { index for the section in symtab }
  92. addralign : longint; { alignment of the section }
  93. flags : cardinal; { section flags }
  94. { size of the data and in the file }
  95. dataalignbytes : longint;
  96. data : TDynamicArray;
  97. datasize : longint;
  98. datapos : longint;
  99. { size and position in memory, set by seTSectionsize }
  100. memsize,
  101. mempos : longint;
  102. { relocation }
  103. relocations : TLinkedList;
  104. constructor create(const Aname:string;Aalign:longint;alloconly:boolean);
  105. destructor destroy;override;
  106. function write(var d;l:longint):longint;
  107. function writestr(const s:string):longint;
  108. procedure writealign(l:longint);
  109. function aligneddatasize:longint;
  110. procedure alignsection;
  111. procedure alloc(l:longint);
  112. procedure addsymreloc(ofs:longint;p:tasmsymbol;relative:TAsmRelocationType);
  113. procedure addsectionreloc(ofs:longint;sec:TSection;relative:TAsmRelocationType);
  114. end;
  115. TAsmObjectAlloc = class
  116. currsec : TSection;
  117. secsize : TAsmSectionSizes;
  118. constructor create;
  119. destructor destroy;override;
  120. procedure seTSection(sec:TSection);
  121. function sectionsize:longint;
  122. procedure sectionalloc(l:longint);
  123. procedure sectionalign(l:longint);
  124. procedure staballoc(p:pchar);
  125. procedure resetSections;
  126. end;
  127. TAsmObjectData = class(TLinkedListItem)
  128. public
  129. name : string[80];
  130. currsec : TSection;
  131. sects : array[TSection] of TAsmSection;
  132. symbols : tindexarray; { contains symbols that will be defined in object file }
  133. constructor create(const n:string);
  134. destructor destroy;override;
  135. procedure createsection(sec:TSection);virtual;
  136. procedure defaulTSection(sec:TSection);
  137. function sectionsize(s:TSection):longint;
  138. function currsectionsize:longint;
  139. procedure setsectionsizes(var s:TAsmSectionSizes);virtual;
  140. procedure alloc(len:longint);
  141. procedure allocalign(len:longint);
  142. procedure writebytes(var data;len:longint);
  143. procedure writereloc(data,len:longint;p:tasmsymbol;relative:TAsmRelocationType);virtual;abstract;
  144. procedure writesymbol(p:tasmsymbol);virtual;abstract;
  145. procedure writestabs(section:TSection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);virtual;abstract;
  146. procedure writesymstabs(section:TSection;offset:longint;p:pchar;ps:tasmsymbol;nidx,nother,line:longint;reloc:boolean);virtual;abstract;
  147. procedure fixuprelocs;virtual;
  148. end;
  149. {$ifndef delphi}
  150. tasmsymbolidxarr = array[0..($7fffffff div sizeof(pointer))] of tasmsymbol;
  151. {$else}
  152. tasmsymbolidxarr = array[0..high(word)] of tasmsymbol;
  153. {$endif}
  154. pasmsymbolidxarr = ^tasmsymbolidxarr;
  155. TAsmLibraryData = class(TLinkedListItem)
  156. private
  157. nextaltnr : longint;
  158. nextlabelnr : longint;
  159. public
  160. name,
  161. realname : string[80];
  162. symbolsearch : tdictionary; { contains ALL assembler symbols }
  163. usedasmsymbollist : tsinglelist;
  164. { ppu }
  165. asmsymbolppuidx : longint;
  166. asmsymbolidx : pasmsymbolidxarr; { used for translating ppu index->asmsymbol }
  167. constructor create(const n:string);
  168. destructor destroy;override;
  169. procedure Freeasmsymbolidx;
  170. procedure DerefAsmsymbol(var s:tasmsymbol);
  171. { asmsymbol }
  172. function newasmsymbol(const s : string;_bind:TAsmSymBind;_typ:TAsmsymtype) : tasmsymbol;
  173. function getasmsymbol(const s : string) : tasmsymbol;
  174. function renameasmsymbol(const sold, snew : string):tasmsymbol;
  175. function newasmlabel(nr:longint;is_addr,is_data:boolean) : tasmlabel;
  176. {# create a new assembler label }
  177. procedure getlabel(var l : tasmlabel);
  178. { make l as a new label and flag is_addr }
  179. procedure getaddrlabel(var l : tasmlabel);
  180. { make l as a new label and flag is_data }
  181. procedure getdatalabel(var l : tasmlabel);
  182. {# return a label number }
  183. procedure getlabelnr(var l : longint);
  184. procedure CreateUsedAsmSymbolList;
  185. procedure DestroyUsedAsmSymbolList;
  186. procedure UsedAsmSymbolListInsert(p:tasmsymbol);
  187. { generate an alternative (duplicate) symbol }
  188. procedure GenerateAltSymbol(p:tasmsymbol);
  189. { reset alternative symbol information }
  190. procedure UsedAsmSymbolListResetAltSym;
  191. procedure UsedAsmSymbolListReset;
  192. procedure UsedAsmSymbolListCheckUndefined;
  193. end;
  194. var
  195. objectlibrary : tasmlibrarydata;
  196. implementation
  197. uses
  198. {$ifdef delphi}
  199. sysutils,
  200. {$else}
  201. strings,
  202. {$endif}
  203. verbose;
  204. const
  205. symbolsgrow = 100;
  206. {*****************************************************************************
  207. TAsmSymbol
  208. *****************************************************************************}
  209. constructor tasmsymbol.create(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
  210. begin;
  211. inherited createname(s);
  212. reset;
  213. defbind:=_bind;
  214. typ:=_typ;
  215. inusedlist:=false;
  216. pass:=255;
  217. ppuidx:=-1;
  218. { mainly used to remove unused labels from the codesegment }
  219. refs:=0;
  220. end;
  221. procedure tasmsymbol.reset;
  222. begin
  223. { reset section info }
  224. section:=sec_none;
  225. address:=0;
  226. size:=0;
  227. indexnr:=-1;
  228. pass:=255;
  229. currbind:=AB_EXTERNAL;
  230. altsymbol:=nil;
  231. { taiowner:=nil;}
  232. end;
  233. function tasmsymbol.is_used:boolean;
  234. begin
  235. is_used:=(refs>0);
  236. end;
  237. procedure tasmsymbol.increfs;
  238. begin
  239. inc(refs);
  240. end;
  241. procedure tasmsymbol.decrefs;
  242. begin
  243. dec(refs);
  244. if refs<0 then
  245. internalerror(200211121);
  246. end;
  247. procedure tasmsymbol.setaddress(_pass:byte;sec:TSection;offset,len:longint);
  248. begin
  249. if (_pass=pass) then
  250. begin
  251. Message1(asmw_e_duplicate_label,name);
  252. exit;
  253. end;
  254. pass:=_pass;
  255. section:=sec;
  256. address:=offset;
  257. size:=len;
  258. { when the bind was reset to External, set it back to the default
  259. bind it got when defined }
  260. if (currbind=AB_EXTERNAL) and (defbind<>AB_NONE) then
  261. currbind:=defbind;
  262. end;
  263. {*****************************************************************************
  264. TAsmLabel
  265. *****************************************************************************}
  266. constructor tasmlabel.create(nr:longint);
  267. begin;
  268. labelnr:=nr;
  269. inherited create(target_asm.labelprefix+tostr(labelnr),AB_LOCAL,AT_FUNCTION);
  270. is_set:=false;
  271. is_addr := false;
  272. end;
  273. constructor tasmlabel.createdata(const modulename:string;nr:longint);
  274. begin;
  275. labelnr:=nr;
  276. if (cs_create_smart in aktmoduleswitches) or
  277. target_asm.labelprefix_only_inside_procedure then
  278. inherited create('_$'+modulename+'$_L'+tostr(labelnr),AB_GLOBAL,AT_DATA)
  279. else
  280. inherited create(target_asm.labelprefix+tostr(labelnr),AB_LOCAL,AT_DATA);
  281. is_set:=false;
  282. is_addr := false;
  283. { write it always }
  284. increfs;
  285. end;
  286. constructor tasmlabel.createaddr(nr:longint);
  287. begin;
  288. create(nr);
  289. is_addr := true;
  290. end;
  291. function tasmlabel.getname:string;
  292. begin
  293. getname:=inherited getname;
  294. increfs;
  295. end;
  296. {****************************************************************************
  297. TAsmObjectAlloc
  298. ****************************************************************************}
  299. constructor TAsmObjectAlloc.create;
  300. begin
  301. end;
  302. destructor TAsmObjectAlloc.destroy;
  303. begin
  304. end;
  305. procedure TAsmObjectAlloc.seTSection(sec:TSection);
  306. begin
  307. currsec:=sec;
  308. end;
  309. procedure TAsmObjectAlloc.reseTSections;
  310. begin
  311. FillChar(secsize,sizeof(secsize),0);
  312. end;
  313. procedure TAsmObjectAlloc.sectionalloc(l:longint);
  314. begin
  315. inc(secsize[currsec],l);
  316. end;
  317. procedure TAsmObjectAlloc.sectionalign(l:longint);
  318. begin
  319. if (secsize[currsec] mod l)<>0 then
  320. inc(secsize[currsec],l-(secsize[currsec] mod l));
  321. end;
  322. procedure TAsmObjectAlloc.staballoc(p:pchar);
  323. begin
  324. inc(secsize[sec_stab]);
  325. if assigned(p) and (p[0]<>#0) then
  326. inc(secsize[sec_stabstr],strlen(p)+1);
  327. end;
  328. function TAsmObjectAlloc.sectionsize:longint;
  329. begin
  330. sectionsize:=secsize[currsec];
  331. end;
  332. {****************************************************************************
  333. TAsmRelocation
  334. ****************************************************************************}
  335. constructor TAsmRelocation.CreateSymbol(Aaddress:longint;s:Tasmsymbol;Atyp:TAsmRelocationType);
  336. begin
  337. Address:=Aaddress;
  338. Symbol:=s;
  339. OrgSize:=0;
  340. Section:=Sec_none;
  341. Typ:=Atyp;
  342. end;
  343. constructor TAsmRelocation.CreateSymbolSize(Aaddress:longint;s:Tasmsymbol;Aorgsize:longint;Atyp:TAsmRelocationType);
  344. begin
  345. Address:=Aaddress;
  346. Symbol:=s;
  347. OrgSize:=Aorgsize;
  348. Section:=Sec_none;
  349. Typ:=Atyp;
  350. end;
  351. constructor TAsmRelocation.CreateSection(Aaddress:longint;sec:TSection;Atyp:TAsmRelocationType);
  352. begin
  353. Address:=Aaddress;
  354. Symbol:=nil;
  355. OrgSize:=0;
  356. Section:=sec;
  357. Typ:=Atyp;
  358. end;
  359. {****************************************************************************
  360. TAsmSection
  361. ****************************************************************************}
  362. constructor TAsmSection.create(const Aname:string;Aalign:longint;alloconly:boolean);
  363. begin
  364. inherited create;
  365. name:=Aname;
  366. secsymidx:=0;
  367. addralign:=Aalign;
  368. { data }
  369. datasize:=0;
  370. datapos:=0;
  371. if alloconly then
  372. data:=nil
  373. else
  374. Data:=TDynamicArray.Create(8192);
  375. { position }
  376. mempos:=0;
  377. memsize:=0;
  378. { relocation }
  379. relocations:=TLinkedList.Create;
  380. end;
  381. destructor TAsmSection.destroy;
  382. begin
  383. if assigned(Data) then
  384. Data.Free;
  385. relocations.free;
  386. end;
  387. function TAsmSection.write(var d;l:longint):longint;
  388. begin
  389. write:=datasize;
  390. if not assigned(Data) then
  391. Internalerror(3334441);
  392. Data.write(d,l);
  393. inc(datasize,l);
  394. end;
  395. function TAsmSection.writestr(const s:string):longint;
  396. begin
  397. writestr:=datasize;
  398. if not assigned(Data) then
  399. Internalerror(3334441);
  400. Data.write(s[1],length(s));
  401. inc(datasize,length(s));
  402. end;
  403. procedure TAsmSection.writealign(l:longint);
  404. var
  405. i : longint;
  406. empty : array[0..63] of char;
  407. begin
  408. { no alignment needed for 0 or 1 }
  409. if l<=1 then
  410. exit;
  411. i:=datasize mod l;
  412. if i>0 then
  413. begin
  414. if assigned(data) then
  415. begin
  416. fillchar(empty,sizeof(empty),0);
  417. Data.write(empty,l-i);
  418. end;
  419. inc(datasize,l-i);
  420. end;
  421. end;
  422. function TAsmSection.aligneddatasize:longint;
  423. begin
  424. aligneddatasize:=align(datasize,addralign);
  425. end;
  426. procedure TAsmSection.alignsection;
  427. begin
  428. writealign(addralign);
  429. end;
  430. procedure TAsmSection.alloc(l:longint);
  431. begin
  432. if assigned(Data) then
  433. Internalerror(3334442);
  434. inc(datasize,l);
  435. end;
  436. procedure TAsmSection.addsymreloc(ofs:longint;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:=sec_none;
  445. r.typ:=relative;
  446. relocations.concat(r);
  447. end;
  448. procedure TAsmSection.addsectionreloc(ofs:longint;sec:TSection;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. {****************************************************************************
  461. TAsmObjectData
  462. ****************************************************************************}
  463. constructor TAsmObjectData.create(const n:string);
  464. begin
  465. inherited create;
  466. name:=n;
  467. { sections }
  468. FillChar(Sects,sizeof(Sects),0);
  469. { symbols }
  470. symbols:=tindexarray.create(symbolsgrow);
  471. symbols.noclear:=true;
  472. end;
  473. destructor TAsmObjectData.destroy;
  474. var
  475. sec : TSection;
  476. begin
  477. { free memory }
  478. for sec:=low(TSection) to high(TSection) do
  479. if assigned(sects[sec]) then
  480. sects[sec].free;
  481. symbols.free;
  482. end;
  483. procedure TAsmObjectData.createsection(sec:TSection);
  484. begin
  485. sects[sec]:=TAsmSection.create(target_asm.secnames[sec],1,(sec=sec_bss));
  486. end;
  487. function TAsmObjectData.sectionsize(s:TSection):longint;
  488. begin
  489. if assigned(sects[s]) then
  490. sectionsize:=sects[s].datasize
  491. else
  492. sectionsize:=0;
  493. end;
  494. function TAsmObjectData.currsectionsize:longint;
  495. begin
  496. if assigned(sects[currsec]) then
  497. currsectionsize:=sects[currsec].datasize
  498. else
  499. currsectionsize:=0;
  500. end;
  501. procedure TAsmObjectData.seTSectionsizes(var s:TAsmSectionSizes);
  502. begin
  503. end;
  504. procedure TAsmObjectData.defaulTSection(sec:TSection);
  505. begin
  506. currsec:=sec;
  507. end;
  508. procedure TAsmObjectData.writebytes(var data;len:longint);
  509. begin
  510. if not assigned(sects[currsec]) then
  511. createsection(currsec);
  512. sects[currsec].write(data,len);
  513. end;
  514. procedure TAsmObjectData.alloc(len:longint);
  515. begin
  516. if not assigned(sects[currsec]) then
  517. createsection(currsec);
  518. sects[currsec].alloc(len);
  519. end;
  520. procedure TAsmObjectData.allocalign(len:longint);
  521. var
  522. modulo : longint;
  523. begin
  524. if not assigned(sects[currsec]) then
  525. createsection(currsec);
  526. modulo:=sects[currsec].datasize mod len;
  527. if modulo > 0 then
  528. sects[currsec].alloc(len-modulo);
  529. end;
  530. procedure TAsmObjectData.fixuprelocs;
  531. begin
  532. { no relocation support by default }
  533. end;
  534. {****************************************************************************
  535. TAsmLibraryData
  536. ****************************************************************************}
  537. constructor TAsmLibraryData.create(const n:string);
  538. begin
  539. inherited create;
  540. realname:=n;
  541. name:=upper(n);
  542. { symbols }
  543. symbolsearch:=tdictionary.create;
  544. symbolsearch.usehash;
  545. { labels }
  546. nextaltnr:=1;
  547. nextlabelnr:=1;
  548. { ppu }
  549. asmsymbolppuidx:=0;
  550. asmsymbolidx:=nil;
  551. end;
  552. destructor TAsmLibraryData.destroy;
  553. begin
  554. symbolsearch.free;
  555. Freeasmsymbolidx;
  556. end;
  557. procedure TAsmLibraryData.Freeasmsymbolidx;
  558. begin
  559. if assigned(asmsymbolidx) then
  560. begin
  561. Freemem(asmsymbolidx);
  562. asmsymbolidx:=nil;
  563. end;
  564. end;
  565. procedure TAsmLibraryData.DerefAsmsymbol(var s:tasmsymbol);
  566. begin
  567. if assigned(s) then
  568. begin
  569. if not assigned(asmsymbolidx) then
  570. internalerror(200208072);
  571. if (longint(pointer(s))<1) or (longint(pointer(s))>asmsymbolppuidx) then
  572. internalerror(200208073);
  573. s:=asmsymbolidx^[longint(pointer(s))-1];
  574. end;
  575. end;
  576. function TAsmLibraryData.newasmsymbol(const s : string;_bind:TAsmSymBind;_typ:Tasmsymtype) : tasmsymbol;
  577. var
  578. hp : tasmsymbol;
  579. begin
  580. hp:=tasmsymbol(symbolsearch.search(s));
  581. if assigned(hp) then
  582. begin
  583. {$IFDEF EXTDEBUG}
  584. if (_typ <> AT_NONE) and (hp.typ <> _typ) then
  585. begin
  586. //Writeln('Error symbol '+hp.name+' type is ',Ord(_typ),', should be ',Ord(hp.typ));
  587. InternalError(2004031501);
  588. end;
  589. {$ENDIF}
  590. if (_bind<>AB_EXTERNAL) then
  591. hp.defbind:=_bind
  592. end
  593. else
  594. begin
  595. { Not found, insert it. }
  596. hp:=tasmsymbol.create(s,_bind,_typ);
  597. symbolsearch.insert(hp);
  598. end;
  599. newasmsymbol:=hp;
  600. end;
  601. function TAsmLibraryData.getasmsymbol(const s : string) : tasmsymbol;
  602. begin
  603. getasmsymbol:=tasmsymbol(symbolsearch.search(s));
  604. end;
  605. function TAsmLibraryData.renameasmsymbol(const sold, snew : string):tasmsymbol;
  606. begin
  607. renameasmsymbol:=tasmsymbol(symbolsearch.rename(sold,snew));
  608. end;
  609. procedure TAsmLibraryData.CreateUsedAsmSymbolList;
  610. begin
  611. if assigned(usedasmsymbollist) then
  612. internalerror(78455782);
  613. usedasmsymbollist:=TSingleList.create;
  614. end;
  615. procedure TAsmLibraryData.DestroyUsedAsmSymbolList;
  616. begin
  617. usedasmsymbollist.destroy;
  618. usedasmsymbollist:=nil;
  619. end;
  620. procedure TAsmLibraryData.UsedAsmSymbolListInsert(p:tasmsymbol);
  621. begin
  622. if not p.inusedlist then
  623. usedasmsymbollist.insert(p);
  624. p.inusedlist:=true;
  625. end;
  626. procedure TAsmLibraryData.GenerateAltSymbol(p:tasmsymbol);
  627. begin
  628. if not assigned(p.altsymbol) then
  629. begin
  630. p.altsymbol:=tasmsymbol.create(name+'_'+tostr(nextaltnr),p.defbind,p.typ);
  631. symbolsearch.insert(p.altsymbol);
  632. { add also the original sym to the usedasmsymbollist,
  633. that list is used to reset the altsymbol }
  634. if not p.inusedlist then
  635. usedasmsymbollist.insert(p);
  636. p.inusedlist:=true;
  637. end;
  638. end;
  639. procedure TAsmLibraryData.UsedAsmSymbolListReset;
  640. var
  641. hp : tasmsymbol;
  642. begin
  643. hp:=tasmsymbol(usedasmsymbollist.first);
  644. while assigned(hp) do
  645. begin
  646. with hp do
  647. begin
  648. reset;
  649. inusedlist:=false;
  650. end;
  651. hp:=tasmsymbol(hp.listnext);
  652. end;
  653. end;
  654. procedure TAsmLibraryData.UsedAsmSymbolListResetAltSym;
  655. var
  656. hp : tasmsymbol;
  657. begin
  658. hp:=tasmsymbol(usedasmsymbollist.first);
  659. inc(nextaltnr);
  660. while assigned(hp) do
  661. begin
  662. with hp do
  663. begin
  664. altsymbol:=nil;
  665. inusedlist:=false;
  666. end;
  667. hp:=tasmsymbol(hp.listnext);
  668. end;
  669. end;
  670. procedure TAsmLibraryData.UsedAsmSymbolListCheckUndefined;
  671. var
  672. hp : tasmsymbol;
  673. begin
  674. hp:=tasmsymbol(usedasmsymbollist.first);
  675. while assigned(hp) do
  676. begin
  677. with hp do
  678. begin
  679. if is_used and
  680. (section=Sec_none) and
  681. not(currbind in [AB_EXTERNAL,AB_COMMON]) then
  682. Message1(asmw_e_undefined_label,name);
  683. end;
  684. hp:=tasmsymbol(hp.listnext);
  685. end;
  686. end;
  687. function TAsmLibraryData.newasmlabel(nr:longint;is_addr,is_data:boolean) : tasmlabel;
  688. var
  689. hp : tasmlabel;
  690. begin
  691. if is_addr then
  692. hp:=tasmlabel.createaddr(nr)
  693. else if is_data then
  694. hp:=tasmlabel.createdata(name,nr)
  695. else
  696. hp:=tasmlabel.create(nr);
  697. symbolsearch.insert(hp);
  698. newasmlabel:=hp;
  699. end;
  700. procedure TAsmLibraryData.getlabel(var l : tasmlabel);
  701. begin
  702. l:=tasmlabel.create(nextlabelnr);
  703. inc(nextlabelnr);
  704. symbolsearch.insert(l);
  705. end;
  706. procedure TAsmLibraryData.getdatalabel(var l : tasmlabel);
  707. begin
  708. l:=tasmlabel.createdata(name,nextlabelnr);
  709. inc(nextlabelnr);
  710. symbolsearch.insert(l);
  711. end;
  712. procedure TAsmLibraryData.getaddrlabel(var l : tasmlabel);
  713. begin
  714. l:=tasmlabel.createaddr(nextlabelnr);
  715. inc(nextlabelnr);
  716. symbolsearch.insert(l);
  717. end;
  718. procedure TAsmLibraryData.getlabelnr(var l : longint);
  719. begin
  720. l:=nextlabelnr;
  721. inc(nextlabelnr);
  722. end;
  723. end.
  724. {
  725. $Log$
  726. Revision 1.17 2004-03-18 11:45:39 olle
  727. + added type similarity check in newasmsymbol
  728. Revision 1.16 2004/03/02 00:36:32 olle
  729. * big transformation of Tai_[const_]Symbol.Create[data]name*
  730. Revision 1.15 2003/05/23 14:27:35 peter
  731. * remove some unit dependencies
  732. * current_procinfo changes to store more info
  733. Revision 1.14 2003/04/06 21:11:23 olle
  734. * changed newasmsymbol to newasmsymboldata for data symbols
  735. Revision 1.13 2003/01/30 21:46:20 peter
  736. * tai_const_symbol.createdataname added
  737. Revision 1.12 2002/11/17 16:31:55 carl
  738. * memory optimization (3-4%) : cleanup of tai fields,
  739. cleanup of tdef and tsym fields.
  740. * make it work for m68k
  741. Revision 1.11 2002/11/15 16:29:30 peter
  742. * made tasmsymbol.refs private (merged)
  743. Revision 1.10 2002/11/15 01:58:45 peter
  744. * merged changes from 1.0.7 up to 04-11
  745. - -V option for generating bug report tracing
  746. - more tracing for option parsing
  747. - errors for cdecl and high()
  748. - win32 import stabs
  749. - win32 records<=8 are returned in eax:edx (turned off by default)
  750. - heaptrc update
  751. - more info for temp management in .s file with EXTDEBUG
  752. Revision 1.9 2002/10/05 12:43:23 carl
  753. * fixes for Delphi 6 compilation
  754. (warning : Some features do not work under Delphi)
  755. Revision 1.8 2002/08/19 19:36:42 peter
  756. * More fixes for cross unit inlining, all tnodes are now implemented
  757. * Moved pocall_internconst to po_internconst because it is not a
  758. calling type at all and it conflicted when inlining of these small
  759. functions was requested
  760. Revision 1.7 2002/08/18 20:06:23 peter
  761. * inlining is now also allowed in interface
  762. * renamed write/load to ppuwrite/ppuload
  763. * tnode storing in ppu
  764. * nld,ncon,nbas are already updated for storing in ppu
  765. Revision 1.6 2002/08/12 15:08:39 carl
  766. + stab register indexes for powerpc (moved from gdb to cpubase)
  767. + tprocessor enumeration moved to cpuinfo
  768. + linker in target_info is now a class
  769. * many many updates for m68k (will soon start to compile)
  770. - removed some ifdef or correct them for correct cpu
  771. Revision 1.5 2002/08/11 14:32:25 peter
  772. * renamed current_library to objectlibrary
  773. Revision 1.4 2002/08/11 13:24:10 peter
  774. * saving of asmsymbols in ppu supported
  775. * asmsymbollist global is removed and moved into a new class
  776. tasmlibrarydata that will hold the info of a .a file which
  777. corresponds with a single module. Added librarydata to tmodule
  778. to keep the library info stored for the module. In the future the
  779. objectfiles will also be stored to the tasmlibrarydata class
  780. * all getlabel/newasmsymbol and friends are moved to the new class
  781. Revision 1.3 2002/07/10 07:24:40 jonas
  782. * memory leak fixes from Sergey Korshunoff
  783. Revision 1.2 2002/07/07 09:52:32 florian
  784. * powerpc target fixed, very simple units can be compiled
  785. * some basic stuff for better callparanode handling, far from being finished
  786. Revision 1.1 2002/07/01 18:46:20 peter
  787. * internal linker
  788. * reorganized aasm layer
  789. }