2
0

files.pas 33 KB

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