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