summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--GNUmakefile9
-rw-r--r--MLKArray.h1
-rw-r--r--MLKArray.m8
-rw-r--r--MLKCompiledClosure.h6
-rw-r--r--MLKCompiledClosure.m34
-rw-r--r--MLKForm.m15
-rw-r--r--MLKInterpreter.m7
-rw-r--r--MLKLLVMCompiler.h10
-rw-r--r--MLKLLVMCompiler.mm154
-rw-r--r--MLKLexicalContext-MLKLLVMCompilation.h17
-rw-r--r--MLKLexicalContext-MLKLLVMCompilation.mm78
-rw-r--r--MLKLexicalContext.h4
-rw-r--r--MLKLexicalContext.m57
-rw-r--r--MLKLexicalEnvironment.m52
-rw-r--r--MLKPackage.m1
-rw-r--r--MLKRoot.m13
16 files changed, 366 insertions, 100 deletions
diff --git a/GNUmakefile b/GNUmakefile
index 9bd1c2f..7fb8754 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -56,7 +56,6 @@ ToiletKit_OBJC_FILES = functions.m globals.m MLKArray.m \
MLKForeignProcedure.m MLKForm.m MLKInteger.m \
MLKInterpretedClosure.m MLKInterpreter.m \
MLKLexicalContext.m \
- MLKLexicalContext-MLKLLVMCompilation.m \
MLKLexicalEnvironment.m MLKNumber.m MLKPackage.m \
MLKParenReader.m MLKQuoteReader.m MLKRatio.m \
MLKReader.m MLKReadtable.m MLKReaderError.m \
@@ -74,9 +73,11 @@ ToiletKit_LDFLAGS = -lgmp -lffi -ldl
USE_LLVM := YES
ifeq ($(USE_LLVM),YES)
ADDITIONAL_OBJCCFLAGS = $(ADDITIONAL_OBJCFLAGS)
+ToiletKit_OBJC_FILES += MLKLexicalContext-MLKLLVMCompilation.m
ToiletKit_OBJCC_FILES = MLKLLVMCompiler.mm
-ToiletKit_OBJCCFLAGS = `llvm-config --cxxflags` $(ToiletKit_OBJCFLAGS)
-ToiletKit_LDFLAGS += `llvm-config --ldflags` `llvm-config --libs backend engine linker codegen transformutils scalaropts analysis`
+ToiletKit_OBJCFLAGS = -DUSE_LLVM
+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`
endif
#TOOL_NAME = etoilet
@@ -93,7 +94,7 @@ etshell_OBJCFLAGS = -w
toilet_OBJC_FILES = MLKReadEvalPrintLoop.m
toilet_OBJC_LIBS += -ledit -lncurses -lToiletKit -LToiletKit.framework \
- -LToiletKit.framework/Versions/Current
+ -LToiletKit.framework/Versions/Current `llvm-config --ldflags` `llvm-config --libs scalaropts analysis ipo`
toilet_OBJCFLAGS = -Wall
Test_OBJC_FILES = MLKLowLevelTests.m
diff --git a/MLKArray.h b/MLKArray.h
index 5fedf1c..1205b69 100644
--- a/MLKArray.h
+++ b/MLKArray.h
@@ -31,6 +31,7 @@
NSArray *_displacement;
}
++(id) array;
-(id) initWithDimensions:(NSArray *)dimensions;
-(NSArray *) dimensions;
diff --git a/MLKArray.m b/MLKArray.m
index 5890953..11c7889 100644
--- a/MLKArray.m
+++ b/MLKArray.m
@@ -30,6 +30,14 @@
@implementation MLKArray
++(id) array
+{
+ return LAUTORELEASE ([[self alloc]
+ initWithDimensions:
+ [NSArray arrayWithObject:
+ [MLKInteger integerWithInt:0]]]);
+}
+
-(id) initWithDimensions:(NSArray *)dimensions
{
NSEnumerator *e;
diff --git a/MLKCompiledClosure.h b/MLKCompiledClosure.h
index 589c0de..772f29c 100644
--- a/MLKCompiledClosure.h
+++ b/MLKCompiledClosure.h
@@ -27,9 +27,8 @@
@interface MLKCompiledClosure : NSObject <MLKFuncallable>
{
int _dataLength;
- id (**_code)();
+ id (*_code)();
id *_data;
- BOOL _ownPointer; // do we own the _code pointer cell?
}
// Why intptr_t? Because it makes it easier to call this method from
@@ -47,5 +46,8 @@
-(NSString *) description;
-(NSString *) descriptionForLisp;
+-(id (*)()) code;
+-(void *) closureData;
+
-(void) dealloc;
@end
diff --git a/MLKCompiledClosure.m b/MLKCompiledClosure.m
index 5dbf6dd..73f308b 100644
--- a/MLKCompiledClosure.m
+++ b/MLKCompiledClosure.m
@@ -38,10 +38,7 @@
_data = data;
_dataLength = dataLength;
- _ownPointer = YES;
-
- _code = malloc (sizeof (id (*)()));
- *_code = code;
+ _code = code;
for (i = 0; i < _dataLength; i++)
{
@@ -75,7 +72,7 @@
for (i = 1; i < argc - 1; i++)
{
arg_types[i] = &ffi_type_pointer;
- argpointers[i-1] = denullify([arguments objectAtIndex:i]);
+ argpointers[i-1] = denullify([arguments objectAtIndex:(i-1)]);
argv[i] = &argpointers[i-1];
}
@@ -89,9 +86,15 @@
format:@"FFI type is invalid (this is probably a bug)."];
}
- ffi_call (&cif, FFI_FN (*_code), &return_value, (void**)argv);
+// NSLog (@"Calling %p (argc = %d)", _code, argc);
+// for (i = 0; i < argc; i++)
+// {
+// NSLog (@"Argument %d: %p", i, *((void**)argv[i]));
+// }
+
+ ffi_call (&cif, FFI_FN (_code), &return_value, (void**)argv);
- // FIXME
+ // FIXME: multiple values
return [NSArray arrayWithObject:nullify(return_value)];
}
@@ -105,22 +108,27 @@
return [NSString stringWithFormat:@"<Compiled closure @%p>", self];
}
+-(id (*)()) code
+{
+ return _code;
+}
+
+-(void *) closureData
+{
+ return _data;
+}
+
-(void) dealloc
{
int i;
[super dealloc];
- // FIXME: Decrease refcount of *_code. Note: When releasing *_code,
- // also release _code regardless of whether we own it.
-
+ // FIXME: Decrease refcount of _code.
for (i = 0; i < _dataLength; i++)
{
LRELEASE (_data[i]);
}
free (_data);
-
- if (_ownPointer)
- free (_code);
}
@end
diff --git a/MLKForm.m b/MLKForm.m
index e78a790..a5bebe5 100644
--- a/MLKForm.m
+++ b/MLKForm.m
@@ -292,7 +292,20 @@
-(id) complete
{
self = [super complete];
- LASSIGN (_argumentForms, [_tail array]);
+
+ id rest;
+ NSMutableArray *argumentForms = [NSMutableArray array];
+
+ rest = [_form cdr];
+ while (rest)
+ {
+ [argumentForms addObject:[MLKForm formWithObject:[rest car]
+ inContext:_context
+ forCompiler:_compiler]];
+ rest = [rest cdr];
+ }
+
+ LASSIGN (_argumentForms, argumentForms);
return self;
}
diff --git a/MLKInterpreter.m b/MLKInterpreter.m
index 42d22ed..693c742 100644
--- a/MLKInterpreter.m
+++ b/MLKInterpreter.m
@@ -1320,7 +1320,6 @@
NSString *formdesc;
NSAutoreleasePool *pool;
- //NSLog (@"%@", code);
//NSLog (@"%@", MLKPrintToString(code));
//NSLog (@"%@", stream);
//NSLog (@"...");
@@ -1328,9 +1327,9 @@
pool = [[NSAutoreleasePool alloc] init];
code = [MLKReader readFromStream:stream
- eofError:NO
- eofValue:eofValue
- recursive:NO
+ eofError:NO
+ eofValue:eofValue
+ recursive:NO
preserveWhitespace:NO];
if (code == eofValue)
diff --git a/MLKLLVMCompiler.h b/MLKLLVMCompiler.h
index 7a38679..379d791 100644
--- a/MLKLLVMCompiler.h
+++ b/MLKLLVMCompiler.h
@@ -53,6 +53,14 @@ using namespace llvm;
onObject:(Value *)object
withArgumentVector:(std::vector<Value*> *)argv
name:(NSString *)name;
++(Value *) insertMethodCall:(NSString *)messageName
+ onObject:(Value *)object
+ withArgumentVector:(std::vector<Value*> *)argv
+ name:(NSString *)name
+ returnType:(const Type *)returnType;
++(Value *) insertVoidMethodCall:(NSString *)messageName
+ onObject:(Value *)object
+ withArgumentVector:(std::vector<Value*> *)argv;
+(Value *) insertMethodCall:(NSString *)messageName
onObject:(Value *)object;
@@ -61,6 +69,8 @@ using namespace llvm;
withName:(NSString *)name;
+(Value *) insertClassLookup:(NSString *)className;
+
++(void) insertTrace:(NSString *)message;
#endif
@end
diff --git a/MLKLLVMCompiler.mm b/MLKLLVMCompiler.mm
index 3ad0c10..4313ac9 100644
--- a/MLKLLVMCompiler.mm
+++ b/MLKLLVMCompiler.mm
@@ -35,6 +35,8 @@
#include <llvm/Support/IRBuilder.h>
#include <llvm/Target/TargetData.h>
#include <llvm/Transforms/Scalar.h>
+#include <llvm/Transforms/IPO.h>
+#include <llvm/Transforms/Utils/UnifyFunctionExitNodes.h>
#include <llvm/Value.h>
#include <deque>
@@ -45,7 +47,7 @@ using namespace llvm;
static ExecutionEngine *execution_engine;
static llvm::Module *module;
-static IRBuilder builder;
+static IRBuilder<true, ConstantFolder> builder;
static FunctionPassManager *fpm;
static PointerType *PointerTy;
static ModuleProvider *module_provider;
@@ -78,10 +80,21 @@ static Constant
module_provider = new ExistingModuleProvider (module);
fpm = new FunctionPassManager (module_provider);
fpm->add (new TargetData (*execution_engine->getTargetData()));
+ //fpm->add (new TargetData (module));
fpm->add (createInstructionCombiningPass());
fpm->add (createReassociatePass());
fpm->add (createGVNPass());
+ // fpm->add (createVerifierPass());
+ //fpm->add (createLowerSetJmpPass());
+ //fpm->add (createRaiseAllocationsPass());
fpm->add (createCFGSimplificationPass());
+ fpm->add (createPromoteMemoryToRegisterPass());
+ //fpm->add (createGlobalOptimizerPass());
+ //fpm->add (createGlobalDCEPass());
+ //fpm->add (createFunctionInliningPass());
+
+ // Utilities.
+ // fpm->add (createUnifyFunctionExitNodesPass());
}
+(id) compile:(id)object
@@ -108,16 +121,19 @@ static Constant
forCompiler:self]];
builder.CreateRet (v);
- function->dump();
verifyFunction (*function);
fpm->run (*function);
// JIT-compile.
fn = (id (*)()) execution_engine->getPointerToFunction (function);
+ module->dump();
+ NSLog (@"%p", fn);
// Execute.
lambdaForm = fn();
+ NSLog (@"Closure built.");
+
return lambdaForm;
}
@@ -169,23 +185,53 @@ static Constant
name:@""];
}
++(Value *) insertVoidMethodCall:(NSString *)messageName
+ onObject:(Value *)object
+ withArgumentVector:(std::vector<Value*> *)argv
+{
+ return [self insertMethodCall:messageName
+ onObject:object
+ withArgumentVector:argv
+ name:@""
+ returnType:(Type::VoidTy)];
+}
+
++(Value *) insertMethodCall:(NSString *)messageName
+ onObject:(Value *)object
+ withArgumentVector:(std::vector<Value*> *)argv
+ name:(NSString *)name
+{
+ return [self insertMethodCall:messageName
+ onObject:object
+ withArgumentVector:argv
+ name:@""
+ returnType:PointerTy];
+}
+
+(Value *) insertMethodCall:(NSString *)messageName
onObject:(Value *)object
withArgumentVector:(std::vector<Value*> *)argv
- name:(NSString *)name;
+ name:(NSString *)name
+ returnType:(const Type *)returnType
{
std::vector <const Type *> argtypes (2, PointerTy);
- FunctionType *ftype = FunctionType::get (PointerTy, argtypes, true);
- Constant *function =
- module->getOrInsertFunction (
+ FunctionType *ftype = FunctionType::get (returnType, argtypes, true);
+
+ Value *sel = [self insertSelectorLookup:messageName];
+
#ifdef __NEXT_RUNTIME__
- "objc_msgSend",
+ Constant *function =
+ module->getOrInsertFunction ("objc_msgSend", ftype);
#else
- "objc_msg_send",
+ std::vector <const Type *> lookup_argtypes (2, PointerTy);
+ FunctionType *lookup_ftype = FunctionType::get (PointerType::get (ftype, 0),
+ lookup_argtypes,
+ false);
+ Constant *lookup_function =
+ module->getOrInsertFunction ("objc_msg_lookup", lookup_ftype);
+ Value *function =
+ builder.CreateCall2 (lookup_function, object, sel, "method_impl");
#endif
- ftype);
-
- Value *sel = [self insertSelectorLookup:messageName];
// XXX The following doesn't work. Why?
// std::deque <Value *> argd (*argv);
@@ -240,6 +286,17 @@ static Constant
Constant *nameptr = createGlobalStringPtr (cname);
return builder.CreateCall (function, nameptr, cname);
}
+
++(void) insertTrace:(NSString *)message
+{
+ Constant *function =
+ module->getOrInsertFunction ("puts",
+ Type::Int32Ty,
+ PointerTy,
+ NULL);
+
+ builder.CreateCall (function, createGlobalStringPtr ([message UTF8String]));
+}
@end
@@ -309,12 +366,12 @@ static Constant
if ([_context variableHeapAllocationForSymbol:_form])
{
- Value *binding = builder.CreateLoad ([_context bindingForSymbol:_form]);
+ Value *binding = builder.CreateLoad ([_context bindingValueForSymbol:_form]);
value = [_compiler insertMethodCall:@"value" onObject:binding];
}
else
{
- value = builder.CreateLoad ([_context valueForSymbol:_form],
+ value = builder.CreateLoad ([_context valueValueForSymbol:_form],
[MLKPrintToString(_form) UTF8String]);
}
@@ -332,15 +389,16 @@ static Constant
// XXX Issue a style warning.
}
- Value *functionCell = builder.CreateLoad ([_context functionCellForSymbol:_head]);
+ Value *functionCell = builder.Insert ([_context functionCellValueForSymbol:_head]);
Value *functionPtr = builder.CreateLoad (functionCell);
- Value *closureDataPointer = builder.CreateLoad ([_context closureDataPointerForSymbol:_head]);
+ Value *closureDataCell = builder.Insert ([_context closureDataPointerValueForSymbol:_head]);
+ Value *closureDataPtr = builder.CreateLoad (closureDataCell);
NSEnumerator *e = [_argumentForms objectEnumerator];
MLKForm *form;
std::vector<Value *> args;
- args.push_back (closureDataPointer);
+ args.push_back (closureDataPtr);
while ((form = [e nextObject]))
{
@@ -382,6 +440,8 @@ static Constant
BasicBlock *loopBlock = BasicBlock::Create ("load_args");
BasicBlock *loopInitBlock = BasicBlock::Create ("load_args_prelude");
BasicBlock *joinBlock = BasicBlock::Create ("function_body");
+ BasicBlock *lambdaListNewBlock = BasicBlock::Create ("lambda_list_new");
+ BasicBlock *lambdaListUpdateBlock = BasicBlock::Create ("lambda_list_update");
builder.SetInsertPoint (initBlock);
@@ -398,13 +458,14 @@ static Constant
NULL),
ap);
- Value *nsmutablearray = [_compiler insertClassLookup:@"NSMutableArray"];
Value *mlkcons = [_compiler insertClassLookup:@"MLKCons"];
+
+ // FIXME: Heap-allocate if appropriate.
Value *lambdaList = builder.CreateAlloca (PointerTy, NULL, "lambda_list");
+ Value *lambdaListTail = builder.CreateAlloca (PointerTy, NULL, "lambda_list_tail");
- builder.CreateStore ([_compiler insertMethodCall:@"array"
- onObject:nsmutablearray],
- lambdaList);
+ builder.CreateStore (ConstantPointerNull::get (PointerTy), lambdaList);
+ builder.CreateStore (ConstantPointerNull::get (PointerTy), lambdaListTail);
builder.CreateBr (loopInitBlock);
builder.SetInsertPoint (loopInitBlock);
@@ -416,13 +477,35 @@ static Constant
builder.SetInsertPoint (loopBlock);
function->getBasicBlockList().push_back (loopBlock);
+ builder.CreateCondBr (builder.CreateICmpEQ (builder.CreateLoad (lambdaList),
+ ConstantPointerNull::get (PointerTy)),
+ lambdaListNewBlock,
+ lambdaListUpdateBlock);
+
+ builder.SetInsertPoint (lambdaListNewBlock);
+ function->getBasicBlockList().push_back (lambdaListNewBlock);
std::vector <Value *> argv (1, arg);
- builder.CreateStore ([_compiler insertMethodCall:@"addObject:"
- onObject:builder.CreateLoad(lambdaList)
- withArgumentVector:&argv],
- lambdaList);
+ argv.push_back (ConstantPointerNull::get (PointerTy));
+ Value *newLambdaList = [_compiler insertMethodCall:@"cons:with:"
+ onObject:mlkcons
+ withArgumentVector:&argv];
+ builder.CreateStore (newLambdaList, lambdaList);
+ builder.CreateStore (newLambdaList, lambdaListTail);
+ builder.CreateBr (loopInitBlock);
+ builder.SetInsertPoint (lambdaListUpdateBlock);
+ function->getBasicBlockList().push_back (lambdaListUpdateBlock);
+
+ Value *newCons = [_compiler insertMethodCall:@"cons:with:"
+ onObject:mlkcons
+ withArgumentVector:&argv];
+ std::vector <Value *> setcdr_argv (1, newCons);
+ [_compiler insertVoidMethodCall:@"setCdr:"
+ onObject:builder.CreateLoad(lambdaListTail)
+ withArgumentVector:&setcdr_argv];
+ builder.CreateStore (newCons, lambdaListTail);
builder.CreateBr (loopInitBlock);
+
builder.SetInsertPoint (joinBlock);
function->getBasicBlockList().push_back (joinBlock);
@@ -432,12 +515,6 @@ static Constant
NULL),
ap);
- argv[0] = builder.CreateLoad(lambdaList);
- builder.CreateStore ([_compiler insertMethodCall:@"listWithArray:"
- onObject:mlkcons
- withArgumentVector:&argv],
- lambdaList);
-
NSEnumerator *e = [_bodyForms objectEnumerator];
MLKForm *form;
Value *value = NULL;
@@ -451,26 +528,31 @@ static Constant
while ((form = [e nextObject]))
{
//NSLog (@"%LAMBDA: Processing subform.");
+ [form->_context setValueValue:lambdaList forSymbol:_lambdaListName];
value = [form processForLLVM];
}
builder.CreateRet (value);
function->dump();
- NSLog (@"Verify...");
+ //NSLog (@"Verify...");
verifyFunction (*function);
- NSLog (@"Optimise...");
+ //NSLog (@"Optimise...");
fpm->run (*function);
- NSLog (@"Done.");
+ //NSLog (@"Assemble...");
+ // Explicit assembly is needed in order to allow libffi to call
+ // the function.
+ execution_engine->getPointerToFunction (function);
+ //NSLog (@"Done.");
function->dump();
- NSLog (@"Function built.");
+ //NSLog (@"Function built.");
builder.SetInsertPoint (outerBlock);
Value *closure_data = ConstantPointerNull::get (PointerTy);
argv[0] = function;
- argv.push_back (closure_data);
+ argv[1] = closure_data;
argv.push_back (builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
0,
false),
@@ -482,6 +564,8 @@ static Constant
onObject:mlkcompiledclosure
withArgumentVector:&argv];
+ //function->viewCFG();
+
return closure;
}
@end
diff --git a/MLKLexicalContext-MLKLLVMCompilation.h b/MLKLexicalContext-MLKLLVMCompilation.h
index 0e9056b..d42140e 100644
--- a/MLKLexicalContext-MLKLLVMCompilation.h
+++ b/MLKLexicalContext-MLKLLVMCompilation.h
@@ -26,6 +26,7 @@
#include <vector>
#include <llvm/Value.h>
#include <llvm/BasicBlock.h>
+#include <llvm/Instructions.h>
using namespace llvm;
#endif
@@ -34,13 +35,13 @@ using namespace llvm;
#ifdef __cplusplus
-(void) setVariableHeapAllocation:(BOOL)heapp forSymbol:(id)name;
-(BOOL) variableHeapAllocationForSymbol:(id)name;
--(Value *) functionCellForSymbol:(id)name;
--(Value *) closureDataPointerForSymbol:(id)name;
--(Value *) bindingForSymbol:(id)name;
--(Value *) valueForSymbol:(id)name;
--(void) setFunctionCell:(Value *)cellPtr forSymbol:(id)name;
--(void) setClosureDataPointer:(Value *)pointer forSymbol:(id)name;
--(void) setBinding:(Value *)binding forSymbol:(id)name;
--(void) setValue:(Value *)value forSymbol:(id)name;
+-(Instruction *) functionCellValueForSymbol:(id)name;
+-(Instruction *) closureDataPointerValueForSymbol:(id)name;
+-(Value *) bindingValueForSymbol:(id)name;
+-(Value *) valueValueForSymbol:(id)name;
+//-(void) setFunctionCellValue:(Value *)cellPtr forSymbol:(id)name;
+//-(void) setClosureDataPointerValue:(Value *)pointer forSymbol:(id)name;
+//-(void) setBindingValue:(Value *)binding forSymbol:(id)name;
+-(void) setValueValue:(Value *)value forSymbol:(id)name;
#endif
@end
diff --git a/MLKLexicalContext-MLKLLVMCompilation.mm b/MLKLexicalContext-MLKLLVMCompilation.mm
index 8be1f24..744351a 100644
--- a/MLKLexicalContext-MLKLLVMCompilation.mm
+++ b/MLKLexicalContext-MLKLLVMCompilation.mm
@@ -22,8 +22,11 @@
#import <Foundation/NSValue.h>
#include <vector>
-#include <llvm/Value.h>
#include <llvm/BasicBlock.h>
+#include <llvm/Constants.h>
+#include <llvm/DerivedTypes.h>
+#include <llvm/Instructions.h>
+#include <llvm/Value.h>
using namespace llvm;
using namespace std;
@@ -45,56 +48,65 @@ using namespace std;
return (flag && [flag boolValue]);
}
--(Value *) functionCellForSymbol:(id)name
+-(Instruction *) functionCellValueForSymbol:(id)name
{
- return (Value *) [[self deepPropertyForFunction:name
- key:@"LLVM.function-cell"]
- pointerValue];
+ std::vector<const Type *> types (1, PointerType::get(Type::Int8Ty, 0));
+ return (new IntToPtrInst (ConstantInt::get(Type::Int64Ty,
+ (uint64_t)[self functionCellForSymbol:name],
+ false),
+ PointerType::get(PointerType::get(FunctionType::get(PointerType::get(Type::Int8Ty,
+ 0),
+ types,
+ true),
+ 0),
+ 0)));
}
--(Value *) closureDataPointerForSymbol:(id)name
+-(Instruction *) closureDataPointerValueForSymbol:(id)name
{
- return (Value *) [[self deepPropertyForFunction:name
- key:@"LLVM.closure-data-pointer"]
- pointerValue];
+ return (new IntToPtrInst (ConstantInt::get(Type::Int64Ty,
+ (uint64_t)[self closureDataPointerForSymbol:name],
+ false),
+ PointerType::get(PointerType::get(Type::Int8Ty, 0), 0)));
}
--(Value *) bindingForSymbol:(id)name
+-(Value *) bindingValueForSymbol:(id)name
{
- return (Value *) [[self deepPropertyForVariable:name
- key:@"LLVM.variable-binding"]
- pointerValue];
+ return (new IntToPtrInst (ConstantInt::get(Type::Int64Ty,
+ (uint64_t)[self bindingForSymbol:name],
+ false),
+ PointerType::get(Type::Int8Ty, 0)));
}
--(Value *) valueForSymbol:(id)name
+-(Value *) valueValueForSymbol:(id)name
{
return (Value *) [[self deepPropertyForVariable:name
key:@"LLVM.variable-value"]
pointerValue];
}
--(void) setFunctionCell:(Value *)cellPtr forSymbol:(id)name
-{
- [self setDeepProperty:[NSValue valueWithPointer:cellPtr]
- forFunction:name
- key:@"LLVM.function-cell"];
-}
+// -(void) setFunctionCellValue:(Value *)cellPtr forSymbol:(id)name
+// {
+// [self setDeepProperty:[NSValue valueWithPointer:cellPtr]
+// forFunction:name
+// key:@"LLVM.function-cell"];
+// }
--(void) setClosureDataPointer:(Value *)pointer forSymbol:(id)name
-{
- [self setDeepProperty:[NSValue valueWithPointer:pointer]
- forFunction:name
- key:@"LLVM.closure-data"];
-}
+// -(void) setClosureDataPointerValue:(Value *)pointer forSymbol:(id)name
+// {
+// [self setDeepProperty:[NSValue valueWithPointer:pointer]
+// forFunction:name
+// key:@"LLVM.closure-data"];
+// }
--(void) setBinding:(Value *)binding forSymbol:(id)name
-{
- [self setDeepProperty:[NSValue valueWithPointer:binding]
- forVariable:name
- key:@"LLVM.variable-binding"];
-}
+// -(void) setBindingValue:(Value *)binding forSymbol:(id)name
+// {
+// [self setDeepProperty:[NSValue valueWithPointer:binding]
+// forVariable:name
+// key:@"LLVM.variable-binding"];
+// }
--(void) setValue:(Value *)value forSymbol:(id)name
+-(void) setValueValue:(Value *)value forSymbol:(id)name
{
[self setDeepProperty:[NSValue valueWithPointer:value]
forVariable:name
diff --git a/MLKLexicalContext.h b/MLKLexicalContext.h
index de6bfd7..fc2abc3 100644
--- a/MLKLexicalContext.h
+++ b/MLKLexicalContext.h
@@ -105,5 +105,9 @@
forFunction:(id)name
key:(id)key;
+-(void *) functionCellForSymbol:(id)name;
+-(void *) closureDataPointerForSymbol:(id)name;
+-(id) bindingForSymbol:(id)name;
+
-(void) dealloc;
@end
diff --git a/MLKLexicalContext.m b/MLKLexicalContext.m
index d051b2a..1eaa51c 100644
--- a/MLKLexicalContext.m
+++ b/MLKLexicalContext.m
@@ -22,6 +22,7 @@
#import <Foundation/NSNull.h>
#import <Foundation/NSSet.h>
#import <Foundation/NSString.h>
+#import <Foundation/NSValue.h>
#import "MLKCons.h"
#import "MLKDynamicContext.h"
@@ -358,6 +359,62 @@ static MLKSymbol *LEXICAL;
}
}
+-(void *) functionCellForSymbol:(id)name
+{
+ id prop = [self deepPropertyForFunction:name
+ key:@"LEXCTX.function-cell"];
+
+ if (!prop)
+ {
+ void *cell = malloc (sizeof(id (*)()));
+ prop = [NSValue valueWithPointer:cell];
+ [self setDeepProperty:prop
+ forFunction:name
+ key:@"LEXCTX.function-cell"];
+ return cell;
+ }
+ else
+ {
+ return [prop pointerValue];
+ }
+}
+
+-(void *) closureDataPointerForSymbol:(id)name
+{
+ id prop = [self deepPropertyForFunction:name
+ key:@"LEXCTX.closure-data"];
+
+ if (!prop)
+ {
+ void *cell = malloc (sizeof(id (*)()));
+ prop = [NSValue valueWithPointer:cell];
+ [self setDeepProperty:prop
+ forFunction:name
+ key:@"LEXCTX.closure-data"];
+ return cell;
+ }
+ else
+ {
+ return [prop pointerValue];
+ }
+}
+
+-(id) bindingForSymbol:(id)name
+{
+ id prop = [self deepPropertyForVariable:name
+ key:@"LEXCTX.variable-binding"];
+
+ if (!prop)
+ {
+ prop = [MLKBinding binding];
+ [self setDeepProperty:prop
+ forVariable:name
+ key:@"LEXCTX.variable-binding"];
+ }
+
+ return prop;
+}
+
-(void) dealloc
{
LRELEASE (_macros);
diff --git a/MLKLexicalEnvironment.m b/MLKLexicalEnvironment.m
index fbeb9aa..ca6b4a9 100644
--- a/MLKLexicalEnvironment.m
+++ b/MLKLexicalEnvironment.m
@@ -24,8 +24,10 @@
#import <Foundation/NSString.h>
#import <Foundation/NSThread.h>
+#import "MLKCompiledClosure.h"
#import "MLKCons.h"
#import "MLKEnvironment.h"
+#import "MLKLexicalContext.h"
#import "MLKLexicalEnvironment.h"
#import "MLKPackage.h"
#import "MLKParenReader.h"
@@ -141,11 +143,61 @@ static MLKLexicalEnvironment *global_environment;
-(void) setFunction:(id)value forSymbol:(MLKSymbol *)symbol
{
[_functions setValue:value forSymbol:symbol];
+
+ if ([_functions environmentForSymbol:symbol] == global_environment->_functions)
+ {
+ // If we're changing the global environment, we need to
+ // interoperate with compiled code. In this case, be sure to set
+ // the global function cell.
+ //
+ // Note that this reserves memory for the function cell that is
+ // never freed, which is why we do it for global function bindings
+ // only!
+ id (**cell)(void *, ...) = [[MLKLexicalContext globalContext]
+ functionCellForSymbol:symbol];
+ void **closure_data_cell = [[MLKLexicalContext globalContext]
+ closureDataPointerForSymbol:symbol];
+ if ([value isKindOfClass:[MLKCompiledClosure class]])
+ {
+ *cell = (id (*)(void *, ...))[value code];
+ *closure_data_cell = [value closureData];
+ }
+ else
+ {
+ *cell = MLKInterpretedFunctionTrampoline;
+ *closure_data_cell = value;
+ }
+ }
}
-(void) addFunction:(id)value forSymbol:(MLKSymbol *)symbol
{
[_functions addValue:value forSymbol:symbol];
+
+ if (self == global_environment)
+ {
+ // If we're changing the global environment, we need to
+ // interoperate with compiled code. In this case, be sure to set
+ // the global function cell.
+ //
+ // Note that this reserves memory for the function cell that is
+ // never freed, which is why we do it for global function bindings
+ // only!
+ id (**cell)(void *, ...) = [[MLKLexicalContext globalContext]
+ functionCellForSymbol:symbol];
+ void **closure_data_cell = [[MLKLexicalContext globalContext]
+ closureDataPointerForSymbol:symbol];
+ if ([value isKindOfClass:[MLKCompiledClosure class]])
+ {
+ *cell = (id (*)(void *, ...))[value code];
+ *closure_data_cell = [value closureData];
+ }
+ else
+ {
+ *cell = MLKInterpretedFunctionTrampoline;
+ *closure_data_cell = value;
+ }
+ }
}
-(BOOL) fboundp:(MLKSymbol *)symbol
diff --git a/MLKPackage.m b/MLKPackage.m
index a05f822..acaf6db 100644
--- a/MLKPackage.m
+++ b/MLKPackage.m
@@ -154,6 +154,7 @@ static NSMutableDictionary *packages = nil;
[sys export:[sys intern:@"FIXNUM-EQ"]];
[sys export:[sys intern:@"DECLARATIONS-AND-DOC-AND-FORMS"]];
[sys export:[sys intern:@"DECLARATIONS-AND-FORMS"]];
+ [sys export:[sys intern:@"COMPILE"]];
[sys export:[sys intern:@"OBJC-CLASS-OF"]];
[sys export:[sys intern:@"OBJC-SUBCLASSP"]];
diff --git a/MLKRoot.m b/MLKRoot.m
index 940181c..b051dd3 100644
--- a/MLKRoot.m
+++ b/MLKRoot.m
@@ -22,6 +22,7 @@
#import "MLKDynamicContext.h"
#import "MLKInterpretedClosure.h"
#import "MLKInterpreter.h"
+#import "MLKLLVMCompiler.h"
#import "MLKNumber.h"
#import "MLKPackage.h"
#import "MLKRoot.h"
@@ -702,4 +703,16 @@ as provided by method %@ of object %@",
cons:forms
with:nil]]);
}
+
+#ifdef USE_LLVM
++(NSArray *) compile:(NSArray *)args
+{
+ NSLog (@"Compiling lambda form.");
+ id thing = [MLKLLVMCompiler compile:denullify([args objectAtIndex:0])
+ inContext:[MLKLexicalContext globalContext]];
+ NSLog (@"Compilation done.");
+ NSLog (@"Compiled: %@", thing);
+ RETURN_VALUE (thing);
+}
+#endif
@end
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 05:20:58 +0000