Category : Pascal Source Code
Archive   : CACHE.ZIP
Filename : RAMCACHE.PAS

 
Output of file : RAMCACHE.PAS contained in archive : CACHE.ZIP
{*********************************************************}
{* RAMCACHE.PAS 4.00 *}
{* Copyright (c) 1986, 1988 by TurboPower Software. *}
{* All rights reserved. *}
{*********************************************************}

{$S-,R-,I-,V-,B-}

unit RamCache;
{-RAM-based disk caching routines}

interface

uses
Dos;

const
CacheCopyright : string[71] =
'RAMCACHE. Copyright (c) 1986, 1988 by TurboPower Software. Version 4.00';

{user-definable sizes}
MaxSects = 512; {how many (512 byte) sectors the cache can hold}
MaxSects1 = 511; {maxsects-1}
MinSects = 10; {cache is not activated unless at least this
many sectors are available in EMS}
InterruptStackSize = 1024; {bytes to allocate for interrupt stack}

type
{an enumerated type for the system drives}
Drives = (DriveA, DriveB, DriveC, DriveD, DriveE, DriveF);

DriveDescr =
record {stores physical parameters of a drive}
Sectors, Heads, SecSize : Word;
end;
DriveArray = array[Drives] of DriveDescr;
LoginArray = array[Drives] of Boolean;
Sectors = 0..MaxSects1; {index into the cache sector array}
Flagged = 0..MaxSects; {maxsects is used as a flag that sector
is currently not in use}
const
{these are made typed constants to allow custom installation
for memory resident disk cache}
FirstConstToCopy : Byte = 0;

{stores parameters of logged in drives}
DrData : DriveArray = (
(Sectors : 0; Heads : 0; SecSize : 0),
(Sectors : 0; Heads : 0; SecSize : 0),
(Sectors : 0; Heads : 0; SecSize : 0),
(Sectors : 0; Heads : 0; SecSize : 0),
(Sectors : 0; Heads : 0; SecSize : 0),
(Sectors : 0; Heads : 0; SecSize : 0));

{set true for each drive to be cached}
DrLogin : LoginArray = (False, False, False, False, False, False);

{true if installed}
Installed : Boolean = False;

{see procedure SetCacheState for explanations of following}
CacheInactive : Boolean = True;
DoCheckFAT : Boolean = True;
GlobalLoadPriority : Byte = 100;
LastConstToCopy : Byte = 0;

var
ConstBytesToCopy,
DataBytesToCopy : Word;

{marker for non-resident to resident access}
FirstDataToCopy : Byte;
OurPrefixSeg : Word; {PrefixSeg for resident program}
ActSects : Sectors; {actual number of sectors allocated at run time}
ActSects1 : Sectors; {holds actsects+1}
Reads : LongInt; {counters for performance analysis}
Misses : LongInt;
SaveInt13 : Pointer; {old diskette interrupt stored here}

function BuildCache(HeapParasToReserve, MaxCacheSectors : Word) : Boolean;
{-Build the largest possible cache in available heap space}

procedure SetCacheState(CacheActive, CheckFAT : Boolean; LoadPriority : Byte);
{-set various parameters about cacheing}

function LoginDrivePath(PName : string) : Boolean;
{-get physical drive parameters for the referenced path}

procedure FlushCache;
{-Mark all cache sectors as available for overwrite}

procedure FlushDrivePath(PName : string);
{-Mark all cache blocks for the named drive as available for overwrite}

procedure ReleaseCache(ReleaseHeap : Boolean);
{-Restore interrupt and release memory of cache}

function CheckSectorsAvailable : Word;
{-Return the number of unused cache sectors}

procedure DumpCache;
{-Show the state of the cache}

{==========================================================================}

implementation

{=$DEFINE Debug}

type
CacheSector = {main storage record for cache}
record
{logical sector number of the disk sector. computed analogously to the way
that DOS does it}
LSN : Word;

{BIOS version of drive number from which the sector came}
Drive : Drives;

{set when sector loaded into cache. provides a mechanism to keep important
data in cache}
Priority : Byte;

{a quasi-time value representing when the sector was last used. for
deciding which sectors to push out of cache}
LRU : Word;

{actual hash value for this sector. acts as a collision fix for the
hashing mechanism. set to maxsects if sector not in use. ideally, hashval
is equal to the index to each sector}
HashVal : Flagged;

(***************************************
{which 16K EMS page holds sector data}
EMSpage : Word;

{offset into the 16K EMS page}
EMSofs : Word;
*****************************************)

{points to heap area holding the actual sector data}
SPtr : Pointer;

{used only when LRUcount reaches maxint, to compress LRU values and then
rearrange sectors to properly hashed position}
Pos : Word;
end;

CacheArray = array[Sectors] of CacheSector;
CompareType = (Less, Equal, Greater);

var
IntrStackSeg : Word; {stack used during interrupt processing}
IntrStackOfs : Word; {stack pointer}
DOSstackSeg : Word; {DOS stack passed in to interrupt}
DOSstackPtr : Word; {saved stack pointer}
DOSflags : Word; {8088 flags register stored here}

{used to allocate our stack for use during the interrupt}
IntrStackPtr : Pointer;

{input at the time of a disk interrupt}
DriveHead : Word;
TrackSector : Word;
BufSeg : Word;
BufOfs : Word;
RetAX : Word;
CallAX : Word;
NumSectors : Word;

{the largest sector size cached}
SectorSize : Word;

{always holds the minimum priority value in cache}
MinPriority : Byte;

LRUCount : Word; {current quasi-time for LRU comparisons}

{support for EMS}
{the segment of the expanded memory window is stored here}
EMMpageFrame : Word;

{the handle by which we access expanded memory}
EMMhandle : Word;

{current EMS page in window}
EMMcurPage : Word;

{the main data structure for the cache memory}
Cache : CacheArray;

{marker for non-resident to resident access}
LastDataToCopy : Byte;

var
{easy access to DOS interrupt vector table}
Vector : array[0..$1F] of Pointer absolute 0 : 0;

Regs : Registers;
SaveExitProc : Pointer;

{$L CACHE.OBJ}

{$F+}
procedure Int13Handler;
{-low level disk access redirected here during active cache}
external {CACHE} ;
{$F-}

procedure CallOld13;
{-Call the real INT 13h}
external {CACHE} ;

procedure InitCachePtrs;
{-Initialize pointers to our data and pointer to old ISR}
external {CACHE} ;

{$F+}
function CompStruct(var S1, S2; Size : Word) : CompareType;
{-Compare two fixed-size structures}
external {CACHE} ;
{$F-}

function ParseDrive(PName : string) : Drives;
{-return which drive the path refers to}
var
ColPos : Byte;
begin {ParseDrive}
ColPos := Pos(':', PName);
if ColPos = 0 then begin
{default drive, get it}
Regs.AH := $19;
MsDos(Regs);
ParseDrive := Drives(Regs.AL);
end
else
{explicit drive}
ParseDrive := Drives(Ord(Upcase(PName[ColPos-1]))-65);
end; {ParseDrive}

function FindMinPriority : Byte;
{-return the lowest priority in the cache}
var
Min : Byte;
S : Sectors;
begin {FindMinPriority}
Min := 255;
for S := 0 to ActSects do
if (Cache[S].HashVal <> MaxSects) and (Cache[S].Priority < Min) then
Min := Cache[S].Priority;
if Min <> 255 then
FindMinPriority := Min
else
{nothing selected, start in middle of range}
FindMinPriority := 100;
end; {FindMinPriority}

procedure FlushDrivePath(PName : string);
{-mark all cache blocks for the named drive as available for overwrite}
{set PName to empty string '' to flush all drives}
var
S : Sectors;
DriveNum : Drives;
AllDrives : Boolean;
begin {FlushDrivePath}
if Length(PName) = 0 then
AllDrives := True
else begin
DriveNum := ParseDrive(PName);
AllDrives := False;
end;
for S := 0 to ActSects do
if AllDrives or (Cache[S].Drive = DriveNum) then
{mark sector available}
Cache[S].HashVal := MaxSects;
MinPriority := FindMinPriority;
end; {FlushDrivePath}

procedure DoCache;
{-high level cache actions}
var
DriveByte, Action : Byte;
LSnum, LStop,
BiosOfs, Track,
Head, Sector : Word;
TheDrive : Drives;
NotReadYet : Boolean;
S : Sectors;

procedure IncMod(var S : Sectors);
{-Increment S modulo number of sectors}
begin {IncMod}
if S >= ActSects then
S := 0
else
Inc(S);
end; {IncMod}

function Hash(DriveNum : Drives; LSnum : Word) : Sectors;
{-Return a number in 0..actsects that semi-uniquely identifies the
drive and logical sector number}
var
H : Word;
begin {Hash}
H := Ord(DriveNum)+LSnum;
Hash := H mod ActSects1;
end; {Hash}

function InCache(DriveNum : Drives; LSnum : Word; var S : Sectors) : Boolean;
{return true and a sector number if the sector is in the cache}
var
InCa : Boolean;
HashNum : Sectors;
begin {InCache}
{compute a hash value pointing into the cache}
{returns a value in 0..actsects}
HashNum := Hash(DriveNum, LSnum);
S := HashNum;

{see if it is the right sector. mixup during LRU replacement requires
that we check all sectors if the first one is not the right one. But
the replacement algorithm keeps the right sector as close as possible
behind the optimal position}
with Cache[S] do
InCa := (HashVal = HashNum) and (LSN = LSnum) and (Drive = DriveNum);

if not(InCa) then
{scan the rest of cache until found or back to start}
repeat
IncMod(S);
with Cache[S] do
if (HashVal = HashNum) then
InCa := (LSN = LSnum) and (Drive = DriveNum);
until InCa or (S = HashNum);
InCache := InCa;
end; {InCache}

function GetSector(DriveNum : Drives; LSnum : Integer; Priority : Byte;
var S : Sectors) : Boolean;
{-Return true and a free sector number if space exists in the
cache or can be made by killing an older, lower priority sector}
var
Full : Boolean;
SectorToKill, HashNum : Sectors;

function OldestSector(MinP : Byte) : Sectors;
{-Return the oldest, lowest priority sector in the cache}
var
S, Olds : Sectors;
MinLRU : Word;
begin {OldestSector}
MinLRU := MaxInt;
for S := 0 to ActSects do
with Cache[S] do
if (Priority = MinP) and (LRU < MinLRU) then begin
Olds := S;
MinLRU := LRU;
end;
OldestSector := Olds;
end; {OldestSector}

procedure UpdateSector(OS, NS : Sectors);
{-Put the contents of ns into os so that ns can be overwritten with new
data}
var
Temp : Pointer;
begin {UpdateSector}
if OS <> NS then begin
Temp := Cache[OS].SPtr; {save the sector data pointer}
Cache[OS] := Cache[NS];
Cache[NS].SPtr := Temp; {swap the two pointers to sector data}
end;
end; {UpdateSector}

begin {GetSector}
{compute a hash value pointing into the cache}
{returns a value in 0..actsects}
HashNum := Hash(DriveNum, LSnum);
S := HashNum;

{find the next sector not in use}
Full := (Cache[S].HashVal <> MaxSects);
if Full then
{cycle through the cache to find unused sectors}
repeat
IncMod(S);
Full := (Cache[S].HashVal <> MaxSects);
until not(Full) or (S = HashNum);

if Full and (Priority < MinPriority) then begin
{there is nothing we can boot out}
GetSector := False;
Exit;
end;

if Full then
{all cache sectors are in use, but we can boot something out}
SectorToKill := OldestSector(MinPriority)
else
{use the first unused sector found}
SectorToKill := S;

{try to insert the new sector in its properly hashed position}
S := HashNum;
if Cache[S].HashVal = S then
{find the next improperly hashed sector}
repeat
IncMod(S);
until (Cache[S].HashVal <> S) or (S = HashNum);

{update the contents of the killed sector record with the first
improperly hashed sector at or following the optimum hash position}
UpdateSector(SectorToKill, S);

{assign our new hash to the most properly positioned sector}
Cache[S].HashVal := HashNum;
GetSector := True;
end; {GetSector}

function LSN(Drive : Drives; Sector, Track, Head : Word) : Word;
{-return the "logical sector number" for a set of physical parameters}
begin {LSN}
with DrData[Drive] do
LSN := Sector+Sectors*(Head+Heads*Track);
end; {LSN}

procedure UpdateLRU;
{-increment LRU counter and handle wrapping}
var
S : Sectors;

procedure SwapSectors(I, J : Sectors);
{-Swap the contents of two sectors}
var
T : CacheSector;
begin {SwapSectors}
T := Cache[I];
Cache[I] := Cache[J];
Cache[J] := T;
end; {SwapSectors}

procedure SortLRU;
{-Sort the cache array on the lru field}
var
I, J : Word;
begin {SortLRU}
for I := 0 to Pred(ActSects) do
for J := ActSects downto Succ(I) do
if Cache[J].LRU < Cache[Pred(J)].LRU then
SwapSectors(J, Pred(J));
end; {SortLRU}

procedure SortPos;
{-sort the cache array on the pos field}
var
I, J : Word;
begin {SortPos}
for I := 0 to Pred(ActSects) do
for J := ActSects downto Succ(I) do
if Cache[J].Pos < Cache[Pred(J)].Pos then
SwapSectors(J, Pred(J));
end; {SortPos}

begin {UpdateLRU}
if LRUCount < MaxInt then
Inc(LRUCount)
else begin
{wraparound, compress lru numbers}
{fill in position field}
for S := 0 to ActSects do
Cache[S].Pos := S;

{sort sectors on LRU field}
SortLRU;

{replace LRU with ascending integers}
for S := 0 to ActSects do
Cache[S].LRU := S;

{sort sectors on position field to get hashes realigned}
SortPos;

{set next lru value}
LRUCount := Succ(ActSects);
end;
end; {UpdateLRU}

function FATdir(LSnum : Integer) : Boolean;
{-Return true if the sector is a DIR or FAT}
begin {FATdir}
FATdir := (NumSectors = 1) and ((LSnum = 2) or (LSnum = 6));
end; {FATdir}

procedure CheckFAT(TheDrive : Drives);
{-see if FAT or DIR sector is in cache}
{if not then flush drive data from cache and update FAT sector}
var
FoundIt, Matched : Boolean;
S : Sectors;
begin {CheckFAT}
{get the sector into the buffer}
Inc(Reads);
CallOld13;
if Odd(DOSflags) then
{error during read}
Exit;

{find the sector in the cache}
FoundIt := InCache(TheDrive, LSnum, S);

if FoundIt then
Matched := CompStruct(Cache[S].SPtr^, Mem[BufSeg:BufOfs],
DrData[TheDrive].SecSize) = Equal;

if FoundIt and not(Matched) then
{this is an old drive with a new diskette}
{flush all old data for this drive}
FlushDrivePath(Chr(65+Ord(TheDrive))+':');

if not(FoundIt) or not(Matched) then begin
{add sector to cache with highest priority}
if GetSector(TheDrive, LSnum, 255, S) then
{store sector to cache}
with Cache[S] do begin
Move(Mem[BufSeg:BufOfs], SPtr^, DrData[TheDrive].SecSize);

{update its lru}
UpdateLRU;
LRU := LRUCount;

{set its priority to the max}
Priority := 255;

{set the drive and lsnum}
LSN := LSnum;
Drive := TheDrive;
Inc(Misses);
end;
end;
{else sector is already cache buffered at top priority}
end; {CheckFat}

begin {DoCache}
{compute the enumerated drive}
DriveByte := Lo(DriveHead);
if DriveByte <= 1 then
{a floppy disk}
TheDrive := Drives(DriveByte)
else
{a hard disk}
TheDrive := Drives(DriveByte-126);

if not(DrLogin[TheDrive]) then begin
{drive has not been selected for caching. use DOS}
CallOld13;
Exit;
end;

{get rest of call parameters}
Sector := TrackSector and 63;
Track := Hi(TrackSector) or ((TrackSector and 192) shl 2);
Head := Hi(DriveHead);
Action := Hi(CallAX);
NumSectors := Lo(CallAX);

{compute the logical sector number}
LSnum := LSN(TheDrive, Sector, Track, Head);

if Action = 2 {read} then begin
Inc(Reads, NumSectors);

{determine whether this is a FAT or DIR sector}
if DoCheckFAT and FATdir(LSnum) then
{fat and dir sectors get special treatment}
{always read from physical disk to guarantee diskette not changed}
CheckFAT(TheDrive)
else begin
{a normal sector}
{loop through the sectors requested}
LStop := LSnum+NumSectors;
BiosOfs := 0;
NotReadYet := True;
while LSnum <> LStop do begin
if InCache(TheDrive, LSnum, S) then begin
{sector found in cache, move data to bios buffer}
Move(Cache[S].SPtr^, Mem[BufSeg:BufOfs+BiosOfs],
DrData[TheDrive].SecSize);

{update its lru}
UpdateLRU;
Cache[S].LRU := LRUCount;
end else begin
{sector not in cache, read it into bios buffer}
if NotReadYet then begin
CallOld13;
if Odd(DOSflags) then
{error during read, let application retry}
Exit;
NotReadYet := False;
end;

{find available sector, if any}
if GetSector(TheDrive, LSnum, GlobalLoadPriority, S) then
{store sector to cache}
with Cache[S] do begin
Move(Mem[BufSeg:BufOfs+BiosOfs], SPtr^,
DrData[TheDrive].SecSize);

{update its lru}
UpdateLRU;
LRU := LRUCount;

{set its priority}
Priority := GlobalLoadPriority;

{set the drive and lsnum}
LSN := LSnum;
Drive := TheDrive;

{count the misses}
Inc(Misses);
end;
end;

{increment biosofs and lsnum}
Inc(BiosOfs, DrData[TheDrive].SecSize);
Inc(LSnum);
end;
end;
end
else begin
{"write through" the cache}
LStop := LSnum+NumSectors;
BiosOfs := 0;
while LSnum <> LStop do begin
if InCache(TheDrive, LSnum, S) then begin
{sector found in cache, update its lru}
UpdateLRU;
Cache[S].LRU := LRUCount;

{move data from bios buffer to cache}
Move(Mem[BufSeg:BufOfs+BiosOfs], Cache[S].SPtr^,
DrData[TheDrive].SecSize);
end;
{else sector not in cache, ignore it}

{increment biosofs and lsnum}
Inc(BiosOfs, DrData[TheDrive].SecSize);
Inc(LSnum);
end;

{write the sectors to disk}
CallOld13;
end;
end; {DoCache}

procedure SetCacheState(CacheActive, CheckFAT : Boolean; LoadPriority : Byte);
{-set various parameters about cacheing}
begin {SetCacheState}
{***
if CACHEACTIVE is true, all BIOS disk reads and writes to logged drives
are run through the cache interrupt handler. Set cacheactive false to
force all data to come directly from disk. Can also be set false to keep
transient data (to be read only once) from replacing valuable data in
cache. See LoadPriority below for other means of managing transient data.
***}
CacheInactive := not CacheActive;

{***
if CHECKFAT is true, all BIOS reads to the FAT or DIR sectors will do a
physical read to confirm that the same diskette is in place in the drive.
May waste time waiting for the settle time of the drive, although DOS
usually keeps the FAT in its own memory buffer too.
***}
DoCheckFAT := CheckFAT;

{***
LOADPRIORITY sets the priority of subsequent reads when they enter the
cache. A high priority value (towards 254) makes the new data more likely
to overwrite existing data in cache, and less likely to be overwritten by
other new data. The value 255 is reserved for the DIR and FAT sectors of
each drive used, which effectively always keeps these sectors locked in
cache.
***}
if LoadPriority < MinPriority then
MinPriority := LoadPriority;

GlobalLoadPriority := LoadPriority;
if GlobalLoadPriority > 254 then
GlobalLoadPriority := 254;
end; {SetCacheState}

function LoginDrivePath(PName : string) : Boolean;
{-get physical drive parameters for the referenced path}
var
Drive : Drives;
BIOSnum, DOSnum, IDbyte : Byte;

function IsBIOSnum(Drive : Drives; DOSnum : Byte; IDbyte : Byte) : Byte;
{-return the drive number that BIOS uses}
var
NDrives : Byte;
begin {IsBiosNum}
if (Drive = DriveA) or (Drive = DriveB) then
{a floppy}
IsBIOSnum := Ord(Drive)
else if IDbyte = $F8 then begin
{a hard drive - see how many hard drives on system}
Regs.AH := 8;
Regs.DL := $80;
Intr($13, Regs);
if Odd(Regs.Flags) then begin
IsBIOSnum := 255;
Exit;
end;
NDrives := Regs.DL;
if (NDrives = 1) or (DOSnum <= 2) then
{one hard drive or the first hard drive}
IsBIOSnum := $80
else begin
{two hard drives, dosnum>=3, is this the first or a later hard drive?}
{check the prior DOS drive to see if it is hard}
Regs.AH := $1C;
Regs.DL := DOSnum;
MsDos(Regs);
IDbyte := Mem[Regs.DS:Regs.BX];
if IDbyte = $F8 then
{prior drive also hard, this drive is $81}
IsBIOSnum := $81
else
{prior drive not hard, this is first hard drive}
IsBIOSnum := $80;
end;
IsBIOSnum := Ord(Drive)+$7E
end
else
IsBIOSnum := 255;
end; {IsBiosNum}

function IsDOSnum(Drive : Drives) : Byte;
{-return the drive number that DOS uses}
begin {IsDOSnum}
case Ord(Drive) of
0..5 : IsDOSnum := Ord(Drive);
else IsDOSnum := 255;
end;
end; {IsDOSnum}

procedure GetFAT(DOSnum : Byte; var DriveId : Byte; var SecSize : Word);
{-Read the FAT ID info for the specified drive}
begin {GetFAT}
Regs.AH := $1C;
Regs.DL := Succ(DOSnum);
MsDos(Regs);
if Odd(Regs.Flags) then
SecSize := 0
else begin
SecSize := Regs.CX;
DriveId := Mem[Regs.DS:Regs.BX];
end;
end; {GetFAT}

procedure GetDriveParams(BIOSnum : Byte; var Heads, Sectors : Word);
{-Read the BIOS drive parameters for the specified drive}
begin {GetDriveParams}
Regs.AH := 8;
Regs.DL := BIOSnum;
Intr($13, Regs);
if Odd(Regs.Flags) then
Sectors := 0
else begin
Heads := Succ(Regs.DH);
Sectors := Regs.CX and $3F;
end;
end; {GetDriveParams}

begin {LoginDrivePath}
LoginDrivePath := False;

{see what drive the pathname refers to}
Drive := ParseDrive(PName);

if not(DrLogin[Drive]) then
with DrData[Drive] do begin
DOSnum := IsDOSnum(Drive);
if DOSnum = 255 then
{drive not known to DOS}
Exit;

{read the FAT information}
GetFAT(DOSnum, IDbyte, SecSize);
if SecSize = 0 then
Exit;

BIOSnum := IsBIOSnum(Drive, DOSnum, IDbyte);
if BIOSnum = 255 then
{drive not known to BIOS}
Exit;

if (BIOSnum = 0) or (BIOSnum = 1) then begin
{a floppy, use FAT ID code to set values}
case IDbyte of
$FF : begin
Heads := 2; Sectors := 8;
end;
$FE : begin
Heads := 1; Sectors := 8;
end;
$FD : begin
Heads := 2; Sectors := 9;
end;
$FC : begin
Heads := 1; Sectors := 9;
end;
$F9 : begin
Heads := 2; Sectors := 15;
end;
$F8 :
{a hard drive, use BIOS function}
GetDriveParams(BIOSnum, Heads, Sectors);
end;
DrLogin[Drive] := True;
end
else if (BIOSnum = $80) or (BIOSnum = $81) then begin
{a hard drive, use BIOS function}
GetDriveParams(BIOSnum, Heads, Sectors);
if Sectors <> 0 then
DrLogin[Drive] := True;
end
else
{drive not known to BIOS}
Exit;
end;

LoginDrivePath := True;
end; {LoginDrivePath}

function CheckSectorsAvailable : Word;
{-Return the number of unused cache sectors}
var
S, SAvail : Sectors;
begin {CheckSectorsAvailable}
SAvail := 0;
for S := 0 to ActSects do
if Cache[S].HashVal = MaxSects then
Inc(SAvail);
CheckSectorsAvailable := SAvail;
end; {CheckSectorsAvailable}

procedure DumpCache;
{-Show the state of the cache}
var
S : Sectors;
I : Word;
begin {DumpCache}
WriteLn('Sectors: ', ActSects1,
^M^J'Unused: ', CheckSectorsAvailable,
^M^J'Reads: ', Reads,
^M^J'Misses: ', Misses);
if Reads > 0 then
WriteLn('Hit ratio: ', (1.0-Misses/Reads):0:2);

{$IFDEF Debug}
for S := 0 to ActSects do
with Cache[S] do begin
{writeln('********************************************************************');}
if HashVal <> MaxSects then
WriteLn('sector: ', S:3, ' hash: ', HashVal:3, ' lsn: ',
LSN:5, ' lru: ', LRU:5);
{FOR i := 0 TO 511 DO
Write(Chr(Mem[Seg(sptr^):Ofs(sptr^)+i]));}
{WriteLn;}
end;
{$ENDIF}
end; {DumpCache}

procedure FlushCache;
{-Mark all cache sectors as available for overwrite}
begin {FlushCache}
FlushDrivePath('');
LRUCount := 0;
end; {FlushCache}

procedure ReleaseCache(ReleaseHeap : Boolean);
{-Restore interrupt vector}
var
S : Sectors;
begin {ReleaseCache}
{restore INT 13h vector}
Vector[$13] := SaveInt13;

{release memory used for cache}
if ReleaseHeap then
if (ActSects >= MinSects) then begin
for S := 0 to ActSects do
FreeMem(Cache[S].SPtr, SectorSize);
FreeMem(IntrStackPtr, InterruptStackSize);
end;
end; {ReleaseCache}

function BuildCache(HeapParasToReserve, MaxCacheSectors : Word) : Boolean;
{-build the largest possible cache in available heap space}
var
I : Integer;
ParasAvail : Word;
S : Sectors;
begin {BuildCache}
{initialize some basic constants}
SectorSize := 512; {only size supported by DOS currently}
Misses := 0;
Reads := 0;
LRUCount := 0;
ActSects := 0;
MinPriority := GlobalLoadPriority;

ParasAvail := MaxAvail div 16;
ParasAvail := ParasAvail-HeapParasToReserve-(InterruptStackSize shr 4);
if Integer(ParasAvail) < 0 then
Exit;

ActSects := Pred(ParasAvail shr 5);
if ActSects > MaxCacheSectors then
ActSects := MaxCacheSectors;
if ActSects > MaxSects1 then
ActSects := MaxSects1;
ActSects1 := Succ(ActSects);

{caching is not worth it if actsects < minsects}
if ActSects < MinSects then
Exit;

{initialize the cache sectors and get the data storage areas}
for S := 0 to ActSects do begin
Cache[S].HashVal := MaxSects; {mark as unused}
GetMem(Cache[S].SPtr, SectorSize);
end;

{set up the interrupt stack}
GetMem(IntrStackPtr, InterruptStackSize);
IntrStackSeg := Seg(IntrStackPtr^);
I := Ofs(IntrStackPtr^); {lowest address on stack}
IntrStackOfs := I+InterruptStackSize; {highest address on stack}
FillChar(IntrStackPtr^, InterruptStackSize, 0);

{adjust so SP=0 means stack overflow}
repeat
Dec(I, $10);
Dec(IntrStackOfs, $10);
Inc(IntrStackSeg);
until I <= 0;

{set up the interrupt handler}
Vector[$13] := @Int13Handler;

{if we get here we succeeded}
BuildCache := True;
end; {BuildCache}

{$F+}
procedure OurExitProc;
{-Deinstall INT 13 handler in case of runtime error}
begin {OurExitProc}
ExitProc := SaveExitProc;

{restore INT 13h vector}
if (ErrorAddr <> nil) and (Vector[$13] = @Int13Handler) then
ReleaseCache(False);
end; {OurExitProc}
{$F-}

begin
{initialize}
OurPrefixSeg := PrefixSeg;
SaveInt13 := Vector[$13];
ConstBytesToCopy := Ofs(LastConstToCopy)-Ofs(FirstConstToCopy);
DataBytesToCopy := Ofs(LastDataToCopy)-Ofs(FirstDataToCopy);

{initialize pointers to our data}
InitCachePtrs;

{set up the exit handler}
SaveExitProc := ExitProc;
ExitProc := @OurExitProc;
end.


  3 Responses to “Category : Pascal Source Code
Archive   : CACHE.ZIP
Filename : RAMCACHE.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/