<<>> <> <> <> <> <> <> <> <<>> DIRECTORY Atom USING [PropList, DottedPairNode], AtomPrivate USING [AtomRec], Basics USING [charsPerWord, CopyBytes, RawWords], Debugging USING [CallDebugger], RefText USING [BaseFromTextPointer], Rope USING [Flatten, FromChar, FromChars, NewText, ROPE, Text], RopeHash USING [FromRefText], SafeStorage USING [NewObject, GetTypeIndex, Type]; AtomImpl: CEDAR MONITOR <> IMPORTS Basics, Debugging, RefText, Rope, RopeHash, SafeStorage EXPORTS Atom, AtomPrivate SHARES Rope, SafeStorage -- for access to Rope.Text.length, SafeStorage.NewObject = { <> HashSize: INTEGER = 4093; <<4093 is prime; HashSize is about twice as great as the initial load of atoms in the system, which makes for fast average lookup (few collisions), yet is not grossly large>> <> <<>> typeOfATOMReferent: SafeStorage.Type ~ SafeStorage.GetTypeIndex["\251", NIL, NIL]; <> PropList: TYPE = Atom.PropList; String: TYPE = LONG POINTER TO READONLY TEXT; WordPtr: TYPE = LONG POINTER TO Basics.RawWords; RefAtomRec: TYPE = REF AtomPrivate.AtomRec; <> AtomDictionaryIndex: TYPE = [0..HashSize); AAtomDict: TYPE = ARRAY AtomDictionaryIndex OF ATOM; ComparisonOutcome: TYPE = {less, greater, equal}; atomDictionary: REF AAtomDict = NEW[AAtomDict ¬ ALL[NIL]]; NILNotAnAtom: PUBLIC ERROR = CODE; emptyRope: Rope.Text ~ Rope.NewText[0]; emptyAtom: ATOM; atomCount: INT ¬ 0; collisions: INT ¬ 0; <> GetTypeIndex: PROC [typeString: STRING, struct, rcmap: POINTER] RETURNS [SafeStorage.Type] ~ TRUSTED MACHINE CODE { "XR_GetTypeIndex" }; NewAtom: PROC [pName: REF] RETURNS [atom: ATOM] = { atom ¬ NARROW[SafeStorage.NewObject[nUnits: UNITS[AtomPrivate.AtomRec], type: typeOfATOMReferent]]; TRUSTED { LOOPHOLE[atom, RefAtomRec]­ ¬ [pName: NARROW[pName]] }; }; GetPName: PUBLIC PROC [atom: ATOM] RETURNS [Rope.Text] = TRUSTED { IF atom = NIL THEN ERROR NILNotAnAtom; RETURN [LOOPHOLE[atom, RefAtomRec].pName] }; GetLink: INTERNAL PROC [atom: ATOM] RETURNS [ATOM] = TRUSTED INLINE { RETURN [LOOPHOLE[atom, RefAtomRec].link] }; SetLink: INTERNAL PROC [atom: ATOM, link: ATOM] = TRUSTED { LOOPHOLE[atom, RefAtomRec].link ¬ link; }; GetPropList: INTERNAL PROC [atom: ATOM] RETURNS [REF ANY] = TRUSTED { RETURN [LOOPHOLE[atom, RefAtomRec].propList] }; SetPropList: INTERNAL PROC [atom: ATOM, propList: PropList] = TRUSTED { LOOPHOLE[atom, RefAtomRec].propList ¬ propList }; <> EmptyAtom: PUBLIC PROC RETURNS [ATOM] = { RETURN [emptyAtom]; }; MakeAtom: PUBLIC ENTRY PROC [pName: Rope.ROPE, start: INT ¬ 0, len: INT ¬ INT.LAST] RETURNS [ATOM] = { ENABLE UNWIND => Crash[]; t: Rope.Text ¬ Rope.Flatten[pName, start, len]; -- was InlineFlatten this, prev: ATOM ¬ NIL; hash: AtomDictionaryIndex ¬ 0; IF t = NIL THEN t ¬ emptyRope; [this, prev, hash] ¬ LookUpAtom[t]; IF this = NIL THEN { <> this ¬ NewAtom[pName: t]; InsertAtom[this: this, prev: prev, hash: hash]; }; RETURN [this] }; UnsafeMakeAtom: PUBLIC ENTRY UNSAFE PROC [pName: String] RETURNS [ATOM] = UNCHECKED { <> ENABLE UNWIND => Crash[]; this, prev: ATOM; hash: AtomDictionaryIndex; IF pName = NIL THEN RETURN [emptyAtom]; [this, prev, hash] ¬ LookUpAtom[LOOPHOLE[pName, Rope.Text]]; IF this = NIL THEN { <> rt: Rope.Text ¬ Rope.NewText[pName.length]; Basics.CopyBytes[ dstBase: RefText.BaseFromTextPointer[LOOPHOLE[rt]], dstStart: 0, srcBase: RefText.BaseFromTextPointer[LOOPHOLE[pName]], srcStart: 0, count: pName.length ]; this ¬ NewAtom[pName: rt]; InsertAtom[this: this, prev: prev, hash: hash]; }; RETURN [this] }; UnsafeMakeAtomFromString: PUBLIC UNSAFE PROC [pName: STRING] RETURNS [ATOM] ~ UNCHECKED { RETURN[UnsafeMakeAtom[LOOPHOLE[pName]]]; }; MakeAtomFromChar: PUBLIC PROC [char: CHAR] RETURNS [ATOM] = { RETURN [MakeAtom[Rope.FromChar[char]]]; }; MakeAtomFromChars: PUBLIC PROC [genChars: PROC [PROC [CHAR]]] RETURNS [ATOM] = { RETURN [MakeAtom[Rope.FromChars[genChars]]]; }; MakeAtomFromRefText: PUBLIC PROC [rt: REF READONLY TEXT] RETURNS [ATOM] = TRUSTED { RETURN [UnsafeMakeAtom[LOOPHOLE[rt]]] }; GetPropertyList: PUBLIC ENTRY PROC [atom: ATOM] RETURNS [PropList ¬ NIL] = { <> ENABLE UNWIND => Crash[]; IF atom # NIL THEN WITH GetPropList[atom] SELECT FROM propList: PropList => RETURN [propList]; ENDCASE; }; PutProp: PUBLIC ENTRY PROC [atom: ATOM, prop: REF, val: REF] = { ENABLE UNWIND => Crash[]; IF atom = NIL THEN RETURN WITH ERROR NILNotAnAtom; SetPropList[atom, PutPropInternal[ref: GetPropList[atom], prop: prop, val: val]]; }; PutPropOnList: PUBLIC ENTRY PROC [propList: PropList, prop: REF, val: REF] RETURNS [PropList] = { ENABLE UNWIND => Crash[]; RETURN [PutPropInternal[propList, prop, val]]; }; PutPropInternal: INTERNAL PROC [ref: REF, prop: REF, val: REF] RETURNS [PropList] = { propList: PropList ¬ NIL; lst: PropList ¬ NIL; lag: PropList ¬ NIL; WITH ref SELECT FROM pl: PropList => { lst ¬ propList ¬ pl; WHILE lst # NIL DO IF lst.first.key = prop THEN { <> lst.first.val ¬ val; RETURN [propList]; }; lag ¬ lst; lst ¬ lst.rest; ENDLOOP; }; ENDCASE => IF ref # NIL THEN Crash[]; <> lst ¬ CONS[NEW[Atom.DottedPairNode ¬ [key: prop, val: val]], NIL]; IF lag = NIL THEN RETURN [lst]; lag.rest ¬ lst; RETURN [propList]; }; GetProp: PUBLIC ENTRY PROC [atom: ATOM, prop: REF] RETURNS [REF ¬ NIL] = { ENABLE UNWIND => Crash[]; <> IF atom # NIL THEN WITH GetPropList[atom] SELECT FROM lst: PropList => WHILE lst # NIL DO IF lst.first.key = prop THEN RETURN [lst.first.val]; lst ¬ lst.rest; ENDLOOP; ENDCASE; }; GetPropFromList: PUBLIC ENTRY PROC [propList: PropList, prop: REF] RETURNS [REF ¬ NIL] = { ENABLE UNWIND => Crash[]; FOR lst: PropList ¬ propList, lst.rest UNTIL lst = NIL DO IF lst.first.key = prop THEN RETURN [lst.first.val]; ENDLOOP; }; RemProp: PUBLIC ENTRY PROC [atom: ATOM, prop: REF] = { ENABLE UNWIND => Crash[]; IF atom # NIL THEN SetPropList[atom, RemPropInternal[GetPropList[atom], prop]]; }; RemPropFromList: PUBLIC ENTRY PROC [propList: PropList, prop: REF] RETURNS [PropList] = { ENABLE UNWIND => Crash[]; RETURN [RemPropInternal[propList, prop]]; }; RemPropInternal: INTERNAL PROC [ref: REF, prop: REF] RETURNS [PropList ¬ NIL] = { WITH ref SELECT FROM propList: PropList => { lst: PropList ¬ propList; lag: PropList ¬ NIL; UNTIL lst = NIL DO rest: PropList ¬ lst.rest; IF lst.first.key = prop THEN { IF lag = NIL THEN RETURN [rest]; lag.rest ¬ rest; RETURN [propList]; }; lag ¬ lst; lst ¬ rest; ENDLOOP; RETURN [propList]; }; ENDCASE; }; MapAtoms: PUBLIC PROC [proc: PROC [atom: ATOM]] = { FOR atom: ATOM ¬ Next[NIL], Next[atom] UNTIL atom = NIL DO proc[atom]; ENDLOOP; }; FindAtom: PUBLIC PROC [proc: PROC [atom: ATOM] RETURNS [stop: BOOL]] RETURNS [ATOM--NIL if was not stopped--] = { FOR atom: ATOM ¬ Next[NIL], Next[atom] UNTIL atom = NIL DO IF proc[atom] THEN RETURN [atom]; ENDLOOP; RETURN [NIL]; }; Next: ENTRY PROC [atom: ATOM ¬ NIL] RETURNS [rtn: ATOM ¬ NIL] = TRUSTED { ENABLE UNWIND => Crash[]; hash: CARDINAL ¬ 0; SELECT TRUE FROM atom = NIL => {}; GetLink[atom] # NIL => RETURN [GetLink[atom]]; ENDCASE => hash ¬ Hash[GetPName[atom]] + 1; WHILE hash < HashSize DO rtn ¬ atomDictionary[hash]; IF rtn # NIL THEN RETURN; hash ¬ hash + 1; ENDLOOP; }; LookUpAtom: INTERNAL PROC [s: Rope.Text] RETURNS [atom: ATOM ¬ NIL, prev: ATOM ¬ NIL, hash: AtomDictionaryIndex] = TRUSTED { <> len: CARDINAL = s.length; hash ¬ Hash[s]; FOR atom ¬ atomDictionary[hash], GetLink[atom] UNTIL atom = NIL DO r: Rope.Text = GetPName[atom]; IF len = r.length THEN { excess: CARDINAL; lp: WordPtr = LOOPHOLE[s, WordPtr] + SIZE[TEXT[0]]; rp: WordPtr = LOOPHOLE[r, WordPtr] + SIZE[TEXT[0]]; FOR i: CARDINAL IN [0..len / Basics.charsPerWord) DO IF lp[i] # rp[i] THEN GO TO notEqual; ENDLOOP; excess ¬ len MOD Basics.charsPerWord; WHILE excess # 0 DO <> IF s[len-excess] # r[len-excess] THEN GO TO notEqual; excess ¬ excess - 1; ENDLOOP; RETURN; EXITS notEqual => {}; }; prev ¬ atom; ENDLOOP; }; InsertAtom: INTERNAL PROC [this: ATOM, prev: ATOM, hash: AtomDictionaryIndex] = TRUSTED { IF prev = NIL THEN { SetLink[this, atomDictionary[hash]]; atomDictionary[hash] ¬ this } ELSE { SetLink[this, GetLink[prev]]; SetLink[prev, this]; collisions ¬ collisions + 1; }; atomCount ¬ atomCount + 1; }; Hash: INTERNAL PROC [s: Rope.Text] RETURNS [AtomDictionaryIndex] = TRUSTED INLINE { RETURN [RopeHash.FromRefText[LOOPHOLE[s]] MOD HashSize]; }; Crash: PROC = { Debugging.CallDebugger["Bad news in AtomImpl"L]; }; <> TRUSTED { <> }; emptyAtom ¬ MakeAtom[emptyRope] }.