files.pas 35 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159
  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. {****************************************************************************
  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. inherited done;
  800. end;
  801. {****************************************************************************
  802. TUSED_UNIT
  803. ****************************************************************************}
  804. constructor tused_unit.init(_u : pmodule;intface:boolean);
  805. begin
  806. u:=_u;
  807. in_interface:=intface;
  808. in_uses:=false;
  809. is_stab_written:=false;
  810. loaded:=true;
  811. name:=stringdup(_u^.modulename^);
  812. checksum:=_u^.crc;
  813. unitid:=0;
  814. end;
  815. constructor tused_unit.init_to_load(const n:string;c:longint;intface:boolean);
  816. begin
  817. u:=nil;
  818. in_interface:=intface;
  819. in_uses:=false;
  820. is_stab_written:=false;
  821. loaded:=false;
  822. name:=stringdup(n);
  823. checksum:=c;
  824. unitid:=0;
  825. end;
  826. destructor tused_unit.done;
  827. begin
  828. stringdispose(name);
  829. inherited done;
  830. end;
  831. end.
  832. {
  833. $Log$
  834. Revision 1.50 1998-09-30 16:43:34 peter
  835. * fixed unit interdependency with circular uses
  836. Revision 1.49 1998/09/28 16:57:20 pierre
  837. * changed all length(p^.value_str^) into str_length(p)
  838. to get it work with and without ansistrings
  839. * changed sourcefiles field of tmodule to a pointer
  840. Revision 1.48 1998/09/24 23:46:34 peter
  841. + outputdir support
  842. Revision 1.47 1998/09/22 17:13:43 pierre
  843. + browsing updated and developed
  844. records and objects fields are also stored
  845. Revision 1.46 1998/09/21 08:45:10 pierre
  846. + added vmt_offset in tobjectdef.write for fututre use
  847. (first steps to have objects without vmt if no virtual !!)
  848. + added fpu_used field for tabstractprocdef :
  849. sets this level to 2 if the functions return with value in FPU
  850. (is then set to correct value at parsing of implementation)
  851. THIS MIGHT refuse some code with FPU expression too complex
  852. that were accepted before and even in some cases
  853. that don't overflow in fact
  854. ( like if f : float; is a forward that finally in implementation
  855. only uses one fpu register !!)
  856. Nevertheless I think that it will improve security on
  857. FPU operations !!
  858. * most other changes only for UseBrowser code
  859. (added symtable references for record and objects)
  860. local switch for refs to args and local of each function
  861. (static symtable still missing)
  862. UseBrowser still not stable and probably broken by
  863. the definition hash array !!
  864. Revision 1.45 1998/09/18 09:58:51 peter
  865. * -s doesn't require the .o to be available, this allows compiling of
  866. everything on other platforms (profiling the windows.pp loading ;)
  867. Revision 1.44 1998/09/10 13:51:32 peter
  868. * tp compiler also uses 'as' as asmprefix
  869. Revision 1.43 1998/09/03 17:08:45 pierre
  870. * better lines for stabs
  871. (no scroll back to if before else part
  872. no return to case line at jump outside case)
  873. + source lines also if not in order
  874. Revision 1.42 1998/09/03 11:24:00 peter
  875. * moved more inputfile things from tscannerfile to tinputfile
  876. * changed ifdef Sourceline to cs_asm_source
  877. Revision 1.41 1998/08/26 15:35:30 peter
  878. * fixed scannerfiles for macros
  879. + $I %<environment>%
  880. Revision 1.40 1998/08/26 10:08:48 peter
  881. * fixed problem with libprefix at the wrong place
  882. * fixed lib generation with smartlinking and no -CS used
  883. Revision 1.39 1998/08/25 16:44:16 pierre
  884. * openppu was true even if the object file is missing
  885. this lead to trying to open a filename without extension
  886. and prevented the 'make cycle' to work for win32
  887. Revision 1.38 1998/08/19 10:06:12 peter
  888. * fixed filenames and removedir which supports slash at the end
  889. Revision 1.37 1998/08/18 20:52:19 peter
  890. * renamed in_main to in_global which is more logical
  891. Revision 1.36 1998/08/17 10:10:07 peter
  892. - removed OLDPPU
  893. Revision 1.35 1998/08/17 09:17:44 peter
  894. * static/shared linking updates
  895. Revision 1.34 1998/08/14 21:56:31 peter
  896. * setting the outputfile using -o works now to create static libs
  897. Revision 1.33 1998/08/11 14:09:08 peter
  898. * fixed some messages and smaller msgtxt.inc
  899. Revision 1.32 1998/08/10 14:49:58 peter
  900. + localswitches, moduleswitches, globalswitches splitting
  901. Revision 1.31 1998/07/14 14:46:48 peter
  902. * released NEWINPUT
  903. Revision 1.30 1998/07/07 11:19:55 peter
  904. + NEWINPUT for a better inputfile and scanner object
  905. Revision 1.29 1998/06/25 10:51:00 pierre
  906. * removed a remaining ifndef NEWPPU
  907. replaced by ifdef OLDPPU
  908. * added uf_finalize to ppu unit
  909. Revision 1.28 1998/06/25 08:48:12 florian
  910. * first version of rtti support
  911. Revision 1.27 1998/06/24 14:48:34 peter
  912. * ifdef newppu -> ifndef oldppu
  913. Revision 1.26 1998/06/17 14:36:19 peter
  914. * forgot an $ifndef OLDPPU :(
  915. Revision 1.25 1998/06/17 14:10:11 peter
  916. * small os2 fixes
  917. * fixed interdependent units with newppu (remake3 under linux works now)
  918. Revision 1.24 1998/06/16 08:56:20 peter
  919. + targetcpu
  920. * cleaner pmodules for newppu
  921. Revision 1.23 1998/06/15 14:44:36 daniel
  922. * BP updates.
  923. Revision 1.22 1998/06/14 18:25:41 peter
  924. * small fix with crc in newppu
  925. Revision 1.21 1998/06/13 00:10:05 peter
  926. * working browser and newppu
  927. * some small fixes against crashes which occured in bp7 (but not in
  928. fpc?!)
  929. Revision 1.20 1998/06/12 14:50:48 peter
  930. * removed the tree dependency to types.pas
  931. * long_fil.pas support (not fully tested yet)
  932. Revision 1.19 1998/06/12 10:32:26 pierre
  933. * column problem hopefully solved
  934. + C vars declaration changed
  935. Revision 1.18 1998/06/11 13:58:07 peter
  936. * small fix to let newppu compile
  937. Revision 1.17 1998/06/09 16:01:40 pierre
  938. + added procedure directive parsing for procvars
  939. (accepted are popstack cdecl and pascal)
  940. + added C vars with the following syntax
  941. var C calias 'true_c_name';(can be followed by external)
  942. reason is that you must add the Cprefix
  943. which is target dependent
  944. Revision 1.16 1998/06/04 10:42:19 pierre
  945. * small bug fix in load_ppu or openppu
  946. Revision 1.15 1998/05/28 14:37:53 peter
  947. * default programname is PROGRAM (like TP7) to avoid dup id's
  948. Revision 1.14 1998/05/27 19:45:02 peter
  949. * symtable.pas splitted into includefiles
  950. * symtable adapted for $ifndef OLDPPU
  951. Revision 1.13 1998/05/23 01:21:05 peter
  952. + aktasmmode, aktoptprocessor, aktoutputformat
  953. + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
  954. + $LIBNAME to set the library name where the unit will be put in
  955. * splitted cgi386 a bit (codeseg to large for bp7)
  956. * nasm, tasm works again. nasm moved to ag386nsm.pas
  957. Revision 1.12 1998/05/20 09:42:33 pierre
  958. + UseTokenInfo now default
  959. * unit in interface uses and implementation uses gives error now
  960. * only one error for unknown symbol (uses lastsymknown boolean)
  961. the problem came from the label code !
  962. + first inlined procedures and function work
  963. (warning there might be allowed cases were the result is still wrong !!)
  964. * UseBrower updated gives a global list of all position of all used symbols
  965. with switch -gb
  966. Revision 1.11 1998/05/12 10:46:59 peter
  967. * moved printstatus to verb_def
  968. + V_Normal which is between V_Error and V_Warning and doesn't have a
  969. prefix like error: warning: and is included in V_Default
  970. * fixed some messages
  971. * first time parameter scan is only for -v and -T
  972. - removed old style messages
  973. Revision 1.10 1998/05/11 13:07:53 peter
  974. + $ifndef OLDPPU for the new ppuformat
  975. + $define GDB not longer required
  976. * removed all warnings and stripped some log comments
  977. * no findfirst/findnext anymore to remove smartlink *.o files
  978. Revision 1.9 1998/05/06 15:04:20 pierre
  979. + when trying to find source files of a ppufile
  980. check the includepathlist for included files
  981. the main file must still be in the same directory
  982. Revision 1.8 1998/05/04 17:54:25 peter
  983. + smartlinking works (only case jumptable left todo)
  984. * redesign of systems.pas to support assemblers and linkers
  985. + Unitname is now also in the PPU-file, increased version to 14
  986. Revision 1.7 1998/05/01 16:38:44 florian
  987. * handling of private and protected fixed
  988. + change_keywords_to_tp implemented to remove
  989. keywords which aren't supported by tp
  990. * break and continue are now symbols of the system unit
  991. + widestring, longstring and ansistring type released
  992. Revision 1.6 1998/05/01 07:43:53 florian
  993. + basics for rtti implemented
  994. + switch $m (generate rtti for published sections)
  995. Revision 1.5 1998/04/30 15:59:40 pierre
  996. * GDB works again better :
  997. correct type info in one pass
  998. + UseTokenInfo for better source position
  999. * fixed one remaining bug in scanner for line counts
  1000. * several little fixes
  1001. Revision 1.4 1998/04/29 10:33:52 pierre
  1002. + added some code for ansistring (not complete nor working yet)
  1003. * corrected operator overloading
  1004. * corrected nasm output
  1005. + started inline procedures
  1006. + added starstarn : use ** for exponentiation (^ gave problems)
  1007. + started UseTokenInfo cond to get accurate positions
  1008. Revision 1.3 1998/04/27 23:10:28 peter
  1009. + new scanner
  1010. * $makelib -> if smartlink
  1011. * small filename fixes pmodule.setfilename
  1012. * moved import from files.pas -> import.pas
  1013. Revision 1.2 1998/04/21 10:16:47 peter
  1014. * patches from strasbourg
  1015. * objects is not used anymore in the fpc compiled version
  1016. }