diff --git a/backward-interface.lisp b/backward-interface.lisp
index 6ecf0147e68777f14b817d513d3d0853c283d23c..7b43a6f7870a0ab9cfc9f5f1739dc682e7d98a38 100644
--- a/backward-interface.lisp
+++ b/backward-interface.lisp
@@ -145,15 +145,12 @@ Deprecated function, for backward-compatibility only.
 Please use UIOP:RUN-PROGRAM instead."
     (let ((command (apply 'format nil control-string args)))
       (asdf-message "; $ ~A~%" command)
-      (handler-case
-          (progn
-            (run-program command :force-shell t :ignore-error-status nil :output *verbose-out*)
-            0)
-        (subprocess-error (c)
-          (let ((code (subprocess-error-code c)))
-            (typecase code
-              (integer code)
-              (t 255))))))))
+      (let ((exit-code
+              (nth-value 2 (run-program command :force-shell t :ignore-error-status t
+                                                :output *verbose-out*))))
+        (typecase exit-code
+          ((integer 0 255) exit-code)
+          (t 255))))))
 
 (with-upgradability ()
   (defvar *asdf-verbose* nil)) ;; backward-compatibility with ASDF2 only. Unused.
diff --git a/test/test-program.script b/test/test-program.script
index 68fca6de5c4d39bd5452cecb24791928c1090683..a02be952613636c4facc87893379dfcf37cd619a 100644
--- a/test/test-program.script
+++ b/test/test-program.script
@@ -29,9 +29,12 @@
 (initialize-source-registry `(:source-registry :ignore-inherited-configuration))
 
 (delete-file-if-exists exe)
-(run-program
- (symbol-call :lisp-invocation :lisp-invocation-arglist
-              :load (native-namestring (subpathname *test-directory* "make-hello-world.lisp"))))
+(assert-equal
+ (multiple-value-list
+  (run-program
+   (symbol-call :lisp-invocation :lisp-invocation-arglist
+                :load (native-namestring (subpathname *test-directory* "make-hello-world.lisp")))))
+ '(nil nil 0))
 (assert (probe-file* exe))
 
 (assert-equal (run-program `(,(native-namestring exe)) :output :lines)
diff --git a/test/test-run-program.script b/test/test-run-program.script
index 52934f6b4856c867b3f504459579ddba44f68353..1595e8985fcfee34d49bac496f7c9227f9e569d1 100644
--- a/test/test-run-program.script
+++ b/test/test-run-program.script
@@ -56,10 +56,10 @@
 (assert-equal (format nil "ok  1~%") (remove-cr (run-program '("echo" "ok  1") :output :string)))
 ;; this test checks for a problem there was in allegro -- :output :interactive
 ;; would try to open T as a stream for INPUT.
-(assert-equal 0 (run-program "true" :force-shell t :output :interactive))
-(assert-equal 0 (run-program "true" :force-shell nil :output :interactive))
-(assert-equal 1 (run-program "false" :force-shell t :output :interactive :ignore-error-status t))
-(assert-equal 1 (run-program "false" :force-shell nil :output :interactive :ignore-error-status t))
+(assert-equal '(nil nil 0) (multiple-value-list (run-program "true" :force-shell t :output :interactive)))
+(assert-equal '(nil nil 0) (multiple-value-list (run-program "true" :force-shell nil :output :interactive)))
+(assert-equal '(nil nil 1) (multiple-value-list (run-program "false" :force-shell t :output :interactive :ignore-error-status t)))
+(assert-equal '(nil nil 1) (multiple-value-list (run-program "false" :force-shell nil :output :interactive :ignore-error-status t)))
 
 
 ;;#+allegro (trace excl:run-shell-command sys:reap-os-subprocess)
@@ -195,16 +195,16 @@ Testing run-program
   (signals error (run-program '("does-not-exist") :output :lines))
   (signals error (run-program "does-not-exist" :output :lines))
 
-  (is (equal 0 (run-program "echo ok" :output nil)))
-  (is (equal 0 (run-program '("echo" "ok") :output nil)))
+  (is (equal '(nil nil 0) (multiple-value-list (run-program "echo ok" :output nil))))
+  (is (equal '(nil nil 0) (multiple-value-list (run-program '("echo" "ok") :output nil))))
   t)
 
 
 (defun unix-only-test/run-program ()
 
-  (is (equal 0 (run-program "true")))
+  (is (equal '(nil nil 0) (multiple-value-list (run-program "true"))))
   (signals subprocess-error (run-program "false"))
-  (is (equal 1 (run-program "false" :ignore-error-status t)))
+  (is (equal '(nil nil 1) (multiple-value-list (run-program "false" :ignore-error-status t))))
 
   (let ((tf (native-namestring (test-source "test-file"))))
 
diff --git a/uiop/README b/uiop/README
index 953637b0ffe695ab8b393d3618237237096bebd8..28cf52372d8af9a2436e4ce963cd3a9d8232f618 100644
--- a/uiop/README
+++ b/uiop/README
@@ -11,13 +11,15 @@ according to its topic: e.g pathname.lisp will define package UIOP/PATHNAME
 and contain utilities related to the handling of pathname objects.
 All exported symbols are reexported in a convenience package UIOP.
 
-The files that constitute UIOP are, in order:
+The files that constitute UIOP are, in loading order:
 
 * package: to deal with packages and their symbols, most notably including
   DEFINE-PACKAGE, a variant of defpackage capable of hot-upgrade.
 
 * common-lisp: to let you paper over various sub-standard implementations
   Corman, GCL, Genera, MCL are the biggest (unmaintained) offenders.
+  Supported without much any issues are:
+  ABCL, Allegro, CCL, CMUCL, CLISP, ECL, LispWorks, MKCL, SBCL, XCL.
 
 * utility: to provide macros and functions that do not involve I/O, handling
   control-flow, (p)lists, character, strings, functions, classes, conditions,
@@ -46,6 +48,7 @@ The files that constitute UIOP are, in order:
   accessing command line arguments or quitting the process.
 
 * run-program: to portably spawn external processes and capture their output.
+  Can also capture error-output, inject input, or let it all be interactive.
 
 * lisp-build: to portably compile common-lisp code, handle compilation results,
   muffle uninteresting conditions, save and restore deferred warnings,
diff --git a/uiop/common-lisp.lisp b/uiop/common-lisp.lisp
index f76b3a7b567131c4c12b0c1b68b288f0f644f661..0c39cf529834f9a76c71efa0bd7860ffefb4f423 100644
--- a/uiop/common-lisp.lisp
+++ b/uiop/common-lisp.lisp
@@ -148,6 +148,12 @@
 ;;;; compatfmt: avoid fancy format directives when unsupported
 (eval-when (:load-toplevel :compile-toplevel :execute)
   (defun frob-substrings (string substrings &optional frob)
+    "for each substring in SUBSTRINGS, find occurrences of it within STRING
+that don't use parts of matched occurrences of previous strings, and
+FROB them, that is to say, remove them if FROB is NIL,
+replace by FROB if FROB is a STRING, or if FROB is a FUNCTION,
+call FROB with the match and a function that emits a string in the output.
+Return a string made of the parts not omitted or emitted by FROB."
     (declare (optimize (speed 0) (safety 3) (debug 3)))
     (let ((length (length string)) (stream nil))
       (labels ((emit-string (x &optional (start 0) (end (length x)))
@@ -184,5 +190,3 @@
     #+(or gcl genera)
     (frob-substrings format `("~3i~_" #+(or genera gcl2.6) ,@'("~@<" "~@;" "~@:>" "~:>")))
     #-(or gcl genera) format))
-
-
diff --git a/uiop/filesystem.lisp b/uiop/filesystem.lisp
index 89bc42c66a6a90f67b11e2a19ae0929469fcdd5f..4fc0783f3ae29cb00c159089b970a37c2e4d8309 100644
--- a/uiop/filesystem.lisp
+++ b/uiop/filesystem.lisp
@@ -410,8 +410,8 @@ TRUENAMIZE uses TRUENAMIZE to resolve as many symlinks as possible."
   (defun call-with-current-directory (dir thunk)
     (if dir
         (let* ((dir (resolve-symlinks* (get-pathname-defaults (pathname-directory-pathname dir))))
-               (*default-pathname-defaults* dir)
-               (cwd (getcwd)))
+               (cwd (getcwd))
+               (*default-pathname-defaults* dir))
           (chdir dir)
           (unwind-protect
                (funcall thunk)
diff --git a/uiop/image.lisp b/uiop/image.lisp
index 1c27293259d3779d62987ab574d23870ded4f624..bbe7840d8443fd0f22f2f684d288f2d6eec5ea3f 100644
--- a/uiop/image.lisp
+++ b/uiop/image.lisp
@@ -347,5 +347,6 @@ if we are not called from a directly executable image."
 ;;; Some universal image restore hooks
 (with-upgradability ()
   (map () 'register-image-restore-hook
-       '(setup-temporary-directory setup-stderr setup-command-line-arguments
+       '(setup-stdin setup-stdout setup-stderr
+         setup-command-line-arguments setup-temporary-directory
          #+abcl detect-os)))
diff --git a/uiop/run-program.lisp b/uiop/run-program.lisp
index 5e2693946395c28c7e778ca2c39bdecbba7f8077..efe374deb75ce36bd8f9b48db7aca54ce6d51378 100644
--- a/uiop/run-program.lisp
+++ b/uiop/run-program.lisp
@@ -12,7 +12,7 @@
    #:escape-token #:escape-command
 
    ;;; run-program
-   #:slurp-input-stream
+   #:slurp-input-stream #:vomit-output-stream
    #:run-program
    #:subprocess-error
    #:subprocess-error-code #:subprocess-error-command #:subprocess-error-process
@@ -97,8 +97,7 @@ omit the outer double-quotes if key argument :QUOTE is NIL"
   (defun escape-sh-token (token &optional s)
     "Escape a string TOKEN within double-quotes if needed
 for use within a POSIX Bourne shell, outputing to S."
-    (escape-token token :stream s :quote #\" :good-chars
-                  #'easy-sh-character-p
+    (escape-token token :stream s :quote #\" :good-chars #'easy-sh-character-p
                         :escaper 'escape-sh-token-within-double-quotes))
 
   (defun escape-shell-token (token &optional s)
@@ -136,6 +135,11 @@ by /bin/sh in POSIX"
 
 ;;;; Slurping a stream, typically the output of another program
 (with-upgradability ()
+  (defun call-stream-processor (fun processor stream)
+    (if (consp processor)
+        (apply fun (first processor) stream (rest processor))
+        (funcall fun processor stream)))
+
   (defgeneric slurp-input-stream (processor input-stream &key &allow-other-keys)
     (:documentation
      "SLURP-INPUT-STREAM is a generic function with two positional arguments
@@ -145,10 +149,10 @@ specified by PROCESSOR.
 
 Built-in methods include the following:
 * if PROCESSOR is a function, it is called with the INPUT-STREAM as its argument
-* if PROCESSOR is a list, its first element should be a function.  It will be applied to a cons of the 
+* if PROCESSOR is a list, its first element should be a function.  It will be applied to a cons of the
   INPUT-STREAM and the rest of the list.  That is (x . y) will be treated as
     \(APPLY x <stream> y\)
-* if PROCESSOR is an output-stream, the contents of INPUT-STREAM is copied to the output-stream, 
+* if PROCESSOR is an output-stream, the contents of INPUT-STREAM is copied to the output-stream,
   per copy-stream-to-stream, with appropriate keyword arguments.
 * if PROCESSOR is the symbol CL:STRING or the keyword :STRING, then the contents of INPUT-STREAM
   are returned as a string, as per SLURP-STREAM-STRING.
@@ -156,6 +160,7 @@ Built-in methods include the following:
 * if PROCESSOR is the keyword :LINE then the INPUT-STREAM will be handled by SLURP-STREAM-LINE.
 * if PROCESSOR is the keyword :FORMS then the INPUT-STREAM will be handled by SLURP-STREAM-FORMS.
 * if PROCESSOR is the keyword :FORM then the INPUT-STREAM will be handled by SLURP-STREAM-FORM.
+* if PROCESSOR is T, it is treated the same as *standard-output*. If it is NIL, NIL is returned.
 
 Programmers are encouraged to define their own methods for this generic function."))
 
@@ -164,7 +169,7 @@ Programmers are encouraged to define their own methods for this generic function
     (funcall function input-stream))
 
   (defmethod slurp-input-stream ((list cons) input-stream &key &allow-other-keys)
-    (apply (first list) (cons input-stream (rest list))))
+    (apply (first list) input-stream (rest list)))
 
   #-(or gcl2.6 genera)
   (defmethod slurp-input-stream ((output-stream stream) input-stream
@@ -201,6 +206,10 @@ Programmers are encouraged to define their own methods for this generic function
     (declare (ignorable x))
     (apply 'slurp-input-stream *standard-output* stream keys))
 
+  (defmethod slurp-input-stream ((x null) stream &rest keys &key &allow-other-keys)
+    (declare (ignorable x stream keys))
+    nil)
+
   (defmethod slurp-input-stream ((pathname pathname) input
                                  &key
                                    (element-type *default-stream-element-type*)
@@ -228,12 +237,92 @@ Programmers are encouraged to define their own methods for this generic function
       #+(or gcl2.6 genera)
       ((output-stream-p x)
        (copy-stream-to-stream
-        input-stream output-stream
+        stream x
         :linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size))
       (t
        (error "Invalid ~S destination ~S" 'slurp-input-stream x)))))
 
 
+(with-upgradability ()
+  (defgeneric vomit-output-stream (processor output-stream &key &allow-other-keys)
+    (:documentation
+     "VOMIT-OUTPUT-STREAM is a generic function with two positional arguments
+PROCESSOR and OUTPUT-STREAM and additional keyword arguments, that produces (vomits)
+some content onto the OUTPUT-STREAM, according to a method specified by PROCESSOR.
+
+Built-in methods include the following:
+* if PROCESSOR is a function, it is called with the OUTPUT-STREAM as its argument
+* if PROCESSOR is a list, its first element should be a function.
+  It will be applied to a cons of the OUTPUT-STREAM and the rest of the list.
+  That is (x . y) will be treated as \(APPLY x <stream> y\)
+* if PROCESSOR is an input-stream, its contents will be copied the OUTPUT-STREAM,
+  per copy-stream-to-stream, with appropriate keyword arguments.
+* if PROCESSOR is a string, its contents will be printed to the OUTPUT-STREAM.
+* if PROCESSOR is T, it is treated the same as *standard-input*. If it is NIL, nothing is done.
+
+Programmers are encouraged to define their own methods for this generic function."))
+
+  #-(or gcl2.6 genera)
+  (defmethod vomit-output-stream ((function function) output-stream &key &allow-other-keys)
+    (funcall function output-stream))
+
+  (defmethod vomit-output-stream ((list cons) output-stream &key &allow-other-keys)
+    (apply (first list) output-stream (rest list)))
+
+  #-(or gcl2.6 genera)
+  (defmethod vomit-output-stream ((input-stream stream) output-stream
+                                 &key linewise prefix (element-type 'character) buffer-size &allow-other-keys)
+    (copy-stream-to-stream
+     input-stream output-stream
+     :linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size))
+
+  (defmethod vomit-output-stream ((x string) stream &key fresh-line terpri &allow-other-keys)
+    (princ x stream)
+    (when fresh-line (fresh-line stream))
+    (when terpri (terpri stream))
+    (values))
+
+  (defmethod vomit-output-stream ((x (eql t)) stream &rest keys &key &allow-other-keys)
+    (declare (ignorable x))
+    (apply 'vomit-output-stream *standard-input* stream keys))
+
+  (defmethod vomit-output-stream ((x null) stream &rest keys &key &allow-other-keys)
+    (declare (ignorable x stream keys))
+    (values))
+
+  (defmethod vomit-output-stream ((pathname pathname) input
+                                 &key
+                                   (element-type *default-stream-element-type*)
+                                   (external-format *utf-8-external-format*)
+                                   (if-exists :rename-and-delete)
+                                   (if-does-not-exist :create)
+                                   buffer-size
+                                   linewise)
+    (with-output-file (output pathname
+                              :element-type element-type
+                              :external-format external-format
+                              :if-exists if-exists
+                              :if-does-not-exist if-does-not-exist)
+      (copy-stream-to-stream
+       input output
+       :element-type element-type :buffer-size buffer-size :linewise linewise)))
+
+  (defmethod vomit-output-stream (x stream
+                                 &key linewise prefix (element-type 'character) buffer-size
+                                 &allow-other-keys)
+    (declare (ignorable stream linewise prefix element-type buffer-size))
+    (cond
+      #+(or gcl2.6 genera)
+      ((functionp x) (funcall x stream))
+      #+(or gcl2.6 genera)
+      ((input-stream-p x)
+       (copy-stream-to-stream
+        x stream
+        :linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size))
+      (t
+       (error "Invalid ~S destination ~S" 'vomit-output-stream x)))))
+
+
 ;;;; ----- Running an external program -----
 ;;; Simple variant of run-program with no input, and capturing output
 ;;; On some implementations, may output to a temporary file...
@@ -248,219 +337,491 @@ Programmers are encouraged to define their own methods for this generic function
                        (subprocess-error-command condition)
                        (subprocess-error-code condition)))))
 
-  (defun run-program (command
-                       &key output ignore-error-status force-shell
-                       (element-type *default-stream-element-type*)
-                       (external-format :default)
-                       &allow-other-keys)
+  ;;; Internal helpers for run-program
+  (defun %normalize-command (command)
+    (etypecase command
+      #+os-unix (string `("/bin/sh" "-c" ,command))
+      #+os-unix (list command)
+      #+os-windows
+      (string
+       ;; NB: We do NOT add cmd /c here. You might want to.
+       #+(or allegro clisp) command
+       ;; On ClozureCL for Windows, we assume you are using
+       ;; r15398 or later in 1.9 or later,
+       ;; so that bug 858 is fixed http://trac.clozure.com/ccl/ticket/858
+       #+clozure (cons "cmd" (strcat "/c " command))
+       ;; NB: On other Windows implementations, this is utterly bogus
+       ;; except in the most trivial cases where no quoting is needed.
+       ;; Use at your own risk.
+       #-(or allegro clisp clozure) (list "cmd" "/c" command))
+      #+os-windows
+      (list
+       #+allegro (escape-windows-command command)
+       #-allegro command)))
+
+  (defun %active-io-specifier-p (specifier)
+    (not (typep specifier '(or null string pathname (member :interactive :output)
+                            #+(or cmu sbcl scl) stream))))
+
+  (defun %normalize-io-specifier (specifier &optional role)
+    (declare (ignorable role))
+    (etypecase specifier
+      (null (or #+(or allegro lispworks) (null-device-pathname)))
+      (string (pathname specifier))
+      (pathname specifier)
+      (stream specifier)
+      ((eql :stream) :stream)
+      ((eql :interactive)
+       #+allegro nil
+       #+clisp :terminal
+       #+(or clozure cmu ecl sbcl scl) t)
+      #+(or allegro clozure cmu ecl lispworks sbcl scl)
+      ((eql :output)
+       (if (eq role :error-output)
+           :output
+           (error "Wrong specifier ~S for role ~S" specifier role)))))
+
+  (defun %interactivep (input output error-output)
+    (member :interactive (list input output error-output)))
+
+  #+clisp
+  (defun clisp-exit-code (raw-exit-code)
+    (typecase raw-exit-code
+      (null 0) ; no error
+      (integer raw-exit-code) ; negative: signal
+      (t -1)))
+
+  (defun %invoke-run-program (command
+                              &rest keys
+                              &key input (if-input-does-not-exist :error)
+                                output (if-output-exists :overwrite)
+                                error-output (if-error-output-exists :overwrite)
+                                directory wait ignore-error-status
+                                #+allegro separate-streams
+                                &allow-other-keys)
+    "Runs the specified command (a list of program and arguments).
+     Returns a process-info plist with possible keys:
+     PROCESS, EXIT-CODE, INPUT-STREAM, OUTPUT-STREAM, BIDIR-STREAM, ERROR-STREAM."
+    ;; NB: these implementations have unix vs windows set at compile-time.
+    (declare (ignorable ignore-error-status directory wait
+                        if-input-does-not-exist if-output-exists if-error-output-exists))
+    (assert (not (and wait (member :stream (list input output error-output)))))
+    #-(or allegro clozure cmu (and lispworks os-unix) sbcl scl)
+    (progn command keys input output error-output
+           (error "run-program not available"))
+    #+(or allegro clisp clozure cmu (and lispworks os-unix) sbcl scl)
+    (let* ((%command (%normalize-command command))
+           (%input (%normalize-io-specifier input :input))
+           (%output (%normalize-io-specifier output :output))
+           (%error-output (%normalize-io-specifier error-output :error-output))
+           (process*
+             #+allegro
+             (multiple-value-list
+              (apply
+               'excl:run-shell-command
+               #+os-unix (coerce (cons (first %command) %command) 'vector)
+               #+os-windows %command
+               :input %input
+               :output %output
+               :error-output %error-output
+               :directory directory :wait wait
+               #+os-windows :show-window #+os-windows (if interactive nil :hide)
+               :allow-other-keys t keys))
+             #-allegro
+             (with-current-directory (#-sbcl directory)
+               #+clisp
+               (flet ((run (f &rest args)
+                        (multiple-value-list
+                         (apply f :input %input :output %output
+                                  :allow-other-keys t `(,@args ,@keys)))))
+                 ;; since we now always return a code, that code path is unused
+                 (assert (eq ignore-error-status t))
+                 (assert (eq error-output :interactive))
+                 (etypecase %command
+                   #+os-windows (string (run 'ext:run-shell-command %command))
+                   (list (run 'ext:run-program (car %command)
+                              :arguments (cdr %command)))))
+               #+(or clozure cmu ecl sbcl scl)
+               (#-ecl progn #+ecl multiple-value-list
+                (apply
+                 '#+(or cmu ecl scl) ext:run-program
+                 #+clozure ccl:run-program #+sbcl sb-ext:run-program
+                 (car %command) (cdr %command)
+                 :input %input
+                 :output %output
+                 :error %error-output
+                 :wait wait
+                 :allow-other-keys t
+                 (append
+                  #+(or clozure cmu sbcl scl)
+                  `(:if-input-does-not-exist ,if-input-does-not-exist
+                    :if-output-exists ,if-output-exists
+                    :if-error-exists ,if-error-output-exists)
+                  #+sbcl `(:search t
+                           :if-output-does-not-exist :create
+                           :if-error-does-not-exist :create)
+                  #-sbcl keys #+sbcl (if directory keys (remove-plist-key :directory keys)))))
+               #+(and lispworks os-unix) ;; note: only used on Unix in non-interactive case
+               (apply
+                'system:run-shell-command
+                (cons "/usr/bin/env" %command) ; lispworks wants a full path.
+                :input %input :if-input-does-not-exist if-input-does-not-exist
+                :output %output :if-output-exists if-output-exists
+                :error %error-output :if-error-output-exists if-error-output-exists
+                :wait wait :save-exit-status t)))
+           (process-info-r ()))
+      (flet ((prop (key value) (push key process-info-r) (push value process-info-r)))
+        #+allegro
+        (cond
+          (wait (prop :exit-code (first process*)))
+          (separate-streams
+           (destructuring-bind (in out err pid) process*
+             (prop :process pid)
+             (when (eq input :stream) (prop :input-stream in))
+             (when (eq output :stream) (prop :output-stream out))
+             (when (eq error-output :stream) (prop :error-stream err))))
+          (t
+           (prop :process (third process*))
+           (let ((x (first process*)))
+             (ecase (+ (if (eq input :stream) 1 0) (if (eq output :stream) 2 0))
+               (0)
+               (1 (prop :input-stream x))
+               (2 (prop :output-stream x))
+               (3 (prop :bidir-stream x))))
+           (when (eq error-output :stream)
+             (prop :error-stream (second process*)))))
+        #+clisp
+        (cond
+          (wait (prop :exit-code (clisp-exit-code (first process*))))
+          (t
+           (ecase (+ (if (eq input :stream) 1 0) (if (eq output :stream) 2 0))
+             (0)
+             (1 (prop :input-stream (first process*)))
+             (2 (prop :output-stream (first process*)))
+             (3 (prop :bidir-stream (pop process*))
+                (prop :input-stream (pop process*))
+                (prop :output-stream (pop process*))))))
+        #+ecl
+        (destructuring-bind (stream code process) process*
+          (let ((mode (+ (if (eq input :stream) 1 0) (if (eq output :stream) 2 0))))
+            (cond
+              ((zerop mode))
+              ((null process*) (prop :exit-code -1))
+              (t (prop (case mode (1 :input-stream) (2 :output-stream) (3 :bidir-stream)) stream))))
+          (when code (prop :exit-code code))
+          (when process (prop :process process)))
+        #+(or clozure cmu sbcl scl)
+        (progn
+          (prop :process process*)
+          (when (eq input :stream)
+            (prop :input-stream
+                  #+clozure (ccl:external-process-input-stream process*)
+                  #+(or cmu scl) (ext:process-input process*)
+                  #+sbcl (sb-ext:process-input process*)))
+          (when (eq output :stream)
+            (prop :output-stream
+                  #+clozure (ccl:external-process-output-stream process*)
+                  #+(or cmu scl) (ext:process-output process*)
+                  #+sbcl (sb-ext:process-output process*)))
+          (when (eq error-output :stream)
+            (prop :error-output-stream
+                  #+clozure (ccl:external-process-error-stream process*)
+                  #+(or cmu scl) (ext:process-error process*)
+                  #+sbcl (sb-ext:process-error process*))))
+        (nreverse process-info-r))))
+
+  (defun %wait-process-result (process-info)
+    (or (getf process-info :exit-code)
+        (let ((process (getf process-info :process)))
+          (when process
+            ;; 1- wait
+            #+(and clozure os-unix) (ccl::external-process-wait process)
+            #+(or cmu scl) (ext:process-wait process)
+            #+(and ecl os-unix) (ext:external-process-wait process)
+            #+sbcl (sb-ext:process-wait process)
+            ;; 2- extract result
+            #+allegro (sys:reap-os-subprocess :pid process :wait t)
+            #+clozure (nth-value 1 (ccl:external-process-status process))
+            #+(or cmu scl) (ext:process-exit-code process)
+            #+ecl (nth-value 1 (ext:external-process-status process))
+            #+lispworks (system:pid-exit-status process :wait t)
+            #+sbcl (sb-ext:process-exit-code process)))))
+
+  (defun %check-result (exit-code &key command process ignore-error-status)
+    (unless ignore-error-status
+      (unless (eql exit-code 0)
+        (cerror "IGNORE-ERROR-STATUS"
+                'subprocess-error :command command :code exit-code :process process)))
+    exit-code)
+
+  (defun %call-with-program-io (gf tval stream-easy-p fun direction spec activep returner
+                                &key element-type external-format &allow-other-keys)
+    ;; handle redirection for run-program and system
+    ;; SPEC is the specification for the subprocess's input or output or error-output
+    ;; TVAL is the value used if the spec is T
+    ;; GF is the generic function to call to handle arbitrary values of SPEC
+    ;; STREAM-EASY-P is T if we're going to use a RUN-PROGRAM that copies streams in the background
+    ;; (it's only meaningful on CMUCL, SBCL, SCL that actually do it)
+    ;; DIRECTION is :INPUT or :OUTPUT for the direction of this io argument
+    ;; FUN is a function of the new reduced spec and an activity function to call with a stream
+    ;; when the subprocess is active and communicating through that stream.
+    ;; ACTIVEP is a boolean true if we will get to run code while the process is running
+    ;; ELEMENT-TYPE and EXTERNAL-FORMAT control what kind of temporary file we may open.
+    ;; RETURNER is a function called with the value of the activity.
+    ;; --- TODO (fare@tunes.org): handle if-output-exists and such when doing it the hard way.
+    (declare (ignorable stream-easy-p))
+    (when (eq spec t) (setf spec tval))
+    (labels ((activity (stream)
+               (call-function returner (call-stream-processor gf spec stream)))
+             (easy-case ()
+               (funcall fun spec nil))
+             (hard-case ()
+               (if activep
+                   (funcall fun :stream #'activity)
+                   (with-temporary-file (:pathname tmp :stream s
+                                         :direction (ecase direction (:input :output) (:output :io))
+                                         :element-type element-type
+                                         :external-format external-format)
+                     (ecase direction
+                       (:input ;; for input
+                        (unwind-protect (activity s)
+                          (ignore-errors (close s)))
+                        (funcall fun tmp nil))
+                       (:output ;; for output, error-output
+                        (unwind-protect
+                             (multiple-value-prog1 (funcall fun tmp nil)
+                               (activity s))
+                          (ignore-errors (close s)))))))))
+      (typecase spec
+        ((or null string pathname (eql :interactive))
+         (easy-case))
+        #+(or cmu sbcl scl) ;; streams are only easy on implementations that try very hard
+        (stream
+         (if stream-easy-p (easy-case) (hard-case)))
+        (t
+         (hard-case)))))
+
+  (defmacro place-setter (place)
+    (when place
+      (let ((value (gensym)))
+        `#'(lambda (,value) (setf ,place ,value)))))
+
+  (defmacro with-program-input (((reduced-input-var
+                                  &optional (input-activity-var (gensym) iavp))
+                                 input-form &key setf stream-easy-p active keys) &body body)
+    `(apply '%call-with-program-io 'vomit-output-stream *standard-input* ,stream-easy-p
+            #'(lambda (,reduced-input-var ,input-activity-var)
+                ,@(unless iavp `((declare (ignore ,input-activity-var))))
+                ,@body)
+            :input ,input-form ,active (place-setter ,setf) ,keys))
+
+  (defmacro with-program-output (((reduced-output-var
+                                  &optional (output-activity-var (gensym) oavp))
+                                  output-form &key setf stream-easy-p active keys) &body body)
+    `(apply '%call-with-program-io 'slurp-input-stream *standard-output* ,stream-easy-p
+            #'(lambda (,reduced-output-var ,output-activity-var)
+                ,@(unless oavp `((declare (ignore ,output-activity-var))))
+                ,@body)
+            :output ,output-form ,active (place-setter ,setf) ,keys))
+
+  (defmacro with-program-error-output (((reduced-error-output-var
+                                         &optional (error-output-activity-var (gensym) eoavp))
+                                        error-output-form &key setf stream-easy-p active keys)
+                                       &body body)
+    `(apply '%call-with-program-io 'slurp-input-stream *error-output* ,stream-easy-p
+            #'(lambda (,reduced-error-output-var ,error-output-activity-var)
+                ,@(unless eoavp `((declare (ignore ,error-output-activity-var))))
+                ,@body)
+            :output ,error-output-form ,active (place-setter ,setf) ,keys))
+
+  (defun %use-run-program (command &rest keys
+                           &key input output error-output ignore-error-status &allow-other-keys)
+    #+(or abcl cormanlisp gcl (and lispworks os-windows) mcl mkcl xcl)
+    (error "Not implemented on this platform")
+    (assert (not (member :stream (list input output error-output))))
+    (let* ((active-input-p (%active-io-specifier-p input))
+           (active-output-p (%active-io-specifier-p output))
+           (active-error-output-p (%active-io-specifier-p error-output))
+           (activity
+             (cond
+               (active-output-p :output)
+               (active-input-p :input)
+               (active-error-output-p :error-output)
+               (t nil)))
+           (wait (not activity))
+           output-result error-output-result exit-code)
+      (with-program-output ((reduced-output output-activity)
+                            output :keys keys :setf output-result
+                            :stream-easy-p t :active (eq activity :output))
+        (with-program-error-output ((reduced-error-output error-output-activity)
+                                    error-output :keys keys :setf error-output-result
+                                    :stream-easy-p t :active (eq activity :error-output))
+          (with-program-input ((reduced-input input-activity)
+                               input :keys keys
+                               :stream-easy-p t :active (eq activity :input))
+            (let ((process-info
+                    (apply '%invoke-run-program command
+                           :wait wait :input reduced-input
+                           :output reduced-output :error-output reduced-error-output
+                           keys)))
+              (flet ((run-activity (activity stream-property)
+                       (if-let ((stream (getf process-info stream-property)))
+                         (funcall activity stream)
+                         (error 'subprocess-error
+                                :code `(:missing ,stream-property)
+                                :command command :process process-info))))
+                (unwind-protect
+                     (ecase activity
+                       ((nil))
+                       (:input (run-activity input-activity :input-stream))
+                       (:output (run-activity output-activity :output-stream))
+                       (:error-output (run-activity error-output-activity :error-output-stream)))
+                  (loop :for (() val) :on process-info :by #'cddr
+                        :when (streamp val) :do (ignore-errors (close val)))
+                  (setf exit-code
+                        (%check-result (%wait-process-result process-info)
+                                       :command command :process process-info
+                                       :ignore-error-status ignore-error-status))))))))
+      (values output-result error-output-result exit-code)))
+
+  (defun %normalize-system-command (command)
+    (etypecase command
+      (string command)
+      (list (escape-shell-command
+             (if (os-unix-p) (cons "exec" command) command)))))
+
+  (defun %redirected-system-command (command in out err directory)
+    (flet ((redirect (spec operator)
+             (let ((pathname
+                     (typecase spec
+                       (null (null-device-pathname))
+                       (string (pathname spec))
+                       (pathname spec)
+                       ((eql :output)
+                        (assert (equal operator "2>"))
+                        (return-from redirect '(" 2>&1"))))))
+               (when pathname
+                 (list " " operator " "
+                       (escape-shell-token (native-namestring pathname)))))))
+      (multiple-value-bind (before after)
+          (let ((normalized (%normalize-system-command command)))
+            (if (os-unix-p)
+                (values '("exec") (list " ; " normalized))
+                (values (list normalized) ())))
+        (reduce/strcat
+         (append
+          before (redirect in "<") (redirect out ">") (redirect err "2>")
+          (when (and directory (os-unix-p)) `("cd " (escape-shell-token directory) " ; "))
+          after)))))
+
+  (defun %invoke-system (command &rest keys
+                         &key input output error-output directory &allow-other-keys)
+    (declare (ignorable input output error-output directory keys))
+    #+(or allegro clozure cmu (and lispworks os-unix) sbcl scl)
+    (%wait-process-result
+     (apply '%invoke-run-program (%normalize-system-command command) keys))
+    #+(or abcl clisp cormanlisp ecl gcl (and lispworks os-windows) mkcl xcl)
+    (let ((%command (%redirected-system-command command input output error-output directory)))
+      #+(and lispworks os-windows)
+      (system:call-system %command :current-directory directory :wait t)
+      #-(and lispworks os-windows)
+      (with-current-directory ((unless (os-unix-p) directory))
+        #+(or abcl xcl) (ext:run-shell-command %command)
+        #+clisp (clisp-exit-code (ext:shell %command))
+        #+cormanlisp (win32:system %command)
+        #+ecl (let ((*standard-input* *stdin*)
+                    (*standard-output* *stdout*)
+                    (*error-output* *stderr*))
+                (ext:system %command))
+        #+gcl (lisp:system %command)
+        #+mcl (ccl::with-cstrs ((%%command %command)) (_system %%command))
+        #+mkcl ;; PROBABLY BOGUS -- ask jcb
+        (multiple-value-bind (io process exit-code)
+            (mkcl:run-program #+windows %command #+windows ()
+                              #-windows "/bin/sh" #-windows (list "-c" %command)
+                              :input t :output t)))))
+
+  (defun %use-system (command &rest keys
+                      &key input output error-output ignore-error-status &allow-other-keys)
+    (let (output-result error-output-result exit-code)
+      (with-program-output ((reduced-output)
+                            output :keys keys :setf output-result)
+        (with-program-error-output ((reduced-error-output)
+                                    error-output :keys keys :setf error-output-result)
+          (with-program-input ((reduced-input) input :keys keys)
+            (setf exit-code
+                  (%check-result (apply '%invoke-system command
+                                        :input reduced-input :output reduced-output
+                                        :error-output reduced-error-output keys)
+                                 :command command
+                                 :ignore-error-status ignore-error-status)))))
+      (values output-result error-output-result exit-code)))
+
+  (defun run-program (command &rest keys
+                       &key ignore-error-status force-shell
+                         (input nil inputp) (if-input-does-not-exist :error)
+                         output (if-output-exists :overwrite)
+                         (error-output nil error-output-p) (if-error-output-exists :overwrite)
+                         (element-type #-clozure *default-stream-element-type* #+clozure 'character)
+                         (external-format *utf-8-external-format*)
+                      &allow-other-keys)
     "Run program specified by COMMAND,
 either a list of strings specifying a program and list of arguments,
 or a string specifying a shell command (/bin/sh on Unix, CMD.EXE on Windows).
 
-Always call a shell (rather than directly execute the command)
+Always call a shell (rather than directly execute the command when possible)
 if FORCE-SHELL is specified.
 
-Signal a SUBPROCESS-ERROR if the process wasn't successful (exit-code 0),
+Signal a continuable SUBPROCESS-ERROR if the process wasn't successful (exit-code 0),
 unless IGNORE-ERROR-STATUS is specified.
 
-If OUTPUT is either NIL or :INTERACTIVE, then
-return the exit status code of the process that was called.
-if it was NIL, the output is discarded;
-if it was :INTERACTIVE, the output and the input are inherited from the current process.
-
+If OUTPUT is a pathname, a string designating a pathname, or NIL designating the null device,
+the file at that path is used as output.
+If it's :INTERACTIVE, output is inherited from the current process.
 Otherwise, OUTPUT should be a value that is a suitable first argument to
-SLURP-INPUT-STREAM (qv.).  In this case, RUN-PROGRAM will create a temporary stream
-for the program output.  The program output, in that stream, will be processed
-by SLURP-INPUT-STREAM, using OUTPUT as the first argument.  RUN-PROGRAM will
-return whatever SLURP-INPUT-STREAM returns.  E.g., using :OUTPUT :STRING will
-have it return the entire output stream as a string.  Use ELEMENT-TYPE and
-EXTERNAL-FORMAT for the stream passed to the OUTPUT processor."
-
-    ;; TODO: The current version does not honor :OUTPUT NIL on Allegro.  Setting
-    ;; the :INPUT and :OUTPUT arguments to RUN-SHELL-COMMAND on ACL actually do
-    ;; what :OUTPUT :INTERACTIVE is advertised to do here.  To get the behavior
-    ;; specified for :OUTPUT NIL, one would have to grab up the process output
-    ;; into a stream and then throw it on the floor.  The consequences of
-    ;; getting this wrong seemed so much worse than having excess output that it
-    ;; is not currently implemented.
-
-    ;; TODO: specially recognize :output pathname ?
-    (declare (ignorable ignore-error-status element-type external-format))
+SLURP-INPUT-STREAM (qv.), or a list of such a value and keyword arguments.
+In this case, RUN-PROGRAM will create a temporary stream for the program output.
+The program output, in that stream, will be processed by a call to SLURP-INPUT-STREAM,
+using OUTPUT as the first argument (or the first element of OUTPUT, and the rest as keywords).
+T designates the *STANDARD-OUTPUT* to be provided to SLURP-INPUT-STREAM.
+The primary value resulting from that call (or NIL if no call was needed)
+will be the first value returned by RUN-PROGRAM.
+E.g., using :OUTPUT :STRING will have it return the entire output stream as a string.
+
+ERROR-OUTPUT is similar to OUTPUT, except that the resulting value is returned
+as the second value of RUN-PROGRAM. T designates the *ERROR-OUTPUT*.
+Also :OUTPUT means redirecting the error output to the output stream, and NIL is returned.
+
+INPUT is similar to OUTPUT, except that VOMIT-OUTPUT-STREAM is used,
+no value is returned, and T designates the *STANDARD-INPUT*.
+
+Use ELEMENT-TYPE and EXTERNAL-FORMAT to specify how streams are created.
+
+One and only one of the stream slurping or vomiting may or may not happen
+in parallel in parallel with the subprocess, depending on options and implementation.
+Other streams are completely produced or consumed before or after the subprocess is spawned,
+using temporary files.
+
+RUN-PROGRAM returns 3 values:
+0- the result of the OUTPUT slurping if any, or NIL
+1- the result of the ERROR-OUTPUT slurping if any, or NIL
+2- either 0 if the subprocess exited with success status,
+or an indication of failure via the EXIT-CODE of the process"
+    (declare (ignorable ignore-error-status))
     #-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl lispworks mcl sbcl scl xcl)
     (error "RUN-PROGRAM not implemented for this Lisp")
-    (labels (#+(or allegro clisp clozure cmu ecl (and lispworks os-unix) sbcl scl)
-             (run-program (command &key pipe interactive)
-               "runs the specified command (a list of program and arguments).
-              If using a pipe, returns two values: process and stream
-              If not using a pipe, returns one values: the process result;
-              also, inherits the output stream."
-               ;; NB: these implementations have unix vs windows set at compile-time.
-               (assert (not (and pipe interactive)))
-               (let* ((wait (not pipe))
-                      #-(and clisp os-windows)
-                      (command
-                        (etypecase command
-                          #+os-unix (string `("/bin/sh" "-c" ,command))
-                          #+os-unix (list command)
-                          #+os-windows
-                          (string
-                           ;; NB: We do NOT add cmd /c here. You might want to.
-                           #+allegro command
-                           ;; On ClozureCL for Windows, we assume you are using
-                           ;; r15398 or later in 1.9 or later,
-                           ;; so that bug 858 is fixed http://trac.clozure.com/ccl/ticket/858
-                           #+clozure (cons "cmd" (strcat "/c " command))
-                           ;; NB: On other Windows implementations, this is utterly bogus
-                           ;; except in the most trivial cases where no quoting is needed.
-                           ;; Use at your own risk.
-                           #-(or allegro clozure) (list "cmd" "/c" command))
-                          #+os-windows
-                          (list
-                           #+allegro (escape-windows-command command)
-                           #-allegro command)))
-                      (process*
-                        (multiple-value-list
-                         #+allegro
-                         (excl:run-shell-command
-                          #+os-unix (coerce (cons (first command) command) 'vector)
-                          #+os-windows command
-                          :input nil
-                          :output (and pipe :stream) :wait wait
-                          #+os-windows :show-window #+os-windows (and (or (null output) pipe) :hide))
-                         #+clisp
-                         (flet ((run (f &rest args)
-                                  (apply f `(,@args :input ,(when interactive :terminal) :wait ,wait :output
-                                                    ,(if pipe :stream :terminal)))))
-                           (etypecase command
-                             #+os-windows (run 'ext:run-shell-command command)
-                             (list (run 'ext:run-program (car command)
-                                        :arguments (cdr command)))))
-                         #+lispworks
-                         (if interactive
-                             (system:call-system-showing-output
-                              #+os-unix
-                              (cons "/usr/bin/env" command) ; lispworks wants a full path.
-                              #-os-unix
-                              command
-                              :show-cmd nil
-                              :wait wait)
-                           (system:run-shell-command
-                            (cons "/usr/bin/env" command) ; lispworks wants a full path.
-                            :input nil :output (and pipe :stream)
-                            :wait wait :save-exit-status (and pipe t)))
-                         #+(or clozure cmu ecl sbcl scl)
-                         (#+(or cmu ecl scl) ext:run-program
-                            #+clozure ccl:run-program
-                            #+sbcl sb-ext:run-program
-                            (car command) (cdr command)
-                            :input interactive :wait wait
-                            :output (if pipe :stream t)
-                            . #.(append
-                                 #+(or clozure cmu ecl sbcl scl) '(:error t)
-                                 ;; note: :external-format requires a recent SBCL
-                                 #+sbcl '(:search t :external-format external-format)))))
-                      (process
-                        #+allegro (if pipe (third process*) (first process*))
-                        #+ecl (third process*)
-                        #-(or allegro ecl) (first process*))
-                      (stream
-                        (when pipe
-                          #+(or allegro lispworks ecl) (first process*)
-                          #+clisp (first process*)
-                          #+clozure (ccl::external-process-output process)
-                          #+(or cmu scl) (ext:process-output process)
-                          #+sbcl (sb-ext:process-output process))))
-                 (values process stream)))
-             #+(or allegro clisp clozure cmu ecl (and lispworks os-unix) sbcl scl)
-             (process-result (process pipe)
-               (declare (ignorable pipe))
-               ;; 1- wait
-               #+(and clozure os-unix) (ccl::external-process-wait process)
-               #+(or cmu scl) (ext:process-wait process)
-               #+(and ecl os-unix) (ext:external-process-wait process)
-               #+sbcl (sb-ext:process-wait process)
-               ;; 2- extract result
-               #+allegro (if pipe (sys:reap-os-subprocess :pid process :wait t) process)
-               #+clisp process
-               #+clozure (nth-value 1 (ccl:external-process-status process))
-               #+(or cmu scl) (ext:process-exit-code process)
-               #+ecl (nth-value 1 (ext:external-process-status process))
-               #+lispworks (if pipe (system:pipe-exit-status process :wait t) process)
-               #+sbcl (sb-ext:process-exit-code process))
-             (check-result (exit-code process)
-               #+clisp
-               (setf exit-code
-                     (typecase exit-code (integer exit-code) (null 0) (t -1)))
-               (unless (or ignore-error-status
-                           (equal exit-code 0))
-                 (error 'subprocess-error :command command :code exit-code :process process))
-               exit-code)
-             (use-run-program ()
-               #-(or abcl cormanlisp gcl (and lispworks os-windows) mcl mkcl xcl)
-               (let* ((interactive (eq output :interactive))
-                      (pipe (and output (not interactive))))
-                 (multiple-value-bind (process stream)
-                     (run-program command :pipe pipe :interactive interactive)
-                   (if (and output (not interactive))
-                       (unwind-protect
-                            (slurp-input-stream output stream)
-                         (when stream (close stream))
-                         (check-result (process-result process pipe) process))
-                       (unwind-protect
-                            (check-result
-                             #+(or allegro lispworks) ; when not capturing, returns the exit code!
-                             process
-                             #-(or allegro lispworks) (process-result process pipe)
-                             process))))))
-             (system-command (command)
-               (etypecase command
-                 (string command)
-                 (list (escape-shell-command
-                        (if (os-unix-p) (cons "exec" command) command)))))
-             (redirected-system-command (command out)
-               (format nil (if (os-unix-p) "exec > ~*~A ; ~2:*~A" "~A > ~A")
-                       (system-command command) (native-namestring out)))
-             (system (command &key interactive)
-               (declare (ignorable interactive))
-               #+(or abcl xcl) (ext:run-shell-command command)
-               #+allegro
-               (excl:run-shell-command
-                command
-                :input nil
-                :output nil
-                :error-output :output ; write STDERR to output, too
-                :wait t
-                #+os-windows :show-window #+os-windows (unless (or interactive (eq output t)) :hide))
-               #+(or clisp clozure cmu (and lispworks os-unix) sbcl scl)
-               (process-result (run-program command :pipe nil :interactive interactive) nil)
-               #+ecl (ext:system command)
-               #+cormanlisp (win32:system command)
-               #+gcl (lisp:system command)
-               #+(and lispworks os-windows)
-               (system:call-system-showing-output
-                command :show-cmd (or interactive (eq output t)) :prefix "" :output-stream nil)
-               #+mcl (ccl::with-cstrs ((%command command)) (_system %command))
-               #+mkcl (nth-value 2
-                                 (mkcl:run-program #+windows command #+windows ()
-                                                   #-windows "/bin/sh" (list "-c" command)
-                                                   :input nil :output nil)))
-             (call-system (command-string &key interactive)
-               (check-result (system command-string :interactive interactive) nil))
-             (use-system ()
-               (let ((interactive (eq output :interactive)))
-                 (if (and output (not interactive))
-                     (with-temporary-file (:pathname tmp :direction :output)
-                       (call-system (redirected-system-command command tmp))
-                       (with-open-file (stream tmp
-                                               :direction :input
-                                               :if-does-not-exist :error
-                                               :element-type element-type
-                                               #-gcl2.6 :external-format #-gcl2.6 external-format)
-                         (slurp-input-stream output stream)))
-                     (call-system (system-command command) :interactive interactive)))))
-      (if (and (not force-shell)
-               #+(or clisp ecl) ignore-error-status
-               #+(or abcl cormanlisp gcl (and lispworks os-windows) mcl mkcl xcl) nil)
-          (use-run-program)
-          (use-system)))))
-
+    (flet ((default (x xp output) (cond (xp x) ((eq output :interactive) :interactive))))
+      (apply (if (or force-shell
+                     #+(or clisp ecl) (or (not ignore-error-status) t)
+                     #+clisp (eq error-output :interactive)
+                     #+(and lispworks os-unix) (interactivep input output error-output)
+                     #+(or abcl cormanlisp gcl (and lispworks os-windows) mcl mkcl xcl) t)
+                 '%use-system '%use-run-program)
+             command
+             :input (default input inputp output)
+             :error-output (default error-output error-output-p output)
+             :if-input-does-not-exist if-input-does-not-exist
+             :if-output-exists if-output-exists
+             :if-error-output-exists if-error-output-exists
+             :element-type element-type :external-format external-format
+           keys))))
diff --git a/uiop/stream.lisp b/uiop/stream.lisp
index 13d21dddda82f0aec5d4de9d31470aad16c5e1fc..fd6e6d03d8f5e8bfec3bf58f64aa27992ed4056a 100644
--- a/uiop/stream.lisp
+++ b/uiop/stream.lisp
@@ -6,13 +6,16 @@
   (:recycle :uiop/stream :asdf/stream :asdf)
   (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/os :uiop/pathname :uiop/filesystem)
   (:export
-   #:*default-stream-element-type* #:*stderr* #:setup-stderr
+   #:*default-stream-element-type*
+   #:*stdin* #:setup-stdin #:*stdout* #:setup-stdout #:*stderr* #:setup-stderr
    #:detect-encoding #:*encoding-detection-hook* #:always-default-encoding
    #:encoding-external-format #:*encoding-external-format-hook* #:default-encoding-external-format
    #:*default-encoding* #:*utf-8-external-format*
    #:with-safe-io-syntax #:call-with-safe-io-syntax #:safe-read-from-string
    #:with-output #:output-string #:with-input
    #:with-input-file #:call-with-input-file #:with-output-file #:call-with-output-file
+   #:null-device-pathname #:call-with-null-input #:with-null-input
+   #:call-with-null-output #:with-null-output
    #:finish-outputs #:format! #:safe-format!
    #:copy-stream-to-stream #:concatenate-files #:copy-file
    #:slurp-stream-string #:slurp-stream-lines #:slurp-stream-line
@@ -32,6 +35,18 @@
   (defvar *default-stream-element-type* (or #+(or abcl cmu cormanlisp scl xcl) 'character :default)
     "default element-type for open (depends on the current CL implementation)")
 
+  (defvar *stdin* *standard-input*
+    "the original standard input stream at startup")
+
+  (defun setup-stdin ()
+    (setf *stdin* #+clozure ccl::*stdin* #-clozure *standard-input*))
+
+  (defvar *stdout* *standard-output*
+    "the original standard output stream at startup")
+
+  (defun setup-stdout ()
+    (setf *stdout* #+clozure ccl::*stdout* #-clozure *standard-output*))
+
   (defvar *stderr* *error-output*
     "the original error output stream at startup")
 
@@ -40,7 +55,8 @@
           #+allegro excl::*stderr*
           #+clozure ccl::*stderr*
           #-(or allegro clozure) *error-output*))
-  (setup-stderr))
+
+  (setup-stdin) (setup-stdout) (setup-stderr))
 
 
 ;;; Encodings (mostly hooks only; full support requires asdf-encodings)
@@ -118,7 +134,6 @@ and implementation-defined external-format's")
     (with-safe-io-syntax (:package package)
       (read-from-string string eof-error-p eof-value :start start :end end :preserve-whitespace preserve-whitespace))))
 
-
 ;;; Output to a stream or string, FORMAT-style
 (with-upgradability ()
   (defun call-with-output (output function)
@@ -215,6 +230,36 @@ Other keys are accepted but discarded."
     (declare (ignore element-type external-format if-exists if-does-not-exist))
     `(call-with-output-file ,pathname #'(lambda (,var) ,@body) ,@keys)))
 
+;;; Null device
+(with-upgradability ()
+  (defun null-device-pathname ()
+    (cond
+      ((os-unix-p) #p"/dev/null")
+      ((os-windows-p) #p"NUL") ;; Q: how many Lisps accept the #p"NUL:" syntax?
+      (t (error "No /dev/null on your OS"))))
+  (defun call-with-null-input (fun &rest keys &key element-type external-format if-does-not-exist)
+    (declare (ignore element-type external-format if-does-not-exist))
+    (apply 'call-with-input-file (null-device-pathname) fun keys))
+  (defmacro with-null-input ((var &rest keys
+                              &key element-type external-format if-does-not-exist)
+                             &body body)
+    (declare (ignore element-type external-format if-does-not-exist))
+    `(call-with-null-input #'(lambda (,var) ,@body) ,@keys))
+  (defun call-with-null-output (fun
+                                &key (element-type *default-stream-element-type*)
+                                  (external-format *utf-8-external-format*)
+                                  (if-exists :overwrite)
+                                  (if-does-not-exist :error))
+    (call-with-output-file
+     (null-device-pathname) fun
+     :element-type element-type :external-format external-format
+     :if-exists if-exists :if-does-not-exist if-does-not-exist))
+  (defmacro with-null-output ((var &rest keys
+                              &key element-type external-format if-does-not-exist if-exists)
+                              &body body)
+    (declare (ignore element-type external-format if-exists if-does-not-exist))
+    `(call-with-null-output #'(lambda (,var) ,@body) ,@keys)))
+
 ;;; Ensure output buffers are flushed
 (with-upgradability ()
   (defun finish-outputs (&rest streams)
@@ -222,8 +267,8 @@ Other keys are accepted but discarded."
 Useful for portably flushing I/O before user input or program exit."
     ;; CCL notably buffers its stream output by default.
     (dolist (s (append streams
-                       (list *stderr* *error-output* *standard-output* *trace-output*
-                             *debug-io* *terminal-io* *debug-io* *query-io*)))
+                       (list *stdout* *stderr* *error-output* *standard-output* *trace-output*
+                             *debug-io* *terminal-io* *query-io*)))
       (ignore-errors (finish-output s)))
     (values))
 
@@ -231,7 +276,7 @@ Useful for portably flushing I/O before user input or program exit."
     "Just like format, but call finish-outputs before and after the output."
     (finish-outputs stream)
     (apply 'format stream format args)
-    (finish-output stream))
+    (finish-outputs stream))
 
   (defun safe-format! (stream format &rest args)
     (with-safe-io-syntax ()
@@ -435,7 +480,7 @@ If a string, repeatedly read and evaluate from it, returning the last values."
       (thunk &key
                prefix keep (direction :io)
                (element-type *default-stream-element-type*)
-               (external-format :default))
+               (external-format *utf-8-external-format*))
     #+gcl2.6 (declare (ignorable external-format))
     (check-type direction (member :output :io))
     (loop
@@ -478,7 +523,7 @@ ready for I/O. Unless KEEP is specified, delete the file afterwards."
         ,@(when prefix `(:prefix ,prefix))
         ,@(when keep `(:keep ,keep))
         ,@(when element-type `(:element-type ,element-type))
-        ,@(when external-format `(:external-format external-format)))))
+        ,@(when external-format `(:external-format ,external-format)))))
 
   ;; Temporary pathnames in simple cases where no contention is assumed
   (defun add-pathname-suffix (pathname suffix)