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<dd.maxlen THEN slot ELSE slotNIL];
slot _ slot + SIZE[Tuple]; IF slot=dd.end THEN slot _ dd.beg; -- wrap around
ENDLOOP;
ERROR Bug; -- no empty slots
};

InsertInDict: PUBLIC PROC[dd: POINTER TO DD,
hash: CARDINAL, tuple: Tuple, slot: Slot] = {
IF slot=slotNIL THEN { known: BOOLEAN;
GrowDict[dd]; -- grow the dictionary, if possible
[known,slot] _ LookUpDict[dd,hash,tuple.key]; -- try again for a slot
Assert[NOT known]; -- shouldn't be there
IF slot=slotNIL THEN ERROR Error[dictfull]; -- still no room
};
VM.PutTuple[slot,tuple]; dd.curlen _ dd.curlen + 1;
};

GrowDict: PROC[olddd: POINTER TO DD] = {
oldmax: CARDINAL _ olddd.maxlen;
IF oldmax < maxlenLimit THEN {
newmax: CARDINAL _ oldmax + MIN[MAX[10,oldmax/2],maxlenLimit-oldmax];
newdict: dict Object _ Dict[newmax];
newdd: DD _ VM.GetDict[newdict];
slot: Slot _ olddd.beg;
THROUGH[0..olddd.size) DO
tuple: Tuple _ VM.GetTuple[slot];
IF tuple.key.type#null THEN {
hash: CARDINAL _ Hash[tuple.key];
known: BOOLEAN; newslot: Slot;
[known,newslot] _ LookUpDict[@newdd,hash,tuple.key];
Assert[(NOT known) AND newslot#slotNIL];
VM.PutTuple[newslot,tuple]; newdd.curlen _ newdd.curlen + 1 };
slot _ slot + SIZE[Tuple]; 
ENDLOOP;
Assert[slot=olddd.end AND newdd.curlen=olddd.curlen];
newdd.curatt _ olddd.curatt; newdd.attach _ olddd.attach;
olddd^ _ newdd };
};

FindInDict: PROC[dict: dict Object, hash: CARDINAL, key: Object]
RETURNS[known: BOOLEAN, slot: Slot, where: dict Object] = {
dd: DD _ VM.GetDict[dict];
[known,slot] _ LookUpDict[@dd,hash,key];
IF known THEN RETURN[TRUE,slot,dict] -- found it in dict
ELSE { -- check attachments
FOR i: CARDINAL IN[0..dd.curatt) DO -- try most recently attached first
adict: dict Object _ AGetDict[dd.attach,i]; aslot: Slot;
[known, aslot, where] _ FindInDict[adict,hash,key];
IF known THEN RETURN[TRUE,aslot,where];
ENDLOOP;
};
RETURN[FALSE,slot,dict];
};

EnterInDict: PROC[dict: dict Object, hash: CARDINAL, tuple: Tuple] = {
dd: DD _ VM.GetDict[dict];
known: BOOLEAN; slot: Slot;
[known,slot] _ LookUpDict[@dd,hash,tuple.key];
IF known THEN VM.PutTuple[slot,tuple]
ELSE { InsertInDict[@dd,hash,tuple,slot]; VM.PutDict[dict,dd] };
};

DeleteInDict: PROC[dict: dict Object, hash: CARDINAL, key: Object] RETURNS[BOOLEAN] = {
dd: DD _ VM.GetDict[dict];
known: BOOLEAN; slot: Slot;
[known,slot] _ LookUpDict[@dd,hash,key];
IF known THEN VM.PutTuple[slot,nullTuple] ELSE RETURN[FALSE];
THROUGH [0..dd.size) DO
tuple: Tuple; newslot: Slot;
slot _ slot + SIZE[Tuple]; IF slot=dd.end THEN slot _ dd.beg; -- wrap around
tuple _ VM.GetTuple[slot];
IF tuple.key.type=null THEN EXIT; -- empty slot
[known,newslot] _ LookUpDict[@dd,Hash[tuple.key],tuple.key];
IF known THEN Assert[newslot=slot]
ELSE { VM.PutTuple[newslot,tuple]; VM.PutTuple[slot,nullTuple] };
REPEAT FINISHED => 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<cache.maxlen THEN loc ELSE locNIL];
loc _ loc + 1; IF loc=cache.size THEN loc _ 0; -- wrap around
ENDLOOP;
ERROR Bug; -- no free slots
};

InsertInCache: PROC[cache: Cache, hash: CARDINAL, tuple: Tuple, loc: Loc] = {
IF loc = locNIL THEN { ClearCache[cache]; loc _ hash MOD cache.size };
cache.hash[loc] _ hash; cache.table[loc] _ tuple;
cache.curlen _ cache.curlen + 1;
};

EnterInCache: PROC[cache: Cache, hash: CARDINAL, tuple: Tuple] = {
known: BOOLEAN; loc: Loc;
[known,loc] _ LookUpCache[cache,hash,tuple.key];
IF known THEN cache.table[loc].value _ tuple.value
ELSE InsertInCache[cache,hash,tuple,loc];
};

DeleteInCache: PROC[cache: Cache, hash: CARDINAL, key: Object] = {
known: BOOLEAN; loc: Loc;
[known,loc] _ LookUpCache[cache,hash,key];
IF known THEN { cache.hash[loc] _ 0; cache.table[loc] _ nullTuple };
};

ClearCache: PROC[cache: Cache] = {
FOR loc: Loc IN[0..cache.size) DO cache.hash[loc] _ freeHash ENDLOOP;
cache.curlen _ 0; cache.clears _ cache.clears + 1;
};

NewCache: PUBLIC PROC RETURNS[Cache] = {
n: CARDINAL = initCacheSize;
hash: LONG POINTER TO HashSequence _ zone.NEW[HashSequence[n]];
table: LONG POINTER TO TupleSequence _ zone.NEW[TupleSequence[n]];
cache: Cache _ zone.NEW[CacheRecord _ [curlen: 0, maxlen: (n/3)*2, size: n,
hash: hash, table: table, clears: 0, probes: 0, hits: 0]];
FOR i: CARDINAL IN[0..n) DO hash[i] _ freeHash ENDLOOP;
RETURN[cache];
};

FreeCache: PUBLIC PROC[cache: Cache] = {
zone.FREE[@cache.hash];
zone.FREE[@cache.table];
zone.FREE[@cache];
};


Dict: PUBLIC PROC[maxlen: CARDINAL] RETURNS[dict Object] = {
IF maxlen<=maxlenLimit THEN {
size: CARDINAL _ maxlen + maxlen/2 + 1;
dict: dict Object _ VM.AllocDict[size];
dd: DD _ VM.GetDict[dict];
slot: Slot _ dd.beg;
THROUGH[0..size) DO
VM.PutTuple[slot,nullTuple]; slot _ slot + SIZE[Tuple];
ENDLOOP;
Assert[slot=dd.end];
dd.maxlen _ maxlen; dd.curlen _ 0;
VM.PutDict[dict,dd]; RETURN[dict] }
ELSE ERROR Error[limitchk];
};


DictLength: PUBLIC PROC[dict: dict Object] RETURNS[CARDINAL] = {
dd: DD _ VM.GetDict[dict]; RETURN[dd.curlen];
};

DictMaxLen: PUBLIC PROC[dict: dict Object] RETURNS[CARDINAL] = {
dd: DD _ VM.GetDict[dict]; RETURN[dd.maxlen];
};


Known: PUBLIC PROC[dict: dict Object, key: Object] RETURNS[BOOLEAN] = {
name: Object _ KeyName[key];
hash: CARDINAL _ Hash[name];
dd: DD _ VM.GetDict[dict];
known: BOOLEAN; [known,] _ LookUpDict[@dd,hash,name];
RETURN[known];
};

Where: PUBLIC PROC [frame: Frame, key: Object] RETURNS[BOOLEAN,dict Object] = {
name: Object _ KeyName[key];
hash: CARDINAL _ Hash[name];
known: BOOLEAN; slot: Slot; dict: dict Object;
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] };
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<oldatt.length THEN newatt _ oldatt
ELSE { max: CARDINAL _ oldatt.length;
IF NOT max<maxattLimit THEN ERROR Error[limitchk]; -- too many attachments
max _ max + MIN[MAX[8,max/2],maxattLimit-max];
dd.attach _ newatt _ VM.AllocArray[max] };
FOR i: CARDINAL DECREASING IN[0..dd.curatt) DO
APut[newatt,i+1,AGetDict[oldatt,i]]; -- move everybody up
ENDLOOP;
APut[newatt,0,adict]; -- plug in the new one
dd.curatt _ dd.curatt + 1; VM.PutDict[dict,dd]; -- update descriptor
};
ClearAllCaches[]; -- in case dict is on stack
};

AttachmentPath: PROC[dict1, dict2: dict Object] RETURNS[BOOLEAN] = {
IF dict1 = dict2 THEN RETURN[TRUE]
ELSE { dd: DD _ VM.GetDict[dict1];
FOR i: CARDINAL IN[0..dd.curatt) DO
IF AttachmentPath[AGetDict[dd.attach,i],dict2] THEN RETURN[TRUE];
ENDLOOP };
RETURN[FALSE];
};

DetachDict: PUBLIC PROC[dict, adict: dict Object] = {
dd: DD _ VM.GetDict[dict];
FOR i: CARDINAL IN[0..dd.curatt) DO
IF AGetDict[dd.attach,i]=adict THEN {
dd.curatt _ dd.curatt - 1;
FOR j: CARDINAL IN[i..dd.curatt) DO
APut[dd.attach,j,AGetDict[dd.attach,j+1]]; -- close up the gap
ENDLOOP;
VM.PutDict[dict,dd]; -- update descriptor
ClearAllCaches[]; -- in case dict is on stack
RETURN };
ENDLOOP;
ERROR Error[notattached]; -- didn't find it
};

DetachAll: PUBLIC PROC[dict: dict Object] = {
dd: DD _ VM.GetDict[dict]; dd.curatt _ 0; VM.PutDict[dict,dd];
ClearAllCaches[]; -- in case dict is on stack
};

Begin: PUBLIC PROC[frame: Frame, dict: dict Object] = {
IF Full[frame.dictstk] THEN ERROR Error[dictovrflw];
Push[frame.dictstk,dict]; ClearCache[frame.cache];
};

End: PUBLIC PROC[frame: Frame] = {
ob: Object _ Pop[frame.dictstk]; Assert[ob.type=dict];
IF Empty[frame.dictstk] THEN { -- disallow popping .sysdict
Push[frame.dictstk,ob]; ERROR Error[dictundflw] };
ClearCache[frame.cache];
};


JDict: PUBLIC PROC[frame: Frame] = {
maxlen: CARDINAL _ PopCardinal[frame.opstk];
dict: dict Object _ Dict[maxlen];
Push[frame.opstk,dict];
};

JMaxLength: PUBLIC PROC[frame: Frame] = {
dict: dict Object _ PopDict[frame.opstk];
maxlen: CARDINAL _ DictMaxLen[dict];
PushCardinal[frame.opstk,maxlen];
};

JKnown: PUBLIC PROC[frame: Frame] = {
key: Object _ Pop[frame.opstk];
dict: dict Object _ PopDict[frame.opstk];
PushBoolean[frame.opstk,Known[dict,key]];
};

JWhere: PUBLIC PROC[frame: Frame] = {
key: Object _ Pop[frame.opstk];
known: BOOLEAN;
dict: dict Object;
[known, dict] _ Where[frame,key];
IF known THEN Push[frame.opstk,dict];
PushBoolean[frame.opstk,known];
};

JGet: PUBLIC PROC[frame: Frame] = {
key: Object _ Pop[frame.opstk];
dict: dict Object _ PopDict[frame.opstk];
value: Object _ Get[dict,key];
Push[frame.opstk,value];
};

JPut: PUBLIC PROC[frame: Frame] = {
value: Object _ Pop[frame.opstk];
key: Object _ Pop[frame.opstk];
dict: dict Object _ PopDict[frame.opstk];
Put[dict, key, value];
};

JDef: PUBLIC PROC[frame: Frame] = {
value: Object _ Pop[frame.opstk];
key: Object _ Pop[frame.opstk];
Def[frame, key, value];
};

JLoad: PUBLIC PROC[frame: Frame] = {
key: Object _ Pop[frame.opstk];
value: Object _ Load[frame, key];
Push[frame.opstk,value];
};

JStore: PUBLIC PROC[frame: Frame] = {
value: Object _ Pop[frame.opstk];
key: Object _ Pop[frame.opstk];
Store[frame, key, value];
};

JDel: PUBLIC PROC[frame: Frame] = {
key: Object _ Pop[frame.opstk];
dict: dict Object _ PopDict[frame.opstk];
Del[dict, key];
};

JClrDict: PUBLIC PROC[frame: Frame] = {
dict: dict Object _ PopDict[frame.opstk];
ClrDict[dict];
};

JBegin: PUBLIC PROC[frame: Frame] = {
dict: dict Object _ PopDict[frame.opstk];
Begin[frame,dict];
};

JEnd: PUBLIC PROC[frame: Frame] = {
End[frame];
};

NextTuple: PROC[dict: dict Object, old: Loc]
RETURNS[key, value: Object, new: Loc] = {
dd: DD _ VM.GetDict[dict]; slot: Slot;
IF old=locNIL THEN { new _ 0; slot _ dd.beg }
ELSE { new _ old + 1; slot _ dd.beg + LONG[new]*SIZE[Tuple] };
WHILE new<dd.size DO
tuple: Tuple _ VM.GetTuple[slot];
IF tuple.key.type # null THEN RETURN[tuple.key,tuple.value,new];
new _ new + 1; slot _ slot + SIZE[Tuple];
ENDLOOP;
Assert[slot=dd.end]; RETURN[nullOb,nullOb,locNIL];
};

JDictForall: PUBLIC PROC[frame: Frame] = {
ob: Object _ Pop[frame.opstk];
dict: dict Object _ PopDict[frame.opstk];
MarkLoop[frame];
Push[frame.execstk, dict];
Push[frame.execstk, ob];
PushCardinal[frame.execstk, locNIL];
DFAProc[frame];
};

DFAProc: PROC[frame: Frame] = {
oldloc: Loc _ PopCardinal[frame.execstk];
ob: Object _ Pop[frame.execstk];
dict: dict Object _ TopDict[frame.execstk];
key, value: Object; newloc: Loc;
[key, value, newloc] _ NextTuple[dict, oldloc];
IF newloc = locNIL THEN {
[] _ PopDict[frame.execstk]; -- remove dict
UnmarkLoop[frame]; -- remove mark
RETURN };
Push[frame.opstk, key];
Push[frame.opstk, value];
Push[frame.execstk, ob];
PushInteger[frame.execstk, newloc];
Push[frame.execstk, dfacmd];
Push[frame.execstk, ob];
};

JCurDict: PUBLIC PROC[frame: Frame] = {
dict: dict Object _ TopDict[frame.dictstk];
Push[frame.opstk, dict];
};

JAttachDict: PUBLIC PROC[frame: Frame] = {
dict2: dict Object _ PopDict[frame.opstk];
dict1: dict Object _ PopDict[frame.opstk];
AttachDict[dict1, dict2];
};

JDetachDict: PUBLIC PROC[frame: Frame] = {
dict2: dict Object _ PopDict[frame.opstk];
dict1: dict Object _ PopDict[frame.opstk];
DetachDict[dict1, dict2];
};

JAttachedForall: PUBLIC PROC[frame: Frame] = {
ob: Object _ Pop[frame.opstk];
dict: dict Object _ PopDict[frame.opstk];
dd: DD _ VM.GetDict[dict];
IF dd.curatt = 0 THEN RETURN;
MarkLoop[frame];
Push[frame.execstk,dict];
Push[frame.execstk,ob];
PushInteger[frame.execstk, 0];
AFAProc[frame];
};

AFAProc: PROC[frame: Frame] = {
i: CARDINAL _ PopCardinal[frame.execstk];
ob: Object _ Pop[frame.execstk];
dict: dict Object _ PopDict[frame.execstk];
dd: DD _ VM.GetDict[dict];
IF i<dd.curatt THEN {
adict: dict Object _ AGetDict[dd.attach,i];
Push[frame.opstk, adict];
Push[frame.execstk, ob];
PushInteger[frame.execstk, i + 1];
Push[frame.execstk, afacmd];
Push[frame.execstk, ob];
}
ELSE {
[] _ PopDict[frame.execstk]; -- remove dict
UnmarkLoop[frame];
};
};

JDetachAll: PUBLIC PROC[frame: Frame] = {
dict: dict Object _ PopDict[frame.opstk];
DetachAll[dict];
};

JClrDictCache: PUBLIC PROC[frame: Frame] = {
ClearCache[frame.cache];
};

JDictCacheStats: PUBLIC PROC[frame: Frame] = {
cache: Cache _ frame.cache;
PushInteger[frame.opstk, cache.clears];
PushInteger[frame.opstk, cache.probes];
PushInteger[frame.opstk, cache.hits];
};

JResetDictCacheStats: PUBLIC PROC[frame: Frame] = {
cache: Cache _ frame.cache;
cache.clears _ cache.probes _ cache.hits _ 0;
};


InstallDict: PROC[why: InstallReason, frame: Frame] = {
SELECT why FROM
register => {
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 <key,value> 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 <object,object> tuples
Hash coding is used to access tuples
Dictionary stack is cached with single level cache.
Types and constants
GLOBALS
Low level dictionary operations
Looks in dictionary for object with key, hashed to hash.
If found then returns [TRUE, where it is]
else returns [FALSE, where it would go or slotNIL if no room]
Looks in dictionary for object with key, hashed to hash.
Will check in attached dictionaries also.
If found then returns [TRUE, where it is, which dict]
else returns [FALSE, where it would go or locNIL if no room, dict]
Rehash entries beyond this one since they may be result of collisions
Cache operations
Looks in dictionary cache for object with key, hashed to hash.
If found then returns [TRUE, where it is]
else returns [FALSE, where it would go or locNIL if no room]
CREATION
Return a new dictionary for up to maxlen tuples
ATTRIBUTES
Return current number of entries in dictionary dict
Return maximum allowable length of dictionary dict
ACCESS
Generates undefkey:
Generates dictfull:
Enters <key,value> into dictionary on top of dictstk,
Generates dictfull:
Return value looked up in highest dictionary having key in dictstk,
searching attached dictionaries if necessary
Not in cache, must search dictionary stack
Enters <key,value> into highest dictionary having key in dictstk,
or into dict on top of dictstk if key not found.
Generates dictfull:
Deletes object key from dictionary
Generates undefkey if object not found:
Deletes all objects from dictionary dict
attach adict to dict
Generates attachmentcycle
returns TRUE iff there is an attachment path from dict1 to dict2
detach adict from dict
Generates notattached
Detaches all attached dictionaries
*** JaM INTRINSICS ***
Expects opstk: (maxLength)
Returns opstk: (new dictionary to hold up to maxLength objects)
Expects opstk: (dictionary)
Returns opstk: (maximum number of objects in dictionary)
Expects opstk: (dictionary, key)
Returns opstk: (boolean)
Expects opstk: (key),
dictstk: a dictionary stack
Returns opstk: (dictionary(iff key known), boolean("known"))
dictstk: unchanged
Expects opstk: (dictionary, key)
Returns opstk: (value looked up in dictionary)
Expects opstk: (dictionary, key, value)
Enters <key,value> into dictionary
Returns opstk: ()
No indication of whether an object with that key already existed.
Expects opstk: (key, value), dictstk: (dictionary)
Enters <key,value> into dictionary
Returns opstk: (), dictstk: (dictionary)
No indication of whether an object with that key already existed.
Expects opstk: (key), dictstk: a dictionary stack
Returns opstk: (value looked up in highest dictionary having key in dictstk),
dictstk: unchanged
Expects opstk: (key, value), dictstk: a dictionary stack
Enters <key,value> into highest dictionary having key in dictstk,
or into dict on top of dictstk
Returns opstk: (), dictstk: unchanged
Expects opstk: (dictionary, key)
Deletes object key from dictionary
Returns opstk: ()
Expects opstk: (dictionary)
Deletes all objects from dictionary
Returns opstk: ()
Expects opstk: (dictionary), dictstk: ()
Returns opstk: (), dictstk: (dictionary)
Expects dictstk: (dictionary)
Returns dictstk: ()
Increments old to location of next non-null tuple and returns new location
together with the key and object of the tuple
Initial call should have old=locNIL
Returns new=locNIL if no more tuples
Normal enumeration is not used because of way JaM control works
Expects opstk: (dictionary)(object)
For each tuple in dictionary put (key)(value) onto opstk and execute object
Returns opstk: ()
save them on exec stack
prime state
start it
get tuple onto opstk
set up opstk
set up execstk
and let it happen
Expects opstk: (), dictstk: (dictionary)
Returns opstk: (dictionary), dictstk: (dictionary)
Expects opstk: (dictionary1) (dictionary2)
Returns opstk: ()
Generates attachmentcycle
Expects opstk: (dictionary1) (dictionary2)
detach dict2 from dict1
Returns opstk: ()
Generates notattached
Expects opstk: (dictionary1) (object)
For each dictionary2 attached to dictionary1 
put dictionary2 onto opstk and execute object
Returns opstk: ()
save them on exec stack
prime state
start it
set up opstk
set up execstk
and let it happen
Expects opstk: (dictionary)
Detaches all attached dictionaries
Returns opstk: ()
initialization
Dictionary commands
�Êg˜š
œ™Jš
œ/™/Jš
œ™Jš
œ™J™$—J˜Jš
œ‰™‰š
œ™Jš
œH™HJš
œ$™$Jš
œ3™3—J˜š
Ïk	˜	Jšœ	�œ˜Jšœ�œ�œ.˜?Jšœ�œ:˜Kšœ�˜Jš
œ¿˜¿—Jšœ�œ˜Jšœ�œ?˜JJ˜—šœ
�˜Jš�œ#˜*Jš�œ˜Jš�œ
�œ/˜6—J˜Jš
œ™˜J˜#Jšœ�
œ�œ˜&J˜Jšœ
�œ
Ïc"˜AJšœ
�œ	ž*˜HJ˜Jšœ�œ˜J˜—š
œ™J˜Jšœ�	œ
�œ˜)J˜J˜QJ˜J˜—Jš
œ™J˜šÏnœ�œ�œ�œ˜IJ˜š�œ�œ
�œ	�œ˜*Jš�œ�œ˜—J˜J˜—šŸ
œ�œ
�œ�œ
�œ
�œ
�œ
˜3Jšœ�œ�œ
�œ
˜6Jš
œ8™8Jš
œ)™)Jš
œ=™=Jšœ�œ�œ
�œ˜9Jš�œ�œ
�œž"˜Pš�œ
�˜Jšœ�œ˜!Jš	�œ�œ
�œ
�œž˜@š�œ�œ
ž˜4Jš
�œ
�œ
�œ�œ�œ
˜<—Jšœ�œ	�œ
�œž˜LJš�œ
˜—Jš�œž˜J˜J˜—šŸœ�œ
�œ�œ
�œ
�œ
˜,Jšœ�œ˜-š�œ�œ
�œ
˜&Jšœž#˜1Jšœ.ž˜EJšœ�œ	ž˜(Jš�œ�œ
�œž˜<J˜—Jš�œ1˜3J˜J˜—š
Ÿœ�œ�œ
�œ
�œ˜(Jšœ�œ˜ š�œ�œ˜Jšœ�œ�œ
�œ"˜EJ˜$Jšœ�œ�œ˜ J˜š�œ�˜Jšœ�œ˜!š�œ�œ˜Jšœ�œ˜!Jšœ�œ˜J˜4Jšœ�œ�œ˜(Jš�œ<˜>—Jšœ�œ	˜Jš�œ
˜—Jšœ�œ˜5J˜9J˜—J˜J˜—šŸ
œ�œ�œ˜@Jš�œ�œ%˜;Jš
œ8™8Jš
œ)™)Jš
œ5™5Jš
œB™BJšœ�œ�œ˜J˜(Jš	�œ�œ
�œ
�œž˜8š�œž˜š	�œ�œ
�œ�œ
ž#˜GJ˜8J˜3Jš�œ�œ
�œ
�œ˜'Jš�œ
˜—J˜—Jš�œ
�œ˜J˜J˜—šŸœ�œ�œ˜FJšœ�œ�œ˜Jšœ�œ
˜J˜.Jš�œ�œ
�œ˜%Jš�œ&�œ˜@J˜J˜—š
Ÿœ�œ�œ�œ
�œ˜WJšœ�œ�œ˜Jšœ�œ
˜J˜(Jš�œ�œ
�œ�œ
�œ
�œ˜=Jš
œE™Eš�œ�˜J˜Jšœ�œ	�œ
�œž˜LJšœ�œ˜Jš�œ�œ
�œž
˜/J˜<Jš�œ�œ˜"Jš�œ�œ�œ˜AJš�œ
�œ�œž˜/Jš�œ
˜—J˜Jš�œ�œ
�œ˜"J˜J˜—šŸ	œ�œ˜&Jšœ�œ�œ˜J˜š�œ
�˜Jš�œ)�œ˜7Jš�œ
˜—J˜Jšœ�œ˜#J˜J˜—Jš
œ™J˜š
Ÿœ�œ�œ�œ
�œ	˜UJš
œ>™>Jš
œ)™)Jš
œ<™<Jšœ�œ˜J˜ š�œ�˜Jšœ�œ˜š�œ�œ˜Jšœ"ž˜1Jš�œ�œ �œ
�œ˜GJ˜
—š�œ
�œ�˜Jš
�œ
�œ
�œ�œ�œ	˜@—Jšœ�œ�œ
ž˜=Jš�œ
˜—Jš�œž˜J˜J˜—šŸ
œ�œ�œ˜MJš�œ�œ!�œ˜FJ˜1J˜ J˜J˜—šŸœ�œ�œ˜BJšœ�œ˜J˜0Jš�œ�œ%˜2Jš�œ%˜)J˜J˜—šŸ
œ�œ�œ˜BJšœ�œ˜J˜*Jš�œ�œ7˜DJ˜J˜—šŸ
œ�œ˜"Jš�œ
�œ�œ�œ
˜EJ˜2J˜J˜—šŸœ�œ
�œ
�œ˜(Jšœ�œ˜Jš	œ�œ
�œ
�œ�œ˜?Jš	œ�œ
�œ
�œ�œ˜Bšœ�œ4˜KJ˜:—Jš
�œ�œ
�œ�œ�œ
˜7Jš�œ˜J˜J˜—šŸ	œ�œ
�œ˜(Jšœ�œ˜Jšœ�œ˜Jšœ�œ	˜J˜J˜—Jš
œ™J˜š
Ÿœ�œ
�œ	�œ�œ˜<Jš
œ/™/š�œ�œ˜Jšœ�œ˜'Jšœ�œ˜'Jšœ�œ�œ˜J˜š�œ
�˜Jš�œ)�œ˜7Jš�œ
˜—J˜J˜"Jš�œ�œ˜#—Jš�œ
�œ˜J˜J˜—Jš
œ
™
J˜š
Ÿ
œ�œ
�œ�œ
�œ˜@Jš
œ3™3Jšœ�œ�œ�œ˜-J˜J˜—š
Ÿ
œ�œ
�œ�œ
�œ˜@Jš
œ2™2Jšœ�œ�œ�œ˜-J˜J˜—Jš
œ™J˜š
Ÿœ�œ
�œ!�œ
�œ˜GJ˜Jšœ�œ˜Jšœ�œ�œ˜Jšœ�œ'˜5Jš�œ˜J˜J˜—š
Ÿœ�œ
�œ�œ
�œ˜OJ˜Jšœ�œ˜Jšœ�œ ˜.šŸœ�œ
�œ
�œ˜+š�œ�œ
�˜J˜9Jš�œ�œ˜ —Jš�œ
˜—š�œ"�œ˜*Jšœ�œž#˜UJš�œ
�œ˜—Jš�œ
�œ
�œ˜J˜J˜—šŸœ�œ
�œ!�œ˜DJš
œ™Jšœ�œ˜J˜#Jš�œ�œ
�œ˜Jš�œ
�œ˜J˜J˜—š
Ÿœ�œ
�œ!�œ
�œ˜QJ˜Jšœ�œ˜Jšœ�œ�œ˜Jšœ�œ
˜J˜)Jš
�œ�œ
�œ
�œ
�œ˜2Jš�œ
�œ
�œ	˜J˜J˜—šŸœ�œ
�œ+˜;Jš
œ™J˜$Jšœ�œ˜!JšŸœ�œ7˜CJ˜Jšœž˜1J˜J˜—šŸœ�œ
�œ&˜6Jš
œ5™5Jš
œ™J˜+J˜$Jšœ�œ˜!JšŸœ�œ7˜CJ˜Jšœ&ž˜EJšœ"ž˜=J˜J˜—šŸœ�œ
�œ�œ˜@Jšœ�œ˜J˜%Jš
�œ�œ
�œ�œ
�œ˜7J˜J˜—š
Ÿ	œ�œ
�œ�œ
�œ˜MJš
œC™CJš
œ,™,J˜J˜Jšœ�œ˜Jšœ�œ*˜8šŸœ�œ
�œ
�œ˜+š�œ�œ
�˜J˜5Jš�œ�œ˜ —Jš�œ
˜—Jšœ,ž˜BJš	�œ�œ
�œ
�œž$˜WJš
œ*™*J˜)š�œ�œ�œ˜1Jšœ%�œ
�œ˜?—Jš�œ
�œ
�œ	˜J˜J˜—šŸœ�œ
�œ&˜8Jš
œA™AJš
œ0™0Jš
œ™J˜$Jšœ�œ˜!Jšœ�œ ˜.šŸœ�œ
�œ
�œ˜+š�œ�œ
�˜J˜:Jš�œ�œ˜ —Jš�œ
˜—Jš�œ"�œ
�œ˜@Jš�œ0˜4Jšœ&ž˜5J˜J˜—šŸœ�œ
�œ$˜4Jš
œ"™"Jš
œ'™'J˜Jšœ�œ˜JšŸœ�œ2˜>Jš�œ
�œ�œ
�œ˜?Jšœž˜1J˜J˜—šŸœ�œ
�œ˜+Jš
œ(™(J˜Jšœž˜-J˜J˜—šŸœ�œ˜JšŸœ�œ%˜0Jšœž˜0J˜J˜—šŸ
œ�œ
�œ˜5Jš
œ™Jš
œ™Jš�œ�œ
�œ˜?š�œ˜J˜Jšœ�œ�œ˜J˜š�œ�œ
�œ�˜#Jš�œ�œ
�œž˜>Jš�œ
˜—Jš�œ�œ˜/š�œ�œ˜%Jš	�œ
�œ�œ
�œž˜JJšœ�œ
�œ˜.Jšœ�œ˜*—š	�œ�œ
�
œ
�œ�˜.Jšœ%ž˜9Jš�œ
˜—Jšœž˜,Jšœ�œž˜DJ˜—Jšœž˜-J˜J˜—šŸœ�œ�œ
�œ˜DJš
œ@™@Jš�œ�œ
�œ
�œ
˜"š�œ�œ�œ˜"š�œ�œ
�œ�˜#Jš�œ-�œ
�œ
�œ˜AJš�œ˜
——Jš�œ
�œ˜J˜J˜—šŸ
œ�œ
�œ˜5Jš
œ™Jš
œ™Jšœ�œ�œ˜š�œ�œ
�œ�˜#š�œ�œ˜%J˜š�œ�œ
�œ�˜#Jšœ+ž˜>Jš�œ
˜—Jš�œž˜)Jšœž˜-Jš�œ˜	—Jš�œ
˜—Jš�œž˜+J˜J˜—šŸ	œ�œ
�œ˜-Jš
œ"™"Jšœ�œ�œ�œ˜>Jšœž˜-J˜J˜—šŸœ�œ
�œ%˜7Jš�œ�œ
�œ˜4J˜2J˜J˜—šŸœ�œ
�œ˜"J˜6š�œ�œž˜;Jšœ�œ˜2—J˜J˜J˜—Jš
œ™J˜šŸœ�œ
�œ˜$Jš
œ™Jš
œ?™?Jšœ�œ˜,J˜!J˜J˜J˜—šŸ
œ�œ
�œ˜)Jš
œ™Jš
œ8™8J˜)Jšœ�œ˜$J˜!J˜J˜—šŸœ�œ
�œ˜%Jš
œ ™ Jš
œ™J˜J˜)J˜)J˜J˜—šŸœ�œ
�œ˜%Jš
œ™Jš
œ™Jš
œ<™<Jš
œ™J˜Jšœ�œ
˜J˜J˜!Jš�œ�œ˜%J˜J˜J˜—šŸœ�œ
�œ˜#Jš
œ ™ Jš
œ.™.J˜J˜)J˜J˜J˜J˜—šŸœ�œ
�œ˜#Jš
œ'™'Jš
œ"™"Jš
œ™Jš
œA™AJ˜!J˜J˜)J˜J˜J˜—šŸœ�œ
�œ˜#Jš
œ2™2Jš
œ"™"Jš
œ(™(Jš
œA™AJ˜!J˜J˜J˜J˜—šŸœ�œ
�œ˜$Jš
œ1™1Jš
œM™MJš
œ™J˜J˜!J˜J˜J˜—šŸœ�œ
�œ˜%Jš
œ8™8Jš
œA™AJš
œ™Jš
œ%™%J˜!J˜J˜J˜J˜—šŸœ�œ
�œ˜#Jš
œ ™ Jš
œ"™"Jš
œ™J˜J˜)J˜J˜J˜—šŸœ�œ
�œ˜'Jš
œ™Jš
œ#™#Jš
œ™J˜)J˜J˜J˜—šŸœ�œ
�œ˜%Jš
œ(™(Jš
œ(™(J˜)J˜J˜J˜—šŸœ�œ
�œ˜#Jš
œ™Jš
œ™J˜J˜J˜—šŸ	œ�œ˜,Jš�œ"˜)Jš
œJ™JJš
œ-™-Jš
œ#™#Jš
œ$™$Jš
œ?™?Jšœ�œ�œ˜&Jš�œ�œ˜-Jš�œ"�œ�œ
˜>š�œ
�˜Jšœ�œ˜!Jš�œ�œ
�œ˜@Jšœ�œ˜)Jš�œ
˜—Jšœ�œ˜2J˜J˜—šŸœ�œ
�œ˜*Jš
œ#™#Jš
œK™KJš
œ™J˜J˜)Jš
œ™J˜J˜J˜Jš
œ™J˜$Jš
œ™J˜J˜J˜—šŸœ�œ˜J˜)J˜ J˜+J˜ Jš
œ™J˜/š�œ�œ˜Jšœž˜+Jšœž˜!Jš�œ˜	—Jš
œ™J˜J˜Jš
œ™J˜J˜#J˜J˜Jš
œ™J˜J˜—šŸœ�œ
�œ˜'Jš
œ(™(Jš
œ2™2J˜+J˜J˜J˜—šŸœ�œ
�œ˜*Jš
œ*™*Jš
œ™Jš
œ™J˜*J˜*J˜J˜J˜—šŸœ�œ
�œ˜*Jš
œ*™*Jš
œ™Jš
œ™Jš
œ™J˜*J˜*J˜J˜J˜—šŸœ�œ
�œ˜.Jš
œ%™%Jš
œ-™-Jš
œ-™-Jš
œ™J˜J˜)Jšœ�œ�œ˜Jš�œ�œ
�œ
˜Jš
œ™J˜J˜J˜Jš
œ™J˜Jš
œ™J˜J˜J˜—šŸœ�œ˜Jšœ�œ˜)J˜ J˜+Jšœ�œ�œ˜š�œ
�œ˜J˜+Jš
œ™J˜Jš
œ™J˜J˜"J˜J˜Jš
œ™J˜
—š�œ˜Jšœž˜+J˜J˜—J˜J˜—šŸ
œ�œ
�œ˜)Jš
œ™Jš
œ"™"Jš
œ™J˜)J˜J˜J˜—šŸ
œ�œ
�œ˜,J˜J˜J˜—šŸœ�œ
�œ˜.J˜J˜'J˜'J˜%J˜J˜—šŸœ�œ
�œ˜3J˜J˜-J˜J˜—Jš
œ™J˜šŸœ�œ&˜7š�œ�˜˜
Jš
œ™J˜"J˜"J˜0J˜(J˜&J˜&J˜3J˜7J˜)J˜3J˜+J˜+J˜'J˜'J˜'J˜)J˜+J˜'J˜/J˜+J˜'J˜5J˜/J˜5J˜5J˜=J˜3J˜9J˜=J˜GJ˜—Jš�œ
˜—J˜J˜—J˜J˜J˜J˜šœ �˜"J˜J˜—šœ!�˜#J˜@J˜—šœ�˜ J˜6J˜—˜J˜J˜ J˜—˜J˜J˜—˜J˜J˜J˜——…—O{5