fmodule.pas 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. This unit implements the first loading and searching of the modules
  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. unit fmodule;
  18. {$i fpcdefs.inc}
  19. {$ifdef go32v2}
  20. {$define shortasmprefix}
  21. {$endif}
  22. {$ifdef watcom}
  23. {$define shortasmprefix}
  24. {$endif}
  25. {$ifdef tos}
  26. {$define shortasmprefix}
  27. {$endif}
  28. {$ifdef OS2}
  29. { Allthough OS/2 supports long filenames I play it safe and
  30. use 8.3 filenames, because this allows the compiler to run
  31. on a FAT partition. (DM) }
  32. {$define shortasmprefix}
  33. {$endif}
  34. interface
  35. uses
  36. cutils,cclasses,cfileutils,
  37. globals,finput,ogbase,
  38. symbase,symsym,aasmbase,aasmtai,aasmdata;
  39. const
  40. UNSPECIFIED_LIBRARY_NAME = '<none>';
  41. type
  42. trecompile_reason = (rr_unknown,
  43. rr_noppu,rr_sourcenewer,rr_build,rr_crcchanged
  44. );
  45. tlinkcontaineritem=class(tlinkedlistitem)
  46. public
  47. data : pshortstring;
  48. needlink : cardinal;
  49. constructor Create(const s:string;m:cardinal);
  50. destructor Destroy;override;
  51. end;
  52. tlinkcontainer=class(tlinkedlist)
  53. procedure add(const s : string;m:cardinal);
  54. function get(var m:cardinal) : string;
  55. function getusemask(mask:cardinal) : string;
  56. function find(const s:string):boolean;
  57. end;
  58. tmodule = class;
  59. tused_unit = class;
  60. tunitmaprec = record
  61. u : tmodule;
  62. { number of references }
  63. refs : longint;
  64. { index in the derefmap }
  65. derefidx : longint;
  66. end;
  67. punitmap = ^tunitmaprec;
  68. tderefmaprec = record
  69. u : tmodule;
  70. { modulename, used during ppu load }
  71. modulename : pshortstring;
  72. end;
  73. pderefmap = ^tderefmaprec;
  74. tmodule = class(tmodulebase)
  75. private
  76. FImportLibraryList : TFPHashObjectList;
  77. public
  78. do_reload, { force reloading of the unit }
  79. do_compile, { need to compile the sources }
  80. sources_avail, { if all sources are reachable }
  81. interface_compiled, { if the interface section has been parsed/compiled/loaded }
  82. is_dbginfo_written,
  83. is_reset,
  84. is_unit,
  85. in_interface, { processing the implementation part? }
  86. { allow global settings }
  87. in_global : boolean;
  88. { Whether a mode switch is still allowed at this point in the parsing.}
  89. mode_switch_allowed,
  90. { generate pic helper which loads eip in ecx (for leave procedures) }
  91. requires_ecx_pic_helper,
  92. { generate pic helper which loads eip in ebx (for non leave procedures) }
  93. requires_ebx_pic_helper : boolean;
  94. mainfilepos : tfileposinfo;
  95. recompile_reason : trecompile_reason; { the reason why the unit should be recompiled }
  96. crc,
  97. interface_crc : cardinal;
  98. flags : cardinal; { the PPU flags }
  99. islibrary : boolean; { if it is a library (win32 dll) }
  100. moduleid : longint;
  101. unitmap : punitmap; { mapping of all used units }
  102. unitmapsize : longint; { number of units in the map }
  103. derefmap : pderefmap; { mapping of all units needed for deref }
  104. derefmapcnt : longint; { number of units in the map }
  105. derefmapsize : longint; { number of units in the map }
  106. derefdataintflen : longint;
  107. derefdata : tdynamicarray;
  108. deflist,
  109. symlist : TFPObjectList;
  110. globalsymtable, { pointer to the global symtable of this unit }
  111. localsymtable : TSymtable;{ pointer to the local symtable of this unit }
  112. globalmacrosymtable, { pointer to the global macro symtable of this unit }
  113. localmacrosymtable : TSymtable;{ pointer to the local macro symtable of this unit }
  114. scanner : TObject; { scanner object used }
  115. procinfo : TObject; { current procedure being compiled }
  116. asmdata : TObject; { Assembler data }
  117. asmprefix : pshortstring; { prefix for the smartlink asmfiles }
  118. loaded_from : tmodule;
  119. _exports : tlinkedlist;
  120. dllscannerinputlist : TFPHashList;
  121. resourcefiles : TCmdStrList;
  122. linkunitofiles,
  123. linkunitstaticlibs,
  124. linkunitsharedlibs,
  125. linkotherofiles, { objects,libs loaded from the source }
  126. linkothersharedlibs, { using $L or $LINKLIB or import lib (for linux) }
  127. linkotherstaticlibs : tlinkcontainer;
  128. used_units : tlinkedlist;
  129. dependent_units : tlinkedlist;
  130. localunitsearchpath, { local searchpaths }
  131. localobjectsearchpath,
  132. localincludesearchpath,
  133. locallibrarysearchpath : TSearchPathList;
  134. {create creates a new module which name is stored in 's'. LoadedFrom
  135. points to the module calling it. It is nil for the first compiled
  136. module. This allow inheritence of all path lists. MUST pay attention
  137. to that when creating link.res!!!!(mazen)}
  138. constructor create(LoadedFrom:TModule;const s:string;_is_unit:boolean);
  139. destructor destroy;override;
  140. procedure reset;virtual;
  141. procedure adddependency(callermodule:tmodule);
  142. procedure flagdependent(callermodule:tmodule);
  143. function addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit;
  144. procedure updatemaps;
  145. function derefidx_unit(id:longint):longint;
  146. function resolve_unit(id:longint):tmodule;
  147. procedure allunitsused;
  148. procedure setmodulename(const s:string);
  149. procedure AddExternalImport(const libname,symname:string;OrdNr: longint;isvar:boolean);
  150. property ImportLibraryList : TFPHashObjectList read FImportLibraryList;
  151. end;
  152. tused_unit = class(tlinkedlistitem)
  153. checksum,
  154. interface_checksum : cardinal;
  155. in_uses,
  156. in_interface : boolean;
  157. u : tmodule;
  158. unitsym : tunitsym;
  159. constructor create(_u : tmodule;intface,inuses:boolean;usym:tunitsym);
  160. end;
  161. tdependent_unit = class(tlinkedlistitem)
  162. u : tmodule;
  163. constructor create(_u : tmodule);
  164. end;
  165. var
  166. main_module : tmodule; { Main module of the program }
  167. current_module : tmodule; { Current module which is compiled or loaded }
  168. compiled_module : tmodule; { Current module which is compiled }
  169. usedunits : tlinkedlist; { Used units for this program }
  170. loaded_units : tlinkedlist; { All loaded units }
  171. SmartLinkOFiles : TCmdStrList; { List of .o files which are generated,
  172. used to delete them after linking }
  173. function get_module(moduleindex : longint) : tmodule;
  174. function get_source_file(moduleindex,fileindex : longint) : tinputfile;
  175. procedure addloadedunit(hp:tmodule);
  176. implementation
  177. uses
  178. SysUtils,
  179. GlobType,
  180. verbose,systems,
  181. scanner,ppu,
  182. procinfo;
  183. {$ifdef MEMDEBUG}
  184. var
  185. memsymtable : TMemDebug;
  186. {$endif}
  187. {*****************************************************************************
  188. Global Functions
  189. *****************************************************************************}
  190. function get_module(moduleindex : longint) : tmodule;
  191. var
  192. hp : tmodule;
  193. begin
  194. result:=nil;
  195. if moduleindex=0 then
  196. exit;
  197. result:=current_module;
  198. if not(assigned(loaded_units)) then
  199. exit;
  200. hp:=tmodule(loaded_units.first);
  201. while assigned(hp) and (hp.unit_index<>moduleindex) do
  202. hp:=tmodule(hp.next);
  203. result:=hp;
  204. end;
  205. function get_source_file(moduleindex,fileindex : longint) : tinputfile;
  206. var
  207. hp : tmodule;
  208. begin
  209. hp:=get_module(moduleindex);
  210. if assigned(hp) then
  211. get_source_file:=hp.sourcefiles.get_file(fileindex)
  212. else
  213. get_source_file:=nil;
  214. end;
  215. procedure addloadedunit(hp:tmodule);
  216. begin
  217. hp.moduleid:=loaded_units.count;
  218. loaded_units.concat(hp);
  219. end;
  220. {****************************************************************************
  221. TLinkContainerItem
  222. ****************************************************************************}
  223. constructor TLinkContainerItem.Create(const s:string;m:cardinal);
  224. begin
  225. inherited Create;
  226. data:=stringdup(s);
  227. needlink:=m;
  228. end;
  229. destructor TLinkContainerItem.Destroy;
  230. begin
  231. stringdispose(data);
  232. end;
  233. {****************************************************************************
  234. TLinkContainer
  235. ****************************************************************************}
  236. procedure TLinkContainer.add(const s : string;m:cardinal);
  237. begin
  238. inherited concat(TLinkContainerItem.Create(s,m));
  239. end;
  240. function TLinkContainer.get(var m:cardinal) : string;
  241. var
  242. p : tlinkcontaineritem;
  243. begin
  244. p:=tlinkcontaineritem(inherited getfirst);
  245. if p=nil then
  246. begin
  247. get:='';
  248. m:=0;
  249. end
  250. else
  251. begin
  252. get:=p.data^;
  253. m:=p.needlink;
  254. p.free;
  255. end;
  256. end;
  257. function TLinkContainer.getusemask(mask:cardinal) : string;
  258. var
  259. p : tlinkcontaineritem;
  260. found : boolean;
  261. begin
  262. found:=false;
  263. repeat
  264. p:=tlinkcontaineritem(inherited getfirst);
  265. if p=nil then
  266. begin
  267. getusemask:='';
  268. exit;
  269. end;
  270. getusemask:=p.data^;
  271. found:=(p.needlink and mask)<>0;
  272. p.free;
  273. until found;
  274. end;
  275. function TLinkContainer.find(const s:string):boolean;
  276. var
  277. newnode : tlinkcontaineritem;
  278. begin
  279. find:=false;
  280. newnode:=tlinkcontaineritem(First);
  281. while assigned(newnode) do
  282. begin
  283. if newnode.data^=s then
  284. begin
  285. find:=true;
  286. exit;
  287. end;
  288. newnode:=tlinkcontaineritem(newnode.next);
  289. end;
  290. end;
  291. {****************************************************************************
  292. TUSED_UNIT
  293. ****************************************************************************}
  294. constructor tused_unit.create(_u : tmodule;intface,inuses:boolean;usym:tunitsym);
  295. begin
  296. u:=_u;
  297. in_interface:=intface;
  298. in_uses:=inuses;
  299. unitsym:=usym;
  300. if _u.state=ms_compiled then
  301. begin
  302. checksum:=u.crc;
  303. interface_checksum:=u.interface_crc;
  304. end
  305. else
  306. begin
  307. checksum:=0;
  308. interface_checksum:=0;
  309. end;
  310. end;
  311. {****************************************************************************
  312. TDENPENDENT_UNIT
  313. ****************************************************************************}
  314. constructor tdependent_unit.create(_u : tmodule);
  315. begin
  316. u:=_u;
  317. end;
  318. {****************************************************************************
  319. TMODULE
  320. ****************************************************************************}
  321. constructor tmodule.create(LoadedFrom:TModule;const s:string;_is_unit:boolean);
  322. var
  323. p,n : string;
  324. begin
  325. p:=ExtractFilePath(s);
  326. n:=ChangeFileExt(ExtractFileName(s),'');
  327. { Programs have the name 'Program' to don't conflict with dup id's }
  328. if _is_unit then
  329. inherited create(n)
  330. else
  331. inherited create('Program');
  332. mainsource:=stringdup(s);
  333. { Dos has the famous 8.3 limit :( }
  334. {$ifdef shortasmprefix}
  335. asmprefix:=stringdup(FixFileName('as'));
  336. {$else}
  337. asmprefix:=stringdup(FixFileName(n));
  338. {$endif}
  339. setfilename(s,true);
  340. localunitsearchpath:=TSearchPathList.Create;
  341. localobjectsearchpath:=TSearchPathList.Create;
  342. localincludesearchpath:=TSearchPathList.Create;
  343. locallibrarysearchpath:=TSearchPathList.Create;
  344. used_units:=TLinkedList.Create;
  345. dependent_units:=TLinkedList.Create;
  346. resourcefiles:=TCmdStrList.Create;
  347. linkunitofiles:=TLinkContainer.Create;
  348. linkunitstaticlibs:=TLinkContainer.Create;
  349. linkunitsharedlibs:=TLinkContainer.Create;
  350. linkotherofiles:=TLinkContainer.Create;
  351. linkotherstaticlibs:=TLinkContainer.Create;
  352. linkothersharedlibs:=TLinkContainer.Create;
  353. FImportLibraryList:=TFPHashObjectList.Create(true);
  354. crc:=0;
  355. interface_crc:=0;
  356. flags:=0;
  357. scanner:=nil;
  358. unitmap:=nil;
  359. unitmapsize:=0;
  360. derefmap:=nil;
  361. derefmapsize:=0;
  362. derefmapcnt:=0;
  363. derefdata:=TDynamicArray.Create(1024);
  364. derefdataintflen:=0;
  365. deflist:=TFPObjectList.Create(false);
  366. symlist:=TFPObjectList.Create(false);
  367. globalsymtable:=nil;
  368. localsymtable:=nil;
  369. globalmacrosymtable:=nil;
  370. localmacrosymtable:=nil;
  371. loaded_from:=LoadedFrom;
  372. do_reload:=false;
  373. do_compile:=false;
  374. sources_avail:=true;
  375. mainfilepos.line:=0;
  376. mainfilepos.column:=0;
  377. mainfilepos.fileindex:=0;
  378. recompile_reason:=rr_unknown;
  379. in_interface:=true;
  380. in_global:=true;
  381. is_unit:=_is_unit;
  382. islibrary:=false;
  383. is_dbginfo_written:=false;
  384. is_reset:=false;
  385. mode_switch_allowed:= true;
  386. _exports:=TLinkedList.Create;
  387. dllscannerinputlist:=TFPHashList.Create;
  388. asmdata:=TAsmData.create(realmodulename^);
  389. end;
  390. destructor tmodule.Destroy;
  391. var
  392. i : longint;
  393. hpi : tprocinfo;
  394. begin
  395. if assigned(unitmap) then
  396. freemem(unitmap);
  397. if assigned(derefmap) then
  398. begin
  399. for i:=0 to derefmapcnt-1 do
  400. stringdispose(derefmap[i].modulename);
  401. freemem(derefmap);
  402. end;
  403. if assigned(_exports) then
  404. _exports.free;
  405. if assigned(dllscannerinputlist) then
  406. dllscannerinputlist.free;
  407. if assigned(scanner) then
  408. begin
  409. { also update current_scanner if it was pointing
  410. to this module }
  411. if current_scanner=tscannerfile(scanner) then
  412. current_scanner:=nil;
  413. tscannerfile(scanner).free;
  414. end;
  415. if assigned(asmdata) then
  416. begin
  417. if current_asmdata=asmdata then
  418. current_asmdata:=nil;
  419. asmdata.free;
  420. end;
  421. if assigned(procinfo) then
  422. begin
  423. if current_procinfo=tprocinfo(procinfo) then
  424. current_procinfo:=nil;
  425. { release procinfo tree }
  426. while assigned(procinfo) do
  427. begin
  428. hpi:=tprocinfo(procinfo).parent;
  429. tprocinfo(procinfo).free;
  430. procinfo:=hpi;
  431. end;
  432. end;
  433. used_units.free;
  434. dependent_units.free;
  435. resourcefiles.Free;
  436. linkunitofiles.Free;
  437. linkunitstaticlibs.Free;
  438. linkunitsharedlibs.Free;
  439. linkotherofiles.Free;
  440. linkotherstaticlibs.Free;
  441. linkothersharedlibs.Free;
  442. FImportLibraryList.Free;
  443. stringdispose(objfilename);
  444. stringdispose(asmfilename);
  445. stringdispose(ppufilename);
  446. stringdispose(importlibfilename);
  447. stringdispose(staticlibfilename);
  448. stringdispose(sharedlibfilename);
  449. stringdispose(exefilename);
  450. stringdispose(outputpath);
  451. stringdispose(path);
  452. stringdispose(realmodulename);
  453. stringdispose(mainsource);
  454. stringdispose(asmprefix);
  455. localunitsearchpath.Free;
  456. localobjectsearchpath.free;
  457. localincludesearchpath.free;
  458. locallibrarysearchpath.free;
  459. {$ifdef MEMDEBUG}
  460. memsymtable.start;
  461. {$endif}
  462. derefdata.free;
  463. deflist.free;
  464. symlist.free;
  465. if assigned(globalsymtable) then
  466. globalsymtable.free;
  467. if assigned(localsymtable) then
  468. localsymtable.free;
  469. if assigned(globalmacrosymtable) then
  470. globalmacrosymtable.free;
  471. if assigned(localmacrosymtable) then
  472. localmacrosymtable.free;
  473. {$ifdef MEMDEBUG}
  474. memsymtable.stop;
  475. {$endif}
  476. stringdispose(modulename);
  477. inherited Destroy;
  478. end;
  479. procedure tmodule.reset;
  480. var
  481. hpi : tprocinfo;
  482. i : longint;
  483. begin
  484. if assigned(scanner) then
  485. begin
  486. { also update current_scanner if it was pointing
  487. to this module }
  488. if current_scanner=tscannerfile(scanner) then
  489. current_scanner:=nil;
  490. tscannerfile(scanner).free;
  491. scanner:=nil;
  492. end;
  493. if assigned(procinfo) then
  494. begin
  495. if current_procinfo=tprocinfo(procinfo) then
  496. current_procinfo:=nil;
  497. { release procinfo tree }
  498. while assigned(procinfo) do
  499. begin
  500. hpi:=tprocinfo(procinfo).parent;
  501. tprocinfo(procinfo).free;
  502. procinfo:=hpi;
  503. end;
  504. end;
  505. if assigned(asmdata) then
  506. begin
  507. if current_asmdata=TAsmData(asmdata) then
  508. current_asmdata:=nil;
  509. asmdata.free;
  510. asmdata:=nil;
  511. end;
  512. if assigned(globalsymtable) then
  513. begin
  514. globalsymtable.free;
  515. globalsymtable:=nil;
  516. end;
  517. if assigned(localsymtable) then
  518. begin
  519. localsymtable.free;
  520. localsymtable:=nil;
  521. end;
  522. if assigned(globalmacrosymtable) then
  523. begin
  524. globalmacrosymtable.free;
  525. globalmacrosymtable:=nil;
  526. end;
  527. if assigned(localmacrosymtable) then
  528. begin
  529. localmacrosymtable.free;
  530. localmacrosymtable:=nil;
  531. end;
  532. deflist.free;
  533. deflist:=TFPObjectList.Create(false);
  534. symlist.free;
  535. symlist:=TFPObjectList.Create(false);
  536. derefdata.free;
  537. derefdata:=TDynamicArray.Create(1024);
  538. if assigned(unitmap) then
  539. begin
  540. freemem(unitmap);
  541. unitmap:=nil;
  542. end;
  543. if assigned(derefmap) then
  544. begin
  545. for i:=0 to derefmapcnt-1 do
  546. stringdispose(derefmap[i].modulename);
  547. freemem(derefmap);
  548. derefmap:=nil;
  549. end;
  550. unitmapsize:=0;
  551. derefmapsize:=0;
  552. derefmapcnt:=0;
  553. derefdataintflen:=0;
  554. sourcefiles.free;
  555. sourcefiles:=tinputfilemanager.create;
  556. asmdata:=TAsmData.create(realmodulename^);
  557. _exports.free;
  558. _exports:=tlinkedlist.create;
  559. dllscannerinputlist.free;
  560. dllscannerinputlist:=TFPHashList.create;
  561. used_units.free;
  562. used_units:=TLinkedList.Create;
  563. dependent_units.free;
  564. dependent_units:=TLinkedList.Create;
  565. resourcefiles.Free;
  566. resourcefiles:=TCmdStrList.Create;
  567. linkunitofiles.Free;
  568. linkunitofiles:=TLinkContainer.Create;
  569. linkunitstaticlibs.Free;
  570. linkunitstaticlibs:=TLinkContainer.Create;
  571. linkunitsharedlibs.Free;
  572. linkunitsharedlibs:=TLinkContainer.Create;
  573. linkotherofiles.Free;
  574. linkotherofiles:=TLinkContainer.Create;
  575. linkotherstaticlibs.Free;
  576. linkotherstaticlibs:=TLinkContainer.Create;
  577. linkothersharedlibs.Free;
  578. linkothersharedlibs:=TLinkContainer.Create;
  579. FImportLibraryList.Free;
  580. FImportLibraryList:=TFPHashObjectList.Create;
  581. do_compile:=false;
  582. do_reload:=false;
  583. interface_compiled:=false;
  584. in_interface:=true;
  585. in_global:=true;
  586. mode_switch_allowed:=true;
  587. is_dbginfo_written:=false;
  588. is_reset:=false;
  589. crc:=0;
  590. interface_crc:=0;
  591. flags:=0;
  592. mainfilepos.line:=0;
  593. mainfilepos.column:=0;
  594. mainfilepos.fileindex:=0;
  595. recompile_reason:=rr_unknown;
  596. {
  597. The following fields should not
  598. be reset:
  599. mainsource
  600. state
  601. loaded_from
  602. sources_avail
  603. }
  604. end;
  605. procedure tmodule.adddependency(callermodule:tmodule);
  606. begin
  607. { This is not needed for programs }
  608. if not callermodule.is_unit then
  609. exit;
  610. Message2(unit_u_add_depend_to,callermodule.modulename^,modulename^);
  611. dependent_units.concat(tdependent_unit.create(callermodule));
  612. end;
  613. procedure tmodule.flagdependent(callermodule:tmodule);
  614. var
  615. pm : tdependent_unit;
  616. begin
  617. { flag all units that depend on this unit for reloading }
  618. pm:=tdependent_unit(current_module.dependent_units.first);
  619. while assigned(pm) do
  620. begin
  621. { We do not have to reload the unit that wants to load
  622. this unit, unless this unit is already compiled during
  623. the loading }
  624. if (pm.u=callermodule) and
  625. (pm.u.state<>ms_compiled) then
  626. Message1(unit_u_no_reload_is_caller,pm.u.modulename^)
  627. else
  628. if pm.u.state=ms_second_compile then
  629. Message1(unit_u_no_reload_in_second_compile,pm.u.modulename^)
  630. else
  631. begin
  632. pm.u.do_reload:=true;
  633. Message1(unit_u_flag_for_reload,pm.u.modulename^);
  634. end;
  635. pm:=tdependent_unit(pm.next);
  636. end;
  637. end;
  638. function tmodule.addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit;
  639. var
  640. pu : tused_unit;
  641. begin
  642. pu:=tused_unit.create(hp,in_interface,inuses,usym);
  643. used_units.concat(pu);
  644. addusedunit:=pu;
  645. end;
  646. procedure tmodule.updatemaps;
  647. var
  648. oldmapsize : longint;
  649. hp : tmodule;
  650. i : longint;
  651. begin
  652. { Extend unitmap }
  653. oldmapsize:=unitmapsize;
  654. unitmapsize:=loaded_units.count;
  655. reallocmem(unitmap,unitmapsize*sizeof(tunitmaprec));
  656. fillchar(unitmap[oldmapsize],(unitmapsize-oldmapsize)*sizeof(tunitmaprec),0);
  657. { Extend Derefmap }
  658. oldmapsize:=derefmapsize;
  659. derefmapsize:=loaded_units.count;
  660. reallocmem(derefmap,derefmapsize*sizeof(tderefmaprec));
  661. fillchar(derefmap[oldmapsize],(derefmapsize-oldmapsize)*sizeof(tderefmaprec),0);
  662. { Add all units to unitmap }
  663. hp:=tmodule(loaded_units.first);
  664. i:=0;
  665. while assigned(hp) do
  666. begin
  667. if hp.moduleid>=unitmapsize then
  668. internalerror(200501151);
  669. { Verify old entries }
  670. if (i<oldmapsize) then
  671. begin
  672. if (hp.moduleid<>i) or
  673. (unitmap[hp.moduleid].u<>hp) then
  674. internalerror(200501156);
  675. end
  676. else
  677. begin
  678. unitmap[hp.moduleid].u:=hp;
  679. unitmap[hp.moduleid].derefidx:=-1;
  680. end;
  681. inc(i);
  682. hp:=tmodule(hp.next);
  683. end;
  684. end;
  685. function tmodule.derefidx_unit(id:longint):longint;
  686. begin
  687. if id>=unitmapsize then
  688. internalerror(2005011511);
  689. if unitmap[id].derefidx=-1 then
  690. begin
  691. unitmap[id].derefidx:=derefmapcnt;
  692. inc(derefmapcnt);
  693. derefmap[unitmap[id].derefidx].u:=unitmap[id].u;
  694. end;
  695. if unitmap[id].derefidx>=derefmapsize then
  696. internalerror(2005011514);
  697. result:=unitmap[id].derefidx;
  698. end;
  699. function tmodule.resolve_unit(id:longint):tmodule;
  700. var
  701. hp : tmodule;
  702. begin
  703. if id>=derefmapsize then
  704. internalerror(200306231);
  705. result:=derefmap[id].u;
  706. if not assigned(result) then
  707. begin
  708. if not assigned(derefmap[id].modulename) or
  709. (derefmap[id].modulename^='') then
  710. internalerror(200501159);
  711. hp:=tmodule(loaded_units.first);
  712. while assigned(hp) do
  713. begin
  714. { only check for units. The main program is also
  715. as a unit in the loaded_units list. We simply need
  716. to ignore this entry (PFV) }
  717. if hp.is_unit and
  718. (hp.modulename^=derefmap[id].modulename^) then
  719. break;
  720. hp:=tmodule(hp.next);
  721. end;
  722. if not assigned(hp) then
  723. internalerror(2005011510);
  724. derefmap[id].u:=hp;
  725. result:=hp;
  726. end;
  727. end;
  728. procedure tmodule.allunitsused;
  729. var
  730. pu : tused_unit;
  731. begin
  732. pu:=tused_unit(used_units.first);
  733. while assigned(pu) do
  734. begin
  735. if assigned(pu.u.globalsymtable) then
  736. begin
  737. if unitmap[pu.u.moduleid].u<>pu.u then
  738. internalerror(200501157);
  739. { Give a note when the unit is not referenced, skip
  740. this is for units with an initialization/finalization }
  741. if (unitmap[pu.u.moduleid].refs=0) and
  742. ((pu.u.flags and (uf_init or uf_finalize))=0) then
  743. CGMessagePos2(pu.unitsym.fileinfo,sym_n_unit_not_used,pu.u.realmodulename^,realmodulename^);
  744. end;
  745. pu:=tused_unit(pu.next);
  746. end;
  747. end;
  748. procedure tmodule.setmodulename(const s:string);
  749. begin
  750. stringdispose(modulename);
  751. stringdispose(realmodulename);
  752. modulename:=stringdup(upper(s));
  753. realmodulename:=stringdup(s);
  754. { also update asmlibrary names }
  755. current_asmdata.name:=modulename^;
  756. current_asmdata.realname:=realmodulename^;
  757. end;
  758. procedure TModule.AddExternalImport(const libname,symname:string;OrdNr: longint;isvar:boolean);
  759. var
  760. ImportLibrary : TImportLibrary;
  761. ImportSymbol : TFPHashObject;
  762. begin
  763. ImportLibrary:=TImportLibrary(ImportLibraryList.Find(libname));
  764. if not assigned(ImportLibrary) then
  765. ImportLibrary:=TImportLibrary.Create(ImportLibraryList,libname);
  766. ImportSymbol:=TFPHashObject(ImportLibrary.ImportSymbolList.Find(symname));
  767. if not assigned(ImportSymbol) then
  768. ImportSymbol:=TImportSymbol.Create(ImportLibrary.ImportSymbolList,symname,OrdNr,isvar);
  769. end;
  770. initialization
  771. {$ifdef MEMDEBUG}
  772. memsymtable:=TMemDebug.create('Symtables');
  773. memsymtable.stop;
  774. {$endif MEMDEBUG}
  775. finalization
  776. {$ifdef MEMDEBUG}
  777. memsymtable.free;
  778. {$endif MEMDEBUG}
  779. end.