diff options
-rw-r--r-- | GNUmakefile | 77 | ||||
-rw-r--r-- | MLKInterpreter.m | 58 | ||||
-rw-r--r-- | MLKLLVMCompiler.h | 3 | ||||
-rw-r--r-- | MLKLLVMCompiler.mm | 90 | ||||
-rw-r--r-- | MLKLexicalContext-MLKLLVMCompilation.h | 2 | ||||
-rw-r--r-- | MLKLexicalContext-MLKLLVMCompilation.mm | 2 | ||||
-rw-r--r-- | MLKReadEvalPrintLoop.m | 11 | ||||
-rw-r--r-- | MLKRoot.m | 11 | ||||
-rw-r--r-- | functions.m | 9 | ||||
-rw-r--r-- | globals.h | 6 | ||||
-rw-r--r-- | globals.m | 3 |
11 files changed, 210 insertions, 62 deletions
diff --git a/GNUmakefile b/GNUmakefile index 11e59a6..29f1f93 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -1,3 +1,5 @@ +## -*- mode: makefile-gmake; coding: utf-8 -*- +## ## Toilet Lisp, a Common Lisp subset for the Étoilé runtime. ## Copyright (C) 2008 Matthias Andreas Benkard. ## @@ -15,7 +17,16 @@ ## along with this program. If not, see <http://www.gnu.org/licenses/>. -default: ToiletKit toilet +export USE_LLVM ADDITIONAL_OBJCFLAGS ADDITIONAL_LDFLAGS LLVM_CONFIG + +KIT_TARGETS = ToiletKit + +USE_LLVM := YES +ifeq ($(USE_LLVM),YES) +KIT_TARGETS += libtoilet-llvm +endif + +default: $(KIT_TARGETS) toilet include $(GNUSTEP_MAKEFILES)/common.make @@ -24,6 +35,7 @@ include $(GNUSTEP_MAKEFILES)/common.make TOOL_NAME = etshell toilet FRAMEWORK_NAME = ToiletKit BUNDLE_NAME = Test +LIBRARY_NAME = ADDITIONAL_OBJCFLAGS += $(CUSTOM_OBJCFLAGS) ADDITIONAL_LDFLAGS += $(CUSTOM_LDFLAGS) @@ -70,17 +82,39 @@ ToiletKit_OBJCFLAGS = -Wall ToiletKit_LDFLAGS = -lgmp -lffi -ldl #LIBRARIES_DEPEND_UPON -USE_LLVM := YES + ifeq ($(USE_LLVM),YES) +ADDITIONAL_OBJCFLAGS += -DUSE_LLVM -DLLVM_MAJOR_VERSION=$(shell llvm-config --version | cut -f 1 -d.) -DLLVM_MINOR_VERSION=$(shell llvm-config --version | cut -f 2 -d. | sed s/svn//) LLVM_CONFIG = llvm-config +LLVM_LDFLAGS = $(shell $(LLVM_CONFIG) --ldflags) $(shell $(LLVM_CONFIG) --libs backend engine linker codegen transformutils scalaropts analysis ipo) +endif + +ifeq ($(BUILD_TOILET_LLVM),YES) +ifeq ($(USE_LLVM),YES) +static = yes # This line is the reason for this whole “BUILD_TOILET_LLVM” + # recursive-make-gone-awry crap. Hooray for not being able + # to build static libraries without bending over backwards! + # Thanks a bunch, GNUstep-Make! + +LIBRARY_NAME += libtoilet-llvm + ADDITIONAL_OBJCCFLAGS = $(ADDITIONAL_OBJCFLAGS) -ToiletKit_OBJC_FILES += MLKLexicalContext-MLKLLVMCompilation.m -ToiletKit_OBJCC_FILES = MLKLLVMCompiler.mm -ToiletKit_OBJCFLAGS = -DUSE_LLVM -DLLVM_MAJOR_VERSION=`llvm-config --version | cut -f 1 -d.` -DLLVM_MINOR_VERSION=`llvm-config --version | cut -f 2 -d. | sed s/svn//` -ToiletKit_OBJCCFLAGS = -DUSE_LLVM `$(LLVM_CONFIG) --cxxflags` $(ToiletKit_OBJCFLAGS) -ToiletKit_LDFLAGS += `$(LLVM_CONFIG) --ldflags` `$(LLVM_CONFIG) --libs backend engine linker codegen transformutils scalaropts analysis ipo` +libtoilet-llvm_OBJC_FILES += MLKLexicalContext-MLKLLVMCompilation.m +libtoilet-llvm_OBJCC_FILES = MLKLLVMCompiler.mm +libtoilet-llvm_OBJCFLAGS = -DUSE_LLVM +libtoilet-llvm_OBJCCFLAGS = -DUSE_LLVM `$(LLVM_CONFIG) --cxxflags` $(ToiletKit_OBJCFLAGS) +libtoilet-llvm_LDFLAGS += $(LLVM_LDFLAGS) +endif +else #!BUILD_TOILET_LLVM +libtoilet-llvm: + $(MAKE) $@ shared=no BUILD_TOILET_LLVM=YES endif +-include GNUmakefile.preamble +include $(GNUSTEP_MAKEFILES)/library.make +-include GNUmakefile.postamble + + #TOOL_NAME = etoilet #etoilet_OBJC_FILES = main.m #etoilet_OBJC_LIBS = -lToiletKit -LToiletKit.framework @@ -94,23 +128,33 @@ etshell_OBJC_LIBS += -lStepTalk -lreadline -lncurses -lToiletKit \ etshell_OBJCFLAGS = -w toilet_OBJC_FILES = MLKReadEvalPrintLoop.m -toilet_OBJC_LIBS += -ledit -lncurses -lToiletKit -LToiletKit.framework \ - -LToiletKit.framework/Versions/Current `llvm-config --ldflags` `llvm-config --libs scalaropts analysis ipo` +toilet_OBJCC_FILES = _stamp.mm +toilet_OBJC_LIBS += -ledit -lncurses -LToiletKit.framework \ + -LToiletKit.framework/Versions/Current -lToiletKit + toilet_OBJCFLAGS = -Wall +ifeq ($(USE_LLVM),YES) +toilet_OBJC_LIBS += -Lobj -ltoilet-llvm $(LLVM_LDFLAGS) +endif + Test_OBJC_FILES = MLKLowLevelTests.m Test_OBJC_LIBS = -lUnitKit -LToiletKit.framework -lToiletKit -include GNUmakefile.preamble include $(GNUSTEP_MAKEFILES)/bundle.make include $(GNUSTEP_MAKEFILES)/framework.make +include $(GNUSTEP_MAKEFILES)/library.make include $(GNUSTEP_MAKEFILES)/tool.make -include GNUmakefile.postamble before-all:: before-etshell before-toilet -before-toilet:: ToiletKit - rm -f obj/toilet +# _stamp.mm serves two distinct purposes. First, it causes toilet to be +# relinked whenever one of the $(KIT_TARGETS) has been updated, and +# second, it causes toilet to be linked with g++. +_stamp.mm: #$(KIT_TARGETS) + touch $@ before-etshell:: ToiletKit rm -f obj/etshell @@ -121,19 +165,24 @@ before-Test:: ToiletKit #after-clean:: # -rmdir $(GNUSTEP_OBJ_DIR)/StepTalkShell +ifneq ($(BUILD_TOILET_LLVM),YES) +after-clean:: + $(MAKE) clean shared=no BUILD_TOILET_LLVM=YES +endif + test: ToiletKit Test env LD_LIBRARY_PATH="`pwd`/ToiletKit.framework/Versions/Current:/usr/local/lib" ukrun Test.bundle run-et: before-etshell ToiletKit etshell env LD_LIBRARY_PATH="`pwd`/ToiletKit.framework/Versions/Current:/usr/local/lib" obj/etshell -run-toilet: before-toilet ToiletKit toilet +run-toilet: before-toilet $(KIT_TARGETS) toilet env LD_LIBRARY_PATH="`pwd`/ToiletKit.framework/Versions/Current:/usr/local/lib" obj/toilet run: run-toilet -debugging-run: before-toilet ToiletKit toilet +debugging-run: before-toilet $(KIT_TARGETS) toilet env LD_LIBRARY_PATH="`pwd`/ToiletKit.framework/Versions/Current:/usr/local/lib" gdb -ex run obj/toilet -ddd-run: before-toilet ToiletKit toilet +ddd-run: before-toilet $(KIT_TARGETS) toilet env LD_LIBRARY_PATH="`pwd`/ToiletKit.framework/Versions/Current:/usr/local/lib" ddd obj/toilet diff --git a/MLKInterpreter.m b/MLKInterpreter.m index 0cdf904..7fd59ad 100644 --- a/MLKInterpreter.m +++ b/MLKInterpreter.m @@ -35,6 +35,7 @@ #import "MLKRoot.h" #import "MLKSymbol.h" #import "NSObject-MLKPrinting.h" +#import "globals.h" #import "runtime-compatibility.h" #import "special-symbols.h" #import "util.h" @@ -1230,34 +1231,37 @@ fprintf (stderr, "| "); fprintf (stderr, "LOAD: %s\n", [formdesc UTF8String]); -#ifdef USE_LLVM - expansion = code; - result = [MLKLLVMCompiler eval:code]; -#else // !USE_LLVM - expansion = denullify([[MLKInterpreter - eval:code - inLexicalContext:[MLKLexicalContext - globalContext] - withEnvironment:[MLKLexicalEnvironment - globalEnvironment] - mode:not_compile_time_mode] - objectAtIndex:0]); - - if ([code isKindOfClass:[MLKCons class]] && [code cdr]) - formdesc = [NSString stringWithFormat:@"(%@ %@ ...)", - MLKPrintToString([expansion car]), - MLKPrintToString([[expansion cdr] car])]; + if (MLKLoadCompilesP) + { + expansion = code; + result = [MLKDefaultCompiler eval:code]; + } else - formdesc = MLKPrintToString(expansion); - - //fprintf (stderr, "; LOAD: %s\n", [formdesc UTF8String]); - result = [MLKInterpreter - eval:expansion - inLexicalContext:[MLKLexicalContext globalContext] - withEnvironment:[MLKLexicalEnvironment globalEnvironment] - expandOnly:NO]; - //NSLog (@"; LOAD: Top-level form evaluated."); -#endif //!USE_LLVM + { + expansion = denullify([[MLKInterpreter + eval:code + inLexicalContext:[MLKLexicalContext + globalContext] + withEnvironment:[MLKLexicalEnvironment + globalEnvironment] + mode:not_compile_time_mode] + objectAtIndex:0]); + + if ([code isKindOfClass:[MLKCons class]] && [code cdr]) + formdesc = [NSString stringWithFormat:@"(%@ %@ ...)", + MLKPrintToString([expansion car]), + MLKPrintToString([[expansion cdr] car])]; + else + formdesc = MLKPrintToString(expansion); + + //fprintf (stderr, "; LOAD: %s\n", [formdesc UTF8String]); + result = [MLKInterpreter + eval:expansion + inLexicalContext:[MLKLexicalContext globalContext] + withEnvironment:[MLKLexicalEnvironment globalEnvironment] + expandOnly:NO]; + //NSLog (@"; LOAD: Top-level form evaluated."); + } LRELEASE (pool); diff --git a/MLKLLVMCompiler.h b/MLKLLVMCompiler.h index cf2823b..d398f0f 100644 --- a/MLKLLVMCompiler.h +++ b/MLKLLVMCompiler.h @@ -32,6 +32,8 @@ using namespace llvm; #endif @interface MLKLLVMCompiler : NSObject ++(void) load; + +(void) initialize; +(id) compile:(id)object @@ -80,5 +82,6 @@ using namespace llvm; #ifdef __cplusplus @interface MLKForm (MLKLLVMCompilation) -(Value *) processForLLVM; +-(Value *) reallyProcessForLLVM; @end #endif diff --git a/MLKLLVMCompiler.mm b/MLKLLVMCompiler.mm index 745be44..2aaa0e8 100644 --- a/MLKLLVMCompiler.mm +++ b/MLKLLVMCompiler.mm @@ -33,6 +33,7 @@ #include <llvm/DerivedTypes.h> #include <llvm/ExecutionEngine/ExecutionEngine.h> #include <llvm/Instructions.h> +//#include <llvm/Interpreter.h> #include <llvm/Module.h> #include <llvm/ModuleProvider.h> #include <llvm/PassManager.h> @@ -40,6 +41,7 @@ #include <llvm/Target/TargetData.h> #include <llvm/Transforms/Scalar.h> #include <llvm/Transforms/IPO.h> +#include <llvm/Transforms/Utils/Cloning.h> // InlineFunction #include <llvm/Transforms/Utils/UnifyFunctionExitNodes.h> #include <llvm/Value.h> @@ -80,6 +82,20 @@ static Constant @implementation MLKLLVMCompiler ++(void) load +{ + if (!MLKDefaultCompiler) + { + MLKDefaultCompiler = self; + MLKLoadCompilesP = YES; + } + + // GNU ld optimises the MLKLLVMCompilation category on + // MLKLexicalContext away unless we do this. Man, the crappiness of + // this Unix stuff is amazing... + MLKDummyUseLLVMLexicalContext = nil; +} + +(void) initialize { module = new llvm::Module ("MLKLLVMModule"); @@ -89,6 +105,7 @@ static Constant fpm = new FunctionPassManager (module_provider); fpm->add (new TargetData (*execution_engine->getTargetData())); //fpm->add (new TargetData (module)); + fpm->add (createScalarReplAggregatesPass()); fpm->add (createInstructionCombiningPass()); fpm->add (createReassociatePass()); fpm->add (createGVNPass()); @@ -138,16 +155,22 @@ static Constant //function->dump(); - // JIT-compile. - fn = (id (*)()) execution_engine->getPointerToFunction (function); //module->dump(); //NSLog (@"%p", fn); [pool release]; //NSLog (@"Code compiled."); +#if 1 + // JIT-compile. + fn = (id (*)()) execution_engine->getPointerToFunction (function); // Execute. lambdaForm = fn(); + execution_engine->freeMachineCodeForFunction (function); +#else + Interpreter *i = Interpreter::create (module_provider); + lambdaForm = i->runFunction (function)->PointerVal; +#endif //NSLog (@"Closure built."); @@ -316,15 +339,43 @@ static Constant Type::Int32Ty, PointerTy, NULL); - + builder.CreateCall (function, createGlobalStringPtr ([message UTF8String])); } + ++(void) insertPointerTrace:(Value *)pointerValue +{ + Constant *function = + module->getOrInsertFunction ("printf", + Type::Int32Ty, + PointerTy, + PointerTy, + NULL); + + builder.CreateCall2 (function, + createGlobalStringPtr ("%p\n"), + builder.CreateBitCast (pointerValue, PointerTy)); +} @end @implementation MLKForm (MLKLLVMCompilation) -(Value *) processForLLVM { + //[_compiler insertTrace: + // [NSString stringWithFormat: + // @"Executing: %@", MLKPrintToString(_form)]]; + + Value *result = [self reallyProcessForLLVM]; + + //[_compiler insertTrace: + // [NSString stringWithFormat: + // @"Done: %@", MLKPrintToString(_form)]]; + return result; +} + +-(Value *) reallyProcessForLLVM +{ NSLog (@"WARNING: Unrecognised form type: %@", self); return NULL; } @@ -332,7 +383,7 @@ static Constant @implementation MLKProgNForm (MLKLLVMCompilation) --(Value *) processForLLVM +-(Value *) reallyProcessForLLVM { NSEnumerator *e = [_bodyForms objectEnumerator]; MLKForm *form; @@ -349,7 +400,7 @@ static Constant @implementation MLKSimpleLoopForm (MLKLLVMCompilation) --(Value *) processForLLVM +-(Value *) reallyProcessForLLVM { NSEnumerator *e = [_bodyForms objectEnumerator]; MLKForm *form; @@ -379,7 +430,7 @@ static Constant @implementation MLKSymbolForm (MLKLLVMCompilation) --(Value *) processForLLVM +-(Value *) reallyProcessForLLVM { Value *value; @@ -422,7 +473,7 @@ static Constant @implementation MLKFunctionCallForm (MLKLLVMCompilation) --(Value *) processForLLVM +-(Value *) reallyProcessForLLVM { static MLKPackage *sys = [MLKPackage findPackage:@"TOILET-SYSTEM"]; @@ -496,13 +547,21 @@ static Constant args.end(), [MLKPrintToString(_head) UTF8String]); + // XXX + if (NO && [_context functionInline:_head]) + { + InlineFunction (call); + } + + //[_compiler insertTrace:[NSString stringWithFormat:@"%@ done.", MLKPrintToString(_head)]]; + return call; } @end @implementation MLKSimpleLambdaForm (MLKLLVMCompilation) --(Value *) processForLLVM +-(Value *) reallyProcessForLLVM { std::vector <const Type *> argtypes (1, PointerTy); FunctionType *ftype = FunctionType::get (PointerTy, argtypes, true); @@ -625,6 +684,7 @@ static Constant execution_engine->getPointerToFunction (function); //NSLog (@"Done."); //function->dump(); + //function->viewCFG(); //NSLog (@"Function built."); builder.SetInsertPoint (outerBlock); @@ -644,15 +704,13 @@ static Constant onObject:mlkcompiledclosure withArgumentVector:&argv]; - //function->viewCFG(); - return closure; } @end @implementation MLKLetForm (MLKLLVMCompilation) --(Value *) processForLLVM +-(Value *) reallyProcessForLLVM { NSEnumerator *e = [_variableBindingForms objectEnumerator]; Value *value = ConstantPointerNull::get (PointerTy); @@ -684,7 +742,7 @@ static Constant @implementation MLKQuoteForm (MLKLLVMCompilation) --(Value *) processForLLVM +-(Value *) reallyProcessForLLVM { // FIXME: When to release _quotedData? At the same time the code is // released, probably... @@ -698,7 +756,7 @@ static Constant @implementation MLKSelfEvaluatingForm (MLKLLVMCompilation) --(Value *) processForLLVM +-(Value *) reallyProcessForLLVM { // FIXME: When to release _form? At the same time the code is // released, probably... @@ -712,7 +770,7 @@ static Constant @implementation MLKIfForm (MLKLLVMCompilation) --(Value *) processForLLVM +-(Value *) reallyProcessForLLVM { Function *function = builder.GetInsertBlock()->getParent(); BasicBlock *thenBlock = BasicBlock::Create ("if_then", function); @@ -742,7 +800,7 @@ static Constant @implementation MLKSetQForm (MLKLLVMCompilation) --(Value *) processForLLVM +-(Value *) reallyProcessForLLVM { NSEnumerator *var_e, *value_e; MLKForm *valueForm; @@ -796,7 +854,7 @@ static Constant @implementation MLKInPackageForm (MLKLLVMCompilation) --(Value *) processForLLVM +-(Value *) reallyProcessForLLVM { id package = [MLKPackage findPackage:stringify(_packageDesignator)]; diff --git a/MLKLexicalContext-MLKLLVMCompilation.h b/MLKLexicalContext-MLKLLVMCompilation.h index d791765..4f4c849 100644 --- a/MLKLexicalContext-MLKLLVMCompilation.h +++ b/MLKLexicalContext-MLKLLVMCompilation.h @@ -31,6 +31,8 @@ using namespace llvm; #endif +extern id MLKDummyUseLLVMLexicalContext; + @interface MLKLexicalContext (MLKLLVMCompilation) #ifdef __cplusplus -(void) setVariableHeapAllocation:(BOOL)heapp forSymbol:(id)name; diff --git a/MLKLexicalContext-MLKLLVMCompilation.mm b/MLKLexicalContext-MLKLLVMCompilation.mm index 22d211d..45208ed 100644 --- a/MLKLexicalContext-MLKLLVMCompilation.mm +++ b/MLKLexicalContext-MLKLLVMCompilation.mm @@ -31,6 +31,8 @@ using namespace llvm; using namespace std; +id MLKDummyUseLLVMLexicalContext = nil; + @implementation MLKLexicalContext (MLKLLVMCompilation) -(void) setVariableHeapAllocation:(BOOL)heapp forSymbol:(id)name diff --git a/MLKReadEvalPrintLoop.m b/MLKReadEvalPrintLoop.m index fc0d8ef..53943bc 100644 --- a/MLKReadEvalPrintLoop.m +++ b/MLKReadEvalPrintLoop.m @@ -26,6 +26,11 @@ #import "runtime-compatibility.h" #import "util.h" +#if USE_LLVM +#import "MLKLLVMCompiler.h" +#import "MLKLexicalContext-MLKLLVMCompilation.h" +#endif + #import <Foundation/NSAutoreleasePool.h> #import <Foundation/NSException.h> #import <Foundation/NSNull.h> @@ -76,6 +81,12 @@ static const char *prompt (EditLine *e) { BOOL success; NSAutoreleasePool *pool; +#ifdef USE_LLVM + // We do this in order to prevent ld from “optimising” MLKLLVMCompiler + // away. GNU ld apparently sucks at dynamic languages. + [MLKLLVMCompiler class]; +#endif + editline = el_init (_argv[0], stdin, stdout, stderr); el_set (editline, EL_PROMPT, &prompt); el_set (editline, EL_EDITOR, "emacs"); @@ -32,6 +32,7 @@ #import "MLKSingleFloat.h" #import "MLKDoubleFloat.h" #import "NSObject-MLKPrinting.h" +#import "globals.h" #import "runtime-compatibility.h" #import "util.h" @@ -708,17 +709,19 @@ as provided by method %@ of object %@", with:nil]]); } -#ifdef USE_LLVM +(NSArray *) compile:(NSArray *)args { + if (!MLKDefaultCompiler) + [NSException raise:@"MLKNotImplementedException" + format:@"It seems as though there is no compiler here."]; + //NSLog (@"Compiling lambda form."); - id thing = [MLKLLVMCompiler compile:denullify([args objectAtIndex:0]) - inContext:[MLKLexicalContext globalContext]]; + id thing = [MLKDefaultCompiler compile:denullify([args objectAtIndex:0]) + inContext:[MLKLexicalContext globalContext]]; //NSLog (@"Compilation done."); //NSLog (@"Compiled: %@", thing); RETURN_VALUE (thing); } -#endif +(NSArray *) fset:(NSArray *)args { diff --git a/functions.m b/functions.m index 20cde07..2d8a08f 100644 --- a/functions.m +++ b/functions.m @@ -419,11 +419,15 @@ id MLKDispatchRootFunction (MLKSymbol *name, ...) id arg; va_list ap; + //NSLog (@"Calling intrinsic."); + //NSLog (@"Intrinsic function: %@", MLKPrintToString (name)); + arguments = [NSMutableArray array]; va_start (ap, name); while ((arg = va_arg (ap, id)) != MLKEndOfArgumentsMarker) { + //NSLog (@"Argument: %p", arg); [arguments addObject:nullify(arg)]; } va_end (ap); @@ -431,7 +435,10 @@ id MLKDispatchRootFunction (MLKSymbol *name, ...) values = [MLKRoot dispatch:name withArguments:arguments]; if ([values count] > 0) - return denullify ([values objectAtIndex:0]); + { + //NSLog (@"RETURN: %p", denullify ([values objectAtIndex:0])); + return denullify ([values objectAtIndex:0]); + } else return nil; } @@ -16,4 +16,10 @@ * along with this program. If not, see <http://www.gnu.org/licenses/>. */ +#import <Foundation/NSObject.h> + + extern id MLKEndOfArgumentsMarker; + +extern id MLKDefaultCompiler; +extern BOOL MLKLoadCompilesP; @@ -23,6 +23,9 @@ id MLKEndOfArgumentsMarker; +id MLKDefaultCompiler = nil; +BOOL MLKLoadCompilesP = NO; + @interface MLKGlobalManager : NSObject +(void) load; |