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; 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] }.  AtomImpl.mesa Copyright ำ 1985, 1986, 1988, 1991 by Xerox Corporation. All rights reserved. Russ Atkinson (RRA) September 4, 1985 7:43:31 pm PDT Carl Hauser, March 30, 1988 3:21:39 pm PST Michael Plass, February 21, 1992 5:12 pm PST Doug Wyatt, August 24, 1991 10:18 pm PDT Sun version the monitor protects the ATOM dictionary and all PropLists Constants 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 Types, Errors, Global Variables A bit of magic: this is the type string the compiler uses for referents of atoms: RRA says so! bridge from opaque ATOM to concrete as defined in AtomPrivate Allocation, accessors for ATOMs Creating Atoms here if not found. Make a new ATOM. exported to AtomPrivate come here if not found. Make a new ATOM. treat NIL as an atom for purposes of GetProp Update list element in place prop not found on property list treat NIL as an atom for purposes of GetProp returns [NIL, ptr to last atom, hash index] if not found There are some odd characters on the end of the text (only 1 for 16-bit words) START HERE SafeStorageOps.AcquireBasicLiterals[CODE[AtomRec]] -- this needs to go back in when the rest of SafeStorage comes up. ส–(cedarcode) style•NewlineDelimiter ™codešœ ™ Kšœ ฯeœC™NJ™4K™*K™,K™(—˜šะbl ™ K™——šฯk ˜ KšœŸœ˜&Kšœ Ÿœ ˜KšœŸœ%˜1Kšœ Ÿœ˜KšœŸœ˜$KšœŸœ)Ÿœ˜?Kšœ Ÿœ˜Kšœ Ÿœ!˜2—headšœ ŸœŸ˜Kšœ:™:KšŸœ8˜?KšŸœ˜KšŸœฯc8˜QKšœ˜K˜—™ šœ Ÿœ˜Kšœช™ช—K˜—™K™šœHŸœŸœ˜RK™^K˜—Kšœ ŸœŸœ ˜Kš œŸœŸœŸœŸœŸœŸœ˜-Kš œ ŸœŸœŸœŸœ˜0K˜šœ ŸœŸœ˜+Kš =™=—K˜KšœŸœ˜*Kš œ ŸœŸœŸœŸœ˜4KšœŸœ˜1K˜Kš œŸœ Ÿœ ŸœŸœ˜:K˜KšœŸœŸœŸœ˜"K˜Kšœ'˜'Kšœ Ÿœ˜Kšœ Ÿœ˜Kšœ Ÿœ˜K˜—™šฯn œŸœŸœŸœŸœŸœŸœŸœ˜sK˜K˜K˜—š กœŸœ ŸœŸœŸœ˜3KšœŸœŸœ2˜cKšŸœŸœŸœ ˜AK˜K˜—š กœŸ œŸœŸœŸœ˜BKšŸœŸœŸœŸœ˜&KšŸœŸœ˜)Kšœ˜K˜—šกœŸœŸœŸœŸœŸœŸœŸœ˜EKšŸœŸœ˜(Kšœ˜K˜—š กœŸœŸœŸœŸœŸœ˜;KšŸœ˜'Kšœ˜K˜—šก œŸœŸœŸœŸœŸœŸœŸœ˜EKšŸœŸœ˜,Kšœ˜K˜—š ก œŸœŸœŸœŸœ˜GKšŸœ&˜.Kšœ˜——™š ก œŸœŸœŸœŸœ˜)KšŸœ ˜Kšœ˜—K˜šกœŸœŸœŸœŸœ Ÿœ ŸœŸœŸœŸœŸœ˜fKšŸœŸœ ˜Kšœ0 ˜DKšœ ŸœŸœ˜Kšœ˜K˜KšŸœŸœŸœ˜Kšœ#˜#šŸœŸœŸœ˜Kšœ#™#Kšœ˜Kšœ/˜/K˜—KšŸœ˜ Kšœ˜—K˜šกœŸœŸœŸ œŸœŸœŸ œ˜WKšœ™KšŸœŸœ ˜Kšœ Ÿœ˜Kšœ˜K˜KšŸœ ŸœŸœŸœ ˜'Kšœ Ÿœ˜<šŸœŸœŸœ˜Kšœ(™(Kšœ+˜+•StartOfExpansion[]šœ˜Kšœ%Ÿœ˜@Kšœ%Ÿœ˜CKšœ˜Kšœ˜—Kšœ˜Kšœ/˜/K˜—KšŸœ˜ Kšœ˜—K˜š กœŸœ ŸœŸœŸœŸ œ˜YKšŸœŸœ ˜(K˜K˜—š กœŸœŸœŸœŸœŸœœ˜=KšŸœ!˜'Kšœ˜—K˜šกœŸœŸœ ŸœŸœŸœŸœŸœœ˜PKšŸœ&˜,Kšœ˜K˜—šกœŸœŸœŸœŸœŸœŸœŸœŸœ˜SKšŸœŸœ˜%Kšœ˜K˜—š กœŸœŸ œŸœŸœ Ÿœ˜MKšœ,™,KšŸœŸœ ˜š ŸœŸœŸœŸœŸœŸ˜5KšœŸœ ˜(KšŸœ˜—Kšœ˜K˜—š กœŸœŸ œŸœŸœŸœ˜AKšŸœŸœ ˜Kš ŸœŸœŸœŸœŸœŸœ˜2K–1[ref: REF ANY, prop: REF ANY, val: REF ANY]šœQ˜QKšœ˜K˜—šก œŸœŸœŸœŸœŸœŸœ˜bKšŸœŸœ ˜KšŸœ(˜.KšŸœ˜K˜—šกœŸœŸœŸœŸœŸœŸœ˜VKšœŸœ˜KšœŸœ˜KšœŸœ˜šŸœŸœŸ˜šœ˜Kšœ˜šŸœŸœŸ˜šŸœŸœ˜Kšœ™K˜KšŸœ ˜Kšœ˜—K˜ K˜KšŸœ˜—K˜—šŸœ˜ KšŸœŸœŸœ ˜——Kš ™KšœŸœŸœ/Ÿœ˜BKšŸœŸœŸœŸœ˜Kšœ˜KšŸœ ˜Kšœ˜K˜—šกœŸœŸœŸœŸœŸœŸœŸœŸœ˜JKšŸœŸœ ˜Kšœ,™,šŸœŸœŸœ˜šŸœŸœŸ˜"šœ˜šŸœŸœŸ˜KšŸœŸœŸœ˜4K˜KšŸœ˜——KšŸœ˜——Kšœ˜—K˜šกœŸœŸœŸœŸœŸœŸœŸœ˜ZKšŸœŸœ ˜šŸœ$ŸœŸœŸ˜9KšŸœŸœŸœ˜4KšŸœ˜—Kšœ˜—K˜š กœŸœŸœŸœŸœŸœ˜6KšŸœŸœ ˜šŸœŸœŸ˜Kšœ<˜<—Kšœ˜—K˜š กœŸœŸœŸœŸœŸœ˜YKšŸœŸœ ˜KšŸœ#˜)Kšœ˜—K˜šกœŸœŸœŸœŸœŸœ Ÿœ˜QšŸœŸœŸ˜šœ˜Kšœ˜KšœŸœ˜šŸœŸœŸ˜Kšœ˜šŸœŸœ˜KšŸœŸœŸœŸœ˜ Kšœ˜KšŸœ ˜K˜—K˜ K˜ KšŸœ˜—KšŸœ ˜K˜—KšŸœ˜—Kšœ˜K˜—K˜š กœŸœŸœŸœŸœ˜3š ŸœŸœŸœŸœŸ˜:Kšœ ˜ KšŸœ˜—Kšœ˜—K˜šกœŸœŸœŸœŸœŸœŸœŸœŸ œ˜qš ŸœŸœŸœŸœŸ˜:KšŸœ ŸœŸœ˜!KšŸœ˜—KšŸœŸœ˜ Kšœ˜—K˜šกœŸœŸœŸœŸœŸœŸœŸœŸœ˜IKšŸœŸœ ˜KšœŸœ˜šŸœŸœŸ˜KšœŸœ˜KšœŸœŸœ˜.KšŸœ$˜+—šŸœŸ˜Kšœ˜KšŸœŸœŸœŸœ˜Kšœ˜KšŸœ˜—Kšœ˜—K˜šก œŸœŸœŸœŸœŸœŸœŸœŸœ˜|Kšœ8™8KšœŸœ ˜Kšœ˜šŸœ,ŸœŸœŸ˜BKšœ˜šŸœŸœ˜KšœŸœ˜KšœŸœŸœŸœ˜3KšœŸœŸœŸœ˜3šŸœŸœŸœ Ÿ˜4KšŸœŸœŸœŸœ ˜%KšŸœ˜—Kšœ Ÿœ˜%šŸœ Ÿ˜KšœN™NKšŸœŸœŸœŸœ ˜5K˜KšŸœ˜—KšŸœ˜KšŸœ˜K˜—Kšœ ˜ KšŸœ˜—Kšœ˜—K˜š ก œŸœŸœŸœŸœŸ œ˜YšŸœŸ˜ šŸœ˜Kšœ$˜$Kšœ˜Kšœ˜—šŸœ˜Kšœ˜Kšœ˜K˜Kšœ˜——K˜Kšœ˜—K˜š กœŸœŸœŸœŸœŸœ˜SKšŸœŸœŸœ ˜8Kšœ˜K˜—šกœŸœ˜K–[STRING]˜0K˜—K˜K˜Kšœ ™ K˜KšŸœ˜ Kšœ$ŸœM™uKšœ˜Kšœ˜K˜—Kšœ˜K˜K˜K˜—…—ภ3า