(*************************************************************************

           =====================================================
           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.