;;;; 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!"))
\f
;;;; 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))
-
-(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)))
#-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))
(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
,@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)
(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 "~@<couldn't select on sub-process: ~
+ :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 "~@<couldn't select on sub-process: ~
~2I~_~A~:>"
- (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
- "~@<couldn't read input from sub-process: ~
+ (strerror readable/errno)))
+ ((zerop result)
+ (return))))
+ (sb-alien:with-alien ((buf (sb-alien:array
+ sb-alien: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
+ "~@<couldn't read input from sub-process: ~
~2I~_~A~:>"
- (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)))))))))))
+ (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
projects / sbcl.git / blobdiff