files.pas 31 KB

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