archived in the BUGS file.
Nathan Froyd:
- He has reported bugs and ported fixes from CMU CL.
+ He has reported bugs and ported fixes from CMU CL. He has fixed
Robert MacLachlan:
He has continued to answer questions about, and contribute fixes to,
updating documentation, and even, for better or worse, getting
rid of various functionality (e.g. the byte interpreter).
+Christopher Rhodes:
+ He has done various low-level work on SBCL, especially for the
+ SPARC port (and for CPU-architecture-neutral things motivated by
+ it, like *BACKEND-FEATURES*). He's also contributed miscellaneous
+ bug fixes.
+
Raymond Toy:
He continued to work on CMU CL after the SBCL fork, especially on
floating point stuff. Various patches and fixes of his have been
(values t (or index null))
(call))
-;;; Structure slot accessors or setters are magically "known" to be
-;;; these functions, although the var remains the Slot-Accessor
-;;; describing the actual function called.
-;;;
-;;; FIXME: It would be nice to make structure slot accessors be
-;;; ordinary functions.
-(defknown %slot-accessor (t) t (flushable))
-(defknown %slot-setter (t t) t (unsafe))
-
(defknown sb!kernel::arg-count-error (t t t t t t) nil (unsafe))
\f
;;;; SETF inverses
;;; if necessary. We claim that the parent form is LABELS for
;;; context declarations, since we don't want it to be considered
;;; a real global function.
-;;; -- In addition to a direct check for the function name in the
-;;; table, we also must check for slot accessors. If the function
-;;; is a slot accessor, then we set the combination kind to the
-;;; function info of %SLOT-SETTER or %SLOT-ACCESSOR, as
-;;; appropriate.
;;; -- If it is a known function, mark it as such by setting the KIND.
;;;
;;; We return the leaf referenced (NIL if not a leaf) and the
(values (ref-leaf (continuation-use (basic-combination-fun call)))
nil))
(t
- (let* ((name (leaf-source-name leaf))
- (info (info :function :info
- (if (slot-accessor-p leaf)
- (if (consp source-name) ; i.e. if SETF function
- '%slot-setter
- '%slot-accessor)
- name))))
+ (let ((info (info :function :info (leaf-source-name leaf))))
(if info
(values leaf (setf (basic-combination-kind call) info))
(values leaf nil)))))))
(specifier-type 'function))
:where-from where)))
-;;; Return a SLOT-ACCESSOR structure usable for referencing the slot
-;;; accessor NAME. CLASS is the structure class.
-(defun find-structure-slot-accessor (class name)
- (declare (type sb!xc:class class))
- (let* ((info (layout-info
- (or (info :type :compiler-layout (sb!xc:class-name class))
- (class-layout class))))
- (accessor-name (if (listp name) (cadr name) name))
- (slot (find accessor-name (dd-slots info)
- :key #'sb!kernel:dsd-accessor-name))
- (type (dd-name info))
- (slot-type (dsd-type slot)))
- (unless slot
- (error "can't find slot ~S" type))
- (make-slot-accessor
- :%source-name name
- :type (specifier-type
- (if (listp name)
- `(function (,slot-type ,type) ,slot-type)
- `(function (,type) ,slot-type)))
- :for class
- :slot slot)))
-
;;; Has the *FREE-FUNS* entry FREE-FUN become invalid?
;;;
;;; In CMU CL, the answer was implicitly always true, so this
(def-frob list)
(def-frob list*))
\f
-;;;; structure accessors
-;;;;
-;;;; These guys have to bizarrely determine the slot offset by looking
-;;;; at the called function.
-
-(defoptimizer (%slot-accessor ir2-convert) ((str) node block)
- (let* ((cont (node-cont node))
- (res (continuation-result-tns cont
- (list *backend-t-primitive-type*))))
- (vop instance-ref node block
- (continuation-tn node block str)
- (dsd-index
- (slot-accessor-slot
- (ref-leaf
- (continuation-use
- (combination-fun node)))))
- (first res))
- (move-continuation-result node block res cont)))
-
-(defoptimizer (%slot-setter ir2-convert) ((value str) node block)
- (let ((val (continuation-tn node block value)))
- (vop instance-set node block
- (continuation-tn node block str)
- val
- (dsd-index
- (slot-accessor-slot
- (ref-leaf
- (continuation-use
- (combination-fun node))))))
-
- (move-continuation-result node block (list val) (node-cont node))))
-\f
;;; Convert the code in a component into VOPs.
(defun ir2-convert (component)
(declare (type component component))
ltn-policy ; a hack to effectively (DECLARE (IGNORE LTN-POLICY))
(setf (basic-combination-info node) :funny)
(setf (node-tail-p node) nil))
-
-;;; Both of these functions need special LTN-annotate methods, since
-;;; we only want to clear the TYPE-CHECK in unsafe policies. If we
-;;; allowed the call to be annotated as a full call, then no type
-;;; checking would be done.
-;;;
-;;; We also need a special LTN annotate method for %SLOT-SETTER so
-;;; that the function is ignored. This is because the reference to a
-;;; SETF function can't be delayed, so IR2 conversion would have
-;;; already emitted a call to FDEFINITION by the time the IR2 convert
-;;; method got control.
-(defoptimizer (%slot-accessor ltn-annotate) ((struct) node ltn-policy)
- (setf (basic-combination-info node) :funny)
- (setf (node-tail-p node) nil)
- (annotate-ordinary-continuation struct ltn-policy))
-(defoptimizer (%slot-setter ltn-annotate) ((struct value) node ltn-policy)
- (setf (basic-combination-info node) :funny)
- (setf (node-tail-p node) nil)
- (annotate-ordinary-continuation struct ltn-policy)
- (annotate-ordinary-continuation value ltn-policy))
\f
;;;; known call annotation
(where-from :test (not (eq where-from :assumed)))
kind)
-;;; The SLOT-ACCESSOR structure represents slot accessor functions. It
-;;; is a subtype of GLOBAL-VAR to make it look more like a normal
-;;; function.
-(def!struct (slot-accessor (:include global-var
- (where-from :defined)
- (kind :global-function)))
- ;; The description of the structure that this is an accessor for.
- (for (missing-arg) :type sb!xc:class)
- ;; The slot description of the slot.
- (slot (missing-arg)))
-(defprinter (slot-accessor :identity t)
- %source-name
- for
- slot)
-
;;; A DEFINED-FUN represents a function that is defined in the same
;;; compilation block, or that has an inline expansion, or that has a
;;; non-NIL INLINEP value. Whenever we change the INLINEP state (i.e.
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.pre7.129"
+"0.pre7.130"
projects / sbcl.git / commitdiff