From 757b74dbcbb78eee894b0bdb916923ffb2d8e99b Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Wed, 6 Aug 2008 17:21:15 +0200 Subject: Generalise foreign value conversion. --- functions.m | 200 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 200 insertions(+) (limited to 'functions.m') 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 +#import + +#import + 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); -- cgit v1.2.3