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
the monitor protects the ATOM dictionary and all PropLists
IMPORTS DebuggerSwap, PrincOpsUtils, Rope, RopeHash, SafeStorageOps, SafeStorage
EXPORTS Atom, AtomPrivate
SHARES Rope
= {
Types, Errors, Global Variables
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;
bridge from opaque ATOM to concrete as defined in AtomPrivate
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;
Creating Atoms
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 {
here if not found. Make a new ATOM.
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 {
exported to AtomPrivate
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 {
here if not found. Make a new ATOM.
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 {
here if not found. Make a new ATOM.
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] = {
treat NIL as an atom for purposes of GetProp
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 {
Update list element in place
lst.first.val ← val;
RETURN [propList];
};
lag ← lst;
lst ← lst.rest;
ENDLOOP;
};
ENDCASE =>
IF ref # NIL THEN Crash[];
prop not found on property list
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[];
treat NIL as an atom for purposes of GetProp
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 {
returns [NIL, ptr to last atom, hash index] if not found
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
There are some odd characters on the end of the text (only 1 for 16-bit words)
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];
};
START HERE
TRUSTED {SafeStorageOps.AcquireBasicLiterals[CODE[AtomRec]]};
emptyAtom ← MakeAtom[""]
}.