X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Frun-program.lisp;h=fc02f3ef625dd86af36836b17a57319fa948a3c6;hb=5edd74f6911093805a009a152b32216b3dba59f7;hp=1539001d7ae7345a42d0021c936988731bfe7ebf;hpb=7ef5ec93744c7cc1c7a0280e46f8b42b74353713;p=sbcl.git diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp index 1539001..fc02f3e 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. -(def-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.) - (def-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,10 +92,10 @@ ;;;; Import wait3(2) from Unix. -(sb-alien:def-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)) +(define-alien-routine ("wait3" c-wait3) sb-alien:int + (status sb-alien:int :out) + (options sb-alien:int) + (rusage sb-alien:int)) (defconstant wait-wnohang #-svr4 1 #+svr4 #o100) (defconstant wait-wuntraced #-svr4 2 #+svr4 4) @@ -174,7 +158,7 @@ (defmethod print-object ((process process) stream) (print-unreadable-object (process stream :type t) (format stream - "~D ~S" + "~W ~S" (process-pid process) (process-status process))) process) @@ -202,12 +186,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)) @@ -305,19 +289,19 @@ (defvar *handlers-installed* nil) #+FreeBSD -(def-alien-type nil +(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 + (sg-ispeed sb-alien:char) ; input speed + (sg-ospeed sb-alien:char) ; output speed + (sg-erase sb-alien:char) ; erase character + (sg-kill sb-alien:char) ; kill character + (sg-flags sb-alien:short))) ; mode flags #+OpenBSD -(def-alien-type nil +(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))) + (sg-four sb-alien:int) + (sg-chars (array sb-alien:char 4)) + (sg-flags sb-alien: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 @@ -380,7 +364,7 @@ (when (streamp pty) (multiple-value-bind (new-fd errno) (sb-unix:unix-dup master) (unless new-fd - (error "couldn't SB-UNIX:UNIX-DUP ~D: ~A" master (strerror errno))) + (error "couldn't SB-UNIX:UNIX-DUP ~W: ~A" master (strerror errno))) (push new-fd *close-on-error*) (copy-descriptor-to-stream new-fd pty cookie))) (values name @@ -413,9 +397,9 @@ ;; Blast the string into place. (sb-kernel:copy-to-system-area (the simple-string s) (* sb-vm:vector-data-offset - sb-vm:word-bits) + sb-vm:n-word-bits) string-sap 0 - (* (1+ n) sb-vm:byte-bits)) + (* (1+ n) sb-vm:n-byte-bits)) ;; Blast the pointer to the string into place. (setf (sap-ref-sap vec-sap i) string-sap) (setf string-sap (sap+ string-sap (round-bytes-to-words (1+ n)))) @@ -435,14 +419,14 @@ ,@body) (sb-sys:deallocate-system-memory ,sap ,size))))) -(sb-alien:def-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? (defun unix-filename-is-executable-p (unix-filename) @@ -669,54 +653,54 @@ (setf handler (sb-sys:add-fd-handler descriptor - :input #'(lambda (fd) - (declare (ignore fd)) - (loop - (unless handler - (return)) - (multiple-value-bind - (result readable/errno) - (sb-unix:unix-select (1+ descriptor) - (ash 1 descriptor) - 0 0 0) - (cond ((null result) - (error "~@" - (strerror readable/errno))) - ((zerop result) - (return)))) - (sb-alien:with-alien ((buf (sb-alien:array - sb-c-call:char - 256))) - (multiple-value-bind - (count errno) - (sb-unix:unix-read descriptor - (alien-sap buf) - 256) - (cond ((or (and (null count) - (eql errno sb-unix:eio)) - (eql count 0)) - (sb-sys:remove-fd-handler handler) - (setf handler nil) - (decf (car cookie)) - (sb-unix:unix-close descriptor) - (return)) - ((null count) - (sb-sys:remove-fd-handler handler) - (setf handler nil) - (decf (car cookie)) - (error - "~@" - (strerror errno))) - (t - (sb-kernel:copy-from-system-area - (alien-sap buf) 0 - string (* sb-vm:vector-data-offset - sb-vm:word-bits) - (* count sb-vm:byte-bits)) - (write-string string stream - :end count))))))))))) + (strerror errno))) + (t + (sb-kernel:copy-from-system-area + (alien-sap buf) 0 + string (* sb-vm:vector-data-offset + sb-vm:n-word-bits) + (* count sb-vm:n-byte-bits)) + (write-string string stream + :end count))))))))))) ;;; Find a file descriptor to use for object given the direction. ;;; Returns the descriptor. If object is :STREAM, returns the created