X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fpcl%2Flow.lisp;h=dd2295d91c7abafbdfad80703ba1fbc45fe2a1d7;hb=316eddc9b2b1aa24012ed826ce700105fdbcdfdb;hp=d59c7bbbe6ae7eaca9fdc21b8607d3ec35e4f3ab;hpb=c713eb2b521b048ff2c927ec52b861787d289f85;p=sbcl.git diff --git a/src/pcl/low.lisp b/src/pcl/low.lisp index d59c7bb..dd2295d 100644 --- a/src/pcl/low.lisp +++ b/src/pcl/low.lisp @@ -97,31 +97,16 @@ (import 'sb-kernel:funcallable-instance-p) -;;; This "works" on non-PCL FINs, which allows us to weaken -;;; FUNCALLABLE-INSTANCE-P to return true for all FINs. This is also -;;; necessary for bootstrapping to work, since the layouts for early -;;; GFs are not initially initialized. -(defmacro funcallable-instance-data-1 (fin slot) - (ecase (eval slot) - (wrapper `(sb-kernel:%funcallable-instance-layout ,fin)) - (slots `(sb-kernel:%funcallable-instance-info ,fin 0)))) - -;;; FIXME: Now that we no longer try to make our CLOS implementation -;;; portable to other implementations of Common Lisp, all the -;;; funcallable instance wrapper logic here can go away in favor -;;; of direct calls to native SBCL funcallable instance operations. (defun set-funcallable-instance-fun (fin new-value) (declare (type function new-value)) (aver (funcallable-instance-p fin)) (setf (sb-kernel:funcallable-instance-fun fin) new-value)) (defmacro fsc-instance-p (fin) `(funcallable-instance-p ,fin)) -(defmacro fsc-instance-class (fin) - `(wrapper-class (funcallable-instance-data-1 ,fin 'wrapper))) (defmacro fsc-instance-wrapper (fin) - `(funcallable-instance-data-1 ,fin 'wrapper)) + `(sb-kernel:%funcallable-instance-layout ,fin)) (defmacro fsc-instance-slots (fin) - `(funcallable-instance-data-1 ,fin 'slots)) + `(sb-kernel:%funcallable-instance-info ,fin 0)) (declaim (inline clos-slots-ref (setf clos-slots-ref))) (declaim (ftype (function (simple-vector index) t) clos-slots-ref)) @@ -180,10 +165,10 @@ ;;; SET-FUN-NAME-INTERN which takes a list spec for a function ;;; name and turns it into a symbol if need be. ;;; -;;; When given a funcallable instance, SET-FUN-NAME *must* -;;; side-effect that FIN to give it the name. When given any other -;;; kind of function SET-FUN-NAME is allowed to return a new -;;; function which is "the same" except that it has the name. +;;; When given a funcallable instance, SET-FUN-NAME *must* side-effect +;;; that FIN to give it the name. When given any other kind of +;;; function SET-FUN-NAME is allowed to return a new function which is +;;; "the same" except that it has the name. ;;; ;;; In all cases, SET-FUN-NAME must return the new (or same) ;;; function. (Unlike other functions to set stuff, it does not return