From c22d1dfba82475d19896c04bd1c217677a97ad6e Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <matthias@benkard.de>
Date: Sun, 17 Aug 2008 15:17:57 +0200
Subject: LLVM compiler: Support package TOILET-SYSTEM's intrinsic operations.

---
 MLKLLVMCompiler.mm | 55 +++++++++++++++++++++++++++++++++++++++++++++---------
 functions.h        |  3 ++-
 functions.m        | 28 ++++++++++++++++++++++++++-
 3 files changed, 75 insertions(+), 11 deletions(-)

diff --git a/MLKLLVMCompiler.mm b/MLKLLVMCompiler.mm
index 81aa764..aba2bf1 100644
--- a/MLKLLVMCompiler.mm
+++ b/MLKLLVMCompiler.mm
@@ -17,6 +17,7 @@
  */
 
 #import "MLKLLVMCompiler.h"
+#import "MLKPackage.h"
 #import "globals.h"
 #import "util.h"
 
@@ -381,23 +382,59 @@ static Constant
 @implementation MLKFunctionCallForm (MLKLLVMCompilation)
 -(Value *) processForLLVM
 {
+  static MLKPackage *sys = [MLKPackage findPackage:@"TOILET-SYSTEM"];
+
+  BOOL special_dispatch = NO;
+  Value *functionCell;
+  Value *functionPtr;
+  Value *closureDataCell;
+  Value *closureDataPtr;
+  std::vector<Value *> args;
+
   if (![_context symbolNamesFunction:_head])
     {
-      NSLog (@"Compiler: Don't know function %@", MLKPrintToString(_head));
-      // XXX Issue a style warning.
+      if (_head && [_head homePackage] == sys)
+        {
+          special_dispatch = YES;
+        }
+      else
+        {
+          NSLog (@"Compiler: Don't know function %@", MLKPrintToString(_head));
+          // XXX Issue a style warning.
+        }
     }
 
-  Value *functionCell = builder.Insert ([_context functionCellValueForSymbol:_head]);
-  Value *functionPtr = builder.CreateLoad (functionCell);
-  Value *closureDataCell = builder.Insert ([_context closureDataPointerValueForSymbol:_head]);
-  Value *closureDataPtr = builder.CreateLoad (closureDataCell);
+  if (!special_dispatch)
+    {
+      functionCell = builder.Insert ([_context functionCellValueForSymbol:_head]);
+      functionPtr = builder.CreateLoad (functionCell);
+      closureDataCell = builder.Insert ([_context closureDataPointerValueForSymbol:_head]);
+      closureDataPtr = builder.CreateLoad (closureDataCell);
+
+      args.push_back (closureDataPtr);
+    }
+  else
+    {
+      std::vector<const Type *> argtypes (1, PointerTy);
+      functionPtr = builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
+                                                             (uint64_t)MLKDispatchRootFunction,
+                                                             false),
+                                            PointerType::get (FunctionType::get (PointerTy,
+                                                                                 argtypes,
+                                                                                 true),
+                                                              0));
+      LRETAIN (_head); // FIXME: release sometime?  On the other hand,
+                       // these symbols will probably never be
+                       // deallocated anyway.
+      args.push_back (builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
+                                                               (uint64_t)_head,
+                                                               false),
+                                              PointerTy));
+    }
 
   NSEnumerator *e = [_argumentForms objectEnumerator];
   MLKForm *form;
 
-  std::vector<Value *> args;
-  args.push_back (closureDataPtr);
-
   while ((form = [e nextObject]))
     {
       args.push_back ([form processForLLVM]);
diff --git a/functions.h b/functions.h
index 8f3e70e..4ea8261 100644
--- a/functions.h
+++ b/functions.h
@@ -17,6 +17,7 @@
  */
 
 #import "MLKInteger.h"
+#import "MLKSymbol.h"
 
 #import <Foundation/NSString.h>
 #include <stdint.h>
@@ -82,7 +83,7 @@ void MLKSetForeignValueWithLispValue (void *destination, id value, MLKForeignTyp
 id MLKLispValueWithForeignValue (void *source, MLKForeignType type);
 
 id MLKInterpretedFunctionTrampoline (void *target, ...);
-  
+id MLKDispatchRootFunction (MLKSymbol *name, ...);  
 
 #ifdef __cplusplus
 }
diff --git a/functions.m b/functions.m
index 7caea41..20cde07 100644
--- a/functions.m
+++ b/functions.m
@@ -25,7 +25,9 @@
 #import "MLKInterpretedClosure.h"
 #import "MLKPackage.h"
 #import "MLKSymbol.h"
+#import "MLKRoot.h"
 
+#import <Foundation/NSArray.h>
 #import <Foundation/NSException.h>
 #import <Foundation/NSString.h>
 
@@ -405,7 +407,31 @@ id MLKInterpretedFunctionTrampoline (void *target, ...)
   values = [closure applyToArray:arguments];
 
   if ([values count] > 0)
-    return [values objectAtIndex:0];
+    return denullify ([values objectAtIndex:0]);
+  else
+    return nil;
+}
+
+id MLKDispatchRootFunction (MLKSymbol *name, ...)
+{
+  NSArray *values;
+  NSMutableArray *arguments;
+  id arg;
+  va_list ap;
+
+  arguments = [NSMutableArray array];
+
+  va_start (ap, name);
+  while ((arg = va_arg (ap, id)) != MLKEndOfArgumentsMarker)
+    {
+      [arguments addObject:nullify(arg)];
+    }
+  va_end (ap);
+
+  values = [MLKRoot dispatch:name withArguments:arguments];
+
+  if ([values count] > 0)
+    return denullify ([values objectAtIndex:0]);
   else
     return nil;
 }
-- 
cgit v1.2.3