-- 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