DIRECTORY
JaMBasic USING [Object, Tuple],
JaMDict USING [DD, freeHash, Hash, Loc, locNIL, Slot, slotNIL],
JaMInternal USING [Cache, CacheRecord, Frame, HashSequence, TupleSequence],
JaMOps USING
[AGet, APut, Assert, Bug, Compare, Empty, Equal, Error, ForEachFrame, ForEachFrameExcept, Full, Install, InstallReason, KeyName, limitchk, MakeName, MarkLoop, nullOb, Pop, PopCardinal, PopDict, Push, PushBoolean, PushCardinal, PushInteger, RegisterExplicit, RegisterInternal, StackForAll, TopDict, typechk, UnmarkLoop],
JaMStorage USING [Zone],
JaMVM USING [AllocArray, AllocDict, GetDict, GetTuple, PutDict, PutTuple];
JaMDictImpl: PROGRAM
IMPORTS JaMDict, JaMOps, JaMStorage, JaMVM
EXPORTS JaMDict, JaMOps = {
OPEN VM:JaMVM, JaMOps, JaMDict, JaMInternal, JaMBasic;
nullTuple: Tuple = [nullOb,nullOb];
nullDict: dict Object = [L,dict[NIL]];
maxlenLimit: CARDINAL = 20000; -- maximum maxlen for a dictionary
maxattLimit: CARDINAL = 1000; -- maximum number of attached dictionaries
initCacheSize: CARDINAL = 67;
zone: UNCOUNTED ZONE = JaMStorage.Zone[];
undefkey,dictfull,attachmentcycle,notattached,dictundflw,dictovrflw: name Object;
dfacmd,afacmd: command Object;
AGetDict: PROC[array: array Object, i: CARDINAL] RETURNS[dict Object] = {
ob: Object _ AGet[array,i];
WITH ob:ob SELECT FROM dict => RETURN[ob];
ENDCASE => ERROR Bug;
};
LookUpDict: PUBLIC PROC[dd: POINTER TO READONLY DD,
hash: CARDINAL, key: Object] RETURNS[BOOLEAN,Slot] = {
slot: Slot _ dd.beg + LONG[hash MOD dd.size]*SIZE[Tuple];
IF key.type = null THEN ERROR Error[typechk]; -- better not allow this for a key
THROUGH[0..dd.size) DO
tuple: Tuple _ VM.GetTuple[slot];
IF Equal[tuple.key,key] THEN RETURN[TRUE,slot]; -- found a match
IF tuple.key.type = null THEN -- found an empty slot
RETURN[FALSE,IF dd.curlen
ERROR Bug; -- no empty slots
ENDLOOP;
dd.curlen _ dd.curlen - 1;
VM.PutDict[dict,dd]; RETURN[TRUE];
};
ClearDict: PROC[dict: dict Object] = {
dd: DD _ VM.GetDict[dict];
slot: Slot _ dd.beg;
THROUGH[0..dd.size) DO
VM.PutTuple[slot,nullTuple]; slot _ slot + SIZE[Tuple];
ENDLOOP;
Assert[slot=dd.end];
dd.curlen _ 0; VM.PutDict[dict,dd];
};
LookUpCache: PROC[cache: Cache, hash: CARDINAL, key: Object] RETURNS[BOOLEAN,Loc] = {
loc: Loc _ hash MOD cache.size;
cache.probes _ cache.probes + 1;
THROUGH[0..cache.size) DO
h: CARDINAL _ cache.hash[loc];
IF h=hash THEN {
k: Object _ cache.table[loc].key; -- compare keys
IF Equal[k,key] THEN { cache.hits _ cache.hits + 1; RETURN[TRUE,loc] };
}
ELSE IF h=freeHash THEN
RETURN[FALSE,IF cache.curlen [known, slot, dict] _ FindInDict[ob, hash, name];
ENDCASE => ERROR Error[typechk];
RETURN[known] };
IF StackForAll[frame.dictstk, Find] THEN {
EnterInCache[frame.cache,hash,VM.GetTuple[slot]]; -- put in cache, anticipating a Get
RETURN[TRUE,dict] }
ELSE RETURN[FALSE,nullDict];
};
Get: PUBLIC PROC[dict: dict Object, key: Object] RETURNS[Object] = {
known: BOOLEAN; value: Object;
[known,value] _ TryToGet[dict,key];
IF known THEN RETURN[value]
ELSE ERROR Error[undefkey];
};
TryToGet: PUBLIC PROC[dict: dict Object, key: Object] RETURNS[BOOLEAN,Object] = {
name: Object _ KeyName[key];
hash: CARDINAL _ Hash[name];
dd: DD _ VM.GetDict[dict];
known: BOOLEAN; slot: Slot;
[known,slot] _ LookUpDict[@dd,hash,name];
IF known THEN RETURN[TRUE,VM.GetTuple[slot].value]
ELSE RETURN[FALSE,nullOb];
};
Put: PUBLIC PROC[dict: dict Object, key, value: Object] = {
tuple: Tuple _ [KeyName[key],value];
hash: CARDINAL _ Hash[tuple.key];
Delete: PROC[f: Frame] = { DeleteInCache[f.cache,hash,tuple.key] };
EnterInDict[dict,hash,tuple];
ForEachFrame[Delete]; -- in case dict is on stack
};
Def: PUBLIC PROC[frame: Frame, key, value: Object] = {
dict: dict Object = TopDict[frame.dictstk];
tuple: Tuple _ [KeyName[key],value];
hash: CARDINAL _ Hash[tuple.key];
Delete: PROC[f: Frame] = { DeleteInCache[f.cache,hash,tuple.key] };
EnterInDict[dict,hash,tuple];
EnterInCache[frame.cache,hash,tuple]; -- insert in this frame's cache
ForEachFrameExcept[frame,Delete]; -- in case dict is on stack
};
Load: PUBLIC PROC[frame: Frame, key: Object] RETURNS[Object] = {
known: BOOLEAN; value: Object;
[known,value] _ TryToLoad[frame,key];
IF known THEN RETURN[value] ELSE ERROR Error[undefkey];
};
TryToLoad: PUBLIC PROC[frame: Frame, key: Object] RETURNS[BOOLEAN,Object] = {
cache: Cache _ frame.cache;
name: Object _ KeyName[key];
hash: CARDINAL _ Hash[name];
known: BOOLEAN; loc: Loc; dict: dict Object; slot: Slot;
Find: PROC[ob: Object] RETURNS[BOOLEAN] = {
WITH ob:ob SELECT FROM
dict => [known,slot,dict] _ FindInDict[ob,hash,name];
ENDCASE => ERROR Error[typechk];
RETURN[known] };
[known,loc] _ LookUpCache[cache,hash,name]; -- try the cache first
IF known THEN RETURN[TRUE,cache.table[loc].value]; -- found it! (this should be common)
known _ StackForAll[frame.dictstk, Find];
IF known THEN { tuple: Tuple _ VM.GetTuple[slot];
InsertInCache[cache,hash,tuple,loc]; RETURN[TRUE,tuple.value] }
ELSE RETURN[FALSE,nullOb];
};
Store: PUBLIC PROC[frame: Frame, key, value: Object] = {
tuple: Tuple _ [KeyName[key],value];
hash: CARDINAL _ Hash[tuple.key];
known: BOOLEAN; dict: dict Object; slot: Slot;
Find: PROC[ob: Object] RETURNS[BOOLEAN] = {
WITH ob:ob SELECT FROM
dict => [known,slot,dict] _ FindInDict[ob,hash,tuple.key];
ENDCASE => ERROR Error[typechk];
RETURN[known] };
IF StackForAll[frame.dictstk, Find] THEN VM.PutTuple[slot,tuple]
ELSE EnterInDict[TopDict[frame.dictstk],hash,tuple];
EnterInCache[frame.cache,hash,tuple]; -- update cache
};
Del: PUBLIC PROC[dict: dict Object, key: Object] = {
name: Object _ KeyName[key];
hash: CARDINAL _ Hash[name];
Delete: PROC[f: Frame] = { DeleteInCache[f.cache,hash,name] };
IF NOT DeleteInDict[dict,hash,name] THEN ERROR Error[undefkey];
ForEachFrame[Delete]; -- in case dict is on stack
};
ClrDict: PUBLIC PROC[dict: dict Object] = {
ClearDict[dict];
ClearAllCaches[]; -- in case dict is on stack
};
ClearAllCaches: PROC = {
Clear: PROC[f: Frame] = { ClearCache[f.cache] };
ForEachFrame[Clear]; -- in case dict is on stack
};
AttachDict: PUBLIC PROC[dict, adict: dict Object] = {
IF AttachmentPath[adict,dict] THEN ERROR Error[attachmentcycle]
ELSE {
oldatt,newatt: array Object;
dd: DD _ VM.GetDict[dict];
oldatt _ dd.attach;
FOR i: CARDINAL IN[0..dd.curatt) DO
IF AGetDict[oldatt,i] = adict THEN RETURN; -- already attached
ENDLOOP;
IF dd.curatt {
undefkey _ MakeName[".undefkey"L];
dictfull _ MakeName[".dictfull"L];
attachmentcycle _ MakeName[".attachmentcycle"L];
notattached _ MakeName[".notattached"L];
dictundflw _ MakeName[".dictundflw"L];
dictovrflw _ MakeName[".dictovrflw"L];
dfacmd _ RegisterInternal["@dictforall"L, DFAProc];
afacmd _ RegisterInternal["@attachedforall"L, AFAProc];
RegisterExplicit[frame, ".dict"L, JDict];
RegisterExplicit[frame, ".maxlength"L, JMaxLength];
RegisterExplicit[frame, ".known"L, JKnown];
RegisterExplicit[frame, ".where"L, JWhere];
RegisterExplicit[frame, ".get"L, JGet];
RegisterExplicit[frame, ".put"L, JPut];
RegisterExplicit[frame, ".def"L, JDef];
RegisterExplicit[frame, ".load"L, JLoad];
RegisterExplicit[frame, ".store"L, JStore];
RegisterExplicit[frame, ".del"L, JDel];
RegisterExplicit[frame, ".clrdict"L, JClrDict];
RegisterExplicit[frame, ".begin"L, JBegin];
RegisterExplicit[frame, ".end"L, JEnd];
RegisterExplicit[frame, ".dictforall"L, JDictForall];
RegisterExplicit[frame, ".curdict"L, JCurDict];
RegisterExplicit[frame, ".attachdict"L, JAttachDict];
RegisterExplicit[frame, ".detachdict"L, JDetachDict];
RegisterExplicit[frame, ".attachedforall"L, JAttachedForall];
RegisterExplicit[frame, ".detachall"L, JDetachAll];
RegisterExplicit[frame, ".clrdictcache"L, JClrDictCache];
RegisterExplicit[frame, ".dictcachestats"L, JDictCacheStats];
RegisterExplicit[frame, ".resetdictcachestats"L, JResetDictCacheStats];
};
ENDCASE;
};
Install[InstallDict];
}.
Paxton December 12, 1980 5:25 PM
added attached dictionaries
Paxton December 14, 1980 10:31 AM
added CacheHash array and automatic growth for full dictionaries
Paxton January 8, 1981 9:34 AM
add MakeName and StringForName; change Hash and Match.
Wyatt 16-Apr-81 0:16:54
Pilot conversion
use String instead of StringDefs
Wyatt 7-May-81 11:34:07
use hash field for NameStrings
Wyatt 29-Aug-81 22:32:37
rewrite
È JaMDictImpl.mesa
Original version by Martin Newell, January 1979
Bill Paxton, 29-Jan-82 15:44:13
Doug Wyatt, 21-Oct-81 17:21:22
Russ Atkinson, July 22, 1983 6:10 pm
Administers dictionaries in VM. A dictionary is a type of Object, however additional information is held in a DictDesc, which also lives in VM. A Dictionary is a set of tuples, in which both key and value are Objects (key is not necessarily a string).
Present implementation:
Dictionary is allocated as a contiguous vector of