(* Copyright (C) 1990, Digital Equipment Corporation           *)
(* All rights reserved.                                        *)
(* See the file COPYRIGHT for a full description.              *)

(* Last modified on Fri Jan 31 10:19:44 PST 1992 by kalsow     *)
(*      modified on Fri Feb  8 05:12:57 1991 by muller         *)

UNSAFE MODULE RTProc;

IMPORT RT0, RT0u, RTTypeFP, FPrint, Word, Cstring;

TYPE Info = UNTRACED REF RT0.ProcInfo;

VAR
 mu     := NEW (MUTEX);
 nProcs : INTEGER := 0;
 info   : UNTRACED REF ARRAY OF Info := NIL;

PROCEDURE NumProcedures (): CARDINAL =
  BEGIN
    LOCK mu DO
      IF (nProcs = 0) THEN CountProcs () END;
      RETURN nProcs;
    END;
  END NumProcedures;

PROCEDURE FromPC (pc: ADDRESS;  VAR p: Proc;  VAR name: Name) =
  VAR x, y, best: Info;  best_diff, diff: INTEGER;
  BEGIN
    LOCK mu DO
      IF (info = NIL) THEN Init () END;
      x := Locate (pc);  (* try the hash table for an exact match *)
      IF (x = NIL) THEN (* resort to linear search *)
        best := NIL;  best_diff := LAST (INTEGER);
        FOR i := 0 TO LAST (info^) DO
          y := info[i];
          IF (y # NIL) THEN
            diff := (pc - y.proc);
            IF (0 <= diff) AND (diff < best_diff) THEN
              best := y;
              best_diff := diff;
            END;
          END;
        END;
        x := best;
      END;
    END;

    IF (x # NIL)
      THEN  p := x.proc;  name := x.name;
      ELSE  p := NIL;     name := NIL;
    END;
  END FromPC;

PROCEDURE ToFingerprint (p: Proc): Fingerprint =
  VAR x: Info;
  BEGIN
    LOCK mu DO
      IF (info = NIL) THEN Init () END;
      x := Locate (p);
      IF (x # NIL) THEN
        IF (x.fp[0] = 0) AND (x.fp[1] = 0) THEN ComputeFP (x) END;
        RETURN x.fp;
      END;
    END;
    RETURN Fingerprint {0, 0};
  END ToFingerprint;

PROCEDURE FromFingerprint (READONLY fp: Fingerprint): Proc =
  VAR x: Info;
  BEGIN
    LOCK mu DO
      IF (info = NIL) THEN Init () END;

      (* first scan for the procedures we've already done *)
      FOR i := 0 TO LAST (info^) DO
        x := info[i];
        IF (x # NIL) AND (x.fp = fp) THEN RETURN x.proc END;
      END;

      (* then force the fingerprints to be evaluated *)
      FOR i := 0 TO LAST (info^) DO
        x := info[i];
        IF (x # NIL) THEN
          IF (x.fp[0] = 0) AND (x.fp[1] = 0) THEN ComputeFP (x) END;
          IF (x.fp = fp) THEN RETURN x.proc END;
        END;
      END;
    END;

    RETURN NIL;
  END FromFingerprint;

PROCEDURE ComputeFP (x: Info) =
  (* called with 'mu' held *)
  VAR tmp: Fingerprint;
  BEGIN
     tmp  := RTTypeFP.UIDToFingerprint (x.typeID);
     x.fp := FPrint.Extend (tmp, x.name, Cstring.strlen (x.name));
  END ComputeFP;

PROCEDURE CountProcs () =
  (* called with 'mu' held *)
  VAR j, n: INTEGER;  p: RT0.ProcInfoList;
  BEGIN
    n := 0;
    FOR i := 0 TO RT0u.nModules - 1 DO
      p := RT0u.modules[i].proc_info;
      IF (p # NIL) THEN
        j := 0;
        WHILE (p^.proc # NIL) DO INC (p, ADRSIZE (p^)); INC (j) END;
        INC (n, j);
      END;
    END;
    nProcs := n;
  END CountProcs;

PROCEDURE Init () =
  (* called while 'mu' is held *)
  VAR p: RT0.ProcInfoList;
  BEGIN
    IF (nProcs = 0) THEN CountProcs () END;

    (* allocate the global array of Info pointers *)
    info := NEW (UNTRACED REF ARRAY OF Info, 3 * nProcs);

    (* for each procedure, insert its info entry into the global array *)
    FOR i := 0 TO RT0u.nModules - 1 DO
      p := RT0u.modules[i].proc_info;
      IF (p # NIL) THEN
        WHILE (p.proc # NIL) DO
          Insert (p^);
          INC (p, ADRSIZE (p^));
        END;
      END;
    END;
  END Init;

(** CONST Multiplier = 1052824; **)
CONST Multiplier = 2 * 2 * 3 * 5 * 7 * 11 * 13 * 17 * 19 * 23 + 1;
(* See Knuth Vol. 2, Theorem A, page 16. *)

PROCEDURE Insert (VAR xx: RT0.ProcInfo) =
  (* called while 'mu' is held *)
  VAR x: Info;  hash, index: INTEGER;
  BEGIN
    hash := LOOPHOLE (xx.proc, INTEGER);
    LOOP
      index := Word.Mod (hash, NUMBER (info^));
      x := info [index];
      IF (x = NIL)   THEN  info [index] := ADR (xx); RETURN  END;
      IF (x.proc = xx.proc) THEN  RETURN  END;
      hash := Word.Plus (1, Word.Times (hash, Multiplier));
    END;
  END Insert;

PROCEDURE Locate (proc: Proc): Info =
  (* called while 'mu' is held *)
  VAR x: Info;  hash, index: INTEGER;
  BEGIN
    hash := LOOPHOLE (proc, INTEGER);
    LOOP
      index := Word.Mod (hash, NUMBER (info^));
      x := info [index];
      IF (x = NIL)       THEN RETURN NIL END;
      IF (x.proc = proc) THEN RETURN x   END;
      hash := Word.Plus (1, Word.Times (hash, Multiplier));
    END;
  END Locate;

BEGIN
END RTProc.