diff --git a/compiler/cstreams.pas b/compiler/cstreams.pas index 072da10f23..7feecfad8a 100644 --- a/compiler/cstreams.pas +++ b/compiler/cstreams.pas @@ -132,6 +132,20 @@ var CFileStreamClass: TCFileStreamClass = TCFileStream; type + TCRangeStream = class(TCStream) + private + FBase: TCStream; + FOffset: LongInt; + FMaxOffset: LongInt; + FSize: LongInt; + FPosition: LongInt; + public + constructor Create(ABase: TCStream; AOffset, ASize: LongInt); + function Read(var Buffer; Count: LongInt): LongInt; override; + function Write(const Buffer; Count: LongInt): LongInt; override; + function Seek(Offset: LongInt; Origin: Word): LongInt; override; + end; + { TCustomMemoryStream abstract class } TCCustomMemoryStream = class(TCStream) @@ -467,6 +481,92 @@ begin end; +{****************************************************************************} +{* TCRangeStream *} +{****************************************************************************} + + +constructor TCRangeStream.Create(ABase: TCStream; AOffset, ASize: LongInt); +begin + if not assigned(ABase) then + CStreamError:=155 + else + { we allow to be positioned directly at the end for appending } + if (AOffset<0) or (AOffset>ABase.Size) then + CStreamError:=156 + else + begin + FBase:=ABase; + FOffset:=AOffset; + if ASize<0 then + FSize:=maxLongint-FOffset + else + FSize:=ASize; + FMaxOffset:=FOffset+FSize-1; + end; +end; + + +function TCRangeStream.Read(var Buffer; Count: LongInt): LongInt; +begin + Count:=Min(Count,FMaxOffset-FPosition+1); + if Count>0 then + begin + FBase.Seek(FOffset+FPosition,soFromBeginning); + result:=FBase.Read(Buffer,Count); + end + else + result:=0; + FPosition:=FPosition+result; +end; + + +function TCRangeStream.Write(const Buffer; Count: LongInt): LongInt; +begin + Count:=Min(Count,FMaxOffset-FPosition+1); + if Count>0 then + begin + FBase.Seek(FOffset+FPosition,soFromBeginning); + result:=FBase.Write(Buffer,Count); + end + else + result:=0; + FPosition:=FPosition+result; +end; + + +function TCRangeStream.Seek(Offset: LongInt; Origin: Word): LongInt; +begin + case Origin of + soFromBeginning: + begin + if Offset>FMaxOffset then + CStreamError:=156 + else + FPosition:=FBase.Seek(FOffset+Offset,soFromBeginning)-FOffset; + end; + soFromCurrent: + begin + if Offset>FMaxOffset then + CStreamError:=156 + else + FPosition:=FBase.Seek(FOffset+FPosition+Offset,soFromBeginning)-FOffset; + end; + soFromEnd: + begin + if Offset>FSize-1 then + CStreamError:=156 + else + FPosition:=FBase.Seek(FMaxOffset-Offset,soFromBeginning)-FOffset; + end; + else + begin + CStreamError:=156; + end; + end; + Result:=FPosition; +end; + {****************************************************************************} {* TCustomMemoryStream *} {****************************************************************************} diff --git a/compiler/entfile.pas b/compiler/entfile.pas index 88e2a37fb1..82b5a9a0a9 100644 --- a/compiler/entfile.pas +++ b/compiler/entfile.pas @@ -192,6 +192,9 @@ type end; tentryfile=class + private + function getposition:longint; + procedure setposition(value:longint); protected buf : pchar; bufstart, @@ -205,8 +208,9 @@ type tempclosed : boolean; closepos : integer; protected - f : TCCustomFileStream; + f : TCStream; mode : byte; {0 - Closed, 1 - Reading, 2 - Writing} + fisfile : boolean; fname : string; fsize : integer; procedure newheader;virtual;abstract; @@ -229,8 +233,14 @@ type procedure flush; procedure closefile;virtual; procedure newentry; + property position:longint read getposition write setposition; + { Warning: don't keep the stream open during a tempclose! } + function substream(ofs,len:longint):TCStream; + { Warning: don't use the put* or write* functions anymore when writing through this } + property stream:TCStream read f; {read} function openfile:boolean; + function openstream(strm:TCStream):boolean; procedure reloadbuf; procedure readdata(out b;len:integer); procedure skipdata(len:integer); @@ -258,6 +268,7 @@ type function skipuntilentry(untilb:byte):boolean; {write} function createfile:boolean;virtual; + function createstream(strm:TCStream):boolean; procedure writeheader;virtual;abstract; procedure writebuf; procedure writedata(const b;len:integer); @@ -310,6 +321,7 @@ end; constructor tentryfile.create(const fn:string); begin fname:=fn; + fisfile:=false; change_endian:=false; mode:=0; newheader; @@ -353,13 +365,44 @@ begin if mode<>0 then begin flush; - f.Free; + if fisfile then + f.Free; mode:=0; closed:=true; end; end; +procedure tentryfile.setposition(value:longint); +begin + if assigned(f) then + f.Position:=value + else + if tempclosed then + closepos:=value; +end; + + +function tentryfile.getposition:longint; +begin + if assigned(f) then + result:=f.Position + else + if tempclosed then + result:=closepos + else + result:=0; +end; + + +function tentryfile.substream(ofs,len:longint):TCStream; +begin + result:=nil; + if assigned(f) then + result:=TCRangeStream.Create(f,ofs,len); +end; + + {***************************************************************************** tentryfile Reading *****************************************************************************} @@ -367,13 +410,25 @@ end; function tentryfile.openfile:boolean; var i : integer; + strm : TCStream; begin openfile:=false; try - f:=CFileStreamClass.Create(fname,fmOpenRead) + strm:=CFileStreamClass.Create(fname,fmOpenRead) except exit; end; + openfile:=openstream(strm); + fisfile:=result; +end; + + +function tentryfile.openstream(strm:TCStream):boolean; +var + i : longint; +begin + openstream:=false; + f:=strm; closed:=false; {read ppuheader} fsize:=f.Size; @@ -390,7 +445,7 @@ begin entrystart:=0; entrybufstart:=0; error:=false; - openfile:=true; + openstream:=true; end; @@ -890,8 +945,10 @@ end; function tentryfile.createfile:boolean; var ok: boolean; + strm : TCStream; begin createfile:=false; + strm:=nil; if outputallowed then begin {$ifdef MACOS} @@ -901,7 +958,7 @@ begin {$endif} ok:=false; try - f:=CFileStreamClass.Create(fname,fmCreate); + strm:=CFileStreamClass.Create(fname,fmCreate); ok:=true; except end; @@ -911,6 +968,17 @@ begin {$endif} if not ok then exit; + end; + createfile:=createstream(strm); + fisfile:=result; +end; + +function tentryfile.createstream(strm:TCStream):boolean; +begin + createstream:=false; + if outputallowed then + begin + f:=strm; mode:=2; {write header for sure} f.Write(getheaderaddr^,getheadersize); @@ -925,7 +993,7 @@ begin entrytyp:=mainentryid; {start} newentry; - createfile:=true; + createstream:=true; end; diff --git a/compiler/fppu.pas b/compiler/fppu.pas index eb10289df0..eab2aa8c85 100644 --- a/compiler/fppu.pas +++ b/compiler/fppu.pas @@ -38,7 +38,7 @@ interface uses cmsgs,verbose, - cutils,cclasses, + cutils,cclasses,cstreams, globtype,globals,finput,fmodule, symbase,ppu,symtype; @@ -59,7 +59,8 @@ interface constructor create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean); destructor destroy;override; procedure reset;override; - function openppu:boolean; + function openppufile:boolean; + function openppustream(strm:TCStream):boolean; procedure getppucrc; procedure writeppu; procedure loadppu; @@ -75,6 +76,7 @@ interface avoid endless resolving loops in case of cyclic dependencies. } defsgeneration : longint; + function openppu(ppufiletime:longint):boolean; function search_unit_files(onlysource:boolean):boolean; function search_unit(onlysource,shortname:boolean):boolean; procedure load_interface; @@ -181,11 +183,11 @@ var until false; end; - function tppumodule.openppu:boolean; + function tppumodule.openppufile:boolean; var ppufiletime : longint; begin - openppu:=false; + openppufile:=false; Message1(unit_t_ppu_loading,ppufilename,@queuecomment); { Get ppufile time (also check if the file exists) } ppufiletime:=getnamedfiletime(ppufilename); @@ -201,6 +203,29 @@ var Message(unit_u_ppu_file_too_short); exit; end; + result:=openppu(ppufiletime); + end; + + + function tppumodule.openppustream(strm:TCStream):boolean; + begin + { Open the ppufile } + Message1(unit_u_ppu_name,ppufilename); + ppufile:=tcompilerppufile.create(ppufilename); + if not ppufile.openstream(strm) then + begin + ppufile.free; + ppufile:=nil; + Message(unit_u_ppu_file_too_short); + exit; + end; + result:=openppu(-1); + end; + + + function tppumodule.openppu(ppufiletime:longint):boolean; + begin + openppu:=false; { check for a valid PPU file } if not ppufile.CheckPPUId then begin @@ -287,7 +312,10 @@ var interface_crc:=ppufile.header.interface_checksum; indirect_crc:=ppufile.header.indirect_checksum; { Show Debug info } - Message1(unit_u_ppu_time,filetimestring(ppufiletime)); + if ppufiletime<>-1 then + Message1(unit_u_ppu_time,filetimestring(ppufiletime)) + else + Message1(unit_u_ppu_time,'unknown'); Message1(unit_u_ppu_flags,tostr(flags)); Message1(unit_u_ppu_crc,hexstr(ppufile.header.checksum,8)); Message1(unit_u_ppu_crc,hexstr(ppufile.header.interface_checksum,8)+' (intfc)'); @@ -338,7 +366,7 @@ var if Found then Begin SetFileName(hs,false); - Found:=OpenPPU; + Found:=openppufile; End; PPUSearchPath:=Found; end;