files.pas 35 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173
  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,ppu;
  23. const
  24. {$ifdef FPC}
  25. maxunits = 1024;
  26. InputFileBufSize=32*1024;
  27. linebufincrease=512;
  28. {$else}
  29. maxunits = 128;
  30. InputFileBufSize=1024;
  31. linebufincrease=64;
  32. {$endif}
  33. type
  34. {$ifdef FPC}
  35. tlongintarr = array[0..1000000] of longint;
  36. {$else}
  37. tlongintarr = array[0..16000] of longint;
  38. {$endif}
  39. plongintarr = ^tlongintarr;
  40. pinputfile = ^tinputfile;
  41. tinputfile = object
  42. path,name : pstring; { path and filename }
  43. next : pinputfile; { next file for reading }
  44. f : file; { current file handle }
  45. is_macro,
  46. endoffile, { still bytes left to read }
  47. closed : boolean; { is the file closed }
  48. buf : pchar; { buffer }
  49. bufstart, { buffer start position in the file }
  50. bufsize, { amount of bytes in the buffer }
  51. maxbufsize : longint; { size in memory for the buffer }
  52. saveinputpointer : pchar; { save fields for scanner variables }
  53. savelastlinepos,
  54. saveline_no : longint;
  55. linebuf : plongintarr; { line buffer to retrieve lines }
  56. maxlinebuf : longint;
  57. ref_count : longint; { to handle the browser refs }
  58. ref_index : longint;
  59. ref_next : pinputfile;
  60. constructor init(const fn:string);
  61. destructor done;
  62. procedure setpos(l:longint);
  63. procedure seekbuf(fpos:longint);
  64. procedure readbuf;
  65. function open:boolean;
  66. procedure close;
  67. procedure tempclose;
  68. function tempopen:boolean;
  69. procedure setmacro(p:pchar;len:longint);
  70. procedure setline(line,linepos:longint);
  71. function getlinestr(l:longint):string;
  72. end;
  73. pfilemanager = ^tfilemanager;
  74. tfilemanager = object
  75. files : pinputfile;
  76. last_ref_index : longint;
  77. constructor init;
  78. destructor done;
  79. procedure register_file(f : pinputfile);
  80. procedure inverse_register_indexes;
  81. function get_file(l:longint) : pinputfile;
  82. function get_file_name(l :longint):string;
  83. function get_file_path(l :longint):string;
  84. end;
  85. type
  86. tunitmap = array[0..maxunits-1] of pointer;
  87. punitmap = ^tunitmap;
  88. pmodule = ^tmodule;
  89. tmodule = object(tlinkedlist_item)
  90. ppufile : pppufile; { the PPU file }
  91. crc,
  92. flags : longint; { the PPU flags }
  93. compiled, { unit is already compiled }
  94. do_assemble, { only assemble the object, don't recompile }
  95. do_compile, { need to compile the sources }
  96. sources_avail, { if all sources are reachable }
  97. is_unit,
  98. in_second_compile, { is this unit being compiled for the 2nd time? }
  99. in_implementation, { processing the implementation part? }
  100. in_global : boolean; { allow global settings }
  101. map : punitmap; { mapping of all used units }
  102. unitcount : word; { local unit counter }
  103. unit_index : word; { global counter for browser }
  104. symtable : pointer; { pointer to the psymtable of this unit }
  105. {$ifdef UseBrowser}
  106. implsymtable : pointer;
  107. {$endif UseBrowser}
  108. scanner : pointer; { scanner object used }
  109. loaded_from : pmodule;
  110. uses_imports : boolean; { Set if the module imports from DLL's.}
  111. imports : plinkedlist;
  112. sourcefiles : pfilemanager;
  113. linksharedlibs,
  114. linkstaticlibs,
  115. linkofiles : tstringcontainer;
  116. used_units : tlinkedlist;
  117. path, { path where the module is find/created }
  118. modulename, { name of the module in uppercase }
  119. objfilename, { fullname of the objectfile }
  120. asmfilename, { fullname of the assemblerfile }
  121. ppufilename, { fullname of the ppufile }
  122. staticlibfilename, { fullname of the static libraryfile }
  123. sharedlibfilename, { fullname of the shared libraryfile }
  124. exefilename, { fullname of the exefile }
  125. asmprefix, { prefix for the smartlink asmfiles }
  126. mainsource : pstring; { name of the main sourcefile }
  127. constructor init(const s:string;_is_unit:boolean);
  128. destructor done;virtual;
  129. procedure reset;
  130. procedure setfilename(const fn:string;allowoutput:boolean);
  131. function openppu:boolean;
  132. function search_unit(const n : string):boolean;
  133. end;
  134. pused_unit = ^tused_unit;
  135. tused_unit = object(tlinkedlist_item)
  136. unitid : word;
  137. name : pstring;
  138. checksum : longint;
  139. loaded : boolean;
  140. in_uses,
  141. in_interface,
  142. is_stab_written : boolean;
  143. u : pmodule;
  144. constructor init(_u : pmodule;intface:boolean);
  145. constructor init_to_load(const n:string;c:longint;intface:boolean);
  146. destructor done;virtual;
  147. end;
  148. var
  149. main_module : pmodule; { Main module of the program }
  150. current_module : pmodule; { Current module which is compiled }
  151. current_ppu : pppufile; { Current ppufile which is read }
  152. global_unit_count : word;
  153. usedunits : tlinkedlist; { Used units for this program }
  154. loaded_units : tlinkedlist; { All loaded units }
  155. implementation
  156. uses
  157. dos,verbose,systems
  158. {$ifndef VER0_99_8}
  159. ,symtable
  160. {$endif}
  161. ;
  162. {****************************************************************************
  163. TINPUTFILE
  164. ****************************************************************************}
  165. constructor tinputfile.init(const fn:string);
  166. var
  167. p,n,e : string;
  168. begin
  169. FSplit(fn,p,n,e);
  170. name:=stringdup(n+e);
  171. path:=stringdup(p);
  172. next:=nil;
  173. { file info }
  174. is_macro:=false;
  175. endoffile:=false;
  176. closed:=true;
  177. buf:=nil;
  178. bufstart:=0;
  179. bufsize:=0;
  180. maxbufsize:=InputFileBufSize;
  181. { save fields }
  182. saveinputpointer:=nil;
  183. saveline_no:=0;
  184. savelastlinepos:=0;
  185. { indexing refs }
  186. ref_next:=nil;
  187. ref_count:=0;
  188. ref_index:=0;
  189. { line buffer }
  190. linebuf:=nil;
  191. maxlinebuf:=0;
  192. end;
  193. destructor tinputfile.done;
  194. begin
  195. stringdispose(path);
  196. stringdispose(name);
  197. { free memory }
  198. if assigned(linebuf) then
  199. freemem(linebuf,maxlinebuf shl 2);
  200. end;
  201. procedure tinputfile.setpos(l:longint);
  202. begin
  203. bufstart:=l;
  204. end;
  205. procedure tinputfile.seekbuf(fpos:longint);
  206. begin
  207. if closed then
  208. exit;
  209. seek(f,fpos);
  210. bufstart:=fpos;
  211. bufsize:=0;
  212. end;
  213. procedure tinputfile.readbuf;
  214. {$ifdef TP}
  215. var
  216. w : word;
  217. {$endif}
  218. begin
  219. if is_macro then
  220. endoffile:=true;
  221. if closed then
  222. exit;
  223. inc(bufstart,bufsize);
  224. {$ifdef TP}
  225. blockread(f,buf^,maxbufsize-1,w);
  226. bufsize:=w;
  227. {$else}
  228. blockread(f,buf^,maxbufsize-1,bufsize);
  229. {$endif}
  230. buf[bufsize]:=#0;
  231. endoffile:=not(bufsize=maxbufsize-1);
  232. end;
  233. function tinputfile.open:boolean;
  234. var
  235. ofm : byte;
  236. begin
  237. open:=false;
  238. if not closed then
  239. Close;
  240. ofm:=filemode;
  241. filemode:=0;
  242. Assign(f,path^+name^);
  243. {$I-}
  244. reset(f,1);
  245. {$I+}
  246. filemode:=ofm;
  247. if ioresult<>0 then
  248. exit;
  249. { file }
  250. endoffile:=false;
  251. closed:=false;
  252. Getmem(buf,MaxBufsize);
  253. bufstart:=0;
  254. bufsize:=0;
  255. open:=true;
  256. end;
  257. procedure tinputfile.close;
  258. var
  259. i : word;
  260. begin
  261. if is_macro then
  262. begin
  263. Freemem(buf,maxbufsize);
  264. is_macro:=false;
  265. closed:=true;
  266. exit;
  267. end;
  268. if not closed then
  269. begin
  270. {$I-}
  271. system.close(f);
  272. {$I+}
  273. i:=ioresult;
  274. Freemem(buf,maxbufsize);
  275. closed:=true;
  276. end;
  277. buf:=nil;
  278. bufstart:=0;
  279. end;
  280. procedure tinputfile.tempclose;
  281. var
  282. i : word;
  283. begin
  284. if is_macro then
  285. exit;
  286. if not closed then
  287. begin
  288. {$I-}
  289. system.close(f);
  290. {$I+}
  291. i:=ioresult;
  292. Freemem(buf,maxbufsize);
  293. buf:=nil;
  294. closed:=true;
  295. end;
  296. end;
  297. function tinputfile.tempopen:boolean;
  298. var
  299. ofm : byte;
  300. begin
  301. tempopen:=false;
  302. if is_macro then
  303. begin
  304. tempopen:=true;
  305. exit;
  306. end;
  307. if not closed then
  308. exit;
  309. ofm:=filemode;
  310. filemode:=0;
  311. Assign(f,path^+name^);
  312. {$I-}
  313. reset(f,1);
  314. {$I+}
  315. filemode:=ofm;
  316. if ioresult<>0 then
  317. exit;
  318. closed:=false;
  319. { get new mem }
  320. Getmem(buf,maxbufsize);
  321. { restore state }
  322. seek(f,BufStart);
  323. bufsize:=0;
  324. readbuf;
  325. tempopen:=true;
  326. end;
  327. procedure tinputfile.setmacro(p:pchar;len:longint);
  328. begin
  329. { create new buffer }
  330. getmem(buf,len+1);
  331. move(p^,buf^,len);
  332. buf[len]:=#0;
  333. { reset }
  334. bufstart:=0;
  335. bufsize:=len;
  336. maxbufsize:=len+1;
  337. is_macro:=true;
  338. endoffile:=true;
  339. closed:=true;
  340. end;
  341. procedure tinputfile.setline(line,linepos:longint);
  342. var
  343. oldlinebuf : plongintarr;
  344. begin
  345. if line<1 then
  346. exit;
  347. while (line>=maxlinebuf) do
  348. begin
  349. oldlinebuf:=linebuf;
  350. { create new linebuf and move old info }
  351. getmem(linebuf,(maxlinebuf+linebufincrease) shl 2);
  352. if assigned(oldlinebuf) then
  353. begin
  354. move(oldlinebuf^,linebuf^,maxlinebuf shl 2);
  355. freemem(oldlinebuf,maxlinebuf shl 2);
  356. end;
  357. fillchar(linebuf^[maxlinebuf],linebufincrease shl 2,0);
  358. inc(maxlinebuf,linebufincrease);
  359. end;
  360. linebuf^[line]:=linepos;
  361. end;
  362. function tinputfile.getlinestr(l:longint):string;
  363. var
  364. c : char;
  365. i,
  366. fpos : longint;
  367. p : pchar;
  368. begin
  369. getlinestr:='';
  370. if l<maxlinebuf then
  371. begin
  372. fpos:=linebuf^[l];
  373. { fpos is set negativ if the line was already written }
  374. { but we still know the correct value }
  375. if fpos<0 then
  376. fpos:=-fpos+1;
  377. if closed then
  378. open;
  379. { in current buf ? }
  380. if (fpos<bufstart) or (fpos>bufstart+bufsize) then
  381. begin
  382. seekbuf(fpos);
  383. readbuf;
  384. end;
  385. { the begin is in the buf now simply read until #13,#10 }
  386. i:=0;
  387. p:=@buf[fpos-bufstart];
  388. repeat
  389. c:=p^;
  390. if c=#0 then
  391. begin
  392. readbuf;
  393. p:=buf;
  394. c:=p^;
  395. end;
  396. if c in [#10,#13] then
  397. break;
  398. inc(i);
  399. getlinestr[i]:=c;
  400. inc(longint(p));
  401. until (i=255);
  402. getlinestr[0]:=chr(i);
  403. end;
  404. end;
  405. {****************************************************************************
  406. TFILEMANAGER
  407. ****************************************************************************}
  408. constructor tfilemanager.init;
  409. begin
  410. files:=nil;
  411. last_ref_index:=0;
  412. end;
  413. destructor tfilemanager.done;
  414. var
  415. hp : pinputfile;
  416. begin
  417. hp:=files;
  418. while assigned(hp) do
  419. begin
  420. files:=files^.ref_next;
  421. dispose(hp,done);
  422. hp:=files;
  423. end;
  424. last_ref_index:=0;
  425. end;
  426. procedure tfilemanager.register_file(f : pinputfile);
  427. begin
  428. inc(last_ref_index);
  429. f^.ref_next:=files;
  430. f^.ref_index:=last_ref_index;
  431. files:=f;
  432. end;
  433. { this procedure is necessary after loading the
  434. sources files from a PPU file PM }
  435. procedure tfilemanager.inverse_register_indexes;
  436. var
  437. f : pinputfile;
  438. begin
  439. f:=files;
  440. while assigned(f) do
  441. begin
  442. f^.ref_index:=last_ref_index-f^.ref_index+1;
  443. f:=f^.ref_next;
  444. end;
  445. end;
  446. function tfilemanager.get_file(l :longint) : pinputfile;
  447. var
  448. ff : pinputfile;
  449. begin
  450. ff:=files;
  451. while assigned(ff) and (ff^.ref_index<>l) do
  452. ff:=ff^.ref_next;
  453. get_file:=ff;
  454. end;
  455. function tfilemanager.get_file_name(l :longint):string;
  456. var
  457. hp : pinputfile;
  458. begin
  459. hp:=get_file(l);
  460. if assigned(hp) then
  461. get_file_name:=hp^.name^
  462. else
  463. get_file_name:='';
  464. end;
  465. function tfilemanager.get_file_path(l :longint):string;
  466. var
  467. hp : pinputfile;
  468. begin
  469. hp:=get_file(l);
  470. if assigned(hp) then
  471. get_file_path:=hp^.path^
  472. else
  473. get_file_path:='';
  474. end;
  475. {****************************************************************************
  476. TMODULE
  477. ****************************************************************************}
  478. procedure tmodule.setfilename(const fn:string;allowoutput:boolean);
  479. var
  480. p : dirstr;
  481. n : NameStr;
  482. e : ExtStr;
  483. begin
  484. stringdispose(objfilename);
  485. stringdispose(asmfilename);
  486. stringdispose(ppufilename);
  487. stringdispose(staticlibfilename);
  488. stringdispose(sharedlibfilename);
  489. stringdispose(exefilename);
  490. stringdispose(path);
  491. { Create names }
  492. fsplit(fn,p,n,e);
  493. n:=FixFileName(n);
  494. { set path }
  495. path:=stringdup(FixPath(p));
  496. { obj,asm,ppu names }
  497. p:=path^;
  498. if AllowOutput then
  499. begin
  500. if (OutputUnitDir<>'') then
  501. p:=OutputUnitDir
  502. else
  503. if (OutputExeDir<>'') then
  504. p:=OutputExeDir;
  505. end;
  506. objfilename:=stringdup(p+n+target_info.objext);
  507. asmfilename:=stringdup(p+n+target_info.asmext);
  508. ppufilename:=stringdup(p+n+target_info.unitext);
  509. { lib and exe could be loaded with a file specified with -o }
  510. if AllowOutput and (OutputFile<>'') then
  511. n:=OutputFile;
  512. staticlibfilename:=stringdup(p+target_os.libprefix+n+target_os.staticlibext);
  513. sharedlibfilename:=stringdup(p+target_os.libprefix+n+target_os.sharedlibext);
  514. { output dir of exe can be specified separatly }
  515. if AllowOutput and (OutputExeDir<>'') then
  516. p:=OutputExeDir
  517. else
  518. p:=path^;
  519. exefilename:=stringdup(p+n+target_os.exeext);
  520. end;
  521. function tmodule.openppu:boolean;
  522. var
  523. objfiletime,
  524. ppufiletime,
  525. asmfiletime : longint;
  526. begin
  527. openppu:=false;
  528. { Get ppufile time (also check if the file exists) }
  529. ppufiletime:=getnamedfiletime(ppufilename^);
  530. if ppufiletime=-1 then
  531. exit;
  532. { Open the ppufile }
  533. Message1(unit_u_ppu_loading,ppufilename^);
  534. ppufile:=new(pppufile,init(ppufilename^));
  535. if not ppufile^.open then
  536. begin
  537. dispose(ppufile,done);
  538. Message(unit_d_ppu_file_too_short);
  539. exit;
  540. end;
  541. { check for a valid PPU file }
  542. if not ppufile^.CheckPPUId then
  543. begin
  544. dispose(ppufile,done);
  545. Message(unit_d_ppu_invalid_header);
  546. exit;
  547. end;
  548. { check for allowed PPU versions }
  549. if not (ppufile^.GetPPUVersion in [15]) then
  550. begin
  551. dispose(ppufile,done);
  552. Message1(unit_d_ppu_invalid_version,tostr(ppufile^.GetPPUVersion));
  553. exit;
  554. end;
  555. { check the target processor }
  556. if ttargetcpu(ppufile^.header.cpu)<>target_cpu then
  557. begin
  558. dispose(ppufile,done);
  559. Comment(V_Debug,'unit is compiled for an other processor');
  560. exit;
  561. end;
  562. { check target }
  563. if ttarget(ppufile^.header.target)<>target_info.target then
  564. begin
  565. dispose(ppufile,done);
  566. Comment(V_Debug,'unit is compiled for an other target');
  567. exit;
  568. end;
  569. {!!!!!!!!!!!!!!!!!!! }
  570. { Load values to be access easier }
  571. flags:=ppufile^.header.flags;
  572. crc:=ppufile^.header.checksum;
  573. { Show Debug info }
  574. Message1(unit_d_ppu_time,filetimestring(ppufiletime));
  575. Message1(unit_d_ppu_flags,tostr(flags));
  576. Message1(unit_d_ppu_crc,tostr(ppufile^.header.checksum));
  577. { check the object and assembler file to see if we need only to
  578. assemble, only if it's not in a library }
  579. do_compile:=false;
  580. if (flags and uf_in_library)=0 then
  581. begin
  582. if ((flags and uf_static_linked)<>0) or
  583. ((flags and uf_smartlink)<>0) then
  584. begin
  585. objfiletime:=getnamedfiletime(staticlibfilename^);
  586. if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
  587. do_compile:=true;
  588. end
  589. else
  590. if (flags and uf_shared_linked)<>0 then
  591. begin
  592. objfiletime:=getnamedfiletime(sharedlibfilename^);
  593. if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
  594. do_compile:=true;
  595. end
  596. else
  597. begin
  598. { the objectfile should be newer than the ppu file }
  599. objfiletime:=getnamedfiletime(objfilename^);
  600. if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
  601. begin
  602. { check if assembler file is older than ppu file }
  603. asmfileTime:=GetNamedFileTime(asmfilename^);
  604. if (asmfiletime<0) or (ppufiletime>asmfiletime) then
  605. begin
  606. Message(unit_d_obj_and_asm_are_older_than_ppu);
  607. do_compile:=true;
  608. { we should try to get the source file }
  609. exit;
  610. end
  611. else
  612. begin
  613. Message(unit_d_obj_is_older_than_asm);
  614. if not(cs_asm_extern in aktglobalswitches) then
  615. exit;
  616. end;
  617. end;
  618. end;
  619. end;
  620. openppu:=true;
  621. end;
  622. function tmodule.search_unit(const n : string):boolean;
  623. var
  624. ext : string[8];
  625. singlepathstring,
  626. unitPath,
  627. filename : string;
  628. found : boolean;
  629. start,i : longint;
  630. Function UnitExists(const ext:string):boolean;
  631. begin
  632. Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
  633. UnitExists:=FileExists(Singlepathstring+FileName+ext);
  634. end;
  635. begin
  636. start:=1;
  637. filename:=FixFileName(n);
  638. unitpath:=UnitSearchPath;
  639. Found:=false;
  640. repeat
  641. { Create current path to check }
  642. i:=pos(';',unitpath);
  643. if i=0 then
  644. i:=length(unitpath)+1;
  645. singlepathstring:=FixPath(copy(unitpath,start,i-start));
  646. delete(unitpath,start,i-start+1);
  647. { Check for PPL file }
  648. if not Found then
  649. begin
  650. Found:=UnitExists(target_info.unitlibext);
  651. if Found then
  652. Begin
  653. SetFileName(SinglePathString+FileName,false);
  654. Found:=OpenPPU;
  655. End;
  656. end;
  657. { Check for PPU file }
  658. if not Found then
  659. begin
  660. Found:=UnitExists(target_info.unitext);
  661. if Found then
  662. Begin
  663. SetFileName(SinglePathString+FileName,false);
  664. Found:=OpenPPU;
  665. End;
  666. end;
  667. { Check for Sources }
  668. if not Found then
  669. begin
  670. ppufile:=nil;
  671. do_compile:=true;
  672. {Check for .pp file}
  673. Found:=UnitExists(target_os.sourceext);
  674. if Found then
  675. Ext:=target_os.sourceext
  676. else
  677. begin
  678. {Check for .pas}
  679. Found:=UnitExists(target_os.pasext);
  680. if Found then
  681. Ext:=target_os.pasext;
  682. end;
  683. stringdispose(mainsource);
  684. if Found then
  685. begin
  686. sources_avail:=true;
  687. {Load Filenames when found}
  688. mainsource:=StringDup(SinglePathString+FileName+Ext);
  689. SetFileName(SinglePathString+FileName,false);
  690. end
  691. else
  692. sources_avail:=false;
  693. end;
  694. until Found or (unitpath='');
  695. search_unit:=Found;
  696. end;
  697. procedure tmodule.reset;
  698. begin
  699. sourcefiles^.done;
  700. sourcefiles^.init;
  701. used_units.done;
  702. used_units.init;
  703. linkofiles.done;
  704. linkofiles.init;
  705. linkstaticlibs.done;
  706. linkstaticlibs.init;
  707. linksharedlibs.done;
  708. linksharedlibs.init;
  709. end;
  710. constructor tmodule.init(const s:string;_is_unit:boolean);
  711. var
  712. p : dirstr;
  713. n : namestr;
  714. e : extstr;
  715. begin
  716. FSplit(s,p,n,e);
  717. { Programs have the name program to don't conflict with dup id's }
  718. if _is_unit then
  719. modulename:=stringdup(Upper(n))
  720. else
  721. modulename:=stringdup('PROGRAM');
  722. mainsource:=stringdup(s);
  723. ppufilename:=nil;
  724. objfilename:=nil;
  725. asmfilename:=nil;
  726. staticlibfilename:=nil;
  727. sharedlibfilename:=nil;
  728. exefilename:=nil;
  729. { Dos has the famous 8.3 limit :( }
  730. {$ifdef tp}
  731. asmprefix:=stringdup(FixFileName('as'));
  732. {$else}
  733. {$ifdef go32v2}
  734. asmprefix:=stringdup(FixFileName('as'));
  735. {$else}
  736. asmprefix:=stringdup(FixFileName(n));
  737. {$endif}
  738. {$endif tp}
  739. path:=nil;
  740. setfilename(p+n,true);
  741. used_units.init;
  742. new(sourcefiles,init);
  743. linkofiles.init;
  744. linkstaticlibs.init;
  745. linksharedlibs.init;
  746. ppufile:=nil;
  747. scanner:=nil;
  748. map:=nil;
  749. symtable:=nil;
  750. {$ifdef UseBrowser}
  751. implsymtable:=nil;
  752. {$endif UseBrowser}
  753. loaded_from:=nil;
  754. flags:=0;
  755. crc:=0;
  756. unitcount:=1;
  757. inc(global_unit_count);
  758. unit_index:=global_unit_count;
  759. do_assemble:=false;
  760. do_compile:=false;
  761. sources_avail:=true;
  762. compiled:=false;
  763. in_second_compile:=false;
  764. in_implementation:=false;
  765. in_global:=true;
  766. is_unit:=_is_unit;
  767. uses_imports:=false;
  768. imports:=new(plinkedlist,init);
  769. { set smartlink flag }
  770. if (cs_smartlink in aktmoduleswitches) then
  771. flags:=flags or uf_smartlink;
  772. { search the PPU file if it is an unit }
  773. if is_unit then
  774. begin
  775. if (not search_unit(modulename^)) and (length(modulename^)>8) then
  776. search_unit(copy(modulename^,1,8));
  777. end;
  778. end;
  779. destructor tmodule.done;
  780. begin
  781. if assigned(map) then
  782. dispose(map);
  783. if assigned(ppufile) then
  784. dispose(ppufile,done);
  785. if assigned(imports) then
  786. dispose(imports,done);
  787. used_units.done;
  788. if assigned(sourcefiles) then
  789. dispose(sourcefiles,done);
  790. linkofiles.done;
  791. linkstaticlibs.done;
  792. linksharedlibs.done;
  793. stringdispose(objfilename);
  794. stringdispose(asmfilename);
  795. stringdispose(ppufilename);
  796. stringdispose(staticlibfilename);
  797. stringdispose(sharedlibfilename);
  798. stringdispose(exefilename);
  799. stringdispose(path);
  800. stringdispose(modulename);
  801. stringdispose(mainsource);
  802. stringdispose(asmprefix);
  803. {$ifndef VER0_99_8}
  804. if assigned(symtable) then
  805. dispose(punitsymtable(symtable),done);
  806. {$endif}
  807. inherited done;
  808. end;
  809. {****************************************************************************
  810. TUSED_UNIT
  811. ****************************************************************************}
  812. constructor tused_unit.init(_u : pmodule;intface:boolean);
  813. begin
  814. u:=_u;
  815. in_interface:=intface;
  816. in_uses:=false;
  817. is_stab_written:=false;
  818. loaded:=true;
  819. name:=stringdup(_u^.modulename^);
  820. checksum:=_u^.crc;
  821. unitid:=0;
  822. end;
  823. constructor tused_unit.init_to_load(const n:string;c:longint;intface:boolean);
  824. begin
  825. u:=nil;
  826. in_interface:=intface;
  827. in_uses:=false;
  828. is_stab_written:=false;
  829. loaded:=false;
  830. name:=stringdup(n);
  831. checksum:=c;
  832. unitid:=0;
  833. end;
  834. destructor tused_unit.done;
  835. begin
  836. stringdispose(name);
  837. inherited done;
  838. end;
  839. end.
  840. {
  841. $Log$
  842. Revision 1.52 1998-10-06 22:09:48 peter
  843. * fixed for compiling with 0.99.8 due circular units
  844. Revision 1.51 1998/10/06 17:16:47 pierre
  845. * some memory leaks fixed (thanks to Peter for heaptrc !)
  846. Revision 1.50 1998/09/30 16:43:34 peter
  847. * fixed unit interdependency with circular uses
  848. Revision 1.49 1998/09/28 16:57:20 pierre
  849. * changed all length(p^.value_str^) into str_length(p)
  850. to get it work with and without ansistrings
  851. * changed sourcefiles field of tmodule to a pointer
  852. Revision 1.48 1998/09/24 23:46:34 peter
  853. + outputdir support
  854. Revision 1.47 1998/09/22 17:13:43 pierre
  855. + browsing updated and developed
  856. records and objects fields are also stored
  857. Revision 1.46 1998/09/21 08:45:10 pierre
  858. + added vmt_offset in tobjectdef.write for fututre use
  859. (first steps to have objects without vmt if no virtual !!)
  860. + added fpu_used field for tabstractprocdef :
  861. sets this level to 2 if the functions return with value in FPU
  862. (is then set to correct value at parsing of implementation)
  863. THIS MIGHT refuse some code with FPU expression too complex
  864. that were accepted before and even in some cases
  865. that don't overflow in fact
  866. ( like if f : float; is a forward that finally in implementation
  867. only uses one fpu register !!)
  868. Nevertheless I think that it will improve security on
  869. FPU operations !!
  870. * most other changes only for UseBrowser code
  871. (added symtable references for record and objects)
  872. local switch for refs to args and local of each function
  873. (static symtable still missing)
  874. UseBrowser still not stable and probably broken by
  875. the definition hash array !!
  876. Revision 1.45 1998/09/18 09:58:51 peter
  877. * -s doesn't require the .o to be available, this allows compiling of
  878. everything on other platforms (profiling the windows.pp loading ;)
  879. Revision 1.44 1998/09/10 13:51:32 peter
  880. * tp compiler also uses 'as' as asmprefix
  881. Revision 1.43 1998/09/03 17:08:45 pierre
  882. * better lines for stabs
  883. (no scroll back to if before else part
  884. no return to case line at jump outside case)
  885. + source lines also if not in order
  886. Revision 1.42 1998/09/03 11:24:00 peter
  887. * moved more inputfile things from tscannerfile to tinputfile
  888. * changed ifdef Sourceline to cs_asm_source
  889. Revision 1.41 1998/08/26 15:35:30 peter
  890. * fixed scannerfiles for macros
  891. + $I %<environment>%
  892. Revision 1.40 1998/08/26 10:08:48 peter
  893. * fixed problem with libprefix at the wrong place
  894. * fixed lib generation with smartlinking and no -CS used
  895. Revision 1.39 1998/08/25 16:44:16 pierre
  896. * openppu was true even if the object file is missing
  897. this lead to trying to open a filename without extension
  898. and prevented the 'make cycle' to work for win32
  899. Revision 1.38 1998/08/19 10:06:12 peter
  900. * fixed filenames and removedir which supports slash at the end
  901. Revision 1.37 1998/08/18 20:52:19 peter
  902. * renamed in_main to in_global which is more logical
  903. Revision 1.36 1998/08/17 10:10:07 peter
  904. - removed OLDPPU
  905. Revision 1.35 1998/08/17 09:17:44 peter
  906. * static/shared linking updates
  907. Revision 1.34 1998/08/14 21:56:31 peter
  908. * setting the outputfile using -o works now to create static libs
  909. Revision 1.33 1998/08/11 14:09:08 peter
  910. * fixed some messages and smaller msgtxt.inc
  911. Revision 1.32 1998/08/10 14:49:58 peter
  912. + localswitches, moduleswitches, globalswitches splitting
  913. Revision 1.31 1998/07/14 14:46:48 peter
  914. * released NEWINPUT
  915. Revision 1.30 1998/07/07 11:19:55 peter
  916. + NEWINPUT for a better inputfile and scanner object
  917. Revision 1.29 1998/06/25 10:51:00 pierre
  918. * removed a remaining ifndef NEWPPU
  919. replaced by ifdef OLDPPU
  920. * added uf_finalize to ppu unit
  921. Revision 1.28 1998/06/25 08:48:12 florian
  922. * first version of rtti support
  923. Revision 1.27 1998/06/24 14:48:34 peter
  924. * ifdef newppu -> ifndef oldppu
  925. Revision 1.26 1998/06/17 14:36:19 peter
  926. * forgot an $ifndef OLDPPU :(
  927. Revision 1.25 1998/06/17 14:10:11 peter
  928. * small os2 fixes
  929. * fixed interdependent units with newppu (remake3 under linux works now)
  930. Revision 1.24 1998/06/16 08:56:20 peter
  931. + targetcpu
  932. * cleaner pmodules for newppu
  933. Revision 1.23 1998/06/15 14:44:36 daniel
  934. * BP updates.
  935. Revision 1.22 1998/06/14 18:25:41 peter
  936. * small fix with crc in newppu
  937. Revision 1.21 1998/06/13 00:10:05 peter
  938. * working browser and newppu
  939. * some small fixes against crashes which occured in bp7 (but not in
  940. fpc?!)
  941. Revision 1.20 1998/06/12 14:50:48 peter
  942. * removed the tree dependency to types.pas
  943. * long_fil.pas support (not fully tested yet)
  944. Revision 1.19 1998/06/12 10:32:26 pierre
  945. * column problem hopefully solved
  946. + C vars declaration changed
  947. Revision 1.18 1998/06/11 13:58:07 peter
  948. * small fix to let newppu compile
  949. Revision 1.17 1998/06/09 16:01:40 pierre
  950. + added procedure directive parsing for procvars
  951. (accepted are popstack cdecl and pascal)
  952. + added C vars with the following syntax
  953. var C calias 'true_c_name';(can be followed by external)
  954. reason is that you must add the Cprefix
  955. which is target dependent
  956. Revision 1.16 1998/06/04 10:42:19 pierre
  957. * small bug fix in load_ppu or openppu
  958. Revision 1.15 1998/05/28 14:37:53 peter
  959. * default programname is PROGRAM (like TP7) to avoid dup id's
  960. Revision 1.14 1998/05/27 19:45:02 peter
  961. * symtable.pas splitted into includefiles
  962. * symtable adapted for $ifndef OLDPPU
  963. Revision 1.13 1998/05/23 01:21:05 peter
  964. + aktasmmode, aktoptprocessor, aktoutputformat
  965. + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
  966. + $LIBNAME to set the library name where the unit will be put in
  967. * splitted cgi386 a bit (codeseg to large for bp7)
  968. * nasm, tasm works again. nasm moved to ag386nsm.pas
  969. Revision 1.12 1998/05/20 09:42:33 pierre
  970. + UseTokenInfo now default
  971. * unit in interface uses and implementation uses gives error now
  972. * only one error for unknown symbol (uses lastsymknown boolean)
  973. the problem came from the label code !
  974. + first inlined procedures and function work
  975. (warning there might be allowed cases were the result is still wrong !!)
  976. * UseBrower updated gives a global list of all position of all used symbols
  977. with switch -gb
  978. Revision 1.11 1998/05/12 10:46:59 peter
  979. * moved printstatus to verb_def
  980. + V_Normal which is between V_Error and V_Warning and doesn't have a
  981. prefix like error: warning: and is included in V_Default
  982. * fixed some messages
  983. * first time parameter scan is only for -v and -T
  984. - removed old style messages
  985. Revision 1.10 1998/05/11 13:07:53 peter
  986. + $ifndef OLDPPU for the new ppuformat
  987. + $define GDB not longer required
  988. * removed all warnings and stripped some log comments
  989. * no findfirst/findnext anymore to remove smartlink *.o files
  990. Revision 1.9 1998/05/06 15:04:20 pierre
  991. + when trying to find source files of a ppufile
  992. check the includepathlist for included files
  993. the main file must still be in the same directory
  994. Revision 1.8 1998/05/04 17:54:25 peter
  995. + smartlinking works (only case jumptable left todo)
  996. * redesign of systems.pas to support assemblers and linkers
  997. + Unitname is now also in the PPU-file, increased version to 14
  998. Revision 1.7 1998/05/01 16:38:44 florian
  999. * handling of private and protected fixed
  1000. + change_keywords_to_tp implemented to remove
  1001. keywords which aren't supported by tp
  1002. * break and continue are now symbols of the system unit
  1003. + widestring, longstring and ansistring type released
  1004. Revision 1.6 1998/05/01 07:43:53 florian
  1005. + basics for rtti implemented
  1006. + switch $m (generate rtti for published sections)
  1007. Revision 1.5 1998/04/30 15:59:40 pierre
  1008. * GDB works again better :
  1009. correct type info in one pass
  1010. + UseTokenInfo for better source position
  1011. * fixed one remaining bug in scanner for line counts
  1012. * several little fixes
  1013. Revision 1.4 1998/04/29 10:33:52 pierre
  1014. + added some code for ansistring (not complete nor working yet)
  1015. * corrected operator overloading
  1016. * corrected nasm output
  1017. + started inline procedures
  1018. + added starstarn : use ** for exponentiation (^ gave problems)
  1019. + started UseTokenInfo cond to get accurate positions
  1020. Revision 1.3 1998/04/27 23:10:28 peter
  1021. + new scanner
  1022. * $makelib -> if smartlink
  1023. * small filename fixes pmodule.setfilename
  1024. * moved import from files.pas -> import.pas
  1025. Revision 1.2 1998/04/21 10:16:47 peter
  1026. * patches from strasbourg
  1027. * objects is not used anymore in the fpc compiled version
  1028. }