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
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
the monitor protects the ATOM dictionary and all PropLists
IMPORTS Basics, Debugging, RefText, Rope, RopeHash, SafeStorage
EXPORTS Atom, AtomPrivate
SHARES Rope, SafeStorage -- for access to Rope.Text.length, SafeStorage.NewObject
= {
Types, Errors, Global Variables
typeOfATOMReferent: SafeStorage.Type ~ SafeStorage.GetTypeIndex["\251",
NIL,
NIL];
A bit of magic: this is the type string the compiler uses for referents of atoms: RRA says so!
PropList: TYPE = Atom.PropList;
String: TYPE = LONG POINTER TO READONLY TEXT;
WordPtr: TYPE = LONG POINTER TO Basics.RawWords;
RefAtomRec:
TYPE =
REF AtomPrivate.AtomRec;
bridge from opaque ATOM to concrete as defined in AtomPrivate
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;
Allocation, accessors for ATOMs
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
};
Creating Atoms
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 {
here if not found. Make a new ATOM.
this ¬ NewAtom[pName: t];
InsertAtom[this: this, prev: prev, hash: hash];
};
RETURN [this]
};
UnsafeMakeAtom:
PUBLIC
ENTRY
UNSAFE PROC [pName: String]
RETURNS [
ATOM] =
UNCHECKED {
exported to AtomPrivate
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 {
come here if not found. Make a new ATOM.
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] = {
treat NIL as an atom for purposes of GetProp
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 {
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 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 {
returns [NIL, ptr to last atom, hash index] if not found
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
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 [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];
};
START HERE
TRUSTED {
SafeStorageOps.AcquireBasicLiterals[CODE[AtomRec]] -- this needs to go back in when the rest of SafeStorage comes up.
};
emptyAtom ¬ MakeAtom[emptyRope]