files.pas 30 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961
  1. {
  2. $Id$
  3. Copyright (c) 1996-98 by Florian Klaempfl
  4. This unit implements an extended file management and the first loading
  5. and searching of the modules (ppufiles)
  6. This program is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2 of the License, or
  9. (at your option) any later version.
  10. This program is distributed in the hope that it will be useful,
  11. but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. GNU General Public License for more details.
  14. You should have received a copy of the GNU General Public License
  15. along with this program; if not, write to the Free Software
  16. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17. ****************************************************************************
  18. }
  19. unit files;
  20. interface
  21. uses
  22. cobjects,globals
  23. {$ifdef NEWPPU}
  24. ,ppu
  25. {$endif}
  26. ;
  27. const
  28. {$ifdef FPC}
  29. maxunits = 1024;
  30. extbufsize = 65535;
  31. {$else}
  32. maxunits = 128;
  33. extbufsize = 2000;
  34. {$endif}
  35. type
  36. { this isn't a text file, this is t-ext-file }
  37. { which means a extended file this files can }
  38. { be handled by a file manager }
  39. pextfile = ^textfile;
  40. textfile = object(tbufferedfile)
  41. path,name,ext : pstring;
  42. _next : pextfile; { else conflicts with tinputstack }
  43. ref_index : word; { 65000 input files for a unit should be enough !! }
  44. { p must be the complete path (with ending \ (or / for unix ...) }
  45. constructor init(const p,n,e : string);
  46. destructor done;virtual;
  47. end;
  48. pinputfile = ^tinputfile;
  49. tinputfile = object(textfile)
  50. filenotatend : boolean;
  51. line_no : longint;
  52. line_count : longint; { second counter for unimportant tokens }
  53. next : pinputfile; { next input file in the stack of input files }
  54. ref_count : longint; { to handle the browser refs }
  55. constructor init(const p,n,e : string);
  56. procedure write_file_line(var t : text); { writes the file name and line number to t }
  57. function get_file_line : string;
  58. end;
  59. pfilemanager = ^tfilemanager;
  60. tfilemanager = object
  61. files : pextfile;
  62. last_ref_index : word;
  63. constructor init;
  64. destructor done;
  65. procedure close_all;
  66. procedure register_file(f : pextfile);
  67. function get_file(w : word) : pextfile;
  68. end;
  69. type
  70. tunitmap = array[0..maxunits-1] of pointer;
  71. punitmap = ^tunitmap;
  72. pmodule = ^tmodule;
  73. tmodule = object(tlinkedlist_item)
  74. {$ifdef NEWPPU}
  75. ppufile : pppufile; { the PPU file }
  76. {$else}
  77. ppufile : pextfile; { the PPU file }
  78. {$endif}
  79. crc,
  80. flags : longint; { the PPU flags }
  81. compiled, { unit is already compiled }
  82. do_assemble, { only assemble the object, don't recompile }
  83. do_compile, { need to compile the sources }
  84. sources_avail, { if all sources are reachable }
  85. in_implementation, { processing the implementation part? }
  86. in_main : boolean; { global, after uses else false }
  87. map : punitmap; { mapping of all used units }
  88. unitcount : word; { local unit counter }
  89. symtable : pointer; { pointer to the psymtable of this unit }
  90. output_format : tof; { how to write this file }
  91. uses_imports : boolean; { Set if the module imports from DLL's.}
  92. imports : plinkedlist;
  93. sourcefiles : tfilemanager;
  94. linksharedlibs,
  95. linkstaticlibs,
  96. linkofiles : tstringcontainer;
  97. used_units : tlinkedlist;
  98. current_inputfile : pinputfile;
  99. { used in firstpass for faster settings }
  100. current_index : word;
  101. unitname, { name of the (unit) module in uppercase }
  102. objfilename, { fullname of the objectfile }
  103. asmfilename, { fullname of the assemblerfile }
  104. ppufilename, { fullname of the ppufile }
  105. arfilename, { fullname of the archivefile }
  106. mainsource : pstring; { name of the main sourcefile }
  107. constructor init(const s:string;is_unit:boolean);
  108. destructor special_done;virtual; { this is to be called only when compiling again }
  109. procedure setfilename(const path,name:string);
  110. {$ifdef NEWPPU}
  111. function openppu(const unit_path:string):boolean;
  112. {$else}
  113. function load_ppu(const unit_path,n,ext:string):boolean;
  114. {$endif}
  115. procedure search_unit(const n : string);
  116. end;
  117. pused_unit = ^tused_unit;
  118. tused_unit = object(tlinkedlist_item)
  119. u : pmodule;
  120. in_uses,
  121. in_interface,
  122. is_stab_written : boolean;
  123. unitid : word;
  124. constructor init(_u : pmodule;f : byte);
  125. destructor done;virtual;
  126. end;
  127. {$ifndef NEWPPU}
  128. type
  129. tunitheader = array[0..19] of char;
  130. const
  131. { compiler version }
  132. { format | }
  133. { signature | | }
  134. { | | | }
  135. { /-------\ /-------\ /----\ }
  136. unitheader : tunitheader = ('P','P','U','0','1','4',#0,#99,
  137. #0,#0,#0,#0,#0,#0,#255,#255,
  138. { | | \---------/ \-------/ }
  139. { | | | | }
  140. { | | check sum | }
  141. { | \--flags unused }
  142. { target system }
  143. #0,#0,#0,#0);
  144. {\---------/ }
  145. { | }
  146. { start of machine language }
  147. ibloadunit = 1;
  148. iborddef = 2;
  149. ibpointerdef = 3;
  150. ibtypesym = 4;
  151. ibarraydef = 5;
  152. ibprocdef = 6;
  153. ibprocsym = 7;
  154. iblinkofile = 8;
  155. ibstringdef = 9;
  156. ibvarsym = 10;
  157. ibconstsym = 11;
  158. ibinitunit = 12;
  159. ibenumsym = 13;
  160. ibtypedconstsym = 14;
  161. ibrecorddef = 15;
  162. ibfiledef = 16;
  163. ibformaldef = 17;
  164. ibobjectdef = 18;
  165. ibenumdef = 19;
  166. ibsetdef = 20;
  167. ibprocvardef = 21;
  168. ibsourcefile = 22;
  169. ibdbxcount = 23;
  170. ibfloatdef = 24;
  171. ibref = 25;
  172. ibextsymref = 26;
  173. ibextdefref = 27;
  174. ibabsolutesym = 28;
  175. ibclassrefdef = 29;
  176. ibpropertysym = 30;
  177. ibsharedlibs = 31;
  178. iblongstringdef = 32;
  179. ibansistringdef = 33;
  180. ibunitname = 34;
  181. ibwidestringdef = 35;
  182. ibstaticlibs = 36;
  183. ibend = 255;
  184. { unit flags }
  185. uf_init = $1;
  186. uf_uses_dbx = $2;
  187. uf_uses_browser = $4;
  188. uf_in_library = $8;
  189. uf_shared_library = $10;
  190. uf_big_endian = $20;
  191. uf_smartlink = $40;
  192. {$endif}
  193. var
  194. main_module : pmodule;
  195. current_module : pmodule;
  196. loaded_units : tlinkedlist;
  197. implementation
  198. uses
  199. dos,verbose,systems;
  200. {****************************************************************************
  201. TFILE
  202. ****************************************************************************}
  203. constructor textfile.init(const p,n,e : string);
  204. begin
  205. inherited init(p+n+e,extbufsize);
  206. path:=stringdup(p);
  207. name:=stringdup(n);
  208. ext:=stringdup(e);
  209. end;
  210. destructor textfile.done;
  211. begin
  212. inherited done;
  213. end;
  214. {****************************************************************************
  215. TINPUTFILE
  216. ****************************************************************************}
  217. constructor tinputfile.init(const p,n,e : string);
  218. begin
  219. inherited init(p,n,e);
  220. filenotatend:=true;
  221. line_no:=1;
  222. line_count:=0;
  223. next:=nil;
  224. end;
  225. procedure tinputfile.write_file_line(var t : text);
  226. begin
  227. write(t,get_file_line);
  228. end;
  229. function tinputfile.get_file_line : string;
  230. begin
  231. if Use_Rhide then
  232. get_file_line:=lowercase(bstoslash(path^)+name^+ext^)+':'+tostr(line_no)+':'
  233. else
  234. get_file_line:=name^+ext^+'('+tostr(line_no)+')'
  235. end;
  236. {****************************************************************************
  237. TFILEMANAGER
  238. ****************************************************************************}
  239. constructor tfilemanager.init;
  240. begin
  241. files:=nil;
  242. last_ref_index:=0;
  243. end;
  244. destructor tfilemanager.done;
  245. var
  246. hp : pextfile;
  247. begin
  248. hp:=files;
  249. while assigned(hp) do
  250. begin
  251. files:=files^._next;
  252. dispose(hp,done);
  253. hp:=files;
  254. end;
  255. end;
  256. procedure tfilemanager.close_all;
  257. begin
  258. end;
  259. procedure tfilemanager.register_file(f : pextfile);
  260. begin
  261. inc(last_ref_index);
  262. f^._next:=files;
  263. f^.ref_index:=last_ref_index;
  264. files:=f;
  265. end;
  266. function tfilemanager.get_file(w : word) : pextfile;
  267. var
  268. ff : pextfile;
  269. begin
  270. ff:=files;
  271. while assigned(ff) and (ff^.ref_index<>w) do
  272. ff:=ff^._next;
  273. get_file:=ff;
  274. end;
  275. {****************************************************************************
  276. TMODULE
  277. ****************************************************************************}
  278. procedure tmodule.setfilename(const path,name:string);
  279. var
  280. s : string;
  281. begin
  282. stringdispose(objfilename);
  283. stringdispose(asmfilename);
  284. stringdispose(ppufilename);
  285. stringdispose(arfilename);
  286. s:=FixFileName(FixPath(path)+name);
  287. objfilename:=stringdup(s+target_info.objext);
  288. asmfilename:=stringdup(s+target_info.asmext);
  289. ppufilename:=stringdup(s+target_info.unitext);
  290. arfilename:=stringdup(s+target_os.staticlibext);
  291. end;
  292. {$ifdef NEWPPU}
  293. function tmodule.openppu(const unit_path:string):boolean;
  294. var
  295. temp,hs : string;
  296. b : byte;
  297. incfile_found : boolean;
  298. objfiletime,
  299. ppufiletime,
  300. asmfiletime,
  301. source_time : longint;
  302. {$ifdef UseBrowser}
  303. hp : pextfile;
  304. _d : dirstr;
  305. _n : namestr;
  306. _e : extstr;
  307. {$endif UseBrowser}
  308. begin
  309. openppu:=false;
  310. { Get ppufile time (also check if the file exists) }
  311. ppufiletime:=getnamedfiletime(ppufilename^);
  312. if ppufiletime=-1 then
  313. exit;
  314. Message1(unit_u_ppu_loading,ppufilename^);
  315. ppufile:=new(pppufile,init(ppufilename^));
  316. if not ppufile^.open then
  317. begin
  318. dispose(ppufile,done);
  319. Message(unit_d_ppu_file_too_short);
  320. exit;
  321. end;
  322. { check for a valid PPU file }
  323. if not ppufile^.CheckPPUId then
  324. begin
  325. dispose(ppufile,done);
  326. Message(unit_d_ppu_invalid_header);
  327. exit;
  328. end;
  329. { check for allowed PPU versions }
  330. if not (ppufile^.GetPPUVersion in [15]) then
  331. begin
  332. dispose(ppufile,done);
  333. Message1(unit_d_ppu_invalid_version,tostr(ppufile^.GetPPUVersion));
  334. exit;
  335. end;
  336. flags:=ppufile^.header.flags;
  337. { Show Debug info }
  338. Message1(unit_d_ppu_time,filetimestring(ppufiletime));
  339. Message1(unit_d_ppu_flags,tostr(flags));
  340. Message1(unit_d_ppu_crc,tostr(ppufile^.header.checksum));
  341. { Unitname }
  342. b:=ppufile^.readentry;
  343. if b=ibunitname then
  344. begin
  345. stringdispose(unitname);
  346. unitname:=stringdup(ppufile^.getstring);
  347. b:=ppufile^.readentry;
  348. end;
  349. { search source files there is at least one source file }
  350. do_compile:=false;
  351. sources_avail:=true;
  352. if b=ibsourcefile then
  353. begin
  354. while not ppufile^.endofentry do
  355. begin
  356. hs:=ppufile^.getstring;
  357. if (flags and uf_in_library)<>0 then
  358. begin
  359. sources_avail:=false;
  360. temp:=' library';
  361. end
  362. else
  363. begin
  364. { check the date of the source files }
  365. Source_Time:=GetNamedFileTime(unit_path+hs);
  366. if Source_Time=-1 then
  367. begin
  368. { search for include files in the includepathlist }
  369. if b<>ibend then
  370. temp:=search(hs,includesearchpath,incfile_found);
  371. if incfile_found then
  372. begin
  373. hs:=temp+hs;
  374. Source_Time:=GetNamedFileTime(hs);
  375. end;
  376. end
  377. else
  378. hs:=unit_path+hs;
  379. if Source_Time=-1 then
  380. begin
  381. sources_avail:=false;
  382. temp:=' not found';
  383. end
  384. else
  385. begin
  386. temp:=' time '+filetimestring(source_time);
  387. if (source_time>ppufiletime) then
  388. begin
  389. do_compile:=true;
  390. temp:=temp+' *'
  391. end;
  392. end;
  393. end;
  394. Message1(unit_t_ppu_source,hs+temp);
  395. {$ifdef UseBrowser}
  396. fsplit(hs,_d,_n,_e);
  397. new(hp,init(_d,_n,_e));
  398. { the indexing should match what is done in writeasunit }
  399. sourcefiles.register_file(hp);
  400. {$endif UseBrowser}
  401. end;
  402. end;
  403. { main source is always the last }
  404. stringdispose(mainsource);
  405. mainsource:=stringdup(hs);
  406. { check the object and assembler file if not a library }
  407. if (flags and uf_in_library)=0 then
  408. begin
  409. if (flags and uf_smartlink)<>0 then
  410. begin
  411. objfiletime:=getnamedfiletime(arfilename^);
  412. if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
  413. do_compile:=true;
  414. end
  415. else
  416. begin
  417. { the objectfile should be newer than the ppu file }
  418. objfiletime:=getnamedfiletime(objfilename^);
  419. if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
  420. begin
  421. { check if assembler file is older than ppu file }
  422. asmfileTime:=GetNamedFileTime(asmfilename^);
  423. if (asmfiletime<0) or (ppufiletime>asmfiletime) then
  424. begin
  425. Message(unit_d_obj_and_asm_are_older_than_ppu);
  426. do_compile:=true;
  427. end
  428. else
  429. begin
  430. Message(unit_d_obj_is_older_than_asm);
  431. do_assemble:=true;
  432. end;
  433. end;
  434. end;
  435. end;
  436. openppu:=true;
  437. end;
  438. procedure tmodule.search_unit(const n : string);
  439. var
  440. ext : string[8];
  441. singlepathstring,
  442. Path,
  443. filename : string;
  444. found : boolean;
  445. start,i : longint;
  446. Function UnitExists(const ext:string):boolean;
  447. begin
  448. Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
  449. UnitExists:=FileExists(Singlepathstring+FileName+ext);
  450. end;
  451. begin
  452. start:=1;
  453. filename:=FixFileName(n);
  454. path:=UnitSearchPath;
  455. Found:=false;
  456. repeat
  457. { Create current path to check }
  458. i:=pos(';',path);
  459. if i=0 then
  460. i:=length(path)+1;
  461. singlepathstring:=FixPath(copy(path,start,i-start));
  462. delete(path,start,i-start+1);
  463. { Check for PPL file }
  464. if not (cs_link_static in aktswitches) then
  465. begin
  466. Found:=UnitExists(target_info.unitlibext);
  467. if Found then
  468. Begin
  469. SetFileName(SinglePathString,FileName);
  470. Found:=OpenPPU(singlepathstring);
  471. End;
  472. end;
  473. { Check for PPU file }
  474. if not (cs_link_dynamic in aktswitches) and not Found then
  475. begin
  476. Found:=UnitExists(target_info.unitext);
  477. if Found then
  478. Begin
  479. SetFileName(SinglePathString,FileName);
  480. Found:=OpenPPU(singlepathstring);
  481. End;
  482. end;
  483. { Check for Sources }
  484. if not Found then
  485. begin
  486. ppufile:=nil;
  487. do_compile:=true;
  488. {Check for .pp file}
  489. Found:=UnitExists(target_os.sourceext);
  490. if Found then
  491. Ext:=target_os.sourceext
  492. else
  493. begin
  494. {Check for .pas}
  495. Found:=UnitExists(target_os.pasext);
  496. if Found then
  497. Ext:=target_os.pasext;
  498. end;
  499. stringdispose(mainsource);
  500. if Found then
  501. begin
  502. sources_avail:=true;
  503. {Load Filenames when found}
  504. mainsource:=StringDup(SinglePathString+FileName+Ext);
  505. SetFileName(SinglePathString,FileName);
  506. end
  507. else
  508. sources_avail:=false;
  509. end;
  510. until Found or (path='');
  511. end;
  512. {$else NEWPPU}
  513. function tmodule.load_ppu(const unit_path,n,ext : string):boolean;
  514. var
  515. header : tunitheader;
  516. count : longint;
  517. temp,hs : string;
  518. b : byte;
  519. incfile_found : boolean;
  520. code : word;
  521. ppuversion,
  522. objfiletime,
  523. ppufiletime,
  524. asmfiletime,
  525. source_time : longint;
  526. {$ifdef UseBrowser}
  527. hp : pextfile;
  528. _d : dirstr;
  529. _n : namestr;
  530. _e : extstr;
  531. {$endif UseBrowser}
  532. begin
  533. load_ppu:=false;
  534. { Get ppufile time (also check if the file exists) }
  535. ppufiletime:=getnamedfiletime(ppufilename^);
  536. if ppufiletime=-1 then
  537. exit;
  538. Message1(unit_u_ppu_loading,ppufilename^);
  539. ppufile:=new(pextfile,init(unit_path,n,ext));
  540. ppufile^.reset;
  541. ppufile^.flush;
  542. { load the header }
  543. ppufile^.read_data(header,sizeof(header),count);
  544. if count<>sizeof(header) then
  545. begin
  546. ppufile^.done;
  547. Message(unit_d_ppu_file_too_short);
  548. exit;
  549. end;
  550. { check for a valid PPU file }
  551. if (header[0]<>'P') or (header[1]<>'P') or (header[2]<>'U') then
  552. begin
  553. ppufile^.done;
  554. Message(unit_d_ppu_invalid_header);
  555. exit;
  556. end;
  557. { load ppu version }
  558. val(header[3]+header[4]+header[5],ppuversion,code);
  559. if not(ppuversion in [13..14]) then
  560. begin
  561. ppufile^.done;
  562. Message1(unit_d_ppu_invalid_version,tostr(ppuversion));
  563. exit;
  564. end;
  565. flags:=byte(header[9]);
  566. crc:=plongint(@header[10])^;
  567. {Get ppufile time}
  568. ppufiletime:=getnamedfiletime(ppufilename^);
  569. {Show Debug info}
  570. Message1(unit_d_ppu_time,filetimestring(ppufiletime));
  571. Message1(unit_d_ppu_flags,tostr(flags));
  572. Message1(unit_d_ppu_crc,tostr(crc));
  573. { read name if its there }
  574. ppufile^.read_data(b,1,count);
  575. if b=ibunitname then
  576. begin
  577. ppufile^.read_data(hs[0],1,count);
  578. ppufile^.read_data(hs[1],ord(hs[0]),count);
  579. stringdispose(unitname);
  580. unitname:=stringdup(hs);
  581. ppufile^.read_data(b,1,count);
  582. end;
  583. { search source files there is at least one source file }
  584. do_compile:=false;
  585. sources_avail:=true;
  586. while b<>ibend do
  587. begin
  588. ppufile^.read_data(hs[0],1,count);
  589. ppufile^.read_data(hs[1],ord(hs[0]),count);
  590. ppufile^.read_data(b,1,count);
  591. if (flags and uf_in_library)<>0 then
  592. begin
  593. sources_avail:=false;
  594. temp:=' library';
  595. end
  596. else
  597. begin
  598. { check the date of the source files }
  599. Source_Time:=GetNamedFileTime(unit_path+hs);
  600. if Source_Time=-1 then
  601. begin
  602. { search for include files in the includepathlist }
  603. if b<>ibend then
  604. temp:=search(hs,includesearchpath,incfile_found);
  605. if incfile_found then
  606. begin
  607. hs:=temp+hs;
  608. Source_Time:=GetNamedFileTime(hs);
  609. end;
  610. end
  611. else
  612. hs:=unit_path+hs;
  613. if Source_Time=-1 then
  614. begin
  615. sources_avail:=false;
  616. temp:=' not found';
  617. end
  618. else
  619. begin
  620. temp:=' time '+filetimestring(source_time);
  621. if (source_time>ppufiletime) then
  622. begin
  623. do_compile:=true;
  624. temp:=temp+' *'
  625. end;
  626. end;
  627. end;
  628. Message1(unit_t_ppu_source,hs+temp);
  629. {$ifdef UseBrowser}
  630. fsplit(hs,_d,_n,_e);
  631. new(hp,init(_d,_n,_e));
  632. { the indexing should match what is done in writeasunit }
  633. sourcefiles.register_file(hp);
  634. {$endif UseBrowser}
  635. end;
  636. { main source is always the last }
  637. stringdispose(mainsource);
  638. mainsource:=stringdup(hs);
  639. { check the object and assembler file if not a library }
  640. if (flags and uf_smartlink)<>0 then
  641. begin
  642. objfiletime:=getnamedfiletime(arfilename^);
  643. if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
  644. do_compile:=true;
  645. end
  646. else
  647. begin
  648. if (flags and uf_in_library)=0 then
  649. begin
  650. { the objectfile should be newer than the ppu file }
  651. objfiletime:=getnamedfiletime(objfilename^);
  652. if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
  653. begin
  654. { check if assembler file is older than ppu file }
  655. asmfileTime:=GetNamedFileTime(asmfilename^);
  656. if (asmfiletime<0) or (ppufiletime>asmfiletime) then
  657. begin
  658. Message(unit_d_obj_and_asm_are_older_than_ppu);
  659. do_compile:=true;
  660. end
  661. else
  662. begin
  663. Message(unit_d_obj_is_older_than_asm);
  664. do_assemble:=true;
  665. end;
  666. end;
  667. end;
  668. end;
  669. load_ppu:=true;
  670. end;
  671. procedure tmodule.search_unit(const n : string);
  672. var
  673. ext : string[8];
  674. singlepathstring,
  675. Path,
  676. filename : string;
  677. found : boolean;
  678. start,i : longint;
  679. Function UnitExists(const ext:string):boolean;
  680. begin
  681. Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
  682. UnitExists:=FileExists(Singlepathstring+FileName+ext);
  683. end;
  684. begin
  685. start:=1;
  686. filename:=FixFileName(n);
  687. path:=UnitSearchPath;
  688. Found:=false;
  689. repeat
  690. {Create current path to check}
  691. i:=pos(';',path);
  692. if i=0 then
  693. i:=length(path)+1;
  694. singlepathstring:=FixPath(copy(path,start,i-start));
  695. delete(path,start,i-start+1);
  696. { Check for PPL file }
  697. if not (cs_link_static in aktswitches) then
  698. begin
  699. Found:=UnitExists(target_info.unitlibext);
  700. if Found then
  701. Begin
  702. SetFileName(SinglePathString,FileName);
  703. Found:=Load_PPU(singlepathstring,filename,target_info.unitlibext);
  704. End;
  705. end;
  706. { Check for PPU file }
  707. if not (cs_link_dynamic in aktswitches) and not Found then
  708. begin
  709. Found:=UnitExists(target_info.unitext);
  710. if Found then
  711. Begin
  712. SetFileName(SinglePathString,FileName);
  713. Found:=Load_PPU(singlepathstring,filename,target_info.unitext);
  714. End;
  715. end;
  716. { Check for Sources }
  717. if not Found then
  718. begin
  719. ppufile:=nil;
  720. do_compile:=true;
  721. {Check for .pp file}
  722. Found:=UnitExists(target_os.sourceext);
  723. if Found then
  724. Ext:=target_os.sourceext
  725. else
  726. begin
  727. {Check for .pas}
  728. Found:=UnitExists(target_os.pasext);
  729. if Found then
  730. Ext:=target_os.pasext;
  731. end;
  732. stringdispose(mainsource);
  733. if Found then
  734. begin
  735. sources_avail:=true;
  736. {Load Filenames when found}
  737. mainsource:=StringDup(SinglePathString+FileName+Ext);
  738. SetFileName(SinglePathString,FileName);
  739. end
  740. else
  741. sources_avail:=false;
  742. end;
  743. until Found or (path='');
  744. end;
  745. {$endif NEWPPU}
  746. constructor tmodule.init(const s:string;is_unit:boolean);
  747. var
  748. p : dirstr;
  749. n : namestr;
  750. e : extstr;
  751. begin
  752. FSplit(s,p,n,e);
  753. unitname:=stringdup(Upper(n));
  754. mainsource:=stringdup(s);
  755. objfilename:=nil;
  756. asmfilename:=nil;
  757. arfilename:=nil;
  758. ppufilename:=nil;
  759. setfilename(p,n);
  760. used_units.init;
  761. sourcefiles.init;
  762. linkofiles.init;
  763. linkstaticlibs.init;
  764. linksharedlibs.init;
  765. ppufile:=nil;
  766. current_inputfile:=nil;
  767. map:=nil;
  768. symtable:=nil;
  769. flags:=0;
  770. crc:=0;
  771. unitcount:=1;
  772. do_assemble:=false;
  773. do_compile:=false;
  774. sources_avail:=true;
  775. compiled:=false;
  776. in_implementation:=false;
  777. in_main:=false;
  778. uses_imports:=false;
  779. imports:=new(plinkedlist,init);
  780. output_format:=commandline_output_format;
  781. { set smartlink flag }
  782. if smartlink then
  783. flags:=flags or uf_smartlink;
  784. { search the PPU file if it is an unit }
  785. if is_unit then
  786. search_unit(unitname^);
  787. end;
  788. destructor tmodule.special_done;
  789. begin
  790. if assigned(map) then
  791. dispose(map);
  792. { cannot remove that because it is linked
  793. in the global chain of used_objects
  794. used_units.done; }
  795. sourcefiles.done;
  796. linkofiles.done;
  797. linkstaticlibs.done;
  798. linksharedlibs.done;
  799. if assigned(ppufile) then
  800. dispose(ppufile,done);
  801. if assigned(imports) then
  802. dispose(imports,done);
  803. inherited done;
  804. end;
  805. {****************************************************************************
  806. TUSED_UNIT
  807. ****************************************************************************}
  808. constructor tused_unit.init(_u : pmodule;f : byte);
  809. begin
  810. u:=_u;
  811. in_interface:=false;
  812. in_uses:=false;
  813. is_stab_written:=false;
  814. unitid:=f;
  815. end;
  816. destructor tused_unit.done;
  817. begin
  818. inherited done;
  819. end;
  820. end.
  821. {
  822. $Log$
  823. Revision 1.10 1998-05-11 13:07:53 peter
  824. + $ifdef NEWPPU for the new ppuformat
  825. + $define GDB not longer required
  826. * removed all warnings and stripped some log comments
  827. * no findfirst/findnext anymore to remove smartlink *.o files
  828. Revision 1.9 1998/05/06 15:04:20 pierre
  829. + when trying to find source files of a ppufile
  830. check the includepathlist for included files
  831. the main file must still be in the same directory
  832. Revision 1.8 1998/05/04 17:54:25 peter
  833. + smartlinking works (only case jumptable left todo)
  834. * redesign of systems.pas to support assemblers and linkers
  835. + Unitname is now also in the PPU-file, increased version to 14
  836. Revision 1.7 1998/05/01 16:38:44 florian
  837. * handling of private and protected fixed
  838. + change_keywords_to_tp implemented to remove
  839. keywords which aren't supported by tp
  840. * break and continue are now symbols of the system unit
  841. + widestring, longstring and ansistring type released
  842. Revision 1.6 1998/05/01 07:43:53 florian
  843. + basics for rtti implemented
  844. + switch $m (generate rtti for published sections)
  845. Revision 1.5 1998/04/30 15:59:40 pierre
  846. * GDB works again better :
  847. correct type info in one pass
  848. + UseTokenInfo for better source position
  849. * fixed one remaining bug in scanner for line counts
  850. * several little fixes
  851. Revision 1.4 1998/04/29 10:33:52 pierre
  852. + added some code for ansistring (not complete nor working yet)
  853. * corrected operator overloading
  854. * corrected nasm output
  855. + started inline procedures
  856. + added starstarn : use ** for exponentiation (^ gave problems)
  857. + started UseTokenInfo cond to get accurate positions
  858. Revision 1.3 1998/04/27 23:10:28 peter
  859. + new scanner
  860. * $makelib -> if smartlink
  861. * small filename fixes pmodule.setfilename
  862. * moved import from files.pas -> import.pas
  863. Revision 1.2 1998/04/21 10:16:47 peter
  864. * patches from strasbourg
  865. * objects is not used anymore in the fpc compiled version
  866. }