(defun %instance-set (instance index new-value)
(setf (%instance-ref instance index) new-value))
+(defun %instance-compare-and-swap (instance index old new)
+ #!+(or x86 x86-64)
+ (%instance-compare-and-swap instance index old new)
+ #!-(or x86 x86-64)
+ (let ((n-old (%instance-ref instance index)))
+ (when (eq old n-old)
+ (%instance-set instance index new))
+ n-old))
+
#!-hppa
(progn
(defun %raw-instance-ref/word (instance index)
(%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)
:datum x
:expected-type (classoid-name (layout-classoid layout))))
(values))
+
\f
(/show0 "target-defstruct.lisp end of file")