/[cmucl]/src/pcl/fin.lisp
ViewVC logotype

Contents of /src/pcl/fin.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.15 - (show annotations)
Tue Aug 27 19:01:39 2002 UTC (11 years, 7 months ago) by pmai
Branch: MAIN
CVS Tags: LINKAGE_TABLE, PRE_LINKAGE_TABLE, UNICODE-BASE
Branch point for: UNICODE-BRANCH
Changes since 1.14: +2 -2 lines
Patch by Gerd Moellmann to turn old-style into new-style eval-when's in
the PCL code base.
1 ;;;-*-Mode:LISP; Package:(PCL Lisp 1000); Base:10; Syntax:Common-lisp -*-
2 ;;;
3 ;;; *************************************************************************
4 ;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation.
5 ;;; All rights reserved.
6 ;;;
7 ;;; Use and copying of this software and preparation of derivative works
8 ;;; based upon this software are permitted. Any distribution of this
9 ;;; software or derivative works must comply with all applicable United
10 ;;; States export control laws.
11 ;;;
12 ;;; This software is made available AS IS, and Xerox Corporation makes no
13 ;;; warranty about the software, its performance or its conformity to any
14 ;;; specification.
15 ;;;
16 ;;; Any person obtaining a copy of this software is requested to send their
17 ;;; name and post office or electronic mail address to:
18 ;;; CommonLoops Coordinator
19 ;;; Xerox PARC
20 ;;; 3333 Coyote Hill Rd.
21 ;;; Palo Alto, CA 94304
22 ;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa)
23 ;;;
24 ;;; Suggestions, comments and requests for improvements are also welcome.
25 ;;; *************************************************************************
26 ;;;
27
28 (ext:file-comment
29 "$Header: /tiger/var/lib/cvsroots/cmucl/src/pcl/fin.lisp,v 1.15 2002/08/27 19:01:39 pmai Exp $")
30 ;;;
31
32 ;;
33 ;;;;;; FUNCALLABLE INSTANCES
34 ;;
35
36 #|
37
38 Generic functions are instances with meta class funcallable-standard-class.
39 Instances with this meta class are called funcallable-instances (FINs for
40 short). They behave something like lexical closures in that they have data
41 associated with them (which is used to store the slots) and are funcallable.
42 When a funcallable instance is funcalled, the function that is invoked is
43 called the funcallable-instance-function. The funcallable-instance-function
44 of a funcallable instance can be changed.
45
46 This file implements low level code for manipulating funcallable instances.
47
48 It is possible to implement funcallable instances in pure Common Lisp. A
49 simple implementation which uses lexical closures as the instances and a
50 hash table to record that the lexical closures are funcallable instances
51 is easy to write. Unfortunately, this implementation adds significant
52 overhead:
53
54 to generic-function-invocation (1 function call)
55 to slot-access (1 function call or one hash table lookup)
56 to class-of a generic-function (1 hash-table lookup)
57
58 In addition, it would prevent the funcallable instances from being garbage
59 collected. In short, the pure Common Lisp implementation really isn't
60 practical.
61
62 Instead, PCL uses a specially tailored implementation for each Common Lisp and
63 makes no attempt to provide a purely portable implementation. The specially
64 tailored implementations are based on the lexical closure's provided by that
65 implementation and are fairly short and easy to write.
66
67 Some of the implementation dependent code in this file was originally written
68 by someone in the employ of the vendor of that Common Lisp. That code is
69 explicitly marked saying who wrote it.
70
71 |#
72
73 (in-package :pcl)
74
75 ;;;
76 ;;; The first part of the file contains the implementation dependent code to
77 ;;; implement funcallable instances. Each implementation must provide the
78 ;;; following functions and macros:
79 ;;;
80 ;;; ALLOCATE-FUNCALLABLE-INSTANCE-1 ()
81 ;;; should create and return a new funcallable instance. The
82 ;;; funcallable-instance-data slots must be initialized to NIL.
83 ;;; This is called by allocate-funcallable-instance and by the
84 ;;; bootstrapping code.
85 ;;;
86 ;;; FUNCALLABLE-INSTANCE-P (x)
87 ;;; the obvious predicate. This should be an INLINE function.
88 ;;; it must be funcallable, but it would be nice if it compiled
89 ;;; open.
90 ;;;
91 ;;; SET-FUNCALLABLE-INSTANCE-FUNCTION (fin new-value)
92 ;;; change the fin so that when it is funcalled, the new-value
93 ;;; function is called. Note that it is legal for new-value
94 ;;; to be copied before it is installed in the fin, specifically
95 ;;; there is no accessor for a FIN's function so this function
96 ;;; does not have to preserve the actual new value. The new-value
97 ;;; argument can be any funcallable thing, a closure, lambda
98 ;;; compiled code etc. This function must coerce those values
99 ;;; if necessary.
100 ;;; NOTE: new-value is almost always a compiled closure. This
101 ;;; is the important case to optimize.
102 ;;;
103 ;;; FUNCALLABLE-INSTANCE-DATA-1 (fin data-name)
104 ;;; should return the value of the data named data-name in the fin.
105 ;;; data-name is one of the symbols in the list which is the value
106 ;;; of funcallable-instance-data. Since data-name is almost always
107 ;;; a quoted symbol and funcallable-instance-data is a constant, it
108 ;;; is possible (and worthwhile) to optimize the computation of
109 ;;; data-name's offset in the data part of the fin.
110 ;;; This must be SETF'able.
111 ;;;
112
113 (eval-when (:compile-toplevel :load-toplevel :execute)
114 (defconstant funcallable-instance-data
115 '(wrapper slots)
116 "These are the 'data-slots' which funcallable instances have so that
117 the meta-class funcallable-standard-class can store class, and static
118 slots in them.")
119 )
120
121 (defmacro funcallable-instance-data-position (data)
122 (if (and (consp data)
123 (eq (car data) 'quote))
124 (or (position (cadr data) funcallable-instance-data :test #'eq)
125 (progn
126 (warn "Unknown funcallable-instance data: ~S." (cadr data))
127 `(error "Unknown funcallable-instance data: ~S." ',(cadr data))))
128 `(position ,data funcallable-instance-data :test #'eq)))
129
130 (declaim (notinline called-fin-without-function))
131 (defun called-fin-without-function (&rest args)
132 (declare (ignore args))
133 (error "Attempt to funcall a funcallable-instance without first~%~
134 setting its funcallable-instance-function."))
135
136
137 ;;;; Implementation of funcallable instances for CMU Common Lisp:
138 ;;;
139 (defstruct (pcl-funcallable-instance
140 (:alternate-metaclass kernel:funcallable-instance
141 kernel:random-pcl-class
142 kernel:make-random-pcl-class)
143 (:type kernel:funcallable-structure)
144 (:constructor allocate-funcallable-instance-1 ())
145 (:conc-name nil))
146 ;;
147 ;; PCL wrapper is in the layout slot.
148 ;;
149 ;; PCL data vector.
150 (pcl-funcallable-instance-slots nil)
151 ;;
152 ;; The debug-name for this function.
153 (funcallable-instance-name nil))
154
155 ;;; Note: returns true for non-pcl funcallable structures.
156 (import 'kernel:funcallable-instance-p)
157
158
159 ;;; SET-FUNCALLABLE-INSTANCE-FUNCTION -- Interface
160 ;;;
161 ;;; Set the function that is called when FIN is called.
162 ;;;
163 (defun set-funcallable-instance-function (fin new-value)
164 (declare (type function new-value))
165 (assert (funcallable-instance-p fin))
166 (setf (kernel:funcallable-instance-function fin) new-value))
167
168
169 ;;; FUNCALLABLE-INSTANCE-DATA-1 -- Interface
170 ;;;
171 ;;; This "works" on non-PCL FINs, which allows us to weaken
172 ;;; FUNCALLABLE-INSTANCE-P to return trure for all FINs. This is also
173 ;;; necessary for bootstrapping to work, since the layouts for early GFs are
174 ;;; not initially initialized.
175 ;;;
176 (defmacro funcallable-instance-data-1 (fin slot)
177 (ecase (eval slot)
178 (wrapper `(kernel:%funcallable-instance-layout ,fin))
179 (slots `(kernel:%funcallable-instance-info ,fin 0))))
180
181 (defmacro pcl-funcallable-instance-wrapper (x)
182 `(kernel:%funcallable-instance-layout ,x))
183
184
185 ;;;; Slightly Higher-Level stuff built on the implementation-dependent stuff.
186 ;;;
187 ;;;
188
189 (defmacro fsc-instance-p (fin)
190 `(funcallable-instance-p ,fin))
191
192 (defmacro fsc-instance-class (fin)
193 `(wrapper-class (funcallable-instance-data-1 ,fin 'wrapper)))
194
195 (defmacro fsc-instance-wrapper (fin)
196 `(funcallable-instance-data-1 ,fin 'wrapper))
197
198 (defmacro fsc-instance-slots (fin)
199 `(funcallable-instance-data-1 ,fin 'slots))

  ViewVC Help
Powered by ViewVC 1.1.5