-- JaMDictImpl.mesa
-- Original version by Martin Newell, January 1979
-- Last changed by Bill Paxton, February 24, 1981 10:37 AM
-- Last changed by Doug Wyatt, 21-Oct-81 17:21:22
-- 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.
DIRECTORY
JaMBasic USING [Object, Tuple, vmNIL],
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;
-- Types and constants
nullTuple: Tuple = [nullOb,nullOb];
nullDict: dict Object = [L,dict[vmNIL]];
maxlenLimit: CARDINAL = 20000; -- maximum maxlen for a dictionary
maxattLimit: CARDINAL = 1000; -- maximum number of attached dictionaries
initCacheSize: CARDINAL = 67;
-- GLOBALS
zone: UNCOUNTED ZONE = JaMStorage.Zone[];
undefkey,dictfull,attachmentcycle,notattached,dictundflw,dictovrflw: name Object;
dfacmd,afacmd: command Object;
-- Low level dictionary operations
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] = {
-- 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]
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] = {
-- 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]
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];
-- Rehash entries beyond this one since they may be result of collisions
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];
};
-- Cache operations
LookUpCache: PROC[cache: Cache, hash: CARDINAL, key: Object] RETURNS[BOOLEAN,Loc] = {
-- 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]
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];
};
-- CREATION
Dict: PUBLIC PROC[maxlen: CARDINAL] RETURNS[dict Object] = {
-- Return a new dictionary for up to maxlen tuples
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];
};
-- ATTRIBUTES
DictLength: PUBLIC PROC[dict: dict Object] RETURNS[CARDINAL] = {
-- Return current number of entries in dictionary dict
dd: DD ← VM.GetDict[dict]; RETURN[dd.curlen];
};
DictMaxLen: PUBLIC PROC[dict: dict Object] RETURNS[CARDINAL] = {
-- Return maximum allowable length of dictionary dict
dd: DD ← VM.GetDict[dict]; RETURN[dd.maxlen];
};
-- ACCESS
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] = {
-- Generates undefkey:
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] = {
-- Generates dictfull:
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] = {
-- Enters <key,value> into dictionary on top of dictstk,
-- Generates dictfull:
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] = {
-- Return value looked up in highest dictionary having key in dictstk,
-- searching attached dictionaries if necessary
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)
-- Not in cache, must search dictionary stack
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] = {
-- Enters <key,value> into highest dictionary having key in dictstk,
-- or into dict on top of dictstk if key not found.
-- Generates dictfull:
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] = {
-- Deletes object key from dictionary
-- Generates undefkey if object not found:
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] = {
-- Deletes all objects from dictionary dict
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] = {
-- attach adict to dict
-- Generates attachmentcycle
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] = {
-- returns TRUE iff there is an attachment path from dict1 to dict2
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] = {
-- detach adict from dict
-- Generates notattached
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] = {
-- Detaches all attached dictionaries
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];
};
--*** JaM INTRINSICS ***
JDict: PUBLIC PROC[frame: Frame] = {
-- Expects opstk: (maxLength)
-- Returns opstk: (new dictionary to hold up to maxLength objects)
maxlen: CARDINAL ← PopCardinal[frame.opstk];
dict: dict Object ← Dict[maxlen];
Push[frame.opstk,dict];
};
JMaxLength: PUBLIC PROC[frame: Frame] = {
-- Expects opstk: (dictionary)
-- Returns opstk: (maximum number of objects in dictionary)
dict: dict Object ← PopDict[frame.opstk];
maxlen: CARDINAL ← DictMaxLen[dict];
PushCardinal[frame.opstk,maxlen];
};
JKnown: PUBLIC PROC[frame: Frame] = {
-- Expects opstk: (dictionary, key)
-- Returns opstk: (boolean)
key: Object ← Pop[frame.opstk];
dict: dict Object ← PopDict[frame.opstk];
PushBoolean[frame.opstk,Known[dict,key]];
};
JWhere: PUBLIC PROC[frame: Frame] = {
-- Expects opstk: (key),
-- dictstk: a dictionary stack
-- Returns opstk: (dictionary(iff key known), boolean("known"))
-- dictstk: unchanged
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] = {
-- Expects opstk: (dictionary, key)
-- Returns opstk: (value looked up in dictionary)
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] = {
-- Expects opstk: (dictionary, key, value)
-- Enters <key,value> into dictionary
-- Returns opstk: ()
-- No indication of whether an object with that key already existed.
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] = {
-- 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.
value: Object ← Pop[frame.opstk];
key: Object ← Pop[frame.opstk];
Def[frame, key, value];
};
JLoad: PUBLIC PROC[frame: Frame] = {
-- Expects opstk: (key), dictstk: a dictionary stack
-- Returns opstk: (value looked up in highest dictionary having key in dictstk),
-- dictstk: unchanged
key: Object ← Pop[frame.opstk];
value: Object ← Load[frame, key];
Push[frame.opstk,value];
};
JStore: PUBLIC PROC[frame: Frame] = {
-- 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
value: Object ← Pop[frame.opstk];
key: Object ← Pop[frame.opstk];
Store[frame, key, value];
};
JDel: PUBLIC PROC[frame: Frame] = {
-- Expects opstk: (dictionary, key)
-- Deletes object key from dictionary
-- Returns opstk: ()
key: Object ← Pop[frame.opstk];
dict: dict Object ← PopDict[frame.opstk];
Del[dict, key];
};
JClrDict: PUBLIC PROC[frame: Frame] = {
-- Expects opstk: (dictionary)
-- Deletes all objects from dictionary
-- Returns opstk: ()
dict: dict Object ← PopDict[frame.opstk];
ClrDict[dict];
};
JBegin: PUBLIC PROC[frame: Frame] = {
-- Expects opstk: (dictionary), dictstk: ()
-- Returns opstk: (), dictstk: (dictionary)
dict: dict Object ← PopDict[frame.opstk];
Begin[frame,dict];
};
JEnd: PUBLIC PROC[frame: Frame] = {
-- Expects dictstk: (dictionary)
-- Returns dictstk: ()
End[frame];
};
NextTuple: PROC[dict: dict Object, old: Loc]
RETURNS[key, value: Object, new: Loc] = {
-- 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
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] = {
-- Expects opstk: (dictionary)(object)
-- For each tuple in dictionary put (key)(value) onto opstk and execute object
-- Returns opstk: ()
ob: Object ← Pop[frame.opstk];
dict: dict Object ← PopDict[frame.opstk];
-- save them on exec stack
MarkLoop[frame];
Push[frame.execstk, dict];
Push[frame.execstk, ob];
-- prime state
PushCardinal[frame.execstk, locNIL];
-- start it
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;
-- get tuple onto opstk
[key, value, newloc] ← NextTuple[dict, oldloc];
IF newloc = locNIL THEN {
[] ← PopDict[frame.execstk]; -- remove dict
UnmarkLoop[frame]; -- remove mark
RETURN };
-- set up opstk
Push[frame.opstk, key];
Push[frame.opstk, value];
-- set up execstk
Push[frame.execstk, ob];
PushInteger[frame.execstk, newloc];
Push[frame.execstk, dfacmd];
Push[frame.execstk, ob];
-- and let it happen
};
JCurDict: PUBLIC PROC[frame: Frame] = {
-- Expects opstk: (), dictstk: (dictionary)
-- Returns opstk: (dictionary), dictstk: (dictionary)
dict: dict Object ← TopDict[frame.dictstk];
Push[frame.opstk, dict];
};
JAttachDict: PUBLIC PROC[frame: Frame] = {
-- Expects opstk: (dictionary1) (dictionary2)
-- Returns opstk: ()
-- Generates attachmentcycle
dict2: dict Object ← PopDict[frame.opstk];
dict1: dict Object ← PopDict[frame.opstk];
AttachDict[dict1, dict2];
};
JDetachDict: PUBLIC PROC[frame: Frame] = {
-- Expects opstk: (dictionary1) (dictionary2)
-- detach dict2 from dict1
-- Returns opstk: ()
-- Generates notattached
dict2: dict Object ← PopDict[frame.opstk];
dict1: dict Object ← PopDict[frame.opstk];
DetachDict[dict1, dict2];
};
JAttachedForall: PUBLIC PROC[frame: Frame] = {
-- Expects opstk: (dictionary1) (object)
-- For each dictionary2 attached to dictionary1
-- put dictionary2 onto opstk and execute object
-- Returns opstk: ()
ob: Object ← Pop[frame.opstk];
dict: dict Object ← PopDict[frame.opstk];
dd: DD ← VM.GetDict[dict];
IF dd.curatt = 0 THEN RETURN;
-- save them on exec stack
MarkLoop[frame];
Push[frame.execstk,dict];
Push[frame.execstk,ob];
-- prime state
PushInteger[frame.execstk, 0];
-- start it
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];
-- set up opstk
Push[frame.opstk, adict];
-- set up execstk
Push[frame.execstk, ob];
PushInteger[frame.execstk, i + 1];
Push[frame.execstk, afacmd];
Push[frame.execstk, ob];
-- and let it happen
}
ELSE {
[] ← PopDict[frame.execstk]; -- remove dict
UnmarkLoop[frame];
};
};
JDetachAll: PUBLIC PROC[frame: Frame] = {
-- Expects opstk: (dictionary)
-- Detaches all attached dictionaries
-- Returns opstk: ()
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;
};
-- initialization
InstallDict: PROC[why: InstallReason, frame: Frame] = {
SELECT why FROM
register => {
-- Dictionary commands
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