%FSET, %FSETQ: Set global function bindings in a way that compiled code can understand.

6 files changed, 165 insertions, 46 deletions

diff --git a/MLKLLVMCompiler.mm b/MLKLLVMCompiler.mm
index 969d12c..e9507a9 100644
--- a/MLKLLVMCompiler.mm
+++ b/MLKLLVMCompiler.mm
@@ -366,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]);
     }
 
@@ -389,9 +389,9 @@ static Constant
       // XXX Issue a style warning.
     }
 
-  Value *functionCell = builder.CreateLoad ([_context functionCellForSymbol:_head]);
+  Value *functionCell = builder.CreateLoad ([_context functionCellValueForSymbol:_head]);
   Value *functionPtr = builder.CreateLoad (functionCell);
-  Value *closureDataCell = builder.CreateLoad ([_context closureDataPointerForSymbol:_head]);
+  Value *closureDataCell = builder.CreateLoad ([_context closureDataPointerValueForSymbol:_head]);
   Value *closureDataPtr = builder.CreateLoad (closureDataCell);
 
   NSEnumerator *e = [_argumentForms objectEnumerator];
@@ -528,7 +528,7 @@ static Constant
   while ((form = [e nextObject]))
     {
       //NSLog (@"%LAMBDA: Processing subform.");
-      [form->_context setValue:lambdaList forSymbol:_lambdaListName];
+      [form->_context setValueValue:lambdaList forSymbol:_lambdaListName];
       value = [form processForLLVM];
     }
 
diff --git a/MLKLexicalContext-MLKLLVMCompilation.h b/MLKLexicalContext-MLKLLVMCompilation.h
index 0e9056b..eaae1f3 100644
--- a/MLKLexicalContext-MLKLLVMCompilation.h
+++ b/MLKLexicalContext-MLKLLVMCompilation.h
@@ -34,13 +34,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;
+-(Value *) functionCellValueForSymbol:(id)name;
+-(Value *) 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..2ff7ec0 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,59 @@ using namespace std;
   return (flag && [flag boolValue]);
 }
 
--(Value *) functionCellForSymbol:(id)name
+-(Value *) functionCellValueForSymbol:(id)name
 {
-  return (Value *) [[self deepPropertyForFunction:name
-                          key:@"LLVM.function-cell"]
-                     pointerValue];
+  return (new IntToPtrInst (ConstantInt::get(Type::Int64Ty,
+                                             (uint64_t)[self functionCellForSymbol:name],
+                                             false),
+                            PointerType::get(Type::Int8Ty, 0)));
 }
 
--(Value *) closureDataPointerForSymbol:(id)name
+-(Value *) 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(Type::Int8Ty, 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