[Back to MEMORY SWAG index] [Back to Main SWAG index] [Original]
{
*************** Generalized file I/O buffering *****************
The enclosed TP unit BUFFERS exports a new object BUFFERFILE. This
object allows to define a variable number of buffers with a buffersize
of up to $FFE0 bytes each. It exports a number of methods to tailor
the behaviour of the buffer to a specific applications needs - See the
following procedures for details in this area:
- SETWRITEBIAS
- SETREADBIAS
- RESETBIAS
- ENABLEINBOUND
- ENABLEOUTBOUND
- DISABLEINBOUND
- DISABLEOUTBOUND
The buffers may be allocated in expanded memory if desired. Performance
will be somewhat affected by this fact.
All methods use the same names as their counterparts in the system unit,
the there should not be any problem implementing them. The only minor
difference is the fact, that the READ and WRITE procedures do not accept
the optional fourth parameter, which in the system unit will return the
number of bytes actually read or written. This was done for performance
reasons but should be very easy to change.
The unit is implemented using some of Turbo Pascals object oriented
language constructs (actually my second step in this area). Some of the
object oriented stuff is not really very pure code - some access to the
imported data areas is direct, etc. This was done as to achieve some decent
performance.
Last but not least a small example on how to use the code:
Program Test;
VAR
BF : BufferFile;
L : LongInt;
begin
BF.Init(16384,5,True);
BF.SetWriteBias; {Purely optional - may improve performance}
BF.Assign('TEST.FIL');
BF.Rewrite(4);
For L:=1 to 20000 do BF.Write(L,1);
BF.Done;
end.
The code is herbey given to the public domain. If you discover any errors,
I would appreciate if you would let me know.
Rolf Ernst 72311,254
}
Unit Buffers;
InterFace
{*********************************************************************}
{**** Written 1989 by Rolf Ernst ****}
{**** ****}
{**** Code requires Turbo Professional for the expanded memory ****}
{**** access. The procedures used should not take more than a ****}
{**** few lines to reproduce though. ****}
{**** ****}
{**** This code is hereby in the public domain. ****}
{*********************************************************************}
Uses Dos, TpEms;
Type
PtrRec = Record
Ofs, Seg : Word;
end;
BigBlock = Array[0..1] Of Byte;
BigBlockPtr = ^BigBlock;
BufferPtr = ^BufferDesc;
BufferDesc = object
BufferAddr : BigBlockPtr;
EmsHandle : Word;
InEms : Boolean;
Size : Word;
Next : Pointer;
Constructor Init(BufferSize : Word; UseEms : Boolean);
Function Map(Offset, Length : Word) : BigBlockPtr; Virtual;
Destructor Done;
end;
FileBufferPtr = ^FileBufferDesc;
FileBufferDesc = Object(BufferDesc)
PosBuffer : LongInt;
BytesUsed : Word;
Initialized : Boolean;
Modified : Boolean;
Constructor Init(BufferSize : Word; UseEms : Boolean);
end;
BufferChain = object
NumberOfBuffers, BlockSize:Word;
BufferHead, BufferTail : FileBufferPtr;
Procedure Init(BufSize, BufNum : Word; UseEms : Boolean);
Procedure ChainAtEnd(VAR B : FileBufferPtr);
Function BuffersUnUsed:Word;
Procedure Done;
end;
BufferFile=Object
F : File;
FSize : LongInt;
CurrentPos : LongInt;
RecordSize : Word;
BlockSize : Word;
BufferS : BufferChain;
FlushAll : Boolean;
ReadAll : Boolean;
NoBufferReads : Boolean;
NoBufferWrites : Boolean;
NoBufferIng : Boolean;
Procedure Init(BufSize, BufNum:Word; UseEms : Boolean);
{Initialize BufNum buffers for the file, each being
Bufsize bytes big - use Expanded memory if UseEms is TRUE}
Procedure Flush;
{Write all modified buffers to disk - does not cause DOS to
flush its buffers}
Function FreeBuffer : FileBufferPtr;
{Find an available Buffer - Flush a buffer if necessary}
Procedure Read(VAR A; NumRecs : Word);
{Read a record buffered}
Procedure DisableOutBound;
{Disable buffering when writing to a file}
Procedure Write(VAR A; NumRecs : Word);
{Write a record buffered}
Function Eof:Boolean;
{Return true if the current position in the file is at its end}
Procedure Seek(NewPos : LongInt);
{Go to a new position in the file}
Function FileSize:LongInt;
{Returns the size of a buffered file taking any data in the
buffers into consideration}
Procedure Assign(Name : PathStr);
{Assign a name to a buffered file}
Function FilePos:LongInt;
{Returns the current position in a buffered file}
Procedure Rewrite(RecSize : Word);
{Create a new file or overwrite an existing one}
Procedure Reset(RecSize:Word);
{Open an existing file}
Procedure SetWriteBias;
{Indicate, that the majority of the file operations will be
sequential writes - when a buffer needs to be flushed ALL
buffers will be flushed}
Procedure SetReadBias;
{Indicate, that the majority of the file operations will be
sequential reads - when a buffer needs to be read ALL buffers
will be read from disk}
Procedure ResetBias;
{Reset file access characteristics to its default values}
Procedure DisableInBound;
{Disable buffering when reading from a dataset}
Procedure EnableInBound;
{Enable buffering when reading from a dataset}
Procedure EnableOutBound;
{Enable buffering when writing to a dataset}
Procedure Done;
{Close the file and free all buffers}
end;
Implementation
Procedure EmsError;
begin
Writeln('Severe Error in EMS handler');
readln;
halt;
end;
Function MemToEms(BytesIn : LongInt) : Word;
begin
MemToEms:=(BytesIn+16383) shr 14;
end;
Procedure MapBuffer(Handle : Word; BytesInBuffer:Word);
VAR
I : Word;
begin
For I:=0 to Pred(MemToEms(BytesInBuffer)) do begin
If Not MapEmsPage(Handle,i,i) then EmsError;
end;
end;
Procedure BufferFile.SetWriteBias;
begin
FlushAll:=True;
ReadAll:=False;
end;
Procedure BufferFile.DisableInBound;
begin
NoBufferReads:=True;
end;
Procedure BufferFile.EnableInBound;
begin
NoBufferReads:=false;
end;
Procedure BufferFile.DisableOutBound;
begin
Flush;
NoBufferWrites:=True;
end;
Procedure BufferFile.EnableOutBound;
begin
NoBufferWrites:=False;
end;
Procedure BufferFile.ResetBias;
begin
FlushAll:=False;
ReadAll:=False;
NoBufferReads:=False;
NoBufferWrites:=False;
end;
Procedure BufferFile.SetReadBias;
begin
FlushAll:=False;
ReadAll:=True;
end;
Constructor BufferDesc.Init(BufferSize : Word; UseEms : Boolean);
begin
InEms:=UseEms and EmsInstalled and
(EmsPagesAvail>=MemToEms(Buffersize));
Size:=BufferSize;
If InEms then begin
EmsHandle:=AllocateEMSPages(MemToEms(Size));
If EmsHandle=EmsErrorCode then EmsError;
BufferAddr:=EmsPageFramePtr;
end else GetMem(BufferAddr,Size);
Next:=Nil;
end;
Function BufferDesc.Map(Offset, Length : Word) : BigBlockPtr;
VAR
HighOffset : Word;
MyPointer : BigBlockPTr;
begin
MyPointer:=BufferAddr;
Inc(PtrRec(MyPointer).Ofs,Offset);
Map:=MyPointer;
If InEms then begin
HighOffset:=Pred(Offset+Length);
Offset:=Offset Shr 14;
HighOffset:=HighOffset shr 14;
repeat
If Not MapEmsPage(EMSHandle,Offset,Offset) then EmsError;
INC(Offset);
until Offset>HighOffset;
end;
end;
Destructor BufferDesc.Done;
begin
IF InEms then begin
If Not DeallocateEmsHandle(Emshandle) then EmsError;
end else FreeMem(BufferAddr,Size);
end;
Constructor FileBufferDesc.Init(BufferSize : Word; UseEms : Boolean);
begin
BufferDesc.Init(BufferSize, UseEms);
Initialized:=False;
Modified:=False;
end;
Procedure BufferChain.Init(BufSize, BufNum : Word; UseEms : Boolean);
VAR
I : Word;
begin
NumberOfBuffers:=BufNum;
BufferTail:=Nil;
For i:=1 to BufNum do begin
New(BufferHead,Init(BufSize,UseEms));
BufferHead^.Next:=BufferTail;
BufferTail:=BufferHead;
end;
While BufferTail^.Next<>Nil do BufferTail:=BufferTail^.Next;
end;
Procedure BufferChain.ChainAtEnd(VAR B : FileBufferPtr);
VAR
BufPtr:FileBufferPtr;
begin
If (NumberOfBuffers>1) and (B<>BufferTail) then begin
BufferTail^.Next:=B;
BufferTail:=B;
If B=BufferHead then begin
BufferHead:=B^.Next;
B^.Next:=Nil;
end else begin
Bufptr:=BufferHead;
While BufPtr^.Next<>B do Bufptr:=BufPtr^.Next;
BufPtr^.Next:=B^.Next;
B^.Next:=Nil;
end;
end;
end;
Procedure BufferFile.Init(BufSize, BufNum:Word; UseEms : Boolean);
VAR
I : Word;
begin
If (BufSize=0) or (BufNum=0) then begin
NoBufferIng:=True;
exit;
end;
UseEms:=UseEms and EmsInstalled and
(EmsPagesAvail>=BufNum * MemToEms(Bufsize));
Buffers.Init(BufSize, BufNum, USeEms);
FlushAll:=False;
ReadAll:=False;
NoBufferReads:=False;
NoBufferWrites:=False;
NoBuffering:=False;
BlockSize:=BufSize;
end;
Function BufferFile.FreeBuffer:FileBufferPtr;
VAR
BufPtr,SavePtr : FileBufferPtr;
LowPos : LongInt;
MyPointer : Pointer;
begin
BufPtr:=Buffers.BufferHead;
LowPos:=$7fffffff;
While BufPtr<>Nil do begin
With BufPtr^ do begin
If (Not Modified) or (Not initialized) then begin
FreeBuffer:=BufPtr;
Modified:=False;
FreeBuffer:=BufPtr;
Buffers.ChainAtEnd(BufPtr);
Exit;
end;
If PosBuffer<LowPos then begin
LowPos:=PosBuffer;
SavePtr:=BufPtr;
end;
BufPtr:=Next;
end;
end;
If FlushAll then begin
Flush;
FreeBuffer:=Buffers.BufferHead;
end;
With SavePtr^ do begin
System.Seek(F,PosBuffer);
MyPointer:=Map(0,BytesUsed);
BlockWrite(F,MyPointer^,BytesUsed);
BytesUsed:=0;
Modified:=False;
end;
FreeBuffer:=SavePtr;
Buffers.ChainAtEnd(SavePtr);
end;
Procedure BufferFile.Flush;
VAR
BufPtr : FileBufferPtr;
MyPointer : Pointer;
begin
If NoBuffering then exit;
BufPtr:=Buffers.BufferHead;
While BufPtr<>Nil do begin
With BufPTr^ do begin
If Modified then begin
System.Seek(F,PosBuffer);
MyPointer:=Map(0,BytesUsed);
BlockWrite(F,BufferAddr^,BytesUsed);
Modified:=False;
end;
BufPtr:=Next;
end;
end;
end;
Function BufferCHain.BuffersUnUsed:Word;
VAR
BufPtr : FileBufferPtr;
Count : Word;
begin
Count:=0;
BufPtr:=BufferHead;
While BufPtr<>Nil do begin
With BufPtr^ do begin
If (Not Initialized) or (Not Modified) then Inc(Count);
BufPtr:=Next;
end;
end;
BuffersUnUsed:=Count;
end;
Function BufferFile.FileSize:LongInt;
begin
If NoBuffering then FileSize:=System.FIleSize(F) else
FileSize:=Fsize div RecordSize;
end;
Function BufferFile.FilePos:LongInt;
begin
If NoBuffering then FilePos:=System.FilePos(F) else
FilePos:=CurrentPos div RecordSize;
end;
Procedure BufferFile.Read(VAR A; NumRecs : Word);
VAR
I,J : Word;
BufPtr : FileBufferPtr;
TargetPtr : BigBlockPtr;
More : Boolean;
BaseBufferToGet : LongInt;
MyPointer : Pointer;
begin
If NoBuffering then BlockRead(F,A,NuMRecs) else begin
NumRecs:=NumRecs*RecordSize;
TargetPtr:=@A;
Repeat
BaseBufferToGet:=CurrentPos-(CurrentPos Mod BlockSize);
BufPtr:=Buffers.BufferHead;
More:=True;
While (BufPtr<>Nil) and More Do begin
With BufPtr^ do begin
If (PosBuffer=BaseBufferToGet) and Initialized then more:=False else
BufPtr:=Next;
end;
end;
If BufPtr=Nil then begin
If NoBufferReads then begin
System.Seek(F,CurrentPos);
BlockRead(F,TargetPtr^,NumRecs);
Inc(CurrentPos,NumRecs);
exit;
end;
BufPtr:=FreeBuffer;
With BufPtr^ do begin
System.Seek(F,BaseBufferToGet);
PosBuffer:=BaseBufferToGet;
MyPointer:=Map(0,BlockSize);
BlockRead(F,MyPointer^,BlockSize,BytesUsed);
Initialized:=True;
end;
If ReadAll then begin
J:=Buffers.BuffersUnUsed;
If J>0 then Dec(j);
I:=1;
While (I<= J) and (BufPtr^.BytesUsed=BlockSize) do begin
Inc(BaseBufferToGet,BlockSize);
BufPtr:=FreeBuffer;
With BufPtr^ do begin
PosBuffer:=BaseBufferToGet;
MyPointer:=Map(0,BlockSize);
BlockRead(F,MyPointer^,BlockSize,BytesUsed);
Initialized:=True;
end;
Inc(I);
end;
end;
end else begin
With BufPtr^ do begin
J:=CurrentPos-PosBuffer;
I:=BytesUsed-j;
If I>NumRecs then I:=NumRecs;
MyPointer:=Map(J,I);
Move(MyPointer^,TargetPtr^,I);
Inc(CurrentPos,I);
Dec(NumRecs,I);
Inc(PtrRec(TargetPtr).Ofs,I);
end;
end;
until NumRecs=0;
end;
end;
Procedure BufferFile.Write(VAR A; NumRecs : Word);
VAR
I,J : WOrd;
BufPtr : FileBufferPtr;
TargetPTr,MyPointer : Pointer;
BaseBufferToGet : LongInt;
BytesNeeded : LongInt;
OK,More : Boolean;
begin
If NoBuffering then BlockWrite(F,A,NumRecs) else begin
TargetPtr:=@A;
NumRecs:=NumRecs*RecordSize;
Repeat
BaseBufferToGet:=CUrrentPos-(CurrentPos Mod BlockSize);
BufPtr:=Buffers.BufferHead;
More:=True;
While (BufPtr<>Nil) and More Do begin
With BufPtr^ do begin
If (Initialized) and (BaseBufferToGet=PosBuffer) then begin
BytesNeeded:=CurrentPos-PosBuffer+NumRecs;
If BytesNeeded>BytesUsed then begin
If BytesNeeded>BlockSize then BytesUsed:=BlockSize else
BytesUsed:=BytesNeeded;
Fsize:=BaseBufferToGet+BytesUsed;
end;
More:=False;
end else BufPtr:=Next;
end;
end;
If BufPtr=Nil then begin
If NoBufferWrites then begin
If BaseBufferToGet<>CurrentPos then begin
System.Seek(F,CurrentPos);
BlockWrite(F,A,NumRecs);
Inc(CurrentPos,NumRecs);
exit;
end;
end;
BufPtr:=FreeBuffer;
With BufPtr^ do begin
System.Seek(F,BaseBufferToGet);
PosBuffer:=BaseBufferToGet;
If PosBuffer<SyStem.FileSize(F) then begin
MyPointer:=Map(0,BlockSize);
BlockRead(F,MyPointer^,BlockSize,BytesUsed);
end else BytesUsed:=0;
Initialized:=True;
end;
end else begin
With BufPtr^ do begin
J:=CurrentPos-PosBuffer;
I:=BytesUsed-j;
If I>NumRecs then I:=NumRecs;
MyPointer:=Map(J,I);
Move(TargetPtr^,MyPointer^,I);
Modified:=True;
Inc(CurrentPos,I);
Dec(NumRecs,I);
Inc(PtrRec(TargetPtr).Ofs,I);
end;
end;
until NumRecs=0;
end;
end;
Function BufferFile.Eof:Boolean;
begin
If NoBuffering then Eof:=System.Eof(F) else
Eof:=CurrentPos=Fsize;
end;
Procedure BufferFile.Seek(NewPos : LongInt);
begin
If NoBuffering then System.Seek(F,Newpos) else
CurrentPos:=NewPos*RecordSize;
end;
Procedure BufferFile.Assign(Name : PathStr);
begin
System.Assign(F,Name);
end;
Procedure BufferFile.Rewrite(RecSize:Word);
begin
RecordSize:=RecSize;
If Not NoBuffering then Recsize:=1;
System.Rewrite(F,RecSize);
Fsize:=0;
CurrentPos:=0;
end;
Procedure BufferFile.Reset(RecSize : Word);
begin
RecordSize:=RecSize;
If Not NoBuffering then RecSize:=1;
System.Reset(F,RecSize);
Fsize:=System.FileSize(F);
CurrentPos:=0;
end;
Procedure BufferChain.Done;
begin
repeat
with BufferHead^ do begin
BufferTail:=BufferHead^.Next;
Dispose(BufferHead,Done);
BufferHead:=BufferTail;
end;
until Bufferhead=Nil;
end;
Procedure BufferFile.Done;
VAR
BufferTail : BufferPtr;
Ok : Boolean;
begin
Flush;
Close(F);
If Not NoBuffering then Buffers.Done;
end;
end.
[Back to MEMORY SWAG index] [Back to Main SWAG index] [Original]