[Back to FILES SWAG index] [Back to Main SWAG index] [Original]
(*************************************************************************
=====================================================
Breaking the 64K barrier for BlockRead and BlockWrite
=====================================================
Copyright (c) 1992,1994 by Jos‚ Campione
Ottawa-Orleans Personal Systems Group
Fidonet: 1:163/513.3
Turbo Pascal implements two procedures for fast transfer of data from
files to memory blocks and viceversa: Blockread and Blockwrite. One of
the commonly encountered limitation in these procedures is the fact that
they can only handle blocks not exceeding 65535 bytes.
This limitation bears a connection with the often asked question on how
to brake the 64K barrier for arrays declared in Pascal. Several answers
have been proposed to this effect. Perhaps one of the most elegant is
the one proposed by Neil Rubenking in his book on Turbo Pascal 6.0
Techniques and Utilities (Ziff-Davis Press, 1991). Albeit elegant,
Neil's approach uses OOP which may not be fully appreciated by many
Pascal users.
So, here is a less ambitious approach with several procedures and
functions permitting the direct handling of large memory blocks. In the
following unit large memory blocks are defined as arrays of blocks each
not exceeding 64K. The only limitation for the size of the overall large
block is that it must not exceed the normal RAM. A longint pointer is
then used to access individual positions.
This unit uses a modified heapfunc that permits the replacement of "new"
with "getmem". This, together with range checking off, allows an array
to be declared as a single byte. During runtime it can be assigned any
size determined by the program. This ensures that the "tail" of the big
block will never be larger than strictly necessary.
Functions BigBlockRead and BigBlockWrite permit the reading and writing
of blocks from and to a file much in the same way as Pascal's BlockRead
and BlockWrite. Only difference is that the 64K limit is not a problem
anymore. Note that the size of the blocks can only be defined in terms
of bytes and that the file being read or write must have been previously
assigned to variable f (an untyped file declared within the unit). Also,
these are not procedures but functions returning false if the reading or
the writing of the big block was not completed.
In the present implementation only one array of big blocks is permitted.
Variable BigBlkExist ensures that MakeBig will only work if a previous
big block has not been created. BigBlk is the array of blocks reserved
in the heap. SizBlk is an array containing the sizes in bytes of each
block reserved in the heap as part of the big block. NumVec contains the
number of blocks used by the big block.
And last, some acknowledgements:
Part of this unit was inspired by code contained in a file posted at
garbo.uwasa.fi by Prof. Timo Salmi. The code itself was based on a
submission by Naji Moawad. Prof. Salmi's code contained the following
message:
The code below is based on a UseNet posting in comp.lang.pascal by
Naji Mouawad nmouawad@watmath.waterloo.edu. Naji's idea was for a
vector, my adaptation is for a two-dimensional matrix. The realization
of the idea is simpler than the one presented by Kent Porter in
Dr.Dobb's Journal, March 1988.
***************************************************************************)
{$R-} { R has to be off... }
{$M 8096,0,655360}
unit bigarru;
interface
uses crt,dos;
const
SizVec = $FFFF;
MaxBlk = $FF;
type
Vec = array [0..0] of byte;
var
BigBlk : array[0..MaxBlk] of ^Vec;
SizBlk : array[0..MaxBlk] of word;
TotSizBlk : longint;
NumVec : byte;
HeapTop : pointer;
BigBlkExist : boolean;
{$F+} function HeapFunc(Size: word) : integer; {$F-}
function MakeBig(HeapNeeded: longint): boolean;
function Peek(p: longint; var error: boolean): byte;
procedure Poke(b : byte; p: longint; var error: boolean);
procedure FillRange(fromby, toby :longint; b : byte);
procedure FillAll(b: byte);
function BigBlockRead (var f: file): boolean;
function BigBlockWrite(var f: file): boolean;
implementation
{$F+} function HeapFunc(Size: word) : integer; {$F-}
begin
HeapFunc:= 1;
end;
{ Create the dynamic variables }
{ HeapNeeded is the needed number of BYTES }
function MakeBig(HeapNeeded: longint): boolean;
var
i : integer;
error : boolean;
begin
error:= false;
if BigBlkExist then begin
Makebig:= false;
exit;
end;
fillchar(sizblk,sizeof(sizblk),0);
NumVec:= (HeapNeeded div SizVec);
if (HeapNeeded < SizVec) then begin
SizBlk[NumVec]:= HeapNeeded;
BigBlk[NumVec]:= nil;
GetMem(BigBlk[NumVec], SizBlk[NumVec]);
if BigBlk[NumVec] = nil then error:= true;
end else begin
i:= -1;
while not error and (i < NumVec - 1) do begin
inc(i,1);
SizBlk[i]:= SizVec;
BigBlk[i]:= nil;
GetMem(BigBlk[i],SizBlk[i]);
if BigBlk[i] = nil then error:= true;
end;
if not error then begin
SizBlk[NumVec]:= HeapNeeded - ((i + 1) * SizVec);
BigBlk[NumVec]:= nil;
GetMem(BigBlk[NumVec], SizBlk[NumVec]);
if BigBlk[NumVec] = nil then error:= true;
end;
end;
if not error then begin
TotSizBlk:= HeapNeeded;
BigBlkExist:= true;
MakeBig:= true;
end else begin
MakeBig:= false;
release(heaptop);
end;
end; { makebig }
function Peek(p: longint; var error: boolean): byte;
var
VecNum: byte;
BytNum: word;
begin
if BigBlkExist and not (p > totsizblk) then begin
error:= false;
VecNum:= p div SizVec;
BytNum:= p - (VecNum * SizVec);
peek:= BigBlk[VecNum]^[BytNum];
end else begin
error:= true;
peek:= 0;
end;
end;
procedure Poke(b: byte; p: longint; var error: boolean);
var
VecNum: byte;
BytNum: word;
begin
if BigBlkExist and not (p > totsizblk) then begin
error:= false;
VecNum:= p div SizVec;
BytNum:= p - (VecNum * SizVec);
BigBlk[VecNum]^[BytNum]:= b;
end else error:= true;
end;
procedure FillRange(fromby, toby :longint; b : byte);
var
p: longint;
VecNum: byte;
BytNum: word;
begin
If BigBlkExist then begin
for p:= fromby to toby do begin
VecNum:= p div SizVec;
BytNum:= p - (VecNum * SizVec);
BigBlk[VecNum]^[BytNum]:= b;
end;
end;
end;
procedure FillAll(b: byte);
var
i : byte;
begin
if BigBlkExist then
for i:= 0 to NumVec do
fillchar(BigBlk[i]^,SizBlk[i],b);
end;
function BigBlockRead (var f: file): boolean;
var
i : integer;
error : boolean;
begin
error:= false;
BigBlockRead:= true;
{$I-} reset(f,1); {$I+}
if (ioresult = 0) and bigblkexist then begin
i:= -1;
while not error and (i < NumVec) do begin
inc(i,1);
{$I-} BlockRead(f,BigBlk[i]^,SizBlk[i]); {$I+}
if ioresult <> 0 then error:= true;
end;
if not error then {$I-}close(f){$I+} else BigBlockRead:= false;
end else BigBlockRead:= false;
end;
function BigBlockWrite(var f: file): boolean;
var
i : integer;
error : boolean;
begin
error:= false;
BigBlockWrite:= true;
{$I-} rewrite(f,1); {$I+}
if (ioresult = 0) and bigblkexist then begin
i:= -1;
while not error and (i < NumVec) do begin
inc(i,1);
{$I-} BlockWrite(f,BigBlk[i]^,SizBlk[i]); {$I+}
if ioresult <> 0 then error:= true;
end;
if not error then {$I-}close(f){$I+} else BigBlockWrite:= false;
end else BigBlockWrite:= false;
end;
begin
heaperror:= @heapfunc;
BigBlkExist:= false;
mark(heaptop);
end.
[Back to FILES SWAG index] [Back to Main SWAG index] [Original]