fmodule.pas 29 KB

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