-- 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.