fmodule.pas 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900
  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. p,n : string;
  356. begin
  357. p:=ExtractFilePath(s);
  358. n:=ChangeFileExt(ExtractFileName(s),'');
  359. { Programs have the name 'Program' to don't conflict with dup id's }
  360. if _is_unit then
  361. inherited create(n)
  362. else
  363. inherited create('Program');
  364. mainsource:=stringdup(s);
  365. { Dos has the famous 8.3 limit :( }
  366. {$ifdef shortasmprefix}
  367. asmprefix:=stringdup(FixFileName('as'));
  368. {$else}
  369. asmprefix:=stringdup(FixFileName(n));
  370. {$endif}
  371. setfilename(s,true);
  372. localunitsearchpath:=TSearchPathList.Create;
  373. localobjectsearchpath:=TSearchPathList.Create;
  374. localincludesearchpath:=TSearchPathList.Create;
  375. locallibrarysearchpath:=TSearchPathList.Create;
  376. used_units:=TLinkedList.Create;
  377. dependent_units:=TLinkedList.Create;
  378. resourcefiles:=TCmdStrList.Create;
  379. linkunitofiles:=TLinkContainer.Create;
  380. linkunitstaticlibs:=TLinkContainer.Create;
  381. linkunitsharedlibs:=TLinkContainer.Create;
  382. linkotherofiles:=TLinkContainer.Create;
  383. linkotherstaticlibs:=TLinkContainer.Create;
  384. linkothersharedlibs:=TLinkContainer.Create;
  385. FImportLibraryList:=TFPHashObjectList.Create(true);
  386. crc:=0;
  387. interface_crc:=0;
  388. flags:=0;
  389. scanner:=nil;
  390. unitmap:=nil;
  391. unitmapsize:=0;
  392. derefmap:=nil;
  393. derefmapsize:=0;
  394. derefmapcnt:=0;
  395. derefdata:=TDynamicArray.Create(1024);
  396. derefdataintflen:=0;
  397. deflist:=TFPObjectList.Create(false);
  398. symlist:=TFPObjectList.Create(false);
  399. globalsymtable:=nil;
  400. localsymtable:=nil;
  401. globalmacrosymtable:=nil;
  402. localmacrosymtable:=nil;
  403. loaded_from:=LoadedFrom;
  404. do_reload:=false;
  405. do_compile:=false;
  406. sources_avail:=true;
  407. mainfilepos.line:=0;
  408. mainfilepos.column:=0;
  409. mainfilepos.fileindex:=0;
  410. recompile_reason:=rr_unknown;
  411. in_interface:=true;
  412. in_global:=true;
  413. is_unit:=_is_unit;
  414. islibrary:=false;
  415. is_dbginfo_written:=false;
  416. is_reset:=false;
  417. mode_switch_allowed:= true;
  418. _exports:=TLinkedList.Create;
  419. dllscannerinputlist:=TFPHashList.Create;
  420. asmdata:=TAsmData.create(realmodulename^);
  421. end;
  422. destructor tmodule.Destroy;
  423. var
  424. i : longint;
  425. hpi : tprocinfo;
  426. begin
  427. if assigned(unitmap) then
  428. freemem(unitmap);
  429. if assigned(derefmap) then
  430. begin
  431. for i:=0 to derefmapcnt-1 do
  432. stringdispose(derefmap[i].modulename);
  433. freemem(derefmap);
  434. end;
  435. if assigned(_exports) then
  436. _exports.free;
  437. if assigned(dllscannerinputlist) then
  438. dllscannerinputlist.free;
  439. if assigned(scanner) then
  440. begin
  441. { also update current_scanner if it was pointing
  442. to this module }
  443. if current_scanner=tscannerfile(scanner) then
  444. current_scanner:=nil;
  445. tscannerfile(scanner).free;
  446. end;
  447. if assigned(asmdata) then
  448. begin
  449. if current_asmdata=asmdata then
  450. current_asmdata:=nil;
  451. asmdata.free;
  452. end;
  453. if assigned(procinfo) then
  454. begin
  455. if current_procinfo=tprocinfo(procinfo) then
  456. current_procinfo:=nil;
  457. { release procinfo tree }
  458. while assigned(procinfo) do
  459. begin
  460. hpi:=tprocinfo(procinfo).parent;
  461. tprocinfo(procinfo).free;
  462. procinfo:=hpi;
  463. end;
  464. end;
  465. used_units.free;
  466. dependent_units.free;
  467. resourcefiles.Free;
  468. linkunitofiles.Free;
  469. linkunitstaticlibs.Free;
  470. linkunitsharedlibs.Free;
  471. linkotherofiles.Free;
  472. linkotherstaticlibs.Free;
  473. linkothersharedlibs.Free;
  474. FImportLibraryList.Free;
  475. stringdispose(objfilename);
  476. stringdispose(asmfilename);
  477. stringdispose(ppufilename);
  478. stringdispose(importlibfilename);
  479. stringdispose(staticlibfilename);
  480. stringdispose(sharedlibfilename);
  481. stringdispose(exefilename);
  482. stringdispose(outputpath);
  483. stringdispose(path);
  484. stringdispose(realmodulename);
  485. stringdispose(mainsource);
  486. stringdispose(asmprefix);
  487. localunitsearchpath.Free;
  488. localobjectsearchpath.free;
  489. localincludesearchpath.free;
  490. locallibrarysearchpath.free;
  491. {$ifdef MEMDEBUG}
  492. memsymtable.start;
  493. {$endif}
  494. derefdata.free;
  495. deflist.free;
  496. symlist.free;
  497. if assigned(globalsymtable) then
  498. globalsymtable.free;
  499. if assigned(localsymtable) then
  500. localsymtable.free;
  501. if assigned(globalmacrosymtable) then
  502. globalmacrosymtable.free;
  503. if assigned(localmacrosymtable) then
  504. localmacrosymtable.free;
  505. {$ifdef MEMDEBUG}
  506. memsymtable.stop;
  507. {$endif}
  508. stringdispose(modulename);
  509. inherited Destroy;
  510. end;
  511. procedure tmodule.reset;
  512. var
  513. hpi : tprocinfo;
  514. i : longint;
  515. begin
  516. if assigned(scanner) then
  517. begin
  518. { also update current_scanner if it was pointing
  519. to this module }
  520. if current_scanner=tscannerfile(scanner) then
  521. current_scanner:=nil;
  522. tscannerfile(scanner).free;
  523. scanner:=nil;
  524. end;
  525. if assigned(procinfo) then
  526. begin
  527. if current_procinfo=tprocinfo(procinfo) then
  528. current_procinfo:=nil;
  529. { release procinfo tree }
  530. while assigned(procinfo) do
  531. begin
  532. hpi:=tprocinfo(procinfo).parent;
  533. tprocinfo(procinfo).free;
  534. procinfo:=hpi;
  535. end;
  536. end;
  537. if assigned(asmdata) then
  538. begin
  539. if current_asmdata=TAsmData(asmdata) then
  540. current_asmdata:=nil;
  541. asmdata.free;
  542. asmdata:=nil;
  543. end;
  544. if assigned(globalsymtable) then
  545. begin
  546. globalsymtable.free;
  547. globalsymtable:=nil;
  548. end;
  549. if assigned(localsymtable) then
  550. begin
  551. localsymtable.free;
  552. localsymtable:=nil;
  553. end;
  554. if assigned(globalmacrosymtable) then
  555. begin
  556. globalmacrosymtable.free;
  557. globalmacrosymtable:=nil;
  558. end;
  559. if assigned(localmacrosymtable) then
  560. begin
  561. localmacrosymtable.free;
  562. localmacrosymtable:=nil;
  563. end;
  564. deflist.free;
  565. deflist:=TFPObjectList.Create(false);
  566. symlist.free;
  567. symlist:=TFPObjectList.Create(false);
  568. derefdata.free;
  569. derefdata:=TDynamicArray.Create(1024);
  570. if assigned(unitmap) then
  571. begin
  572. freemem(unitmap);
  573. unitmap:=nil;
  574. end;
  575. if assigned(derefmap) then
  576. begin
  577. for i:=0 to derefmapcnt-1 do
  578. stringdispose(derefmap[i].modulename);
  579. freemem(derefmap);
  580. derefmap:=nil;
  581. end;
  582. unitmapsize:=0;
  583. derefmapsize:=0;
  584. derefmapcnt:=0;
  585. derefdataintflen:=0;
  586. sourcefiles.free;
  587. sourcefiles:=tinputfilemanager.create;
  588. asmdata:=TAsmData.create(realmodulename^);
  589. _exports.free;
  590. _exports:=tlinkedlist.create;
  591. dllscannerinputlist.free;
  592. dllscannerinputlist:=TFPHashList.create;
  593. used_units.free;
  594. used_units:=TLinkedList.Create;
  595. dependent_units.free;
  596. dependent_units:=TLinkedList.Create;
  597. resourcefiles.Free;
  598. resourcefiles:=TCmdStrList.Create;
  599. linkunitofiles.Free;
  600. linkunitofiles:=TLinkContainer.Create;
  601. linkunitstaticlibs.Free;
  602. linkunitstaticlibs:=TLinkContainer.Create;
  603. linkunitsharedlibs.Free;
  604. linkunitsharedlibs:=TLinkContainer.Create;
  605. linkotherofiles.Free;
  606. linkotherofiles:=TLinkContainer.Create;
  607. linkotherstaticlibs.Free;
  608. linkotherstaticlibs:=TLinkContainer.Create;
  609. linkothersharedlibs.Free;
  610. linkothersharedlibs:=TLinkContainer.Create;
  611. FImportLibraryList.Free;
  612. FImportLibraryList:=TFPHashObjectList.Create;
  613. do_compile:=false;
  614. do_reload:=false;
  615. interface_compiled:=false;
  616. in_interface:=true;
  617. in_global:=true;
  618. mode_switch_allowed:=true;
  619. is_dbginfo_written:=false;
  620. is_reset:=false;
  621. crc:=0;
  622. interface_crc:=0;
  623. flags:=0;
  624. mainfilepos.line:=0;
  625. mainfilepos.column:=0;
  626. mainfilepos.fileindex:=0;
  627. recompile_reason:=rr_unknown;
  628. {
  629. The following fields should not
  630. be reset:
  631. mainsource
  632. state
  633. loaded_from
  634. sources_avail
  635. }
  636. end;
  637. procedure tmodule.adddependency(callermodule:tmodule);
  638. begin
  639. { This is not needed for programs }
  640. if not callermodule.is_unit then
  641. exit;
  642. Message2(unit_u_add_depend_to,callermodule.modulename^,modulename^);
  643. dependent_units.concat(tdependent_unit.create(callermodule));
  644. end;
  645. procedure tmodule.flagdependent(callermodule:tmodule);
  646. var
  647. pm : tdependent_unit;
  648. begin
  649. { flag all units that depend on this unit for reloading }
  650. pm:=tdependent_unit(current_module.dependent_units.first);
  651. while assigned(pm) do
  652. begin
  653. { We do not have to reload the unit that wants to load
  654. this unit, unless this unit is already compiled during
  655. the loading }
  656. if (pm.u=callermodule) and
  657. (pm.u.state<>ms_compiled) then
  658. Message1(unit_u_no_reload_is_caller,pm.u.modulename^)
  659. else
  660. if pm.u.state=ms_second_compile then
  661. Message1(unit_u_no_reload_in_second_compile,pm.u.modulename^)
  662. else
  663. begin
  664. pm.u.do_reload:=true;
  665. Message1(unit_u_flag_for_reload,pm.u.modulename^);
  666. end;
  667. pm:=tdependent_unit(pm.next);
  668. end;
  669. end;
  670. function tmodule.addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit;
  671. var
  672. pu : tused_unit;
  673. begin
  674. pu:=tused_unit.create(hp,in_interface,inuses,usym);
  675. used_units.concat(pu);
  676. addusedunit:=pu;
  677. end;
  678. procedure tmodule.updatemaps;
  679. var
  680. oldmapsize : longint;
  681. hp : tmodule;
  682. i : longint;
  683. begin
  684. { Extend unitmap }
  685. oldmapsize:=unitmapsize;
  686. unitmapsize:=loaded_units.count;
  687. reallocmem(unitmap,unitmapsize*sizeof(tunitmaprec));
  688. fillchar(unitmap[oldmapsize],(unitmapsize-oldmapsize)*sizeof(tunitmaprec),0);
  689. { Extend Derefmap }
  690. oldmapsize:=derefmapsize;
  691. derefmapsize:=loaded_units.count;
  692. reallocmem(derefmap,derefmapsize*sizeof(tderefmaprec));
  693. fillchar(derefmap[oldmapsize],(derefmapsize-oldmapsize)*sizeof(tderefmaprec),0);
  694. { Add all units to unitmap }
  695. hp:=tmodule(loaded_units.first);
  696. i:=0;
  697. while assigned(hp) do
  698. begin
  699. if hp.moduleid>=unitmapsize then
  700. internalerror(200501151);
  701. { Verify old entries }
  702. if (i<oldmapsize) then
  703. begin
  704. if (hp.moduleid<>i) or
  705. (unitmap[hp.moduleid].u<>hp) then
  706. internalerror(200501156);
  707. end
  708. else
  709. begin
  710. unitmap[hp.moduleid].u:=hp;
  711. unitmap[hp.moduleid].derefidx:=-1;
  712. end;
  713. inc(i);
  714. hp:=tmodule(hp.next);
  715. end;
  716. end;
  717. function tmodule.derefidx_unit(id:longint):longint;
  718. begin
  719. if id>=unitmapsize then
  720. internalerror(2005011511);
  721. if unitmap[id].derefidx=-1 then
  722. begin
  723. unitmap[id].derefidx:=derefmapcnt;
  724. inc(derefmapcnt);
  725. derefmap[unitmap[id].derefidx].u:=unitmap[id].u;
  726. end;
  727. if unitmap[id].derefidx>=derefmapsize then
  728. internalerror(2005011514);
  729. result:=unitmap[id].derefidx;
  730. end;
  731. function tmodule.resolve_unit(id:longint):tmodule;
  732. var
  733. hp : tmodule;
  734. begin
  735. if id>=derefmapsize then
  736. internalerror(200306231);
  737. result:=derefmap[id].u;
  738. if not assigned(result) then
  739. begin
  740. if not assigned(derefmap[id].modulename) or
  741. (derefmap[id].modulename^='') then
  742. internalerror(200501159);
  743. hp:=tmodule(loaded_units.first);
  744. while assigned(hp) do
  745. begin
  746. { only check for units. The main program is also
  747. as a unit in the loaded_units list. We simply need
  748. to ignore this entry (PFV) }
  749. if hp.is_unit and
  750. (hp.modulename^=derefmap[id].modulename^) then
  751. break;
  752. hp:=tmodule(hp.next);
  753. end;
  754. if not assigned(hp) then
  755. internalerror(2005011510);
  756. derefmap[id].u:=hp;
  757. result:=hp;
  758. end;
  759. end;
  760. procedure tmodule.allunitsused;
  761. var
  762. pu : tused_unit;
  763. begin
  764. pu:=tused_unit(used_units.first);
  765. while assigned(pu) do
  766. begin
  767. if assigned(pu.u.globalsymtable) then
  768. begin
  769. if unitmap[pu.u.moduleid].u<>pu.u then
  770. internalerror(200501157);
  771. { Give a note when the unit is not referenced, skip
  772. this is for units with an initialization/finalization }
  773. if (unitmap[pu.u.moduleid].refs=0) and
  774. ((pu.u.flags and (uf_init or uf_finalize))=0) then
  775. CGMessagePos2(pu.unitsym.fileinfo,sym_n_unit_not_used,pu.u.realmodulename^,realmodulename^);
  776. end;
  777. pu:=tused_unit(pu.next);
  778. end;
  779. end;
  780. procedure tmodule.setmodulename(const s:string);
  781. begin
  782. stringdispose(modulename);
  783. stringdispose(realmodulename);
  784. modulename:=stringdup(upper(s));
  785. realmodulename:=stringdup(s);
  786. { also update asmlibrary names }
  787. current_asmdata.name:=modulename^;
  788. current_asmdata.realname:=realmodulename^;
  789. end;
  790. procedure TModule.AddExternalImport(const libname,symname:string;OrdNr: longint;isvar:boolean);
  791. var
  792. ImportLibrary : TImportLibrary;
  793. ImportSymbol : TFPHashObject;
  794. begin
  795. ImportLibrary:=TImportLibrary(ImportLibraryList.Find(libname));
  796. if not assigned(ImportLibrary) then
  797. ImportLibrary:=TImportLibrary.Create(ImportLibraryList,libname);
  798. ImportSymbol:=TFPHashObject(ImportLibrary.ImportSymbolList.Find(symname));
  799. if not assigned(ImportSymbol) then
  800. ImportSymbol:=TImportSymbol.Create(ImportLibrary.ImportSymbolList,symname,OrdNr,isvar);
  801. end;
  802. initialization
  803. {$ifdef MEMDEBUG}
  804. memsymtable:=TMemDebug.create('Symtables');
  805. memsymtable.stop;
  806. {$endif MEMDEBUG}
  807. finalization
  808. {$ifdef MEMDEBUG}
  809. memsymtable.free;
  810. {$endif MEMDEBUG}
  811. end.