fixing bugs introduced in 0.7.0 release...
...made LOAD-FOREIGN and LOAD-1-FOREIGN definitions work, at
least as far as I could test on OpenBSD. (As reported by
Stig E Sandoe sbcl-devel 2002-01-22, they were broken
in the 0.7.0 sources, because the SB-ALIEN:LOAD-FOREIGN
and SB-ALIEN:LOAD-1-FOREIGN symbols are no longer
visible in SB-SYS, and foreign.lisp was
IN-PACKAGE SB-SYS.)
...sharpened the foreign.test.sh tests to keep this from
happening again
...fixed bug 133 (somewhat kludgily, but hopefully better than
nothing)
made DEFGENERIC do trivial checks on its arguments immediately,
so (DEFGENERIC FOO OR ((X BAR) (Y BAR)) gives a
better error message
internal compiler error. (This error occurs in sbcl-0.6.13 and in
0.pre7.86.flaky7.14.)
-133:
- Trying to compile something like
- (sb!alien:def-alien-routine "breakpoint_remove" sb!c-call:void
- (code-obj sb!c-call:unsigned-long)
- (pc-offset sb!c-call:int)
- (old-inst sb!c-call:unsigned-long))
- in SBCL-0.pre7.86.flaky7.22 after warm init fails with an error
- cannot use values types here
- probably because the SB-C-CALL:VOID type gets translated to (VALUES).
- It should be valid to use VOID for a function return type, so perhaps
- instead of calling SPECIFIER-TYPE (which excludes all VALUES types
- automatically) we should call VALUES-SPECIFIER-TYPE and handle VALUES
- types manually, allowing the special case (VALUES) but still excluding
- all more-complex VALUES types.
-
135:
Ideally, uninterning a symbol would allow it, and its associated
FDEFINITION and PROCLAIM data, to be reclaimed by the GC. However,
"DEFPRINTER"
"AVER" "ENFORCE-TYPE"
+ ;; ..and CONDITIONs..
+ "UNSUPPORTED-OPERATOR"
+
;; ..and DEFTYPEs..
"INDEX"
(stream-error-stream condition)
(reader-eof-error-context condition)))))
\f
+;;;; special SBCL extension conditions
+
+;;; a condition for use in stubs for operations which aren't
+;;; unsupported on some OSes/CPUs/whatever
+;;;
+;;; E.g. in sbcl-0.7.0.5, it might be appropriate to do something
+;;; like
+;;; #-(or freebsd linux)
+;;; (defun load-foreign (&rest rest)
+;;; (error 'unsupported-operator :name 'load-foreign))
+;;; #+(or freebsd linux)
+;;; (defun load-foreign ... actual definition ...)
+;;; By signalling a standard condition in this case, we make it
+;;; possible for test code to distinguish between intentionally not
+;;; implemented and just screwed up somehow. (Before this condition
+;;; was defined, this was dealt with by checking for FBOUNDP, but
+;;; that didn't work reliably. In sbcl-0.7.0, a a package screwup
+;;; left the definition of LOAD-FOREIGN in the wrong package, so
+;;; it was unFBOUNDP even on architectures where it was supposed to
+;;; be supported, and the regression tests cheerfully passed because
+;;; they assumed that unFBOUNDPness meant they were running on an
+;;; system which didn't support the extension.)
+(define-condition unsupported-operator (cell-error) ()
+ (:report
+ (lambda (condition stream)
+ (format stream
+ "unsupported on this implementation: ~S"
+ (cell-error-name condition)))))
+\f
;;;; restart definitions
(define-condition abort-failure (control-error) ()
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.
-(in-package "SB-SYS") ; (SB-SYS, not SB!SYS, since we're built in warm load.)
+(in-package "SB-ALIEN") ; (SB-ALIEN, not SB!ALIEN, since we're in warm load.)
(defun pick-temporary-file-name (&optional
;; KLUDGE: There are various security
;;; placeholder implementation is overwritten by a subsequent real
;;; implementation.)
;;;
-;;; You may want to use sb-sys:foreign-symbol-address instead of
+;;; You may want to use SB-SYS:FOREIGN-SYMBOL-ADDRESS instead of
;;; calling this directly; see code/target-load.lisp.
(defun get-dynamic-foreign-symbol-address (symbol)
(declare (type simple-string symbol) (ignore symbol))
;;; dlsym()-based implementation of GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS
;;; and functions (e.g. LOAD-FOREIGN) which affect it. This should
;;; work on any ELF system with dlopen(3) and dlsym(3)
+#-(or linux FreeBSD)
+(macrolet ((define-unsupported-fun (fun-name)
+ `(defun ,fun-name (&rest rest)
+ "unsupported on this system"
+ (declare (ignore rest))
+ (error 'unsupported-operator :name ',fun-name))))
+ (define-unsupported-fun load-1-foreign)
+ (define-unsupported-fun load-foreign))
#+(or linux FreeBSD)
(progn
\f
;;;; the FUNCTION and VALUES alien types
+;;; not documented in CMU CL:-(
+;;;
+;;; reverse engineering observations:
+;;; * seems to be set when translating return values
+;;; * seems to enable the translation of (VALUES), which is the
+;;; Lisp idiom for C's return type "void" (which is likely
+;;; why it's set when when translating return values)
(defvar *values-type-okay* nil)
(define-alien-type-class (fun :include mem-block)
(stub nil :type (or null function)))
(define-alien-type-translator function (result-type &rest arg-types
- &environment env)
+ &environment env)
(make-alien-fun-type
:result-type (let ((*values-type-okay* t))
(parse-alien-type result-type env))
;; anyway, and (2) such a declamation can be (especially for
;; alien values) both messy to do by hand and very important
;; for performance of later code which uses the return value.
- (declaim (ftype (function ,(mapcar (constantly t) args)
- (alien ,result-type))
- ,lisp-name))
+ ,(let (;; FIXME: Ideally, we'd actually declare useful types
+ ;; here, so e.g. an alien function of "int" and "char"
+ ;; arguments would get Lisp arg types WORD and CHARACTER
+ ;; or something. Meanwhile, for now we just punt.
+ (lisp-arg-types (mapcar (constantly t) args))
+ ;; KLUDGE: This is a quick hack to solve bug 133,
+ ;; where PROCLAIM trying to translate alien void result
+ ;; types would signal an error here ("cannot use values
+ ;; types here"), and the kludgy SB!ALIEN::*VALUE-TYPE-OKAY*
+ ;; flag to enable values types didn't fit into PROCLAIM
+ ;; in any reasonable way. But there's likely a better
+ ;; way to do this. (If there isn't a suitable utility
+ ;; to systematically translate C return types into
+ ;; Lisp return types, there should be.) -- WHN 2002-01-22
+ (lisp-result-type (if (eql result-type 'void)
+ '(values)
+ `(alien ,result-type))))
+ `(declaim (ftype (function ,lisp-arg-types ,lisp-result-type)
+ ,lisp-name)))
(defun ,lisp-name ,(lisp-args)
,@(docs)
foreign-symbol-address-as-integer))
-;;; sb!sys:get-dynamic-foreign-symbol-address is in foreign.lisp, on
+;;; SB!SYS:GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS is in foreign.lisp, on
;;; platforms that have dynamic loading
(defun foreign-symbol-address-as-integer (foreign-symbol)
(or (find-foreign-symbol-in-table foreign-symbol *static-foreign-symbols*)
;; when we have to ignore a PROCLAIM because the type system is
;; uninitialized.
(when *type-system-initialized*
- (let ((type (specifier-type (first args))))
- (unless (csubtypep type (specifier-type 'function))
+ (let ((ctype (specifier-type (first args))))
+ (unless (csubtypep ctype (specifier-type 'function))
(error "not a function type: ~S" (first args)))
(dolist (name (rest args))
#|
(when (eq (info :function :where-from name) :declared)
(let ((old-type (info :function :type name)))
- (when (type/= type old-type)
+ (when (type/= ctype old-type)
(style-warn
"new FTYPE proclamation~@
~S~@
for ~S does not match old FTYPE proclamation~@
~S"
- (list type name old-type)))))
+ (list ctype name old-type)))))
|#
;; Now references to this function shouldn't be warned
(note-name-defined name :function)
;; the actual type declaration
- (setf (info :function :type name) type
+ (setf (info :function :type name) ctype
(info :function :where-from name) :declared)))))
(freeze-type
(dolist (type args)
standard-compute-effective-method))))
\f
(defmacro defgeneric (fun-name lambda-list &body options)
+ (declare (type list lambda-list))
+ (unless (legal-fun-name-p fun-name)
+ (error 'simple-program-error
+ :format-control "illegal generic function name ~S"
+ :format-arguments (list fun-name)))
(let ((initargs ())
(methods ()))
(flet ((duplicate-option (name)
ld -shared -o $testfilestem.so $testfilestem.o
${SBCL:-sbcl} <<EOF
- (unless (fboundp 'load-foreign) ; not necessarily supported on all OSes..
- (sb-ext:quit :unix-status 52)) ; successfully unsupported:-|
- (load-foreign '("$testfilestem.so"))
+ (handler-case
+ (load-foreign '("$testfilestem.so"))
+ (sb-int:unsupported-operator ()
+ ;; At least as of sbcl-0.7.0.5, LOAD-FOREIGN isn't supported
+ ;; on every OS. In that case, there's nothing to test, and we
+ ;; can just fall through to success.
+ (sb-ext:quit :unix-status 52))) ; success convention for Lisp program
(define-alien-routine summish int (x int) (y int))
(assert (= (summish 10 20) 31))
(sb-ext:quit :unix-status 52) ; success convention for Lisp program
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.7.0.4"
+"0.7.0.5"
projects / sbcl.git / commitdiff