fmodule.pas 29 KB

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