fmodule.pas 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849
  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 : tstringlist;
  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 : TStringList; { 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. {*****************************************************************************
  184. Global Functions
  185. *****************************************************************************}
  186. function get_module(moduleindex : longint) : tmodule;
  187. var
  188. hp : tmodule;
  189. begin
  190. result:=nil;
  191. if moduleindex=0 then
  192. exit;
  193. result:=current_module;
  194. if not(assigned(loaded_units)) then
  195. exit;
  196. hp:=tmodule(loaded_units.first);
  197. while assigned(hp) and (hp.unit_index<>moduleindex) do
  198. hp:=tmodule(hp.next);
  199. result:=hp;
  200. end;
  201. function get_source_file(moduleindex,fileindex : longint) : tinputfile;
  202. var
  203. hp : tmodule;
  204. begin
  205. hp:=get_module(moduleindex);
  206. if assigned(hp) then
  207. get_source_file:=hp.sourcefiles.get_file(fileindex)
  208. else
  209. get_source_file:=nil;
  210. end;
  211. procedure addloadedunit(hp:tmodule);
  212. begin
  213. hp.moduleid:=loaded_units.count;
  214. loaded_units.concat(hp);
  215. end;
  216. {****************************************************************************
  217. TLinkContainerItem
  218. ****************************************************************************}
  219. constructor TLinkContainerItem.Create(const s:string;m:cardinal);
  220. begin
  221. inherited Create;
  222. data:=stringdup(s);
  223. needlink:=m;
  224. end;
  225. destructor TLinkContainerItem.Destroy;
  226. begin
  227. stringdispose(data);
  228. end;
  229. {****************************************************************************
  230. TLinkContainer
  231. ****************************************************************************}
  232. procedure TLinkContainer.add(const s : string;m:cardinal);
  233. begin
  234. inherited concat(TLinkContainerItem.Create(s,m));
  235. end;
  236. function TLinkContainer.get(var m:cardinal) : string;
  237. var
  238. p : tlinkcontaineritem;
  239. begin
  240. p:=tlinkcontaineritem(inherited getfirst);
  241. if p=nil then
  242. begin
  243. get:='';
  244. m:=0;
  245. end
  246. else
  247. begin
  248. get:=p.data^;
  249. m:=p.needlink;
  250. p.free;
  251. end;
  252. end;
  253. function TLinkContainer.getusemask(mask:cardinal) : string;
  254. var
  255. p : tlinkcontaineritem;
  256. found : boolean;
  257. begin
  258. found:=false;
  259. repeat
  260. p:=tlinkcontaineritem(inherited getfirst);
  261. if p=nil then
  262. begin
  263. getusemask:='';
  264. exit;
  265. end;
  266. getusemask:=p.data^;
  267. found:=(p.needlink and mask)<>0;
  268. p.free;
  269. until found;
  270. end;
  271. function TLinkContainer.find(const s:string):boolean;
  272. var
  273. newnode : tlinkcontaineritem;
  274. begin
  275. find:=false;
  276. newnode:=tlinkcontaineritem(First);
  277. while assigned(newnode) do
  278. begin
  279. if newnode.data^=s then
  280. begin
  281. find:=true;
  282. exit;
  283. end;
  284. newnode:=tlinkcontaineritem(newnode.next);
  285. end;
  286. end;
  287. {****************************************************************************
  288. TUSED_UNIT
  289. ****************************************************************************}
  290. constructor tused_unit.create(_u : tmodule;intface,inuses:boolean;usym:tunitsym);
  291. begin
  292. u:=_u;
  293. in_interface:=intface;
  294. in_uses:=inuses;
  295. unitsym:=usym;
  296. if _u.state=ms_compiled then
  297. begin
  298. checksum:=u.crc;
  299. interface_checksum:=u.interface_crc;
  300. end
  301. else
  302. begin
  303. checksum:=0;
  304. interface_checksum:=0;
  305. end;
  306. end;
  307. {****************************************************************************
  308. TDENPENDENT_UNIT
  309. ****************************************************************************}
  310. constructor tdependent_unit.create(_u : tmodule);
  311. begin
  312. u:=_u;
  313. end;
  314. {****************************************************************************
  315. TMODULE
  316. ****************************************************************************}
  317. constructor tmodule.create(LoadedFrom:TModule;const s:string;_is_unit:boolean);
  318. var
  319. p,n : string;
  320. begin
  321. p:=ExtractFilePath(s);
  322. n:=ChangeFileExt(ExtractFileName(s),'');
  323. { Programs have the name 'Program' to don't conflict with dup id's }
  324. if _is_unit then
  325. inherited create(n)
  326. else
  327. inherited create('Program');
  328. mainsource:=stringdup(s);
  329. { Dos has the famous 8.3 limit :( }
  330. {$ifdef shortasmprefix}
  331. asmprefix:=stringdup(FixFileName('as'));
  332. {$else}
  333. asmprefix:=stringdup(FixFileName(n));
  334. {$endif}
  335. setfilename(s,true);
  336. localunitsearchpath:=TSearchPathList.Create;
  337. localobjectsearchpath:=TSearchPathList.Create;
  338. localincludesearchpath:=TSearchPathList.Create;
  339. locallibrarysearchpath:=TSearchPathList.Create;
  340. used_units:=TLinkedList.Create;
  341. dependent_units:=TLinkedList.Create;
  342. resourcefiles:=TStringList.Create;
  343. linkunitofiles:=TLinkContainer.Create;
  344. linkunitstaticlibs:=TLinkContainer.Create;
  345. linkunitsharedlibs:=TLinkContainer.Create;
  346. linkotherofiles:=TLinkContainer.Create;
  347. linkotherstaticlibs:=TLinkContainer.Create;
  348. linkothersharedlibs:=TLinkContainer.Create;
  349. FImportLibraryList:=TFPHashObjectList.Create(true);
  350. crc:=0;
  351. interface_crc:=0;
  352. flags:=0;
  353. scanner:=nil;
  354. unitmap:=nil;
  355. unitmapsize:=0;
  356. derefmap:=nil;
  357. derefmapsize:=0;
  358. derefmapcnt:=0;
  359. derefdata:=TDynamicArray.Create(1024);
  360. derefdataintflen:=0;
  361. deflist:=TFPObjectList.Create(false);
  362. symlist:=TFPObjectList.Create(false);
  363. globalsymtable:=nil;
  364. localsymtable:=nil;
  365. globalmacrosymtable:=nil;
  366. localmacrosymtable:=nil;
  367. loaded_from:=LoadedFrom;
  368. do_reload:=false;
  369. do_compile:=false;
  370. sources_avail:=true;
  371. mainfilepos.line:=0;
  372. mainfilepos.column:=0;
  373. mainfilepos.fileindex:=0;
  374. recompile_reason:=rr_unknown;
  375. in_interface:=true;
  376. in_global:=true;
  377. is_unit:=_is_unit;
  378. islibrary:=false;
  379. is_dbginfo_written:=false;
  380. is_reset:=false;
  381. mode_switch_allowed:= true;
  382. _exports:=TLinkedList.Create;
  383. dllscannerinputlist:=TFPHashList.Create;
  384. asmdata:=TAsmData.create(realmodulename^);
  385. end;
  386. destructor tmodule.Destroy;
  387. var
  388. {$ifdef MEMDEBUG}
  389. d : tmemdebug;
  390. {$endif}
  391. i : longint;
  392. hpi : tprocinfo;
  393. begin
  394. if assigned(unitmap) then
  395. freemem(unitmap);
  396. if assigned(derefmap) then
  397. begin
  398. for i:=0 to derefmapcnt-1 do
  399. stringdispose(derefmap[i].modulename);
  400. freemem(derefmap);
  401. end;
  402. if assigned(_exports) then
  403. _exports.free;
  404. if assigned(dllscannerinputlist) then
  405. dllscannerinputlist.free;
  406. if assigned(scanner) then
  407. begin
  408. { also update current_scanner if it was pointing
  409. to this module }
  410. if current_scanner=tscannerfile(scanner) then
  411. current_scanner:=nil;
  412. tscannerfile(scanner).free;
  413. end;
  414. if assigned(asmdata) then
  415. begin
  416. if current_asmdata=asmdata then
  417. current_asmdata:=nil;
  418. asmdata.free;
  419. end;
  420. if assigned(procinfo) then
  421. begin
  422. if current_procinfo=tprocinfo(procinfo) then
  423. current_procinfo:=nil;
  424. { release procinfo tree }
  425. while assigned(procinfo) do
  426. begin
  427. hpi:=tprocinfo(procinfo).parent;
  428. tprocinfo(procinfo).free;
  429. procinfo:=hpi;
  430. end;
  431. end;
  432. used_units.free;
  433. dependent_units.free;
  434. resourcefiles.Free;
  435. linkunitofiles.Free;
  436. linkunitstaticlibs.Free;
  437. linkunitsharedlibs.Free;
  438. linkotherofiles.Free;
  439. linkotherstaticlibs.Free;
  440. linkothersharedlibs.Free;
  441. FImportLibraryList.Free;
  442. stringdispose(objfilename);
  443. stringdispose(asmfilename);
  444. stringdispose(ppufilename);
  445. stringdispose(importlibfilename);
  446. stringdispose(staticlibfilename);
  447. stringdispose(sharedlibfilename);
  448. stringdispose(exefilename);
  449. stringdispose(outputpath);
  450. stringdispose(path);
  451. stringdispose(realmodulename);
  452. stringdispose(mainsource);
  453. stringdispose(asmprefix);
  454. localunitsearchpath.Free;
  455. localobjectsearchpath.free;
  456. localincludesearchpath.free;
  457. locallibrarysearchpath.free;
  458. {$ifdef MEMDEBUG}
  459. d:=tmemdebug.create(modulename^+' - symtable');
  460. {$endif}
  461. derefdata.free;
  462. deflist.free;
  463. symlist.free;
  464. if assigned(globalsymtable) then
  465. globalsymtable.free;
  466. if assigned(localsymtable) then
  467. localsymtable.free;
  468. if assigned(globalmacrosymtable) then
  469. globalmacrosymtable.free;
  470. if assigned(localmacrosymtable) then
  471. localmacrosymtable.free;
  472. {$ifdef MEMDEBUG}
  473. d.free;
  474. {$endif}
  475. stringdispose(modulename);
  476. inherited Destroy;
  477. end;
  478. procedure tmodule.reset;
  479. var
  480. hpi : tprocinfo;
  481. i : longint;
  482. begin
  483. if assigned(scanner) then
  484. begin
  485. { also update current_scanner if it was pointing
  486. to this module }
  487. if current_scanner=tscannerfile(scanner) then
  488. current_scanner:=nil;
  489. tscannerfile(scanner).free;
  490. scanner:=nil;
  491. end;
  492. if assigned(procinfo) then
  493. begin
  494. if current_procinfo=tprocinfo(procinfo) then
  495. current_procinfo:=nil;
  496. { release procinfo tree }
  497. while assigned(procinfo) do
  498. begin
  499. hpi:=tprocinfo(procinfo).parent;
  500. tprocinfo(procinfo).free;
  501. procinfo:=hpi;
  502. end;
  503. end;
  504. if assigned(asmdata) then
  505. begin
  506. if current_asmdata=TAsmData(asmdata) then
  507. current_asmdata:=nil;
  508. asmdata.free;
  509. asmdata:=nil;
  510. end;
  511. if assigned(globalsymtable) then
  512. begin
  513. globalsymtable.free;
  514. globalsymtable:=nil;
  515. end;
  516. if assigned(localsymtable) then
  517. begin
  518. localsymtable.free;
  519. localsymtable:=nil;
  520. end;
  521. if assigned(globalmacrosymtable) then
  522. begin
  523. globalmacrosymtable.free;
  524. globalmacrosymtable:=nil;
  525. end;
  526. if assigned(localmacrosymtable) then
  527. begin
  528. localmacrosymtable.free;
  529. localmacrosymtable:=nil;
  530. end;
  531. deflist.free;
  532. deflist:=TFPObjectList.Create(false);
  533. symlist.free;
  534. symlist:=TFPObjectList.Create(false);
  535. derefdata.free;
  536. derefdata:=TDynamicArray.Create(1024);
  537. if assigned(unitmap) then
  538. begin
  539. freemem(unitmap);
  540. unitmap:=nil;
  541. end;
  542. if assigned(derefmap) then
  543. begin
  544. for i:=0 to derefmapcnt-1 do
  545. stringdispose(derefmap[i].modulename);
  546. freemem(derefmap);
  547. derefmap:=nil;
  548. end;
  549. unitmapsize:=0;
  550. derefmapsize:=0;
  551. derefmapcnt:=0;
  552. derefdataintflen:=0;
  553. sourcefiles.free;
  554. sourcefiles:=tinputfilemanager.create;
  555. asmdata:=TAsmData.create(realmodulename^);
  556. _exports.free;
  557. _exports:=tlinkedlist.create;
  558. dllscannerinputlist.free;
  559. dllscannerinputlist:=TFPHashList.create;
  560. used_units.free;
  561. used_units:=TLinkedList.Create;
  562. dependent_units.free;
  563. dependent_units:=TLinkedList.Create;
  564. resourcefiles.Free;
  565. resourcefiles:=TStringList.Create;
  566. linkunitofiles.Free;
  567. linkunitofiles:=TLinkContainer.Create;
  568. linkunitstaticlibs.Free;
  569. linkunitstaticlibs:=TLinkContainer.Create;
  570. linkunitsharedlibs.Free;
  571. linkunitsharedlibs:=TLinkContainer.Create;
  572. linkotherofiles.Free;
  573. linkotherofiles:=TLinkContainer.Create;
  574. linkotherstaticlibs.Free;
  575. linkotherstaticlibs:=TLinkContainer.Create;
  576. linkothersharedlibs.Free;
  577. linkothersharedlibs:=TLinkContainer.Create;
  578. FImportLibraryList.Free;
  579. FImportLibraryList:=TFPHashObjectList.Create;
  580. do_compile:=false;
  581. do_reload:=false;
  582. interface_compiled:=false;
  583. in_interface:=true;
  584. in_global:=true;
  585. mode_switch_allowed:=true;
  586. is_dbginfo_written:=false;
  587. is_reset:=false;
  588. crc:=0;
  589. interface_crc:=0;
  590. flags:=0;
  591. mainfilepos.line:=0;
  592. mainfilepos.column:=0;
  593. mainfilepos.fileindex:=0;
  594. recompile_reason:=rr_unknown;
  595. {
  596. The following fields should not
  597. be reset:
  598. mainsource
  599. state
  600. loaded_from
  601. sources_avail
  602. }
  603. end;
  604. procedure tmodule.adddependency(callermodule:tmodule);
  605. begin
  606. { This is not needed for programs }
  607. if not callermodule.is_unit then
  608. exit;
  609. Message2(unit_u_add_depend_to,callermodule.modulename^,modulename^);
  610. dependent_units.concat(tdependent_unit.create(callermodule));
  611. end;
  612. procedure tmodule.flagdependent(callermodule:tmodule);
  613. var
  614. pm : tdependent_unit;
  615. begin
  616. { flag all units that depend on this unit for reloading }
  617. pm:=tdependent_unit(current_module.dependent_units.first);
  618. while assigned(pm) do
  619. begin
  620. { We do not have to reload the unit that wants to load
  621. this unit, unless this unit is already compiled during
  622. the loading }
  623. if (pm.u=callermodule) and
  624. (pm.u.state<>ms_compiled) then
  625. Message1(unit_u_no_reload_is_caller,pm.u.modulename^)
  626. else
  627. if pm.u.state=ms_second_compile then
  628. Message1(unit_u_no_reload_in_second_compile,pm.u.modulename^)
  629. else
  630. begin
  631. pm.u.do_reload:=true;
  632. Message1(unit_u_flag_for_reload,pm.u.modulename^);
  633. end;
  634. pm:=tdependent_unit(pm.next);
  635. end;
  636. end;
  637. function tmodule.addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit;
  638. var
  639. pu : tused_unit;
  640. begin
  641. pu:=tused_unit.create(hp,in_interface,inuses,usym);
  642. used_units.concat(pu);
  643. addusedunit:=pu;
  644. end;
  645. procedure tmodule.updatemaps;
  646. var
  647. oldmapsize : longint;
  648. hp : tmodule;
  649. i : longint;
  650. begin
  651. { Extend unitmap }
  652. oldmapsize:=unitmapsize;
  653. unitmapsize:=loaded_units.count;
  654. reallocmem(unitmap,unitmapsize*sizeof(tunitmaprec));
  655. fillchar(unitmap[oldmapsize],(unitmapsize-oldmapsize)*sizeof(tunitmaprec),0);
  656. { Extend Derefmap }
  657. oldmapsize:=derefmapsize;
  658. derefmapsize:=loaded_units.count;
  659. reallocmem(derefmap,derefmapsize*sizeof(tderefmaprec));
  660. fillchar(derefmap[oldmapsize],(derefmapsize-oldmapsize)*sizeof(tderefmaprec),0);
  661. { Add all units to unitmap }
  662. hp:=tmodule(loaded_units.first);
  663. i:=0;
  664. while assigned(hp) do
  665. begin
  666. if hp.moduleid>=unitmapsize then
  667. internalerror(200501151);
  668. { Verify old entries }
  669. if (i<oldmapsize) then
  670. begin
  671. if (hp.moduleid<>i) or
  672. (unitmap[hp.moduleid].u<>hp) then
  673. internalerror(200501156);
  674. end
  675. else
  676. begin
  677. unitmap[hp.moduleid].u:=hp;
  678. unitmap[hp.moduleid].derefidx:=-1;
  679. end;
  680. inc(i);
  681. hp:=tmodule(hp.next);
  682. end;
  683. end;
  684. function tmodule.derefidx_unit(id:longint):longint;
  685. begin
  686. if id>=unitmapsize then
  687. internalerror(2005011511);
  688. if unitmap[id].derefidx=-1 then
  689. begin
  690. unitmap[id].derefidx:=derefmapcnt;
  691. inc(derefmapcnt);
  692. derefmap[unitmap[id].derefidx].u:=unitmap[id].u;
  693. end;
  694. if unitmap[id].derefidx>=derefmapsize then
  695. internalerror(2005011514);
  696. result:=unitmap[id].derefidx;
  697. end;
  698. function tmodule.resolve_unit(id:longint):tmodule;
  699. var
  700. hp : tmodule;
  701. begin
  702. if id>=derefmapsize then
  703. internalerror(200306231);
  704. result:=derefmap[id].u;
  705. if not assigned(result) then
  706. begin
  707. if not assigned(derefmap[id].modulename) or
  708. (derefmap[id].modulename^='') then
  709. internalerror(200501159);
  710. hp:=tmodule(loaded_units.first);
  711. while assigned(hp) do
  712. begin
  713. if hp.modulename^=derefmap[id].modulename^ then
  714. break;
  715. hp:=tmodule(hp.next);
  716. end;
  717. if not assigned(hp) then
  718. internalerror(2005011510);
  719. derefmap[id].u:=hp;
  720. result:=hp;
  721. end;
  722. end;
  723. procedure tmodule.allunitsused;
  724. var
  725. pu : tused_unit;
  726. begin
  727. pu:=tused_unit(used_units.first);
  728. while assigned(pu) do
  729. begin
  730. if assigned(pu.u.globalsymtable) then
  731. begin
  732. if unitmap[pu.u.moduleid].u<>pu.u then
  733. internalerror(200501157);
  734. { Give a note when the unit is not referenced, skip
  735. this is for units with an initialization/finalization }
  736. if (unitmap[pu.u.moduleid].refs=0) and
  737. ((pu.u.flags and (uf_init or uf_finalize))=0) then
  738. CGMessagePos2(pu.unitsym.fileinfo,sym_n_unit_not_used,pu.u.realmodulename^,realmodulename^);
  739. end;
  740. pu:=tused_unit(pu.next);
  741. end;
  742. end;
  743. procedure tmodule.setmodulename(const s:string);
  744. begin
  745. stringdispose(modulename);
  746. stringdispose(realmodulename);
  747. modulename:=stringdup(upper(s));
  748. realmodulename:=stringdup(s);
  749. { also update asmlibrary names }
  750. current_asmdata.name:=modulename^;
  751. current_asmdata.realname:=realmodulename^;
  752. end;
  753. procedure TModule.AddExternalImport(const libname,symname:string;OrdNr: longint;isvar:boolean);
  754. var
  755. ImportLibrary : TImportLibrary;
  756. ImportSymbol : TFPHashObject;
  757. begin
  758. ImportLibrary:=TImportLibrary(ImportLibraryList.Find(libname));
  759. if not assigned(ImportLibrary) then
  760. ImportLibrary:=TImportLibrary.Create(ImportLibraryList,libname);
  761. ImportSymbol:=TFPHashObject(ImportLibrary.ImportSymbolList.Find(symname));
  762. if not assigned(ImportSymbol) then
  763. ImportSymbol:=TImportSymbol.Create(ImportLibrary.ImportSymbolList,symname,OrdNr,isvar);
  764. end;
  765. end.