X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffdefinition.lisp;h=7f89e1c89f0243bec1ff5506b6e84e27239bd435;hb=4eb1a6d3ad2b7dcc19ac0ec979a1eb1eb049659a;hp=5be99307059ac0e6dee9b1a8074c8bd239fdd399;hpb=467a8e5dba8bfa2598ca8e22c1204dc173ce556f;p=sbcl.git diff --git a/src/code/fdefinition.lisp b/src/code/fdefinition.lisp index 5be9930..7f89e1c 100644 --- a/src/code/fdefinition.lisp +++ b/src/code/fdefinition.lisp @@ -25,16 +25,16 @@ (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)) @@ -55,7 +55,7 @@ "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) @@ -105,8 +105,8 @@ ;;; 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. @@ -137,10 +137,10 @@ ;;; 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) @@ -156,7 +156,7 @@ (%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 @@ -180,37 +180,45 @@ ;; 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) + (= (widetag-of fun) sb!vm:closure-header-widetag) (find-if-in-closure #'encapsulation-info-p fun))) ;;; When removing an encapsulation, we must remember that @@ -228,14 +236,14 @@ #!+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. @@ -253,11 +261,10 @@ (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) @@ -278,12 +285,13 @@ ;;; (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, @@ -317,7 +325,7 @@ (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 @@ -329,7 +337,7 @@ (setf (encapsulation-info-definition encap-info) new-value)))))) (t - (setf (fdefn-function fdefn) new-value)))))) + (setf (fdefn-fun fdefn) new-value)))))) ;;;; FBOUNDP and FMAKUNBOUND @@ -337,11 +345,11 @@ #!+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 - "Make Name have no global function definition." + "Make NAME have no global function definition." (let ((fdefn (fdefinition-object name nil))) (when fdefn (fdefn-makunbound fdefn)))