m3core/src/runtime/common/RTProcess.m3

 Copyright (C) 1990, Digital Equipment Corporation           
 All rights reserved.                                        
 See the file COPYRIGHT for a full description.              
 Last modified on Wed Dec 21 13:47:07 PST 1994 by kalsow     
      modified on Sat Jun 27 22:22:30 PDT 1992 by muller     


UNSAFE MODULE RTProcess;

IMPORT RTHeapRep, RTException, RTIO, RTOS;

-------------------------------- program startup/shutdown -----------------


TYPE
  Exitor = UNTRACED BRANDED "RTProcess.Exitor" REF RECORD
             proc: PROCEDURE ();
             next: Exitor;
           END;

 Exitors are untraced because we don't want to depend on the
   collector during a crash.  Since they're never disposed, we
   have a small memory leak, probably about (3 * 16 bytes)/process. 


VAR
  exitors: Exitor := NIL;

PROCEDURE RegisterExitor (p: PROCEDURE ()) =
  BEGIN
    exitors := NEW (Exitor, proc := p, next := exitors);
  END RegisterExitor;

PROCEDURE InvokeExitors () =
  VAR tmp: Exitor;
  BEGIN
    (* run the registered "exit" routines *)
    WHILE exitors # NIL DO
      (* to ensure progress, remove an element from the list before
         invoking it *)
      tmp := exitors;
      exitors := exitors.next;
      tmp.proc ();
    END;
  END InvokeExitors;

PROCEDURE Exit (n: INTEGER) =
  BEGIN
    InvokeExitors ();
    RTOS.Exit (n);
  END Exit;

PROCEDURE Crash (msg: TEXT) =
  BEGIN
    IF (msg # NIL) THEN
      RTIO.PutText ("\n*** ");
      RTIO.PutText (msg);
      RTIO.PutText ("\n");
    END;
    RTException.DumpStack ();
    RTIO.Flush ();

    (* run the registered "exit" routines *)
    InvokeExitors ();

    (* crash *)
    EVAL RTHeapRep.Crash ();
    RTOS.Crash ();
  END Crash;

------------------------------------------------------ Ctl-C interrupts ---


VAR
  cur_handler: InterruptHandler := NIL;
  cur_enable : InterruptHandler := NIL;
  cur_disable: InterruptHandler := NIL;
  enabled    : BOOLEAN := FALSE;

PROCEDURE OnInterrupt (p: InterruptHandler): InterruptHandler =
  (* This procedure should be atomic... but I doubt anyone cares. *)
  VAR old := cur_handler;
  BEGIN
    IF enabled = (p = NIL) THEN
      IF enabled
        THEN IF (cur_disable # NIL) THEN cur_disable (); END;
        ELSE IF (cur_enable  # NIL) THEN cur_enable ();  END;
      END;
      enabled := NOT enabled;
    END;

    cur_handler := p;
    RETURN old;
  END OnInterrupt;

PROCEDURE RegisterInterruptSetup (enable, disable: PROCEDURE ()) =
  BEGIN
    cur_enable := enable;
    cur_disable := disable;
  END RegisterInterruptSetup;

BEGIN
END RTProcess.