diff options
| -rw-r--r-- | Lisp/libobjcl.lisp | 15 | ||||
| -rw-r--r-- | Objective-C/libobjcl.h | 14 | ||||
| -rw-r--r-- | Objective-C/libobjcl.m | 93 |
3 files changed, 122 insertions, 0 deletions
diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp index 07f88ac..fd575d2 100644 --- a/Lisp/libobjcl.lisp +++ b/Lisp/libobjcl.lisp @@ -121,6 +121,21 @@ (defcfun objcl-get-yes :long) (defcfun objcl-get-no :long) +(defcfun ("objcl_create_imp" %objcl-create-imp) :pointer + (callback :pointer) + (argc :int) + (return-typespec :string) + (arg-typespecs (:array :string))) + +(defcfun ("objcl_acquire_lock" %objcl-release-lock) :pointer + (lock :pointer)) + +(defcfun ("objcl_release_lock" %objcl-acquire-lock) :pointer + (lock :pointer)) + +(defcvar *objcl-current-exception-lock* :pointer) +(defcvar *objcl-current-exception* :pointer) + (defun objcl-get-nil () ;; %OBJCL-GET-NIL can return NIL for CLISP, which CFFI refuses to ;; accept as an argument to POINTER-EQ. This is weird. 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" +} |