Power-Programmierung/CD1.mdf/pascal/library/dos/btree/tree/page.pas

Pascal/Delphi Source File | 1989-07-13 | 41.2 KB | 1,071 lines

(* TBTree15             Copyright (c)  1988,1989       Dean H. Farwell II    *)

unit Page;

{$I-}                                         (* turn off 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.        *)

(* Version Information

   Version 1.1 - No Changes

   Version 1.2 - No Changes

   Version 1.3 - No Changes

   Version 1.4 - Performed some internal optimizations
                 Specifically, I am passing more variables as VAR parameters
                 for those routines which are internal to the unit.

               - Made internal modifications necessary to use the redesigned
                 TIME unit.

               - Fixed error in SetMaxBufferPages routine.  Routine did not
                 previously work correctly

   Version 1.5 - Error handling added.  Unit now uses the ERROR unit to handle
                 I/O errors which occur in the internal ReadFromDisk and
                 WriteToDisk routines.

               - In previous versions, there was a danger of running out of
                 heap space and being unable to allocate enough space on the
                 heap to allocate room for at least one page.  This is now
                 handled properly by initially reserving enough space on the
                 heap for one entry. In this way, you will always be able to
                 have at least one page in the buffer.  It reserves the space
                 as part of the initialization sequence when the code in the
                 initialization section is called.  If there is not enough
                 heap space available, a runtime error occurs.  If an error
                 does not occur during the initialization, a problem will
                 never occur later.  However, if there is a very limited
                 amount of heap space available, the unit will not allow very
                 many pages reside in the buffer at one time.  This will be
                 transparent to you except that performance will suffer
                 somewhat.

               - Changed code internally to use Inc and Dec where practical

   Version 1.6 - Fixed error which caused a catestrophic error when the heap
                 was nearly full and a page was allocated.                   *)


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

interface

uses
    Compare,
    Error,
    FastMove,
    FileBuff,
    FileDecs,
    Hex,
    MyPrint,
    Numbers,
    Printer,
    Strings,
    Time;

const
    PAGESIZE = 512;                  (* Number of bytes in a Physical Record *)

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

    PageRange  = 1 .. PAGESIZE;    (* type used primarily for indexing a page
                                      byte by byte.                          *)

    SinglePage = Array [PageRange] of Byte;    (* type used to hold one page *)

(*\*)
(* 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 : FnString;
                    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.                                   *)

procedure FetchPage(fName : FnString;
                    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.  It 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 : FnString;
                    prNum : PrNumber;
                    pg : SinglePage);

(*\*)
(* Routine to write all dirty pages in buffer to disk.                       *)

procedure WriteEntireBufferToDisk;


(* This routine will all pages corresponding to the given file out to disk.
   The routine does not release the pages from the buffer.                   *)

procedure WriteBufferToDisk(fName : FnString);


(* 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 : FnString;
                      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.  This must be done explicitly or they
   will be lost.  This routine is handy for deleting a file to ensure that no
   pages are left roaming around in the buffer.                              *)

procedure ReleaseAllPages(fName : FnString);


(* This routine will return the number of buffer pages currently in use.     *)

function CheckPagesInUse : BufferSizeType;


(* This routine will return the number of maximum buffer pages allowed       *)

function CheckMaxBufferPages : BufferSizeType;

(*\*)
(* 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 allow the user to set whether stored pages will be
   immediately  written to disk during StorePage operations.  It will
   set an internal variable which keeps track of whether pages should
   be immediately written to disk or only stored in the buffer.  The
   variable cannot be accessed by the user.  The only way is to set
   it is to call this routine.  The routine is called at initialization
   time with x = FALSE which means that pages will not be written immediately
   to disk.  The user can change this at any time.  Once this is set to
   TRUE all dirty pages in the buffer (ones that have not yet been written
   to disk) will still be dirty (will not be automatically written).  All
   newly stored pages will be immediately written.  To ensure that all
   pages have been written to disk, use WriteEntireBufferToDisk.  Regardless
   of whether this is set to TRUE or FALSE, the page will still be in the
   buffer and will be available for FetchPage operations without going to
   disk.

   note - As stated above, this can be called anytime.  However, if this is
   set to TRUE after pages have been written to the buffer, make sure you
   still call WriteEntireBufferToDisk.  Calling this routine will not cause
   pages which are already dirty to be immediately written to disk           *)

procedure SetImmediateDiskWrite(x : Boolean);

(*\*)
(* This routine will return TRUE if the parameter has been set forcing pages
   to be written to disk immediately on calling StorePage.  This is the only
   to check the variable since it is hidden in the implementation.           *)

function CheckImmediateDiskWrite : Boolean;

(* This routine will print the entire page buffer to the printer *)

procedure PrintPageBuffer;


(* This routine will print the buffer statistics                             *)

procedure PrintBufferStats;

(*!*)
(*\*)
(*///////////////////// 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     : FnString;
                 prNum     : PrNumber;
                 dirty     : boolean;
                 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 *)

    immediateDiskWrite : Boolean;         (* used to keep track of whether to
                                             store pages immediately to disk
                                             on all StorePage calls          *)

    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
    tempFile : File;
    ioRes : Word;
    ioErrRec : IOErrorRec;

    begin
    OpenUntypedFile(pgPtr^.fName,tempFile,PAGESIZE);
    repeat                                   (* I/O loop with error checking *)
        Seek(tempFile,pgPtr^.prNum);
        BlockWrite(tempFile,pgPtr^.page,1);
        ioRes := IOResult;
        if ioRes <> 0 then
            begin
            ioErrRec.routineName := 'CloseFile';
            ioErrRec.tBTreeIOResult := ioRes;
            UserIOError(ioErrRec);
            end;
    until ioRes = 0;
    pgPtr^.dirty := FALSE;
    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 : FnString;           (* var for speed only *)
                       prNum : PrNumber;
                       pgPtr : PagePtr);

var
    tempFile : file;
    ioRes : Word;
    ioErrRec : IOErrorRec;

    begin
    OpenUntypedFile(fName,tempFile,PAGESIZE);
    repeat                                   (* I/O loop with error checking *)
        ioRes := IOResult;
        Seek(tempFile,prNum);
        BlockRead(tempFile,pgPtr^.page,1);
        if ioRes <> 0 then
            begin
            ioErrRec.routineName := 'CloseFile';
            ioErrRec.tBTreeIOResult := ioRes;
            UserIOError(ioErrRec);
            end;
    until ioRes = 0;
    pgPtr^.fName := fName;
    pgPtr^.prNum := prNum;
    pgPtr^.dirty := FALSE;
    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 : FnString;                    (* 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 : FnString;              (* 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^.fName = fName) and (tempPtr^.prNum = prNum) 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 : FnString;         (* 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 sets the file name and record number
   fields.  It then inserts the new page in the front of the appropriate
   page list.  It does not set the time nor dirty fields.  This routine does
   not check to see if there is a page available.   This is the responsibility
   of the caller.                                                            *)

procedure CreateNewPage(var fName : FnString;          (* 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.  The pointer to the page is then returned *)

function LRUPage : PagePtr;

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

    begin
    SetMaxTime(minTime);
    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;
    WriteToDisk(leastPgPtr);                       (* write page out to disk *)
    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 : FnString;
                    prNum : PrNumber) : Boolean;

var
    tempFile : File;

    begin
    if GetPagePtr(fName,prNum) = NIL then            (* check to see if record
                                                                is in buffer *)
        begin
        OpenUntypedFile(fName,tempFile,PAGESIZE);
        if prNum <= FileSize(tempFile) - 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.  If there are currently no pages in
   the heap and there is no heap space to create the first page, the ERROR
   unit comes into play.  UserHeapError is called.  You                                    *)

procedure FetchPage(fName : FnString;
                    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 *)
                InsertPgInList(fName,prNum,pgPtr);   (* put page into proper
                                                             place in buffer *)
                end
            else
                begin
                pgPtr := LRUPage;            (* get least recently used page *)
                                                     (* and write it to disk *)
                InsertPgInList(fName,prNum,pgPtr);  (* reuse page and put in
                                                      proper place in buffer *)
                end;
            end;
        ReadFromDisk(fName,prNum,pgPtr);             (* read in desired page *)
        end
    else
        begin                                           (* page is in buffer *)
        Inc(bufferHits);                              (* update hits counter *)
        end;
    GetTime(pgPtr^.timeUsed);                 (* set time page was requested *)
    FastMover(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, 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.  It 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
   ensure that current info is always on the disk but will greatly reduce
   efficiency                                                                *)

procedure StorePage(fName : FnString;
                    prNum : PrNumber;
                    pg : SinglePage);

var
    pgPtr : PagePtr;

    begin
    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
            pgPtr := LRUPage;
            InsertPgInList(fName,prNum,pgPtr);
            end;
        pgPtr^.fName := fName;
        pgPtr^.prNum := prNum;
        end;
    FastMover(pg,pgPtr^.page,SizeOf(pg));  (* move page to store into buffer *)
    pgPtr^.dirty := TRUE;
    GetTime(pgPtr^.timeUsed);
    if immediateDiskWrite then
        begin
        WriteToDisk(pgPtr);
        end;
    end;                                         (* end of StorePage routine *)

(*\*)
(* Routine to write all dirty pages in buffer to disk.                       *)

procedure WriteEntireBufferToDisk;

var
    pgPtr : PagePtr;
    cnt : PointerArrayRange;

    begin
    for cnt:= 0 to POINTERARRAYSIZE do
        begin
        pgPtr := PointerArray[cnt];
        while pgPtr <> NIL do
            begin
            if pgPtr^.dirty then
                begin
                WriteBufferToDisk(pgPtr^.fName);
                end;
            pgPtr := pgPtr^.nextPage;
            end;
        end;
    end;                           (* end of WriteEntireBufferToDisk routine *)


(* This routine will all pages corresponding to the given file out to disk.
   The routine does not release the pages from the buffer.                   *)

procedure WriteBufferToDisk(fName : FnString);

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
                WriteTodisk(pgPtr);
                end;
            pgPtr := pgPtr^.nextPage;
            end;
        end;;
    end;                                 (* end of WriteBufferToDisk 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 : FnString;
                      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.  This must be done explicitly or they
   will be lost.  This routine is handy for deleting a file to ensure that no
   pages are left roaming around in the buffer.                              *)

procedure ReleaseAllPages(fName : FnString);

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 return the number of buffer pages currently in use.     *)

function CheckPagesInUse : BufferSizeType;

    begin
    CheckPagesInUse := pagesInUse;
    end;                                   (* end of CheckPagesInUse routine *)

(* This routine will return the number of maximum buffer pages allowed       *)

function CheckMaxBufferPages : BufferSizeType;

    begin
    CheckMaxBufferPages := maxBufferPages;
    end;                               (* end of CheckMaxBufferPages 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 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);

var
    pgPtr : PagePtr;
    cnt : PointerArrayRange;

    begin
    if n > 0 then      (* make sure that value is not 0! if it is do nothing *)
        begin
        if pagesInUse <= n then
            begin
            maxBufferPages := n;
            end
        else
            begin
            cnt := 0;
            while pagesInUse > n do
                begin
                pgPtr := pointerArray[cnt];                (* reset pgPtr to
                                                            a valid location *)
                if pgPtr <> NIL then
                    begin
                    if pgPtr^.dirty then
                        begin
                        WriteToDisk(pgPtr);
                        end;
                    ReleasePage(pgPtr^.fName,pgPtr^.prNum);
                    end
                else
                    begin
                    Inc(cnt);
                    end;
                end;
            end;
        end;
    end;                                 (* end of SetMaxBufferPages routine *)

(*\*)
(* This routine will allow the user to set whether stored pages will be
   immediately  written to disk during StorePage operations.  It will
   set an internal variable which keeps track of whether pages should
   be immediately written to disk or only stored in the buffer.  The
   variable cannot be accessed by the user.  The only way is to set
   it is to call this routine.  The routine is called at initialization
   time with x = FALSE which means that pages will not be written immediately
   to disk.  The user can change this at any time.  Once this is set to
   TRUE all dirty pages in the buffer (ones that have not yet been written
   to disk) will still be dirty (will not be automatically written).  All
   newly stored pages will be immediately written.  To ensure that all
   pages have been written to disk, use WriteEntireBufferToDisk.  Regardless
   of whether this is set to TRUE or FALSE, the page will still be in the
   buffer and will be available for FetchPage operations without going to
   disk.

   note - As stated above, this can be called anytime.  However, if this is
   set to TRUE after pages have been written to the buffer, make sure you
   still call WriteEntireBufferToDisk.  Calling this routine will not cause
   pages which are already dirty to be immediately written to disk           *)

procedure SetImmediateDiskWrite(x : Boolean);

    begin
    ImmediateDiskWrite := x;
    end;                             (* end of SetImmediateDiskWrite routine *)


(* This routine will return TRUE if the parameter has been set forcing pages
   to be written to disk immediately on calling StorePage.  This is the only
   to check the variable since it is hidden in the implementation.           *)

function CheckImmediateDiskWrite : Boolean;

    begin
    CheckImmediateDiskWrite := immediateDiskWrite;
    end;                           (* end of CheckImmediateDiskWrite routine *)

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

procedure PrintPageInfo(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 = 32;          (* 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);
    Write(lst,'     dirty = ');
    PrintBoolean(pgPtr^.dirty);
    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 entire page buffer to the printer *)

procedure PrintPageBuffer;

var
    pgPtr : PagePtr;
    cnt : PointerArrayRange;

    begin
    SetCompressedMode;                 (* sets printer to 132 character mode *)
    for cnt := 0 to POINTERARRAYSIZE do
        begin
        pgPtr := PointerArray[cnt];
        while pgPtr <> NIL do
            begin
            PrintPageInfo(pgPtr);
            pgPtr := pgPtr^.nextPage;
            end;
        end;
    CancelCompressedMode;
    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                             *)

procedure PrintBufferStats;

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);
    Writeln(lst,'Hit percentage = ',Trunc((stats.hits/stats.attempts)*100),'%');
    end;                                       (* end of PrintBuffer routine *)



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