<> <> <> DIRECTORY Atom USING [PropList, DottedPairNode], AtomPrivate USING [AtomRec], Basics USING [charsPerWord, RawWords], DebuggerSwap USING [CallDebugger], PrincOpsUtils USING [LongCopy], Rope USING [ROPE, Text, FromChar, InlineFlatten, NewText, FromRefText], RopeHash USING [FromRefText], SafeStorageOps USING [AcquireBasicLiterals], SafeStorage USING [GetPermanentZone]; AtomImpl: CEDAR MONITOR <> IMPORTS DebuggerSwap, PrincOpsUtils, Rope, RopeHash, SafeStorageOps, SafeStorage EXPORTS Atom, AtomPrivate SHARES Rope = { <> HashSize: INTEGER = 2039; <<2039 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>> <> <<>> PropList: TYPE = Atom.PropList; String: TYPE = LONG POINTER TO READONLY TEXT; WordPtr: TYPE = LONG POINTER TO Basics.RawWords; AtomRec: TYPE = AtomPrivate.AtomRec; RefAtomRec: TYPE = REF AtomRec; <> AtomDictionaryIndex: TYPE = [0..HashSize); AAtomDict: TYPE = ARRAY AtomDictionaryIndex OF RefAtomRec; ComparisonOutcome: TYPE = {less, greater, equal}; atomZone: ZONE = SafeStorage.GetPermanentZone[]; atomDictionary: REF AAtomDict = atomZone.NEW[AAtomDict _ ALL[NIL]]; NILNotAnAtom: PUBLIC ERROR = CODE; emptyAtom: ATOM; atomCount: INT _ 0; collisions: INT _ 0; <> <<>> EmptyAtom: PUBLIC PROC RETURNS [ATOM] = { RETURN [emptyAtom]; }; MakeAtom: PUBLIC ENTRY PROC [pName: Rope.ROPE] RETURNS [ATOM] = TRUSTED { ENABLE UNWIND => Crash[]; t: Rope.Text _ Rope.InlineFlatten[pName]; this, prev: RefAtomRec; hash: AtomDictionaryIndex; IF t = NIL THEN t _ ""; [this, prev, hash] _ LookUpAtom[t]; IF this = NIL THEN { <> this _ atomZone.NEW[AtomRec _ [pName: t]]; InsertAtom[atom: this, prev: prev, hash: hash]; }; RETURN [LOOPHOLE[this]]; }; UnsafeMakeAtom: PUBLIC ENTRY PROC [pName: String] RETURNS [ATOM] = TRUSTED { <> ENABLE UNWIND => Crash[]; this, prev: RefAtomRec; 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]; PrincOpsUtils.LongCopy[ from: LOOPHOLE[pName, LONG POINTER] + SIZE[TEXT[0]], nwords: (pName.length + (Basics.charsPerWord-1)) / Basics.charsPerWord, to: LOOPHOLE[rt, LONG POINTER] + SIZE[TEXT[0]] ]; this _ atomZone.NEW[AtomRec _ [pName: rt]]; InsertAtom[atom: this, prev: prev, hash: hash]; }; RETURN [LOOPHOLE[this]]; }; MakeAtomFromChar: PUBLIC PROC [char: CHAR] RETURNS [ATOM] = TRUSTED { RETURN [MakeAtom[Rope.FromChar[char]]]; }; MakeAtomFromRefText: PUBLIC ENTRY PROC [rt: REF READONLY TEXT] RETURNS [ATOM] = TRUSTED { ENABLE UNWIND => Crash[]; this, prev: RefAtomRec; hash: AtomDictionaryIndex; IF rt = NIL THEN RETURN [emptyAtom]; [this, prev, hash] _ LookUpAtom[LOOPHOLE[rt, Rope.Text]]; IF this = NIL THEN { <> this _ atomZone.NEW[AtomRec _ [pName: Rope.FromRefText[rt]]]; InsertAtom[atom: this, prev: prev, hash: hash]; }; RETURN [LOOPHOLE[this, ATOM]]; }; ATOMToAtom: PROC [atom: ATOM] RETURNS [RefAtomRec] = TRUSTED INLINE { RETURN [LOOPHOLE[atom, RefAtomRec]]; }; GetPropertyList: PUBLIC PROC [atom: ATOM] RETURNS [PropList _ NIL] = { <> IF atom # NIL THEN WITH ATOMToAtom[atom].propList 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; ATOMToAtom[atom].propList _ PutPropInternal[ATOMToAtom[atom].propList, prop, 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 ATOMToAtom[atom].propList 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 ATOMToAtom[atom].propList _ RemPropInternal[ATOMToAtom[atom].propList, 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; }; GetPName: PUBLIC PROC [atom: ATOM] RETURNS [pName: Rope.Text] = { IF atom = NIL THEN ERROR NILNotAnAtom; RETURN [ATOMToAtom[atom].pName]; }; 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[]; a: RefAtomRec = LOOPHOLE[atom]; hash: CARDINAL _ 0; SELECT TRUE FROM a = NIL => {}; a.link # NIL => RETURN [a.link]; ENDCASE => hash _ Hash[a.pName] + 1; WHILE hash < HashSize DO rtn _ LOOPHOLE[atomDictionary[hash]]; IF rtn # NIL THEN RETURN; hash _ hash + 1; ENDLOOP; }; LookUpAtom: INTERNAL PROC [s: Rope.Text] RETURNS [atom: RefAtomRec _ NIL, prev: RefAtomRec _ NIL, hash: AtomDictionaryIndex] = TRUSTED { <> len: CARDINAL = s.length; hash _ Hash[s]; FOR atom _ atomDictionary[hash], LOOPHOLE[atom.link] UNTIL atom = NIL DO r: Rope.Text = atom.pName; 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 [atom: RefAtomRec, prev: RefAtomRec, hash: AtomDictionaryIndex] = TRUSTED { IF prev = NIL THEN { atom.link _ LOOPHOLE[atomDictionary[hash]]; atomDictionary[hash] _ atom } ELSE { atom.link _ prev.link; prev.link _ LOOPHOLE[atom]; 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 = { DebuggerSwap.CallDebugger["Bad news in AtomImpl"L]; }; <> TRUSTED {SafeStorageOps.AcquireBasicLiterals[CODE[AtomRec]]}; emptyAtom _ MakeAtom[""] }.