1.0.24.42: fix bug 235a

  This is probably the same bug as 162

235: "type system and inline expansion"

  a.

  (declaim (ftype (function (cons) number) acc))

  (declaim (inline acc))

  (defun acc (c)

    (the number (car c)))

  (defun foo (x y)

    (values (locally (declare (optimize (safety 0)))

              (acc x))

            (locally (declare (optimize (safety 3)))

              (acc y))))

  (foo '(nil) '(t)) => NIL, T.

  As of 0.9.15.41 this seems to be due to ACC being inlined only once

  inside FOO, which results in the second call reusing the FUNCTIONAL

  resulting from the first -- which doesn't check the type.

237: "Environment arguments to type functions"

  a. Functions SUBTYPEP, TYPEP, UPGRADED-ARRAY-ELEMENT-TYPE, and 

     UPGRADED-COMPLEX-PART-TYPE now have an optional environment

    computes the right offset for the memory copy.

  * bug fix: compilation problem involving inlined calls to aliens with

    result type VOID. (reported by Ken Olum)

  * bug fix: #235a; sequential inline expasion in different policies no

    longer reuses the functional from the previous expansion site.

changes in sbcl-1.0.24 relative to 1.0.23:

  * new feature: ARRAY-STORAGE-VECTOR provides access to the underlying data

                            leaf

                            inlinep

                            (info :function :info name))))

                 ;; allow backward references to this function from

                 ;; following top level forms

                 (setf (defined-fun-functional leaf) res)

                 ;; Allow backward references to this function from following

                 ;; forms. (Reused only if policy matches.)

                 (push res (defined-fun-functionals leaf))

                 (change-ref-leaf ref res))))

        (let ((fun (defined-fun-functional leaf)))

          (if (or (not fun)

                  (with-ir1-environment-from-node call

                    (frob)

                    (locall-analyze-component *current-component*)))

              ;; If we've already converted, change ref to the converted functional.

              ;; If we've already converted, change ref to the converted

              ;; functional.

              (change-ref-leaf ref fun))))

      (values (ref-leaf ref) nil))

     (t

                                          :maybe-add-debug-catch t

                                          :source-name name)))

             (assert-global-function-definition-type name res)

             (setf (defined-fun-functional defined-fun-res) res)

             (push res (defined-fun-functionals defined-fun-res))

             (unless (eq (defined-fun-inlinep defined-fun-res) :notinline)

               (substitute-leaf-if

                (lambda (ref)

             (setf (gethash name *free-funs*) res)))

          ;; If *FREE-FUNS* has a previously converted definition

          ;; for this name, then blow it away and try again.

          ((defined-fun-functional found)

          ((defined-fun-functionals found)

           (remhash name *free-funs*)

           (get-defined-fun name))

          (t found))))

                       *universal-type*)

     :where-from where)))

;;; Has the *FREE-FUNS* entry FREE-FUN become invalid?

;;; Have some DEFINED-FUN-FUNCTIONALS of a *FREE-FUNS* entry become invalid?

;;; Drop 'em.

;;;

;;; In CMU CL, the answer was implicitly always true, so this

;;; predicate didn't exist.

;;;

;;; This predicate was added to fix bug 138 in SBCL. In some obscure

;;; circumstances, it was possible for a *FREE-FUNS* entry to contain a

;;; DEFINED-FUN whose DEFINED-FUN-FUNCTIONAL object contained IR1

;;; stuff (NODEs, BLOCKs...) referring to an already compiled (aka

;;; "dead") component. When this IR1 stuff was reused in a new

;;; component, under further obscure circumstances it could be used by

;;; This was added to fix bug 138 in SBCL. It is possible for a *FREE-FUNS*

;;; entry to contain a DEFINED-FUN whose DEFINED-FUN-FUNCTIONAL object

;;; contained IR1 stuff (NODEs, BLOCKs...) referring to an already compiled

;;; (aka "dead") component. When this IR1 stuff was reused in a new component,

;;; under further obscure circumstances it could be used by

;;; WITH-IR1-ENVIRONMENT-FROM-NODE to generate a binding for

;;; *CURRENT-COMPONENT*. At that point things got all confused, since

;;; IR1 conversion was sending code to a component which had already

;;; been compiled and would never be compiled again.

(defun invalid-free-fun-p (free-fun)

;;; *CURRENT-COMPONENT*. At that point things got all confused, since IR1

;;; conversion was sending code to a component which had already been compiled

;;; and would never be compiled again.

;;;

;;; Note: as of 1.0.24.41 this seems to happen only in XC, and the original

;;; BUGS entry also makes it seem like this might not be an issue at all on

;;; target.

(defun clear-invalid-functionals (free-fun)

  ;; There might be other reasons that *FREE-FUN* entries could

  ;; become invalid, but the only one we've been bitten by so far

  ;; (sbcl-0.pre7.118) is this one:

  (and (defined-fun-p free-fun)

       (let ((functional (defined-fun-functional free-fun)))

         (or (and functional

                  (eql (functional-kind functional) :deleted))

             (and (lambda-p functional)

  (when (defined-fun-p free-fun)

    (setf (defined-fun-functionals free-fun)

          (delete-if (lambda (functional)

                       (or (eq (functional-kind functional) :deleted)

                           (when (lambda-p functional)

                             (or

                              ;; (The main reason for this first test is to bail

                              ;; out early in cases where the LAMBDA-COMPONENT

                              ;; that case, it seems rather questionable to reuse

                              ;; it, and certainly it shouldn't be necessary to

                              ;; reuse it, so we cheerfully declare it invalid.

                   (null (lambda-bind functional))

                              (not (lambda-bind functional))

                              ;; If this IR1 stuff belongs to a dead component,

                              ;; then we can't reuse it without getting into

                              ;; bizarre confusion.

                   (eql (component-info (lambda-component functional))

                        :dead)))))))

                              (eq (component-info (lambda-component functional))

                                  :dead)))))

                     (defined-fun-functionals free-fun)))

    nil))

;;; If NAME already has a valid entry in *FREE-FUNS*, then return

;;; the value. Otherwise, make a new GLOBAL-VAR using information from

(declaim (ftype (sfunction (t string) global-var) find-free-fun))

(defun find-free-fun (name context)

  (or (let ((old-free-fun (gethash name *free-funs*)))

        (and (not (invalid-free-fun-p old-free-fun))

        (when old-free-fun

          (clear-invalid-functionals old-free-fun)

          old-free-fun))

      (ecase (info :function :kind name)

        ;; FIXME: The :MACRO and :SPECIAL-FORM cases could be merged.

    (when (defined-fun-p var)

      (setf (defined-fun-inline-expansion res)

            (defined-fun-inline-expansion var))

      (setf (defined-fun-functional res)

            (defined-fun-functional var)))

      (setf (defined-fun-functionals res)

            (defined-fun-functionals var)))

    ;; FIXME: Is this really right? Needs we not set the FUNCTIONAL

    ;; to the original global-var?

    res))