Lay the groundwork for super calls.

darcs-hash:6b92675f9ae403584bc82cd69df0404f1fde70bb

4 files changed, 45 insertions, 8 deletions

diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp
index aacedab..0858cb9 100644
--- a/Lisp/libobjcl.lisp
+++ b/Lisp/libobjcl.lisp
@@ -39,6 +39,7 @@
 
 (defcfun ("objcl_invoke_with_types" %objcl-invoke-with-types) :pointer
   (argc :int)
+  (superclass-for-send-super :pointer)
   (return_typespec :string)
   (arg_typespecs (:array :string))
   (return_value (:pointer :void))
diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp
index 2389a9f..c90b37d 100644
--- a/Lisp/method-invocation.lisp
+++ b/Lisp/method-invocation.lisp
@@ -216,6 +216,7 @@ easier to use with __apply__.
               argc (+ 2 (length args)))
       (low-level-invoke receiver
                         selector
+                        (null-pointer)
                         method-return-typestring
                         method-return-type
                         method-arg-typestrings
@@ -264,6 +265,7 @@ easier to use with __apply__.
                                 (mapcar #'ad-hoc-value->typespec args))))
       (low-level-invoke receiver
                         (selector method-name)
+                        (null-pointer)
                         (print-typespec-to-string return-typespec)
                         return-typespec
                         (mapcar #'print-typespec-to-string arg-typespecs)
@@ -317,7 +319,8 @@ easier to use with __apply__.
     (otherwise (typespec-primary-type typespec))))
 
 
-(defun low-level-invoke (receiver selector return-typestring return-type
+(defun low-level-invoke (receiver selector superclass-pointer-for-send-super
+                         return-typestring return-type
                          arg-typestrings arg-types argc args)
   (let ((return-c-type (typespec->c-type return-type))
         (arg-c-types (mapcar #'typespec->c-type arg-types)))
@@ -422,6 +425,7 @@ easier to use with __apply__.
                                   (otherwise arg)))))))
           (let* ((error-cell
                   (%objcl-invoke-with-types (- argc 2)
+                                            superclass-pointer-for-send-super
                                             return-typestring
                                             objc-arg-typestrings
                                             objc-return-value-cell
diff --git a/Objective-C/libobjcl.h b/Objective-C/libobjcl.h
index 4a7137e..cca5d12 100644
--- a/Objective-C/libobjcl.h
+++ b/Objective-C/libobjcl.h
@@ -70,6 +70,7 @@ objcl_shutdown_runtime (void);
 
 id
 objcl_invoke_with_types (int argc,
+                         Class superclass_for_send_super,
                          char *return_typespec,
                          char *arg_typespecs[],
                          void *return_value,
@@ -105,7 +106,8 @@ objcl_selector_name (SEL selector);
 
 IMP
 objcl_get_method_implementation (id object,
-                                 SEL selector);
+                                 SEL selector,
+                                 Class superclass_for_send_super);
 
 BOOL
 objcl_object_is_class (id obj);
diff --git a/Objective-C/libobjcl.m b/Objective-C/libobjcl.m
index b380b6e..97422c2 100644
--- a/Objective-C/libobjcl.m
+++ b/Objective-C/libobjcl.m
@@ -114,6 +114,7 @@ objcl_shutdown_runtime (void)
 #ifdef USE_LIBFFI
 id
 objcl_invoke_with_types (int argc,
+                         Class superclass_for_send_super,
                          char *return_typespec,
                          char *arg_typespecs[],
                          void *return_value,
@@ -140,7 +141,8 @@ objcl_invoke_with_types (int argc,
   NS_DURING
     {
       TRACE (@"get-method");
-      method = objcl_get_method_implementation (receiver, method_selector);
+      method = objcl_get_method_implementation (receiver, method_selector,
+                                                superclass_for_send_super);
       TRACE (@"method == NULL");
       if (method == NULL)
         [[NSException exceptionWithName: @"MLKNoApplicableMethod"
@@ -284,22 +286,50 @@ objcl_selector_name (SEL selector)
 
 IMP
 objcl_get_method_implementation (id object,
-                                 SEL selector)
+                                 SEL selector,
+                                 Class superclass_for_send_super)
 {
+  /* If superclass_for_send_super == nil, this is just plain old method
+     implementation hunting.  If it isn't, though, we're trying to do a
+     super call, which can get a bit hairy quickly. */
   TRACE (@"method-impl %p %p", object, selector);
 #ifdef __NEXT_RUNTIME__
+  Class target_class;
+
   if (objcl_object_is_class (object))
-    return method_getImplementation (class_getClassMethod (object, selector));
+    {
+      if (superclass_for_send_super == nil)
+        target_class = object;
+      else
+        target_class = superclass_for_send_super;
+
+      return method_getImplementation (class_getClassMethod (target_class,
+                                                             selector));
+    }
   else
     {
+      if (superclass_for_send_super == nil)
+        target_class = [object class];
+      else
+        target_class = superclass_for_send_super;
+
 #ifdef __OBJC2__
-      return class_getMethodImplementation ([object class], selector);
+      return class_getMethodImplementation (target_class, selector);
 #else
-      return method_getImplementation (class_getInstanceMethod ([object class], selector));
+      return method_getImplementation (class_getInstanceMethod (target_class,
+                                                                selector));
 #endif
     }
 #else
-  return objc_msg_lookup (object, selector);
+  if (superclass_for_send_super == nil)
+    return objc_msg_lookup (object, selector);
+  else
+    {
+      Super super_struct;
+      super_struct.self = object;
+      super_struct.class = superclass_for_send_super;
+      return objc_msg_lookup_super (&super_struct, selector);
+    }
 #endif
 }