<> <> <> <> DIRECTORY Atom USING [PropList, DottedPairNode], AtomPrivate USING [AtomRec], PrincOpsUtils USING [BITSHIFT], Rope USING [ROPE, Text, FromChar, InlineFlatten, NewText, FromRefText], SafeStorageOps USING [AcquireBasicLiterals], SafeStorage USING [GetPermanentZone] ; AtomImpl: CEDAR MONITOR -- protects the ATOM dictionary and all PropLists IMPORTS PrincOpsUtils, Rope, SafeStorageOps, SafeStorage EXPORTS Atom, AtomPrivate SHARES Rope = BEGIN <> HashSize: INTEGER = 4093; -- prime; <> PropList: TYPE = Atom.PropList; String: TYPE = LONG POINTER TO READONLY TEXT; 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; <> EmptyAtom: PUBLIC PROC RETURNS[ATOM] = {RETURN[emptyAtom]}; MakeAtom: PUBLIC PROC [pName: Rope.ROPE] RETURNS[ATOM] = TRUSTED { t: Rope.Text = Rope.InlineFlatten[pName]; this, prev: RefAtomRec; hash: AtomDictionaryIndex; l: CARDINAL; IF t = NIL THEN RETURN[EmptyAtom[]]; l _ t.length; IF l MOD 2 = 1 -- fill residue char with 0 THEN { w: CARDINAL _ PrincOpsUtils.BITSHIFT[LOOPHOLE[t[l-1], UNSPECIFIED], 8]; p: LONG POINTER TO CARDINAL; l _ l + 1; p _ LOOPHOLE[t, LONG POINTER TO CARDINAL] + SIZE[TEXT[0]] + l/2 - 1; IF p^ # w THEN p^ _ w}; [this, prev, hash] _ LookUpAtom[t]; IF this # NIL THEN RETURN[LOOPHOLE[this]]; <> this _ atomZone.NEW[AtomRec _ [pName: t]]; InsertAtom[atom: this, prev: prev, hash: hash]; RETURN[LOOPHOLE[this]]; }; <> UnsafeMakeAtom: PUBLIC PROC[pName: String] RETURNS[ATOM] = TRUSTED{ this, prev: RefAtomRec; hash: AtomDictionaryIndex; l: CARDINAL; oddLength: BOOLEAN _ FALSE; rt: Rope.Text; IF pName = NIL THEN RETURN[NIL]; l _ pName.length; IF l MOD 2 = 1 -- fill residue char with 0 (NOTE violation of READONLY!!!) THEN { w: CARDINAL = PrincOpsUtils.BITSHIFT[LOOPHOLE[pName[l-1], UNSPECIFIED], 8]; p: LONG POINTER TO CARDINAL; oddLength _ TRUE; l _ l + 1; p _ LOOPHOLE[pName + SIZE[TEXT[0]] + l/2 - 1]; IF p^ # w THEN p^ _ w -- NOTE violation of READONLY!!! }; [this, prev, hash] _ LookUpAtom[LOOPHOLE[pName, Rope.Text]]; IF this # NIL THEN RETURN[LOOPHOLE[this]]; <> rt _ Rope.NewText[l]; rt.length _ pName.length; FOR i: CARDINAL IN [0..pName.length) DO rt[i] _ pName[i] ENDLOOP; IF oddLength THEN {rt.length _ l; rt[l-1] _ LOOPHOLE[0]; rt.length _ l-1}; this _ atomZone.NEW[AtomRec _ [pName: rt]]; InsertAtom[atom: this, prev: prev, hash: hash]; RETURN[LOOPHOLE[this]]}; MakeAtomFromChar: PUBLIC PROC [char: CHARACTER] RETURNS[ATOM] = TRUSTED { RETURN[MakeAtom[Rope.FromChar[char]]]; }; MakeAtomFromRefText: PUBLIC PROC [rt: REF READONLY TEXT] RETURNS[ATOM] = TRUSTED { this, prev: RefAtomRec; hash: AtomDictionaryIndex; l: CARDINAL; IF rt = NIL THEN RETURN[EmptyAtom[]]; l _ rt.length; IF l MOD 2 = 1 -- fill residue char with 0 THEN { w: CARDINAL _ PrincOpsUtils.BITSHIFT[LOOPHOLE[rt[l-1], UNSPECIFIED], 8]; p: LONG POINTER TO CARDINAL; old: CARDINAL; oldSaved: BOOL _ FALSE; l _ l + 1; p _ LOOPHOLE[rt, LONG POINTER TO CARDINAL] + SIZE[TEXT[0]] + l/2 - 1; IF p^ # w THEN {old _ p^; p^ _ w; oldSaved _ TRUE}; [this, prev, hash] _ LookUpAtom[LOOPHOLE[rt, Rope.Text]]; IF oldSaved THEN p^ _ old; } ELSE [this, prev, hash] _ LookUpAtom[LOOPHOLE[rt, Rope.Text]]; IF this # NIL THEN RETURN[LOOPHOLE[this]]; <> 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]]; }; ATOMToPropList: PROC [atom: ATOM] RETURNS [PropList] = INLINE { RETURN[NARROW[ATOMToAtom[atom].propList, PropList]]; }; <> <> GetPropertyList: PUBLIC PROC [atom: ATOM] RETURNS[PropList] = { RETURN[IF atom = NIL THEN NIL ELSE ATOMToPropList[atom]]; <> }; PutProp: PUBLIC PROC [atom: ATOM, prop: REF ANY, val: REF ANY] = { IF atom = NIL THEN ERROR NILNotAnAtom; ATOMToAtom[atom].propList _ PutPropOnList[propList: ATOMToPropList[atom], prop: prop, val: val]; }; PutPropOnList: PUBLIC ENTRY PROC [propList: PropList, prop: REF ANY, val: REF ANY] RETURNS[PropList] = { ENABLE UNWIND => NULL; lst: PropList _ propList; lst1: PropList _ NIL; UNTIL lst = NIL DO IF lst.first.key = prop THEN BEGIN lst.first.val _ val; RETURN[propList]; END; lst1 _ lst; lst _ lst.rest; ENDLOOP; <> lst _ CONS[NEW[Atom.DottedPairNode _ [key: prop, val: val]], NIL]; IF lst1 = NIL THEN RETURN[lst] ELSE IF lst1.rest = NIL THEN {lst1.rest _ lst; RETURN[propList]} -- add at end -- ELSE ERROR ; -- shouldnt happen }; -- of PutPropOnList GetProp: PUBLIC PROC [atom: ATOM, prop: REF ANY] RETURNS[REF ANY] = { IF atom = NIL THEN RETURN[NIL] -- treat NIL as an atom for purposes of GetProp ELSE RETURN[GetPropFromList[propList: ATOMToPropList[atom], prop: prop]]; }; GetPropFromList: PUBLIC ENTRY PROC [propList: PropList, prop: REF ANY] RETURNS[REF ANY] = { ENABLE UNWIND => NULL; FOR lst: PropList _ propList, lst.rest UNTIL lst = NIL DO IF lst.first.key = prop THEN RETURN[lst.first.val]; ENDLOOP; RETURN[NIL]; }; RemProp: PUBLIC PROC [atom: ATOM, prop: REF ANY] = { IF atom = NIL THEN RETURN; ATOMToAtom[atom].propList _ RemPropFromList[ATOMToPropList[atom], prop]; }; RemPropFromList: PUBLIC ENTRY PROC [propList: PropList, prop: REF ANY] RETURNS[PropList] = { ENABLE UNWIND => NULL; lst, lst1: PropList _ NIL; lst _ propList; UNTIL lst = NIL DO IF lst.first.key = prop THEN {IF lst1 = NIL THEN RETURN[lst.rest] ELSE {lst1.rest _ lst.rest; RETURN[propList]}; }; lst1 _ lst; lst_lst.rest; ENDLOOP; RETURN[propList]; }; <<>> 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]] = TRUSTED { proc1: PROC [atm: ATOM] RETURNS[stop: BOOLEAN] = CHECKED { proc[atm]; RETURN[FALSE]; }; -- of proc1 [] _ FindAtom[proc: proc1]; }; 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[ATOM] = TRUSTED INLINE{ a: RefAtomRec = LOOPHOLE[atom]; IF a # NIL AND a.link # NIL THEN RETURN[a.link]; FOR adi: CARDINAL _ (IF a = NIL THEN 0 ELSE (Hash[LOOPHOLE[a.pName]] + 1)), adi + 1 UNTIL adi = HashSize DO IF atomDictionary[adi] # NIL THEN RETURN[LOOPHOLE[atomDictionary[adi]]]; ENDLOOP; RETURN[NIL]}; <> LookUpAtom: ENTRY PROC[s: Rope.Text] RETURNS[atom: RefAtomRec, prev: RefAtomRec, hash: AtomDictionaryIndex] = TRUSTED INLINE { prev _ NIL; hash _ Hash[s]; FOR atom _ atomDictionary[hash], LOOPHOLE[atom.link] UNTIL atom = NIL DO SELECT CompareStrings[s, atom.pName] FROM equal => RETURN; greater => {atom _ NIL; EXIT}; ENDCASE; prev _ atom; ENDLOOP}; InsertAtom: ENTRY PROC[atom: RefAtomRec, prev: RefAtomRec, hash: AtomDictionaryIndex] = TRUSTED INLINE { IF prev = NIL THEN {atom.link _ LOOPHOLE[atomDictionary[hash]]; atomDictionary[hash] _ atom} ELSE {atom.link _ prev.link; prev.link _ LOOPHOLE[atom]}}; CompareStrings: INTERNAL PROC[leftString, rightString: Rope.Text] RETURNS[ComparisonOutcome] = TRUSTED INLINE { lLength: CARDINAL = (leftString.length+1)/2; rLength: CARDINAL = (rightString.length+1)/2; lp: LONG POINTER TO CARDINAL = LOOPHOLE[leftString, LONG POINTER TO CARDINAL] + SIZE[TEXT[0]]; rp: LONG POINTER TO CARDINAL = LOOPHOLE[rightString, LONG POINTER TO CARDINAL] + SIZE[TEXT[0]]; FOR i: CARDINAL IN [0..MIN[lLength, rLength]) DO lw: CARDINAL = (lp + i)^; rw: CARDINAL = (rp + i)^; IF lw < rw THEN RETURN[less] ELSE IF lw > rw THEN RETURN[greater]; ENDLOOP; RETURN [IF lLength = rLength THEN equal ELSE IF lLength < rLength THEN less ELSE greater]}; <> Hash: INTERNAL PROC[s: Rope.Text] RETURNS[AtomDictionaryIndex] = INLINE { acc: CARDINAL _ 0; FOR i: CARDINAL IN [0..MIN[7, s.length]) DO acc _ 7*acc+LOOPHOLE[s[i], CARDINAL] ENDLOOP; RETURN[acc MOD HashSize]}; <> TRUSTED{SafeStorageOps.AcquireBasicLiterals[CODE[AtomRec]]}; emptyAtom _ MakeAtom[""]; END.