fmodule.pas 28 KB

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