-- 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
		THEN	JaMVMDefs.GetWordsVM[location+SIZE[Object],@value,SIZE[Object]]
		ELSE	ERROR 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
			THEN	ERROR JaMExecDefs.JaMError[dictfull,TRUE]
			ELSE	BEGIN
					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
			THEN	ERROR JaMExecDefs.JaMError[dictfull,TRUE]
			ELSE	BEGIN
					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 THEN	RETURN[Cache[cacheloc].value];
-- Must search dictionary stack
		IF JaMStackDefs.StackForall[dictstk,Find]
		THEN	BEGIN
				JaMVMDefs.GetWordsVM[location+SIZE[Object],@value,SIZE[Object]];
				EnterInCache[[key,value], hash, cacheloc];
				END
		ELSE	ERROR 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]
		THEN	JaMVMDefs.PutWordsVM[location+SIZE[Object],@value,SIZE[Object]]
		ELSE	Put[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
		FOR	location _
			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]];
		FOR	tupleptr _	IF oldtupleptr=NIL
								THEN DD.base
								ELSE oldtupleptr+tupleSize,
								tupleptr+tupleSize
						UNTIL	tupleptr-DD.base>=DD.sizew
		DO	JaMVMDefs.GetWordsVM[tupleptr,@key,SIZE[Object]];
			IF key.Type#NullType
			THEN	BEGIN
					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)
		DO	k _ 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
		THEN	BEGIN
				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
			DO	loc _ 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
		THEN	BEGIN
				[] _ 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(670)\1288b14B901b10B715b6B226b9B247b5B223b5B217b4B520b3B428b3B702b6B908b4B286b4B634b5B283b4B580b6B1404b5B451b9B863b5B211b3B300b4B858b11B678b6B878b11B1279b5B145b6B310b12B196b13B612b10B157b10B101b9B100b10B91b9B128b8B302b13B181b9B214b9B391b7B233b7B343b10B379b8B307b9B378b10B233b9B163b10B614b7B944b9B204b7B140b11B242b19B110b7B390b8B21b8B21b8B21b7B21b9B21b13B23b15B