e-mail on cmucl-help@cons.org on 2001-01-16 and 2001-01-17 from WHN
and Pierre Mai.)
+79:
+ as pointed out by Dan Barlow on sbcl-devel 2000-07-02:
+ The PICK-TEMPORARY-FILE-NAME utility used by LOAD-FOREIGN uses
+ an easily guessable temporary filename in a way which might open
+ applications using LOAD-FOREIGN to hijacking by malicious users
+ on the same machine. Incantations for doing this safely are
+ floating around the net in various "how to write secure programs
+ despite Unix" documents, and it would be good to (1) fix this in
+ LOAD-FOREIGN, and (2) hunt for any other code which uses temporary
+ files and make it share the same new safe logic.
+
KNOWN BUGS RELATED TO THE IR1 INTERPRETER
#s(sb-cold:package-data
:name "SB!IMPL"
:doc "private: a grab bag of implementation details"
- :use ("CL" "SB!EXT" "SB!INT" "SB!SYS" "SB!DEBUG" "SB!KERNEL" "SB!BIGNUM"
- "SB!GRAY"))
+ :use ("CL" "SB!ALIEN" "SB!BIGNUM" "SB!C-CALL" "SB!DEBUG" "SB!EXT"
+ "SB!GRAY" "SB!INT" "SB!KERNEL" "SB!SYS"))
;; FIXME: It seems to me that this could go away, with its contents moved
;; into SB!KERNEL, like the implementation of the rest of the class system.
:reexport ("LOAD-FOREIGN" "LOAD-1-FOREIGN" "WEAK-POINTER-P")
:export (;; Information about how the program was invoked is
;; nonstandard but very useful.
- "*POSIX-ARGV*" "POSIX-GETENV"
+ "*POSIX-ARGV*" "POSIX-GETENV" "POSIX-ENVIRON"
;; People have various good reasons to mess with the GC.
"*AFTER-GC-HOOKS*" "*BEFORE-GC-HOOKS*"
"DEFINE-HASH-TABLE-TEST"
"*GC-INHIBIT-HOOK*"
+ ;; compatibility hacks for old-style CMU CL data formats
+ "UNIX-ENVIRONMENT-CMUCL-FROM-SBCL"
+ "UNIX-ENVIRONMENT-SBCL-FROM-CMUCL"
+
;; not used any more, I think -- WHN 19991206
#+nil
("SERVE-BUTTON-PRESS"
This package only tries to implement what happens to be
needed by the current implementation of SBCL, and makes
no guarantees of interface stability."
- :use ("CL" "SB!ALIEN" "SB!C-CALL" "SB!SYS" "SB!EXT" "SB!INT")
+ :use ("CL" "SB!ALIEN" "SB!C-CALL" "SB!EXT" "SB!INT" "SB!SYS")
:export ("CADDR-T" "D-INO" "D-NAME" "D-NAMLEN" "D-OFF" "D-RECLEN"
"DADDR-T" "DEV-T" "DIRECT" "EXECGRP" "EXECOTH" "EXECOWN" "F-DUPFD"
"F-GETFD" "F-GETFL" "F-GETOWN" "F-SETFD" "F-SETFL" "F-SETOWN"
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.
-(in-package "SB!EXT")
+(in-package "SB!IMPL")
;;; Lots of code wants to get to the KEYWORD package or the
;;; COMMON-LISP package without a lot of fuss, so we cache them in
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.
-(in-package "SB!EXT")
+(in-package "SB!IMPL")
;;; something not EQ to anything we might legitimately READ
(defparameter *eof-object* (make-symbol "EOF-OBJECT"))
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.
-(in-package "SB!EXT")
+(in-package "SB!IMPL")
(defvar *objects-pending-finalization* nil)
(in-package "SB-SYS")
-;;; not needed until we implement full-blown LOAD-FOREIGN
-#|
(defun pick-temporary-file-name (&optional
;; KLUDGE: There are various security
;; nastyisms associated with easily
(return nil))
(t
(incf code))))))))
-|#
+
;;; On any OS where we don't support foreign object file loading, any
;;; query of a foreign symbol value is answered with "no definition
(push (lambda () (setq *tables-from-dlopen* nil))
sb-int:*after-save-initializations*)
-;;; not needed until we implement full-blown LOAD-FOREIGN
-#|
(defvar *dso-linker* "/usr/bin/ld")
(defvar *dso-linker-options* '("-G" "-o"))
-|#
+
(sb-alien:def-alien-routine dlopen system-area-pointer
(file sb-c-call:c-string) (mode sb-c-call:int))
(error "can't open global symbol table: ~S" (dlerror)))))
(defun load-1-foreign (file)
- "a primitive way to load a foreign object file. (LOAD-FOREIGN is
- probably preferred, but as of SBCL 0.6.7 is not implemented..)
+ "the primitive upon which the more general LOAD-FOREIGN is built: load
+ a single foreign object file
To use LOAD-1-FOREIGN, at the Unix command line do this:
echo 'int summish(int x, int y) { return 1 + x + y; }' > /tmp/ffi-test.c
(unless (zerop possible-result)
(return possible-result)))))
-;;; code partially ported from CMU CL to SBCL, but needs RUN-PROGRAM
-#|
-(defun load-foreign (files &key
- (libraries '("-lc"))
- (base-file nil)
- ;; Note: Since SBCL has no *ENVIRONMENT-LIST*
- ;; variable, if this code is ever restored,
- ;; the default should be taken from the alien
- ;; "environ" variable.
- ,, ; do it!
- (env sb-ext:*environment-list*))
+(defun load-foreign (files
+ &key
+ (libraries '("-lc"))
+ ;; FIXME: The old documentation said
+ ;; The BASE-FILE argument is used to specify a
+ ;; file to use as the starting place for
+ ;; defined symbols. The default is the C start
+ ;; up code for Lisp.
+ ;; But the code ignored the BASE-FILE argument.
+ ;; The comment above
+ ;; (DECLARE (IGNORE BASE-FILE))
+ ;; said
+ ;; dlopen() remembers the name of an object,
+ ;; when dlopen()ing the same name twice, the
+ ;; old object is reused.
+ ;; So I deleted all reference to BASE-FILE,
+ ;; including the now-bogus reference to the
+ ;; BASE-FILE argument in the documentation. But
+ ;; are there any other subtleties of the new code
+ ;; which need to be documented in its place?
+ (env nil env-p)
+ (environment (if env-p
+ (unix-environment-sbcl-from-cmu env)
+ (posix-environ))
+ environment-p))
#+sb-doc
"LOAD-FOREIGN loads a list of C object files into a running Lisp. The FILES
argument should be a single file or a list of files. The files may be
specified as namestrings or as pathnames. The libraries argument should be a
list of library files as would be specified to ld. They will be searched in
the order given. The default is just \"-lc\", i.e., the C library. The
- base-file argument is used to specify a file to use as the starting place for
- defined symbols. The default is the C start up code for Lisp. The ENV
- argument is the Unix environment variable definitions for the invocation of
- the linker. The default is the environment passed to Lisp."
- ;; Note: dlopen() remembers the name of an object, when dlopen()ing
- ;; the same name twice, the old object is reused.
- (declare (ignore base-file))
+ ENVIRONMENT argument is a list of SIMPLE-STRINGs corresponding to the Unix
+ environment (\"man environ\") definitions for the invocation of the linker.
+ The default is the environment that Lisp is itself running in. Instead of
+ using the ENVIRONMENT argument, it is also possible to use the ENV argument,
+ using the alternate, lossy representation used by CMU CL."
+ (when (and env-p environment-p)
+ (error "can't specify :ENV and :ENVIRONMENT simultaneously"))
(let ((output-file (pick-temporary-file-name
(concatenate 'string "/tmp/~D~C" (string (gensym)))))
(error-output (make-string-output-stream)))
(list files)
files))
libraries))
- :env env
+ :environment environment
:input nil
:output error-output
:error :output)))
(load-1-foreign output-file))
#-sb-show (sb-unix:unix-unlink output-file)
#+sb-show (/show "not unlinking" output-file)))) ; so we can look at it
-|#
) ; PROGN
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.
-(in-package "SB!EXT")
+(in-package "SB!IMPL")
(defparameter *abbrev-weekday-table*
#("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun"))
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.
-(in-package "SB!EXT")
+(in-package "SB!IMPL")
(defun featurep (x)
#!+sb-doc
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.
-(in-package "SB-EXT")
+(in-package "SB-IMPL")
+\f
+;;;; hacking the Unix environment
+;;;;
+;;;; In the original CMU CL code that LOAD-FOREIGN is derived from, the
+;;;; Unix environment (as in "man environ") was represented as an
+;;;; alist from keywords to strings, so that e.g. the Unix environment
+;;;; "SHELL=/bin/bash" "HOME=/root" "PAGER=less"
+;;;; was represented as
+;;;; ((:SHELL . "/bin/bash") (:HOME . "/root") (:PAGER "less"))
+;;;; This had a few problems in principle: the mapping into
+;;;; keyword symbols smashed the case of environment
+;;;; variables, and the whole mapping depended on the presence of
+;;;; #\= characters in the environment strings. In practice these
+;;;; problems weren't hugely important, since conventionally environment
+;;;; variables are uppercase strings followed by #\= followed by
+;;;; arbitrary data. However, since it's so manifestly not The Right
+;;;; Thing to make code which breaks unnecessarily on input which
+;;;; doesn't follow what is, after all, only a tradition, we've switched
+;;;; formats in SBCL, so that the fundamental environment list
+;;;; is just a list of strings, with a one-to-one-correspondence
+;;;; to the C-level representation. I.e., in the example above,
+;;;; the SBCL representation is
+;;;; '("SHELL=/bin/bash" "HOME=/root" "PAGER=less")
+;;;; CMU CL's implementation is currently supported to help with porting.
+;;;;
+;;;; It's not obvious that this code belongs here (instead of e.g. in
+;;;; unix.lisp), since it has only a weak logical connection with
+;;;; RUN-PROGRAM. However, physically it's convenient to put it here.
+;;;; It's not needed at cold init, so we *can* put it in this
+;;;; warm-loaded file. And by putting it in this warm-loaded file, we
+;;;; make it easy for it to get to the C-level 'environ' variable.
+;;;; 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))
+
+(defun posix-environ ()
+ "Return the Unix environment (\"man environ\") as a list of SIMPLE-STRINGs."
+ (let ((reversed-result nil))
+ (dotimes (i most-positive-fixnum (error "can't happen"))
+ (declare (type index i))
+ (let ((env-item (deref environ i)))
+ (if env-item
+ (push env-item reversed-result)
+ (return (nreverse reversed-result)))))))
+
+;;; Convert as best we can from a SBCL representation of a Unix
+;;; environment to a CMU CL representation.
+;;;
+;;; * (UNIX-ENVIRONMENT-CMUCL-FROM-SBCL '("Bletch=fub" "Noggin" "YES=No!"))
+;;; WARNING:
+;;; smashing case of "Bletch=fub" in conversion to CMU-CL-style
+;;; environment alist
+;;; WARNING:
+;;; no #\= in "Noggin", eliding it in CMU-CL-style environment alist
+;;; ((:BLETCH . "fub") (:YES . "No!"))
+(defun unix-environment-cmucl-from-sbcl (sbcl)
+ (mapcan
+ (lambda (string)
+ (declare (type simple-string string))
+ (let ((=-pos (position #\= string :test #'equal)))
+ (if =-pos
+ (list
+ (let* ((key-as-string (subseq string 0 =-pos))
+ (key-as-upcase-string (string-upcase key-as-string))
+ (key (keywordicate key-as-upcase-string))
+ (val (subseq string (1+ =-pos))))
+ (unless (string= key-as-string key-as-upcase-string)
+ (warn "smashing case of ~S in conversion to CMU-CL-style ~
+ environment alist"
+ string))
+ (cons key val)))
+ (warn "no #\\= in ~S, eliding it in CMU-CL-style environment alist"
+ string))))
+ sbcl))
+
+;;; Convert from a CMU CL representation of a Unix environment to a
+;;; SBCL representation.
+(defun unix-environment-sbcl-from-cmucl (cmucl)
+ (mapcar
+ (lambda (cons)
+ (destructuring-bind (key . val) cons
+ (declare (type keyword key) (type simple-string val))
+ (concatenate 'simple-string (symbol-name key) "=" val)))
+ cmucl))
\f
;;;; Import wait3(2) from Unix.
(stdout sb-c-call:int)
(stderr sb-c-call:int))
+;;; 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
+;;; this comment should be merged into the doc string, and then this
+;;; comment can go away.
+;;;
;;; RUN-PROGRAM uses fork() and execve() to run a different program.
;;; Strange stuff happens to keep the Unix state of the world
;;; coherent.
;;; RUN-PROGRAM returns a PROCESS structure for the process if
;;; the fork worked, and NIL if it did not.
(defun run-program (program args
- &key env (wait t) pty input
- if-input-does-not-exist output (if-output-exists :error)
- (error :output) (if-error-exists :error) status-hook)
- "RUN-PROGRAM creates a new process and runs the unix progam in the
- file specified by the simple-string program. Args are the standard
- arguments that can be passed to a Unix program, for no arguments
- use NIL (which means just the name of the program is passed as arg 0).
+ &key
+ (env nil env-p)
+ (environment (if env-p
+ (unix-environment-sbcl-from-cmucl env)
+ (posix-environ))
+ environment-p)
+ (wait t)
+ pty
+ input
+ if-input-does-not-exist
+ output
+ (if-output-exists :error)
+ (error :output)
+ (if-error-exists :error)
+ status-hook)
+ "RUN-PROGRAM creates a new Unix process running the Unix program found in
+ the file specified by the PROGRAM argument. ARGS are the standard
+ arguments that can be passed to a Unix program. For no arguments, use NIL
+ (which means that just the name of the program is passed as arg 0).
RUN-PROGRAM will either return NIL or a PROCESS structure. See the CMU
Common Lisp Users Manual for details about the PROCESS structure.
+ notes about Unix environments (as in the :ENVIRONMENT and :ENV args):
+ 1. The SBCL implementation of RUN-PROGRAM, like Perl and many other
+ programs, but unlike the original CMU CL implementation, copies
+ the Unix environment by default.
+ 2. Running Unix programs from a setuid process, or in any other
+ situation where the Unix environment is under the control of someone
+ else, is a mother lode of security problems. If you are contemplating
+ doing this, read about it first. (The Perl community has a lot of good
+ documentation about this and other security issues in script-like
+ programs.)
+
The keyword 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
+ the current process.
:ENV
- An A-LIST mapping keyword environment variables to simple-string
- values.
+ an alternative lossy representation of the new Unix environment,
+ for compatibility with CMU CL
:WAIT
If non-NIL (default), wait until the created process finishes. If
NIL, continue running Lisp until the program finishes.
This is a function the system calls whenever the status of the
process changes. The function takes the process as an argument."
+ (when (and env-p environment-p)
+ (error "can't specify :ENV and :ENVIRONMENT simultaneously"))
;; Make sure that the interrupt handler is installed.
(sb-sys:enable-interrupt sb-unix:sigchld #'sigchld-handler)
;; Make sure that all the args are okay.
(error "All arguments to program must be simple strings: ~S" args))
;; Prepend the program to the argument list.
(push (namestring program) args)
- ;; Clear various specials used by GET-DESCRIPTOR-FOR to communicate
- ;; cleanup info. Also, establish proc at this level so we can
- ;; return it.
- (let (*close-on-error* *close-in-parent* *handlers-installed* proc)
+ (let (;; Clear various specials used by GET-DESCRIPTOR-FOR to
+ ;; communicate cleanup info.
+ *close-on-error*
+ *close-in-parent*
+ *handlers-installed*
+ ;; Establish PROC at this level so that we can return it.
+ proc)
(unwind-protect
- (let ((pfile (unix-namestring (merge-pathnames program "path:") t t))
+ (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.
+ ;; (I don't want to do it with search lists the way
+ ;; that CMU CL did, because those are a non-ANSI
+ ;; extension which I'd like to get rid of. -- WHN)
+ (pfile (unix-namestring program t t))
(cookie (list 0)))
(unless pfile
(error "no such program: ~S" program))
- (multiple-value-bind
- (stdin input-stream)
+ (multiple-value-bind (stdin input-stream)
(get-descriptor-for input cookie :direction :input
:if-does-not-exist if-input-does-not-exist)
- (multiple-value-bind
- (stdout output-stream)
+ (multiple-value-bind (stdout output-stream)
(get-descriptor-for output cookie :direction :output
:if-exists if-output-exists)
- (multiple-value-bind
- (stderr error-stream)
+ (multiple-value-bind (stderr error-stream)
(if (eq error :output)
(values stdout output-stream)
(get-descriptor-for error cookie :direction :output
;; death before we have installed the PROCESS
;; structure in *ACTIVE-PROCESSES*.
(sb-sys:without-interrupts
- (with-c-strvec (argv args)
- (with-c-strvec
- (envp (mapcar #'(lambda (entry)
- (concatenate
- 'string
- (symbol-name (car entry))
- "="
- (cdr entry)))
- env))
+ (with-c-strvec (args-vec args)
+ (with-c-strvec (environment-vec environment)
(let ((child-pid
(without-gcing
- (spawn pfile argv envp pty-name
+ (spawn pfile args-vec environment-vec pty-name
stdin stdout stderr))))
(when (< child-pid 0)
(error "could not fork child process: ~S"
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.
-(in-package "SB!EXT")
+(in-package "SB!IMPL")
+\f
+;;;; miscellaneous I/O
;;; INDENTING-FURTHER is a user-level macro which may be used to locally
;;; increment the indentation of a stream.
-;;;; This file contains Unix support that SBCL needs to implement itself. It's
-;;;; derived from Peter Van Eynde's unix-glibc2.lisp for CMU CL, which was
-;;;; derived from CMU CL unix.lisp 1.56. But those files aspired to be complete
-;;;; Unix interfaces exported to the end user, while this file aims to be as
-;;;; simple as possible and is not intended for the end user.
+;;;; This file contains Unix support that SBCL needs to implement
+;;;; itself. It's derived from Peter Van Eynde's unix-glibc2.lisp for
+;;;; CMU CL, which was derived from CMU CL unix.lisp 1.56. But those
+;;;; files aspired to be complete Unix interfaces exported to the end
+;;;; user, while this file aims to be as simple as possible and is not
+;;;; intended for the end user.
;;;;
;;;; FIXME: The old CMU CL unix.lisp code was implemented as hand
;;;; transcriptions from Unix headers into Lisp. It appears that this was as
(values nil (get-errno))
,success-form)))
-;;; Like SYSCALL, but if it fails, signal an error instead of returning error
-;;; codes. Should only be used for syscalls that will never really get an
-;;; error.
+;;; This is like SYSCALL, but if it fails, signal an error instead of
+;;; returning error codes. Should only be used for syscalls that will
+;;; never really get an error.
(defmacro syscall* ((name &rest arg-types) success-form &rest args)
`(let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types))
,@args)))
(defmacro int-syscall ((name &rest arg-types) &rest args)
`(syscall (,name ,@arg-types) (values result 0) ,@args))
\f
-;;; from stdio.h
+;;;; hacking the Unix environment
-(/show0 "unix.lisp 124")
+(/show0 "unix.lisp 122")
+
+(def-alien-routine ("getenv" posix-getenv) c-string
+ "Return the environment string \"name=value\" which corresponds to NAME, or
+ NIL if there is none."
+ (name c-string))
+\f
+;;; from stdio.h
(defun unix-rename (name1 name2)
#!+sb-doc
(declare (type unix-pathname name1 name2))
(void-syscall ("rename" c-string c-string) name1 name2))
\f
-;;; from stdlib.h
-
-(def-alien-routine ("getenv" posix-getenv) c-string
- "Return the environment string \"name=value\" which corresponds to NAME, or
- NIL if there is none."
- (name c-string))
-\f
;;; from sys/types.h and gnu/types.h
-(/show0 "unix.lisp 144")
+(/show0 "unix.lisp 220")
(defconstant +max-s-long+ 2147483647)
(defconstant +max-u-long+ 4294967295)
(def-alien-type uid-t unsigned-int)
(def-alien-type ssize-t int)
-(/show0 "unix.lisp 163")
-
;;; FIXME: We shouldn't hand-copy types from header files into Lisp like this
;;; unless we have extreme provocation. Reading directories is not extreme
;;; enough, since it doesn't need to be blindingly fast: we can just implement
;;; those functions in C as a wrapper layer.
(def-alien-type fd-mask unsigned-long)
-(/show0 "unix.lisp 171")
;;; FIXME: Isn't there some way to use a C wrapper to avoid this hand-copying?
(def-alien-type dev-t
(def-alien-type nlink-t
#!+linux unsigned-int
#!+bsd unsigned-short)
-(/show0 "unix.lisp 190")
+(/show0 "unix.lisp 263")
;;; FIXME: We shouldn't hand-copy types from header files into Lisp like this
;;; unless we have extreme provocation. Reading directories is not extreme
#!+linux long
#!+bsd quad-t)
-(/show0 "unix.lisp 195")
(defconstant fd-setsize 1024)
-(/show0 "unix.lisp 217")
(def-alien-type nil
(struct fd-set
(fds-bits (array fd-mask #.(/ fd-setsize 32)))))
-
-(/show0 "unix.lisp 223")
\f
;;;; direntry.h
(d-reclen unsigned-short) ; length of this record
(d_type unsigned-char)
(d-name (array char 256)))) ; name must be no longer than this
-(/show0 "unix.lisp 241")
+(/show0 "unix.lisp 289")
\f
;;;; dirent.h
(defstruct directory
name
(dir-struct (required-argument) :type system-area-pointer))
-(/show0 "unix.lisp 258")
+(/show0 "unix.lisp 304")
(def!method print-object ((dir directory) stream)
(print-unreadable-object (dir stream :type t)
(prin1 (directory-name dir) stream)))
-(/show0 "unix.lisp 264")
(defun open-dir (pathname)
(declare (type unix-pathname pathname))
(when (string= pathname "")
(values nil enoent))
(t
(values nil enotdir)))))
-(/show0 "unix.lisp 286")
(defun read-dir (dir)
(declare (type directory dir))
(values (cast (slot direct 'd-name) c-string)
(slot direct 'd-ino))))))
-(/show0 "unix.lisp 301")
(defun close-dir (dir)
(declare (type directory dir))
(alien-funcall (extern-alien "closedir"
(function void system-area-pointer))
(directory-dir-struct dir))
nil)
+\f
+;;;; fcntl.h
+;;;;
+;;;; POSIX Standard: 6.5 File Control Operations <fcntl.h>
-;;; dlfcn.h -> in foreign.lisp
-
-;;; fcntl.h
-;;;
-;;; POSIX Standard: 6.5 File Control Operations <fcntl.h>
-
-(/show0 "unix.lisp 318")
+(/show0 "unix.lisp 356")
(defconstant r_ok 4 #!+sb-doc "Test for read permission")
(defconstant w_ok 2 #!+sb-doc "Test for write permission")
(defconstant x_ok 1 #!+sb-doc "Test for execute permission")
(defconstant f_ok 0 #!+sb-doc "Test for presence of file")
-(/show0 "unix.lisp 352")
+;;; Open the file whose pathname is specified by PATH for reading
+;;; and/or writing as specified by the FLAGS argument. Various FLAGS
+;;; masks (O_RDONLY etc.) are defined in fcntlbits.h.
+;;;
+;;; If the O_CREAT flag is specified, then the file is created with a
+;;; permission of argument MODE if the file doesn't exist. An integer
+;;; file descriptor is returned by UNIX-OPEN.
(defun unix-open (path flags mode)
- #!+sb-doc
- "Unix-open opens the file whose pathname is specified by path
- for reading and/or writing as specified by the flags argument.
- The flags argument can be:
-
- o_rdonly Read-only flag.
- o_wronly Write-only flag.
- o_rdwr Read-and-write flag.
- o_append Append flag.
- o_creat Create-if-nonexistent flag.
- o_trunc Truncate-to-size-0 flag.
- o_excl Error if the file allready exists
- o_noctty Don't assign controlling tty
- o_ndelay Non-blocking I/O
- o_sync Synchronous I/O
- o_async Asynchronous I/O
-
- If the o_creat flag is specified, then the file is created with
- a permission of argument mode if the file doesn't exist. An
- integer file descriptor is returned by unix-open."
(declare (type unix-pathname path)
(type fixnum flags)
(type unix-file-mode mode))
;;; associated with it.
(/show0 "unix.lisp 391")
(defun unix-close (fd)
- #!+sb-doc
- "Unix-close takes an integer file descriptor as an argument and
- closes the file associated with it. T is returned upon successful
- completion, otherwise NIL and an error number."
(declare (type unix-fd fd))
(void-syscall ("close" int) fd))
\f
-;;; fcntlbits.h
+;;;; fcntlbits.h
(/show0 "unix.lisp 337")
(defconstant o_rdonly 0) ; read-only flag
(struct rusage
(ru-utime (struct timeval)) ; user time used
(ru-stime (struct timeval)) ; system time used.
- (ru-maxrss long) ; Maximum resident set size (in kilobytes)
+ (ru-maxrss long) ; maximum resident set size (in kilobytes)
(ru-ixrss long) ; integral shared memory size
(ru-idrss long) ; integral unshared data size
(ru-isrss long) ; integral unshared stack size
\f
;;;; time.h
-;; POSIX.4 structure for a time value. This is like a `struct timeval' but
-;; has nanoseconds instead of microseconds.
-
+;; the POSIX.4 structure for a time value. This is like a `struct
+;; timeval' but has nanoseconds instead of microseconds.
(def-alien-type nil
(struct timespec
(tv-sec long) ;Seconds
(tv-nsec long))) ;Nanoseconds
-;; Used by other time functions.
+;; used by other time functions
(def-alien-type nil
(struct tm
(tm-sec int) ; Seconds. [0-60] (1 leap second)
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.
-(in-package "SB!EXT")
+(in-package "SB!IMPL")
(defun make-weak-pointer (object)
#!+sb-doc
- "Allocates and returns a weak pointer which points to OBJECT."
+ "Allocate and return a weak pointer which points to OBJECT."
(declare (values weak-pointer))
(make-weak-pointer object))
#!-sb-fluid (declaim (inline weak-pointer-value))
(defun weak-pointer-value (weak-pointer)
#!+sb-doc
- "If WEAK-POINTER is valid, returns the value of WEAK-POINTER and T.
+ "If WEAK-POINTER is valid, return the value of WEAK-POINTER and T.
If the referent of WEAK-POINTER has been garbage collected, returns
the values NIL and NIL."
(declare (type weak-pointer weak-pointer)
(values t (member t nil)))
- ;; We don't need to wrap this with a without-gcing, because once we have
- ;; extracted the value, our reference to it will keep the weak pointer
- ;; from becoming broken. We just have to make sure the compiler won't
- ;; reorder these primitives.
+ ;; We don't need to wrap this with a WITHOUT-GCING, because once we
+ ;; have extracted the value, our reference to it will keep the weak
+ ;; pointer from becoming broken. We just have to make sure the
+ ;; compiler won't reorder these primitives.
+ ;;
+ ;; FIXME: Might it be a good idea to tweak the DEFKNOWNs for
+ ;; %WEAK-POINTER-VALUE and %WEAK-POINTER-BROKEN, so that the
+ ;; compiler will never try to reorder them even in code where we
+ ;; neglect to frame them in a LET?
(let ((value (sb!c::%weak-pointer-value weak-pointer))
(broken (sb!c::%weak-pointer-broken weak-pointer)))
(values value (not broken))))
.text
#define LDSO_STUBIFY(fct) \
- .align 16 ;\
-.globl ldso_stub__ ## fct ;\
- .type ldso_stub__ ## fct,@function ;\
-ldso_stub__ ## fct: ;\
- jmp fct ;\
-.L ## fct ## e1: ;\
- .size ldso_stub__ ## fct,.L ## fct ## e1-ldso_stub__ ## fct ;
+ .align 16 ; \
+.globl ldso_stub__ ## fct ; \
+ .type ldso_stub__ ## fct,@function ; \
+ldso_stub__ ## fct: ; \
+ jmp fct ; \
+.L ## fct ## e1: ; \
+ .size ldso_stub__ ## fct,.L ## fct ## e1-ldso_stub__ ## fct ;
LDSO_STUBIFY(accept)
LDSO_STUBIFY(access)
/* LDSO_STUBIFY(endspent) */
/* LDSO_STUBIFY(endusershell) */
/* LDSO_STUBIFY(endutent) */
-/* LDSO_STUBIFY(environ) */
/* LDSO_STUBIFY(erand48) */
/* LDSO_STUBIFY(erf) */
/* LDSO_STUBIFY(erfc) */
--- /dev/null
+#!/bin/sh
+
+# tests related to foreign function interface and LOAD-FOREIGN
+
+# This software is part of the SBCL system. See the README file for
+# more information.
+#
+# While most of SBCL is derived from the CMU CL system, the test
+# files (like this one) were written from scratch after the fork
+# from CMU CL.
+#
+# This software is in the public domain and is provided with
+# absolutely no warranty. See the COPYING and CREDITS files for
+# more information.
+
+testfilestem=$TMPDIR/sbcl-foreign-test-$$
+
+echo 'int summish(int x, int y) { return 1 + x + y; }' > $testfilestem.c
+make $testfilestem.o
+ld -shared -o $testfilestem.so $testfilestem.o
+
+sbcl --noinform --noprint --sysinit /dev/null --userinit /dev/null <<EOF
+ (load-foreign '("$testfilestem.so"))
+ (def-alien-routine summish int (x int) (y int))
+ (assert (= (summish 10 20) 31))
+ (sb-ext:quit :unix-status 52) ; success convention for Lisp program
+EOF
+if [ $? != 52 ]; then
+ echo test failed: $?
+ exit 1
+fi
+
+# FIXME: I rewrote the handling of ENV/ENVIRONMENT arguments for
+# LOAD-FOREIGN, but I can't think of a nice way to test it. (Kent Beck
+# would cry. If he didn't keel over on the spot and then commence
+# rolling over in his grave.:-) It would be good to make a test case
+# for it..
+
+# success convention for script
+exit 104
# absolutely no warranty. See the COPYING and CREDITS files for
# more information.
+# Make sure that there's at least something in the environment (for
+# one of the tests below).
+export SOMETHING_IN_THE_ENVIRONMENT='yes there is'
+
sbcl --noinform --noprint --sysinit /dev/null --userinit /dev/null <<EOF
(let ((string (with-output-to-string (stream)
(sb-ext:run-program "/bin/echo"
'("foo" "bar")
:output stream))))
- (when (string= string "foo bar
-")
- (sb-ext:quit :unix-status 52)))
+ (assert (string= string "foo bar
+")))
+ ;; Unix environment strings are ordinarily passed with SBCL convention
+ ;; (instead of CMU CL alist-of-keywords convention).
+ (let ((string (with-output-to-string (stream)
+ (sb-ext:run-program "/usr/bin/env" ()
+ :output stream
+ :environment '("FEEFIE=foefum")))))
+ (assert (string= string "FEEFIE=foefum
+")))
+ ;; The default Unix environment for the subprocess is the same as
+ ;; for the parent process. (I.e., we behave like perl and lots of
+ ;; other programs, but not like CMU CL.)
+ (let ((string (with-output-to-string (stream)
+ (sb-ext:run-program "/usr/bin/env" ()
+ :output stream)))
+ (expected (apply #'concatenate
+ 'string
+ (mapcar (lambda (environ-string)
+ (concatenate 'string
+ environ-string
+ (string #\newline)))
+ (sb-ext:posix-environ)))))
+ (assert (string= string expected)))
+ ;; That's not just because POSIX-ENVIRON is having a bad hair
+ ;; day and returning NIL, is it?
+ (assert (plusp (length (sb-ext:posix-environ))))
+ ;; success convention for this Lisp program run as part of a larger script
+ (sb-ext:quit :unix-status 52)))
EOF
if [ $? != 52 ]; then
echo test failed: $?
;;; versions, and a string like "0.6.5.12" is used for versions which
;;; aren't released but correspond only to CVS tags or snapshots.
-"0.6.10.1"
+"0.6.10.2"
projects / sbcl.git / commitdiff