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

(* Last modified on Thu Dec 24 13:49:51 PST 1992 by jdd *)

UNSAFE MODULE RTHeapDep;

IMPORT Ctypes, RTHeap, RTMisc, Umman, Unix, Uresource, Usignal, Utypes, Word;

VAR
  initialized                         := FALSE;
  defaultFault: Usignal.SignalHandler := NIL;

PROCEDURE Protect (p: Page; n: CARDINAL; readable, writable: BOOLEAN) =
  BEGIN
    IF NOT initialized THEN Init(); initialized := TRUE; END;
    IF NOT readable THEN writable := FALSE; END; (* processor limitation *)
    VAR prot: Ctypes.int := 0;
    BEGIN
      IF readable THEN prot := Word.Or(prot, Umman.PROT_READ); END;
      IF writable THEN prot := Word.Or(prot, Umman.PROT_WRITE); END;
      VAR
        ret := Umman.mprotect(LOOPHOLE(p * BytesPerPage, Utypes.caddr_t),
                              n * BytesPerPage, prot);
      BEGIN
        <* ASSERT ret = n * BytesPerPage *>
      END;
    END;
  END Protect;

(* Init establishes a signal handler for VM faults, and remembers the old
   handler, which is used if a VM fault does not reference the stack. *)

PROCEDURE Init () =
  BEGIN
    VAR vmPageBytes := Unix.getpagesize();
    BEGIN
      <* ASSERT BytesPerPage >= vmPageBytes *>
      <* ASSERT BytesPerPage MOD vmPageBytes = 0 *>
      VAR
        vec := Usignal.struct_sigvec{
                 sv_handler := Fault, sv_mask :=
                 Word.LeftShift(1, Usignal.SIGVTALRM - 1), sv_flags := 0};
        ovec: Usignal.struct_sigvec;
        ret := Usignal.sigvec(Usignal.SIGSEGV, vec, ovec);
      BEGIN
        <* ASSERT ret = 0 *>
        defaultFault := ovec.sv_handler;
      END;
    END;
  END Init;

(* Fault is called when there's a VM fault.  If RTHeapFault is not able to
   handle it, it calls the default handler. *)

PROCEDURE Fault (sig, code: Ctypes.int;
                 scp      : UNTRACED REF Usignal.struct_sigcontext) =
  BEGIN
    IF NOT RTHeap.Fault(LOOPHOLE(scp.sc_badvaddr, ADDRESS)) THEN
      IF defaultFault # NIL THEN
        defaultFault(sig, code, scp);
      ELSE
        RTMisc.FatalError(NIL, 0, "Bus error");
      END;
    END;
  END Fault;

(* System-call faults are handled in RTHeapDepC.c *)

PROCEDURE TimeUsed (): REAL =
  VAR usage: Uresource.struct_rusage;
  BEGIN
    VAR ret := Uresource.getrusage(Uresource.RUSAGE_SELF, ADR(usage));
    BEGIN
      <* ASSERT ret # -1 *>
    END;
    RETURN (FLOAT(usage.ru_utime.tv_sec)
              + FLOAT(usage.ru_utime.tv_usec) / 1000000.0)
             + (FLOAT(usage.ru_utime.tv_sec)
                  + FLOAT(usage.ru_utime.tv_usec) / 1000000.0);
  END TimeUsed;

PROCEDURE VMFaultTime (): REAL =
  BEGIN
    RETURN 0.010;                (* guess 10ms to handle a page fault *)
  END VMFaultTime;

BEGIN END RTHeapDep.