Merge /home/mulk/Dropbox/Projekte/Toilet Lisp

1 files changed, 112 insertions, 36 deletions

diff --git a/MLKLLVMCompiler.mm b/MLKLLVMCompiler.mm
index 84fc6af..9f273cf 100644
--- a/MLKLLVMCompiler.mm
+++ b/MLKLLVMCompiler.mm
@@ -57,8 +57,10 @@
 
 #include <stddef.h>
 #ifdef MACOSX
-#include <objc/runtime.h>
 #include <objc/objc-api.h>
+#if defined(OBJC_API_VERSION) && OBJC_API_VERSION >= 2
+#include <objc/runtime.h>
+#endif
 #endif
 
 using namespace llvm;
@@ -225,7 +227,7 @@ static Constant
 
 +(Value *) processForm:(MLKForm *)form
 {
-  return [form processForLLVM];
+  return [form processForLLVMWithMultiValue:NULL];
 }
 
 +(void) markVariablesForHeapAllocationInForm:(MLKForm *)form
@@ -412,7 +414,7 @@ static Constant
 
 
 @implementation MLKForm (MLKLLVMCompilation)
--(Value *) processForLLVM
+-(Value *) processForLLVMWithMultiValue:(Value *)multiValue
 {
 #if 0
   [_compiler insertTrace:
@@ -420,7 +422,7 @@ static Constant
                            @"Executing: %@", MLKPrintToString(_form)]];
 #endif
 
-  Value *result = [self reallyProcessForLLVM];
+  Value *result = [self reallyProcessForLLVMWithMultiValue:multiValue];
 
 #if 0
   [_compiler insertTrace:
@@ -431,7 +433,7 @@ static Constant
   return result;
 }
 
--(Value *) reallyProcessForLLVM
+-(Value *) reallyProcessForLLVMWithMultiValue:(Value *)multiValue
 {
   NSLog (@"WARNING: Unrecognised form type: %@", self);
   return NULL;
@@ -440,15 +442,21 @@ static Constant
 
 
 @implementation MLKProgNForm (MLKLLVMCompilation)
--(Value *) reallyProcessForLLVM
+-(Value *) reallyProcessForLLVMWithMultiValue:(Value *)multiValue
 {
   NSEnumerator *e = [_bodyForms objectEnumerator];
   MLKForm *form;
   Value *value = ConstantPointerNull::get (VoidPointerTy);
+  int i;
 
+  i = 0;
   while ((form = [e nextObject]))
     {
-      value = [form processForLLVM];
+      i++;
+      if (i == [_bodyForms count])
+        value = [form processForLLVMWithMultiValue:multiValue];
+      else
+        value = [form processForLLVMWithMultiValue:NULL];
     }
 
   return value;
@@ -457,7 +465,7 @@ static Constant
 
 
 @implementation MLKSimpleLoopForm (MLKLLVMCompilation)
--(Value *) reallyProcessForLLVM
+-(Value *) reallyProcessForLLVMWithMultiValue:(Value *)multiValue
 {
   NSEnumerator *e = [_bodyForms objectEnumerator];
   MLKForm *form;
@@ -472,7 +480,7 @@ static Constant
 
   while ((form = [e nextObject]))
     {
-      [form processForLLVM];
+      [form processForLLVMWithMultiValue:NULL];
     }
 
   builder.CreateBr (loopBlock);
@@ -487,7 +495,7 @@ static Constant
 
 
 @implementation MLKSymbolForm (MLKLLVMCompilation)
--(Value *) reallyProcessForLLVM
+-(Value *) reallyProcessForLLVMWithMultiValue:(Value *)multiValue
 {
   Value *value;
 
@@ -535,7 +543,7 @@ static Constant
 
 
 @implementation MLKFunctionCallForm (MLKLLVMCompilation)
--(Value *) reallyProcessForLLVM
+-(Value *) reallyProcessForLLVMWithMultiValue:(Value *)multiValue
 {
   Value *functionPtr;
   Value *closureDataPtr;
@@ -580,7 +588,7 @@ static Constant
       Value *code = builder.CreateLoad (codeptr, "closure_code");
       Value *data = builder.CreateLoad (dataptr, "closure_data");
 
-      std::vector<const Type *> types (1, PointerPointerTy);
+      std::vector<const Type *> types (2, PointerPointerTy);
       functionPtr = builder.CreateBitCast (code, PointerType::get(FunctionType::get(VoidPointerTy,
                                                                                     types,
                                                                                     true),
@@ -592,13 +600,17 @@ static Constant
   //[_compiler insertPointerTrace:functionPtr];
 
   args.push_back (closureDataPtr);
+  if (multiValue)
+    args.push_back (multiValue);
+  else
+    args.push_back (ConstantPointerNull::get (PointerPointerTy));
 
   NSEnumerator *e = [_argumentForms objectEnumerator];
   MLKForm *form;
 
   while ((form = [e nextObject]))
     {
-      args.push_back ([form processForLLVM]);
+      args.push_back ([form processForLLVMWithMultiValue:NULL]);
     }
 
   //GlobalVariable *endmarker = module->getGlobalVariable ("MLKEndOfArgumentsMarker", false);
@@ -647,7 +659,7 @@ build_simple_function_definition (MLKBodyForm *processed_form,
   MLKLexicalContext *_context = [processed_form context];
   id _compiler = [MLKLLVMCompiler class];
 
-  vector <const Type *> argtypes (1, PointerPointerTy);
+  vector <const Type *> argtypes (2, PointerPointerTy);
   FunctionType *ftype = FunctionType::get (VoidPointerTy, argtypes, true);
   function = Function::Create (ftype,
                                Function::InternalLinkage,
@@ -657,6 +669,9 @@ build_simple_function_definition (MLKBodyForm *processed_form,
   Function::arg_iterator args = function->arg_begin();
   Value *closure_data_arg = args++;
   closure_data_arg->setName ("closure_data");
+  
+  Value *functionMultiValue = args++;
+  functionMultiValue->setName ("function_multiple_value_return_pointer");
 
   BasicBlock *outerBlock = builder.GetInsertBlock ();
   BasicBlock *initBlock = BasicBlock::Create ("init_function", function);
@@ -801,10 +816,14 @@ build_simple_function_definition (MLKBodyForm *processed_form,
       value = ConstantPointerNull::get (VoidPointerTy);
     }
 
+  i = 0;
   while ((form = [e nextObject]))
     {
-      //NSLog (@"%LAMBDA: Processing subform.");
-      value = [form processForLLVM];
+      i++;
+      if (i == [_bodyForms count])
+        value = [form processForLLVMWithMultiValue:functionMultiValue];
+      else
+        value = [form processForLLVMWithMultiValue:NULL];
     }
 
   builder.CreateRet (value);
@@ -828,7 +847,7 @@ build_simple_function_definition (MLKBodyForm *processed_form,
 
 
 @implementation MLKSimpleLambdaForm (MLKLLVMCompilation)
--(Value *) reallyProcessForLLVM
+-(Value *) reallyProcessForLLVMWithMultiValue:(Value *)multiValue
 {
   intptr_t closure_data_size;
   Function *function;
@@ -856,7 +875,7 @@ build_simple_function_definition (MLKBodyForm *processed_form,
 
 
 @implementation MLKLetForm (MLKLLVMCompilation)
--(Value *) reallyProcessForLLVM
+-(Value *) reallyProcessForLLVMWithMultiValue:(Value *)multiValue
 {
   NSEnumerator *e = [_variableBindingForms objectEnumerator];
   Value *value = ConstantPointerNull::get (VoidPointerTy);
@@ -865,7 +884,7 @@ build_simple_function_definition (MLKBodyForm *processed_form,
 
   while ((binding_form = [e nextObject]))
     {
-      Value *binding_value = [[binding_form valueForm] processForLLVM];
+      Value *binding_value = [[binding_form valueForm] processForLLVMWithMultiValue:NULL];
 
       if ([_bodyContext variableHeapAllocationForSymbol:[binding_form name]])
         {
@@ -890,10 +909,15 @@ build_simple_function_definition (MLKBodyForm *processed_form,
         }
     }
 
+  int i = 0;
   e = [_bodyForms objectEnumerator];
   while ((form = [e nextObject]))
     {
-      value = [form processForLLVM];
+      i++;
+      if (i == [_bodyForms count])
+        value = [form processForLLVMWithMultiValue:multiValue];
+      else
+        value = [form processForLLVMWithMultiValue:NULL];
     }
 
   return value;
@@ -902,12 +926,13 @@ build_simple_function_definition (MLKBodyForm *processed_form,
 
 
 @implementation MLKSimpleFletForm (MLKLLVMCompilation)
--(Value *) reallyProcessForLLVM
+-(Value *) reallyProcessForLLVMWithMultiValue:(Value *)multiValue
 {
   NSEnumerator *e = [_functionBindingForms objectEnumerator];
   Value *value = ConstantPointerNull::get (VoidPointerTy);
   MLKForm *form;
   MLKSimpleFunctionBindingForm *binding_form;
+  unsigned int i;
   
   while ((binding_form = [e nextObject]))
     {
@@ -941,11 +966,16 @@ build_simple_function_definition (MLKBodyForm *processed_form,
       [_bodyContext setFunctionBindingValue:binding
                                   forSymbol:[binding_form name]];
     }
-  
+
+  i = 0;
   e = [_bodyForms objectEnumerator];
   while ((form = [e nextObject]))
     {
-      value = [form processForLLVM];
+      i++;
+      if (i == [_bodyForms count])
+        value = [form processForLLVMWithMultiValue:multiValue];
+      else
+        value = [form processForLLVMWithMultiValue:NULL];
     }
   
   return value;
@@ -954,7 +984,7 @@ build_simple_function_definition (MLKBodyForm *processed_form,
 
 
 @implementation MLKQuoteForm (MLKLLVMCompilation)
--(Value *) reallyProcessForLLVM
+-(Value *) reallyProcessForLLVMWithMultiValue:(Value *)multiValue
 {
   // FIXME: When to release _quotedData?  At the same time the code is
   // released, probably...
@@ -975,7 +1005,7 @@ build_simple_function_definition (MLKBodyForm *processed_form,
 
 
 @implementation MLKSelfEvaluatingForm (MLKLLVMCompilation)
--(Value *) reallyProcessForLLVM
+-(Value *) reallyProcessForLLVMWithMultiValue:(Value *)multiValue
 {
   // FIXME: When to release _form?  At the same time the code is
   // released, probably...
@@ -996,25 +1026,25 @@ build_simple_function_definition (MLKBodyForm *processed_form,
 
 
 @implementation MLKIfForm (MLKLLVMCompilation)
--(Value *) reallyProcessForLLVM
+-(Value *) reallyProcessForLLVMWithMultiValue:(Value *)multiValue
 {
   Function *function = builder.GetInsertBlock()->getParent();
   BasicBlock *thenBlock = BasicBlock::Create ("if_then", function);
   BasicBlock *elseBlock = BasicBlock::Create ("if_else");
   BasicBlock *joinBlock = BasicBlock::Create ("if_join");
 
-  Value *test = builder.CreateICmpNE ([_conditionForm processForLLVM],
+  Value *test = builder.CreateICmpNE ([_conditionForm processForLLVMWithMultiValue:NULL],
                                       ConstantPointerNull::get (VoidPointerTy));
   Value *value = builder.CreateAlloca (VoidPointerTy, NULL, "if_result");
   builder.CreateCondBr (test, thenBlock, elseBlock);
 
   builder.SetInsertPoint (thenBlock);
-  builder.CreateStore ([_consequentForm processForLLVM], value);
+  builder.CreateStore ([_consequentForm processForLLVMWithMultiValue:multiValue], value);
   builder.CreateBr (joinBlock);
 
   builder.SetInsertPoint (elseBlock);
   function->getBasicBlockList().push_back (elseBlock);
-  builder.CreateStore ([_alternativeForm processForLLVM], value);
+  builder.CreateStore ([_alternativeForm processForLLVMWithMultiValue:multiValue], value);
   builder.CreateBr (joinBlock);
 
   builder.SetInsertPoint (joinBlock);
@@ -1026,7 +1056,7 @@ build_simple_function_definition (MLKBodyForm *processed_form,
 
 
 @implementation MLKSetQForm (MLKLLVMCompilation)
--(Value *) reallyProcessForLLVM
+-(Value *) reallyProcessForLLVMWithMultiValue:(Value *)multiValue
 {
   NSEnumerator *var_e, *value_e;
   MLKForm *valueForm;
@@ -1038,7 +1068,7 @@ build_simple_function_definition (MLKBodyForm *processed_form,
   while ((valueForm = [value_e nextObject]))
     {
       variable = [var_e nextObject];
-      value = [valueForm processForLLVM];
+      value = [valueForm processForLLVMWithMultiValue:NULL];
       if (![_context variableIsLexical:variable])
         {
           Value *mlkdynamiccontext = [_compiler insertClassLookup:@"MLKDynamicContext"];
@@ -1125,7 +1155,7 @@ build_simple_function_definition (MLKBodyForm *processed_form,
 
 
 @implementation MLKInPackageForm (MLKLLVMCompilation)
--(Value *) reallyProcessForLLVM
+-(Value *) reallyProcessForLLVMWithMultiValue:(Value *)multiValue
 {
   id package = [MLKPackage findPackage:stringify(_packageDesignator)];
 
@@ -1143,7 +1173,7 @@ build_simple_function_definition (MLKBodyForm *processed_form,
 
 
 @implementation MLKSimpleFunctionForm (MLKLLVMCompilation)
--(Value *) reallyProcessForLLVM
+-(Value *) reallyProcessForLLVMWithMultiValue:(Value *)multiValue
 {
   if ([_context functionIsGlobal:_functionName])
     {
@@ -1182,8 +1212,54 @@ build_simple_function_definition (MLKBodyForm *processed_form,
 
 
 @implementation MLKLambdaFunctionForm (MLKLLVMCompilation)
--(Value *) reallyProcessForLLVM
+-(Value *) reallyProcessForLLVMWithMultiValue:(Value *)multiValue
 {
-  return [_lambdaForm processForLLVM];
+  return [_lambdaForm processForLLVMWithMultiValue:multiValue];
 }
-@end
\ No newline at end of file
+@end
+
+
+@implementation MLKMultipleValueListForm (MLKLLVMCompilation)
+-(Value *) reallyProcessForLLVMWithMultiValue:(Value *)multiValue
+{
+  Value *endmarker = builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
+                                                              (uint64_t)MLKEndOfArgumentsMarker,
+                                                              false),
+                                             VoidPointerTy);
+  Value *multi_tmp = builder.CreateAlloca (VoidPointerTy, NULL);
+  builder.CreateStore (endmarker, multi_tmp);
+
+  Value *value = [_listForm processForLLVMWithMultiValue:multi_tmp];
+  Value *return_value = builder.CreateAlloca (VoidPointerTy, NULL);
+
+  Function *function = builder.GetInsertBlock()->getParent();
+  BasicBlock *singleValueBlock = BasicBlock::Create ("single_value_block", function);
+  BasicBlock *multipleValueBlock = BasicBlock::Create ("multiple_value_block");
+  BasicBlock *joinBlock = BasicBlock::Create ("join_block");
+
+  Value *multi_tmp_content = builder.CreateLoad (multi_tmp);
+  Value *isSingleValue = builder.CreateICmpEQ (multi_tmp_content, endmarker);
+  builder.CreateCondBr (isSingleValue, singleValueBlock, multipleValueBlock);
+
+  builder.SetInsertPoint (singleValueBlock);
+  Value *mlkcons = [_compiler insertClassLookup:@"MLKCons"];
+  vector <Value *> argv;
+  argv.push_back (value);
+  argv.push_back (ConstantPointerNull::get (VoidPointerTy));
+  Value *newList = [_compiler insertMethodCall:@"cons:with:"
+                                      onObject:mlkcons
+                            withArgumentVector:&argv];
+  builder.CreateStore (newList, return_value);
+  builder.CreateBr (joinBlock);
+
+  function->getBasicBlockList().push_back (multipleValueBlock);
+  builder.SetInsertPoint (multipleValueBlock);
+  builder.CreateStore (multi_tmp_content, return_value);
+  builder.CreateBr (joinBlock);
+
+  function->getBasicBlockList().push_back (joinBlock);
+  builder.SetInsertPoint (joinBlock);
+
+  return builder.CreateLoad (return_value);
+}
+@end