UNSAFE MODULE RTSignal;

IMPORT RTError, (* RTMisc, *) RTProcess, Usignal, Uprocess;
FROM Ctypes IMPORT int;

TYPE
  SigInfo = UNTRACED REF Usignal.struct_sigcontext;

VAR
  DefaultHandler   : Usignal.SignalHandler;
  IgnoreSignal     : Usignal.SignalHandler;
  initial_handlers : ARRAY [0..5] OF Usignal.struct_sigaction;

PROCEDURE InstallHandlers () =
  BEGIN
    DefaultHandler := LOOPHOLE (0, Usignal.SignalHandler);
    IgnoreSignal   := LOOPHOLE (1, Usignal.SignalHandler);

    SetHandler (0, Usignal.SIGHUP,  Shutdown);
    SetHandler (1, Usignal.SIGINT,  Interrupt);
    SetHandler (2, Usignal.SIGQUIT, Quit);
    SetHandler (3, Usignal.SIGSEGV, SegV);
    SetHandler (4, Usignal.SIGPIPE, IgnoreSignal);
    SetHandler (5, Usignal.SIGTERM, Shutdown);
  END InstallHandlers;

PROCEDURE SetHandler (id: INTEGER; sig: int;  handler: Usignal.SignalHandler) =
  (* Note: we use the LOOPHOLE to prevent the runtime check for
     nested procedure.  The runtime check crashes when
     handler = IgnoreSignal = 1. *)
  VAR new: Usignal.struct_sigaction;
  BEGIN
    new.sa_handler := LOOPHOLE (handler, Usignal.SignalHandler);
    new.sa_flags   := 0;
    EVAL Usignal.sigaction (sig, ADR(new), ADR(initial_handlers[id]));
    IF (initial_handlers[id].sa_handler # DefaultHandler) THEN
      (* don't override inherited, non-default handlers *)
      EVAL Usignal.sigaction (sig, ADR(initial_handlers[id]), ADR(new));
    END;
  END SetHandler;

PROCEDURE RestoreHandlers () =
  BEGIN
    RestoreHandler (0, Usignal.SIGHUP);
    RestoreHandler (1, Usignal.SIGINT);
    RestoreHandler (2, Usignal.SIGQUIT);
    RestoreHandler (3, Usignal.SIGSEGV);
    RestoreHandler (4, Usignal.SIGPIPE);
    RestoreHandler (5, Usignal.SIGTERM);
  END RestoreHandlers;

PROCEDURE RestoreHandler (id: INTEGER;  sig: int) =
  BEGIN
    EVAL Usignal.sigaction (sig, ADR(initial_handlers[id]), NIL);
  END RestoreHandler;

PROCEDURE Shutdown (sig: int; <*UNUSED*> code: int; <*UNUSED*> scp: SigInfo) =
  VAR new, old: Usignal.struct_sigaction;
  BEGIN
    new.sa_handler := DefaultHandler;
    new.sa_flags   := 0;
    RTProcess.InvokeExitors ();                   (* flush stdio... *)
    EVAL Usignal.sigaction (sig, ADR(new), ADR(old));       (* restore default handler *)
    EVAL Usignal.kill (Uprocess.getpid (), sig);  (* and resend the signal *)
  END Shutdown;

PROCEDURE Interrupt (sig: int;  code: int;  scp: SigInfo) =
  VAR h := RTProcess.OnInterrupt (NIL);
  BEGIN
    IF (h = NIL) THEN
      Shutdown (sig, code, scp);
    ELSE
      EVAL RTProcess.OnInterrupt (h); (* reinstall the handler *)
      h ();
    END;
  END Interrupt;

PROCEDURE Quit (<*UNUSED*> sig, code: int; scp: SigInfo) =
  VAR pc := 0;
  BEGIN
    IF (scp # NIL) THEN pc := scp.sc_eip END;
    RTError.Msg (NIL, 0, "aborted");
    (* RTMisc.FatalErrorPC (pc, "aborted"); *)
  END Quit;

PROCEDURE SegV (<*UNUSED*> sig, code: int; scp: SigInfo) =
  VAR pc := 0;
  BEGIN
    IF (scp # NIL) THEN pc := scp.sc_eip END;
    RTError.Msg (NIL, 0,
      "Segmentation violation - possible attempt to dereference NIL");
    (* RTMisc.FatalErrorPC (pc,
      "Segmentation violation - possible attempt to dereference NIL"); *)
  END SegV;

BEGIN
END RTSignal.