diff options
| -rw-r--r-- | MLKRoot.m | 69 | ||||
| -rw-r--r-- | functions.h | 35 | ||||
| -rw-r--r-- | functions.m | 200 |
3 files changed, 261 insertions, 43 deletions
@@ -553,6 +553,7 @@ static id truify (BOOL value) SEL selector; NSMethodSignature *signature; int i; + MLKForeignType returnType; if (MLKFixnumP (object)) object = [MLKInteger integerWithFixnum:object]; @@ -579,55 +580,26 @@ static id truify (BOOL value) for (i = 2; i < [args count]; i++) { id argument = denullify ([args objectAtIndex:i]); - const char *type = [signature getArgumentTypeAtIndex:i]; - - if (strcmp (type, @encode(unichar)) == 0) - { - unichar arg; - if (MLKFixnumP (argument)) - arg = MLKIntWithFixnum (argument); - else if ([argument isKindOfClass:[MLKCharacter class]]) - arg = [argument unicharValue]; - else if ([argument isKindOfClass:[MLKInteger class]]) - arg = [argument intValue]; - else - [NSException raise:@"MLKInvalidArgumentError" - format:@"Don't know how to coerce %@ into type \"%s\".", - argument, type]; - [invocation setArgument:&arg atIndex:i]; - } - else - { - if (MLKFixnumP (argument)) - argument = [MLKInteger integerWithFixnum:argument]; - - [invocation setArgument:&argument atIndex:i]; - } + const char *objctype = [signature getArgumentTypeAtIndex:i]; + MLKForeignType type = MLKForeignTypeWithObjectiveCType (objctype); + ffi_type *ffi_argtype = MLKFFITypeWithForeignType (type); + void *argbuf = alloca (ffi_argtype->size); + + if (type == MLKT_INVALID) + [NSException raise:@"MLKInvalidArgumentError" + format:@"Don't know how to coerce %@ into type \"%s\".", + argument, objctype]; + + MLKSetForeignValueWithLispValue (argbuf, argument, type); + [invocation setArgument:argbuf atIndex:i]; } [invocation invoke]; -#define IF_TYPE_RETURN(TYPE, VALUE_NAME, VALUE) \ - if (strcmp ([signature methodReturnType], @encode(TYPE)) == 0) \ - { \ - TYPE VALUE_NAME; \ - [invocation getReturnValue:&VALUE_NAME]; \ - RETURN_VALUE (VALUE); \ - } + returnType = MLKForeignTypeWithObjectiveCType ([signature methodReturnType]); - if (strcmp ([signature methodReturnType], @encode(void)) == 0) - { - return [NSArray array]; - } - else IF_TYPE_RETURN (BOOL, retval, truify (retval)) - else IF_TYPE_RETURN (id, retval, retval) - else IF_TYPE_RETURN (Class, retval, retval) - else IF_TYPE_RETURN (NSException *, retval, retval) - else IF_TYPE_RETURN (int, retval, [MLKInteger integerWithInt:retval]) - else IF_TYPE_RETURN (unsigned int, retval, [MLKInteger integerWithInt:retval]) //FIXME - else IF_TYPE_RETURN (unichar, retval, [MLKCharacter characterWithUnichar:retval]) - else + if (returnType == MLKT_INVALID) { [NSException raise:@"MLKInvalidReturnTypeError" format:@"Cannot handle an Objective-C return type of \"%s\" \ @@ -635,5 +607,16 @@ as provided by method %@ of object %@", methodName, object, [signature methodReturnType]]; return nil; } + else if (returnType == MLKT_VOID) + { + return [NSArray array]; + } + else + { + ffi_type *ffi_rettype = MLKFFITypeWithForeignType (returnType); + void *returnValue = alloca (ffi_rettype->size); + [invocation getReturnValue:returnValue]; + RETURN_VALUE (MLKLispValueWithForeignValue (returnValue, returnType)); + } } @end diff --git a/functions.h b/functions.h index bb8c6af..102565b 100644 --- a/functions.h +++ b/functions.h @@ -21,6 +21,12 @@ #import <Foundation/NSString.h> #include <stdint.h> +#ifdef HAVE_FFI_H +#include <ffi.h> +#elif HAVE_FFI_FFI_H +#include <ffi/ffi.h> +#endif + NSString *MLKPrintToString (id object); @@ -36,3 +42,32 @@ id MLKAddFixnums (id x, id y); id MLKSubtractFixnums (id x, id y); id MLKIDivideFixnums (id x, id y); id MLKMultiplyFixnums (id x, id y); + +typedef enum MLKForeignType +{ + MLKT_PTR, + MLKT_SHORT, + MLKT_USHORT, + MLKT_INT, + MLKT_UINT, + MLKT_LONG, + MLKT_ULONG, + MLKT_STRING, + MLKT_VOID, + MLKT_BOOL, + MLKT_ID, + MLKT_CLASS, + MLKT_CHAR, + MLKT_UNICHAR, + MLKT_ERROR, + MLKT_INVALID, +} MLKForeignType; + +MLKForeignType MLKForeignTypeWithObjectiveCType (const char *typestring); +MLKForeignType MLKForeignTypeWithTypeDesignator (id typeDesignator); +MLKForeignType MLKForeignTypeWithLispValue (id value); +ffi_type *MLKFFITypeWithForeignType (MLKForeignType type); +ffi_type *MLKFFITypeWithObjectiveCType (const char *typestring); +ffi_type *MLKFFITypeWithLispValue (id value); +void MLKSetForeignValueWithLispValue (void *destination, id value, MLKForeignType type); +id MLKLispValueWithForeignValue (void *source, MLKForeignType type); diff --git a/functions.m b/functions.m index ddcd0c6..1c46c75 100644 --- a/functions.m +++ b/functions.m @@ -17,7 +17,17 @@ */ #import "functions.h" +#import "util.h" +#import "MLKCharacter.h" #import "MLKInteger.h" +#import "MLKPackage.h" +#import "MLKSymbol.h" + +#import <Foundation/NSException.h> +#import <Foundation/NSString.h> + +#import <string.h> + NSString *MLKPrintToString (id object) { @@ -46,6 +56,14 @@ id MLKFixnumWithInt (intptr_t value) return (id)((value << 1) | 1); } +intptr_t MLKIntWithInteger (id integer) +{ + if (MLKFixnumP (integer)) + return MLKIntWithFixnum (integer); + else + return [integer intValue]; +} + id MLKIntegerWithInt (intptr_t value) { #ifndef NO_FIXNUMS @@ -123,3 +141,185 @@ id MLKMultiplyFixnums (id x, id y) return MLKCanoniseInteger (result); } + + +static MLKSymbol *INT, *SHORT, *LONG, *VOID, *POINTER, + *UINT, *USHORT, *ULONG, *STRING, *ID, *BOOLEAN, *CLASS, *UNICHAR, *CHAR, + *ERROR; +static MLKPackage *keyword = nil, *cl = nil; + +#define INTERN_KEYWORD(VAR, NAME) \ + LASSIGN (VAR, [keyword intern:NAME]) + +static void init_symbols () +{ + if (keyword) + return; + + cl = [MLKPackage findPackage:@"COMMON-LISP"]; + keyword = [MLKPackage findPackage:@"KEYWORD"]; + INTERN_KEYWORD (POINTER, @"POINTER"); + INTERN_KEYWORD (SHORT, @"SHORT-INT"); + INTERN_KEYWORD (USHORT, @"UNSIGNED-SHORT-INT"); + INTERN_KEYWORD (INT, @"INT"); + INTERN_KEYWORD (UINT, @"UNSIGNED-INT"); + INTERN_KEYWORD (LONG, @"LONG-INT"); + INTERN_KEYWORD (ULONG, @"UNSIGNED-LONG-INT"); + INTERN_KEYWORD (STRING, @"STRING"); + INTERN_KEYWORD (ID, @"ID"); + INTERN_KEYWORD (BOOLEAN, @"BOOL"); + INTERN_KEYWORD (CLASS, @"CLASS"); + INTERN_KEYWORD (UNICHAR, @"UNICHAR"); + INTERN_KEYWORD (CHAR, @"CHAR"); + INTERN_KEYWORD (ERROR, @"ERROR"); + INTERN_KEYWORD (VOID, @"VOID"); +} + + +MLKForeignType MLKForeignTypeWithTypeDesignator (id typeDesignator) +{ +#define DESIGNATOR_CASE(TYPE, FOREIGN_TYPE) \ + if (typeDesignator == TYPE) return MLKT_ ## FOREIGN_TYPE; + + init_symbols (); + + DESIGNATOR_CASE (POINTER, PTR) + else DESIGNATOR_CASE (INT, INT) + else DESIGNATOR_CASE (UINT, UINT) + else DESIGNATOR_CASE (SHORT, SHORT) + else DESIGNATOR_CASE (LONG, LONG) + else DESIGNATOR_CASE (USHORT, USHORT) + else DESIGNATOR_CASE (ULONG, ULONG) + else DESIGNATOR_CASE (STRING, STRING) + else DESIGNATOR_CASE (VOID, VOID) + else DESIGNATOR_CASE (ID, ID) + else DESIGNATOR_CASE (BOOLEAN, BOOL) + else DESIGNATOR_CASE (CLASS, CLASS) + else DESIGNATOR_CASE (UNICHAR, UNICHAR) + else DESIGNATOR_CASE (CHAR, CHAR) + else DESIGNATOR_CASE (ERROR, ERROR) + else return MLKT_INVALID; +} + +ffi_type *MLKFFITypeWithForeignType (MLKForeignType type) +{ +#define FFI_TYPE_CASE(FOREIGN_TYPE, FFI_TYPE) \ + case MLKT_ ## FOREIGN_TYPE: return &(ffi_type_ ## FFI_TYPE); + + switch (type) + { + FFI_TYPE_CASE (PTR, pointer); + FFI_TYPE_CASE (INT, sint); + FFI_TYPE_CASE (UINT, uint); + FFI_TYPE_CASE (LONG, slong); + FFI_TYPE_CASE (ULONG, ulong); + FFI_TYPE_CASE (SHORT, sshort); + FFI_TYPE_CASE (USHORT, ushort); + FFI_TYPE_CASE (STRING, pointer); + FFI_TYPE_CASE (VOID, void); + FFI_TYPE_CASE (ID, pointer); + FFI_TYPE_CASE (BOOL, schar); + FFI_TYPE_CASE (CLASS, pointer); + FFI_TYPE_CASE (UNICHAR, sshort); + FFI_TYPE_CASE (CHAR, schar); + FFI_TYPE_CASE (ERROR, pointer); + case MLKT_INVALID: return NULL; + } + + return NULL; +} + +static id truify (BOOL value) +{ + init_symbols (); + return (value ? (id) [cl intern:@"T"] : nil); +} + +id MLKLispValueWithForeignValue (void *source, MLKForeignType type) +{ + switch (type) + { + case MLKT_INT: return MLKIntegerWithInt(*(int*)source); + case MLKT_UINT: return MLKIntegerWithInt(*(unsigned*)source); + case MLKT_LONG: return MLKIntegerWithInt(*(long*)source); + case MLKT_ULONG: return MLKIntegerWithInt(*(unsigned long*)source); + case MLKT_SHORT: return MLKIntegerWithInt(*(short*)source); + case MLKT_USHORT: return MLKIntegerWithInt(*(unsigned short*)source); + case MLKT_PTR: return MLKIntegerWithInt(*(intptr_t*)source); //FIXME + case MLKT_STRING: return [NSString stringWithUTF8String:(*(char**)source)]; + case MLKT_ID: return *(id*)source; + case MLKT_BOOL: return truify (*(BOOL*)source); + case MLKT_CLASS: return *(Class*)source; + case MLKT_UNICHAR: return [MLKCharacter characterWithUnichar:(*(unichar*)source)]; + case MLKT_CHAR: return [MLKCharacter characterWithUnichar:(*(char*)source)]; + case MLKT_ERROR: return *(id*)source; +// case MLKT_: return (*(*)source); + case MLKT_INVALID: return nil; + case MLKT_VOID: return nil; + } + + return nil; +} + +void MLKSetForeignValueWithLispValue (void *destination, id value, MLKForeignType type) +{ + switch (type) + { + case MLKT_INT: *(int *)destination = MLKIntWithInteger (value); break; + case MLKT_UINT: *(unsigned *)destination = MLKIntWithInteger (value); break; + case MLKT_LONG: *(long *)destination = MLKIntWithInteger (value); break; + case MLKT_ULONG: *(unsigned long *)destination = MLKIntWithInteger (value); break; + case MLKT_SHORT: *(short *)destination = MLKIntWithInteger (value); break; + case MLKT_USHORT: *(unsigned short *)destination = MLKIntWithInteger (value); break; + case MLKT_PTR: *(void **)destination = value; break; + case MLKT_STRING: *(const char **)destination = [value UTF8String]; break; + case MLKT_ID: + *(id*)destination = (MLKFixnumP (value) + ? (id)[MLKInteger integerWithFixnum:value] + : (id)value); + break; + case MLKT_BOOL: *(BOOL*)destination = (value != nil); break; + case MLKT_CLASS: *(Class*)destination = (Class)value; break; + case MLKT_UNICHAR: + if (MLKFixnumP (value)) + *(unichar*)destination = MLKIntWithFixnum (value); + else if ([value isKindOfClass:[MLKInteger class]]) + *(unichar*)destination = [value intValue]; + else + *(unichar*)destination = [value unicharValue]; + break; + case MLKT_CHAR: *(char*)destination = [value unicharValue]; break; + case MLKT_ERROR: *(id*)destination = value; break; +// case MLKT_: *(*)destination = ; break; + case MLKT_INVALID: break; + case MLKT_VOID: break; + } +} + +MLKForeignType MLKForeignTypeWithObjectiveCType (const char *typestring) +{ +#define OBJC_TYPE_CASE(OBJCTYPE, TYPE) \ + if (strcmp (typestring, @encode(OBJCTYPE)) == 0) return MLKT_ ## TYPE; + + OBJC_TYPE_CASE (BOOL, BOOL) + else OBJC_TYPE_CASE (unichar, UNICHAR) + else OBJC_TYPE_CASE (char, CHAR) + else OBJC_TYPE_CASE (int, INT) + else OBJC_TYPE_CASE (short, SHORT) + else OBJC_TYPE_CASE (long, LONG) + else OBJC_TYPE_CASE (unsigned, UINT) + else OBJC_TYPE_CASE (unsigned short, USHORT) + else OBJC_TYPE_CASE (unsigned long, ULONG) + else OBJC_TYPE_CASE (void *, PTR) + else OBJC_TYPE_CASE (char *, STRING) + else OBJC_TYPE_CASE (id, ID) + else OBJC_TYPE_CASE (Class, CLASS) + else OBJC_TYPE_CASE (NSException *, ERROR) + else OBJC_TYPE_CASE (void, VOID) + else return MLKT_INVALID; +} + + +MLKForeignType MLKForeignTypeWithLispValue (id value); +ffi_type *MLKFFITypeWithObjectiveCType (const char *typestring); +ffi_type *MLKFFITypeWithLispValue (id value); |