DP Tool Club 25/CD_ASCQ_25_1095.iso/dos/prg/tjgold/install.002/DFPAGE.PAS

Pascal/Delphi Source File | 1995-07-19 | 37KB | 921 lines

{--------------------------------------------------------------------------}
{                Product: TechnoJock's Turbo Toolkit                       }
{                Version: GOLD                                             }
{                Build:   1.01                                             }
{                                                                          }
{  The index routines used in TTT Gold were developed by Dean Farwell II   }
{  and are an adaptation of his excellent TBTREE database tools.           }
{                                                                          }
{                   Copyright 1988-1994 Dean Farwell II                    }
{        Portions Copyright 1986-1995  TechnoJock Software, Inc.           }
{                           All Rights Reserved                            }
{                          Restricted by License                           }
{--------------------------------------------------------------------------}

                     {********************************}
                     {       Unit:   DFPAGE           }
                     {********************************}

unit DFPage;

{$I-}                                          (* turn on I/O error checking *)

(*****************************************************************************)
(*                                                                           *)
(*          P A G E  B U F F E R  H A N D L I N G  R O U T I N E S           *)
(*                                                                           *)
(*****************************************************************************)

(*  This unit handles the page buffer.  This buffer is used for keeping
    disk pages in memory.  The pages can be for data files or index files.
    The buffer uses a demand paging scheme in which the least recently used
    page is swapped out when a page is needed and the buffer is full.        *)


(*////////////////////////// I N T E R F A C E //////////////////////////////*)

interface

uses
    Dos,
    DFBTreUt;

type

    BufferSizeType = 0 .. 1024;    (* used for number of pages in the buffer *)


(* This routine will check to see if a given physical record for a given file
   actually exists either on disk or in the buffer.  It first checks the
   buffer.  If its not in the buffer, it checks to see if it is past the
   end of the file.  It essentially replaces EOF.  EOF will not work properly
   if the pages reside in the buffer but have not been written to disk yet.

   Note - This routine is quite different than routines found in the LOGICAL
   unit and the BTREE unit.  Those units use bitmaps to to see if a record is
   actively being used as opposed to existing and containing garbage.
   PageExists only checks the physical existence of a physical record.  It
   does not check bitmaps like the others do.  It first checks the page buffer
   to see if the page exists there.  If it is not found there, then the file
   itself is checked.                                                        *)


function PageExists(fName : PathStr;
                    var FId : File;                    (* var for speed only *)
                    prNum : PrNumber) : Boolean;


(* This function will fetch a page and return a copy of the page to the caller.
   It accomplishes this by first looking in the buffer itself.  If it can't
   locate it in the buffer, it checks to see if there is room in the buffer.
   If there is no available room, the least recently used page is written to
   disk.  That frees up that page for use.  It will then read in the page from
   disk.

   Note - This routine expects the page physical record to exist somewhere
   (either on the disk or in the page buffer)                                *)

procedure FetchPage(fName : PathStr;
                    var fId : File;                    (* var for speed only *)
                    prNum : PrNumber;
                    var pg : SinglePage);

(*\*)
(* This routine will store a page in the buffer.  It accomplishes this by
   seeing if an old version is in the buffer.  If it is not it creates a new
   page.  The page is stored, the dirty flag is set, and the timeUsed is
   set.

   This can be used to store a page even if the corresponding page does not
   yet exist.  In this case, the record will be created and stored in the
   buffer. It will be physically created in the file when the page is written
   to disk.

   note - This routine will immediately write this page to disk if the user
   has called SetImmediateDiskWrite with a value of TRUE.  Using this feature
   will ensure that current info is always on the disk but will greatly reduce
   efficiency.                                                               *)

procedure StorePage(fName : PathStr;
                    var fId : File;                    (* var for speed only *)
                    prNum : PrNumber;
                    pg : SinglePage);


(* This routine will release the page in the buffer for a given physical
   record in a given file.  Of course, the routine first checks to see
   if the record is in fact in the buffer.                                   *)

procedure ReleasePage(fName : PathStr;
                      prNum : PrNumber);


(* This routine will release all pages in the buffer for the given file (fName)
   It is extremely important to realize that this DOES NOT write the buffer
   pages to disk prior to releasing them.  It is intended for internal use.
   You should use ClearBuffer instead in that ClearBuffer will ensure that
   pages are not lost.                                                       *)

procedure ReleaseAllPages(fName : PathStr);


(*\*)
(* This routine will allow the user to set the maximum number of buffer pages
   to be in use at one time.  This routine allows the user to change this
   at ANY time while the program is running.  The program will check to
   ensure that the user is not setting the maximum number of pages in use
   to an illegal value.  An illegal value is zero or less.  The buffer must
   contain at least one page to function properly.  If the caller has
   specified a new setting which is below the number of pages in use, the
   routine will release pages randomly until the count of pages in use is
   reduced to n.  There is nothing fancy about the algorithm to chose pages
   to release.  The user can alleviate having the wrong pages swapped out
   by specifying certain pages to be swapped out prior to calling this.
   For example, the user could save and release all pages for a file which
   won't be used for awhile.  Remember, swapping out the wrong pages will
   not cause errors, but it may temporarily affect performance as the pages
   will have to be read back in upon their next use.  As an aside, I did
   not swap out least recently used pages since a large number might be
   swapped out.  Each swap would entail going through the entire buffer to
   find the least recently used page.  This would cause too much overhead.

   note - notice use of Exit for exiting the routine.  The routine will not
   normally fall out the bottom.                                             *)

procedure SetMaxBufferPages(n : BufferSizeType);


(* This routine will print the entire page buffer.  lst is the parameter which
   specifies which text device you want to use for output. Normally, it will
   be the printer.  Be sure that the device is initialized properly using
   Assign and Rewrite prior to calling this routine.                         *)

procedure PrintPageBuffer(var lst : PrintTextDevice);


procedure PrintPageBufferPage(var lst : PrintTextDevice;
                              prNum : PrNumber);


(* This routine will print the buffer statistics.  lst is the parameter which
   specifies which text device you want to use for output. Normally, it will
   be the printer.  Be sure that the device is initialized properly using
   Assign and Rewrite prior to calling this routine.                         *)

procedure PrintBufferStats(var lst : PrintTextDevice);

(*!*)
(*\*)
(*///////////////////// I M P L E M E N T A T I O N /////////////////////////*)

(* the following declarations are for defining and storing the buffer *)

implementation


const
    POINTERARRAYSIZE = 199;          (* used to set up array of linked lists
                                         this number needs to be prime       *)

type
    PagePtr = ^PageEntry;

    PageEntry  = record
                 fName        : PathStr;
                 prNum        : PrNumber;
                 timeUsed     : TimeArr;
                 page         : SinglePage;
                 nextPage     : PagePtr;
                 end;

    PointerArrayRange = 0 .. POINTERARRAYSIZE;


var
    pagesInUse : BufferSizeType;     (* value should never exceed the current
                                                     value of maxBufferPages *)

    pointerArray : Array [PointerArrayRange] of PagePtr;  (* Type of Array
                                                         holding the pointers
                                                         to the linked list of
                                                         pages in the
                                                         page buffer *)

    reservedPgPtr : PagePtr;              (* used to reserve enough room on
                                             the heap for at least one page  *)


(* the following declarations are for keeping and printing statistics on
   buffer usage                                                              *)

type
    StatsRange = 0 .. MAXLONGINT;  (* used as type for many buffer stat vars *)

    BufferStats = record                   (* used to hold buffer statistics *)
                  pagesInUse : StatsRange;
                  maxPages : StatsRange;
                  attempts : StatsRange;
                  hits : StatsRange;
                  end;


var
    maxBufferPages : BufferSizeType;  (* Number of buffer pages in buffer.
                                         This can be set by the user to
                                         allow a flexible buffer size        *)


    bufferAttempts: StatsRange;     (* total attempts to fetch a page from the
                                       buffer                                *)

    bufferHits : StatsRange;        (* used for to keep track of attempts to
                                       fetch a physical record from the buffer
                                       in which the record was there         *)

(*\*)
(* This routine will initialize the pointer array to all NILS and will set
   the pages in the pagesInUse counter to zero.  This last item will reflect
   the fact that there are no pages active in the buffer.                    *)

procedure InitializePointerArray;

var
    cnt : PointerArrayRange;

    begin
    for cnt := 0 to POINTERARRAYSIZE do
        begin
        pointerArray[cnt] := NIL;
        end;
    pagesInUse := 0;
    end;                            (* end of InitializePointerArray routine *)


(* This routine will write a specified page to disk.  It will also change the
   Dirty flag to FALSE showing that the page is not dirty.                   *)

procedure WriteToDisk(pgPtr : PagePtr;
                      var fId : File                   (* var for speed only *)
                      );
var
  errorCode : IOErrorCode;
begin
   {$I-}Seek(fId,pgPtr^.prNum);{$I+}
   errorCode := IOresult;
   if errorCode <> 0 then
   begin
      SetBtreeError(errorCode);
      exit;
   end;
   {$I-}BlockWrite(fId,pgPtr^.page,1);{$I+}
   errorCode := IOresult;
   if errorCode <> 0 then
      SetBtreeError(errorCode);
end;           (* end of WriteToDisk procedure *)

(*\*)
(* This routine will read in a specified page from disk.  It will change the
   Dirty flag to false showing that the page is not dirty.  It will also
   set the file name and set the physical record number.  It does not set the
   the time.  This will be done by the procedure which actually decides to
   fetch this record.                                                        *)

procedure ReadFromDisk(var fName : PathStr;           (* var for speed only *)
                       var fId : File;                (* var for speed only *)
                       prNum : PrNumber;
                       pgPtr : PagePtr);
var
  errorCode : IOErrorCode;
begin
    {$I-}Seek(fId,prNum);{$I+}
    errorCode := IOresult;
    if errorCode <> 0 then
    begin
       SetBtreeError(errorCode);
       Exit;
    end;
    {$I-}BlockRead(fId,pgPtr^.page,1);{$I+}
    errorCode := IOresult;
    if errorCode <> 0 then
    begin
       SetBtreeError(errorCode);
       Exit;
    end;
    pgPtr^.fName := fName;
    pgPtr^.prNum := prNum;
end;          (* end of ReadFromDisk procedure *)


(* This routine will return the index to the pointerArray corresponding to the
   given file and physical record.                                           *)

function Hash(var fName : PathStr;                    (* var for speed only *)
              prNum : PrNumber) : PointerArrayRange;

{$V-}
begin
   Hash := (prNum + TotalString(fName)) Mod POINTERARRAYSIZE;
end;           (* end of Hash routine *)
{$V+}

(*\*)
(* This routine will return a pointer pointing to the page corresponding to a
   given file and physical record number.  It will return NIL if the page is
   not in the buffer.                                                        *)

function GetPagePtr(var fName : PathStr;              (* var for speed only *)
                    prNum : PrNumber) : PagePtr;

var
    tempPtr : PagePtr;
    found : boolean;

    begin
    tempPtr := pointerArray[Hash(fName,prNum)];
    found := FALSE;
    while (not found) and (tempPtr <> NIL) do
        begin
        if (tempPtr^.prNum = prNum) and (tempPtr^.fName = fName) then
           begin
           found := TRUE;
           end
       else
           begin
           tempPtr := tempPtr^.nextPage;
           end;
       end;
   GetPagePtr := tempPtr;
   end;                                           (* end of FindPage routine *)


(* This routine will pull a page out of a page list.  It does not Dispose of
   the page.  This allows the page to be immediately reused.  The calling
   routine should either reuse it or Dispose it.                             *)

procedure DeletePgFromList(pgPtr : PagePtr);

var
    tempPtr : PagePtr;

    begin
    tempPtr := pointerArray[Hash(pgPtr^.fName,pgPtr^.prNum)];
    if tempPtr = pgPtr then
        begin                             (* page to delete is first in list *)
        pointerArray[Hash(pgPtr^.fName,pgPtr^.prNum)] := pgPtr^.nextPage;
        end
    else
        begin
        while tempPtr^.nextPage <> pgPtr do
            begin
            tempPtr := tempPtr^.nextPage;
            end;
        tempPtr^.nextPage := pgPtr^.nextPage;
        end;
    end;                                  (* end of DeletePgFromList routine *)

(*\*)
(* This routine will take a page and insert it into the proper place in the
   buffer.                                                                   *)

procedure InsertPgInList(var fName : PathStr;         (* var for speed only *)
                         prNum : PrNumber;
                         pgPtr : PagePtr);

var
    arrayIndex : PointerArrayRange;

    begin
    arrayIndex := Hash(fName,prNum);
    pgPtr^.nextPage := pointerArray[arrayIndex];  (* insert page as first    *)
    pointerArray[arrayIndex] := pgPtr;            (* page in page list       *)
    end;                                    (* end of InsertPgInList routine *)


(* This routine creates a new page and inserts the new page in the front of
   the appropriate page list.  It does not set any of the fields in the prPtr^
   record (except for the nextPage pointer).  This routine does not check to
   see if there is a page available.   This is the responsibility of the
   caller.                                                                   *)

procedure CreateNewPage(var fName : PathStr;          (* var for speed only *)
                        prNum : PrNumber;
                        var pgPtr : PagePtr);

    begin
    New(pgPtr);
    Inc(pagesInUse);                                (* one more page used up *)
    InsertPgInList(fName,prNum,pgPtr);               (* put page into proper
                                                             place in buffer *)
    end;                                     (* end of CreateNewPage routine *)

(*\*)
(* This routine will find the least recently used page, delete it from the
   page list and write it to disk (if it is dirty).  The pointer to the page
   is then returned                                                          *)

function LRUPage : PagePtr;

var
    cnt : PointerArrayRange;
    tempPgPtr,
    leastPgPtr : PagePtr;
    minTime : TimeArr;

    begin
    SetMaxTime(minTime);
    leastPgPtr := NIL;
    for cnt := 0 to POINTERARRAYSIZE do
        begin
        tempPgPtr := pointerArray[cnt];
        while tempPgPtr <> NIL do
            begin
            if CompareTime(tempPgPtr^.timeUsed,mintime) = LESSTHAN then
                begin
                minTime := tempPgPtr^.timeUsed;
                leastPgPtr := tempPgPtr;
                end;
            tempPgPtr := tempPgPtr^.nextPage;
            end;
        end;
    DeletePgFromList(leastPgPtr);              (* pull page out of page list *)
    LRUPage := leastPgPtr;               (* return pointer to page to caller *)
    end;                                           (* end of LRUPage routine *)

(*\*)
(* This routine will check to see if a given physical record for a given file
   actually exists either on disk or in the buffer.  It first checks the
   buffer.  If its not in the buffer, it checks to see if it is past the
   end of the file.  It essentially replaces EOF.  EOF will not work properly
   if the pages reside in the buffer but have not been written to disk yet.

   Note - This routine is quite different than routines found in the LOGICAL
   unit and the BTREE unit.  Those units use bitmaps to to see if a record is
   actively being used as opposed to existing and containing garbage.
   PageExists only checks the physical existence of a physical record.  It
   does not check bitmaps like the others do.  It first checks the page buffer
   to see if the page exists there.  If it is not found there, then the file
   itself is checked.                                                        *)

function PageExists(fName : PathStr;
                    var FId : File;                    (* var for speed only *)
                    prNum : PrNumber) : Boolean;

var
    fSize : PrNumber;
    errorCode : IOErrorCode;

    begin
    if GetPagePtr(fName,prNum) = NIL then  (* check to see if rec is in buff *)
        begin
        fSize := FileSize(fID);
        if errorCode <> 0 then
            begin
            SetBtreeError(errorCode);
            Exit;
            end;
        if prNum <= FSize - 1 then
            begin                             (* record not past end of file *)
            PageExists := TRUE;
            end
        else
            begin               (* record not in buffer and past end of file *)
            PageExists := FALSE;
            end;
        end
    else
        begin                    (* page is in buffer .. therefore it exists *)
        PageExists := TRUE;
        end;
    end;                                        (* end of PageExists routine *)

(*\*)
(* This function will fetch a page and return a copy of the page to the caller.
   It accomplishes this by first looking in the buffer itself.  If it can't
   locate it in the buffer, it checks to see if there is room in the buffer.
   If there is no available room, the least recently used page is written to
   disk.  That frees up that page for use.  It will then read in the page from
   disk.

   Note - This routine expects the page physical record to exist somewhere
   (either on the disk or in the page buffer)                                *)

procedure FetchPage(fName : PathStr;
                    var fId : File;                    (* var for speed only *)
                    prNum : PrNumber;
                    var pg : SinglePage);

var
    pgPtr : PagePtr;

    begin
    pgPtr := GetPagePtr(fName,prNum);          (* try to find page in buffer *)
    if pgPtr = NIL then                    (* check to see if page was found *)
        begin                                    (* page not found in buffer *)
        if (pagesInUse < maxBufferPages) and       (* check for unused pages *)
           (MaxAvail >= SizeOf(PageEntry)) then      (* check for heap space *)
            begin                             (* there is room in the buffer *)
            CreateNewPage(fName,prNum,pgPtr);    (* make new page and use it *)
            end
        else
            begin                                         (* no unused pages *)
            if pagesInUse = 0 then
                begin
                pgPtr := reservedPgPtr;          (* used reserved heap space *)
                end
            else
                begin
                pgPtr := LRUPage;            (* get least recently used page *)
                                                     (* and write it to disk *)
                end;
            InsertPgInList(fName,prNum,pgPtr);       (* put page into proper
                                                             place in buffer *)
            end;
        ReadFromDisk(fName,fId,prNum,pgPtr);         (* read in desired page *)
        if BTreeErrorOccurred then Exit;
        end
    else
        begin                                           (* page is in buffer *)
        Inc(bufferHits);                              (* update hits counter *)
        end;
    GetTime(pgPtr^.timeUsed);                 (* set time page was requested *)
    Move(pgPtr^.page,pg,SizeOf(pg));          (* return copy of the actual
                                                 page to the caller       *)
    Inc(bufferAttempts);
    end;                                         (* end of FetchPage routine *)

(*\*)
(* This routine will store a page in the buffer.  It accomplishes this by
   seeing if an old version is in the buffer.  If it is not it creates a new
   page.  The page is stored and the timeUsed is set.

   This can be used to store a page even if the corresponding page does not yet
   exist.  In this case, the record will be created and stored in the buffer.
   It will be physically created in the file when the page is written to
   disk.

   note - This routine will immediately write this page to disk.             *)

procedure StorePage(fName : PathStr;
                    var fId : File;                    (* var for speed only *)
                    prNum : PrNumber;
                    pg : SinglePage);

var
    pgPtr : PagePtr;
    oldPg : SinglePage;

    begin
{$B-}                            (* next statement depends on short circuit
                                              boolean expression evaluation  *)

    pgPtr := GetPagePtr(fName,prNum);
    if pgPtr = NIL then
        begin
        if (pagesInUse <> maxBufferPages) and      (* check for unused pages *)
           (MaxAvail >= SizeOf(PageEntry)) then      (* check for heap space *)
            begin
            CreateNewPage(fName,prNum,pgPtr);
            end
        else
            begin
            if pagesInUse = 0 then
                begin
                pgPtr := reservedPgPtr;          (* used reserved heap space *)
                end
            else
                begin
                pgPtr := LRUPage;            (* get least recently used page *)
                                                     (* and write it to disk *)
                end;
            InsertPgInList(fName,prNum,pgPtr);       (* put page into proper
                                                             place in buffer *)
            end;
        pgPtr^.fName := fName;
        pgPtr^.prNum := prNum;
        end;
    Move(pg,pgPtr^.page,SizeOf(pg));    (* move page to store into buffer *)
    GetTime(pgPtr^.timeUsed);
    WriteToDisk(pgPtr,fId);
    if BTreeErrorOccurred then Exit;
    end;                                         (* end of StorePage routine *)

(*\*)
(* This routine will release the page in the buffer for a given physical
   record in a given file.  Of course, the routine first checks to see
   if the record is in fact in the buffer.  It is important to realize that
   this page will not be written to disk, but will be lost.                  *)

procedure ReleasePage(fName : PathStr;
                      prNum : PrNumber);

var
    pgPtr : PagePtr;

    begin
    pgPtr := GetPagePtr(fName,prNum);
    if pgPtr <> NIL then
        begin
        DeletePgFromList(pgPtr);
        if pgPtr <> reservedPgPtr then
            begin                (* dispose of the heap space unless it is
                                    the reserved space                       *)
            Dispose(pgPtr);
            end;
        Dec(pagesInUse);
        end;
    end;                                       (* end of ReleasePage routine *)


(* This routine will release all pages in the buffer for the given file (fName)
   It is extremely important to realize that this DOES NOT write the buffer
   pages to disk prior to releasing them.  It is intended for internal use.
   You should use ClearBuffer instead in that ClearBuffer will ensure that
   pages are not lost.                                                       *)

procedure ReleaseAllPages(fName : PathStr);

var
    pgPtr : PagePtr;
    cnt : PointerArrayRange;

    begin
    for cnt := 0 to POINTERARRAYSIZE do
        begin
        pgPtr := pointerArray[cnt];
        while pgPtr <> NIL do
            begin
            if pgPtr^.fName = fName then
                begin
                ReleasePage(fName,pgPtr^.prNum);
                pgPtr := PointerArray[cnt];     (* reset to a valid location *)
                end
            else
                begin
                pgPtr := pgPtr^.nextPage;
                end;
            end;
        end;
    end;                                   (* end of ReleaseAllPages routine *)


(* This routine will allow the user to set the maximum number of buffer pages
   to be in use at one time.  This routine allows the user to change this
   at ANY time while the program is running.  The program will check to
   ensure that the user is not setting the maximum number of pages in use
   to an illegal value.  An illegal value is zero or less.  The buffer must
   contain at least one page to function properly.  If the caller has
   specified a new setting which is below the number of pages in use, the
   routine will release pages randomly until the count of pages in use is
   reduced to n.  There is nothing fancy about the algorithm to chose pages
   to release.  The user can alleviate having the wrong pages swapped out
   by specifying certain pages to be swapped out prior to calling this.
   For example, the user could write to disk and release all pages for a file
   which won't be used for awhile.  Remember, swapping out the wrong pages
   will not cause errors, but it may temporarily affect performance as the
   pages will have to be read back in upon their next use.  As an aside, I did
   not swap out least recently used pages since a large number might be
   swapped out.  Each swap would entail going through the entire buffer to
   find the least recently used page.  This would cause too much overhead.   *)

procedure SetMaxBufferPages(n : BufferSizeType);

var
    pgPtr : PagePtr;
    cnt : PointerArrayRange;

    begin
    if n > 0 then      (* make sure that value is not 0! if it is do nothing *)
        begin
        cnt := 0;
        while pagesInUse > n do
            begin           (* if more pages are in use than desired, release
                               them until the desired number    is reached   *)
            pgPtr := pointerArray[cnt];                    (* reset pgPtr to
                                                            a valid location *)
            if pgPtr <> NIL then
                begin
                ReleasePage(pgPtr^.fName,pgPtr^.prNum);
                end
            else
                begin
                Inc(cnt);
                end;
            end;
        maxBufferPages := n;
        end;
    end;                                 (* end of SetMaxBufferPages routine *)

(*\*)
(* These routines support debugging of the page buffer routines              *)

procedure PrintPageInfo(var lst : PrintTextDevice;
                        pgPtr : PagePtr);

    (* Prints out string equivalent of boolean value *)
    procedure PrintBoolean(x : boolean);

    begin
    case x of
        FALSE : Write(lst,'FALSE');
        TRUE  : Write(lst,'TRUE');
        end;                                        (* end of case statement *)
    end;                                   (* end of PrintPageBuffer routine *)

    (* determines if x is a screen printable non control character *)
    function PrintableChar(x : Char) : boolean;

    begin
    PrintableChar := Integer(x) in [32 .. 127];
    end;                                     (* end of PrintableChar routine *)

const
    LINESIZE = 24;          (* number of bytes output on one line of printer *)

var
    loopByteCnt,            (* used in inner loop to point to bytes *)
    maxLoopByteCnt,         (* used in inner loop to keep from going past
                               end of buffer page  *)
    byteCnt : PageRange;    (* current byte in buffer page *)
    done : boolean;         (* used for inner loop termination *)

    begin
    Writeln(lst,'     fName = ',pgPtr^.fName);
    Writeln(lst,'     prNum = ',pgPtr^.prNum);
    Writeln(lst);
    Write(lst,'     timeUsed = ');
    Write(lst,pgPtr^.timeUsed.msLongInt,'     ');
    Write(lst,pgPtr^.timeUsed.lsLongInt);
    Writeln(lst); Writeln(lst);
    byteCnt := 1;
    done := FALSE;
    repeat
        begin
        if ((byteCnt + LINESIZE) - 1) <= PAGESIZE then
            begin
            maxLoopByteCnt := byteCnt + LINESIZE - 1;
            end
        else
            begin
            maxLoopByteCnt := PAGESIZE;
            end;
        (* print column position *)
        for loopByteCnt := byteCnt to maxLoopByteCnt do
            begin
            Write(lst,loopByteCnt : 3,' ');
            end;
        Writeln(lst);
        (* Print HEX value *)
        for loopByteCnt := byteCnt to maxLoopByteCnt do
            begin
            Write(lst,'$',ByteToHex(pgPtr^.page[loopByteCnt]),' ');
            end;
        Writeln(lst);
        (* print integer equivalent *)
        for loopByteCnt := byteCnt to maxLoopByteCnt do
            begin
            Write(lst,pgPtr^.page[loopByteCnt] :3,' ');
            end;
        Writeln(lst);
        (* character equivalent or print '*' if char not printable *)
        for loopByteCnt := byteCnt to maxLoopByteCnt do
            begin
            if PrintableChar(Chr(pgPtr^.page[loopByteCnt])) then
                begin
                Write(lst,' ',Chr(pgPtr^.page[loopByteCnt]),'  ');
                end
            else
                begin
                Write(lst,' *  ');
                end;
            end;
        Writeln(lst); Writeln(lst);
        if byteCnt + LINESIZE > PAGESIZE then
            begin
            done := TRUE;
            end
        else
            begin
            Inc(byteCnt,LINESIZE);
            end;
        end;
    until done;
    Writeln(lst); Writeln(lst);
    end;                                     (* end of PrintPageInfo routine *)


(* This routine will print the desired page from the page buffer.  lst is the
   parameter which specifies which text device you want to use for output.
   Normally, it will be the printer.  Be sure that the device is initialized
   properly using Assign and Rewrite prior to calling this routine.          *)


(* This routine will print the entire page buffer.  lst is the parameter which
   specifies which text device you want to use for output. Normally, it will
   be the printer.  Be sure that the device is initialized properly using
   Assign and Rewrite prior to calling this routine.                         *)

procedure PrintPageBuffer(var lst : PrintTextDevice);

var
    pgPtr : PagePtr;
    cnt : PointerArrayRange;

    begin
    SetCompressedMode(lst);            (* sets printer to 132 character mode *)
    for cnt := 0 to POINTERARRAYSIZE do
        begin
        pgPtr := PointerArray[cnt];
        while pgPtr <> NIL do
            begin
            PrintPageInfo(lst,pgPtr);
            pgPtr := pgPtr^.nextPage;
            end;
        end;
    CancelCompressedMode(lst);
    end;                                   (* end of PrintPageBuffer routine *)


procedure PrintPageBufferPage(var lst : PrintTextDevice;
                              prNum : PrNumber);

var
    pgPtr : PagePtr;
    cnt : PointerArrayRange;

    begin
    SetCompressedMode(lst);            (* sets printer to 132 character mode *)
    for cnt := 0 to POINTERARRAYSIZE do
        begin
        pgPtr := PointerArray[cnt];
        while pgPtr <> NIL do
            begin
            if pgPtr^.prNum = prNum then
                begin
                PrintPageInfo(lst,pgPtr);
                end;
            pgPtr := pgPtr^.nextPage;
            end;
        end;
    CancelCompressedMode(lst);
    end;                                   (* end of PrintPageBuffer routine *)


(* This routine will initialize the variables used to keep track of buffer
   use statistics.                                                           *)

procedure InitializeBufferStats;

    begin
    bufferAttempts := 0;
    bufferHits := 0;
    end;                             (* end of InitializeBufferStats routine *)


(* This routine will return buffer statistics.  The statistic will be returned
   in a a record of type BufferStats.                                        *)

procedure CreateBufferStats(var stats : BufferStats);

    begin
    stats.pagesInUse := pagesInUse;
    stats.maxPages := maxBufferPages;
    stats.attempts := bufferAttempts;
    stats.hits := bufferHits;
    end;                                 (* end of CreateBufferStats routine *)

(*\*)
(* This routine will print the buffer statistics.  lst is the parameter which
   specifies which text device you want to use for output. Normally, it will
   be the printer.  Be sure that the device is initialized properly using
   Assign and Rewrite prior to calling this routine.                         *)

procedure PrintBufferStats(var lst : PrintTextDevice);

var
    stats : BufferStats;

    begin
    CreateBufferStats(stats);
    Writeln(lst);
    Writeln(lst,'** Buffer Statistics Follow: **');
    Writeln(lst);
    Writeln(lst,'Buffer Pages In Use = ',stats.pagesInUse);
    Writeln(lst,'Maximum buffer pages available =  ',stats.maxPages);
    Writeln(lst,'Attempts to Fetch Data = ',stats.attempts);
    Writeln(lst,'Number of Hits = ',stats.hits);
    if stats.attempts <> 0 then
        begin
        Writeln(lst,'Hit percentage = ',
                Trunc((stats.hits/stats.attempts)*100),'%');
        end;
    end;                                       (* end of PrintBuffer routine *)



begin
New(reservedPgPtr);              (* reserve space for one page in the buffer *)
InitializePointerArray;
InitializeBufferStats;
SetMaxBufferPages(256);                           (* initially a 128K buffer *)
end.                                                     (* end of Page unit *)