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.



0AtomImpl.Mesa. Implements basic atom and property list operations. Resides in boot file. Rest of procedures in Atom interface are exported by AtomImpl.
Last Modified On January 17, 1983 1:38 pm by Warren Teitelman 
Last Modified On September 19, 1983 8:48 pm by Paul Rovner 
Last Edited by: Levin, September 20, 1983 3:34 pm
Constants
Types, Errors, Global Variables
bridge from opaque ATOM to concrete as defined in AtomPrivate
Creating Atoms
here if not found. Make a new ATOM.
exported to AtomPrivate
here if not found. Make a new ATOM.
here if not found. Make a new ATOM.
property list operations (for atoms and types)
property lists are alists, rather than list of ref any, so that the property list functions do not have to check the type of each entry to make sure it is a dotted pair. When automatic narrowing arrives, then maybe want to just make property list a list of typed objects.
treat NIL as an atom for purposes of GetProp
prop not found on property list

returns [NIL, ptr to last atom, hash index] if not found
stolen from TexHash.mesa
START HERE
Κ™–

"Cedar" style˜Jš
Οc—
™—
Jš
>™>Jš
;™;J™1š
Οk	˜	Jšœžœ˜&Jšœžœ˜Jšœžœžœ˜Jšœžœžœ7˜GJšœžœ˜,Jšœžœ˜$˜
J˜——JšΠblœžœ
žœ1˜JJšžœ1˜8Jšžœ˜Jšžœ˜
Jšœž˜
head™	Jšœ
žœ
œ
˜$—™Jšœ
žœž
œ	˜Jš
œžœžœ
žœ
žœ
žœ
žœ
˜-J˜Jšœ	žœ˜$šœžœžœ	˜Jš
=™=—J˜Jšœžœ˜*Jšœžœžœžœ˜:Jšœžœ˜1J˜Jšœ
žœ"˜0Jš	œžœžœ
žœ
žœ˜CJ˜Jšœžœ
žœžœ
˜#J˜Jšœžœ
˜—™JšΟn	œžœ
žœ
žœ
žœžœ
˜;J˜š œžœ
žœžœžœ
žœžœ˜BJš
œ)˜)Jš
œ˜Jš
œ˜Jšœžœ
˜J˜Jšžœžœ
žœ
žœ˜$Jš
œ
˜
šžœžœ˜+šžœ˜Jš	œžœžœ
žœ	žœ˜GJš	œžœ
žœ
žœ
žœ
˜Jš
œ
˜
Jšœžœžœ
žœ
žœ
žœžœ
žœ˜DJšžœžœ	˜——Jš
œ#˜#Jš
žœžœ
žœ
žœ
žœ˜*J˜Jš
œ#™#Jšœžœ˜*Jš
œ/˜/Jšžœ
žœ˜Jš
œ˜—J˜Jš
œ™š œžœ
žœžœ
žœžœ˜EJš
œ˜Jš
œ˜Jšœžœ
˜Jšœžœžœ
˜Jš
œ˜J˜Jš
žœ	žœ
žœ
žœ
žœ˜ Jš
œ˜šžœžœ;˜Kšžœ˜Jš	œžœžœ
žœ
žœ˜KJš	œžœ
žœ
žœ
žœ
˜Jšœžœ
˜Jš
œ
˜
Jšœžœ	žœ
žœ˜.Jšžœžœ ˜6Jš
œ˜——Jšœ žœ˜<Jš
žœžœ
žœ
žœ
žœ˜*J˜Jš
œ#™#Jš
œ˜Jš
œ˜Jš
žœžœ
žœžœžœ
˜AJšžœžœžœ˜JJšœžœ˜+Jš
œ/˜/Jšžœ
žœ	˜—J˜š œžœ
žœž	œžœ
žœžœ˜IJšžœ ˜&Jš
œ˜—J˜š œžœ
žœžœ
žœ
žœžœ
žœžœ˜RJš
œ˜Jš
œ˜Jšœžœ
˜J˜Jšžœžœ
žœ
žœ˜%Jš
œ˜šžœžœ˜+šžœ˜Jš	œžœžœ
žœ
žœ˜HJš	œžœ
žœ
žœ
žœ
˜Jšœžœ
˜Jšœ
žœ
˜J˜Jš
œ
˜
Jšœžœžœ
žœ
žœ
žœžœ
žœ˜EJšžœžœžœ˜3Jšœ žœ˜9Jšžœ
žœ
˜Jš
œ
˜
—Jšžœ!žœ˜>—Jš
žœžœ
žœ
žœ
žœ˜*J˜Jš
œ#™#Jšœžœ*˜=Jš
œ/˜/Jšžœ
žœžœ˜Jš
œ˜J˜—š 
œžœžœžœžœ
žœ˜EJšžœ
žœ˜#Jš
œ˜—J˜š
 œžœžœžœžœ˜@Jšžœ
žœ'˜4Jš
œ˜—J˜—š
œ.™.Jš
œ™—˜š
 œžœ
žœžœžœ˜@šžœ
žœžœ
žœ
žœ
žœ˜9Jš
œ,™,—Jš
œ˜—J˜š œžœ
žœžœžœ
žœžœ
žœ˜CJšžœžœ
žœ
žœ˜&˜J˜F—Jš
œ˜—J˜š 
œžœ
žœ
žœžœ
žœžœ
žœžœ˜iJšžœ
žœžœ
˜J˜Jšœžœ
˜šžœžœž˜šžœž˜Jš
ž˜J˜Jšžœ˜Jšžœ
˜—J˜J˜—Jšžœ
˜Jš
™Jšœžœ
žœ/žœ˜Bšžœžœ
žœ
žœ˜Jšžœ
žœ
žœ
žœžœ˜QJšžœ
žœ˜ —Jšž
œ˜—J˜š œžœ
žœžœžœ
žœžœ
žœ
žœ˜EJšžœžœ
žœ
žœ
žœ/˜NJšžœ
žœ>˜IJš
œ˜—J˜š œžœ
žœ
žœžœ
žœžœ
žœ
žœ˜[Jšžœ
žœžœ
˜šžœ$žœžœ
ž˜9Jšžœžœ
žœ˜3Jšžœ
˜—Jšžœ
žœ˜Jš
œ˜—J˜š œžœ
žœžœžœ
žœ˜4Jšžœžœ
žœ
žœ
˜J˜HJš
œ˜—J˜š œžœ
žœ
žœžœ
žœžœ˜\Jšžœ
žœžœ
˜Jšœžœ
˜J˜šžœžœ
ž˜šžœž˜Jš	œ
žœžœ
žœ
žœ
˜$Jšžœžœ˜.J˜—J˜J˜
Jšžœ
˜—Jšžœ˜Jš
œ˜—J™J˜š
 œžœ
žœžœžœ˜AJšžœžœ
žœ
žœ˜&Jšžœ˜Jš
œ˜—J˜š œžœ
žœžœžœžœ˜:šœžœžœžœžœžœ˜;J˜
Jšžœ
žœ˜Jšž
œ˜—J˜Jš
œ˜Jš
œ˜—J˜š œžœ
žœžœžœžœžœ˜BJšžœ
žœ˜+š	žœžœžœžœž˜7Jš
žœ
žœžœ
žœžœ
˜+—Jšžœ
žœ˜
—J˜Jš œžœ
žœžœžœžœ
žœ˜2šžœ
˜Jšœžœ˜Jšžœžœ
žœ
žœ
žœ
žœ	˜0šžœžœžœžœ
žœžœžœ˜SJšžœ˜Jšžœ
žœžœ
žœ
žœ
žœ˜KJšžœ
˜—Jšžœ
žœ˜
—J˜Jš
œ8™8š 
œžœ
žœ˜$JšžœA˜H—šžœ˜Jšœžœ
˜Jš
œ˜šžœžœžœž˜Eš
ž˜šžœž˜)Jšœ	žœ
˜Jšœžœžœ˜—Jšžœ
˜Jš
œ˜—Jšžœ˜	——J˜Jš 
œžœ
žœA˜Wšžœ˜šžœž˜
Jšžœžœ4˜NJšžœ%žœ	˜:——J˜š œžœ
žœ$˜AJšžœ˜—šžœ˜Jšœ	žœ˜,Jšœ	žœ˜-Jšœžœ
žœ
žœ
žœžœ
žœ
žœ
žœ
žœžœ
žœ˜^Jšœžœ
žœ
žœ
žœžœžœ
žœ
žœ
žœžœ
žœ˜_J˜šžœžœ
žœžœ˜-š
ž˜Jšœžœ
˜Jšœžœ
˜Jšžœ	žœ
žœžœ
žœ	žœ
žœ
˜B—Jšžœ
˜—š
ž˜šœ
žœžœ˜ Jšžœ
žœžœžœ˜3———J˜Jš
œ™Jš œžœ
žœžœ˜@šžœ˜Jšœžœ˜šžœžœ
žœžœ˜(Jšžœ
žœžœžœ
˜0—Jšžœžœ˜—J˜J˜Jš
œ
™
J˜Jšžœ%žœ˜<J˜Jš
œ˜—J˜Jšžœ
˜J˜J˜J˜—…— :3