files.pas 38 KB

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