MODULE RTTypeFP;

IMPORT Word, Fingerprint;
IMPORT RT0, RTType;
FROM RTType IMPORT Typecode;

VAR map : UNTRACED REF ARRAY OF INTEGER := NIL;

PROCEDURE ToFingerprint (tc: Typecode): Fingerprint.T =
  VAR t := RTType.Get (tc);  fp: Fingerprint.T;
  BEGIN
    fp.byte := t.fp;
    RETURN fp;
  END ToFingerprint;

PROCEDURE FromFingerprint (READONLY fp_in: Fingerprint.T): Typecode =
  VAR n, x, y : INTEGER;  t: RT0.TypeDefn;  fp: RT0.Fingerprint;
  BEGIN
    fp := fp_in.byte;
    IF (map = NIL) THEN BuildFPMap () END;
    n := NUMBER (map^);
    x := FPHash (fp, n);
    LOOP
      y := map[x];
      IF (y = RTType.NoSuchType) THEN  RETURN RTType.NoSuchType;  END;
      t := RTType.Get (y);
      IF (t.fp = fp) THEN  RETURN t.typecode;  END;
      INC (x);  IF (x >= n) THEN x := 0 END;
    END;
  END FromFingerprint;

PROCEDURE BuildFPMap () =
  VAR
    n   := RTType.MaxTypecode () + 1;
    n_m := 3 * n;
    m   := NEW (UNTRACED REF ARRAY OF INTEGER, n_m);
    t   : RT0.TypeDefn;
    x   : INTEGER;
  BEGIN
    FOR i := FIRST (m^) TO LAST (m^) DO
      m[i] := RTType.NoSuchType;
    END;
    FOR i := 0 TO n-1 DO
      t := RTType.Get (i);
      IF (t.traced # 0) OR (t.typecode = RT0.NilTypecode) THEN
        x := FPHash (t.fp, n_m);
        WHILE (m[x] # RTType.NoSuchType) DO
          INC (x);
          IF (x >= n_m) THEN x := 0 END;
        END;
        m[x] := t.typecode;
      END;
    END;
    map := m;
  END BuildFPMap;

PROCEDURE FPHash (READONLY fp: RT0.Fingerprint;  x: INTEGER): INTEGER =
  BEGIN
    RETURN
      Word.Xor (Word.Xor (Word.Xor (Word.Shift (fp[0], 0),
                                    Word.Shift (fp[1], 3)),
                          Word.Xor (Word.Shift (fp[2], 7),
                                    Word.Shift (fp[3], 11))),
                Word.Xor (Word.Xor (Word.Shift (fp[4], 13),
                                    Word.Shift (fp[5], 17)),
                          Word.Xor (Word.Shift (fp[6], 19),
                                    Word.Shift (fp[7], 23))))
      MOD x
  END FPHash;

BEGIN
END RTTypeFP.