src/Pure/ML-Systems/polyml_common.ML
author wenzelm
Thu, 06 Mar 2008 19:21:26 +0100
changeset 26215 94d32a7cd0fb
child 26220 d34b68c21f9a
permissions -rw-r--r--
rearrangements to make latest Poly/ML the default, not old 4.x;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
26215
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
     1
(*  Title:      Pure/ML-Systems/polyml_common.ML
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
     2
    ID:         $Id$
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
     3
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
     4
Compatibility file for Poly/ML -- common part for 4.x and 5.x.
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
     5
*)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
     6
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
     7
use "ML-Systems/exn.ML";
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
     8
if List.exists (fn s => s = "Universal") (PolyML.Compiler.structureNames ()) then ()
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
     9
else use "ML-Systems/universal.ML";
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    10
use "ML-Systems/multithreading.ML";
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    11
use "ML-Systems/time_limit.ML";
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    12
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    13
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    14
(** ML system and platform related **)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    15
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    16
(* Compiler options *)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    17
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    18
val ml_system_fix_ints = false;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    19
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    20
PolyML.Compiler.printInAlphabeticalOrder := false;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    21
PolyML.Compiler.maxInlineSize := 80;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    22
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    23
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    24
(* String compatibility *)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    25
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    26
(*low-level pointer equality*)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    27
val pointer_eq = Address.wordEq;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    28
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    29
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    30
(* old Poly/ML emulation *)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    31
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    32
local
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    33
  val orig_exit = exit;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    34
in
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    35
  open PolyML;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    36
  val exit = orig_exit;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    37
  fun quit () = exit 0;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    38
end;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    39
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    40
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    41
(* restore old-style character / string functions *)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    42
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    43
val ord = SML90.ord;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    44
val chr = SML90.chr;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    45
val explode = SML90.explode;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    46
val implode = SML90.implode;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    47
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    48
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    49
(* compiler-independent timing functions *)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    50
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    51
fun start_timing () =
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    52
  let val CPUtimer = Timer.startCPUTimer();
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    53
      val time = Timer.checkCPUTimer(CPUtimer)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    54
  in  (CPUtimer,time)  end;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    55
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    56
fun end_timing (CPUtimer, {sys,usr}) =
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    57
  let open Time  (*...for Time.toString, Time.+ and Time.- *)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    58
      val {sys=sys2,usr=usr2} = Timer.checkCPUTimer(CPUtimer)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    59
  in  "User " ^ toString (usr2-usr) ^
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    60
      "  All "^ toString (sys2-sys + usr2-usr) ^
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    61
      " secs"
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    62
      handle Time => ""
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    63
  end;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    64
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    65
fun check_timer timer =
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    66
  let
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    67
    val {sys, usr} = Timer.checkCPUTimer timer;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    68
    val gc = Timer.checkGCTime timer;    (* FIXME already included in usr? *)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    69
  in (sys, usr, gc) end;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    70
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    71
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    72
(* prompts *)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    73
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    74
fun ml_prompts p1 p2 = (PolyML.Compiler.prompt1 := p1; PolyML.Compiler.prompt2 := p2);
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    75
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    76
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    77
(* toplevel pretty printing (see also Pure/pure_setup.ML) *)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    78
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    79
fun make_pp _ pprint (str, blk, brk, en) _ _ obj =
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    80
  pprint obj (str, fn ind => blk (ind, false), fn wd => brk (wd, 0),
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    81
    fn () => brk (99999, 0), en);
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    82
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    83
(*print depth*)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    84
local
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    85
  val depth = ref 10;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    86
in
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    87
  fun get_print_depth () = ! depth;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    88
  fun print_depth n = (depth := n; PolyML.print_depth n);
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    89
end;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    90
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    91
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    92
(* ML command execution -- 'eval' *)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    93
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    94
fun use_text (tune: string -> string) name (print, err) verbose txt =
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    95
  let
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    96
    val in_buffer = ref (explode (tune txt));
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    97
    val out_buffer = ref ([]: string list);
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    98
    fun output () = implode (rev (case ! out_buffer of "\n" :: cs => cs | cs => cs));
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
    99
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   100
    fun get () =
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   101
      (case ! in_buffer of
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   102
        [] => ""
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   103
      | c :: cs => (in_buffer := cs; c));
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   104
    fun put s = out_buffer := s :: ! out_buffer;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   105
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   106
    fun exec () =
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   107
      (case ! in_buffer of
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   108
        [] => ()
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   109
      | _ => (PolyML.compiler (get, put) (); exec ()));
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   110
  in
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   111
    exec () handle exn =>
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   112
      (err ((if name = "" then "" else "Error in " ^ name ^ "\n") ^ output ()); raise exn);
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   113
    if verbose then print (output ()) else ()
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   114
  end;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   115
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   116
fun use_file tune output verbose name =
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   117
  let
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   118
    val instream = TextIO.openIn name;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   119
    val txt = TextIO.inputAll instream before TextIO.closeIn instream;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   120
  in use_text tune name output verbose txt end;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   121
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   122
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   123
(*eval command line arguments*)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   124
local
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   125
  fun println s =
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   126
    (TextIO.output (TextIO.stdOut, s ^ "\n"); TextIO.flushOut TextIO.stdOut);
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   127
  fun eval "-q" = ()
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   128
    | eval txt = use_text (fn x => x) "" (println, println) false txt;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   129
in
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   130
  val _ = PolyML.onEntry (fn () =>
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   131
   (Signal.signal (2, Signal.SIG_HANDLE (fn _ => Process.interruptConsoleProcesses ()));
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   132
    app eval (CommandLine.arguments ())));
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   133
end;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   134
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   135
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   136
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   137
(** interrupts **)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   138
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   139
exception Interrupt = SML90.Interrupt;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   140
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   141
local
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   142
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   143
val sig_int = 2;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   144
val default_handler = Signal.SIG_HANDLE (fn _ => Process.interruptConsoleProcesses ());
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   145
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   146
val _ = Signal.signal (sig_int, default_handler);
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   147
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   148
fun change_signal new_handler f x =
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   149
  let
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   150
    (*RACE wrt. other signals!*)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   151
    val old_handler = Signal.signal (sig_int, new_handler);
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   152
    val result = Exn.capture (f old_handler) x;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   153
    val _ = Signal.signal (sig_int, old_handler);
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   154
  in Exn.release result end;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   155
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   156
in
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   157
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   158
fun interruptible f = change_signal default_handler (fn _ => f);
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   159
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   160
fun uninterruptible f =
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   161
  change_signal Signal.SIG_IGN
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   162
    (fn old_handler => f (fn g => change_signal old_handler (fn _ => g)));
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   163
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   164
end;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   165
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   166
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   167
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   168
(** OS related **)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   169
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   170
(* Posix patches *)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   171
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   172
(*This extension of the Poly/ML Signal structure is only necessary
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   173
  because in SML/NJ, types Posix.Signal.signal and Signals.signal differ.*)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   174
structure IsaSignal =
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   175
struct
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   176
  open Signal
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   177
  val usr1 = Posix.Signal.usr1
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   178
  val usr2 = Posix.Signal.usr2
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   179
  val alrm = Posix.Signal.alrm
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   180
  val chld = Posix.Signal.chld
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   181
  val cont = Posix.Signal.cont
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   182
  val int  = Posix.Signal.int
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   183
  val quit = Posix.Signal.quit
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   184
end;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   185
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   186
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   187
(* current directory *)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   188
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   189
val cd = OS.FileSys.chDir;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   190
val pwd = OS.FileSys.getDir;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   191
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   192
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   193
(* system command execution *)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   194
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   195
(*execute Unix command which doesn't take any input from stdin and
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   196
  sends its output to stdout; could be done more easily by Unix.execute,
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   197
  but that function doesn't use the PATH*)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   198
fun execute command =
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   199
  let
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   200
    val tmp_name = OS.FileSys.tmpName ();
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   201
    val is = (OS.Process.system (command ^ " > " ^ tmp_name); TextIO.openIn tmp_name);
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   202
    val result = TextIO.inputAll is;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   203
  in
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   204
    TextIO.closeIn is;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   205
    OS.FileSys.remove tmp_name;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   206
    result
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   207
  end;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   208
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   209
(*plain version; with return code*)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   210
fun system cmd =
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   211
  if OS.Process.isSuccess (OS.Process.system cmd) then 0 else 1;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   212
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   213
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   214
(*Convert a process ID to a decimal string (chiefly for tracing)*)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   215
fun string_of_pid pid =
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   216
  Word.fmt StringCvt.DEC (Word.fromLargeWord (Posix.Process.pidToWord pid));
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   217
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   218
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   219
(* getenv *)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   220
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   221
fun getenv var =
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   222
  (case OS.Process.getEnv var of
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   223
    NONE => ""
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   224
  | SOME txt => txt);
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   225
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   226
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   227
(* profile execution *)
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   228
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   229
fun profile 0 f x = f x
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   230
  | profile n f x =
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   231
      let
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   232
        val _ = RunCall.run_call1 RuntimeCalls.POLY_SYS_profiler n;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   233
        val res = Exn.capture f x;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   234
        val _ = RunCall.run_call1 RuntimeCalls.POLY_SYS_profiler 0;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   235
      in Exn.release res end;
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents:
diff changeset
   236