"Return the Unix environment (\"man environ\") as a list of SIMPLE-STRINGs."
(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!"))
(options sb-alien:int)
(rusage sb-alien:int))
-(defconstant wait-wnohang #-svr4 1 #+svr4 #o100)
-(defconstant wait-wuntraced #-svr4 2 #+svr4 4)
-(defconstant wait-wstopped #-svr4 #o177 #+svr4 wait-wuntraced)
-
(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)))
;;; list of handlers installed by RUN-PROGRAM
(defvar *handlers-installed* nil)
-#+FreeBSD
-(define-alien-type nil
- (struct sgttyb
- (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-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
;;; of the pty, and the name of the tty device for the slave side.
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
(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)
(values (and (eq (sb-unix:unix-file-kind unix-filename) :file)
(sb-unix:unix-access unix-filename sb-unix:x_ok))))
+(defun find-executable-in-search-path (pathname
+ &optional
+ (search-path (posix-getenv "PATH")))
+ "Find the first executable file matching PATHNAME in any of the colon-separated list of pathnames SEARCH-PATH"
+ (loop for end = (position #\: search-path :start (if end (1+ end) 0))
+ and start = 0 then (and end (1+ end))
+ while start
+ ;; <Krystof> the truename of a file naming a directory is the
+ ;; directory, at least until pfdietz comes along and says why
+ ;; that's noncompliant
+ for fullpath = (merge-pathnames
+ pathname (truename
+ (subseq search-path start end)))
+ when (unix-filename-is-executable-p (namestring fullpath))
+ return fullpath))
+
;;; FIXME: There shouldn't be two semiredundant versions of the
;;; documentation. Since this is a public extension function, the
;;; documentation should be in the doc string. So all information from
(posix-environ))
environment-p)
(wait t)
+ search
pty
input
if-input-does-not-exist
:ENV
an alternative lossy representation of the new Unix environment,
for compatibility with CMU CL
+ :SEARCH
+ Look for PROGRAM in each of the directories along the $PATH
+ environment variable. Otherwise an absolute pathname is required.
+ (See also FIND-EXECUTABLE-IN-SEARCH-PATH)
:WAIT
If non-NIL (default), wait until the created process finishes. If
NIL, continue running Lisp until the program finishes.
;; designator, but internally we'd like SIMPLE-STRINGs.
(simple-args (mapcar (lambda (x) (coerce x 'simple-string)) args)))
(unwind-protect
- (let (;; FIXME: The old code here used to do
- ;; (MERGE-PATHNAMES PROGRAM "path:"),
- ;; which is the right idea (searching through the Unix
- ;; PATH). Unfortunately, there is no logical pathname
- ;; "path:" defined in sbcl-0.6.10. It would probably be
- ;; reasonable to restore Unix PATH searching in SBCL, e.g.
- ;; with a function FIND-EXECUTABLE-FILE-IN-POSIX-PATH.
- ;; CMU CL did it with a "PATH:" search list, but CMU CL
- ;; search lists are a non-ANSI extension that SBCL
- ;; doesn't support. -- WHN)
- (pfile (unix-namestring program t))
+ (let ((pfile
+ (if search
+ (let ((p (find-executable-in-search-path program)))
+ (and p (unix-namestring p t)))
+ (unix-namestring program t)))
(cookie (list 0)))
(unless pfile
(error "no such program: ~S" program))
projects / sbcl.git / blobdiff