From e8267bcebfa0212ec3f455aeaf75a342408afb14 Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Thu, 14 Feb 2008 22:44:08 +0100 Subject: Lay the groundwork for super calls. darcs-hash:6b92675f9ae403584bc82cd69df0404f1fde70bb --- Lisp/libobjcl.lisp | 1 + Lisp/method-invocation.lisp | 6 +++++- Objective-C/libobjcl.h | 4 +++- Objective-C/libobjcl.m | 42 ++++++++++++++++++++++++++++++++++++------ 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 } -- cgit v1.2.3