fmodule.pas 28 KB

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