TJaMNameImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Written by Bill Paxton, January 1981
Bill Paxton, 14-Jan-82 14:32:53
Russ Atkinson, July 22, 1983 6:38 pm
Michael Plass, February 14, 1985 12:48:00 pm PST
Administers names
DIRECTORY
TJaMBasic USING [NameID, NameIndex, Object, Tag, Tuple],
TJaMDict USING [DD, freeHash, HashString, HashText, InsertInDict, LookUpDict, Slot],
TJaMInternal USING [Frame],
TJaMOps USING
[ACopy, Assert, Bug, Error, Install, InstallReason, limitchk, MakeName, MakeString, root, SCopy, Text],
TJaMStorage USING [Zone],
TJaMVM USING
[AllocString, GetChar, GetDict, GetElem, GetText, GetTuple, PutDict, PutElem, PutRoot, PutText],
PrincOpsUtils USING [LongCopy];
TJaMNameImpl:
MONITOR
IMPORTS TJaMDict, TJaMOps, TJaMStorage, TJaMVM, PrincOpsUtils
EXPORTS TJaMOps = {
Types and Constants
nullID: TJaMBasic.NameID = [FALSE,LAST[TJaMBasic.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: TJaMOps.Text, hash: CARDINAL, id: TJaMBasic.NameID];
initialCacheSize: CARDINAL = 67;
locNIL: CARDINAL = LAST[CARDINAL];
maxNameLength: CARDINAL = 20;
Globals
zone: UNCOUNTED ZONE = TJaMStorage.Zone[];
unknownname: name TJaMBasic.Object;
cache: NameCache ← NIL;
scratch: string TJaMBasic.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] = {
TJaMOps.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: TJaMOps.Text ← zone.NEW[StringBody[maxNameLength]];
cache[i] ← [text,TJaMDict.freeHash,nullID];
ENDLOOP;
};
FreeCache:
PROC = {
TJaMOps.Assert[cache#NIL];
FOR i:
CARDINAL
IN[0..cache.size)
DO
zone.FREE[@cache[i].text];
ENDLOOP;
zone.FREE[@cache];
};
LookUpName:
PROC[text: TJaMOps.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=TJaMDict.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 TJaMOps.Bug; -- no free slots
};
InsertName:
PROC[text: TJaMOps.Text, hash:
CARDINAL, id: TJaMBasic.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;
TJaMOps.Assert[len<=entry.text.maxlength]; entry.text.length ← len;
PrincOpsUtils.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 ← TJaMDict.freeHash; entry.id ← nullID;
entry.text.length ← 0; cache[loc] ← entry;
ENDLOOP;
cache.curlen ← 0; cache.clears ← cache.clears + 1;
};
StringToID:
PROC[string: string TJaMBasic.Object, hash:
CARDINAL]
RETURNS[TJaMBasic.NameID] = {
dict: dict TJaMBasic.Object ← TJaMOps.root.nameDict;
dd: TJaMDict.DD ← TJaMVM.GetDict[dict];
known: BOOLEAN; slot: TJaMDict.Slot;
tuple: TJaMBasic.Tuple; id: TJaMBasic.NameID;
[known,slot] ← TJaMDict.LookUpDict[@dd,hash,string];
IF known
THEN {
-- found it in the name dictionary
tuple ← TJaMVM.GetTuple[slot];
WITH ob:tuple.value
SELECT
FROM name => id ← ob.id;
ENDCASE => ERROR TJaMOps.Bug
}
ELSE {
-- not found, must create a new Name
array: array TJaMBasic.Object ← TJaMOps.root.nameArray;
index: CARDINAL ← TJaMOps.root.nameCount;
firstchar: CHARACTER ← 0C;
IF index>LAST[TJaMBasic.NameIndex] THEN ERROR TJaMOps.Error[TJaMOps.limitchk];
TJaMOps.Assert[dd.curlen=index];
string ← TJaMOps.SCopy[string]; -- copy the string
IF string.length>0 THEN firstchar ← TJaMVM.GetChar[string,0];
id ← [local: (firstchar=':), index: index];
tuple ← [string,[X,name[id]]];
TJaMDict.InsertInDict[@dd,hash,tuple,slot]; TJaMVM.PutDict[dict,dd];
IF
NOT index<array.length
THEN
array ← TJaMOps.root.nameArray ← TJaMOps.ACopy[array,array.length/2];
TJaMVM.PutElem[array,index,string];
TJaMOps.root.nameCount ← index + 1; TJaMVM.PutRoot[TJaMOps.root];
};
RETURN[id];
};
Name operations
NameToString:
PUBLIC
ENTRY
PROC[name: name TJaMBasic.Object]
RETURNS[string TJaMBasic.Object] = {
ENABLE UNWIND => NULL;
index: CARDINAL ← name.id.index;
count: CARDINAL ← TJaMOps.root.nameCount;
IF index<count
THEN {
array: array TJaMBasic.Object ← TJaMOps.root.nameArray; ob: TJaMBasic.Object;
TJaMOps.Assert[index<array.length];
ob ← TJaMVM.GetElem[array,index]; ob.tag ← name.tag;
WITH ob:ob
SELECT
FROM string =>
RETURN[ob];
ENDCASE => ERROR TJaMOps.Bug
}
ELSE ERROR TJaMOps.Error[unknownname];
};
NameLength:
PUBLIC
PROC[name: name TJaMBasic.Object]
RETURNS[
CARDINAL] = {
RETURN[NameToString[name].length]
};
StringToName:
PUBLIC
ENTRY
PROC[string: string TJaMBasic.Object, text: TJaMOps.Text ←
NIL]
RETURNS[name TJaMBasic.Object] = {
ENABLE UNWIND => NULL;
mytext: STRING ← [maxNameLength];
hash: CARDINAL; known: BOOLEAN; loc: CARDINAL; id: TJaMBasic.NameID;
IF text=
NIL
AND string.length<=maxNameLength
THEN {
text ← mytext; TJaMVM.GetText[string,text]
};
IF text=
NIL
THEN { hash ← TJaMDict.HashString[string]; known ←
FALSE }
ELSE { hash ← TJaMDict.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: TJaMOps.Text, tag: TJaMBasic.Tag ←
X]
RETURNS[name: name TJaMBasic.Object, known: BOOLEAN] = {
hash: CARDINAL ← TJaMDict.HashText[text];
loc: CARDINAL; id: TJaMBasic.NameID;
[known,loc] ← LookUpName[text,hash];
IF known
THEN id ← cache[loc].id
ELSE {
string: string TJaMBasic.Object ← scratch; -- use scratch string if possible
IF text.length<=string.length
THEN {
string.length ← text.length; TJaMVM.PutText[string,text]
}
ELSE { string ← TJaMOps.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: TJaMOps.Text]
RETURNS[
BOOLEAN] =
INLINE {
RETURN[IF a.length=b.length THEN EqualText[a,b] ELSE FALSE]
};
EqualText:
PROC[a,b: TJaMOps.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: TJaMOps.InstallReason, frame: TJaMInternal.Frame] = {
SELECT why
FROM
init => InitCache[initialCacheSize];
free => FreeCache[];
register => {
unknownname ← TJaMOps.MakeName[".unknownname"L];
scratch ← TJaMVM.AllocString[maxNameLength];
};
ENDCASE;
};
TJaMOps.Install[InstallName];
}.