paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 13:28:05 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
+ 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 -
This commit is contained in:
svenbarth 2016-02-19 17:13:58 +00:00
parent 0226195272
commit 1945bf64b4
3 changed files with 208 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

100
compiler/cstreams.pas
View File

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

80
compiler/entfile.pas
View File

@ -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;

40
compiler/fppu.pas
View File

@ -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;