2
0

files.pas 39 KB

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