files.pas 40 KB

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