(declare (type fdefn fdefn))
(fdefn-name fdefn))
-(defun fdefn-function (fdefn)
+(defun fdefn-fun (fdefn)
(declare (type fdefn fdefn)
(values (or function null)))
- (fdefn-function fdefn))
+ (fdefn-fun fdefn))
-(defun (setf fdefn-function) (fun fdefn)
+(defun (setf fdefn-fun) (fun fdefn)
(declare (type function fun)
(type fdefn fdefn)
(values function))
- (setf (fdefn-function fdefn) fun))
+ (setf (fdefn-fun fdefn) fun))
(defun fdefn-makunbound (fdefn)
(declare (type fdefn fdefn))
"Return the fdefn object for NAME. If it doesn't already exist and CREATE
is non-NIL, create a new (unbound) one."
(declare (values (or fdefn null)))
- (unless (legal-function-name-p name)
+ (unless (legal-fun-name-p name)
(error 'simple-type-error
:datum name
:expected-type '(or symbol list)
;;; 5. Require that the function calling convention be stereotyped
;;; along the lines of
;;; mov %ebx, local_immediate_3 ; Point to symbol.
-;;; mov %eax, symbol_function_offset(%eax) ; Point to function.
-;;; call *function_code_pointer(%eax) ; Go.
+;;; mov %eax, symbol_fun_offset(%eax) ; Point to function.
+;;; call *function_code_pointer(%eax) ; Go.
;;; That way, it's guaranteed that on entry to a function, %EBX points
;;; back to the symbol which was used to indirect into the function,
;;; so the undefined function handler can base its complaint on that.
;;; The compiler emits calls to this when someone tries to funcall a symbol.
(defun %coerce-name-to-function (name)
#!+sb-doc
- "Returns the definition for name, including any encapsulations. Settable
+ "Return the definition for name, including any encapsulations. Settable
with SETF."
(let ((fdefn (fdefinition-object name nil)))
- (or (and fdefn (fdefn-function fdefn))
+ (or (and fdefn (fdefn-fun fdefn))
(error 'undefined-function :name name))))
(defun %coerce-callable-to-function (callable)
(%coerce-name-to-function name))
(defun (setf raw-definition) (function name)
(let ((fdefn (fdefinition-object name t)))
- (setf (fdefn-function fdefn) function)))
+ (setf (fdefn-fun fdefn) function)))
;;; FIXME: There seems to be no good reason to have both
;;; %COERCE-NAME-TO-FUNCTION and RAW-DEFINITION names for the same
;; replaced by an encapsulation of type TYPE.
(definition nil :type function))
-;;; We must bind and close over info. Consider the case where we
-;;; encapsulate (the second) an encapsulated (the first) definition,
-;;; and later someone unencapsulates the encapsulated (first)
-;;; definition. We don't want our encapsulation (second) to bind
-;;; basic-definition to the encapsulated (first) definition when it no
-;;; longer exists. When unencapsulating, we make sure to clobber the
-;;; appropriate info structure to allow basic-definition to be bound
-;;; to the next definition instead of an encapsulation that no longer
-;;; exists.
+;;; Replace the definition of NAME with a function that binds NAME's
+;;; arguments a variable named argument-list, binds name's definition
+;;; to a variable named basic-definition, and evaluates BODY in that
+;;; context. TYPE is whatever you would like to associate with this
+;;; encapsulation for identification in case you need multiple
+;;; encapsulations of the same name.
(defun encapsulate (name type body)
- #!+sb-doc
- "Replaces the definition of NAME with a function that binds name's arguments
- a variable named argument-list, binds name's definition to a variable named
- basic-definition, and evaluates BODY in that context. TYPE is
- whatever you would like to associate with this encapsulation for
- identification in case you need multiple encapsuations of the same name."
(let ((fdefn (fdefinition-object name nil)))
- (unless (and fdefn (fdefn-function fdefn))
+ (unless (and fdefn (fdefn-fun fdefn))
(error 'undefined-function :name name))
- (let ((info (make-encapsulation-info type (fdefn-function fdefn))))
- (setf (fdefn-function fdefn)
- #'(lambda (&rest argument-list)
- (declare (special argument-list))
- (let ((basic-definition (encapsulation-info-definition info)))
- (declare (special basic-definition))
- (eval body)))))))
+ ;; We must bind and close over INFO. Consider the case where we
+ ;; encapsulate (the second) an encapsulated (the first)
+ ;; definition, and later someone unencapsulates the encapsulated
+ ;; (first) definition. We don't want our encapsulation (second) to
+ ;; bind basic-definition to the encapsulated (first) definition
+ ;; when it no longer exists. When unencapsulating, we make sure to
+ ;; clobber the appropriate INFO structure to allow
+ ;; basic-definition to be bound to the next definition instead of
+ ;; an encapsulation that no longer exists.
+ (let ((info (make-encapsulation-info type (fdefn-fun fdefn))))
+ (setf (fdefn-fun fdefn)
+ (lambda (&rest argument-list)
+ (declare (special argument-list))
+ (let ((basic-definition (encapsulation-info-definition info)))
+ (declare (special basic-definition))
+ (eval body)))))))
+
+;;; This is like FIND-IF, except that we do it on a compiled closure's
+;;; environment.
+(defun find-if-in-closure (test fun)
+ (dotimes (index (1- (get-closure-length fun)))
+ (let ((elt (%closure-index-ref fun index)))
+ (when (funcall test elt)
+ (return elt)))))
-;;; Finds the encapsulation info that has been closed over.
+;;; Find the encapsulation info that has been closed over.
(defun encapsulation-info (fun)
(and (functionp fun)
- (= (get-type fun) sb!vm:closure-header-type)
+ (= (get-type fun) sb!vm:closure-header-widetag)
(find-if-in-closure #'encapsulation-info-p fun)))
;;; When removing an encapsulation, we must remember that
#!+sb-doc
"Removes NAME's most recent encapsulation of the specified TYPE."
(let* ((fdefn (fdefinition-object name nil))
- (encap-info (encapsulation-info (fdefn-function fdefn))))
+ (encap-info (encapsulation-info (fdefn-fun fdefn))))
(declare (type (or encapsulation-info null) encap-info))
(cond ((not encap-info)
;; It disappeared on us, so don't worry about it.
)
((eq (encapsulation-info-type encap-info) type)
;; It's the first one, so change the fdefn object.
- (setf (fdefn-function fdefn)
+ (setf (fdefn-fun fdefn)
(encapsulation-info-definition encap-info)))
(t
;; It must be an interior one, so find it.
(setf encap-info next-info))))))
t)
+;;; Does NAME have an encapsulation of the given TYPE?
(defun encapsulated-p (name type)
- #!+sb-doc
- "Returns t if name has an encapsulation of the given type, otherwise nil."
(let ((fdefn (fdefinition-object name nil)))
- (do ((encap-info (encapsulation-info (fdefn-function fdefn))
+ (do ((encap-info (encapsulation-info (fdefn-fun fdefn))
(encapsulation-info
(encapsulation-info-definition encap-info))))
((null encap-info) nil)
;;; (TRACE FOO)
;;; (FUNCALL 'FOO)
;;; (FUNCALL (FDEFINITION 'FOO))
-;;; What to do? ANSI says TRACE "Might change the definitions of the functions
-;;; named by function-names." Might it be OK to just get punt all this
-;;; encapsulation stuff and go back to a simple but correct implementation of
-;;; TRACE? We'd lose the ability to redefine a TRACEd function and keep the
-;;; trace in place, but that seems tolerable to me. (Is the wrapper stuff
-;;; needed for anything else besides TRACE?)
+;;; What to do? ANSI says TRACE "Might change the definitions of the
+;;; functions named by function-names." Might it be OK to just get
+;;; punt all this encapsulation stuff and go back to a simple but
+;;; correct implementation of TRACE? We'd lose the ability to redefine
+;;; a TRACEd function and keep the trace in place, but that seems
+;;; tolerable to me. (Is the wrapper stuff needed for anything else
+;;; besides TRACE?)
;;;
;;; The only problem I can see with not having a wrapper: If tracing
;;; EQ, EQL, EQUAL, or EQUALP causes its function address to change,
(dolist (f *setf-fdefinition-hook*)
(funcall f name new-value)))
- (let ((encap-info (encapsulation-info (fdefn-function fdefn))))
+ (let ((encap-info (encapsulation-info (fdefn-fun fdefn))))
(cond (encap-info
(loop
(let ((more-info
(setf (encapsulation-info-definition encap-info)
new-value))))))
(t
- (setf (fdefn-function fdefn) new-value))))))
+ (setf (fdefn-fun fdefn) new-value))))))
\f
;;;; FBOUNDP and FMAKUNBOUND
#!+sb-doc
"Return true if name has a global function definition."
(let ((fdefn (fdefinition-object name nil)))
- (and fdefn (fdefn-function fdefn) t)))
+ (and fdefn (fdefn-fun fdefn) t)))
(defun fmakunbound (name)
#!+sb-doc
projects / sbcl.git / blobdiff