LoganBerryCacheImpl.mesa
Copyright Ó 1991, 1992 by Xerox Corporation. All rights reserved.
Derived From LoganBerrySunStubImpl
Swinehart, October 4, 1991 5:53 pm PDT
Christian Jacobi, April 23, 1992 10:45 am PDT
Provides a cached front-end to LoganBerry databases. Dangerous if database is being updated by more than one client at once. Speeds performance of ReadEntry[...primary key....]. Doesn't support activity log stuff in WriteEntry. ReadEntry[].others is not always reliable.
This implementation both raises some of its own LoganBerry errors and lets some of the real ones through. This may eventually be confusing, since the DB in effect at the time may be different.
This implementation is willing to do non-write-through caching of entries. The feature is of limited value: any attempt to access entries while LBWriteCaching is asserted through any key other than the primary one, or any concurrent attempts to write, are fraught with peril. This feature is supported only for those who have consulted the author(s).
Willie-s, April 23, 1992 5:18 pm PDT
DIRECTORY
Args USING [ Arg, ArgsGet, Error ],
Atom USING [ GetProp, PutProp, RemProp ],
BasicTime USING [ earliestGMT, GMT, Period ],
Commander, CommanderOps, Convert,
IO,
List USING [ Sort, CompareProc ],
LoganBerry,
LoganBerryClass USING [Class, ClassObject, GetDBSpecifics, Register],
LoganBerryEntry USING [ CopyEntry, GetAttr ],
RefID USING [Seal, Reseal, Unseal],
Rope USING [Compare, Equal, Find, ROPE, Substr],
SymTab USING [ Create, Delete, EachPairAction, Erase, Fetch, GetSize, Insert, Pairs, Ref, Store, Val ]
;
LoganBerryCacheImpl: CEDAR MONITOR LOCKS dbinfo USING dbinfo: OpenDBInfo
-- Operations are monitored to avoid thinking, for the present.
IMPORTS Args, Atom, BasicTime, Commander, CommanderOps, Convert, IO, List, LoganBerry, LoganBerryClass, LoganBerryEntry, RefID, Rope, SymTab
EXPORTS LoganBerry indirectly by registering with LoganBerryClass
~ BEGIN OPEN IO;
ROPE: TYPE ~ Rope.ROPE;
Conv: TYPE ~ LoganBerry.Conv;
OpenDB: TYPE ~ LoganBerry.OpenDB;
AttributeType: TYPE ~ LoganBerry.AttributeType;
AttributeValue: TYPE ~ LoganBerry.AttributeValue;
Entry: TYPE ~ LoganBerry.Entry;
nullDB: OpenDB~LoganBerry.nullDB;
nilconv: INT = 0;
OpenDBInfo: TYPE = REF OpenDBRecord;
OpenDBRecord: TYPE = MONITORED RECORD [
dbName: ROPE,
realDB: OpenDB¬nullDB,
realRealDB: OpenDB¬nullDB,
dbCache: DBCache¬NIL,
referencesThisInterval: INT¬0,
isOpen: BOOLEAN¬FALSE,
primaryKey: AttributeType ¬ NIL,
writeList: LIST OF REF ANY ¬ NIL
];
Class methods -- cached operations.
notInDatabase: Entry ¬ LIST[[$NotInDatabase, "NotInDatabaseValue"]];
Open: PROC [conv: Conv ¬ NIL, dbName: ROPE] RETURNS [db: OpenDB] ~ {
Since this implementation locks accesses to individual dbs, the locking during open is complicated (no record to lock yet). See LoganBerryImpl for how this works.
dbinfo: OpenDBInfo;
cacheRequestIndex: INT ¬ Rope.Find[s1: dbName, s2: "-CACHED", case: FALSE];
IF cacheRequestIndex = -1 THEN RETURN[LoganBerry.nullDB];
dbinfo ¬ GetSharedDB[dbName];
IF NOT dbinfo.isOpen THEN
MonitoredOpen[dbinfo, conv, dbinfo.dbName.Substr[len: cacheRequestIndex]];
RETURN[RefID.Seal[dbinfo]];
};
MonitoredOpen: ENTRY PROC [dbinfo: OpenDBInfo, conv: Conv, realDBName: ROPE] ~ {
ENABLE UNWIND => NULL;
realDB: OpenDB;
IF dbinfo.isOpen THEN RETURN; -- lost the race
realDB ¬ LoganBerry.Open[conv: conv, dbName: realDBName];
dbinfo.primaryKey ¬
LoganBerry.Describe[conv: conv, db: realDB].info.indices.first.key;
dbinfo.realDB ¬ realDB;
dbinfo.realRealDB ¬ LoganBerryClass.GetDBSpecifics[realDB].dbhandle;
dbinfo.isOpen ¬ TRUE;
};
ReadEntry: PROC [conv: Conv ¬ NIL, db: OpenDB, key: AttributeType, value: AttributeValue] RETURNS [entry: Entry, others: BOOLEAN] ~ {
[entry, others] ¬ ReadEntryI[GetInfo[db], conv, key, value];
};
ReadEntryI: ENTRY PROC [dbinfo: OpenDBInfo, conv: Conv, key: AttributeType, value: AttributeValue] RETURNS [entry: Entry, others: BOOLEAN¬FALSE] ~ {
ENABLE UNWIND => NULL;
primary: BOOL ¬ key=dbinfo.primaryKey;
e: Entry¬NIL;
IF primary THEN entry¬ReadCache[dbinfo, value, TRUE];
IF entry#NIL THEN RETURN[IF entry=notInDatabase THEN NIL ELSE entry];
[entry, others] ¬
LoganBerry.ReadEntry[conv: conv, db: dbinfo.realDB, key: key, value: value];
e ¬ entry;
IF e = NIL THEN e ¬ notInDatabase;
IF primary THEN RecordCache[dbinfo, value, e, TRUE];
RETURN[entry, others];
};
WriteEntry: PROC [conv: Conv ¬ NIL, db: OpenDB, entry: Entry, log: LoganBerry.LogID ¬ LoganBerry.activityLog, replace: BOOLEAN ¬ FALSE] RETURNS [] ~ {
WriteEntryI[GetInfo[db], conv, entry, log, replace];
};
WriteEntryI: ENTRY PROC [dbinfo: OpenDBInfo, conv: Conv, entry: Entry, log: LoganBerry.LogID, replace: BOOLEAN] ~ {
ENABLE UNWIND => NULL;
value: ROPE ¬ LoganBerryEntry.GetAttr[entry: entry, type: dbinfo.primaryKey];
IF value=NIL OR ~writeCaching THEN {
oldEntry ← IF value#NIL THEN ReadCache[dbinfo, value, FALSE] ELSE NIL;
IF oldEntry = notInDatabase THEN oldEntry←NIL;
LoganBerry.WriteEntry[conv: conv, db: dbinfo.realDB, entry: entry, log: log, replace: replace];
};
IF value#NIL THEN RecordCache[dbinfo, value, entry, FALSE];
};
DeleteEntry: PROC [conv: Conv ¬ NIL, db: OpenDB, key: AttributeType, value: AttributeValue] RETURNS [deleted: Entry] ~ {
deleted ¬ DeleteEntryI[GetInfo[db], conv, key, value];
};
DeleteEntryI: PROC [dbinfo: OpenDBInfo, conv: Conv, key: AttributeType, value: AttributeValue] RETURNS [deleted: Entry] ~ {
ENABLE UNWIND => NULL;
kValue: AttributeValue ¬ value;
IF writeCaching THEN LoganBerry.Error[$OpNotAvailable, "Can't delete entries while write caching is enabled."];
IF caching AND key#dbinfo.primaryKey THEN {
entry: Entry ¬ LoganBerry.ReadEntry[conv: conv, db: dbinfo.realDB, key: key, value: value].entry;
kValue ¬ LoganBerryEntry.GetAttr[entry, dbinfo.primaryKey];
};
LoganBerry.DeleteEntry[conv, dbinfo.realDB, key, value];
IF ~caching THEN RETURN;
IF kValue=NIL THEN
LoganBerry.Error[$OpNotAvailable, "Not enough information to delete entry from cache."];
[] ¬ dbinfo.dbCache.Delete[kValue];
};
Class methods -- pass on.
EnumerateEntries: PROC [db: OpenDB, key: AttributeType, start: AttributeValue ¬ NIL, end: AttributeValue ¬ NIL, proc: LoganBerry.EntryProc] RETURNS [] ~ {
dbinfo: OpenDBInfo ¬ GetInfo[db];
LoganBerry.EnumerateEntries[dbinfo.realDB, key, start, end, proc];
};
Procedures are not locked that do not do anything of local interest.
GenerateEntries: PROC [conv: Conv ¬ NIL, db: OpenDB, key: AttributeType, start: AttributeValue ¬ NIL, end: AttributeValue ¬ NIL] RETURNS [cursor: LoganBerry.Cursor] ~ {
Permit NextEntry, EndGenerate to be fielded directly by the underlying real DB, until further notice.
dbinfo: OpenDBInfo ¬ GetInfo[db];
RETURN[LoganBerry.GenerateEntries[conv, dbinfo.realDB, key, start, end]];
};
NextEntry: PROC [conv: Conv, cursor: LoganBerry.Cursor, dir: LoganBerry.CursorDirection]
RETURNS [Entry] ~ {
RETURN[LoganBerry.NextEntry[conv, cursor, dir]];
Believe it or not, we actually have to forward this! The cursor we get from the ClassImpl is the next cursor down, and the ClassImpl has to dispatch on it.
};
EndGenerate: PROC [conv: Conv ¬ NIL, cursor: LoganBerry.Cursor] RETURNS [] ~ {
LoganBerry.EndGenerate[conv, cursor]; -- Believe it or not, we must get involved!
};
Close: PROC [conv: Conv ¬ NIL, db: OpenDB] RETURNS [] ~ {
CloseI[GetInfo[db], conv];
};
CloseI: ENTRY PROC [dbinfo: OpenDBInfo, conv: Conv] ~ {
ENABLE UNWIND => NULL;
WriteOneOff[dbinfo]; -- Write all dirty records
SymTab.Erase[dbinfo.dbCache]; -- Too dangerous to retain cached values.
LoganBerry.Close[conv, dbinfo.realDB]; -- Whether open or not.
But we never really close ourselves. It has no useful meaning.
dbinfo.isOpen ¬ FALSE;
};
Next two not completely safe, but shouldn't be doing this with stuff running anyhow.
BuildIndices: PROC [conv: Conv ¬ NIL, db: OpenDB] RETURNS [] ~ {
FlushDBCache[db];
LoganBerry.BuildIndices[conv, GetInfo[db].realDB];
};
CompactLogs: PROC [conv: Conv ¬ NIL, db: OpenDB] RETURNS [] ~ {
FlushDBCache[db];
LoganBerry.CompactLogs[conv, GetInfo[db].realDB];
};
Describe: PROC [conv: Conv ¬ NIL, db: OpenDB] RETURNS [info: LoganBerry.SchemaInfo] ~ {
dbinfo: OpenDBInfo ¬ GetInfo[db];
info ¬ LoganBerry.Describe[conv, dbinfo.realDB];
info.dbName ¬ dbinfo.dbName;
};
IsLocal: PROC [db: LoganBerry.OpenDB] RETURNS [local: BOOL ¬ TRUE] = {
local ¬ LoganBerry.IsLocal[GetInfo[db].realDB];
};
StartTransaction: PROC [db: LoganBerry.OpenDB, wantAtomic: BOOLEAN ¬ FALSE] = {
LoganBerry.StartTransaction[GetInfo[db].realDB, wantAtomic];
};
EndTransaction: PROC [db: LoganBerry.OpenDB, commit: BOOLEAN ¬ TRUE] RETURNS [committed: BOOLEAN] = {
committed ¬ EndTransactionI[GetInfo[db], commit];
};
EndTransactionI: ENTRY PROC [dbinfo: OpenDBInfo, commit: BOOLEAN] RETURNS [committed: BOOLEAN] = {
ENABLE UNWIND => NULL;
WriteOneOff[dbinfo]; -- Flush
committed ¬ LoganBerry.EndTransaction[dbinfo.realDB, commit];
};
FlushDBCache: PROC [db: LoganBerry.OpenDB ¬ LoganBerry.nullDB] = {
Causes LoganBerry to flush all cached information about the specific database, or about all databases if db=nullDB. This may be necessary if the schema has changed, for instance.
If this is done with dirty entries in the cache, we're in trouble!
dbinfo: OpenDBInfo ¬ IF db=LoganBerry.nullDB THEN NIL ELSE GetInfo[db];
FlushOpenTable[dbinfo];
IF dbinfo#NIL THEN LoganBerry.FlushDBCache[dbinfo.realDB];
Otherwise, the system will take care of the underlying DB
};
Caching
This package caches LoganBerry entries that are read and written using the above procedures. At present, it only works if only one database is used with the cache, and if the only read and write accesses that use the cache refer to the database's primary key. It maintains a single cache of up to minSustainedCacheSize+referencesPerInterval entries; once every referencesPerInterval reads, the cache is pruned to contain no more than minSustainedCacheSize entries. An initial write to an entry produces a beginning reference count of insertRefCount.
caching: BOOL ¬ FALSE; -- default is not to do it!
writeCaching: BOOL ¬ FALSE; -- default is not to do it . . . by far the advisable course!!
dateCompare: BOOL ¬ FALSE; -- default is not to do it. Should be enabled DB by DB, somehow.
DBCache: TYPE = SymTab.Ref;
For cache pruning
referencesPerInterval: INT ¬ 1500;
minSustainedCacheSize: INT ¬ 3000;
insertRefCount: INT ¬ 5;
For debugging and statistics
numPrunes: INT¬0;
numSweeps: INT¬0;
numNew: INT¬0;
CacheEntry: TYPE~REF CacheEntryRecord;
CacheEntryRecord: TYPE~RECORD[
key: LoganBerry.AttributeValue,
timeFromKey: BasicTime.GMT ¬ BasicTime.earliestGMT,
entry: LoganBerry.Entry¬NIL,
cleanEntry: LoganBerry.Entry¬NIL,
dirty: BOOL¬FALSE,
refCount: INT¬0
];
Other applications can read the cache by calling this procedure, found (if caching) registered in the appropriate place on an atom -- see below. This is not monitor-protected, so there's a bit of danger.
RemoteReadCache: PROC[realDB: LoganBerry.OpenDB, value: AttributeValue]
RETURNS[entry: Entry ¬ NIL] ~ {
dbinfo: OpenDBInfo ¬ GetCacheDBFromRealDB[realDB];
IF dbinfo=NIL THEN RETURN;
entry ¬ ReadCache[dbinfo, value, FALSE];
IF entry = notInDatabase THEN entry ¬ NIL;
};
ReadCache: PROC[dbinfo: OpenDBInfo, value: AttributeValue, reading: BOOL¬TRUE]
RETURNS[entry: Entry¬NIL] = {
IF ~reading, then current (clean) DB copy of cache value is being read for the benefit of the superclass
dbCache: DBCache ¬ dbinfo.dbCache;
cacheEntry: CacheEntry;
e: SymTab.Val;
IF ~caching THEN RETURN[NIL];
e ¬ SymTab.Fetch[dbCache, value].val;
IF e=NIL THEN RETURN;
cacheEntry ¬ NARROW[e];
IF cacheEntry=NIL THEN RETURN;
entry ¬ IF reading THEN cacheEntry.entry ELSE cacheEntry.cleanEntry;
IF entry#NIL AND entry#notInDatabase AND reading THEN
entry ¬ LoganBerryEntry.CopyEntry[entry]; -- Caller may mess with results.
cacheEntry.refCount ¬ cacheEntry.refCount.SUCC;
};
RecordCache: PROC[
dbinfo: OpenDBInfo, value: AttributeValue, entry: Entry, reading: BOOL] = {
Deal with LRU stuff here.
"reading" means the value has just been read from the DB and is being inserted into the cache. Otherwise, the value is being written into the DB from the application. The cleanEntry field will be occupied only if the value exists in the database.
dbCache: DBCache ¬ dbinfo.dbCache;
cacheEntry: CacheEntry¬NIL;
e: SymTab.Val;
IF ~caching THEN RETURN;
e ¬ SymTab.Fetch[dbCache, value].val;
IF e=NIL THEN {
cacheEntry ¬ NEW[CacheEntryRecord¬[key: value]];
[] ¬ SymTab.Store[dbCache, value, cacheEntry];
cacheEntry.timeFromKey ¬ TimeFromKey[value];
numNew ¬ numNew.SUCC;
}
ELSE cacheEntry ¬ NARROW[e];
cacheEntry.entry ¬ IF reading AND entry#notInDatabase
THEN LoganBerryEntry.CopyEntry[entry] ELSE entry;
IF reading OR ~writeCaching THEN cacheEntry.cleanEntry ¬ cacheEntry.entry
ELSE cacheEntry.dirty ¬ TRUE;
cacheEntry.refCount ¬ MAX[insertRefCount, cacheEntry.refCount.SUCC];
dbinfo.referencesThisInterval ¬ dbinfo.referencesThisInterval.SUCC;
IF dbinfo.referencesThisInterval >= referencesPerInterval THEN PruneCache[dbinfo];
};
PruneCache: PROC[dbinfo: OpenDBInfo] ~{
sweepIfBelow: INT¬0;
minNextSeen: INT¬0;
mod100: INT¬0;
cacheSize: INT;
dbCache: DBCache ¬ dbinfo.dbCache;
dbinfo.writeList ¬ NIL;
numPrunes ¬ numPrunes.SUCC;
WHILE (cacheSize¬SymTab.GetSize[dbCache])>minSustainedCacheSize DO
PruneOneEntry: SymTab.EachPairAction ~ {
cacheEntry: CacheEntry ¬ NARROW[val];
IF cacheEntry.refCount<=sweepIfBelow THEN {
WriteOneEntry[dbinfo, cacheEntry]; -- only if dirty, of course.
[]¬SymTab.Delete[dbCache, cacheEntry.key];
cacheSize¬cacheSize.PRED;
IF cacheSize<=minSustainedCacheSize THEN RETURN[TRUE];
}
ELSE minNextSeen ¬ MIN[minNextSeen, cacheEntry.refCount];
cacheEntry.refCount ¬ 0;
};
numSweeps ¬ numSweeps.SUCC;
[]¬SymTab.Pairs[dbCache, PruneOneEntry];
IF minNextSeen<=sweepIfBelow THEN EXIT; -- ?? Should note this.
sweepIfBelow ¬ minNextSeen;
ENDLOOP;
WriteDeferredList[dbinfo];
dbinfo.referencesThisInterval ¬ 0;
};
WriteOneEntry: PROC[db: OpenDBInfo, cacheEntry: CacheEntry] ~ {
IF cacheEntry=NIL OR ~cacheEntry.dirty THEN RETURN;
db.writeList ¬ CONS[cacheEntry, db.writeList];
};
WriteOneOff: INTERNAL PROC[dbinfo: OpenDBInfo] ~{
WriteOneEntryOff: SymTab.EachPairAction ~ {
cacheEntry: CacheEntry ¬ NARROW[val];
WriteOneEntry[dbinfo, cacheEntry];
};
IF ~writeCaching THEN RETURN;
dbinfo.writeList ¬ NIL;
[] ¬ SymTab.Pairs[dbinfo.dbCache, WriteOneEntryOff];
WriteDeferredList[dbinfo];
};
WriteOffLocked: ENTRY PROC[dbinfo: OpenDBInfo] ~ {
ENABLE UNWIND => NULL; WriteOneOff[dbinfo]; };
WriteCachingOff: PROC ~{
WriteOneCacheOff: SymTab.EachPairAction ~ {
dbinfo: OpenDBInfo ¬ NARROW[val];
IF dbinfo=NIL THEN RETURN;
WriteOffLocked[dbinfo];
};
[]¬SymTab.Pairs[OpenDBTable, WriteOneCacheOff];
writeCaching ¬ FALSE;
};
EraseEntry: ENTRY PROC[dbinfo: OpenDBInfo] ~ {
ENABLE UNWIND => NULL;
WriteOneOff[dbinfo];
SymTab.Erase[dbinfo.dbCache];
dbinfo.referencesThisInterval ¬ 0;
};
FlushOpenTable: PROC [dbinfo: OpenDBInfo ¬ NIL] = {
Flushes one or all databases from the OpenDBTable.
FlushOneCache: SymTab.EachPairAction ~ {
dbinfo: OpenDBInfo ¬ NARROW[val];
EraseEntry[dbinfo];
};
IF dbinfo # NIL
THEN []¬FlushOneCache[NIL, dbinfo]
ELSE []¬SymTab.Pairs[OpenDBTable, FlushOneCache];
};
WriteDeferredList: PROC[dbinfo: OpenDBInfo] ~ {
IF dbinfo.writeList=NIL THEN RETURN;
dbinfo.writeList ¬ List.Sort[dbinfo.writeList, Compare];
FOR remList: LIST OF REF ANY ¬ dbinfo.writeList, remList.rest WHILE remList#NIL DO
WriteOneEntryDeferred[dbinfo, NARROW[remList.first]];
ENDLOOP;
dbinfo.writeList ¬ NIL;
};
WriteOneEntryDeferred: PROC[dbinfo: OpenDBInfo, cacheEntry: CacheEntry] ~ {
entry: Entry;
IF cacheEntry=NIL OR ~cacheEntry.dirty THEN RETURN; -- eh?
entry ¬ cacheEntry.entry;
IF entry=NIL THEN RETURN;
LoganBerry.WriteEntry[db: dbinfo.realDB, entry: entry, replace: TRUE];
cacheEntry.cleanEntry ¬ cacheEntry.entry;
cacheEntry.dirty ¬ FALSE;
};
Compare: List.CompareProc ~{
cacheEntry1: CacheEntry ¬ NARROW[ref1];
cacheEntry2: CacheEntry ¬ NARROW[ref2];
t1: BasicTime.GMT ¬ cacheEntry1.timeFromKey;
t2: BasicTime.GMT ¬ cacheEntry2.timeFromKey;
RETURN[IF t1=t2 THEN Rope.Compare[cacheEntry1.key, cacheEntry2.key, FALSE]
ELSE IF BasicTime.Period[t1, t2]>0 THEN less ELSE greater];
};
TimeFromKey: PROC[key: ROPE] RETURNS [time: BasicTime.GMT] ~ INLINE {
index: INT;
IF ~dateCompare THEN RETURN[BasicTime.earliestGMT];
index ¬ Rope.Find[key, "@", 0];
IF index=-1 THEN RETURN[BasicTime.earliestGMT];
time ¬ Convert.TimeFromRope[Rope.Substr[key, index+1]!
Convert.Error => { time ¬ BasicTime.earliestGMT; CONTINUE;}];
};
GetCacheDBFromRealDB: PROC[realDB: LoganBerry.OpenDB]
RETURNS [dbinfo: OpenDBInfo¬NIL] ~ {
IsThisIt: SymTab.EachPairAction~{
db: OpenDBInfo ¬ NARROW[val];
IF db.realRealDB=realDB THEN { dbinfo ¬ db; RETURN[TRUE]; };
};
[]¬SymTab.Pairs[OpenDBTable, IsThisIt];
};
Handles
OpenDBTable: SymTab.Ref;
OpenDBTableSize: NAT = 2039;
2039 is a good candidate because it is prime and is large enough that collisions should be rare.
GetInfo: PROC [db: OpenDB] RETURNS [OpenDBInfo] ~ INLINE {
Unseals the database handle and ensures that it's valid.
ref: REF = RefID.Unseal[db];
IF ref = NIL THEN
ERROR LoganBerry.Error[$BadDBHandle, "NIL OpenDB handle."];
WITH ref SELECT FROM
dbinfo: OpenDBInfo => {
RETURN[dbinfo];
};
ENDCASE => ERROR LoganBerry.Error[$BadDBHandle, "Invalid OpenDB handle."];
};
GetSharedDB: PROC [dbName: ROPE] RETURNS [dbinfo: OpenDBInfo] ~ {
Remember: this routine is not called under a monitor lock. If several clients try to create an OpenDBRecord concurrently, the first one to register with the OpenDBTable wins.
Can't do full name processing, because name might be remote. Have to believe the name will be presented the same way each time.
dbinfo ¬ NARROW[SymTab.Fetch[OpenDBTable, dbName].val];
IF dbinfo = NIL THEN {
dbinfo ¬ NEW[OpenDBRecord];
dbinfo.dbName ¬ dbName;
dbinfo.isOpen ¬ FALSE;
dbinfo.dbCache ¬ SymTab.Create[];
IF NOT SymTab.Insert[OpenDBTable, dbName, dbinfo] THEN -- lost race
dbinfo ¬ NARROW[SymTab.Fetch[OpenDBTable, dbName].val];
};
};
Commander operations
LBCacheStats: Commander.CommandProc~{
dbinfo: OpenDBInfo ¬ GetSharedDB[CommanderOps.NextArgument[cmd]];
CacheStats[cmd, dbinfo]
};
CacheStats: PROC[cmd: Commander.Handle, dbinfo: OpenDBInfo] ~{
IO.PutF[cmd.out,
"pK: %g, refsThis: %g, sizeNow: %g",
atom[dbinfo.primaryKey],
int[dbinfo.referencesThisInterval],
int[SymTab.GetSize[dbinfo.dbCache]]
];
IO.PutF[cmd.out,
", prunes: %g, sweeps: %g, new: %g\n",
int[numPrunes], int[numSweeps],
int[numNew]
];
};
LBCachedDBs: Commander.CommandProc~{
LBCachedDB: SymTab.EachPairAction~{
dbinfo: OpenDBInfo ¬NARROW[val];
IO.PutF[cmd.out,
"tabName: %g, dbName: %g, dbID: %g",
rope[key],
rope[dbinfo.dbName],
card[RefID.Reseal[dbinfo]]
];
IO.PutF[cmd.out,
", realDBID: %g, open: %g\n",
card[dbinfo.realDB],
bool[dbinfo.isOpen]
];
CacheStats[cmd, dbinfo]
};
[]¬SymTab.Pairs[OpenDBTable, LBCachedDB];
};
LBParameterCommand: Commander.CommandProc~{
foundOne: BOOL¬FALSE;
GetInt: PROC[arg: Args.Arg, current: INT] RETURNS[new: INT] ~ {
IF arg.ok THEN foundOne ¬ TRUE;
new ¬ IF arg.ok THEN arg.int ELSE current;
IF arg.ok THEN IF msg=NIL THEN msg ¬ IO.PutFR1["(%g)", int[new]]
ELSE msg ¬ "";
};
GetOnOff: PROC[arg: Args.Arg, current: BOOL] RETURNS[new: BOOL] ~ {
IF arg.ok THEN foundOne ¬ TRUE;
new ¬ SELECT TRUE FROM
NOT arg.ok => current,
arg.rope.Equal["on", FALSE] => TRUE,
ENDCASE => FALSE;
IF arg.ok THEN msg ¬ IF msg#NIL THEN "" ELSE IF new THEN "(on)" ELSE "(off)"
};
cSize, cStretch, cCaching, cWriteCaching, cDateCompare: Args.Arg;
newWriteCaching: BOOL¬FALSE;
[cSize, cStretch, cCaching, cWriteCaching, cDateCompare] ¬ Args.ArgsGet[cmd, "-cacheSize%i-cacheStretch%i-caching%s-writeCaching%s-dateCompare%s" ! Args.Error => {
IO.PutRope[cmd.err, infoRope];
result ¬ $Failure;
GOTO BOMB
}];
IF cSize.ok THEN{ numNew ¬ numSweeps ¬ numPrunes ¬ 0; };
minSustainedCacheSize ¬ GetInt[cSize, minSustainedCacheSize];
referencesPerInterval ¬ GetInt[cStretch, referencesPerInterval];
dateCompare ¬ GetOnOff[cDateCompare, dateCompare];
caching ¬ GetOnOff[cCaching, caching];
newWriteCaching ¬ GetOnOff[cWriteCaching, writeCaching];
SELECT TRUE FROM
NOT cCaching.ok => NULL;
caching => Atom.PutProp[$LoganBerry, $RemoteReadCache, remoteReadCache];
ENDCASE => Atom.RemProp[$LoganBerry, $RemoteReadCache];
SELECT TRUE FROM
NOT cWriteCaching.ok => NULL;
newWriteCaching => writeCaching ¬ TRUE;
ENDCASE => WriteCachingOff;
IF NOT foundOne THEN {
cmd.out.PutF["caching: %g\nwriteCaching: %g\ncacheSize: %g\n", bool[caching], bool[newWriteCaching], int[minSustainedCacheSize]];
cmd.out.PutF["cacheStretch: %g\ndateCompare: %g\n", int[referencesPerInterval], bool[dateCompare]];
};
EXITS
BOMB => NULL;
};
infoRope: Rope.ROPE ~ "Usage: LBParam [-cacheSize <numEntries> | -cacheStretch <numEntries> | -caching (on|off) | -writeCaching (on|off) | -dateCompare (on|off)]\n";
Class registration
class: LoganBerryClass.Class;
RRC: TYPE ~ RECORD[
readCache: PROC[LoganBerry.OpenDB, AttributeValue] RETURNS [Entry]
];
remoteReadCache: REF RRC ¬ NEW[RRC ¬ [RemoteReadCache]];
Init: PROC ~ {
OpenDBTable ¬ NARROW[Atom.GetProp[$LoganBerry, $OpenCachedDBTable]];
IF OpenDBTable = NIL THEN {
OpenDBTable ¬ SymTab.Create[mod: OpenDBTableSize, case: FALSE];
Atom.PutProp[$LoganBerry, $OpenCachedDBTable, OpenDBTable];
};
LoganBerryClass.Register[name: class.name, class: class];
Commander.Register["LBParameter", LBParameterCommand];
Commander.Register["LBCachedDBs", LBCachedDBs];
Commander.Register["LBCacheStats", LBCacheStats];
};
class ¬ NEW[LoganBerryClass.ClassObject ¬ [
name: $CachedDB,
open: Open,
describe: Describe,
readEntry: ReadEntry,
enumerateEntries: EnumerateEntries,
generateEntries: GenerateEntries,
nextEntry: NextEntry,
endGenerate: EndGenerate,
writeEntry: WriteEntry,
deleteEntry: DeleteEntry,
close: Close,
buildIndices: BuildIndices,
compactLogs: CompactLogs,
isLocal: IsLocal,
startTransaction: StartTransaction,
endTransaction: EndTransaction,
flushDBCache: FlushDBCache,
classData: NIL
]];
Init[];
END.
Obsolete stuff
Commander.Register["LBCachesDump", LBCachesDump];
LBCachesDump: Commander.CommandProc~{
DumpOpenTables[cmd.out, CommanderOps.NextArgument[cmd]];
};
DumpOpenTables: PROC [out: IO.STREAM, filter: ROPE¬NIL] = {
Causes LoganBerry to flush all cached information about the specific database, or about all databases if db=nullDB. This may be necessary if the schema has changed, for instance.
dbName: ROPE ¬ NIL;
DumpOneCache: SymTab.EachPairAction ~ {
db: OpenDBInfo ¬ NARROW[val];
DumpOneEntry: SymTab.EachPairAction ~ {
cacheEntry: CacheEntry ¬ NARROW[val];
IF cacheEntry=NIL THEN RETURN[FALSE];
db.writeList ¬ CONS[cacheEntry, db.writeList];
};
DumpOneEntryDeferred: PROC[cacheEntry: CacheEntry] ~ {
IF cacheEntry=NIL THEN RETURN;
DE[cacheEntry.entry, filter, FALSE, IF cacheEntry.dirty THEN '← ELSE ':];
IF cacheEntry.cleanEntry#NIL AND cacheEntry.entry#cacheEntry.cleanEntry
THEN DE[cacheEntry.cleanEntry, filter, TRUE, ':];
};
DE: PROC[entry: LoganBerry.Entry, filter: ROPE, old: BOOL, dirtyInd: CHAR] ~ {
prefix: ROPE ¬ IF old THEN "old> " ELSE NIL;
IF filter#NIL THEN {
kVal: AttributeValue ¬ LoganBerryEntry.GetAttr[entry, db.primaryKey];
IF Rope.Find[kVal, filter, 0]=-1 THEN RETURN;
};
FOR e: LoganBerry.Entry ¬ entry, e.rest WHILE e#NIL DO
IO.PutF[out, " %g%g%g %g\n", rope[prefix], atom[e.first.type], char[dirtyInd], rope[e.first.value]];
ENDLOOP;
IF entry#NIL THEN IO.PutChar[out, '\n];
};
IF db=NIL THEN RETURN;
db.writeList ¬ NIL;
[]¬SymTab.Pairs[db.dbCache, DumpOneEntry];
IO.PutF[out, "Contents of cache for database %g\n", rope[db.dbName]];
IF db.writeList=NIL THEN RETURN;
db.writeList ¬ List.Sort[db.writeList, Compare];
FOR remList: LIST OF REF ANY ¬ db.writeList, remList.rest WHILE remList#NIL DO
DumpOneEntryDeferred[NARROW[remList.first]];
ENDLOOP;
db.writeList ¬ NIL;
};
[]¬SymTab.Pairs[OpenDBTable, DumpOneCache];
};