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

(* Last modified on Thu Dec 19 08:03:29 PST 1991 by kalsow    *)
(*      modified on Sat Mar  9 01:34:26 1991 by muller        *)
(*      modified on Thu Nov  8 14:21:56 PST 1990 by crelier   *)

UNSAFE MODULE Pkl EXPORTS Pkl, PklRep;

IMPORT RTType;

EXCEPTION RedefinedProc;
<*FATAL RedefinedProc *>

VAR mu: MUTEX := NIL; (* to protect the global 'procs' table *)

PROCEDURE Init () =
  BEGIN
    IF (mu = NIL) THEN mu := NEW (MUTEX) END;
    IF (procs = NIL) THEN
      LOCK mu DO
        IF (procs = NIL) THEN
          procs := NEW(Procs, RTType.MaxTypeCode()+1);
        END;
      END;
    END;
  END Init;

PROCEDURE RegisterConvertProcs(tc: INTEGER;  wrproc, rdproc: ConvertProc) =
  VAR wp, rp: ConvertProc;  conv, next: ConvertList;
  BEGIN
    Init ();
    LOCK mu DO
      wp := procs[tc].wrconv;
      rp := procs[tc].rdconv;
      IF (wp # NIL) AND (wp # wrproc) OR (rp # NIL) AND (rp # rdproc) THEN
        RAISE RedefinedProc;
      END ;
      procs[tc].wrconv := wrproc;
      procs[tc].rdconv := rdproc;
      FOR i := 0 TO RTType.MaxTypeCode() DO
        IF RTType.IsSubtype(i, tc) THEN
          conv := procs[i].first;
          IF conv = NIL THEN
            procs[i].first := NEW(ConvertList, tc := tc, next := NIL);
          ELSE
            next := conv.next;
            WHILE (next # NIL) AND RTType.IsSubtype(tc, next.tc) DO
              conv := next; next := conv.next;
            END;
            conv.next := NEW(ConvertList, tc := tc, next := conv.next);
          END;
        END;
      END;
    END;
  END RegisterConvertProcs;

PROCEDURE RegisterBytesProcs (tc     : INTEGER;
                              new_wr : WriteBytesProc;
                              new_rd : ReadBytesProc) =
  VAR old_wr: WriteBytesProc; old_rd: ReadBytesProc;
  BEGIN
    Init ();
    LOCK mu DO
      old_wr := procs[tc].wrbytes;
      old_rd := procs[tc].rdbytes;
      IF ((old_wr # NIL) AND (old_wr # new_wr))
        OR ((old_rd # NIL) AND (old_rd # new_rd)) THEN
        RAISE RedefinedProc;
      END;
      procs[tc].wrbytes := new_wr;
      procs[tc].rdbytes := new_rd;
    END;
  END RegisterBytesProcs;

BEGIN
END Pkl.