files.pas 37 KB

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