fmodule.pas 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914
  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,
  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. plinkcontaineritem=^tlinkcontaineritem;
  44. tlinkcontaineritem=object(tcontaineritem)
  45. data : pstring;
  46. needlink : longint;
  47. constructor init(const s:string;m:longint);
  48. destructor done;virtual;
  49. end;
  50. plinkcontainer=^tlinkcontainer;
  51. tlinkcontainer=object(tcontainer)
  52. constructor Init;
  53. procedure insert(const s : string;m:longint);
  54. function get(var m:longint) : string;
  55. function getusemask(mask:longint) : string;
  56. function find(const s:string):boolean;
  57. end;
  58. pmodule = ^tmodule;
  59. {$ifndef NEWMAP}
  60. tunitmap = array[0..maxunits-1] of pointer;
  61. punitmap = ^tunitmap;
  62. {$else NEWMAP}
  63. tunitmap = array[0..maxunits-1] of pmodule;
  64. punitmap = ^tunitmap;
  65. {$endif NEWMAP}
  66. tmodule = object(tmodulebase)
  67. ppufile : pppufile; { the PPU file }
  68. crc,
  69. interface_crc,
  70. flags : longint; { the PPU flags }
  71. compiled, { unit is already compiled }
  72. do_reload, { force reloading of the unit }
  73. do_assemble, { only assemble the object, don't recompile }
  74. do_compile, { need to compile the sources }
  75. sources_avail, { if all sources are reachable }
  76. sources_checked, { if there is already done a check for the sources }
  77. is_unit,
  78. in_compile, { is it being compiled ?? }
  79. in_second_compile, { is this unit being compiled for the 2nd time? }
  80. in_second_load, { is this unit PPU loaded a 2nd time? }
  81. in_implementation, { processing the implementation part? }
  82. in_global : boolean; { allow global settings }
  83. recompile_reason : trecompile_reason; { the reason why the unit should be recompiled }
  84. islibrary : boolean; { if it is a library (win32 dll) }
  85. map : punitmap; { mapping of all used units }
  86. unitcount : word; { local unit counter }
  87. globalsymtable, { pointer to the local/static symtable of this unit }
  88. localsymtable : pointer; { pointer to the psymtable of this unit }
  89. scanner : pointer; { scanner object used }
  90. loaded_from : pmodule;
  91. uses_imports : boolean; { Set if the module imports from DLL's.}
  92. imports : plinkedlist;
  93. _exports : plinkedlist;
  94. resourcefiles : tstringcontainer;
  95. linkunitofiles,
  96. linkunitstaticlibs,
  97. linkunitsharedlibs,
  98. linkotherofiles, { objects,libs loaded from the source }
  99. linkothersharedlibs, { using $L or $LINKLIB or import lib (for linux) }
  100. linkotherstaticlibs : tlinkcontainer;
  101. used_units : tlinkedlist;
  102. dependent_units : tlinkedlist;
  103. localunitsearchpath, { local searchpaths }
  104. localobjectsearchpath,
  105. localincludesearchpath,
  106. locallibrarysearchpath : TSearchPathList;
  107. asmprefix : pstring; { prefix for the smartlink asmfiles }
  108. {$ifdef Test_Double_checksum}
  109. crc_array : pointer;
  110. crc_size : longint;
  111. crc_array2 : pointer;
  112. crc_size2 : longint;
  113. {$endif def Test_Double_checksum}
  114. constructor init(const s:string;_is_unit:boolean);
  115. destructor done;virtual;
  116. procedure reset;
  117. procedure setfilename(const fn:string;allowoutput:boolean);
  118. function openppu:boolean;
  119. function search_unit(const n : string;onlysource:boolean):boolean;
  120. end;
  121. pused_unit = ^tused_unit;
  122. tused_unit = object(tlinkedlist_item)
  123. unitid : word;
  124. name : pstring;
  125. checksum,
  126. interface_checksum : longint;
  127. loaded : boolean;
  128. in_uses,
  129. in_interface,
  130. is_stab_written : boolean;
  131. u : pmodule;
  132. constructor init(_u : pmodule;intface:boolean);
  133. constructor init_to_load(const n:string;c,intfc:longint;intface:boolean);
  134. destructor done;virtual;
  135. end;
  136. pdependent_unit = ^tdependent_unit;
  137. tdependent_unit = object(tlinkedlist_item)
  138. u : pmodule;
  139. constructor init(_u : pmodule);
  140. end;
  141. var
  142. main_module : pmodule; { Main module of the program }
  143. current_module : pmodule; { Current module which is compiled or loaded }
  144. compiled_module : pmodule; { Current module which is compiled }
  145. usedunits : tlinkedlist; { Used units for this program }
  146. loaded_units : tlinkedlist; { All loaded units }
  147. SmartLinkOFiles : TStringContainer; { List of .o files which are generated,
  148. used to delete them after linking }
  149. function get_source_file(moduleindex,fileindex : word) : pinputfile;
  150. implementation
  151. uses
  152. {$ifdef delphi}
  153. dmisc,
  154. {$else}
  155. dos,
  156. {$endif}
  157. globtype,verbose,systems,
  158. symbase,
  159. scanner;
  160. {*****************************************************************************
  161. Global Functions
  162. *****************************************************************************}
  163. function get_source_file(moduleindex,fileindex : word) : pinputfile;
  164. var
  165. hp : pmodule;
  166. f : pinputfile;
  167. begin
  168. hp:=pmodule(loaded_units.first);
  169. while assigned(hp) and (hp^.unit_index<>moduleindex) do
  170. hp:=pmodule(hp^.next);
  171. get_source_file:=nil;
  172. if not assigned(hp) then
  173. exit;
  174. f:=pinputfile(hp^.sourcefiles^.files);
  175. while assigned(f) do
  176. begin
  177. if f^.ref_index=fileindex then
  178. begin
  179. get_source_file:=f;
  180. exit;
  181. end;
  182. f:=pinputfile(f^.ref_next);
  183. end;
  184. end;
  185. {****************************************************************************
  186. TLinkContainerItem
  187. ****************************************************************************}
  188. constructor TLinkContainerItem.Init(const s:string;m:longint);
  189. begin
  190. inherited Init;
  191. data:=stringdup(s);
  192. needlink:=m;
  193. end;
  194. destructor TLinkContainerItem.Done;
  195. begin
  196. stringdispose(data);
  197. end;
  198. {****************************************************************************
  199. TLinkContainer
  200. ****************************************************************************}
  201. constructor TLinkContainer.Init;
  202. begin
  203. inherited init;
  204. end;
  205. procedure TLinkContainer.insert(const s : string;m:longint);
  206. var
  207. newnode : plinkcontaineritem;
  208. begin
  209. {if find(s) then
  210. exit; }
  211. new(newnode,init(s,m));
  212. inherited insert(newnode);
  213. end;
  214. function TLinkContainer.get(var m:longint) : string;
  215. var
  216. p : plinkcontaineritem;
  217. begin
  218. p:=plinkcontaineritem(inherited get);
  219. if p=nil then
  220. begin
  221. get:='';
  222. m:=0;
  223. exit;
  224. end;
  225. get:=p^.data^;
  226. m:=p^.needlink;
  227. dispose(p,done);
  228. end;
  229. function TLinkContainer.getusemask(mask:longint) : string;
  230. var
  231. p : plinkcontaineritem;
  232. found : boolean;
  233. begin
  234. found:=false;
  235. repeat
  236. p:=plinkcontaineritem(inherited get);
  237. if p=nil then
  238. begin
  239. getusemask:='';
  240. exit;
  241. end;
  242. getusemask:=p^.data^;
  243. found:=(p^.needlink and mask)<>0;
  244. dispose(p,done);
  245. until found;
  246. end;
  247. function TLinkContainer.find(const s:string):boolean;
  248. var
  249. newnode : plinkcontaineritem;
  250. begin
  251. find:=false;
  252. newnode:=plinkcontaineritem(root);
  253. while assigned(newnode) do
  254. begin
  255. if newnode^.data^=s then
  256. begin
  257. find:=true;
  258. exit;
  259. end;
  260. newnode:=plinkcontaineritem(newnode^.next);
  261. end;
  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):boolean;
  427. begin
  428. Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
  429. UnitExists:=FileExists(Singlepathstring+FileName+ext);
  430. end;
  431. Function PPUSearchPath(const s:string):boolean;
  432. var
  433. found : boolean;
  434. begin
  435. Found:=false;
  436. singlepathstring:=FixPath(s,false);
  437. { Check for PPU file }
  438. Found:=UnitExists(target_info.unitext);
  439. if Found then
  440. Begin
  441. SetFileName(SinglePathString+FileName,false);
  442. Found:=OpenPPU;
  443. End;
  444. PPUSearchPath:=Found;
  445. end;
  446. Function SourceSearchPath(const s:string):boolean;
  447. var
  448. found : boolean;
  449. ext : string[8];
  450. begin
  451. Found:=false;
  452. singlepathstring:=FixPath(s,false);
  453. { Check for Sources }
  454. ppufile:=nil;
  455. do_compile:=true;
  456. recompile_reason:=rr_noppu;
  457. {Check for .pp file}
  458. Found:=UnitExists(target_os.sourceext);
  459. if Found then
  460. Ext:=target_os.sourceext
  461. else
  462. begin
  463. {Check for .pas}
  464. Found:=UnitExists(target_os.pasext);
  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(SinglePathString+FileName+Ext);
  474. SetFileName(SinglePathString+FileName,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 : PStringQueueItem;
  495. found : boolean;
  496. begin
  497. found:=false;
  498. hp:=list.First;
  499. while assigned(hp) do
  500. begin
  501. found:=SearchPath(hp^.data^);
  502. if found then
  503. break;
  504. hp:=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 : pdependent_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^.done;
  571. sourcefiles^.init;
  572. imports^.done;
  573. imports^.init;
  574. _exports^.done;
  575. _exports^.init;
  576. used_units.done;
  577. used_units.init;
  578. { all units that depend on this one must be recompiled ! }
  579. pm:=pdependent_unit(dependent_units.first);
  580. while assigned(pm) do
  581. begin
  582. if pm^.u^.in_second_compile then
  583. Comment(v_debug,'No reload already in second compile: '+pm^.u^.modulename^)
  584. else
  585. begin
  586. pm^.u^.do_reload:=true;
  587. Comment(v_debug,'Reloading '+pm^.u^.modulename^+' needed because '+modulename^+' is reloaded');
  588. end;
  589. pm:=pdependent_unit(pm^.next);
  590. end;
  591. dependent_units.done;
  592. dependent_units.init;
  593. resourcefiles.done;
  594. resourcefiles.init;
  595. linkunitofiles.done;
  596. linkunitofiles.init;
  597. linkunitstaticlibs.done;
  598. linkunitstaticlibs.init;
  599. linkunitsharedlibs.done;
  600. linkunitsharedlibs.init;
  601. linkotherofiles.done;
  602. linkotherofiles.init;
  603. linkotherstaticlibs.done;
  604. linkotherstaticlibs.init;
  605. linkothersharedlibs.done;
  606. linkothersharedlibs.init;
  607. uses_imports:=false;
  608. do_assemble:=false;
  609. do_compile:=false;
  610. { sources_avail:=true;
  611. should not be changed PM }
  612. compiled:=false;
  613. in_implementation:=false;
  614. in_global:=true;
  615. {loaded_from:=nil;
  616. should not be changed PFV }
  617. flags:=0;
  618. crc:=0;
  619. interface_crc:=0;
  620. unitcount:=1;
  621. recompile_reason:=rr_unknown;
  622. end;
  623. constructor tmodule.init(const s:string;_is_unit:boolean);
  624. var
  625. p : dirstr;
  626. n : namestr;
  627. e : extstr;
  628. begin
  629. FSplit(s,p,n,e);
  630. { Programs have the name program to don't conflict with dup id's }
  631. if _is_unit then
  632. begin
  633. {$ifdef UNITALIASES}
  634. modulename:=stringdup(GetUnitAlias(Upper(n)));
  635. realmodulename:=stringdup(GetUnitAlias(n));
  636. {$else}
  637. modulename:=stringdup(Upper(n));
  638. realmodulename:=stringdup(n);
  639. {$endif}
  640. end
  641. else
  642. begin
  643. modulename:=stringdup('PROGRAM');
  644. realmodulename:=stringdup('Program');
  645. end;
  646. mainsource:=stringdup(s);
  647. ppufilename:=nil;
  648. objfilename:=nil;
  649. asmfilename:=nil;
  650. staticlibfilename:=nil;
  651. sharedlibfilename:=nil;
  652. exefilename:=nil;
  653. { Dos has the famous 8.3 limit :( }
  654. {$ifdef SHORTASMPREFIX}
  655. asmprefix:=stringdup(FixFileName('as'));
  656. {$else}
  657. asmprefix:=stringdup(FixFileName(n));
  658. {$endif}
  659. outputpath:=nil;
  660. path:=nil;
  661. setfilename(p+n,true);
  662. localunitsearchpath.init;
  663. localobjectsearchpath.init;
  664. localincludesearchpath.init;
  665. locallibrarysearchpath.init;
  666. used_units.init;
  667. dependent_units.init;
  668. new(sourcefiles,init);
  669. resourcefiles.init;
  670. linkunitofiles.init;
  671. linkunitstaticlibs.init;
  672. linkunitsharedlibs.init;
  673. linkotherofiles.init;
  674. linkotherstaticlibs.init;
  675. linkothersharedlibs.init;
  676. ppufile:=nil;
  677. scanner:=nil;
  678. map:=nil;
  679. globalsymtable:=nil;
  680. localsymtable:=nil;
  681. loaded_from:=nil;
  682. flags:=0;
  683. crc:=0;
  684. interface_crc:=0;
  685. do_reload:=false;
  686. unitcount:=1;
  687. inc(global_unit_count);
  688. unit_index:=global_unit_count;
  689. do_assemble:=false;
  690. do_compile:=false;
  691. sources_avail:=true;
  692. sources_checked:=false;
  693. compiled:=false;
  694. recompile_reason:=rr_unknown;
  695. in_second_load:=false;
  696. in_compile:=false;
  697. in_second_compile:=false;
  698. in_implementation:=false;
  699. in_global:=true;
  700. is_unit:=_is_unit;
  701. islibrary:=false;
  702. uses_imports:=false;
  703. imports:=new(plinkedlist,init);
  704. _exports:=new(plinkedlist,init);
  705. { search the PPU file if it is an unit }
  706. if is_unit then
  707. begin
  708. { use the realmodulename so we can also find a case sensitive
  709. source filename }
  710. search_unit(realmodulename^,false);
  711. { it the sources_available is changed then we know that
  712. the sources aren't available }
  713. if not sources_avail then
  714. sources_checked:=true;
  715. end;
  716. end;
  717. destructor tmodule.done;
  718. {$ifdef MEMDEBUG}
  719. var
  720. d : tmemdebug;
  721. {$endif}
  722. begin
  723. if assigned(map) then
  724. dispose(map);
  725. if assigned(ppufile) then
  726. dispose(ppufile,done);
  727. ppufile:=nil;
  728. if assigned(imports) then
  729. dispose(imports,done);
  730. imports:=nil;
  731. if assigned(_exports) then
  732. dispose(_exports,done);
  733. _exports:=nil;
  734. if assigned(scanner) then
  735. pscannerfile(scanner)^.invalid:=true;
  736. if assigned(sourcefiles) then
  737. dispose(sourcefiles,done);
  738. sourcefiles:=nil;
  739. used_units.done;
  740. dependent_units.done;
  741. resourcefiles.done;
  742. linkunitofiles.done;
  743. linkunitstaticlibs.done;
  744. linkunitsharedlibs.done;
  745. linkotherofiles.done;
  746. linkotherstaticlibs.done;
  747. linkothersharedlibs.done;
  748. stringdispose(objfilename);
  749. stringdispose(asmfilename);
  750. stringdispose(ppufilename);
  751. stringdispose(staticlibfilename);
  752. stringdispose(sharedlibfilename);
  753. stringdispose(exefilename);
  754. stringdispose(outputpath);
  755. stringdispose(path);
  756. stringdispose(modulename);
  757. stringdispose(realmodulename);
  758. stringdispose(mainsource);
  759. stringdispose(asmprefix);
  760. localunitsearchpath.done;
  761. localobjectsearchpath.done;
  762. localincludesearchpath.done;
  763. locallibrarysearchpath.done;
  764. {$ifdef MEMDEBUG}
  765. d.init('symtable');
  766. {$endif}
  767. if assigned(globalsymtable) then
  768. dispose(psymtable(globalsymtable),done);
  769. globalsymtable:=nil;
  770. if assigned(localsymtable) then
  771. dispose(psymtable(localsymtable),done);
  772. localsymtable:=nil;
  773. {$ifdef MEMDEBUG}
  774. d.done;
  775. {$endif}
  776. inherited done;
  777. end;
  778. {****************************************************************************
  779. TUSED_UNIT
  780. ****************************************************************************}
  781. constructor tused_unit.init(_u : pmodule;intface:boolean);
  782. begin
  783. u:=_u;
  784. in_interface:=intface;
  785. in_uses:=false;
  786. is_stab_written:=false;
  787. loaded:=true;
  788. name:=stringdup(_u^.modulename^);
  789. checksum:=_u^.crc;
  790. interface_checksum:=_u^.interface_crc;
  791. unitid:=0;
  792. end;
  793. constructor tused_unit.init_to_load(const n:string;c,intfc:longint;intface:boolean);
  794. begin
  795. u:=nil;
  796. in_interface:=intface;
  797. in_uses:=false;
  798. is_stab_written:=false;
  799. loaded:=false;
  800. name:=stringdup(n);
  801. checksum:=c;
  802. interface_checksum:=intfc;
  803. unitid:=0;
  804. end;
  805. destructor tused_unit.done;
  806. begin
  807. stringdispose(name);
  808. inherited done;
  809. end;
  810. {****************************************************************************
  811. TDENPENDENT_UNIT
  812. ****************************************************************************}
  813. constructor tdependent_unit.init(_u : pmodule);
  814. begin
  815. u:=_u;
  816. end;
  817. end.
  818. {
  819. $Log$
  820. Revision 1.4 2000-10-31 22:02:46 peter
  821. * symtable splitted, no real code changes
  822. Revision 1.3 2000/10/15 07:47:51 peter
  823. * unit names and procedure names are stored mixed case
  824. Revision 1.2 2000/09/24 15:06:16 peter
  825. * use defines.inc
  826. Revision 1.1 2000/08/27 16:11:50 peter
  827. * moved some util functions from globals,cobjects to cutils
  828. * splitted files into finput,fmodule
  829. }