files.pas 38 KB

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