<> <> <> <> <> < tuples, in which both key and value are Objects (key is not necessarily a string).>> <> < tuples>> <> <> 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: 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> 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] = { < into dictionary on top of dictstk,>> <> 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] = { < into highest dictionary having key in dictstk,>> <> <> 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> 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]; }; <<*** JaM INTRINSICS ***>> 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] = { <> < into dictionary>> <> <> 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] = { <> < into dictionary>> <> <> 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] = { <> < into highest dictionary having key in dictstk,>> <> <> 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> <> <> 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> 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