-- AtomsPrivateImpl.mesa
-- Simple hash-table implementation of CedarPrivateAtoms.MakeAtom
-- Last Modified On 8-Mar-82 10:30:26 by Paul Rovner 

DIRECTORY
        Inline,
        Rope USING[ROPE, Text],
        RopeInline USING[NewText, InlineFlatten],
        RTBasic USING[Type],
        RTLoader USING[AcquireBasicLiterals],
        RTTypesBasic USING[GetCanonicalType, Type],
        RTTypesBasicPrivate USING[NotifyAtomRecType],
        SafeStorage USING[NewZone],
        AtomsPrivate;

AtomsPrivateImpl: MONITOR -- protects the ATOM dictionary
  IMPORTS Inline, RopeInline, RTLoader, RTTypesBasic, RTTypesBasicPrivate, SafeStorage
  EXPORTS AtomsPrivate  
  SHARES Rope
  
= BEGIN OPEN AtomsPrivate;

-- CONSTANTS
HashSize: INTEGER = 4093;  -- prime

-- TYPES
String: TYPE = LONG POINTER TO READONLY TEXT;
Atom: TYPE = REF AtomRec;
AtomDictionaryIndex: TYPE = [0..HashSize);
AAtomDict: TYPE = ARRAY AtomDictionaryIndex OF Atom;
ComparisonOutcome: TYPE = {less, greater, equal};

-- VARIABLES
atomDictionary: REF AAtomDict _ NEW[AAtomDict _ ALL[NIL]];
atomZone: ZONE = SafeStorage.NewZone[sr: quantized];

-- PROCEDURES

GetAtom: PUBLIC PROC[pName: Rope.ROPE] RETURNS[ATOM] =
  { t: Rope.Text = RopeInline.InlineFlatten[pName];
    this, prev: Atom;
    hash: AtomDictionaryIndex;
    l: CARDINAL;
    
    IF t = NIL THEN RETURN[NIL];
    l _ t.length;
    IF l MOD 2 = 1  -- fill residue char with 0
     THEN { w: CARDINAL = Inline.BITSHIFT[t[l-1], 8];
            p: LONG POINTER TO UNSPECIFIED;
            l _ l + 1;
            p _ LOOPHOLE[t, LONG POINTER TO UNSPECIFIED] + SIZE[TEXT[0]] + l/2 - 1;
            IF p^ # w THEN p^ _ w};
    [this, prev, hash] _ LookUpAtom[t];
    IF this # NIL THEN RETURN[LOOPHOLE[this]];

  -- 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 PROC[pName: String] RETURNS[ATOM] =
  { this, prev: Atom;
    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 = Inline.BITSHIFT[pName[l-1], 8];
            p: LONG POINTER TO UNSPECIFIED;
            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]];
  -- here if not found. Make a new ATOM.
    rt _ RopeInline.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]]};

EnumerateAtoms: PUBLIC PROC[ callee: PROC[ATOM] RETURNS[stop: BOOLEAN] ]
     RETURNS[ATOM--NIL if was not stopped--] =
  { FOR atom: ATOM _ Next[NIL], Next[atom]
     UNTIL atom = NIL DO IF callee[atom] THEN RETURN[atom]; ENDLOOP;
    RETURN[NIL]};

Next: ENTRY PROC[atom: ATOM _ NIL] RETURNS[ATOM] = INLINE
  { a: Atom = 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]};

        -- returns [NIL,ptr to last atom, hash index] if not found
LookUpAtom: ENTRY PROC[s: Rope.Text]
      RETURNS[atom: Atom, prev: Atom, hash: AtomDictionaryIndex] =
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: Atom, prev: Atom, hash: AtomDictionaryIndex] = 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] = 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]};


        -- stolen from TexHash.mesa
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]};

-- START HERE

atomRecType: RTTypesBasic.Type = RTTypesBasic.GetCanonicalType[CODE[AtomRec]];

RTTypesBasicPrivate.NotifyAtomRecType[atomRecType];
RTLoader.AcquireBasicLiterals[atomRecType];

END.