Index: /trunk/ccl/level-1/l1-dcode.lisp
===================================================================
--- /trunk/ccl/level-1/l1-dcode.lisp	(revision 887)
+++ /trunk/ccl/level-1/l1-dcode.lisp	(revision 888)
@@ -384,4 +384,29 @@
 )
 
+#+ppc-target
+(defppclapfunction funcallable-trampoline ()
+  (svref nfn gf.dcode nfn)
+  (lwz temp0 ppc32::misc-data-offset nfn)
+  (mtctr temp0)
+  (bctr))
+
+(defvar *fi-trampoline-code* (uvref #'funcallable-trampoline 0))
+
+#+ppc-target
+(defppclapfunction unset-fin-trampoline ()
+  (mflr loc-pc)
+  (bla .SPheap-rest-arg)                ; cons up an &rest arg, vpush it
+  (vpop arg_z)                          ; whoops, didn't really want to
+  (bla .SPsavecontextvsp)
+  (lwz arg_x '"Funcallable instance ~S was called with args ~s, but has no FUNCALLABLE-INSTANCE-FUNCTION" fn)
+  (mr arg_y fn)
+  (set-nargs 3)
+  (lwz fname 'error fn)
+  (bla .SPrestorecontext)
+  (mtlr loc-pc)
+  (ba .SPjmpsym))
+
+(defvar *unset-fin-code* (uvref #'unset-fin-trampoline 0))
+
 
 #+ppc-target
@@ -491,5 +516,5 @@
   (setf (combined-method.dcode cm) val))
 
-(defun generic-function-p (thing)
+(defun funcallable-instance-p (thing)
   (when (typep thing 'function)
     (let ((bits (lfun-bits-known-function thing)))
@@ -498,4 +523,17 @@
 	  (logand bits (logior (ash 1 $lfbits-gfn-bit)
 			       (ash 1 $lfbits-method-bit)))))))
+
+(defun generic-function-p (thing)
+  (and (typep thing 'function)
+       (let ((bits (lfun-bits-known-function thing)))
+	 (declare (fixnum bits))
+	 (eq (ash 1 $lfbits-gfn-bit)
+	     (logand bits (logior (ash 1 $lfbits-gfn-bit)
+				  (ash 1 $lfbits-method-bit)))))
+       (or (eq (%class.own-wrapper *generic-function-class*)
+	       (gf.instance.class-wrapper thing))
+	   (memq  *generic-function-class*
+		  (%inited-class-cpl (class-of thing))))))
+
 
 (defun standard-generic-function-p (thing)
@@ -524,4 +562,5 @@
 
 (setf (type-predicate 'standard-generic-function) 'standard-generic-function-p)
+(setf (type-predicate 'funcallable-standard-object) 'funcallable-instance-p)
 (setf (type-predicate 'combined-method) 'combined-method-p)