fmodule.pas 26 KB

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