From: William Harold Newman Date: Fri, 19 Jan 2001 18:02:07 +0000 (+0000) Subject: 0.6.10.2: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=e5f24ebc38e38c986df830fd1e4035d16bea4e5c;p=sbcl.git 0.6.10.2: merged MNA LOAD-FOREIGN patch (sbcl-devel 2001-01-10) tweaked LOAD-FOREIGN and RUN-PROGRAM to use :ENVIRONMENT instead of lossy :ENV by preference renamed GET-UNIX-ENVIRONMENT to SB-EXT:POSIX-ENVIRON, by analogy with SB-EXT:POSIX-GETENV removed (MERGE-PATHNAMES PROGRAM "path:") in RUN-PROGRAM, since it refers to a search list which isn't defined in SBCL (and since I'd like to remove all support for search lists anyway). SB-EXT is a public interface package not really intended as a home for implementations; switched IN-PACKAGEs to use SB-IMPL instead To support this, SB-IMPL should USE SB-C-CALL and SB-ALIEN as SB-EXT does. made RUN-PROGRAM default to copying Unix environment added LOAD-FOREIGN and RUN-PROGRAM test cases --- diff --git a/BUGS b/BUGS index 2f2a651..0cc98bc 100644 --- a/BUGS +++ b/BUGS @@ -853,6 +853,17 @@ Error in function C::GET-LAMBDA-TO-COMPILE: 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 diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 7888052..816e75f 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -325,8 +325,8 @@ #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. @@ -484,7 +484,7 @@ like *STACK-TOP-HINT*" :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*" @@ -795,6 +795,10 @@ retained, possibly temporariliy, because it might be used internally." "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" @@ -1429,7 +1433,7 @@ stable Unix interface suitable for the end user. 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" diff --git a/src/code/boot-extensions.lisp b/src/code/boot-extensions.lisp index 63c57a9..5f0ae6a 100644 --- a/src/code/boot-extensions.lisp +++ b/src/code/boot-extensions.lisp @@ -9,7 +9,7 @@ ;;;; 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 diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index 7b2f0c5..812b35d 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -16,7 +16,7 @@ ;;;; 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")) diff --git a/src/code/final.lisp b/src/code/final.lisp index 20c2fa8..e3685dc 100644 --- a/src/code/final.lisp +++ b/src/code/final.lisp @@ -9,7 +9,7 @@ ;;;; 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) diff --git a/src/code/foreign.lisp b/src/code/foreign.lisp index 636a4d2..d4e3e9e 100644 --- a/src/code/foreign.lisp +++ b/src/code/foreign.lisp @@ -11,8 +11,6 @@ (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 @@ -45,7 +43,7 @@ (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 @@ -96,11 +94,9 @@ (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)) @@ -126,8 +122,8 @@ (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 @@ -165,30 +161,44 @@ (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))) @@ -206,7 +216,7 @@ (list files) files)) libraries)) - :env env + :environment environment :input nil :output error-output :error :output))) @@ -219,6 +229,5 @@ (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 diff --git a/src/code/format-time.lisp b/src/code/format-time.lisp index e23ff4b..33d07c0 100644 --- a/src/code/format-time.lisp +++ b/src/code/format-time.lisp @@ -9,7 +9,7 @@ ;;;; 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")) diff --git a/src/code/late-extensions.lisp b/src/code/late-extensions.lisp index 694ce6b..afd2191 100644 --- a/src/code/late-extensions.lisp +++ b/src/code/late-extensions.lisp @@ -7,7 +7,7 @@ ;;;; 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 diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp index 7db3ff5..d6b2080 100644 --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -10,7 +10,92 @@ ;;;; provided with absolutely no warranty. See the COPYING and CREDITS ;;;; files for more information. -(in-package "SB-EXT") +(in-package "SB-IMPL") + +;;;; 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)) ;;;; Import wait3(2) from Unix. @@ -349,6 +434,12 @@ (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. @@ -387,21 +478,48 @@ ;;; 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. @@ -443,6 +561,8 @@ 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. @@ -450,25 +570,35 @@ (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 @@ -479,18 +609,11 @@ ;; 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" diff --git a/src/code/target-extensions.lisp b/src/code/target-extensions.lisp index 123af88..28699d1 100644 --- a/src/code/target-extensions.lisp +++ b/src/code/target-extensions.lisp @@ -15,7 +15,9 @@ ;;;; provided with absolutely no warranty. See the COPYING and CREDITS ;;;; files for more information. -(in-package "SB!EXT") +(in-package "SB!IMPL") + +;;;; miscellaneous I/O ;;; INDENTING-FURTHER is a user-level macro which may be used to locally ;;; increment the indentation of a stream. diff --git a/src/code/unix.lisp b/src/code/unix.lisp index 4ad861f..7c1f63d 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -1,8 +1,9 @@ -;;;; 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 @@ -98,9 +99,9 @@ (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))) @@ -116,9 +117,16 @@ (defmacro int-syscall ((name &rest arg-types) &rest args) `(syscall (,name ,@arg-types) (values result 0) ,@args)) -;;; 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)) + +;;; from stdio.h (defun unix-rename (name1 name2) #!+sb-doc @@ -127,16 +135,9 @@ (declare (type unix-pathname name1 name2)) (void-syscall ("rename" c-string c-string) name1 name2)) -;;; 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)) - ;;; 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) @@ -157,14 +158,11 @@ (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 @@ -181,7 +179,7 @@ (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 @@ -192,15 +190,11 @@ #!+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") ;;;; direntry.h @@ -211,7 +205,7 @@ (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") ;;;; dirent.h @@ -226,13 +220,12 @@ (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 "") @@ -252,7 +245,6 @@ (values nil enoent)) (t (values nil enotdir))))) -(/show0 "unix.lisp 286") (defun read-dir (dir) (declare (type directory dir)) @@ -267,48 +259,31 @@ (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) + +;;;; fcntl.h +;;;; +;;;; POSIX Standard: 6.5 File Control Operations -;;; dlfcn.h -> in foreign.lisp - -;;; fcntl.h -;;; -;;; POSIX Standard: 6.5 File Control Operations - -(/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)) @@ -318,14 +293,10 @@ ;;; 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)) -;;; fcntlbits.h +;;;; fcntlbits.h (/show0 "unix.lisp 337") (defconstant o_rdonly 0) ; read-only flag @@ -369,7 +340,7 @@ (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 @@ -893,15 +864,14 @@ ;;;; 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) diff --git a/src/code/weak.lisp b/src/code/weak.lisp index 8ce3367..37b83a1 100644 --- a/src/code/weak.lisp +++ b/src/code/weak.lisp @@ -9,26 +9,31 @@ ;;;; 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)))) diff --git a/src/runtime/ldso-stubs.S b/src/runtime/ldso-stubs.S index 48e609b..eacfdb2 100644 --- a/src/runtime/ldso-stubs.S +++ b/src/runtime/ldso-stubs.S @@ -22,13 +22,13 @@ gcc2_compiled.: .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) @@ -259,7 +259,6 @@ ldso_stub__ ## fct: ;\ /* LDSO_STUBIFY(endspent) */ /* LDSO_STUBIFY(endusershell) */ /* LDSO_STUBIFY(endutent) */ -/* LDSO_STUBIFY(environ) */ /* LDSO_STUBIFY(erand48) */ /* LDSO_STUBIFY(erf) */ /* LDSO_STUBIFY(erfc) */ diff --git a/tests/foreign.test.sh b/tests/foreign.test.sh new file mode 100644 index 0000000..69702f6 --- /dev/null +++ b/tests/foreign.test.sh @@ -0,0 +1,40 @@ +#!/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 <