<> <> <> <> <> <> <> <<>> 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 = { <> 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; <> zone: UNCOUNTED ZONE = TJaMStorage.Zone[]; unknownname: name TJaMBasic.Object; cache: NameCache _ NIL; scratch: string TJaMBasic.Object; <> <> 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 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> 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 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] }; <> 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]; }.