X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Frun-program.lisp;h=aee63b8bb13482512eb2cbd92b97a9e29ed106aa;hb=4ae1b794a5d6a90794468cf8017f5307f2c30dfe;hp=4dbcc554a526232a9de09f9b10708cf3180bfe3f;hpb=e0814eee6f6dea52db010b45a330100f2fe65832;p=sbcl.git

diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index 4dbcc55..aee63b8 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))
@@ -307,17 +287,17 @@
 #+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
+	  (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
 (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
@@ -435,16 +415,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 +667,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)