files.pas 34 KB

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