fmodule.pas 27 KB

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