-- ppAtom.mesa: Atom module for Chipmonk

-- written by E. McCreight, February 3, 1983  9:18 AM

DIRECTORY
  ppdefs,
  ZoneAllocDefs;

ppAtom: PROGRAM IMPORTS ZoneAllocDefs EXPORTS ppdefs =
  BEGIN OPEN ppdefs;

  atomZone: UNCOUNTED ZONE ← NIL;

  AtomRecPtr: TYPE = LONG POINTER TO AtomRec ← NIL;
  AtomRec: TYPE = RECORD [
    next: AtomRecPtr,
    length: CARDINAL, -- from here on is a StringBody
    t: PACKED SEQUENCE maxlength: CARDINAL OF CHARACTER
    ];

  AHRange: TYPE = INTEGER[0..229);
  AtomHash: TYPE = ARRAY AHRange OF AtomRecPtr ← ALL[NIL];
  atomHash: LONG POINTER TO AtomHash;

  CharArray: TYPE = PACKED ARRAY CHARACTER OF CHARACTER;
  capitalize: LONG POINTER TO CharArray;

  StartAtoms: PROC =
    BEGIN
    atomZone ← ZoneAllocDefs.GetAnXMZone[];
    atomHash ← atomZone.NEW[AtomHash ← ALL[NIL]];
    capitalize ← atomZone.NEW[CharArray];
    FOR c: CHARACTER IN CHARACTER DO
      capitalize[c] ← IF c IN ['a..'z] THEN 'A+(c-'a) ELSE c;
      ENDLOOP;
    END;

  RestartAtoms: PUBLIC PROC =
    BEGIN
    atomZone ← ZoneAllocDefs.DestroyAnXMZone[atomZone];
    StartAtoms[];
    END;

  MakeAtom: PUBLIC PROC [s: LONG STRING] RETURNS [Atom] =
    BEGIN
    h: AHRange = HashIndex[s];
    ar, prevAr: AtomRecPtr ← NIL;
    FOR ar ← atomHash[h], ar.next WHILE ar#NIL DO
      IF s.length=ar.length THEN
        FOR i: CARDINAL IN [0..s.length) DO
          IF capitalize[s[i]]#ar.t[i] THEN GOTO MisMatch;
          REPEAT
            MisMatch => NULL;
            FINISHED =>
              BEGIN
              IF prevAr#NIL THEN
                BEGIN -- move ar to front of its list
                prevAr.next ← ar.next;
                ar.next ← atomHash[h];
                atomHash[h] ← ar;
                END;
              RETURN[LOOPHOLE[@ar.length]];
              END;
          ENDLOOP;
      prevAr ← ar;
      ENDLOOP;
    ar ← atomZone.NEW[AtomRec[s.length] ← [next: atomHash[h], length: s.length, t:]];
    FOR i: CARDINAL IN [0..s.length) DO
      ar.t[i] ← capitalize[s[i]];
      ENDLOOP;
    ar.next ← atomHash[h];
    atomHash[h] ← ar;
    RETURN[LOOPHOLE[@ar.length]];
    END;

  FindAtom: PUBLIC PROC [s: LONG STRING] RETURNS [Atom] =
    BEGIN
    h: AHRange = HashIndex[s];
    prevAr: AtomRecPtr ← NIL;
    FOR ar: AtomRecPtr ← atomHash[h], ar.next WHILE ar#NIL DO
      IF s.length=ar.length THEN
        FOR i: CARDINAL IN [0..s.length) DO
          IF capitalize[s[i]]#ar.t[i] THEN GOTO MisMatch;
          REPEAT
            MisMatch => NULL;
            FINISHED =>
              BEGIN
              IF prevAr#NIL THEN
                BEGIN -- move ar to front of its list
                prevAr.next ← ar.next;
                ar.next ← atomHash[h];
                atomHash[h] ← ar;
                END;
              RETURN[LOOPHOLE[@ar.length]];
              END;
          ENDLOOP;
      prevAr ← ar;
      ENDLOOP;
    RETURN[NIL];
    END;

  HashIndex: PROC [s: LONG STRING] RETURNS [AHRange] =
    BEGIN
    n: INTEGER ← 0;
    FOR i: CARDINAL IN [0..MIN[s.length, 10]) DO
      n ← n+(i+1)*LOOPHOLE[capitalize[s[i]], CARDINAL];
      ENDLOOP;
    RETURN[n MOD (LAST[AHRange]+1)];
    END;

  -- module start code
  StartAtoms[];
  END.