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