X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Frun-program.lisp;h=946f95e98cebaa5304b081b4e2ae5d39ee496ecc;hb=860543cc7ba0266e41e1d41ac9b6a208f3795f1a;hp=4dbcc554a526232a9de09f9b10708cf3180bfe3f;hpb=e0814eee6f6dea52db010b45a330100f2fe65832;p=sbcl.git diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp index 4dbcc55..946f95e 100644 --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -45,28 +45,12 @@ ;;;; which (at least in sbcl-0.6.10 on Red Hat Linux 6.2) is not ;;;; visible at GENESIS time. -(define-alien-variable "environ" (* c-string)) -(push (lambda () - ;; We redo this here to protect ourselves from this scenario: - ;; * Build under one version of shared lib, save a core. - ;; * Load core under another version of shared lib. ("Now - ;; where was environ again?" SIGSEGV, etc.) - ;; Obviously it's a KLUDGE to do this hack for every alien - ;; variable, but as it happens, as of sbcl-0.7.0 this is the - ;; only alien variable used to implement SBCL, so it's not - ;; worth coming up with a general solution. (A general - ;; solution would be nice for users who want to have their - ;; alien code be preserved across a save/load cycle, but this - ;; problem with alien variables is only one of several - ;; problems which'd need to be solved before that can happen.) - (define-alien-variable "environ" (* c-string))) - *after-save-initializations*) - +(define-alien-routine wrapped-environ (* c-string)) (defun posix-environ () "Return the Unix environment (\"man environ\") as a list of SIMPLE-STRINGs." - (c-strings->string-list environ)) + (c-strings->string-list (wrapped-environ))) -;;; Convert as best we can from a SBCL representation of a Unix +;;; Convert as best we can from an SBCL representation of a Unix ;;; environment to a CMU CL representation. ;;; ;;; * (UNIX-ENVIRONMENT-CMUCL-FROM-SBCL '("Bletch=fub" "Noggin" "YES=No!")) @@ -108,30 +92,26 @@ ;;;; Import wait3(2) from Unix. -(sb-alien:define-alien-routine ("wait3" c-wait3) sb-c-call:int - (status sb-c-call:int :out) - (options sb-c-call:int) - (rusage sb-c-call:int)) - -(defconstant wait-wnohang #-svr4 1 #+svr4 #o100) -(defconstant wait-wuntraced #-svr4 2 #+svr4 4) -(defconstant wait-wstopped #-svr4 #o177 #+svr4 wait-wuntraced) +(define-alien-routine ("wait3" c-wait3) sb-alien:int + (status sb-alien:int :out) + (options sb-alien:int) + (rusage sb-alien:int)) (defun wait3 (&optional do-not-hang check-for-stopped) "Return any available status information on child process. " (multiple-value-bind (pid status) (c-wait3 (logior (if do-not-hang - wait-wnohang + sb-unix:wnohang 0) (if check-for-stopped - wait-wuntraced + sb-unix:wuntraced 0)) 0) (cond ((or (minusp pid) (zerop pid)) nil) ((eql (ldb (byte 8 0) status) - wait-wstopped) + sb-unix:wstopped) (values pid :stopped (ldb (byte 8 8) status))) @@ -202,12 +182,12 @@ #-hpux ;;; Find the current foreground process group id. (defun find-current-foreground-process (proc) - (sb-alien:with-alien ((result sb-c-call:int)) + (with-alien ((result sb-alien:int)) (multiple-value-bind (wonp error) (sb-unix:unix-ioctl (sb-sys:fd-stream-fd (process-pty proc)) sb-unix:TIOCGPGRP - (sb-alien:alien-sap (sb-alien:addr result))) + (alien-sap (sb-alien:addr result))) (unless wonp (error "TIOCPGRP ioctl failed: ~S" (strerror error))) result)) @@ -304,21 +284,6 @@ ;;; list of handlers installed by RUN-PROGRAM (defvar *handlers-installed* nil) -#+FreeBSD -(define-alien-type nil - (struct sgttyb - (sg-ispeed sb-c-call:char) ; input speed - (sg-ospeed sb-c-call:char) ; output speed - (sg-erase sb-c-call:char) ; erase character - (sg-kill sb-c-call:char) ; kill character - (sg-flags sb-c-call:short))) ; mode flags -#+OpenBSD -(define-alien-type nil - (struct sgttyb - (sg-four sb-c-call:int) - (sg-chars (array sb-c-call:char 4)) - (sg-flags sb-c-call:int))) - ;;; Find an unused pty. Return three values: the file descriptor for ;;; the master side of the pty, the file descriptor for the slave side ;;; of the pty, and the name of the tty device for the slave side. @@ -335,34 +300,6 @@ sb-unix:o_rdwr #o666))) (when slave-fd - ;; comment from classic CMU CL: - ;; Maybe put a vhangup here? - ;; - ;; FIXME: It seems as though this logic should be in - ;; OPEN-PTY, not FIND-A-PTY (both from the comments - ;; documenting DEFUN FIND-A-PTY, and from the - ;; connotations of the function names). - ;; - ;; FIXME: It would be nice to have a note, and/or a pointer - ;; to some reference material somewhere, explaining - ;; why we need this on *BSD and not on Linux. - #+bsd - (sb-alien:with-alien ((stuff (sb-alien:struct sgttyb))) - (let ((sap (sb-alien:alien-sap stuff))) - (sb-unix:unix-ioctl slave-fd sb-unix:TIOCGETP sap) - (setf (sb-alien:slot stuff 'sg-flags) - ;; This is EVENP|ODDP, the same numeric code - ;; both on FreeBSD and on OpenBSD. -- WHN 20000929 - #o300) ; EVENP|ODDP - (sb-unix:unix-ioctl slave-fd sb-unix:TIOCSETP sap) - (sb-unix:unix-ioctl master-fd sb-unix:TIOCGETP sap) - (setf (sb-alien:slot stuff 'sg-flags) - (logand (sb-alien:slot stuff 'sg-flags) - ;; This is ~ECHO, the same numeric - ;; code both on FreeBSD and on OpenBSD. - ;; -- WHN 20000929 - (lognot 8))) ; ~ECHO - (sb-unix:unix-ioctl master-fd sb-unix:TIOCSETP sap))) (return-from find-a-pty (values master-fd slave-fd @@ -425,8 +362,7 @@ (values vec-sap (sap+ vec-sap #-alpha 4 #+alpha 8) total-bytes)))) (defmacro with-c-strvec ((var str-list) &body body) - (let ((sap (gensym "SAP-")) - (size (gensym "SIZE-"))) + (with-unique-names (sap size) `(multiple-value-bind (,sap ,var ,size) (string-list-to-c-strvec ,str-list) @@ -435,16 +371,17 @@ ,@body) (sb-sys:deallocate-system-memory ,sap ,size))))) -(sb-alien:define-alien-routine spawn sb-c-call:int - (program sb-c-call:c-string) - (argv (* sb-c-call:c-string)) - (envp (* sb-c-call:c-string)) - (pty-name sb-c-call:c-string) - (stdin sb-c-call:int) - (stdout sb-c-call:int) - (stderr sb-c-call:int)) +(sb-alien:define-alien-routine spawn sb-alien:int + (program sb-alien:c-string) + (argv (* sb-alien:c-string)) + (envp (* sb-alien:c-string)) + (pty-name sb-alien:c-string) + (stdin sb-alien:int) + (stdout sb-alien:int) + (stderr sb-alien:int)) ;;; Is UNIX-FILENAME the name of a file that we can execute? +;;; XXX does this actually work for symlinks? (defun unix-filename-is-executable-p (unix-filename) (declare (type simple-string unix-filename)) (values (and (eq (sb-unix:unix-file-kind unix-filename) :file) @@ -686,7 +623,7 @@ ((zerop result) (return)))) (sb-alien:with-alien ((buf (sb-alien:array - sb-c-call:char + sb-alien:char 256))) (multiple-value-bind (count errno)