-- JaMNameImpl.mesa
-- Written by Bill Paxton, January 1981
-- Last changed by Bill Paxton, 14-Jan-82 14:32:53

-- Administers names

DIRECTORY
  JaMBasic USING [NameID, NameIndex, Object, Tag, Tuple],
  JaMDict USING [DD, freeHash, HashString, HashText, InsertInDict, LookUpDict, Slot],
  JaMInternal USING [Frame],
  JaMOps USING [ACopy, Assert, Bug, Error, Install, InstallReason, limitchk,
    MakeName, MakeString, root, SCopy, Text],
  JaMStorage USING [Zone],
  JaMVM USING [AllocString, GetChar, GetDict, GetElem, GetText, GetTuple,
    PutDict, PutElem, PutRoot, PutText],
  Inline USING [LongCOPY];

JaMNameImpl: MONITOR
IMPORTS JaMDict, JaMOps, JaMStorage, JaMVM, Inline
EXPORTS JaMOps = {
OPEN VM:JaMVM, JaMOps, JaMDict, JaMInternal, JaMBasic;

-- Types and Constants

nullID: NameID = [FALSE,LAST[NameIndex]];

NameCache: TYPE = LONG POINTER TO NameCacheRecord;
NameCacheRecord: TYPE = RECORD [
  curlen,maxlen: CARDINAL,
  clears, probes, hits: LONG INTEGER,
  table: SEQUENCE size: CARDINAL OF Entry
  ];
Entry: TYPE = RECORD[text: Text, hash: CARDINAL, id: NameID];

initialCacheSize: CARDINAL = 67;
locNIL: CARDINAL = LAST[CARDINAL];
maxNameLength: CARDINAL = 20;

-- Globals

zone: UNCOUNTED ZONE = JaMStorage.Zone[];

unknownname: name Object;
cache: NameCache _ NIL;
scratch: string Object;
-- Also part of the monitor: root.nameDict, root.nameArray, root.nameCount

-- Private operations (should be called with the monitor locked)

InitCache: PROC[size: CARDINAL] = {
  Assert[cache=NIL];
  cache _ zone.NEW[NameCacheRecord[size] _ [curlen: 0, maxlen: (size/3)*2,
    clears: 0, probes: 0, hits: 0, table: ]];
  FOR i: CARDINAL IN[0..size) DO
    text: Text _ zone.NEW[StringBody[maxNameLength]];
    cache[i] _ [text,freeHash,nullID];
    ENDLOOP;
  };

FreeCache: PROC = {
  Assert[cache#NIL];
  FOR i: CARDINAL IN[0..cache.size) DO
    zone.FREE[@cache[i].text];
    ENDLOOP;
  zone.FREE[@cache];
  };

LookUpName: PROC[text: Text, hash: CARDINAL] RETURNS[BOOLEAN,CARDINAL] = {
  loc: CARDINAL _ hash MOD cache.size;
  cache.probes _ cache.probes + 1;
  THROUGH[0..cache.size) DO
    entry: Entry _ cache[loc];
    IF entry.hash=hash AND EQText[entry.text,text] THEN {
      cache.hits _ cache.hits + 1; RETURN[TRUE,loc] }
    ELSE IF entry.hash=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
  };

InsertName: PROC[text: Text, hash: CARDINAL, id: NameID, loc: CARDINAL] = {
  len: CARDINAL _ text.length;
  entry: Entry;
  IF loc = locNIL THEN { ClearCache[]; loc _ hash MOD cache.size };
  entry _ cache[loc]; entry.hash _ hash; entry.id _ id;
  Assert[len<=entry.text.maxlength]; entry.text.length _ len;
  Inline.LongCOPY[from: @text.text, to: @entry.text.text, nwords: (len+1)/2];
  cache[loc] _ entry; cache.curlen _ cache.curlen + 1;
  };

ClearCache: PROC = {
  FOR loc: CARDINAL IN[0..cache.size) DO
    entry: Entry _ cache[loc];
    entry.hash _ freeHash; entry.id _ nullID;
    entry.text.length _ 0; cache[loc] _ entry;
    ENDLOOP;
  cache.curlen _ 0; cache.clears _ cache.clears + 1;
  };

StringToID: PROC[string: string Object, hash: CARDINAL] RETURNS[NameID] = {
  dict: dict Object _ root.nameDict;
  dd: DD _ VM.GetDict[dict];
  known: BOOLEAN; slot: Slot;
  tuple: Tuple; id: NameID;
  [known,slot] _ LookUpDict[@dd,hash,string];
  IF known THEN { -- found it in the name dictionary
    tuple _ VM.GetTuple[slot];
    WITH ob:tuple.value SELECT FROM name => id _ ob.id;
      ENDCASE => ERROR Bug }
  ELSE { -- not found, must create a new Name
    array: array Object _ root.nameArray;
    index: CARDINAL _ root.nameCount;
    firstchar: CHARACTER _ 0C;
    IF index>LAST[NameIndex] THEN ERROR Error[limitchk];
    Assert[dd.curlen=index];
    string _ SCopy[string]; -- copy the string
    IF string.length>0 THEN firstchar _ VM.GetChar[string,0];
    id _ [local: (firstchar=':), index: index];
    tuple _ [string,[X,name[id]]];
    InsertInDict[@dd,hash,tuple,slot]; VM.PutDict[dict,dd];
    IF NOT index<array.length THEN
      array _ root.nameArray _ ACopy[array,array.length/2];
    VM.PutElem[array,index,string];
    root.nameCount _ index + 1; VM.PutRoot[root];
    };
  RETURN[id];
  };

-- Name operations

NameToString: PUBLIC ENTRY PROC[name: name Object] RETURNS[string Object] = {
  ENABLE UNWIND => NULL;
  index: CARDINAL _ name.id.index;
  count: CARDINAL _ root.nameCount;
  IF index<count THEN {
    array: array Object _ root.nameArray; ob: Object;
    Assert[index<array.length];
    ob _ VM.GetElem[array,index]; ob.tag _ name.tag;
    WITH ob:ob SELECT FROM string => RETURN[ob];
      ENDCASE => ERROR Bug }
  ELSE ERROR Error[unknownname];
  };

NameLength: PUBLIC PROC[name: name Object] RETURNS[CARDINAL] = {
  RETURN[NameToString[name].length] };

StringToName: PUBLIC ENTRY PROC[string: string Object, text: Text _ NIL]
  RETURNS[name Object] = {
  ENABLE UNWIND => NULL;
  mytext: STRING _ [maxNameLength];
  hash: CARDINAL; known: BOOLEAN; loc: CARDINAL; id: NameID;
  IF text=NIL AND string.length<=maxNameLength THEN {
    text _ mytext; VM.GetText[string,text] };
  IF text=NIL THEN { hash _ HashString[string]; known _ FALSE }
  ELSE { hash _ HashText[text]; [known,loc] _ LookUpName[text,hash] };
  IF known THEN id _ cache[loc].id -- found it in the cache
  ELSE {
    id _ StringToID[string,hash]; -- look in the dictionary, enter if necessary
    IF text#NIL THEN InsertName[text,hash,id,loc]; -- enter in cache
    };
  RETURN[[string.tag,name[id]]];
  };

CreateName: PUBLIC ENTRY PROC[text: Text, tag: Tag _ X]
  RETURNS[name: name Object, known: BOOLEAN] = {
  hash: CARDINAL _ HashText[text];
  loc: CARDINAL; id: NameID;
  [known,loc] _ LookUpName[text,hash];
  IF known THEN id _ cache[loc].id
  ELSE {
    string: string Object _ scratch; -- use scratch string if possible
    IF text.length<=string.length THEN {
      string.length _ text.length; VM.PutText[string,text] }
    ELSE { string _ MakeString[text]; text _ NIL };
    id _ StringToID[string,hash]; -- look in the dictionary, enter if necessary
    IF text#NIL THEN InsertName[text,hash,id,loc]; -- enter in cache
    };
  name _ [tag,name[id]];
  };

EQText: PROC[a,b: Text] RETURNS[BOOLEAN] = INLINE {
  RETURN[IF a.length=b.length THEN EqualText[a,b] ELSE FALSE] };

EqualText: PROC[a,b: Text] RETURNS[BOOLEAN] = {
  IF a.length#b.length THEN RETURN[FALSE];
  FOR i: CARDINAL IN[0..a.length) DO
    IF a[i]#b[i] THEN RETURN[FALSE];
    ENDLOOP;
  RETURN[TRUE] };

-- Initialization
InstallName: PROC[why: InstallReason, frame: Frame] = { SELECT why FROM
  init => InitCache[initialCacheSize];
  free => FreeCache[];
  register => {
    unknownname _ MakeName[".unknownname"L];
    scratch _ VM.AllocString[maxNameLength];
    };
  ENDCASE;
  };

Install[InstallName];

}.