files.pas 35 KB

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