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

(* File: OS.m3                                                 *)
(* Last modified on Mon Nov  9 12:23:45 MET 1992 by preschern  *)
(*      modified on Mon Aug 10 08:13:19 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, Rd, Wr, Thread, Stdio, Uerror;
IMPORT Unix, Usignal, Uprocess, Ustat, Udos, UFileWr, Text, NameMap;
<* FATAL Wr.Failure, Rd.Failure, Thread.Alerted *>

REVEAL Dir = BRANDED "OS.Dir" REF Udos.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 (NameMap.GetDos (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) =
  VAR string: TEXT;
  BEGIN
    string := "cp " & old & " " & new;
    EVAL Unix.system (M3toC.TtoS (string));
(**********
    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.Mrwrr + 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 := Udos.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 := Udos.readdir (d^);
    name: TEXT;
  <*FATAL Rd.Failure*>
  BEGIN
    IF (x = NIL) THEN RETURN NIL END;
    name:= M3toC.CopyStoT (LOOPHOLE (ADR (x.d_name), Ctypes.char_star));
    IF Text.FindChar(name, NameMap.DollarChar) >= 0 THEN
      name:= NameMap.GetLong(name);
    END;
    RETURN name;
  END ReadDir;

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

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

PROCEDURE CallSystem (program: TEXT; args: ArgList) =
  VAR string: TEXT := program;
  BEGIN
    FOR i := 1 TO LAST (args^) DO
      string := string & " " & args^ [i];
    END (* for *); 
    EVAL Unix.system (M3toC.TtoS (string));
  END CallSystem;

PROCEDURE Run (program: TEXT;  args: ArgList): RunResult =
  VAR result := RunResult { signal := 0,  status := 0,  core_dumped := FALSE };
      string:= "";
  BEGIN
    FOR i := 1 TO LAST (args^) DO
      string := string & " " & args^ [i];
    END (* for *); 
    result.status:= Unix.system (M3toC.TtoS (string));
    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;

PROCEDURE Fork (program: TEXT;  args: ArgList): Handle =
  VAR h: Handle; pid: INTEGER;
  BEGIN
    pid := 0;
    h := NEW (Handle, pid := pid);
    CallSystem (program, args);
    RETURN h;
  END Fork;

PROCEDURE Stop (h: Handle;  waitP: BOOLEAN := FALSE) =
  CONST SIGTERM = 15;
  VAR status := 0;
  BEGIN
    <* ASSERT FALSE *>
(*********
    IF waitP
      THEN EVAL Uexec.wait (ADR (status)); (* waitpid (h.pid, status, 0) *)
      ELSE EVAL Usignal.kill (h.pid, 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;

(****************

TYPE CArgList = REF ARRAY OF Ctypes.char_star;

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.