Faré Rideau)
* bug fix: GET-INTERNAL-REAL-TIME now works even for processes that
have been running for over 50 days. (reported by Gilbert Baumann)
+ * bug fix: the logic for getting names of functions gets less
+ confused when confronded with alternate-metaclass
+ funcallable-instances. (reported by Cyrus Harmon)
* threads
** bug fix: parent thread now can be gc'ed even with a live
child thread
"BUILT-IN-CLASSOID-TRANSLATION" "RANDOM-LAYOUT-CLOS-HASH"
"CLASSOID-PCL-CLASS" "FUNCALLABLE-STRUCTURE"
"FUNCALLABLE-INSTANCE-FUN" "%FUNCALLABLE-INSTANCE-LAYOUT"
+ "%SET-FUNCALLABLE-INSTANCE-LAYOUT"
"BASIC-STRUCTURE-CLASSOID" "CLASSOID-CELL-CLASSOID"
"FUNCALLABLE-STRUCTURE-CLASSOID-P" "REGISTER-LAYOUT"
"FUNCALLABLE-INSTANCE" "RANDOM-FIXNUM-MAX"
(defsetf %instance-layout %set-instance-layout)
(defsetf %funcallable-instance-info %set-funcallable-instance-info)
+(defsetf %funcallable-instance-layout %set-funcallable-instance-layout)
;;; from early-setf.lisp
(in-package "SB!IMPL")
(let* ((dd (make-defstruct-description class-name))
(conc-name (concatenate 'string (symbol-name class-name) "-"))
(dd-slots (let ((reversed-result nil)
- ;; The index starts at 1 for ordinary
- ;; named slots because slot 0 is
- ;; magical, used for LAYOUT in
- ;; CONDITIONs or for something (?) in
- ;; funcallable instances.
+ ;; The index starts at 1 for ordinary named
+ ;; slots because slot 0 is magical, used for
+ ;; the LAYOUT in CONDITIONs and
+ ;; FUNCALLABLE-INSTANCEs. (This is the same
+ ;; in ordinary structures too: see (INCF
+ ;; DD-LENGTH) in
+ ;; PARSE-DEFSTRUCT-NAME-AND-OPTIONS).
(index 1))
(dolist (slot-name slot-names)
(push (make-defstruct-slot-description
,object-gensym)
'%instance-ref))
(funcallable-structure
- (values `(%make-funcallable-instance ,dd-length
- ,delayed-layout-form)
+ (values `(let ((,object-gensym
+ (%make-funcallable-instance ,dd-length)))
+ (setf (%funcallable-instance-layout ,object-gensym)
+ ,delayed-layout-form)
+ ,object-gensym)
'%funcallable-instance-info)))
`(progn
(defun %set-instance-layout (instance new-value)
(%set-instance-layout instance new-value))
-(defun %make-funcallable-instance (len layout)
- (%make-funcallable-instance len layout))
+(defun %make-funcallable-instance (len)
+ (%make-funcallable-instance len))
(defun funcallable-instance-p (x) (funcallable-instance-p x))
(defun funcallable-instance-fun (fin)
(%funcallable-instance-lexenv fin))
-;;; The heart of the magic of funcallable instances ("FINs"). The
-;;; function for a FIN must be a magical INSTANCE-LAMBDA form. When
+;;; The heart of the magic of funcallable instances ("FINs"). When
;;; called (as with any other function), we grab the code pointer, and
;;; call it, leaving the original function object in LEXENV (in case
-;;; it was a closure). If it is actually a FIN, then we need to do an
+;;; it was a closure). If it is actually a FIN, then we need to do an
;;; extra indirection with funcallable-instance-lexenv to get at any
-;;; closure environment. This extra indirection is set up when
+;;; closure environment. This extra indirection is set up when
;;; accessing the closure environment of an INSTANCE-LAMBDA. Note that
;;; the original FIN pointer is lost, so if the called function wants
;;; to get at the original object to do some slot accesses, it must
;;;
;;; If we set the FIN function to be a FIN, we directly copy across
;;; both the code pointer and the lexenv, since that code pointer (for
-;;; an instance-lambda) is expecting that lexenv to be accessed. This
+;;; an instance-lambda) is expecting that lexenv to be accessed. This
;;; effectively pre-flattens what would otherwise be a chain of
-;;; indirections. (That used to happen when PCL dispatch functions
+;;; indirections. (That used to happen when PCL dispatch functions
;;; were byte-compiled; now that the byte compiler is gone, I can't
;;; think of another example offhand. -- WHN 2001-10-06)
;;;
;;; The only loss is that if someone accesses the
-;;; FUNCALLABLE-INSTANCE-FUN, then won't get a FIN back. This probably
-;;; doesn't matter, since PCL only sets the FIN function.
+;;; FUNCALLABLE-INSTANCE-FUN, then won't get a FIN back. This
+;;; probably doesn't matter, since PCL only sets the FIN function.
(defun (setf funcallable-instance-fun) (new-value fin)
(setf (%funcallable-instance-fun fin)
(%closure-fun new-value))
(#.sb!vm:closure-header-widetag
(%closure-fun function))
(#.sb!vm:funcallable-instance-header-widetag
- (funcallable-instance-fun function))))
+ (%fun-fun (funcallable-instance-fun function)))))
(defun %closure-values (object)
(declare (function object))
)
(lexenv :ref-known (flushable) :ref-trans %funcallable-instance-lexenv
:set-known (unsafe) :set-trans (setf %funcallable-instance-lexenv))
- (layout :init :arg
- :ref-known (flushable) :ref-trans %funcallable-instance-layout
- :set-known (unsafe) :set-trans (setf %funcallable-instance-layout))
(info :rest-p t))
(define-primitive-object (value-cell :lowtag other-pointer-lowtag
(defknown %closure-index-ref (function index) t
(flushable))
-(defknown %make-funcallable-instance (index layout) function
+(defknown %make-funcallable-instance (index) function
(unsafe))
(defknown %funcallable-instance-info (function index) t (flushable))
`(truly-the layout (%instance-ref ,x 0)))
(define-source-transform %set-instance-layout (x val)
`(%instance-set ,x 0 (the layout ,val)))
+(define-source-transform %funcallable-instance-layout (x)
+ `(truly-the layout (%funcallable-instance-info ,x 0)))
+(define-source-transform %set-funcallable-instance-layout (x val)
+ `(setf (%funcallable-instance-info ,x 0) (the layout ,val)))
\f
;;;; character support
(declare (type function new-value))
(aver (funcallable-instance-p fin))
(setf (funcallable-instance-fun fin) new-value))
+;;; FIXME: these macros should just go away. It's not clear whether
+;;; the inline functions defined by
+;;; !DEFSTRUCT-WITH-ALTERNATE-METACLASS are as efficient as they could
+;;; be; ordinary defstruct accessors are defined as source transforms.
(defmacro fsc-instance-p (fin)
`(funcallable-instance-p ,fin))
(defmacro fsc-instance-wrapper (fin)
`(%funcallable-instance-layout ,fin))
-;;; FIXME: This seems to bear no relation at all to the CLOS-SLOTS
-;;; slot in the FUNCALLABLE-INSTANCE structure, above, which
-;;; (bizarrely) seems to be set to the NAME of the
-;;; FUNCALLABLE-INSTANCE. At least, the index 1 seems to return the
-;;; NAME, and the index 2 NIL. Weird. -- CSR, 2002-11-07
(defmacro fsc-instance-slots (fin)
- `(%funcallable-instance-info ,fin 0))
+ `(%funcallable-instance-info ,fin 1))
(defmacro fsc-instance-hash (fin)
`(%funcallable-instance-info ,fin 3))
\f
(if (if (eq *boot-state* 'complete)
(typep fun 'generic-function)
(eq (class-of fun) *the-class-standard-generic-function*))
- (setf (%funcallable-instance-info fun 1) new-name)
+ (setf (%funcallable-instance-info fun 2) new-name)
(bug "unanticipated function type")))
;; Fixup name-to-function mappings in cases where the function
;; hasn't been defined by DEFUN. (FIXME: is this right? This logic
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.4.26"
+"0.9.4.27"
projects / sbcl.git / commitdiff