fmodule.pas 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 by Florian Klaempfl
  4. This unit implements the first loading and searching of the modules
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit fmodule;
  19. {$i defines.inc}
  20. {$ifdef go32v1}
  21. {$define SHORTASMPREFIX}
  22. {$endif}
  23. {$ifdef go32v2}
  24. {$define SHORTASMPREFIX}
  25. {$endif}
  26. {$ifdef OS2}
  27. { Allthough OS/2 supports long filenames I play it safe and
  28. use 8.3 filenames, because this allows the compiler to run
  29. on a FAT partition. (DM) }
  30. {$define SHORTASMPREFIX}
  31. {$endif}
  32. interface
  33. uses
  34. cutils,cobjects,cclasses,
  35. globals,ppu,finput;
  36. const
  37. maxunits = 1024;
  38. type
  39. trecompile_reason = (rr_unknown,
  40. rr_noppu,rr_sourcenewer,rr_build,rr_libolder,rr_objolder,
  41. rr_asmolder,rr_crcchanged
  42. );
  43. TExternalsItem=class(TLinkedListItem)
  44. public
  45. found : longbool;
  46. data : pstring;
  47. constructor Create(const s:string);
  48. Destructor Destroy;override;
  49. end;
  50. tlinkcontaineritem=class(tlinkedlistitem)
  51. public
  52. data : pstring;
  53. needlink : cardinal;
  54. constructor Create(const s:string;m:cardinal);
  55. destructor Destroy;override;
  56. end;
  57. tlinkcontainer=class(tlinkedlist)
  58. procedure add(const s : string;m:cardinal);
  59. function get(var m:cardinal) : string;
  60. function getusemask(mask:cardinal) : string;
  61. function find(const s:string):boolean;
  62. end;
  63. {$ifndef NEWMAP}
  64. tunitmap = array[0..maxunits-1] of pointer;
  65. punitmap = ^tunitmap;
  66. {$else NEWMAP}
  67. tunitmap = array[0..maxunits-1] of tmodule;
  68. punitmap = ^tunitmap;
  69. {$endif NEWMAP}
  70. tmodule = class(tmodulebase)
  71. ppufile : pppufile; { the PPU file }
  72. crc,
  73. interface_crc,
  74. flags : longint; { the PPU flags }
  75. compiled, { unit is already compiled }
  76. do_reload, { force reloading of the unit }
  77. do_assemble, { only assemble the object, don't recompile }
  78. do_compile, { need to compile the sources }
  79. sources_avail, { if all sources are reachable }
  80. sources_checked, { if there is already done a check for the sources }
  81. is_unit,
  82. in_compile, { is it being compiled ?? }
  83. in_second_compile, { is this unit being compiled for the 2nd time? }
  84. in_second_load, { is this unit PPU loaded a 2nd time? }
  85. in_implementation, { processing the implementation part? }
  86. in_global : boolean; { allow global settings }
  87. recompile_reason : trecompile_reason; { the reason why the unit should be recompiled }
  88. islibrary : boolean; { if it is a library (win32 dll) }
  89. map : punitmap; { mapping of all used units }
  90. unitcount : longint; { local unit counter }
  91. globalsymtable, { pointer to the local/static symtable of this unit }
  92. localsymtable : pointer; { pointer to the psymtable of this unit }
  93. scanner : pointer; { scanner object used }
  94. loaded_from : tmodule;
  95. uses_imports : boolean; { Set if the module imports from DLL's.}
  96. imports : tlinkedlist;
  97. _exports : tlinkedlist;
  98. externals : tlinkedlist; {Only for DLL scanners by using Unix-style $LINKLIB }
  99. resourcefiles : tstringlist;
  100. linkunitofiles,
  101. linkunitstaticlibs,
  102. linkunitsharedlibs,
  103. linkotherofiles, { objects,libs loaded from the source }
  104. linkothersharedlibs, { using $L or $LINKLIB or import lib (for linux) }
  105. linkotherstaticlibs : tlinkcontainer;
  106. used_units : tlinkedlist;
  107. dependent_units : tlinkedlist;
  108. localunitsearchpath, { local searchpaths }
  109. localobjectsearchpath,
  110. localincludesearchpath,
  111. locallibrarysearchpath : TSearchPathList;
  112. asmprefix : pstring; { prefix for the smartlink asmfiles }
  113. {$ifdef Test_Double_checksum}
  114. crc_array : pointer;
  115. crc_size : longint;
  116. crc_array2 : pointer;
  117. crc_size2 : longint;
  118. {$endif def Test_Double_checksum}
  119. constructor create(const s:string;_is_unit:boolean);
  120. destructor destroy;override;
  121. procedure reset;
  122. procedure setfilename(const fn:string;allowoutput:boolean);
  123. function openppu:boolean;
  124. function search_unit(const n : string;onlysource:boolean):boolean;
  125. end;
  126. tused_unit = class(tlinkedlistitem)
  127. unitid : longint;
  128. name : pstring;
  129. checksum,
  130. interface_checksum : longint;
  131. loaded : boolean;
  132. in_uses,
  133. in_interface,
  134. is_stab_written : boolean;
  135. u : tmodule;
  136. constructor create(_u : tmodule;intface:boolean);
  137. constructor create_to_load(const n:string;c,intfc:longint;intface:boolean);
  138. destructor destroy;override;
  139. end;
  140. tdependent_unit = class(tlinkedlistitem)
  141. u : tmodule;
  142. constructor create(_u : tmodule);
  143. end;
  144. var
  145. main_module : tmodule; { Main module of the program }
  146. current_module : tmodule; { Current module which is compiled or loaded }
  147. compiled_module : tmodule; { Current module which is compiled }
  148. usedunits : tlinkedlist; { Used units for this program }
  149. loaded_units : tlinkedlist; { All loaded units }
  150. SmartLinkOFiles : TStringList; { List of .o files which are generated,
  151. used to delete them after linking }
  152. function get_source_file(moduleindex,fileindex : longint) : tinputfile;
  153. implementation
  154. uses
  155. {$ifdef delphi}
  156. dmisc,
  157. {$else}
  158. dos,
  159. {$endif}
  160. globtype,verbose,systems,
  161. symbase,
  162. scanner;
  163. {*****************************************************************************
  164. Global Functions
  165. *****************************************************************************}
  166. function get_source_file(moduleindex,fileindex : longint) : tinputfile;
  167. var
  168. hp : tmodule;
  169. begin
  170. hp:=tmodule(loaded_units.first);
  171. while assigned(hp) and (hp.unit_index<>moduleindex) do
  172. hp:=tmodule(hp.next);
  173. if assigned(hp) then
  174. get_source_file:=hp.sourcefiles.get_file(fileindex)
  175. else
  176. get_source_file:=nil;
  177. end;
  178. {****************************************************************************
  179. TLinkContainerItem
  180. ****************************************************************************}
  181. constructor TLinkContainerItem.Create(const s:string;m:cardinal);
  182. begin
  183. inherited Create;
  184. data:=stringdup(s);
  185. needlink:=m;
  186. end;
  187. destructor TLinkContainerItem.Destroy;
  188. begin
  189. stringdispose(data);
  190. end;
  191. {****************************************************************************
  192. TLinkContainer
  193. ****************************************************************************}
  194. procedure TLinkContainer.add(const s : string;m:cardinal);
  195. begin
  196. inherited concat(TLinkContainerItem.Create(s,m));
  197. end;
  198. function TLinkContainer.get(var m:cardinal) : string;
  199. var
  200. p : tlinkcontaineritem;
  201. begin
  202. p:=tlinkcontaineritem(inherited getfirst);
  203. if p=nil then
  204. begin
  205. get:='';
  206. m:=0;
  207. end
  208. else
  209. begin
  210. get:=p.data^;
  211. m:=p.needlink;
  212. p.free;
  213. end;
  214. end;
  215. function TLinkContainer.getusemask(mask:cardinal) : string;
  216. var
  217. p : tlinkcontaineritem;
  218. found : boolean;
  219. begin
  220. found:=false;
  221. repeat
  222. p:=tlinkcontaineritem(inherited getfirst);
  223. if p=nil then
  224. begin
  225. getusemask:='';
  226. exit;
  227. end;
  228. getusemask:=p.data^;
  229. found:=(p.needlink and mask)<>0;
  230. p.free;
  231. until found;
  232. end;
  233. function TLinkContainer.find(const s:string):boolean;
  234. var
  235. newnode : tlinkcontaineritem;
  236. begin
  237. find:=false;
  238. newnode:=tlinkcontaineritem(First);
  239. while assigned(newnode) do
  240. begin
  241. if newnode.data^=s then
  242. begin
  243. find:=true;
  244. exit;
  245. end;
  246. newnode:=tlinkcontaineritem(newnode.next);
  247. end;
  248. end;
  249. {****************************************************************************
  250. TExternalsItem
  251. ****************************************************************************}
  252. constructor tExternalsItem.Create(const s:string);
  253. begin
  254. inherited Create;
  255. found:=false;
  256. data:=stringdup(s);
  257. end;
  258. destructor tExternalsItem.Destroy;
  259. begin
  260. stringdispose(data);
  261. inherited;
  262. end;
  263. {****************************************************************************
  264. TMODULE
  265. ****************************************************************************}
  266. procedure tmodule.setfilename(const fn:string;allowoutput:boolean);
  267. var
  268. p : dirstr;
  269. n : NameStr;
  270. e : ExtStr;
  271. begin
  272. stringdispose(objfilename);
  273. stringdispose(asmfilename);
  274. stringdispose(ppufilename);
  275. stringdispose(staticlibfilename);
  276. stringdispose(sharedlibfilename);
  277. stringdispose(exefilename);
  278. stringdispose(outputpath);
  279. stringdispose(path);
  280. { Create names }
  281. fsplit(fn,p,n,e);
  282. n:=FixFileName(n);
  283. { set path }
  284. path:=stringdup(FixPath(p,false));
  285. { obj,asm,ppu names }
  286. p:=path^;
  287. if AllowOutput then
  288. begin
  289. if (OutputUnitDir<>'') then
  290. p:=OutputUnitDir
  291. else
  292. if (OutputExeDir<>'') then
  293. p:=OutputExeDir;
  294. end;
  295. outputpath:=stringdup(p);
  296. objfilename:=stringdup(p+n+target_info.objext);
  297. asmfilename:=stringdup(p+n+target_info.asmext);
  298. ppufilename:=stringdup(p+n+target_info.unitext);
  299. { lib and exe could be loaded with a file specified with -o }
  300. if AllowOutput and (OutputFile<>'') and (compile_level=1) then
  301. n:=OutputFile;
  302. staticlibfilename:=stringdup(p+target_os.libprefix+n+target_os.staticlibext);
  303. if target_info.target=target_i386_WIN32 then
  304. sharedlibfilename:=stringdup(p+n+target_os.sharedlibext)
  305. else
  306. sharedlibfilename:=stringdup(p+target_os.libprefix+n+target_os.sharedlibext);
  307. { output dir of exe can be specified separatly }
  308. if AllowOutput and (OutputExeDir<>'') then
  309. p:=OutputExeDir
  310. else
  311. p:=path^;
  312. exefilename:=stringdup(p+n+target_info.exeext);
  313. end;
  314. function tmodule.openppu:boolean;
  315. var
  316. objfiletime,
  317. ppufiletime,
  318. asmfiletime : longint;
  319. begin
  320. openppu:=false;
  321. Message1(unit_t_ppu_loading,ppufilename^);
  322. { Get ppufile time (also check if the file exists) }
  323. ppufiletime:=getnamedfiletime(ppufilename^);
  324. if ppufiletime=-1 then
  325. exit;
  326. { Open the ppufile }
  327. Message1(unit_u_ppu_name,ppufilename^);
  328. ppufile:=new(pppufile,init(ppufilename^));
  329. ppufile^.change_endian:=source_os.endian<>target_os.endian;
  330. if not ppufile^.open then
  331. begin
  332. dispose(ppufile,done);
  333. Message(unit_u_ppu_file_too_short);
  334. exit;
  335. end;
  336. { check for a valid PPU file }
  337. if not ppufile^.CheckPPUId then
  338. begin
  339. dispose(ppufile,done);
  340. Message(unit_u_ppu_invalid_header);
  341. exit;
  342. end;
  343. { check for allowed PPU versions }
  344. if not (ppufile^.GetPPUVersion = CurrentPPUVersion) then
  345. begin
  346. dispose(ppufile,done);
  347. Message1(unit_u_ppu_invalid_version,tostr(ppufile^.GetPPUVersion));
  348. exit;
  349. end;
  350. { check the target processor }
  351. if ttargetcpu(ppufile^.header.cpu)<>target_cpu then
  352. begin
  353. dispose(ppufile,done);
  354. Message(unit_u_ppu_invalid_processor);
  355. exit;
  356. end;
  357. { check target }
  358. if ttarget(ppufile^.header.target)<>target_info.target then
  359. begin
  360. dispose(ppufile,done);
  361. Message(unit_u_ppu_invalid_target);
  362. exit;
  363. end;
  364. { Load values to be access easier }
  365. flags:=ppufile^.header.flags;
  366. crc:=ppufile^.header.checksum;
  367. interface_crc:=ppufile^.header.interface_checksum;
  368. { Show Debug info }
  369. Message1(unit_u_ppu_time,filetimestring(ppufiletime));
  370. Message1(unit_u_ppu_flags,tostr(flags));
  371. Message1(unit_u_ppu_crc,tostr(ppufile^.header.checksum));
  372. Message1(unit_u_ppu_crc,tostr(ppufile^.header.interface_checksum)+' (intfc)');
  373. { check the object and assembler file to see if we need only to
  374. assemble, only if it's not in a library }
  375. do_compile:=false;
  376. if (flags and uf_in_library)=0 then
  377. begin
  378. if (flags and uf_smart_linked)<>0 then
  379. begin
  380. objfiletime:=getnamedfiletime(staticlibfilename^);
  381. Message2(unit_u_check_time,staticlibfilename^,filetimestring(objfiletime));
  382. if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
  383. begin
  384. recompile_reason:=rr_libolder;
  385. Message(unit_u_recompile_staticlib_is_older);
  386. do_compile:=true;
  387. exit;
  388. end;
  389. end;
  390. if (flags and uf_static_linked)<>0 then
  391. begin
  392. { the objectfile should be newer than the ppu file }
  393. objfiletime:=getnamedfiletime(objfilename^);
  394. Message2(unit_u_check_time,objfilename^,filetimestring(objfiletime));
  395. if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
  396. begin
  397. { check if assembler file is older than ppu file }
  398. asmfileTime:=GetNamedFileTime(asmfilename^);
  399. Message2(unit_u_check_time,asmfilename^,filetimestring(asmfiletime));
  400. if (asmfiletime<0) or (ppufiletime>asmfiletime) then
  401. begin
  402. Message(unit_u_recompile_obj_and_asm_older);
  403. recompile_reason:=rr_objolder;
  404. do_compile:=true;
  405. exit;
  406. end
  407. else
  408. begin
  409. Message(unit_u_recompile_obj_older_than_asm);
  410. if not(cs_asm_extern in aktglobalswitches) then
  411. begin
  412. do_compile:=true;
  413. recompile_reason:=rr_asmolder;
  414. exit;
  415. end;
  416. end;
  417. end;
  418. end;
  419. end;
  420. openppu:=true;
  421. end;
  422. function tmodule.search_unit(const n : string;onlysource:boolean):boolean;
  423. var
  424. singlepathstring,
  425. filename : string;
  426. Function UnitExists(const ext:string;var foundfile:string):boolean;
  427. begin
  428. Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
  429. UnitExists:=FindFile(FileName+ext,Singlepathstring,foundfile);
  430. end;
  431. Function PPUSearchPath(const s:string):boolean;
  432. var
  433. found : boolean;
  434. hs : string;
  435. begin
  436. Found:=false;
  437. singlepathstring:=FixPath(s,false);
  438. { Check for PPU file }
  439. Found:=UnitExists(target_info.unitext,hs);
  440. if Found then
  441. Begin
  442. SetFileName(hs,false);
  443. Found:=OpenPPU;
  444. End;
  445. PPUSearchPath:=Found;
  446. end;
  447. Function SourceSearchPath(const s:string):boolean;
  448. var
  449. found : boolean;
  450. ext : string[8];
  451. hs : string;
  452. begin
  453. Found:=false;
  454. singlepathstring:=FixPath(s,false);
  455. { Check for Sources }
  456. ppufile:=nil;
  457. do_compile:=true;
  458. recompile_reason:=rr_noppu;
  459. {Check for .pp file}
  460. Found:=UnitExists(target_os.sourceext,hs);
  461. if not Found then
  462. begin
  463. { Check for .pas }
  464. Found:=UnitExists(target_os.pasext,hs);
  465. if Found then
  466. Ext:=target_os.pasext;
  467. end;
  468. stringdispose(mainsource);
  469. if Found then
  470. begin
  471. sources_avail:=true;
  472. { Load Filenames when found }
  473. mainsource:=StringDup(hs);
  474. SetFileName(hs,false);
  475. end
  476. else
  477. sources_avail:=false;
  478. SourceSearchPath:=Found;
  479. end;
  480. Function SearchPath(const s:string):boolean;
  481. var
  482. found : boolean;
  483. begin
  484. { First check for a ppu, then for the source }
  485. found:=false;
  486. if not onlysource then
  487. found:=PPUSearchPath(s);
  488. if not found then
  489. found:=SourceSearchPath(s);
  490. SearchPath:=found;
  491. end;
  492. Function SearchPathList(list:TSearchPathList):boolean;
  493. var
  494. hp : TStringListItem;
  495. found : boolean;
  496. begin
  497. found:=false;
  498. hp:=TStringListItem(list.First);
  499. while assigned(hp) do
  500. begin
  501. found:=SearchPath(hp.Str);
  502. if found then
  503. break;
  504. hp:=TStringListItem(hp.next);
  505. end;
  506. SearchPathList:=found;
  507. end;
  508. var
  509. fnd : boolean;
  510. begin
  511. filename:=FixFileName(n);
  512. { try to find unit
  513. 1. look for ppu in cwd
  514. 2. look for ppu in outputpath if set, this is tp7 compatible (PFV)
  515. 3. look for source in cwd
  516. 4. local unit pathlist
  517. 5. global unit pathlist }
  518. fnd:=false;
  519. if not onlysource then
  520. begin
  521. fnd:=PPUSearchPath('.');
  522. if (not fnd) and (current_module.outputpath^<>'') then
  523. fnd:=PPUSearchPath(current_module.outputpath^);
  524. end;
  525. if (not fnd) then
  526. fnd:=SourceSearchPath('.');
  527. if (not fnd) then
  528. fnd:=SearchPathList(current_module.LocalUnitSearchPath);
  529. if (not fnd) then
  530. fnd:=SearchPathList(UnitSearchPath);
  531. { try to find a file with the first 8 chars of the modulename, like
  532. dos }
  533. if (not fnd) and (length(filename)>8) then
  534. begin
  535. filename:=copy(filename,1,8);
  536. fnd:=SearchPath('.');
  537. if (not fnd) then
  538. fnd:=SearchPathList(current_module.LocalUnitSearchPath);
  539. if not fnd then
  540. fnd:=SearchPathList(UnitSearchPath);
  541. end;
  542. search_unit:=fnd;
  543. end;
  544. procedure tmodule.reset;
  545. var
  546. pm : tdependent_unit;
  547. begin
  548. if assigned(scanner) then
  549. pscannerfile(scanner)^.invalid:=true;
  550. if assigned(globalsymtable) then
  551. begin
  552. dispose(psymtable(globalsymtable),done);
  553. globalsymtable:=nil;
  554. end;
  555. if assigned(localsymtable) then
  556. begin
  557. dispose(psymtable(localsymtable),done);
  558. localsymtable:=nil;
  559. end;
  560. if assigned(map) then
  561. begin
  562. dispose(map);
  563. map:=nil;
  564. end;
  565. if assigned(ppufile) then
  566. begin
  567. dispose(ppufile,done);
  568. ppufile:=nil;
  569. end;
  570. sourcefiles.free;
  571. sourcefiles:=tinputfilemanager.create;
  572. imports.free;
  573. imports:=tlinkedlist.create;
  574. _exports.free;
  575. _exports:=tlinkedlist.create;
  576. externals.free;
  577. externals:=tlinkedlist.create;
  578. used_units.free;
  579. used_units:=TLinkedList.Create;
  580. { all units that depend on this one must be recompiled ! }
  581. pm:=tdependent_unit(dependent_units.first);
  582. while assigned(pm) do
  583. begin
  584. if pm.u.in_second_compile then
  585. Comment(v_debug,'No reload already in second compile: '+pm.u.modulename^)
  586. else
  587. begin
  588. pm.u.do_reload:=true;
  589. Comment(v_debug,'Reloading '+pm.u.modulename^+' needed because '+modulename^+' is reloaded');
  590. end;
  591. pm:=tdependent_unit(pm.next);
  592. end;
  593. dependent_units.free;
  594. dependent_units:=TLinkedList.Create;
  595. resourcefiles.Free;
  596. resourcefiles:=TStringList.Create;
  597. linkunitofiles.Free;
  598. linkunitofiles:=TLinkContainer.Create;
  599. linkunitstaticlibs.Free;
  600. linkunitstaticlibs:=TLinkContainer.Create;
  601. linkunitsharedlibs.Free;
  602. linkunitsharedlibs:=TLinkContainer.Create;
  603. linkotherofiles.Free;
  604. linkotherofiles:=TLinkContainer.Create;
  605. linkotherstaticlibs.Free;
  606. linkotherstaticlibs:=TLinkContainer.Create;
  607. linkothersharedlibs.Free;
  608. linkothersharedlibs:=TLinkContainer.Create;
  609. uses_imports:=false;
  610. do_assemble:=false;
  611. do_compile:=false;
  612. { sources_avail:=true;
  613. should not be changed PM }
  614. compiled:=false;
  615. in_implementation:=false;
  616. in_global:=true;
  617. {loaded_from:=nil;
  618. should not be changed PFV }
  619. flags:=0;
  620. crc:=0;
  621. interface_crc:=0;
  622. unitcount:=1;
  623. recompile_reason:=rr_unknown;
  624. end;
  625. constructor tmodule.create(const s:string;_is_unit:boolean);
  626. var
  627. p : dirstr;
  628. n : namestr;
  629. e : extstr;
  630. begin
  631. FSplit(s,p,n,e);
  632. { Programs have the name 'Program' to don't conflict with dup id's }
  633. if _is_unit then
  634. inherited create(n)
  635. else
  636. inherited create('Program');
  637. mainsource:=stringdup(s);
  638. { Dos has the famous 8.3 limit :( }
  639. {$ifdef SHORTASMPREFIX}
  640. asmprefix:=stringdup(FixFileName('as'));
  641. {$else}
  642. asmprefix:=stringdup(FixFileName(n));
  643. {$endif}
  644. setfilename(p+n,true);
  645. localunitsearchpath:=TSearchPathList.Create;
  646. localobjectsearchpath:=TSearchPathList.Create;
  647. localincludesearchpath:=TSearchPathList.Create;
  648. locallibrarysearchpath:=TSearchPathList.Create;
  649. used_units:=TLinkedList.Create;
  650. dependent_units:=TLinkedList.Create;
  651. resourcefiles:=TStringList.Create;
  652. linkunitofiles:=TLinkContainer.Create;
  653. linkunitstaticlibs:=TLinkContainer.Create;
  654. linkunitsharedlibs:=TLinkContainer.Create;
  655. linkotherofiles:=TLinkContainer.Create;
  656. linkotherstaticlibs:=TLinkContainer.Create;
  657. linkothersharedlibs:=TLinkContainer.Create;
  658. ppufile:=nil;
  659. scanner:=nil;
  660. map:=nil;
  661. globalsymtable:=nil;
  662. localsymtable:=nil;
  663. loaded_from:=nil;
  664. flags:=0;
  665. crc:=0;
  666. interface_crc:=0;
  667. do_reload:=false;
  668. unitcount:=1;
  669. do_assemble:=false;
  670. do_compile:=false;
  671. sources_avail:=true;
  672. sources_checked:=false;
  673. compiled:=false;
  674. recompile_reason:=rr_unknown;
  675. in_second_load:=false;
  676. in_compile:=false;
  677. in_second_compile:=false;
  678. in_implementation:=false;
  679. in_global:=true;
  680. is_unit:=_is_unit;
  681. islibrary:=false;
  682. uses_imports:=false;
  683. imports:=TLinkedList.Create;
  684. _exports:=TLinkedList.Create;
  685. externals:=TLinkedList.Create;
  686. { search the PPU file if it is an unit }
  687. if is_unit then
  688. begin
  689. { use the realmodulename so we can also find a case sensitive
  690. source filename }
  691. search_unit(realmodulename^,false);
  692. { it the sources_available is changed then we know that
  693. the sources aren't available }
  694. if not sources_avail then
  695. sources_checked:=true;
  696. end;
  697. end;
  698. destructor tmodule.Destroy;
  699. {$ifdef MEMDEBUG}
  700. var
  701. d : tmemdebug;
  702. {$endif}
  703. begin
  704. if assigned(map) then
  705. dispose(map);
  706. if assigned(ppufile) then
  707. dispose(ppufile,done);
  708. ppufile:=nil;
  709. if assigned(imports) then
  710. imports.free;
  711. imports:=nil;
  712. if assigned(_exports) then
  713. _exports.free;
  714. _exports:=nil;
  715. if assigned(externals) then
  716. externals.free;
  717. externals:=nil;
  718. if assigned(scanner) then
  719. pscannerfile(scanner)^.invalid:=true;
  720. used_units.free;
  721. dependent_units.free;
  722. resourcefiles.Free;
  723. linkunitofiles.Free;
  724. linkunitstaticlibs.Free;
  725. linkunitsharedlibs.Free;
  726. linkotherofiles.Free;
  727. linkotherstaticlibs.Free;
  728. linkothersharedlibs.Free;
  729. stringdispose(objfilename);
  730. stringdispose(asmfilename);
  731. stringdispose(ppufilename);
  732. stringdispose(staticlibfilename);
  733. stringdispose(sharedlibfilename);
  734. stringdispose(exefilename);
  735. stringdispose(outputpath);
  736. stringdispose(path);
  737. stringdispose(modulename);
  738. stringdispose(realmodulename);
  739. stringdispose(mainsource);
  740. stringdispose(asmprefix);
  741. localunitsearchpath.Free;
  742. localobjectsearchpath.free;
  743. localincludesearchpath.free;
  744. locallibrarysearchpath.free;
  745. {$ifdef MEMDEBUG}
  746. d.init('symtable');
  747. {$endif}
  748. if assigned(globalsymtable) then
  749. dispose(psymtable(globalsymtable),done);
  750. globalsymtable:=nil;
  751. if assigned(localsymtable) then
  752. dispose(psymtable(localsymtable),done);
  753. localsymtable:=nil;
  754. {$ifdef MEMDEBUG}
  755. d.done;
  756. {$endif}
  757. inherited Destroy;
  758. end;
  759. {****************************************************************************
  760. TUSED_UNIT
  761. ****************************************************************************}
  762. constructor tused_unit.create(_u : tmodule;intface:boolean);
  763. begin
  764. u:=_u;
  765. in_interface:=intface;
  766. in_uses:=false;
  767. is_stab_written:=false;
  768. loaded:=true;
  769. name:=stringdup(_u.modulename^);
  770. checksum:=_u.crc;
  771. interface_checksum:=_u.interface_crc;
  772. unitid:=0;
  773. end;
  774. constructor tused_unit.create_to_load(const n:string;c,intfc:longint;intface:boolean);
  775. begin
  776. u:=nil;
  777. in_interface:=intface;
  778. in_uses:=false;
  779. is_stab_written:=false;
  780. loaded:=false;
  781. name:=stringdup(n);
  782. checksum:=c;
  783. interface_checksum:=intfc;
  784. unitid:=0;
  785. end;
  786. destructor tused_unit.destroy;
  787. begin
  788. stringdispose(name);
  789. inherited destroy;
  790. end;
  791. {****************************************************************************
  792. TDENPENDENT_UNIT
  793. ****************************************************************************}
  794. constructor tdependent_unit.create(_u : tmodule);
  795. begin
  796. u:=_u;
  797. end;
  798. end.
  799. {
  800. $Log$
  801. Revision 1.9 2001-03-13 18:45:06 peter
  802. * fixed some memory leaks
  803. Revision 1.8 2001/03/06 18:28:02 peter
  804. * patch from Pavel with a new and much faster DLL Scanner for
  805. automatic importing so $linklib works for DLLs. Thanks Pavel!
  806. Revision 1.7 2001/02/20 21:41:15 peter
  807. * new fixfilename, findfile for unix. Look first for lowercase, then
  808. NormalCase and last for UPPERCASE names.
  809. Revision 1.6 2000/12/25 00:07:25 peter
  810. + new tlinkedlist class (merge of old tstringqueue,tcontainer and
  811. tlinkedlist objects)
  812. Revision 1.5 2000/11/07 20:48:33 peter
  813. * removed ref_count from pinputfile it's not used
  814. Revision 1.4 2000/10/31 22:02:46 peter
  815. * symtable splitted, no real code changes
  816. Revision 1.3 2000/10/15 07:47:51 peter
  817. * unit names and procedure names are stored mixed case
  818. Revision 1.2 2000/09/24 15:06:16 peter
  819. * use defines.inc
  820. Revision 1.1 2000/08/27 16:11:50 peter
  821. * moved some util functions from globals,cobjects to cutils
  822. * splitted files into finput,fmodule
  823. }