files.pas 34 KB

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