(defun unix-environment-cmucl-from-sbcl (sbcl)
(mapcan
(lambda (string)
- (declare (type simple-string string))
+ (declare (type simple-base-string string))
(let ((=-pos (position #\= string :test #'equal)))
(if =-pos
(list
(mapcar
(lambda (cons)
(destructuring-bind (key . val) cons
- (declare (type keyword key) (type simple-string val))
- (concatenate 'simple-string (symbol-name key) "=" val)))
+ (declare (type keyword key) (type simple-base-string val))
+ (concatenate 'simple-base-string (symbol-name key) "=" val)))
cmucl))
\f
;;;; Import wait3(2) from Unix.
;;; 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
The &KEY arguments have the following meanings:
:ENVIRONMENT
- a list of SIMPLE-STRINGs describing the new Unix environment (as
- in \"man environ\"). The default is to copy the environment of
+ a list of SIMPLE-BASE-STRINGs describing the new Unix environment
+ (as in \"man environ\"). The default is to copy the environment of
the current process.
: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