-- JaMDictionary.mesa
-- Written by Martin Newell, January 1979
-- Last changed by Doug Wyatt, January 9, 1981 2:15 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.

DIRECTORY
JaMDictionaryDefs,
JaMMasterDefs
USING [Frame, Object, Stack],
JaMControlDefs
USING [GetCurrentFrame, NotifyCommand, NotifyStringObject,
RegisterIntCommand],
JaMExecDefs
USING [JaMError],
JaMFnsDefs
USING [PopInteger, PopObject, PushBoolean, PushInteger, PushObject],
JaMStackDefs
USING [CountStk, Pop, Push, StackForall, Top],
JaMTypeChkDefs
USING [DescArrayType, DescBooleanType, DescCommandType, DescDictType,
DescFrameType, DescIntegerType, DescLongIntegerType,
DescRealType, DescStackType, DescStreamType, DescStringType],
JaMVMDefs
USING [AllocateWordsVM, GetCharVM, GetWordsVM, PutWordsVM],
Inline
USING [BITSHIFT, BITXOR, HighHalf, LowHalf];

JaMDictionary: PROGRAM
IMPORTS JaMControlDefs,JaMExecDefs,JaMFnsDefs,JaMStackDefs,
JaMTypeChkDefs,JaMVMDefs,Inline
EXPORTS JaMDictionaryDefs =
BEGIN OPEN JaMMasterDefs;

-- TYPES

DictDesc: TYPE = MACHINE DEPENDENT RECORD
--Dictionary descriptor, pointed to by DictType Object.Address
[maxLen,curLen: INTEGER, --in units of tuples
base: LONG POINTER,--word address of zone in VM
sizew: CARDINAL,--in units of words
sizet: CARDINAL,--in units of tuples
stepw: CARDINAL --for hash search, in units of words
];

Tuple: TYPE = RECORD[key,value: Object];

-- GLOBALS

tupleSize: CARDINAL = 2*SIZE[Object];
nullObject: NullType Object ← [lit,NullType[]];

Cache: ARRAY [0..cachesize) OF Tuple;
cachesize: CARDINAL = 64;-- Should be power of 2 for efficiency
cachemaxLen: CARDINAL = cachesize*2/3;--max # entries allowed
cachecurLen: CARDINAL;
nullTuple: Tuple = [nullObject,nullObject];



-- CREATION

Dictionary: PUBLIC PROCEDURE[maxLen: CARDINAL]
RETURNS[dict: DictType Object] =
-- Return a new dictionary for up to maxlen tuples
BEGIN
t: CARDINAL ← MAX[maxLen/2*3,1]; -- always at least 1 slot
w: CARDINAL ← t*tupleSize;
loc: LONG POINTER;
DD: DictDesc ←[
maxLen: maxLen,
curLen: 0,
base: JaMVMDefs.AllocateWordsVM[w],
sizew: w,
sizet: t,
stepw: tupleSize];
dict ← [lit,DictType[JaMVMDefs.AllocateWordsVM[SIZE[DictDesc]]]];
-- Write DictDesc to VM
JaMVMDefs.PutWordsVM[dict.Address,@DD,SIZE[DictDesc]];
-- Clear the Dictionary
FOR loc ← DD.base, loc+tupleSize UNTIL loc=DD.base+DD.sizew
DO JaMVMDefs.PutWordsVM[loc,@nullObject,SIZE[Object]];
ENDLOOP;
END;

-- ATTRIBUTES

Length: PUBLIC PROCEDURE[dict: DictType Object]
RETURNS[length: CARDINAL] =
-- Return current length of dictionary dict
BEGIN
DD: DictDesc;
JaMVMDefs.GetWordsVM[dict.Address,@DD,SIZE[DictDesc]];
RETURN[DD.curLen];
END;

MaxLength: PUBLIC PROCEDURE[dict: DictType Object]
RETURNS[length: CARDINAL] =
-- Return maximum allowable length of dictionary dict
BEGIN
DD: DictDesc;
JaMVMDefs.GetWordsVM[dict.Address,@DD,SIZE[DictDesc]];
RETURN[DD.maxLen];
END;

-- ACCESS

Known: PUBLIC PROCEDURE[dict: DictType Object, key: Object]
RETURNS[known: BOOLEAN] =
BEGIN
DD: DictDesc;
JaMVMDefs.GetWordsVM[dict.Address,@DD,SIZE[DictDesc]];
[known,] ← LookUp[DD,key,Hash[key] MOD DD.sizet];
END;

Where: PUBLIC PROCEDURE[dictstk: JaMMasterDefs.Stack, key: Object]
RETURNS[known: BOOLEAN, dict: DictType Object] =
BEGIN
hash: CARDINAL ← Hash[key];
location: LONG POINTER;
cacheloc: INTEGER;
value: Object;
Find: PROCEDURE[obj: Object] RETURNS[done: BOOLEAN] =
BEGIN
DD: DictDesc;
dict ← JaMTypeChkDefs.DescDictType[obj];
JaMVMDefs.GetWordsVM[dict.Address,@DD,SIZE[DictDesc]];
[done, location] ← LookUp[DD,key,hash MOD DD.sizet];
END;

known ← JaMStackDefs.StackForall[dictstk,Find];
IF known THEN --enter it in cache
BEGIN
JaMVMDefs.GetWordsVM[location+SIZE[Object],@value,SIZE[Object]];
[,cacheloc] ← LookUpCache[key, hash MOD cachesize];
EnterInCache[[key,value], hash, cacheloc];
END;
END;

Get: PUBLIC PROCEDURE[dict: DictType Object, key: Object]
RETURNS[value: Object] =
-- Generates undefkey
BEGIN
DD: DictDesc;
known: BOOLEAN;
location: LONG POINTER;
JaMVMDefs.GetWordsVM[dict.Address,@DD,SIZE[DictDesc]];
[known,location] ← LookUp[DD,key,Hash[key] MOD DD.sizet];
IF known
THENJaMVMDefs.GetWordsVM[location+SIZE[Object],@value,SIZE[Object]]
ELSEERROR JaMExecDefs.JaMError[undefkey,TRUE];
END;

Put: PUBLIC PROCEDURE[dict: DictType Object, key,value: Object] =
-- Generates dictfull:
BEGIN
DD: DictDesc;
hash: CARDINAL = Hash[key];
known: BOOLEAN;
location: LONG POINTER;
JaMVMDefs.GetWordsVM[dict.Address,@DD,SIZE[DictDesc]];
[known,location] ← LookUp[DD, key, hash MOD DD.sizet];
IF ~known THEN
IF location=NIL
THENERROR JaMExecDefs.JaMError[dictfull,TRUE]
ELSEBEGIN
JaMVMDefs.PutWordsVM[location,@key,SIZE[Object]];
DD.curLen ← DD.curLen+1;
JaMVMDefs.PutWordsVM[dict.Address,@DD,SIZE[DictDesc]];
END;
JaMVMDefs.PutWordsVM[location+SIZE[Object],@value,SIZE[Object]];
--just in case dict is on stack:
DeleteInCache[key, hash MOD cachesize];
END;

Define: PUBLIC PROCEDURE[dictstk: JaMMasterDefs.Stack, key,value: Object] =
-- Enters <key,value> into dictionary on top of dictstk,
-- Generates dictfull:
BEGIN
DD: DictDesc;
dict: DictType Object = JaMTypeChkDefs.DescDictType[JaMStackDefs.Top[dictstk]];
hash: CARDINAL = Hash[key];
known: BOOLEAN;
location: LONG POINTER;
cacheloc: INTEGER;
JaMVMDefs.GetWordsVM[dict.Address,@DD,SIZE[DictDesc]];
[known,location] ← LookUp[DD, key, hash MOD DD.sizet];
IF ~known THEN
IF location=NIL
THENERROR JaMExecDefs.JaMError[dictfull,TRUE]
ELSEBEGIN
JaMVMDefs.PutWordsVM[location,@key,SIZE[Object]];
DD.curLen ← DD.curLen+1;
JaMVMDefs.PutWordsVM[dict.Address,@DD,SIZE[DictDesc]];
END;
JaMVMDefs.PutWordsVM[location+SIZE[Object],@value,SIZE[Object]];
-- Update cache
[,cacheloc] ← LookUpCache[key, hash MOD cachesize];
EnterInCache[[key,value], hash, cacheloc];
END;

Load: PUBLIC PROCEDURE[dictstk: JaMMasterDefs.Stack, key: Object]
RETURNS[value: Object] =
-- Return value looked up in highest dictionary having key in dictstk
-- Generates undefkey
BEGIN
hash: CARDINAL ← Hash[key];
known: BOOLEAN;
location: LONG POINTER;
cacheloc: INTEGER;
Find: PROCEDURE[obj: Object] RETURNS[done: BOOLEAN] =
BEGIN
DD: DictDesc;
dict: DictType Object ← JaMTypeChkDefs.DescDictType[obj];
JaMVMDefs.GetWordsVM[dict.Address,@DD,SIZE[DictDesc]];
[done, location] ← LookUp[DD,key,hash MOD DD.sizet];
END;

[known,cacheloc] ← LookUpCache[key, hash MOD cachesize];
IF known THENRETURN[Cache[cacheloc].value];
-- Must search dictionary stack
IF JaMStackDefs.StackForall[dictstk,Find]
THENBEGIN
JaMVMDefs.GetWordsVM[location+SIZE[Object],@value,SIZE[Object]];
EnterInCache[[key,value], hash, cacheloc];
END
ELSEERROR JaMExecDefs.JaMError[undefkey,TRUE];
END;

Store: PUBLIC PROCEDURE[dictstk: JaMMasterDefs.Stack, key,value: Object] =
-- Enters <key,value> into highest dictionary having key in dictstk,
-- or into dict on top of dictstk
-- Generates dictfull:
BEGIN
hash: CARDINAL ← Hash[key];
location: LONG POINTER;
cacheloc: INTEGER;
Find: PROCEDURE[obj: Object] RETURNS[done: BOOLEAN] =
BEGIN
dict: DictType Object ← JaMTypeChkDefs.DescDictType[obj];
DD: DictDesc;
JaMVMDefs.GetWordsVM[dict.Address,@DD,SIZE[DictDesc]];
[done, location] ← LookUp[DD,key,hash MOD DD.sizet];
END;

IF JaMStackDefs.StackForall[dictstk,Find]
THENJaMVMDefs.PutWordsVM[location+SIZE[Object],@value,SIZE[Object]]
ELSEPut[JaMTypeChkDefs.DescDictType[JaMStackDefs.Top[dictstk]],
key,value];
-- Update cache
[,cacheloc] ← LookUpCache[key, hash MOD cachesize];
EnterInCache[[key,value], hash, cacheloc];
END;

Delete: PUBLIC PROCEDURE[dict: DictType Object, key: Object] =
-- Deletes object key from dictionary
-- Generates undefkey if object not found:
BEGIN
DD: DictDesc;
hash: CARDINAL = Hash[key];
known: BOOLEAN;
newloc,location: LONG POINTER;
k,v: Object;
JaMVMDefs.GetWordsVM[dict.Address,@DD,SIZE[DictDesc]];
[known,location] ← LookUp[DD, key, hash MOD DD.sizet];
IF ~known THEN ERROR JaMExecDefs.JaMError[undefkey,TRUE];
JaMVMDefs.PutWordsVM[location,@nullObject,SIZE[Object]];
-- Rehash entries below this one since they may be result of collisions
FORlocation ←
IF DD.stepw<DD.base+DD.sizew-location
THEN location+DD.stepw
ELSE location-(DD.sizew-DD.stepw),
IF DD.stepw<DD.base+DD.sizew-location
THEN location+DD.stepw
ELSE location-(DD.sizew-DD.stepw)
DO
JaMVMDefs.GetWordsVM[location,@k,SIZE[Object]];
IF k.Type=NullType THEN EXIT;
[,newloc] ← LookUp[DD, k, Hash[k] MOD DD.sizet];
IF newloc # location THEN
BEGIN
JaMVMDefs.PutWordsVM[newloc,@k,SIZE[Object]];
JaMVMDefs.GetWordsVM[location+SIZE[Object],@v,SIZE[Object]];
JaMVMDefs.PutWordsVM[newloc+SIZE[Object],@v,SIZE[Object]];
JaMVMDefs.PutWordsVM[location,@nullObject,SIZE[Object]];
END;
ENDLOOP;
DD.curLen ← DD.curLen-1;
JaMVMDefs.PutWordsVM[dict.Address,@DD,SIZE[DictDesc]];
-- Clear cache just in case dict on stack:
DeleteInCache[key, hash MOD cachesize];
END;

Clear: PUBLIC PROCEDURE[dict: DictType Object] =
-- Deletes all objects from dictionary dict
BEGIN
DD: DictDesc;
loc: LONG POINTER;
JaMVMDefs.GetWordsVM[dict.Address,@DD,SIZE[DictDesc]];
FOR loc ← DD.base, loc+tupleSize UNTIL loc=DD.base+DD.sizew
DO JaMVMDefs.PutWordsVM[loc,@nullObject,SIZE[Object]];
ENDLOOP;
DD.curLen ← 0;
JaMVMDefs.PutWordsVM[dict.Address,@DD,SIZE[DictDesc]];
-- just in case dict is on stack:
ClearCache[];
END;

NextTuple: PUBLIC PROCEDURE[dict: DictType Object,
oldtupleptr: LONG POINTER]
RETURNS[key,value: Object, tupleptr: LONG POINTER] =
-- Increments oldtupleptr to next non-null tuple and returns it together
-- with the key and object of the tuple
-- Initial call should have oldtupleptr=NIL
-- Returns tupleptr=NIL if no more tuples
-- Normal enumeration is not used because of way JaM control works
BEGIN
DD: DictDesc;
JaMVMDefs.GetWordsVM[dict.Address,@DD,SIZE[DictDesc]];
FORtupleptr ←IF oldtupleptr=NIL
THEN DD.base
ELSE oldtupleptr+tupleSize,
tupleptr+tupleSize
UNTILtupleptr-DD.base>=DD.sizew
DOJaMVMDefs.GetWordsVM[tupleptr,@key,SIZE[Object]];
IF key.Type#NullType
THENBEGIN
JaMVMDefs.GetWordsVM[tupleptr+SIZE[Object],@value,SIZE[Object]];
RETURN;
END;
ENDLOOP;
tupleptr ← NIL;
END;

Begin: PUBLIC PROCEDURE[dictstk: JaMMasterDefs.Stack,
dict: DictType Object] =
-- Push dictionary dict onto stack dictstk, dealing with cache
BEGIN
JaMStackDefs.Push[dict,dictstk];
ClearCache[];
END;

End: PUBLIC PROCEDURE[dictstk: JaMMasterDefs.Stack] =
-- Pop stack dictstk, dealing with cache
BEGIN
IF JaMStackDefs.CountStk[dictstk] <= 1--disallow popping .sysdict
THEN ERROR JaMExecDefs.JaMError[StkUndFlw,TRUE];
[] ← JaMStackDefs.Pop[dictstk];
ClearCache[];
END;


-- PRIVATE Procedures

Hash: PROCEDURE[key: Object] RETURNS[h: CARDINAL] =
-- hashes object key into a CARDINAL
-- Expects caller to do: (h MOD range) to allow for different ranges with same key
BEGIN
WITH k:key SELECT FROM
NullType=> h ← 0;
IntegerType=> h ← k.IntegerVal;
LongIntegerType=> h ← LowHalfLI[k.LongIntegerVal];
RealType=> h ← HighHalfRE[k.RealVal];
BooleanType=> h ← 0;
StringType=>
BEGIN
h ← 0;
FOR i: CARDINAL IN [0..k.Length) DO
h ← Inline.BITXOR[Inline.BITSHIFT[h,1],
JaMVMDefs.GetCharVM[k.Address,k.Offset,i]];
ENDLOOP;
END;
StreamType=> h ← LOOPHOLE[k.SHandle];
CommandType=> h ← LOOPHOLE[k.Command];
DictType=> h ← LowHalfLP[k.Address];
ArrayType=> h ← LowHalfLP[k.ArrayPtr];
StackType=> h ← LOOPHOLE[k.StkPtr];
FrameType=> h ← LOOPHOLE[k.FrmPtr];
ENDCASE;
END;

LookUpCache: PROCEDURE[key: Object, hash: CARDINAL]
RETURNS[known: BOOLEAN, loc: INTEGER] =
-- Looks in dictionary cache Cache for object with key, hashed to hash.
-- If found then returns [TRUE, where it is]
-- else returns [FALSE, index where it will go if
--you want to do a Put or -1 if no room]
BEGIN
k: Object;
loc ← hash;
THROUGH [0..cachesize)
DOk ← Cache[loc].key;
SELECT TRUE FROM
EqualObject[key,k] => RETURN[TRUE,loc];
k.Type=NullType => RETURN[FALSE,IF cachecurLen < cachemaxLen
THEN loc ELSE -1];
ENDCASE;
loc ← loc + 1;
IF loc=cachesize THEN loc ← 0;
ENDLOOP;
RETURN[FALSE,-1];--shouldn’t ever get here
END;

LookUp: PROCEDURE[DD: DictDesc, key: Object, hash: CARDINAL]
RETURNS[known: BOOLEAN, location: LONG POINTER] =
-- Looks in dictionary DD for object with key, hashed to hash.
-- If found then returns [TRUE, where it is]
-- else returns [FALSE,tuple address where it will go if
--you want to do a Put or NIL if no room]
BEGIN
start: LONG POINTER ← DD.base + hash*tupleSize;
location ← start;
DO
k: Object;
JaMVMDefs.GetWordsVM[location,@k,SIZE[Object]];
IF EqualObject[key,k] THEN RETURN[TRUE,location] -- found it
ELSE IF k.Type=NullType THEN RETURN[FALSE, -- found an empty slot
IF DD.curLen < DD.maxLen THEN location ELSE NIL];
location←location+DD.stepw; -- next probe
IF NOT (location-DD.base)<DD.sizew THEN
location←location-DD.sizew; -- wrap around
IF location=start THEN EXIT;
ENDLOOP;
RETURN[FALSE,NIL]; --shouldn’t ever get here
END;

EqualObject: PROCEDURE[ob1,ob2: Object]
RETURNS[equal: BOOLEAN] =
-- Checks for equality of values of objects
BEGIN
IF ob1.Type#ob2.Type THEN RETURN[FALSE];
WITH o1:ob1 SELECT FROM
NullType=> RETURN[TRUE];
IntegerType=> RETURN[o1.IntegerVal=
JaMTypeChkDefs.DescIntegerType[ob2].IntegerVal];
LongIntegerType=> RETURN[o1.LongIntegerVal=
JaMTypeChkDefs.DescLongIntegerType[ob2].LongIntegerVal];
RealType=> RETURN[o1.RealVal=
JaMTypeChkDefs.DescRealType[ob2].RealVal];
BooleanType=> RETURN[o1.BooleanVal=
JaMTypeChkDefs.DescBooleanType[ob2].BooleanVal];
StringType=> RETURN[Match[o1,
JaMTypeChkDefs.DescStringType[ob2]]];
StreamType=> RETURN[o1.SHandle=
JaMTypeChkDefs.DescStreamType[ob2].SHandle];
CommandType=> RETURN[o1.Command=
JaMTypeChkDefs.DescCommandType[ob2].Command];
DictType=> RETURN[o1.Address=
JaMTypeChkDefs.DescDictType[ob2].Address];
ArrayType=> RETURN[o1.ArrayPtr=
JaMTypeChkDefs.DescArrayType[ob2].ArrayPtr];
StackType=> RETURN[o1.StkPtr=
JaMTypeChkDefs.DescStackType[ob2].StkPtr];
FrameType=> RETURN[o1.FrmPtr=
JaMTypeChkDefs.DescFrameType[ob2].FrmPtr];
ENDCASE => RETURN[FALSE];
END;

EqOb: PROCEDURE = {
ob1: Object ← JaMFnsDefs.PopObject[];
ob2: Object ← JaMFnsDefs.PopObject[];
JaMFnsDefs.PushBoolean[EqualObject[ob1,ob2]];
};

Match: PUBLIC PROCEDURE [s1,s2: StringType Object] RETURNS[BOOLEAN] =
BEGIN
i: CARDINAL;
IF s1.Length#s2.Length THEN RETURN[FALSE];
FOR i IN [0..s1.Length) DO
IF JaMVMDefs.GetCharVM[s1.Address,s1.Offset,i]#
JaMVMDefs.GetCharVM[s2.Address,s2.Offset,i]
THEN RETURN[FALSE];
ENDLOOP;
RETURN[TRUE];
END;

EnterInCache: PROCEDURE[tuple: Tuple, hash: CARDINAL, cacheloc: INTEGER] =
BEGIN
IF cacheloc=-1
THENBEGIN
ClearCache[];
cacheloc ← hash MOD cachesize;
END;
Cache[cacheloc] ← tuple;
END;

DeleteInCache: PROCEDURE[key: Object, hash: CARDINAL] =
BEGIN
k: Object;
known: BOOLEAN;
newloc,loc: INTEGER;
[known,loc] ← LookUpCache[key, hash MOD cachesize];
IF known THEN -- delete it and rehash everything below
BEGIN
Cache[loc] ← nullTuple;
THROUGH [0..cachesize) --really no need for this line
DOloc ← loc + 1;
IF loc=cachesize THEN loc ← 0;
k ← Cache[loc].key;
IF k.Type=NullType THEN EXIT;
[,newloc] ← LookUpCache[k, Hash[k] MOD cachesize];
IF newloc # loc THEN
BEGIN
Cache[newloc] ← Cache[loc];
Cache[loc] ← nullTuple;
END;
ENDLOOP;
END;
END;

ClearCache: PROCEDURE =
BEGIN--could be speeded up using bitblt
i: CARDINAL;
FOR i IN [0..cachesize) DO Cache[i] ← nullTuple; ENDLOOP;
cachecurLen ← 0;
END;

HighHalfLP: PROCEDURE [lp: LONG POINTER] RETURNS [CARDINAL] =
INLINE BEGIN RETURN[Inline.HighHalf[lp]] END;

LowHalfLP: PROCEDURE [lp: LONG POINTER] RETURNS [CARDINAL] =
INLINE BEGIN RETURN[Inline.LowHalf[lp]] END;

HighHalfRE: PROCEDURE [r: REAL] RETURNS [CARDINAL] =
INLINE BEGIN RETURN[Inline.HighHalf[r]] END;

LowHalfLI: PROCEDURE [li: LONG INTEGER] RETURNS [CARDINAL] =
INLINE BEGIN RETURN[Inline.LowHalf[li]] END;


--*** JaM INTRINSICS ***

DictDict: PUBLIC PROCEDURE =
-- Expects opstk: (maxLength)
-- Returns opstk: (new dictionary to hold up to maxLength objects)
BEGIN OPEN JaMFnsDefs;
i:INTEGER ← PopInteger[];
IF i < 0 THEN JaMExecDefs.JaMError[RangeChk,TRUE];
PushDict[Dictionary[i]];
END;

--"DictLength" is handled in JaMAttributes

DictMaxLength: PUBLIC PROCEDURE =
-- Expects opstk: (dictionary)
-- Returns opstk: (maximum number of objects in dictionary)
BEGIN OPEN JaMFnsDefs;
PushInteger[MaxLength[PopDict[]]];
END;

DictKnown: PUBLIC PROCEDURE =
-- Expects opstk: (dictionary, key)
-- Returns opstk: (boolean)
BEGIN OPEN JaMFnsDefs;
key: Object = PopObject[];
dict: DictType Object = PopDict[];
PushBoolean[Known[dict,key]];
END;

DictWhere: PUBLIC PROCEDURE =
-- Expects opstk: (key), dictstk: a dictionary stack
-- Returns opstk: (dictionary(iff key known), boolean("known"))
--dictstk: unchanged
BEGIN OPEN JaMFnsDefs;
key: Object = PopObject[];
known: BOOLEAN;
dict: DictType Object;
[known,dict] ← Where[JaMControlDefs.GetCurrentFrame[].dictstk, key];
IF known THEN PushDict[dict];
PushBoolean[known];
END;

DictGet: PUBLIC PROCEDURE =
-- Expects opstk: (dictionary, key)
-- Returns opstk: (value looked up in dictionary)
BEGIN OPEN JaMFnsDefs;
key: Object = PopObject[];
dict: DictType Object = PopDict[];
PushObject[Get[dict,key]];
END;

DictPut: PUBLIC PROCEDURE =
-- Expects opstk: (dictionary, key, value)
-- Enters <key,value> into dictionary
-- Returns opstk: ()
-- No indication of whether an object with that key already existed.
BEGIN OPEN JaMFnsDefs;
value: Object = PopObject[];
key: Object = PopObject[];
dict: DictType Object = PopDict[];
Put[dict,key,value];
END;

DictDefine: PUBLIC PROCEDURE =
-- 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.
BEGIN OPEN JaMFnsDefs;
value: Object = PopObject[];
key: Object = PopObject[];
Define[JaMControlDefs.GetCurrentFrame[].dictstk,key,value];
END;

DictLoad: PUBLIC PROCEDURE =
-- Expects opstk: (key), dictstk: a dictionary stack
-- Returns opstk: (value looked up in highest dictionary having key in dictstk),
-- dictstk: unchanged
BEGIN OPEN JaMFnsDefs;
key: Object = PopObject[];
PushObject[Load[JaMControlDefs.GetCurrentFrame[].dictstk,key]];
END;

DictStore: PUBLIC PROCEDURE =
-- 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
BEGIN OPEN JaMFnsDefs;
value: Object = PopObject[];
key: Object = PopObject[];
Store[JaMControlDefs.GetCurrentFrame[].dictstk,key,value];
END;

DictDelete: PUBLIC PROCEDURE =
-- Expects opstk: (dictionary, key)
-- Deletes object key from dictionary
-- Returns opstk: ()
BEGIN OPEN JaMFnsDefs;
key: Object = PopObject[];
dict: DictType Object = PopDict[];
Delete[dict,key];
END;

DictClear: PUBLIC PROCEDURE =
-- Expects opstk: (dictionary)
-- Deletes all objects from dictionary
-- Returns opstk: ()
BEGIN OPEN JaMFnsDefs;
Clear[PopDict[]];
END;

DictForall: PUBLIC PROCEDURE =
-- Expects opstk: (dictionary)(object)
-- For each tuple in dictionary put (key)(value) onto opstk and execute object
-- Returns opstk: ()
BEGIN OPEN JaMFnsDefs;
mark: MarkType Object←[nolit,MarkType[]];
frm: Frame = JaMControlDefs.GetCurrentFrame[];
obj: Object = PopObject[];
dict: DictType Object = PopDict[];
-- save them on exec stack
JaMStackDefs.Push[mark,frm.execstk];
JaMStackDefs.Push[dict,frm.execstk];
JaMStackDefs.Push[obj,frm.execstk];
-- prime state
JaMStackDefs.Push[[lit,LongIntegerType[LOOPHOLE[LONG[NIL]]]],frm.execstk];
-- start it
DFAProc[];
END;


DFAProc: PROCEDURE =
BEGIN OPEN JaMFnsDefs;
frm: Frame = JaMControlDefs.GetCurrentFrame[];
tupleptr: LONG POINTER ←
LOOPHOLE[JaMTypeChkDefs.DescLongIntegerType[
JaMStackDefs.Pop[frm.execstk]].LongIntegerVal];
obj: Object = JaMStackDefs.Pop[frm.execstk];
dict: DictType Object = JaMTypeChkDefs.DescDictType[JaMStackDefs.Pop[frm.execstk]];
key,value: Object;
-- get tuple onto opstk
[key,value,tupleptr] ← NextTuple[dict,tupleptr];
IF tupleptr=NIL
THENBEGIN
[] ← JaMStackDefs.Pop[frm.execstk]; --remove mark
RETURN;
END;
JaMStackDefs.Push[key,frm.opstk];
JaMStackDefs.Push[value,frm.opstk];
-- set up stack
JaMStackDefs.Push[dict,frm.execstk];
JaMStackDefs.Push[obj,frm.execstk];
JaMStackDefs.Push[[lit,LongIntegerType[
LOOPHOLE[tupleptr,LONG INTEGER]]],
frm.execstk];
JaMStackDefs.Push[DFAProcObject,frm.execstk];
JaMStackDefs.Push[obj,frm.execstk];
-- and let it happen
END;

DictBegin: PUBLIC PROCEDURE =
-- Expects opstk: (dictionary), dictstk: ()
-- Returns opstk: (), dictstk: (dictionary)
BEGIN
frm: Frame = JaMControlDefs.GetCurrentFrame[];
Begin[frm.dictstk,PopDict[]];
END;

DictEnd: PUBLIC PROCEDURE =
-- Expects dictstk: (dictionary)
-- Returns dictstk: ()
BEGIN
End[JaMControlDefs.GetCurrentFrame[].dictstk];
END;

DictCurrent: PUBLIC PROCEDURE =
-- Expects opstk: (), dictstk: (dictionary)
-- Returns opstk: (dictionary), dictstk: (dictionary)
BEGIN
frm: Frame = JaMControlDefs.GetCurrentFrame[];
JaMStackDefs.Push[JaMStackDefs.Top[frm.dictstk],frm.opstk];
END;

--Private

PushDict: PROCEDURE[d: DictType Object] =
BEGIN
JaMStackDefs.Push[d,JaMControlDefs.GetCurrentFrame[].opstk];
END;

PopDict: PROCEDURE RETURNS[DictType Object] =
BEGIN
stack: Stack ← JaMControlDefs.GetCurrentFrame[].opstk;
ob: Object = JaMStackDefs.Pop[stack];
WITH dob:ob SELECT FROM
DictType=> BEGIN
dict: DictType Object = dob;
RETURN[dict];
END;
ENDCASE=>BEGIN
JaMStackDefs.Push[ob,stack];
JaMExecDefs.JaMError[TypeChk,TRUE];
END;
END;

-- Error string objects
undefkey: StringType Object;
RangeChk: StringType Object;
dictfull: StringType Object;
TypeChk: StringType Object;
StkUndFlw: StringType Object;
DFAProcObject: CommandType Object;

StartDictionary: PROCEDURE =
BEGIN OPEN JaMControlDefs;

DFAProcObject←RegisterIntCommand[DFAProc];

NotifyStringObject[@undefkey, ".undefkey"L];
NotifyStringObject[@RangeChk, ".rangechk"L];
NotifyStringObject[@dictfull, ".dictfull"L];
NotifyStringObject[@TypeChk, ".typechk"L];
NotifyStringObject[@StkUndFlw, ".stkundflw"L];

--Dictionary commands
NotifyCommand[".dict"L,DictDict];
NotifyCommand[".maxlength"L,DictMaxLength];
NotifyCommand[".known"L,DictKnown];
NotifyCommand[".where"L,DictWhere];
NotifyCommand[".get"L,DictGet];
NotifyCommand[".put"L,DictPut];
NotifyCommand[".def"L,DictDefine];
NotifyCommand[".load"L,DictLoad];
NotifyCommand[".store"L,DictStore];
NotifyCommand[".del"L,DictDelete];
NotifyCommand[".clrdict"L,DictClear];
NotifyCommand[".begin"L,DictBegin];
NotifyCommand[".end"L,DictEnd];
NotifyCommand[".dictforall"L,DictForall];
NotifyCommand[".curdict"L,DictCurrent];
NotifyCommand[".eqob"L,EqOb];
END;

-- initialization
StartDictionary;

END.

DKW March 28, 1980 3:41 PM
added StartDictionary

DKW April 1, 1980 3:10 PM
now uses NotifyCommand, NotifyStringObject

DKW July 14, 1980 11:14 PM
made DictDesc MACHINE DEPENDENT
uses InlineDefs.HighHalf/LowHalf instead of MACHINE CODE

DKW December 4, 1980 10:49 AM
fixed bug in Dictionary for dictionaries of size 0 or 1: ensured t>0
BITAND[hash, cachesize-1] => hash MOD cachesize
InlineDefs => Inline
added .curdict command

DKW January 9, 1981 2:14 PM
added EqOb