Merged revision(s) 32302-32305, 32310 from branches/svenbarth/packages:

+ new stream class TCRangeStream that represents a substream of another stream while being also extendable
........
Extend tentryfile so that it can be opened from a stream in addition to a file

entfile.pas, tentryfile:
  + new method openstream() to open a readable tentryfile based on a stream
  + new method createstream() to open a writeable tentryfile based on a stream
  * adjust openfile() to use openstream()
  * adjust createfile() to use createstream()
........
A few extensions for tentryfile needed for package files

entfile.pas, tentryfile:
  + new property position to retrieve/control the position of the underlying stream (works also with tempclose()/tempopen())
  + new method substream() to retrieve a stream that goes from the specified offset with the specified length (-1 create a stream that is extendable, aka for writing)
  + new property stream to get the underlying stream directly; be careful when using this!
........
Extend tppumodule so that it can be opened from a stream as well.

fppu.pas, tppumodule:
  * rename openppu() to openppufile()
  + new method openppustream() to open a module based on a stream
  + put the common part of openppufile() and openppustream() into a new method openppu()
........
Fix compilation.

fppu.pas, tppumodule:
  * openppu: add parameter ppufiletime for printing the time of the file (only if filetime is not -1)
  * openppufile: pass the retrieve time of the PPU to openppu()
  * openppustream: pass -1 to openppu()
........

git-svn-id: trunk@33109 -

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                          *}
 {****************************************************************************}

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;
 
 

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;