fmodule.pas 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907
  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 : longint; { 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 : longint;
  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 : longint) : 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 : longint) : pinputfile;
  164. var
  165. hp : pmodule;
  166. begin
  167. hp:=pmodule(loaded_units.first);
  168. while assigned(hp) and (hp^.unit_index<>moduleindex) do
  169. hp:=pmodule(hp^.next);
  170. if assigned(hp) then
  171. get_source_file:=hp^.sourcefiles^.get_file(fileindex)
  172. else
  173. get_source_file:=nil;
  174. end;
  175. {****************************************************************************
  176. TLinkContainerItem
  177. ****************************************************************************}
  178. constructor TLinkContainerItem.Init(const s:string;m:longint);
  179. begin
  180. inherited Init;
  181. data:=stringdup(s);
  182. needlink:=m;
  183. end;
  184. destructor TLinkContainerItem.Done;
  185. begin
  186. stringdispose(data);
  187. end;
  188. {****************************************************************************
  189. TLinkContainer
  190. ****************************************************************************}
  191. constructor TLinkContainer.Init;
  192. begin
  193. inherited init;
  194. end;
  195. procedure TLinkContainer.insert(const s : string;m:longint);
  196. var
  197. newnode : plinkcontaineritem;
  198. begin
  199. {if find(s) then
  200. exit; }
  201. new(newnode,init(s,m));
  202. inherited insert(newnode);
  203. end;
  204. function TLinkContainer.get(var m:longint) : string;
  205. var
  206. p : plinkcontaineritem;
  207. begin
  208. p:=plinkcontaineritem(inherited get);
  209. if p=nil then
  210. begin
  211. get:='';
  212. m:=0;
  213. exit;
  214. end;
  215. get:=p^.data^;
  216. m:=p^.needlink;
  217. dispose(p,done);
  218. end;
  219. function TLinkContainer.getusemask(mask:longint) : string;
  220. var
  221. p : plinkcontaineritem;
  222. found : boolean;
  223. begin
  224. found:=false;
  225. repeat
  226. p:=plinkcontaineritem(inherited get);
  227. if p=nil then
  228. begin
  229. getusemask:='';
  230. exit;
  231. end;
  232. getusemask:=p^.data^;
  233. found:=(p^.needlink and mask)<>0;
  234. dispose(p,done);
  235. until found;
  236. end;
  237. function TLinkContainer.find(const s:string):boolean;
  238. var
  239. newnode : plinkcontaineritem;
  240. begin
  241. find:=false;
  242. newnode:=plinkcontaineritem(root);
  243. while assigned(newnode) do
  244. begin
  245. if newnode^.data^=s then
  246. begin
  247. find:=true;
  248. exit;
  249. end;
  250. newnode:=plinkcontaineritem(newnode^.next);
  251. end;
  252. end;
  253. {****************************************************************************
  254. TMODULE
  255. ****************************************************************************}
  256. procedure tmodule.setfilename(const fn:string;allowoutput:boolean);
  257. var
  258. p : dirstr;
  259. n : NameStr;
  260. e : ExtStr;
  261. begin
  262. stringdispose(objfilename);
  263. stringdispose(asmfilename);
  264. stringdispose(ppufilename);
  265. stringdispose(staticlibfilename);
  266. stringdispose(sharedlibfilename);
  267. stringdispose(exefilename);
  268. stringdispose(outputpath);
  269. stringdispose(path);
  270. { Create names }
  271. fsplit(fn,p,n,e);
  272. n:=FixFileName(n);
  273. { set path }
  274. path:=stringdup(FixPath(p,false));
  275. { obj,asm,ppu names }
  276. p:=path^;
  277. if AllowOutput then
  278. begin
  279. if (OutputUnitDir<>'') then
  280. p:=OutputUnitDir
  281. else
  282. if (OutputExeDir<>'') then
  283. p:=OutputExeDir;
  284. end;
  285. outputpath:=stringdup(p);
  286. objfilename:=stringdup(p+n+target_info.objext);
  287. asmfilename:=stringdup(p+n+target_info.asmext);
  288. ppufilename:=stringdup(p+n+target_info.unitext);
  289. { lib and exe could be loaded with a file specified with -o }
  290. if AllowOutput and (OutputFile<>'') and (compile_level=1) then
  291. n:=OutputFile;
  292. staticlibfilename:=stringdup(p+target_os.libprefix+n+target_os.staticlibext);
  293. if target_info.target=target_i386_WIN32 then
  294. sharedlibfilename:=stringdup(p+n+target_os.sharedlibext)
  295. else
  296. sharedlibfilename:=stringdup(p+target_os.libprefix+n+target_os.sharedlibext);
  297. { output dir of exe can be specified separatly }
  298. if AllowOutput and (OutputExeDir<>'') then
  299. p:=OutputExeDir
  300. else
  301. p:=path^;
  302. exefilename:=stringdup(p+n+target_info.exeext);
  303. end;
  304. function tmodule.openppu:boolean;
  305. var
  306. objfiletime,
  307. ppufiletime,
  308. asmfiletime : longint;
  309. begin
  310. openppu:=false;
  311. Message1(unit_t_ppu_loading,ppufilename^);
  312. { Get ppufile time (also check if the file exists) }
  313. ppufiletime:=getnamedfiletime(ppufilename^);
  314. if ppufiletime=-1 then
  315. exit;
  316. { Open the ppufile }
  317. Message1(unit_u_ppu_name,ppufilename^);
  318. ppufile:=new(pppufile,init(ppufilename^));
  319. ppufile^.change_endian:=source_os.endian<>target_os.endian;
  320. if not ppufile^.open then
  321. begin
  322. dispose(ppufile,done);
  323. Message(unit_u_ppu_file_too_short);
  324. exit;
  325. end;
  326. { check for a valid PPU file }
  327. if not ppufile^.CheckPPUId then
  328. begin
  329. dispose(ppufile,done);
  330. Message(unit_u_ppu_invalid_header);
  331. exit;
  332. end;
  333. { check for allowed PPU versions }
  334. if not (ppufile^.GetPPUVersion = CurrentPPUVersion) then
  335. begin
  336. dispose(ppufile,done);
  337. Message1(unit_u_ppu_invalid_version,tostr(ppufile^.GetPPUVersion));
  338. exit;
  339. end;
  340. { check the target processor }
  341. if ttargetcpu(ppufile^.header.cpu)<>target_cpu then
  342. begin
  343. dispose(ppufile,done);
  344. Message(unit_u_ppu_invalid_processor);
  345. exit;
  346. end;
  347. { check target }
  348. if ttarget(ppufile^.header.target)<>target_info.target then
  349. begin
  350. dispose(ppufile,done);
  351. Message(unit_u_ppu_invalid_target);
  352. exit;
  353. end;
  354. { Load values to be access easier }
  355. flags:=ppufile^.header.flags;
  356. crc:=ppufile^.header.checksum;
  357. interface_crc:=ppufile^.header.interface_checksum;
  358. { Show Debug info }
  359. Message1(unit_u_ppu_time,filetimestring(ppufiletime));
  360. Message1(unit_u_ppu_flags,tostr(flags));
  361. Message1(unit_u_ppu_crc,tostr(ppufile^.header.checksum));
  362. Message1(unit_u_ppu_crc,tostr(ppufile^.header.interface_checksum)+' (intfc)');
  363. { check the object and assembler file to see if we need only to
  364. assemble, only if it's not in a library }
  365. do_compile:=false;
  366. if (flags and uf_in_library)=0 then
  367. begin
  368. if (flags and uf_smart_linked)<>0 then
  369. begin
  370. objfiletime:=getnamedfiletime(staticlibfilename^);
  371. Message2(unit_u_check_time,staticlibfilename^,filetimestring(objfiletime));
  372. if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
  373. begin
  374. recompile_reason:=rr_libolder;
  375. Message(unit_u_recompile_staticlib_is_older);
  376. do_compile:=true;
  377. exit;
  378. end;
  379. end;
  380. if (flags and uf_static_linked)<>0 then
  381. begin
  382. { the objectfile should be newer than the ppu file }
  383. objfiletime:=getnamedfiletime(objfilename^);
  384. Message2(unit_u_check_time,objfilename^,filetimestring(objfiletime));
  385. if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
  386. begin
  387. { check if assembler file is older than ppu file }
  388. asmfileTime:=GetNamedFileTime(asmfilename^);
  389. Message2(unit_u_check_time,asmfilename^,filetimestring(asmfiletime));
  390. if (asmfiletime<0) or (ppufiletime>asmfiletime) then
  391. begin
  392. Message(unit_u_recompile_obj_and_asm_older);
  393. recompile_reason:=rr_objolder;
  394. do_compile:=true;
  395. exit;
  396. end
  397. else
  398. begin
  399. Message(unit_u_recompile_obj_older_than_asm);
  400. if not(cs_asm_extern in aktglobalswitches) then
  401. begin
  402. do_compile:=true;
  403. recompile_reason:=rr_asmolder;
  404. exit;
  405. end;
  406. end;
  407. end;
  408. end;
  409. end;
  410. openppu:=true;
  411. end;
  412. function tmodule.search_unit(const n : string;onlysource:boolean):boolean;
  413. var
  414. singlepathstring,
  415. filename : string;
  416. Function UnitExists(const ext:string):boolean;
  417. begin
  418. Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
  419. UnitExists:=FileExists(Singlepathstring+FileName+ext);
  420. end;
  421. Function PPUSearchPath(const s:string):boolean;
  422. var
  423. found : boolean;
  424. begin
  425. Found:=false;
  426. singlepathstring:=FixPath(s,false);
  427. { Check for PPU file }
  428. Found:=UnitExists(target_info.unitext);
  429. if Found then
  430. Begin
  431. SetFileName(SinglePathString+FileName,false);
  432. Found:=OpenPPU;
  433. End;
  434. PPUSearchPath:=Found;
  435. end;
  436. Function SourceSearchPath(const s:string):boolean;
  437. var
  438. found : boolean;
  439. ext : string[8];
  440. begin
  441. Found:=false;
  442. singlepathstring:=FixPath(s,false);
  443. { Check for Sources }
  444. ppufile:=nil;
  445. do_compile:=true;
  446. recompile_reason:=rr_noppu;
  447. {Check for .pp file}
  448. Found:=UnitExists(target_os.sourceext);
  449. if Found then
  450. Ext:=target_os.sourceext
  451. else
  452. begin
  453. {Check for .pas}
  454. Found:=UnitExists(target_os.pasext);
  455. if Found then
  456. Ext:=target_os.pasext;
  457. end;
  458. stringdispose(mainsource);
  459. if Found then
  460. begin
  461. sources_avail:=true;
  462. {Load Filenames when found}
  463. mainsource:=StringDup(SinglePathString+FileName+Ext);
  464. SetFileName(SinglePathString+FileName,false);
  465. end
  466. else
  467. sources_avail:=false;
  468. SourceSearchPath:=Found;
  469. end;
  470. Function SearchPath(const s:string):boolean;
  471. var
  472. found : boolean;
  473. begin
  474. { First check for a ppu, then for the source }
  475. found:=false;
  476. if not onlysource then
  477. found:=PPUSearchPath(s);
  478. if not found then
  479. found:=SourceSearchPath(s);
  480. SearchPath:=found;
  481. end;
  482. Function SearchPathList(list:TSearchPathList):boolean;
  483. var
  484. hp : PStringQueueItem;
  485. found : boolean;
  486. begin
  487. found:=false;
  488. hp:=list.First;
  489. while assigned(hp) do
  490. begin
  491. found:=SearchPath(hp^.data^);
  492. if found then
  493. break;
  494. hp:=hp^.next;
  495. end;
  496. SearchPathList:=found;
  497. end;
  498. var
  499. fnd : boolean;
  500. begin
  501. filename:=FixFileName(n);
  502. { try to find unit
  503. 1. look for ppu in cwd
  504. 2. look for ppu in outputpath if set, this is tp7 compatible (PFV)
  505. 3. look for source in cwd
  506. 4. local unit pathlist
  507. 5. global unit pathlist }
  508. fnd:=false;
  509. if not onlysource then
  510. begin
  511. fnd:=PPUSearchPath('.');
  512. if (not fnd) and (current_module^.outputpath^<>'') then
  513. fnd:=PPUSearchPath(current_module^.outputpath^);
  514. end;
  515. if (not fnd) then
  516. fnd:=SourceSearchPath('.');
  517. if (not fnd) then
  518. fnd:=SearchPathList(current_module^.LocalUnitSearchPath);
  519. if (not fnd) then
  520. fnd:=SearchPathList(UnitSearchPath);
  521. { try to find a file with the first 8 chars of the modulename, like
  522. dos }
  523. if (not fnd) and (length(filename)>8) then
  524. begin
  525. filename:=copy(filename,1,8);
  526. fnd:=SearchPath('.');
  527. if (not fnd) then
  528. fnd:=SearchPathList(current_module^.LocalUnitSearchPath);
  529. if not fnd then
  530. fnd:=SearchPathList(UnitSearchPath);
  531. end;
  532. search_unit:=fnd;
  533. end;
  534. procedure tmodule.reset;
  535. var
  536. pm : pdependent_unit;
  537. begin
  538. if assigned(scanner) then
  539. pscannerfile(scanner)^.invalid:=true;
  540. if assigned(globalsymtable) then
  541. begin
  542. dispose(psymtable(globalsymtable),done);
  543. globalsymtable:=nil;
  544. end;
  545. if assigned(localsymtable) then
  546. begin
  547. dispose(psymtable(localsymtable),done);
  548. localsymtable:=nil;
  549. end;
  550. if assigned(map) then
  551. begin
  552. dispose(map);
  553. map:=nil;
  554. end;
  555. if assigned(ppufile) then
  556. begin
  557. dispose(ppufile,done);
  558. ppufile:=nil;
  559. end;
  560. sourcefiles^.done;
  561. sourcefiles^.init;
  562. imports^.done;
  563. imports^.init;
  564. _exports^.done;
  565. _exports^.init;
  566. used_units.done;
  567. used_units.init;
  568. { all units that depend on this one must be recompiled ! }
  569. pm:=pdependent_unit(dependent_units.first);
  570. while assigned(pm) do
  571. begin
  572. if pm^.u^.in_second_compile then
  573. Comment(v_debug,'No reload already in second compile: '+pm^.u^.modulename^)
  574. else
  575. begin
  576. pm^.u^.do_reload:=true;
  577. Comment(v_debug,'Reloading '+pm^.u^.modulename^+' needed because '+modulename^+' is reloaded');
  578. end;
  579. pm:=pdependent_unit(pm^.next);
  580. end;
  581. dependent_units.done;
  582. dependent_units.init;
  583. resourcefiles.done;
  584. resourcefiles.init;
  585. linkunitofiles.done;
  586. linkunitofiles.init;
  587. linkunitstaticlibs.done;
  588. linkunitstaticlibs.init;
  589. linkunitsharedlibs.done;
  590. linkunitsharedlibs.init;
  591. linkotherofiles.done;
  592. linkotherofiles.init;
  593. linkotherstaticlibs.done;
  594. linkotherstaticlibs.init;
  595. linkothersharedlibs.done;
  596. linkothersharedlibs.init;
  597. uses_imports:=false;
  598. do_assemble:=false;
  599. do_compile:=false;
  600. { sources_avail:=true;
  601. should not be changed PM }
  602. compiled:=false;
  603. in_implementation:=false;
  604. in_global:=true;
  605. {loaded_from:=nil;
  606. should not be changed PFV }
  607. flags:=0;
  608. crc:=0;
  609. interface_crc:=0;
  610. unitcount:=1;
  611. recompile_reason:=rr_unknown;
  612. end;
  613. constructor tmodule.init(const s:string;_is_unit:boolean);
  614. var
  615. p : dirstr;
  616. n : namestr;
  617. e : extstr;
  618. begin
  619. FSplit(s,p,n,e);
  620. { Programs have the name program to don't conflict with dup id's }
  621. if _is_unit then
  622. begin
  623. {$ifdef UNITALIASES}
  624. modulename:=stringdup(GetUnitAlias(Upper(n)));
  625. realmodulename:=stringdup(GetUnitAlias(n));
  626. {$else}
  627. modulename:=stringdup(Upper(n));
  628. realmodulename:=stringdup(n);
  629. {$endif}
  630. end
  631. else
  632. begin
  633. modulename:=stringdup('PROGRAM');
  634. realmodulename:=stringdup('Program');
  635. end;
  636. mainsource:=stringdup(s);
  637. ppufilename:=nil;
  638. objfilename:=nil;
  639. asmfilename:=nil;
  640. staticlibfilename:=nil;
  641. sharedlibfilename:=nil;
  642. exefilename:=nil;
  643. { Dos has the famous 8.3 limit :( }
  644. {$ifdef SHORTASMPREFIX}
  645. asmprefix:=stringdup(FixFileName('as'));
  646. {$else}
  647. asmprefix:=stringdup(FixFileName(n));
  648. {$endif}
  649. outputpath:=nil;
  650. path:=nil;
  651. setfilename(p+n,true);
  652. localunitsearchpath.init;
  653. localobjectsearchpath.init;
  654. localincludesearchpath.init;
  655. locallibrarysearchpath.init;
  656. used_units.init;
  657. dependent_units.init;
  658. new(sourcefiles,init);
  659. resourcefiles.init;
  660. linkunitofiles.init;
  661. linkunitstaticlibs.init;
  662. linkunitsharedlibs.init;
  663. linkotherofiles.init;
  664. linkotherstaticlibs.init;
  665. linkothersharedlibs.init;
  666. ppufile:=nil;
  667. scanner:=nil;
  668. map:=nil;
  669. globalsymtable:=nil;
  670. localsymtable:=nil;
  671. loaded_from:=nil;
  672. flags:=0;
  673. crc:=0;
  674. interface_crc:=0;
  675. do_reload:=false;
  676. unitcount:=1;
  677. inc(global_unit_count);
  678. unit_index:=global_unit_count;
  679. do_assemble:=false;
  680. do_compile:=false;
  681. sources_avail:=true;
  682. sources_checked:=false;
  683. compiled:=false;
  684. recompile_reason:=rr_unknown;
  685. in_second_load:=false;
  686. in_compile:=false;
  687. in_second_compile:=false;
  688. in_implementation:=false;
  689. in_global:=true;
  690. is_unit:=_is_unit;
  691. islibrary:=false;
  692. uses_imports:=false;
  693. imports:=new(plinkedlist,init);
  694. _exports:=new(plinkedlist,init);
  695. { search the PPU file if it is an unit }
  696. if is_unit then
  697. begin
  698. { use the realmodulename so we can also find a case sensitive
  699. source filename }
  700. search_unit(realmodulename^,false);
  701. { it the sources_available is changed then we know that
  702. the sources aren't available }
  703. if not sources_avail then
  704. sources_checked:=true;
  705. end;
  706. end;
  707. destructor tmodule.done;
  708. {$ifdef MEMDEBUG}
  709. var
  710. d : tmemdebug;
  711. {$endif}
  712. begin
  713. if assigned(map) then
  714. dispose(map);
  715. if assigned(ppufile) then
  716. dispose(ppufile,done);
  717. ppufile:=nil;
  718. if assigned(imports) then
  719. dispose(imports,done);
  720. imports:=nil;
  721. if assigned(_exports) then
  722. dispose(_exports,done);
  723. _exports:=nil;
  724. if assigned(scanner) then
  725. pscannerfile(scanner)^.invalid:=true;
  726. if assigned(sourcefiles) then
  727. dispose(sourcefiles,done);
  728. sourcefiles:=nil;
  729. used_units.done;
  730. dependent_units.done;
  731. resourcefiles.done;
  732. linkunitofiles.done;
  733. linkunitstaticlibs.done;
  734. linkunitsharedlibs.done;
  735. linkotherofiles.done;
  736. linkotherstaticlibs.done;
  737. linkothersharedlibs.done;
  738. stringdispose(objfilename);
  739. stringdispose(asmfilename);
  740. stringdispose(ppufilename);
  741. stringdispose(staticlibfilename);
  742. stringdispose(sharedlibfilename);
  743. stringdispose(exefilename);
  744. stringdispose(outputpath);
  745. stringdispose(path);
  746. stringdispose(modulename);
  747. stringdispose(realmodulename);
  748. stringdispose(mainsource);
  749. stringdispose(asmprefix);
  750. localunitsearchpath.done;
  751. localobjectsearchpath.done;
  752. localincludesearchpath.done;
  753. locallibrarysearchpath.done;
  754. {$ifdef MEMDEBUG}
  755. d.init('symtable');
  756. {$endif}
  757. if assigned(globalsymtable) then
  758. dispose(psymtable(globalsymtable),done);
  759. globalsymtable:=nil;
  760. if assigned(localsymtable) then
  761. dispose(psymtable(localsymtable),done);
  762. localsymtable:=nil;
  763. {$ifdef MEMDEBUG}
  764. d.done;
  765. {$endif}
  766. inherited done;
  767. end;
  768. {****************************************************************************
  769. TUSED_UNIT
  770. ****************************************************************************}
  771. constructor tused_unit.init(_u : pmodule;intface:boolean);
  772. begin
  773. u:=_u;
  774. in_interface:=intface;
  775. in_uses:=false;
  776. is_stab_written:=false;
  777. loaded:=true;
  778. name:=stringdup(_u^.modulename^);
  779. checksum:=_u^.crc;
  780. interface_checksum:=_u^.interface_crc;
  781. unitid:=0;
  782. end;
  783. constructor tused_unit.init_to_load(const n:string;c,intfc:longint;intface:boolean);
  784. begin
  785. u:=nil;
  786. in_interface:=intface;
  787. in_uses:=false;
  788. is_stab_written:=false;
  789. loaded:=false;
  790. name:=stringdup(n);
  791. checksum:=c;
  792. interface_checksum:=intfc;
  793. unitid:=0;
  794. end;
  795. destructor tused_unit.done;
  796. begin
  797. stringdispose(name);
  798. inherited done;
  799. end;
  800. {****************************************************************************
  801. TDENPENDENT_UNIT
  802. ****************************************************************************}
  803. constructor tdependent_unit.init(_u : pmodule);
  804. begin
  805. u:=_u;
  806. end;
  807. end.
  808. {
  809. $Log$
  810. Revision 1.5 2000-11-07 20:48:33 peter
  811. * removed ref_count from pinputfile it's not used
  812. Revision 1.4 2000/10/31 22:02:46 peter
  813. * symtable splitted, no real code changes
  814. Revision 1.3 2000/10/15 07:47:51 peter
  815. * unit names and procedure names are stored mixed case
  816. Revision 1.2 2000/09/24 15:06:16 peter
  817. * use defines.inc
  818. Revision 1.1 2000/08/27 16:11:50 peter
  819. * moved some util functions from globals,cobjects to cutils
  820. * splitted files into finput,fmodule
  821. }