diff options
| -rw-r--r-- | GNUmakefile | 22 | ||||
| -rw-r--r-- | MLKCompiledProcedure.h | 41 | ||||
| -rw-r--r-- | MLKCompiledProcedure.m | 92 |
3 files changed, 151 insertions, 4 deletions
diff --git a/GNUmakefile b/GNUmakefile index 6ee0974..54b8b9b 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -26,14 +26,26 @@ FRAMEWORK_NAME = ToiletKit BUNDLE_NAME = Test ifeq ($(DEBUG),YES) -ADDITIONAL_OBJCFLAGS = -Wall +ADDITIONAL_OBJCFLAGS += -ggdb3 +endif + +HAVE_FFI_H := $(shell echo '\#include <ffi.h>' | $(CC) $(ADDITIONAL_OBJCFLAGS) -c -o /dev/null -x c - 2>/dev/null && echo YES) + +ifeq ($(HAVE_FFI_H),YES) + ADDITIONAL_OBJCFLAGS += -DHAVE_FFI_H else -ADDITIONAL_OBJCFLAGS = -Wall -ggdb3 + HAVE_FFI_FFI_H := $(shell echo '\#include <ffi/ffi.h>' | $(CC) $(ADDITIONAL_OBJCFLAGS) -c -o /dev/null -x c - 2>/dev/null && echo YES) + + ifeq ($(HAVE_FFI_FFI_H),YES) + ADDITIONAL_OBJCFLAGS += -DHAVE_FFI_FFI_H + else + $(error "Could not find ffi.h. Please install libffi and pass appropriate ADDITIONAL_OBJCFLAGS and ADDITIONAL_LDFLAGS to make.") + endif endif ToiletKit_OBJC_FILES = functions.m globals.m MLKBackquoteReader.m \ MLKBinding.m MLKCharacter.m MLKCommaReader.m \ - MLKCons.m MLKDoubleFloat.m \ + MLKCompiledProcedure.m MLKCons.m MLKDoubleFloat.m \ MLKDispatchingMacroCharacterReader.m \ MLKDynamicContext.m MLKEnvironment.m MLKFloat.m \ MLKInteger.m MLKInterpretedClosure.m \ @@ -48,7 +60,8 @@ ToiletKit_OBJC_FILES = functions.m globals.m MLKBackquoteReader.m \ MLKStringReader.m MLKSymbol.m MLKThrowException.m \ MLKValuesFunction.m NSObject-MLKPrinting.m \ NSString-MLKPrinting.m -ToiletKit_LDFLAGS = -lgmp +ToiletKit_OBJCFLAGS = -Wall +ToiletKit_LDFLAGS = -lgmp -lffi #LIBRARIES_DEPEND_UPON #TOOL_NAME = etoilet @@ -66,6 +79,7 @@ etshell_OBJCFLAGS = -w toilet_OBJC_FILES = MLKReadEvalPrintLoop.m toilet_OBJC_LIBS += -ledit -lncurses -lToiletKit -LToiletKit.framework \ -LToiletKit.framework/Versions/Current +toilet_OBJCFLAGS = -Wall Test_OBJC_FILES = MLKLowLevelTests.m Test_OBJC_LIBS = -lUnitKit -LToiletKit.framework -lToiletKit diff --git a/MLKCompiledProcedure.h b/MLKCompiledProcedure.h new file mode 100644 index 0000000..e06d372 --- /dev/null +++ b/MLKCompiledProcedure.h @@ -0,0 +1,41 @@ +/* -*- mode: objc; coding: utf-8 -*- */ +/* Étoilisp/Mulklisp, a Common Lisp subset for the Étoilé runtime. + * Copyright (C) 2008 Matthias Andreas Benkard. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or (at + * your option) any later version. + * + * This program is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see <http://www.gnu.org/licenses/>. + */ + +#import "MLKFuncallable.h" +#import "MLKLispValue.h" +#import "MLKLexicalContext.h" +#import "MLKLexicalEnvironment.h" + +#import <Foundation/NSArray.h> +#import <Foundation/NSString.h> + + +@interface MLKCompiledProcedure : MLKLispValue <MLKFuncallable> +{ + void *_code; +} + +-(id) initWithCode:(void *)code; + +-(NSArray *) applyToArray:(NSArray *)arguments; + +-(NSString *) description; +-(NSString *) descriptionForLisp; + +-(void) dealloc; +@end diff --git a/MLKCompiledProcedure.m b/MLKCompiledProcedure.m new file mode 100644 index 0000000..af18ef0 --- /dev/null +++ b/MLKCompiledProcedure.m @@ -0,0 +1,92 @@ +/* -*- mode: objc; coding: utf-8 -*- */ +/* Étoilisp/Mulklisp, a Common Lisp subset for the Étoilé runtime. + * Copyright (C) 2008 Matthias Andreas Benkard. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or (at + * your option) any later version. + * + * This program is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see <http://www.gnu.org/licenses/>. + */ + +#import "MLKCompiledProcedure.h" +#import "globals.h" +#import "util.h" + +#import <Foundation/NSArray.h> + +#ifdef HAVE_FFI_H +#include <ffi.h> +#elif HAVE_FFI_FFI_H +#include <ffi/ffi.h> +#endif + +#include <stdlib.h> + + +@implementation MLKCompiledProcedure +-(id) initWithCode:(void *)code +{ + self = [super init]; + _code = code; + return self; +} + +-(NSArray *) applyToArray:(NSArray *)arguments +{ + int argc = ([arguments count] + 1); + ffi_cif cif; + ffi_type *arg_types[argc]; + ffi_status status; + id *argv[argc]; + id argpointers[argc - 1]; + id return_value; + int i; + + for (i = 0; i < argc - 1; i++) + { + arg_types[i] = &ffi_type_pointer; + argpointers[i] = denullify([arguments objectAtIndex:i]); + argv[i] = &argpointers[i]; + } + + arg_types[argc - 1] = &ffi_type_pointer; + argv[argc - 1] = &MLKEndOfArgumentsMarker; + + status = ffi_prep_cif (&cif, FFI_DEFAULT_ABI, argc, &ffi_type_pointer, arg_types); + if (status != FFI_OK) + { + [NSException raise:@"MLKInvalidFFITypeException" + format:@"FFI type is invalid (this is probably a bug)."]; + } + + ffi_call (&cif, FFI_FN (_code), &return_value, (void**)argv); + + // FIXME + return [NSArray arrayWithObject:nullify(return_value)]; +} + +-(NSString *) description +{ + return MLKPrintToString(self); +} + +-(NSString *) descriptionForLisp +{ + return [NSString stringWithFormat:@"<Compiled procedure @%p>", self]; +} + +-(void) dealloc +{ + // FIXME: Can we really just use free() here? + free (_code); + [super dealloc]; +} +@end |