1 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; This software is derived from software originally released by Xerox
5 ;;;; Corporation. Copyright and release statements follow. Later modifications
6 ;;;; to the software are in the public domain and are provided with
7 ;;;; absolutely no warranty. See the COPYING and CREDITS files for more
10 ;;;; copyright information from original PCL sources:
12 ;;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation.
13 ;;;; All rights reserved.
15 ;;;; Use and copying of this software and preparation of derivative works based
16 ;;;; upon this software are permitted. Any distribution of this software or
17 ;;;; derivative works must comply with all applicable United States export
20 ;;;; This software is made available AS IS, and Xerox Corporation makes no
21 ;;;; warranty about the software, its performance or its conformity to any
29 ;;; Each implementation must provide the following functions and macros:
31 ;;; ALLOCATE-FUNCALLABLE-INSTANCE-1 ()
32 ;;; should create and return a new funcallable instance. The
33 ;;; funcallable-instance-data slots must be initialized to NIL.
34 ;;; This is called by allocate-funcallable-instance and by the
35 ;;; bootstrapping code.
37 ;;; FUNCALLABLE-INSTANCE-P (x)
38 ;;; the obvious predicate. This should be an INLINE function. It
39 ;;; must be funcallable, but it would be nice if it compiled open.
41 ;;; SET-FUNCALLABLE-INSTANCE-FUNCTION (fin new-value)
42 ;;; change the fin so that when it is funcalled, the new-value
43 ;;; function is called. Note that it is legal for new-value
44 ;;; to be copied before it is installed in the fin, specifically
45 ;;; there is no accessor for a FIN's function so this function
46 ;;; does not have to preserve the actual new value. The new-value
47 ;;; argument can be any funcallable thing, a closure, lambda
48 ;;; compiled code etc. This function must coerce those values
50 ;;; NOTE: new-value is almost always a compiled closure. This
51 ;;; is the important case to optimize.
53 ;;; FUNCALLABLE-INSTANCE-DATA-1 (fin data-name)
54 ;;; should return the value of the data named data-name in the fin.
55 ;;; data-name is one of the symbols in the list which is the value
56 ;;; of funcallable-instance-data. Since data-name is almost always
57 ;;; a quoted symbol and funcallable-instance-data is a constant, it
58 ;;; is possible (and worthwhile) to optimize the computation of
59 ;;; data-name's offset in the data part of the fin.
60 ;;; This must be SETF'able.
62 ;;;; implementation of funcallable instances for CMU Common Lisp
64 (defstruct (pcl-funcallable-instance
65 (:alternate-metaclass sb-kernel:funcallable-instance
66 sb-kernel:random-pcl-class
67 sb-kernel:make-random-pcl-class)
68 (:type sb-kernel:funcallable-structure)
69 (:constructor allocate-funcallable-instance-1 ())
72 ;; Note: The PCL wrapper is in the layout slot.
75 (pcl-funcallable-instance-slots nil)
76 ;; The debug-name for this function.
77 (funcallable-instance-name nil))
79 (import 'sb-kernel:funcallable-instance-p)
81 ;;; Set the function that is called when FIN is called.
82 (defun set-funcallable-instance-function (fin new-value)
83 (declare (type function new-value))
84 (assert (funcallable-instance-p fin))
85 (setf (sb-kernel:funcallable-instance-function fin) new-value))
87 ;;; This "works" on non-PCL FINs, which allows us to weaken
88 ;;; FUNCALLABLE-INSTANCE-P to return true for all FINs. This is also
89 ;;; necessary for bootstrapping to work, since the layouts for early GFs are
90 ;;; not initially initialized.
91 (defmacro funcallable-instance-data-1 (fin slot)
93 (wrapper `(sb-kernel:%funcallable-instance-layout ,fin))
94 (slots `(sb-kernel:%funcallable-instance-info ,fin 0))))
96 ;;;; slightly higher-level stuff built on the implementation-dependent stuff
98 (defmacro fsc-instance-p (fin)
99 `(funcallable-instance-p ,fin))
101 (defmacro fsc-instance-class (fin)
102 `(wrapper-class (funcallable-instance-data-1 ,fin 'wrapper)))
104 (defmacro fsc-instance-wrapper (fin)
105 `(funcallable-instance-data-1 ,fin 'wrapper))
107 (defmacro fsc-instance-slots (fin)
108 `(funcallable-instance-data-1 ,fin 'slots))