(defun %raw-instance-set/complex-double (instance index new-value)
(declare (type index index)
(type (complex double-float) new-value))
- (%raw-instance-set/complex-double instance index new-value)))
+ (%raw-instance-set/complex-double instance index new-value))
+) ; #!-HPPA
+#!+hppa
+(progn
(defun %raw-ref-single (vec index)
(declare (type index index))
(%raw-ref-single vec index))
(defun %raw-set-complex-long (vec index val)
(declare (type index index))
(%raw-set-complex-long vec index val))
+) ; #!+HPPA
(defun %instance-layout (instance)
(%instance-layout instance))
(%set-funcallable-instance-info fin i new-value))
(defun funcallable-instance-fun (fin)
- (%funcallable-instance-lexenv fin))
-
-;;; 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
-;;; extra indirection with funcallable-instance-lexenv to get at any
-;;; 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
-;;; close over the FIN object.
-;;;
-;;; 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
-;;; effectively pre-flattens what would otherwise be a chain of
-;;; 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-function fin))
+
(defun (setf funcallable-instance-fun) (new-value fin)
- (setf (%funcallable-instance-fun fin)
- (%closure-fun new-value))
- (setf (%funcallable-instance-lexenv fin)
- (if (funcallable-instance-p new-value)
- (%funcallable-instance-lexenv new-value)
- new-value)))
+ (setf (%funcallable-instance-function fin) new-value))
;;; service function for structure constructors
(defun %make-instance-with-layout (layout)