From: William Harold Newman Date: Tue, 11 Jun 2002 13:50:22 +0000 (+0000) Subject: 0.7.4.24: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=625946563072d5b9fb7e9bde905f8cbed219a329;p=sbcl.git 0.7.4.24: Fix bug 177 (bogus type warnings from CALL-NEXT-METHOD) with a hack, wrapping the offending code in an opaque identity function. Add comments in INVOKE-EFFECTIVE-METHOD-FUNCTION explaining CSR's insight that the ,@(WHEN ...) clauses are optimizing slot access (with slots encoded as FIXNUMs). Also remove DECLARE NOTINLINE GET-SLOTS-OR-NIL now that I understand what the code is doing. --- diff --git a/BUGS b/BUGS index 4f58f70..9ec3cff 100644 --- a/BUGS +++ b/BUGS @@ -1289,49 +1289,7 @@ WORKAROUND: (make-instance 'c19) 177: - reported by Stig E Sandoe 8 Jun 2002 on sbcl-devel: - ;;; I am a bit unsure about SBCL's warnings with some of my code. - ;;; ASDF seems to die on warnings and SBCL seems to generate one - ;;; out of nothing. I've tried to turn it into an example - ;;; (that can be LOADed or COMPILEd to reproduce warnings): - (in-package :cl-user) - (defclass a () ()) - (defclass b () ()) - (defclass c (b) ()) - (defgeneric get-price (obj1 obj2)) - (defmethod get-price (obj1 obj2) - 0) - (defmethod get-price ((obj1 a) (obj2 b)) - 20) - (defmethod get-price ((obj1 a) (obj2 c)) - (* 3 (call-next-method))) - (print (get-price (make-instance 'a) (make-instance 'c))) - ;;; In the GET-PRICE where I call CALL-NEXT-METHOD, it starts to - ;;; generate real WARNINGS: - ;;; stig@palomba(9:02)[~] 690> sbcl - ;;; This is SBCL 0.7.4, an implementation of ANSI Common Lisp. - ;;; ... - ;;; * (load "call-next") - ;;; ; in: LAMBDA NIL - ;;; ; (CALL-NEXT-METHOD) - ;;; ; --> SB-PCL::CALL-NEXT-METHOD-BODY IF IF - ;;; ; --> SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION LOCALLY COND IF COND IF - ;;; PROGN - ;;; ; --> LET WHEN COND IF PROGN SETF LET* MULTIPLE-VALUE-BIND LET FUNCALL - ;;; ; --> SB-C::%FUNCALL BLOCK SETF SB-KERNEL:%SVSET SB-KERNEL:%ASET LET* - ;;; ; --> SB-KERNEL:HAIRY-DATA-VECTOR-SET MULTIPLE-VALUE-BIND - ;;; MULTIPLE-VALUE-CALL - ;;; ; --> FUNCTION - ;;; ; ==> - ;;; ; (SB-KERNEL:DATA-VECTOR-SET (TRULY-THE (SIMPLE-ARRAY T 1) ARRAY) - ;;; ; SB-INT:INDEX - ;;; ; SB-C::NEW-VALUE) - ;;; ; - ;;; ; caught WARNING: - ;;; ; Result is a A, not a NUMBER. - ;;; ... - ;;; ; compilation unit finished - ;;; ; caught 4 WARNING conditions + (fixed in sbcl-0.7.4.24) DEFUNCT CATEGORIES OF BUGS diff --git a/TODO b/TODO index fb776be..35e257a 100644 --- a/TODO +++ b/TODO @@ -1,6 +1,8 @@ for early 0.7.x: -* building with CLISP (or explaining why not) +* building using something other than SBCL/CMUCL, e.g. CLISP or OpenMCL, + as xc host; or at least hitting bugs (in them, not us:-) which + give us a good excuse not to:-| * urgent EVAL/EVAL-WHEN/%COMPILE/DEFUN/DEFSTRUCT cleanup: ** made inlining DEFUN inside MACROLET work again ** (also, while working on INLINE anyway, it might be easy diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp index 3284897..65433a1 100644 --- a/src/pcl/boot.lisp +++ b/src/pcl/boot.lisp @@ -770,11 +770,8 @@ bootstrapping. #-sb-fluid (declaim (sb-ext:freeze-type fast-instance-boundp)) (eval-when (:compile-toplevel :load-toplevel :execute) - -(defvar *allow-emf-call-tracing-p* nil) -(defvar *enable-emf-call-tracing-p* #-testing nil #+testing t) - -) ; EVAL-WHEN + (defvar *allow-emf-call-tracing-p* nil) + (defvar *enable-emf-call-tracing-p* #-sb-show nil #+sb-show t)) ;;;; effective method functions @@ -820,30 +817,34 @@ bootstrapping. (trace-emf-call ,emf ,restp (list ,@required-args+rest-arg)) (invoke-fast-method-call ,emf ,@required-args+rest-arg))) +;;; KLUDGE: an opaque-to-the-compiler IDENTITY function to hide code +;;; from the too-easily-bewildered compiler type checker +(defun trust-me-i-know-what-i-am-doing (x) + x) + (defmacro invoke-effective-method-function (emf restp &rest required-args+rest-arg) (unless (constantp restp) (error "The RESTP argument is not constant.")) + ;; FIXME: The RESTP handling here is confusing and maybe slightly + ;; broken if RESTP evaluates to a non-self-evaluating form. E.g. if + ;; (INVOKE-EFFECTIVE-METHOD-FUNCTION EMF '(ERROR "gotcha") ...) + ;; then TRACE-EMF-CALL-CALL-INTERNAL might die on a gotcha error. (setq restp (eval restp)) - `(locally - - ;; In sbcl-0.6.11.43, the compiler would issue bogus warnings - ;; about type mismatches in unreachable code when we - ;; macroexpanded the GET-SLOTS-OR-NIL expressions here and - ;; byte-compiled the code. GET-SLOTS-OR-NIL is now an inline - ;; function instead of a macro, which seems sufficient to solve - ;; the problem all by itself (probably because of some quirk in - ;; the relative order of expansion and type inference) but we - ;; also use overkill by NOTINLINEing GET-SLOTS-OR-NIL, because it - ;; looks as though (1) inlining isn't that much of a win anyway, - ;; and (2a) once you miss the FAST-METHOD-CALL clause you're - ;; going to be slow anyway, but (2b) code bloat still hurts even - ;; when it's off the critical path. - (declare (notinline get-slots-or-nil)) - + `(progn (trace-emf-call ,emf ,restp (list ,@required-args+rest-arg)) (cond ((typep ,emf 'fast-method-call) - (invoke-fast-method-call ,emf ,@required-args+rest-arg)) + (invoke-fast-method-call ,emf ,@required-args+rest-arg)) + ;; "What," you may wonder, "do these next two clauses do?" + ;; In that case, you are not a PCL implementor, for they + ;; considered this to be self-documenting.:-| Or CSR, for + ;; that matter, since he can also figure it out by looking + ;; at it without breaking stride. For the rest of us, + ;; though: From what the code is doing with .SLOTS. and + ;; whatnot, evidently it's implementing SLOT-VALUEish and + ;; GET-SLOT-VALUEish things. Then we can reason backwards + ;; and conclude that setting EMF to a FIXNUM is an + ;; optimized way to represent these slot access operations. ,@(when (and (null restp) (= 1 (length required-args+rest-arg))) `(((typep ,emf 'fixnum) (let* ((.slots. (get-slots-or-nil @@ -858,18 +859,31 @@ bootstrapping. (let ((.new-value. ,(car required-args+rest-arg)) (.slots. (get-slots-or-nil ,(car required-args+rest-arg)))) - (when .slots. - (setf (clos-slots-ref .slots. ,emf) .new-value.)))))) - #|| - ,@(when (and (null restp) (= 1 (length required-args+rest-arg))) - `(((typep ,emf 'fast-instance-boundp) - (let ((.slots. (get-slots-or-nil - ,(car required-args+rest-arg)))) - (and .slots. - (not (eq (clos-slots-ref - .slots. (fast-instance-boundp-index ,emf)) - +slot-unbound+))))))) - ||# + ;; KLUDGE: As of sbcl-0.7.4.20 or so, there's not + ;; enough information available either at + ;; macroexpansion time or at compile time to + ;; exclude the possibility that a two-argument + ;; CALL-NEXT-METHOD might be a FIXNUM-encoded slot + ;; writer, and when the compiler sees into this + ;; macroexpansion, it can tell that the type + ;; of this clause -- just in case of being + ;; a slot writer -- doesn't match the type + ;; needed for CALL-NEXT-METHOD, and complain. + ;; (E.g. in + ;; (defmethod get-price ((obj1 a) (obj2 c)) + ;; (* 3 (call-next-method))) + ;; in the original bug report from Stig Erik + ;; Sandoe. As a quick hack to make the bogus + ;; warning go away we use this + ;; opaque-to-the-compiler IDENTITY operation to + ;; hide any possible type mismatch.) + (trust-me-i-know-what-i-am-doing + (when .slots. + (setf (clos-slots-ref .slots. ,emf) .new-value.))))))) + ;; (In cmucl-2.4.8 there was a commented-out third ,@(WHEN + ;; ...) clause here to handle SLOT-BOUNDish stuff. Since + ;; there was no explanation and presumably the code is 10+ + ;; years stale, I simply deleted it. -- WHN) (t (etypecase ,emf (method-call @@ -988,7 +1002,7 @@ bootstrapping. `(if ,cnm-args (bind-args ((,@',args ,@',(when rest-arg - `(&rest ,rest-arg))) + `(&rest ,rest-arg))) ,cnm-args) ,call) ,call)))) diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp index 0d0d1e2..3a7da7b 100644 --- a/src/pcl/std-class.lisp +++ b/src/pcl/std-class.lisp @@ -970,9 +970,9 @@ (let ((method (get-method generic-function () (list class) nil))) (when method (remove-method generic-function method)))) -;;; make-reader-method-function and make-write-method function are NOT part of -;;; the standard protocol. They are however useful, PCL makes uses makes use -;;; of them internally and documents them for PCL users. +;;; MAKE-READER-METHOD-FUNCTION and MAKE-WRITE-METHOD function are NOT +;;; part of the standard protocol. They are however useful, PCL makes +;;; use of them internally and documents them for PCL users. ;;; ;;; *** This needs work to make type testing by the writer functions which ;;; *** do type testing faster. The idea would be to have one constructor @@ -980,7 +980,7 @@ ;;; ;;; *** There is a subtle bug here which is going to have to be fixed. ;;; *** Namely, the simplistic use of the template has to be fixed. We -;;; *** have to give the optimize-slot-value method the user might have +;;; *** have to give the OPTIMIZE-SLOT-VALUE method the user might have ;;; *** defined for this metaclass a chance to run. (defmethod make-reader-method-function ((class slot-class) slot-name) diff --git a/version.lisp-expr b/version.lisp-expr index cf4bfab..df97fa6 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.4.23" +"0.7.4.24"