Objective-C layer: Add objcl_create_imp and assorted functions.

darcs-hash:586394a97ab02a3f8e258cd75c1230dff717a38e

2 files changed, 107 insertions, 0 deletions

diff --git a/Objective-C/libobjcl.h b/Objective-C/libobjcl.h
index 09b08ab..270af45 100644
--- a/Objective-C/libobjcl.h
+++ b/Objective-C/libobjcl.h
@@ -44,6 +44,8 @@ typedef struct objc_ivar *IVAR_T;
 #endif
 
 extern NSException *objcl_oom_exception;
+extern id objcl_current_exception;
+extern void *objcl_current_exception_lock;
 
 
 void
@@ -145,3 +147,15 @@ objcl_slot_name (IVAR_T ivar);
 
 const char *
 objcl_slot_type (IVAR_T ivar);
+
+IMP
+objcl_create_imp (IMP callback,
+                  int argc,
+                  const char *return_typespec,
+                  const char *arg_typespecs[]);
+
+void
+objcl_acquire_lock (void *lock);
+
+void
+objcl_release_lock (void *lock);
diff --git a/Objective-C/libobjcl.m b/Objective-C/libobjcl.m
index 1d6607e..3cbf3e5 100644
--- a/Objective-C/libobjcl.m
+++ b/Objective-C/libobjcl.m
@@ -45,6 +45,9 @@ static NSAutoreleasePool *objcl_autorelease_pool = NULL;
 /* Preallocate an exception to throw when memory is all used up. */
 NSException *objcl_oom_exception = NULL;
 
+id objcl_current_exception = NULL;
+void *objcl_current_exception_lock = NULL;
+
 
 void
 objcl_initialise_runtime (void)
@@ -477,3 +480,93 @@ objcl_slot_type (IVAR_T ivar)
   return ivar->ivar_type;
 #endif
 }
+
+
+
+
+/* In order to be able to do exception propagation from Lisp code, we
+   have the Lisp layer save exceptions to objcl_current_exception.  Our
+   wrapper function is then able to raise the exception from where it
+   ought to be raised from: the Objective-C layer.
+
+   Note that it is the Lisp layer's duty to wrap Objective-C exceptions
+   around Lisp SERIOUS-CONDITIONs in order to propagate them. */
+static void
+imp_closure (ffi_cif *cif, void *result, void **args, void *user_data)
+{
+  id exception;
+
+  ffi_call (cif, user_data, result, args);
+
+  exception = objcl_current_exception;
+  objcl_current_exception = NULL;
+  objcl_release_lock (objcl_current_exception_lock);
+
+  if (exception)
+    [exception raise];
+}
+
+
+IMP
+objcl_create_imp (IMP callback,
+                  int argc,
+                  const char *return_typespec,
+                  const char *arg_typespecs[])
+{
+  ffi_type *return_type;
+  ffi_type *arg_types[argc + 2];
+  ffi_status status;
+  ffi_cif cif;
+  ffi_closure *closure;
+
+  int i;
+
+  static ffi_type *id_type = NULL;
+  static ffi_type *sel_type = NULL;
+
+  if (!id_type)
+    id_type = objcl_pyobjc_arg_signature_to_ffi_type ("@");
+
+  if (!sel_type)
+    sel_type = objcl_pyobjc_arg_signature_to_ffi_type (":");
+
+  return_type = objcl_pyobjc_signature_to_ffi_return_type (return_typespec);
+
+  arg_types[0] = id_type;
+  arg_types[1] = sel_type;
+
+  for (i = 0; i < argc; i++)
+    arg_types[i + 2] = objcl_pyobjc_arg_signature_to_ffi_type (arg_typespecs[i]);
+
+  status = ffi_prep_cif (&cif, FFI_DEFAULT_ABI, argc + 2, return_type, arg_types);
+  if (status != FFI_OK)
+    {
+      [[NSException exceptionWithName: @"MLKInvalidFFITypeException"
+                    reason: @"FFI type is invalid (this is probably a bug)."
+                    userInfo: nil] raise];
+    }
+
+  status = ffi_prep_closure (closure, &cif, imp_closure, (void *)callback);
+  if (status != FFI_OK)
+    {
+      [[NSException exceptionWithName: @"MLKClosureCreationFailure"
+                    reason: @"Creating an IMP closure failed (this is probably a bug)."
+                    userInfo: nil] raise];
+    }
+
+  return (IMP) closure;
+}
+
+
+void
+objcl_acquire_lock (void *lock)
+{
+#warning "FIXME"
+}
+
+
+void
+objcl_release_lock (void *lock)
+{
+#warning "FIXME"
+}