1 ;;;; This file contains functions that hack on the global function
2 ;;;; namespace (primarily concerned with SETF functions here). Also,
3 ;;;; function encapsulation and routines that set and return
4 ;;;; definitions disregarding whether they might be encapsulated.
6 ;;;; This software is part of the SBCL system. See the README file for
9 ;;;; This software is derived from the CMU CL system, which was
10 ;;;; written at Carnegie Mellon University and released into the
11 ;;;; public domain. The software is in the public domain and is
12 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
13 ;;;; files for more information.
15 (in-package "SB!IMPL")
20 (sb!int::/show0 "fdefinition.lisp 22")
22 ;;;; fdefinition (fdefn) objects
24 (defun make-fdefn (name)
27 (defun fdefn-name (fdefn)
28 (declare (type fdefn fdefn))
31 (defun fdefn-function (fdefn)
32 (declare (type fdefn fdefn)
33 (values (or function null)))
34 (fdefn-function fdefn))
36 (defun (setf fdefn-function) (fun fdefn)
37 (declare (type function fun)
40 (setf (fdefn-function fdefn) fun))
42 (defun fdefn-makunbound (fdefn)
43 (declare (type fdefn fdefn))
44 (fdefn-makunbound fdefn))
46 ;;; This function is called by !COLD-INIT after the globaldb has been
47 ;;; initialized, but before anything else. We need to install these
48 ;;; fdefn objects into the globaldb before any top level forms run, or
49 ;;; we will end up with two different fdefn objects being used for the
50 ;;; same function name. *!INITIAL-FDEFN-OBJECTS* is set up by GENESIS.
51 (defvar *!initial-fdefn-objects*)
52 (defun !fdefn-cold-init ()
53 (dolist (fdefn *!initial-fdefn-objects*)
54 (setf (info :function :definition (fdefn-name fdefn)) fdefn)))
56 (defun fdefinition-object (name create)
58 "Return the fdefn object for NAME. If it doesn't already exist and CREATE
59 is non-NIL, create a new (unbound) one."
60 (declare (values (or fdefn null)))
61 (unless (or (symbolp name)
64 (let ((cdr (cdr name)))
68 (error 'simple-type-error
70 :expected-type '(or symbol list)
71 :format-control "invalid function name: ~S"
72 :format-arguments (list name)))
73 (let ((fdefn (info :function :definition name)))
74 (if (and (null fdefn) create)
75 (setf (info :function :definition name) (make-fdefn name))
78 ;;; FIXME: If the fundamental operation performed when
79 ;;; funcalling a symbol is %COERCE-NAME-TO-FUNCTION, which expands into
80 ;;; FDEFINITION-OBJECT, which does (INFO :FUNCTION :DEFINITION NAME),
81 ;;; that's a horrendously heavyweight way to implement SYMBOL-FUNCTION.
82 ;;; What compelling reason is there for all this hairiness? The only
83 ;;; thing I can think of is that it does give a place to store
84 ;;; SETF functions, but I don't think that's a good enough reason.
85 ;;; It might even be that the FDEFINITION arrangement saves a little
86 ;;; space, if the proportion of function-less symbols is high enough,
87 ;;; but I don't think that's a good enough reason, either.
88 ;;; I'd really like to wipe out FDEFN stuff root and branch, and
89 ;;; just store SETF functions in the symbol property list.
91 ;;; One problem with just doing the simple thing: What happens when
92 ;;; people call symbols which have no function definitions?
93 ;;; 1. Just hit "undefined function" error -- with no clue as to
94 ;;; what undefined function it was. (This might actually not be
95 ;;; too horrible, since the compiler warns you about undefined
96 ;;; functions and the debugger aims, with incomplete success,
97 ;;; to show you what form caused an error.)
98 ;;; 2. various solutions involving closures in the function slot,
99 ;;; all of which have the drawback of extra memory use and extra
100 ;;; difficulty in detecting when functions are undefined
101 ;;; 2a. Have every single symbol have an undefined function closure
102 ;;; which points back to it to tell you which undefined symbol it
103 ;;; was. (4 extra words per undefined symbol)
104 ;;; 2b. Play tricks with FDEFINITION, where the default SYMBOL-FUNCTION
105 ;;; for any function is an anonymous "undefined function" error
106 ;;; which doesn't tell you what the problem was, but if FDEFINITION
107 ;;; is ever called on an undefined symbol, it helpfully changes the
108 ;;; function definition to point to a closure which knows which
109 ;;; symbol caused the problem.
110 ;;; 4. Just don't sweat it except when DEBUG>SPEED, where the calling
111 ;;; convention gets tweaked to test for the undefined-function
112 ;;; function at call time and bail out with helpful information
114 ;;; 5. Require that the function calling convention be stereotyped
115 ;;; along the lines of
116 ;;; mov %ebx, local_immediate_3 ; Point to symbol.
117 ;;; mov %eax, symbol_function_offset(%eax) ; Point to function.
118 ;;; call *function_code_pointer(%eax) ; Go.
119 ;;; That way, it's guaranteed that on entry to a function, %EBX points
120 ;;; back to the symbol which was used to indirect into the function,
121 ;;; so the undefined function handler can base its complaint on that.
123 ;;; Another problem with doing the simple thing: people will want to
124 ;;; indirect through something in order to get to SETF functions, in
125 ;;; order to be able to redefine them. What will they indirect
126 ;;; through? This could be done with a hack, making an anonymous
127 ;;; symbol and linking it to the main symbol's SB!KERNEL:SETF-FUNCTION
128 ;;; property. The anonymous symbol could even point back to the symbol
129 ;;; it's the SETF function for, so that if the SETF function was
130 ;;; undefined at the time a call was made, the debugger could say
131 ;;; which function caused the problem. It'd probably be cleaner,
132 ;;; though, to use a new type of primitive object (SYMBOLOID?)
133 ;;; instead. It could probably be like symbol except that its name
134 ;;; could be any object and its value points back to the symbol which
135 ;;; owns it. Then the setf functions for FOO could be on the list (GET
136 ;;; FOO 'SB!KERNEL:SYMBOLOIDS)
138 ;;; FIXME: Oh, my. Now that I've started thinking about it, I
139 ;;; appreciate more fully how weird and twisted FDEFNs might be. Look
140 ;;; at the calling sequence for full calls. It goes and reads the
141 ;;; address of a function object from its own table of immediate
142 ;;; values, then jumps into that. Consider how weird that is. Not only
143 ;;; is it not doing indirection through a symbol (which I'd already
144 ;;; realized) but it's not doing indirection through
146 ;;; The compiler emits calls to this when someone tries to funcall a symbol.
147 (defun %coerce-name-to-function (name)
149 "Returns the definition for name, including any encapsulations. Settable
151 (let ((fdefn (fdefinition-object name nil)))
152 (or (and fdefn (fdefn-function fdefn))
153 (error 'undefined-function :name name))))
155 (defun %coerce-callable-to-function (callable)
156 (if (functionp callable)
158 (%coerce-name-to-function callable)))
160 ;;; This is just another name for %COERCE-NAME-TO-FUNCTION.
161 #!-sb-fluid (declaim (inline raw-definition))
162 (defun raw-definition (name)
163 ;; We know that we are calling %COERCE-NAME-TO-FUNCTION, so don't remind us.
164 (declare (optimize (inhibit-warnings 3)))
165 (%coerce-name-to-function name))
166 (defun (setf raw-definition) (function name)
167 (let ((fdefn (fdefinition-object name t)))
168 (setf (fdefn-function fdefn) function)))
170 ;;; FIXME: There seems to be no good reason to have both
171 ;;; %COERCE-NAME-TO-FUNCTION and RAW-DEFINITION names for the same
172 ;;; thing. And despite what the doc string of %COERCE-NAME-TO-FUNCTION
173 ;;; says, it's doesn't look settable. Perhaps we could collapse
174 ;;; %COERCE-TO-FUNCTION, RAW-DEFINITION, and (SETF RAW-DEFINITION)
175 ;;; into RAW-FDEFINITION and (SETF RAW-FDEFINITION), or
176 ;;; OUTER-FDEFINITION and (SETF OUTER-FDEFINITION).
178 ;;;; definition encapsulation
180 (defstruct (encapsulation-info (:constructor make-encapsulation-info
182 ;; This is definition's encapsulation type. The encapsulated
183 ;; definition is in the previous encapsulation-info element or
184 ;; installed as the global definition of some function name.
186 ;; the previous, encapsulated definition. This used to be installed
187 ;; as a global definition for some function name, but it was
188 ;; replaced by an encapsulation of type TYPE.
189 (definition nil :type function))
191 ;;; We must bind and close over info. Consider the case where we
192 ;;; encapsulate (the second) an encapsulated (the first) definition,
193 ;;; and later someone unencapsulates the encapsulated (first)
194 ;;; definition. We don't want our encapsulation (second) to bind
195 ;;; basic-definition to the encapsulated (first) definition when it no
196 ;;; longer exists. When unencapsulating, we make sure to clobber the
197 ;;; appropriate info structure to allow basic-definition to be bound
198 ;;; to the next definition instead of an encapsulation that no longer
200 (defun encapsulate (name type body)
202 "Replaces the definition of NAME with a function that binds name's arguments
203 a variable named argument-list, binds name's definition to a variable named
204 basic-definition, and evaluates BODY in that context. TYPE is
205 whatever you would like to associate with this encapsulation for
206 identification in case you need multiple encapsuations of the same name."
207 (let ((fdefn (fdefinition-object name nil)))
208 (unless (and fdefn (fdefn-function fdefn))
209 (error 'undefined-function :name name))
210 (let ((info (make-encapsulation-info type (fdefn-function fdefn))))
211 (setf (fdefn-function fdefn)
212 #'(lambda (&rest argument-list)
213 (declare (special argument-list))
214 (let ((basic-definition (encapsulation-info-definition info)))
215 (declare (special basic-definition))
218 ;;; Finds the encapsulation info that has been closed over.
219 (defun encapsulation-info (fun)
221 (= (get-type fun) sb!vm:closure-header-type)
222 (find-if-in-closure #'encapsulation-info-p fun)))
224 ;;; When removing an encapsulation, we must remember that
225 ;;; encapsulating definitions close over a reference to the
226 ;;; encapsulation-info that describes the encapsulating definition.
227 ;;; When you find an info with the target type, the previous info in
228 ;;; the chain has the ensulating definition of that type. We take the
229 ;;; encapsulated definition from the info with the target type, and we
230 ;;; store it in the previous info structure whose encapsulating
231 ;;; definition it describes looks to this previous info structure for
232 ;;; a definition to bind (see ENCAPSULATE). When removing the first
233 ;;; info structure, we do something conceptually equal, but
234 ;;; mechanically it is different.
235 (defun unencapsulate (name type)
237 "Removes NAME's most recent encapsulation of the specified TYPE."
238 (let* ((fdefn (fdefinition-object name nil))
239 (encap-info (encapsulation-info (fdefn-function fdefn))))
240 (declare (type (or encapsulation-info null) encap-info))
241 (cond ((not encap-info)
242 ;; It disappeared on us, so don't worry about it.
244 ((eq (encapsulation-info-type encap-info) type)
245 ;; It's the first one, so change the fdefn object.
246 (setf (fdefn-function fdefn)
247 (encapsulation-info-definition encap-info)))
249 ;; It must be an interior one, so find it.
251 (let ((next-info (encapsulation-info
252 (encapsulation-info-definition encap-info))))
254 ;; Not there, so don't worry about it.
256 (when (eq (encapsulation-info-type next-info) type)
257 ;; This is it, so unlink us.
258 (setf (encapsulation-info-definition encap-info)
259 (encapsulation-info-definition next-info))
261 (setf encap-info next-info))))))
264 (defun encapsulated-p (name type)
266 "Returns t if name has an encapsulation of the given type, otherwise nil."
267 (let ((fdefn (fdefinition-object name nil)))
268 (do ((encap-info (encapsulation-info (fdefn-function fdefn))
270 (encapsulation-info-definition encap-info))))
271 ((null encap-info) nil)
272 (declare (type (or encapsulation-info null) encap-info))
273 (when (eq (encapsulation-info-type encap-info) type)
278 ;;; KLUDGE: Er, it looks as though this means that
279 ;;; (FUNCALL (FDEFINITION 'FOO))
280 ;;; doesn't do the same thing as
282 ;;; That doesn't look like ANSI behavior to me. Look e.g. at the
283 ;;; ANSI definition of TRACE: "Whenever a traced function is invoked,
284 ;;; information about the call, ..". Try this:
285 ;;; (DEFUN FOO () (PRINT "foo"))
288 ;;; (FUNCALL (FDEFINITION 'FOO))
289 ;;; What to do? ANSI says TRACE "Might change the definitions of the functions
290 ;;; named by function-names." Might it be OK to just get punt all this
291 ;;; encapsulation stuff and go back to a simple but correct implementation of
292 ;;; TRACE? We'd lose the ability to redefine a TRACEd function and keep the
293 ;;; trace in place, but that seems tolerable to me. (Is the wrapper stuff
294 ;;; needed for anything else besides TRACE?)
296 ;;; The only problem I can see with not having a wrapper: If tracing
297 ;;; EQ, EQL, EQUAL, or EQUALP causes its function address to change,
298 ;;; it will mess up the MAKE-HASH-TABLE logic which uses EQ tests
299 ;;; on those function values. -- WHN 19990906
300 (defun fdefinition (name)
302 "Return name's global function definition taking care to respect any
303 encapsulations and to return the innermost encapsulated definition.
305 (let ((fun (raw-definition name)))
307 (let ((encap-info (encapsulation-info fun)))
309 (setf fun (encapsulation-info-definition encap-info))
312 (defvar *setf-fdefinition-hook* nil
314 "This holds functions that (SETF FDEFINITION) invokes before storing the
315 new value. These functions take the function name and the new value.")
317 (defun %set-fdefinition (name new-value)
319 "Set NAME's global function definition."
320 (declare (type function new-value) (optimize (safety 1)))
321 (let ((fdefn (fdefinition-object name t)))
322 ;; *SETF-FDEFINITION-HOOK* won't be bound when initially running top-level
323 ;; forms in the kernel core startup.
324 (when (boundp '*setf-fdefinition-hook*)
325 (dolist (f *setf-fdefinition-hook*)
326 (funcall f name new-value)))
328 (let ((encap-info (encapsulation-info (fdefn-function fdefn))))
333 (encapsulation-info-definition encap-info))))
335 (setf encap-info more-info)
337 (setf (encapsulation-info-definition encap-info)
340 (setf (fdefn-function fdefn) new-value))))))
342 ;;;; FBOUNDP and FMAKUNBOUND
344 (defun fboundp (name)
346 "Return true if name has a global function definition."
347 (let ((fdefn (fdefinition-object name nil)))
348 (and fdefn (fdefn-function fdefn) t)))
350 (defun fmakunbound (name)
352 "Make Name have no global function definition."
353 (let ((fdefn (fdefinition-object name nil)))
355 (fdefn-makunbound fdefn)))