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

(* File: OS.m3                                                 *)
(* Last modified on Wed Oct 14 07:48:53 PDT 1992 by kalsow     *)
(*      modified on Tue Mar 24 16:04:38 PST 1992 by muller     *)

UNSAFE MODULE OS;

IMPORT RTArgs, M3toC, RTMisc, Ctypes, Time, Word, Rd, Wr, Thread, Stdio;
IMPORT Unix, Udir, Usignal, Uprocess, Uexec, Ustat, Utime, UFileRd, UFileWr;

REVEAL Dir = BRANDED "OS.Dir" REF Udir.DIR_star;

PROCEDURE NumParameters (): INTEGER =
  BEGIN
    RETURN RTArgs.argc;
  END NumParameters;

PROCEDURE GetParameter (n: INTEGER): TEXT =
  VAR arg: UNTRACED REF ADDRESS;
  BEGIN
    IF (n < 0) OR (RTArgs.argc <= n) THEN RETURN NIL END;
    arg := RTArgs.argv + n * ADRSIZE (ADDRESS);
    RETURN M3toC.StoT (arg^);
  END GetParameter;

PROCEDURE CreateTime (file: TEXT): INTEGER =
  VAR s: Ustat.struct_stat;
  BEGIN
    IF Ustat.stat (M3toC.CopyTtoS (file), ADR (s)) = 0 THEN
      RETURN s.st_mtime;
    ELSE
      RETURN NO_TIME;
    END;
  END CreateTime;

PROCEDURE Now (): INTEGER =
  BEGIN
    RETURN Time.Now().seconds;
  END Now;

PROCEDURE Remove (file: TEXT) =
  BEGIN
    EVAL Unix.unlink (M3toC.TtoS (file));
  END Remove;

PROCEDURE Rename (old, new: TEXT) =
  BEGIN
    EVAL Unix.rename (M3toC.TtoS (old), M3toC.TtoS (new));
  END Rename;

PROCEDURE Clone (old, new: TEXT) =
  BEGIN
    EVAL Unix.symlink (M3toC.TtoS (old), M3toC.TtoS (new));
  END Clone;

PROCEDURE NewExec (name: TEXT): Wr.T =
  <*FATAL Wr.Failure, Thread.Alerted*>
  CONST Mode = Unix.O_WRONLY + Unix.O_CREAT + Unix.O_TRUNC;
  CONST Flags = Unix.Mrwrwrw + Unix.MXOWNER + Unix.MXGROUP + Unix.MXOTHER;
  VAR fd := Unix.open (M3toC.TtoS (name), Mode, Flags);
  BEGIN
    RETURN UFileWr.New (fd);
  END NewExec;

PROCEDURE OpenDir (name: TEXT): Dir =
  VAR dx := Udir.opendir (M3toC.CopyTtoS (name));
  VAR d: Dir;
  BEGIN
    IF (dx = NIL) THEN RETURN NIL END;
    d  := NEW (Dir);
    d^ := dx;
    RETURN d;
  END OpenDir;

PROCEDURE ReadDir (d: Dir): TEXT =
  VAR x := Udir.readdir (d^);
  BEGIN
  IF (x = NIL) THEN RETURN NIL END;
  RETURN M3toC.CopyStoT (LOOPHOLE (ADR (x.d_name), Ctypes.char_star));
  END ReadDir;

PROCEDURE CloseDir (d: Dir) =
  BEGIN
    EVAL Udir.closedir (d^);
  END CloseDir;

(************
<*EXTERNAL*> PROCEDURE system (s: Ctypes.char_star): INTEGER;
*************)

TYPE CArgList = REF ARRAY OF Ctypes.char_star;

PROCEDURE Run (program: TEXT;  args: ArgList): RunResult =
  VAR result := RunResult { signal := 0,  status := 0,  core_dumped := FALSE };
  VAR argx   := ConvertArgs (args);
  VAR argv   : Ctypes.char_star_star := ADR (argx[0]);
  VAR status : Ctypes.int;
  VAR x      : Ctypes.int;
  BEGIN
    CASE Unix.vfork () OF
    | -1 => (* failure? *)
            result.signal := -1;  result.status := -1;

    | 0  => (* in the child *)
            x := Uexec.execvp (M3toC.TtoS (program), argv);
            IF (x < 0) THEN
              result.signal := x;  result.status := -3;
            ELSE
              (* should never return if the exec was successful *)
              <* ASSERT FALSE *>
            END;

    ELSE    (* in the parent, after the fork *)
            x := Uexec.wait (ADR (status));
            IF (x < 0) THEN
              result.signal := x;  result.status := -2;
            ELSE
              result.signal      := Word.And (status, 16_7F);
              result.core_dumped := Word.And (status, 16_80) # 0;
              result.status      := Word.And (status, 16_FF00) DIV 16_80;
            END;
    END;
    RETURN result;
  END Run;

PROCEDURE Exit (n: INTEGER) =
  BEGIN
    RTMisc.Exit (n);
    <* ASSERT FALSE *>
  END Exit;

VAR user_cleanup : PROCEDURE () := NIL;

PROCEDURE OnShutDown (cleanup: PROCEDURE ()) =
  BEGIN
    user_cleanup := cleanup;
    SetHandler (Usignal.SIGTERM);
    SetHandler (Usignal.SIGINT);
    SetHandler (Usignal.SIGHUP);
  END OnShutDown;

PROCEDURE SetHandler (sig: Ctypes.int) =
  VAR new, old: Usignal.struct_sigvec;
  BEGIN
    new.sv_handler := Usignal.SIG_IGN;
    new.sv_mask    := Usignal.empty_sv_mask;
    new.sv_flags   := 0;
    IF Usignal.sigvec (sig, new, old) # 0 THEN RETURN END;
    IF (old.sv_handler = Usignal.SIG_IGN) THEN RETURN END;
    new.sv_handler := CleanUp;
    EVAL Usignal.sigvec (sig, new, old);
  END SetHandler;

PROCEDURE CleanUp (sig: INTEGER;  <*UNUSED*> code: INTEGER;
                   <*UNUSED*> scp: UNTRACED REF Usignal.struct_sigcontext) =
  VAR new, old: Usignal.struct_sigvec;
  BEGIN
    IF (sig # -1) THEN
      new.sv_handler := Usignal.SIG_DFL;
      new.sv_mask    := Usignal.empty_sv_mask;
      new.sv_flags   := 0;
      EVAL Usignal.sigvec (sig, new, old);
      EVAL Usignal.kill (Uprocess.getpid (), sig);
    END;
    IF (user_cleanup # NIL) THEN user_cleanup () END;
  END CleanUp;

TYPE Pipe = ARRAY [0..1] OF Ctypes.int;

PROCEDURE Fork (program: TEXT;  args: ArgList): Handle =
  VAR argx := ConvertArgs (args);
  VAR argv : Ctypes.char_star_star := ADR (argx[0]);
  VAR stdin, stdout: Pipe;  h: Handle;  pid: INTEGER;
  BEGIN
    IF (Unix.pipe (stdin) # 0) OR (Unix.pipe (stdout) # 0) THEN
      h := NEW (Handle, error := "couldn't create pipes");
      RETURN h;
    END;

    pid := Unix.vfork ();

    CASE pid OF
    | -1 => (* failure? *)
            h := NEW (Handle, error := "couldn't fork");
            RETURN h;

    | 0  => (* in the child *)
            IF   (Unix.close (stdin [1]) # 0)
              OR (Unix.close (stdout [0]) # 0) THEN
              Die ("Child-process couldn't close pipes.")
            ELSIF (Unix.dup2 (stdin [0], 0) = -1)
               OR (Unix.dup2 (stdout [1], 1) = -1) THEN
              Die ("Couldn't set stdio channels for child.")
            ELSIF NOT DisableTimer (Utime.ITIMER_VIRTUAL) THEN
              Die ("Couldn't disable virtual timer.")
            END;
            EVAL Uexec.execvp (M3toC.TtoS (program), argv);
            <* ASSERT FALSE *>

    ELSE    (* in the parent *)
            h := NEW (Handle, pid := pid);
            IF (Unix.close (stdin [0]) # 0)
               OR (Unix.close (stdout [1]) # 0) THEN
               h.error := "parent process couldn't close pipes.";
               RETURN h;
            END;
            TRY
              h.stdin  := UFileWr.New (stdin [1], TRUE);
              h.stdout := UFileRd.New (stdout [0]);
            EXCEPT Wr.Failure, Rd.Failure =>
              h.error := "unable to create pipe reader or writer";
            END;
            RETURN h;
    END;
  END Fork;

PROCEDURE Stop (h: Handle;  waitP: BOOLEAN := FALSE) =
  VAR status := 0;
  BEGIN
    IF waitP
      THEN EVAL Uexec.wait (ADR (status)); (* waitpid (h.pid, status, 0) *)
      ELSE EVAL Usignal.kill (h.pid, Usignal.SIGTERM);
    END;
    TRY    Wr.Close (h.stdin);
    EXCEPT Wr.Failure, Thread.Alerted => (* ignore *)
    END;
    TRY    Rd.Close (h.stdout);
    EXCEPT Wr.Failure, Rd.Failure, Thread.Alerted => (* ignore *)
    END;
    h.stdin := NIL;
    h.stdout := NIL;
  END Stop;

PROCEDURE ConvertArgs (args: ArgList): CArgList =
  VAR argx := NEW (CArgList, NUMBER (args^)+1);
  BEGIN
    FOR i := 0 TO LAST (args^) DO argx[i] := M3toC.TtoS (args[i]) END;
    argx[LAST(argx^)] := NIL;
    RETURN argx;
  END ConvertArgs;

PROCEDURE Die (msg: TEXT) =
  BEGIN
    TRY
      Wr.PutText (Stdio.stderr, msg);
      Wr.Flush (Stdio.stderr)
    EXCEPT
    ELSE (* ignore failures at this point *)
    END;
    Exit (-1);
  END Die;
    
PROCEDURE DisableTimer (which: [Utime.ITIMER_REAL .. Utime.ITIMER_PROF]):
  BOOLEAN =
  VAR
    value := Utime.struct_itimerval {
               Utime.struct_timeval {0, 0}, Utime.struct_timeval {0, 0}};
    ovalue := Utime.struct_itimerval {
                Utime.struct_timeval {0, 0}, Utime.struct_timeval {0, 0}};
  BEGIN
    RETURN Utime.setitimer (which, value, ovalue) = 0
  END DisableTimer;

BEGIN
END OS.