Add safepoint mechanism

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

diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index d9e00f2..97d6d55 100644 (file)
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -386,14 +386,16 @@ status slot."
     ;; First try to use the Unix98 pty api.
     (let* ((master-name (coerce (format nil "/dev/ptmx") 'base-string))
            (master-fd (sb-unix:unix-open master-name
-                                         sb-unix:o_rdwr
+                                         (logior sb-unix:o_rdwr
+                                                 sb-unix:o_noctty)
                                          #o666)))
       (when master-fd
         (grantpt master-fd)
         (unlockpt master-fd)
         (let* ((slave-name (ptsname master-fd))
                (slave-fd (sb-unix:unix-open slave-name
-                                            sb-unix:o_rdwr
+                                            (logior sb-unix:o_rdwr
+                                                    sb-unix:o_noctty)
                                             #o666)))
           (when slave-fd
             (return-from find-a-pty
@@ -408,13 +410,15 @@ status slot."
         (let* ((master-name (coerce (format nil "/dev/pty~C~X" char digit)
                                     'base-string))
                (master-fd (sb-unix:unix-open master-name
-                                             sb-unix:o_rdwr
+                                             (logior sb-unix:o_rdwr
+                                                     sb-unix:o_noctty)
                                              #o666)))
           (when master-fd
             (let* ((slave-name (coerce (format nil "/dev/tty~C~X" char digit)
                                        'base-string))
                    (slave-fd (sb-unix:unix-open slave-name
-                                                sb-unix:o_rdwr
+                                                (logior sb-unix:o_rdwr
+                                                        sb-unix:o_noctty)
                                                 #o666)))
               (when slave-fd
                 (return-from find-a-pty
@@ -939,6 +943,12 @@ Users Manual for details about the PROCESS structure."#-win32"
         (get-stream-fd-and-external-format
          (two-way-stream-output-stream stream) direction))))))
 
+(defun get-temporary-directory ()
+  #-win32 (or (sb-ext:posix-getenv "TMPDIR")
+              "/tmp")
+  #+win32 (or (sb-ext:posix-getenv "TEMP")
+              "C:/Temp"))
+
 \f
 ;;; Find a file descriptor to use for object given the direction.
 ;;; Returns the descriptor. If object is :STREAM, returns the created
@@ -957,10 +967,14 @@ Users Manual for details about the PROCESS structure."#-win32"
   ;; run afoul of disk quotas or to choke on small /tmp file systems.
   (flet ((make-temp-fd ()
            (multiple-value-bind (fd name/errno)
-               (sb-unix:sb-mkstemp "/tmp/.run-program-XXXXXX" #o0600)
+               (sb-unix:sb-mkstemp (format nil "~a/.run-program-XXXXXX"
+                                           (get-temporary-directory))
+                                   #o0600)
              (unless fd
                (error "could not open a temporary file: ~A"
                       (strerror name/errno)))
+             ;; Can't unlink an opened file on Windows
+             #-win32
              (unless (sb-unix:unix-unlink name/errno)
                (sb-unix:unix-close fd)
                (error "failed to unlink ~A" name/errno))