files.pas 36 KB

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