refactor GET-TOPLEVEL-FORM &co between debugger and disassembler

[sbcl.git] / src / code / run-program.lisp

diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index 0417401..05c6333 100644 (file)
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -729,6 +729,8 @@ Users Manual for details about the PROCESS structure."#-win32"
                                       ;; hard-coded symbols here.
                                       (values stdout output-stream)
                                       (get-descriptor-for ,@args))))
+                           (unless ,fd
+                             (return-from run-program))
                            ,@body))
                       (with-open-pty (((pty-name pty-stream) (pty cookie))
                                       &body body)
@@ -773,7 +775,7 @@ Users Manual for details about the PROCESS structure."#-win32"
                                                   (if search 1 0)
                                                   environment-vec pty-name
                                                   (if wait 1 0))))
-                             (unless (= child -1)
+                             (unless (minusp child)
                                (setf proc
                                      (apply
                                       #'make-process
@@ -791,9 +793,15 @@ Users Manual for details about the PROCESS structure."#-win32"
                                                   (list :%status :running))))
                                (push proc *active-processes*)))))
                        ;; Report the error outside the lock.
-                       (when (= child -1)
-                         (error "couldn't fork child process: ~A"
-                                (strerror)))))))))
+                       #+win32
+                       (when (minusp child)
+                         (error "Couldn't execute ~S: ~A" progname (strerror)))
+                       #-win32
+                       (case child
+                         (-2
+                          (error "Couldn't execute ~S: ~A" progname (strerror)))
+                         (-1
+                          (error "Couldn't fork child process: ~A" (strerror))))))))))
         (dolist (fd *close-in-parent*)
           (sb-unix:unix-close fd))
         (unless proc
@@ -1004,15 +1012,16 @@ Users Manual for details about the PROCESS structure."#-win32"
            ;; validation there.
            (with-open-stream (file (apply #'open object :allow-other-keys t
                                           keys))
-             (multiple-value-bind
-                   (fd errno)
-                 (sb-unix:unix-dup (sb-sys:fd-stream-fd file))
-               (cond (fd
-                      (push fd *close-in-parent*)
-                      (values fd nil))
-                     (t
-                      (error "couldn't duplicate file descriptor: ~A"
-                             (strerror errno)))))))
+             (when file
+               (multiple-value-bind
+                     (fd errno)
+                   (sb-unix:unix-dup (sb-sys:fd-stream-fd file))
+                 (cond (fd
+                        (push fd *close-in-parent*)
+                        (values fd nil))
+                       (t
+                        (error "couldn't duplicate file descriptor: ~A"
+                               (strerror errno))))))))
           ((streamp object)
            (ecase direction
              (:input