Initial implementation of a JIT for Emacs bytecode

emacs-llvm-jit.diff

diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c
index 3e79cae4..1db39bae 100644
--- a/lib-src/make-docfile.c
+++ b/lib-src/make-docfile.c
@@ -669,7 +669,18 @@ scan_c_file (char *filename, const char *mode)
   int extension = filename[strlen (filename) - 1];
 
   if (extension == 'o')
-    filename[strlen (filename) - 1] = 'c';
+    {
+      /* Try llvm.o specially, since it's the only C++ file. */
+      if (strcmp (filename, "llvm.o") == 0)
+        {
+          filename = strdup("llvm.cpp"); /* this leak is harmless */
+          extension = 'p';
+        }
+      else
+        {
+          filename[strlen (filename) - 1] = 'c';
+        }
+    }
 
   infile = fopen (filename, mode);
 
diff --git a/src/bytecode.c b/src/bytecode.c
index 772a8bb8..71667c6d 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -482,6 +482,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
       typedef Lisp_Object (*Native_Function)(int /* argc */,
                                              Lisp_Object * /* args */);
       Native_Function func = (Native_Function) XINT (bytestr);
+      write_string ("Executing Native LLVM function...\n", -1);
       return func(nargs, args);
     }
 
diff --git a/src/llvm.cpp b/src/llvm.cpp
index 3120e7b6..3070c6c3 100644
--- a/src/llvm.cpp
+++ b/src/llvm.cpp
@@ -68,36 +68,133 @@ namespace lc
   struct UChar {
     typedef unsigned char value_type;
     typedef ConstantInt llvm_constant_type;
-    Type *operator()() {
+    operator Type *() const {
       return Type::getInt8Ty(*Context);
     }
   };
 
+  struct PtrDiffT {
+    typedef ptrdiff_t value_type;
+    typedef ConstantInt llvm_constant_type;
+    operator Type *() const {
+      return Type::getInt64Ty(*Context);
+    }
+  };
+
   struct Double {
     typedef double value_type;
-    Type *operator()() {
+    operator Type *() const {
       return Type::getDoubleTy(*Context);
     }
   };
 
+  struct Int32 {
+    typedef unsigned int value_type;
+    operator Type *() const {
+      return Type::getInt32Ty(*Context);
+    }
+  };
+
   struct LispObject {
     typedef Lisp_Object value_type;
-    Type *operator()() {
+    operator Type *() const {
       return Type::getInt64Ty(*Context);
     }
   };
 
+  template <typename BaseType>
+  struct Pointer {
+    typedef typename BaseType::value_type * value_type;
+    operator Type *() const {
+      return PointerType::getUnqual(BaseType());
+    }
+  };
+
+  template <typename BaseType>
+  struct Array {
+    typedef typename BaseType::value_type * value_type;
+    unsigned int size;
+    Array(unsigned int sz) : size(sz) {}
+    operator Type *() const {
+      return ArrayType::get(BaseType(), size);
+    }
+  };
+
+  struct Node
+  {
+    Value *value;
+    Node() : value(NULL) {}
+    /* jww (2012-06-26): width of unsigned int depends on the platform? */
+    Node(int t)
+      : value(ConstantInt::get(Type::getInt32Ty(*Context), t, true)) {}
+    Node(unsigned long t)
+      : value(ConstantInt::get(Type::getInt64Ty(*Context), t, true)) {}
+    Node(Lisp_Object t) : value(ConstantInt::get(LispObject(), t, false)) {}
+    Node(Value *v) : value(v) {}
+
+    Node& operator=(const Node& rhs) {
+      value = rhs.value;
+      return *this;
+    }
+    Node& operator=(Value *val) {
+      value = val;
+      return *this;
+    }
+
+    operator Value *() const {
+      return getValue();
+    }
+    Value * getValue() const {
+      return value;
+    }
+
+    Node operator==(const Node& rhs) const {
+      return Builder->CreateICmpEQ(*this, const_cast<Node&>(rhs));
+    }
+    Node operator>>(const Node& rhs) const {
+      return Builder->CreateLShr(value, rhs);
+    }
+
+    Node operator&(const Node& rhs) const {
+      return Builder->CreateAnd(value, rhs);
+    }
+    Node operator|(const Node& rhs) const {
+      return Builder->CreateOr(value, rhs);
+    }
+    Node operator^(const Node& rhs) const {
+      return Builder->CreateXor(value, rhs);
+    }
+  };
+
   template <typename T>
+  struct Constant
+  {
+    typename T::value_type constant;
+    Constant(typename T::value_type c) : constant(c) {}
+
+    operator Value *() const {
+      return T::llvm_constant_type::get(
+        T(), constant, is_signed<typename T::value_type>::value);
+    }
+    operator Node() const {
+      return Node((Value *)*this);
+    }
+  };
+
+  typedef Constant<UChar> C_UChar;
+
+  template <typename ReturnType = LispObject>
   struct If
   {
     BasicBlock * then_block;
     BasicBlock * else_block;
     BasicBlock * ifend;
-    Value *      condbr;
-    Value *      then_body;
-    Value *      else_body;
 
-    If(Value *cond, bool has_else = false) : condbr(NULL) {
+    Node condbr;
+    Node then_body;
+    Node else_body;
+
+    If(Node cond, bool has_else = false) : condbr(NULL) {
       then_block = BasicBlock::Create(*Context, "then", TheFunction);
       else_block = has_else ? BasicBlock::Create(*Context, "else") : NULL;
       ifend      = BasicBlock::Create(*Context, "ifend");
@@ -106,10 +203,10 @@ namespace lc
         cond, then_block, else_block ? else_block : ifend);
     }
 
-    If& Then(function<Value *()> f) {
+    If& Then(Node body) {
       Builder->SetInsertPoint(then_block);
 
-      then_body = f();
+      then_body = body;
 
       Builder->CreateBr(ifend);
       // Codegen of 'Then' can change the current block, update
@@ -119,11 +216,11 @@ namespace lc
       return *this;
     }
 
-    If& Else(function<Value *()> f) {
+    If& Else(Node body) {
       TheFunction->getBasicBlockList().push_back(else_block);
       Builder->SetInsertPoint(else_block);
 
-      else_body = f();
+      else_body = body;
 
       Builder->CreateBr(ifend);
       // Codegen of 'Then' can change the current block, update
@@ -133,106 +230,297 @@ namespace lc
       return *this;
     }
 
-    Value *End() {
+    Node End() {
       TheFunction->getBasicBlockList().push_back(ifend);
       Builder->SetInsertPoint(ifend);
 
-      PHINode *PN = Builder->CreatePHI(T()(), 2, "iftmp");
+      PHINode *PN = Builder->CreatePHI(ReturnType(), 2, "iftmp");
       PN->addIncoming(then_body, then_block);
       PN->addIncoming(else_body, else_block);
       return PN;
     }
   };
 
-  struct Node
+  Function * Func(const char *Name, Type * ret_type, vector<Type *>& types)
   {
-    Value *value;
-    Node(Value *v) : value(v) {}
-
-    operator Value *() {
-      return getValue();
-    }
-    Value * getValue() {
-      return value;
-    }
+    Function *Callee = TheModule->getFunction(Name);
+    if (! Callee) {
+      FunctionType *FT =
+        FunctionType::get(/* Result=   */ ret_type,
+                          /* Params=   */ types,
+                          /* isVarArg= */ false);
 
-    Node operator==(const Node& rhs) {
-      return Builder->CreateICmpEQ(*this, const_cast<Node&>(rhs), "tmp");
-    }
-    Node operator>>(uint64_t size) {
-      return Builder->CreateAShr(value, size, "tmp");
+      Callee = Function::Create(
+        FT, Function::ExternalLinkage, Name, TheModule);
+      Callee->setCallingConv(CallingConv::C);
     }
-  };
+    return Callee;
+  }
 
-  template <typename T>
-  struct Constant
+  template <typename ParamType, typename ...ParamTypes>
+  Function * Func(
+    const char *Name, Type * ret_type, vector<Type *>& types, ParamType param,
+    ParamTypes ...params)
   {
-    typename T::value_type constant;
-    Constant(typename T::value_type c) : constant(c) {}
-
-    operator Value *() {
-      return typename T::llvm_constant_type::get (
-        T()(), constant,
-        /* isSigned= */ is_signed<typename T::value_type>::value);
-    }
-  };
+    types.push_back(param);
+    return Func(Name, ret_type, types, params...);
+  }
 
-  struct Obj : Constant<LispObject> {
-    Obj(Lisp_Object obj) : Constant<LispObject>(obj) {}
-  };
+  template <typename ...ParamTypes>
+  Function * Func(const char *Name, Type * ret_type, ParamTypes ...params)
+  {
+    vector<Type *> types;
+    return Func(Name, ret_type, types, params...);
+  }
 
-  template <typename ReturnType>
-  Node Call(vector<Node>& nodes, const char *Name) {
+  template <typename ReturnType = LispObject>
+  Node Call(const char *Name, vector<Node>& nodes)
+  {
     // Look up the name in the global module table.
     Function *Callee = TheModule->getFunction(Name);
-    if (Callee == 0) {
+    if (! Callee) {
       vector<Type *> types;
-      for_each(
-        nodes.begin(), nodes.end(),
-        [](Node& node) { types.push_back(node.getValue()->getType()); });
+      for_each(nodes.begin(), nodes.end(), [&](Node& node) {
+          types.push_back(node.getValue()->getType());
+        });
 
       FunctionType *FT =
-        FunctionType::get (/* Result=   */ ReturnType()(),
-                           /* Params=   */ types,
-                           /* isVarArg= */ false);
+        FunctionType::get(/* Result=   */ ReturnType(),
+                          /* Params=   */ types,
+                          /* isVarArg= */ false);
 
-      Callee = Function::Create (
+      Callee = Function::Create(
         FT, Function::ExternalLinkage, Name, TheModule);
       Callee->setCallingConv(CallingConv::C);
     }
 
     vector<Value *> values;
-    for_each(
-      nodes.begin(), nodes.end(),
-      [](Node& node) { values.push_back(node.getValue()); });
+    for_each(nodes.begin(), nodes.end(), [&](Node& node) {
+        values.push_back(node.getValue());
+      });
 
     return Builder->CreateCall(Callee, values, Name);
   }
 
-  template <typename ReturnType, typename ArgType, typename ...ArgTypes>
+  template <typename ReturnType = LispObject,
+            typename ArgType, typename ...ArgTypes>
   Node Call(
-    vector<Node>& nodes, const char *Name, ArgType arg, ArgTypes ...args) {
+    const char *Name, vector<Node>& nodes, ArgType arg, ArgTypes ...args)
+  {
     nodes.push_back(arg);
-    return Call(nodes, Name, args...);
+    return Call<ReturnType>(Name, nodes, args...);
   }
 
-  template <typename ReturnType, typename ...ArgTypes>
-  Node Call(const char *Name, ArgTypes ...args) {
+  template <typename ReturnType = LispObject, typename ...ArgTypes>
+  Node Call(const char *Name, ArgTypes ...args)
+  {
     vector<Node> nodes;
-    return Call(nodes, args...);
+    return Call<ReturnType>(Name, nodes, args...);
+  }
+
+  Node Args(vector<Node>& values, unsigned int len)
+  {
+    Value * args = Builder->CreateAlloca(LispObject(), C_UChar(len));
+    assert(len < 255);
+    for (int i = 0; i < len; ++i)
+      Builder->CreateStore(values[i], Builder->CreateGEP(args, C_UChar(i)));
+    return args;
   }
+
+  template <typename T = LispObject>
+  struct TempVar
+  {
+    Value * temp;
+
+    TempVar(Node expr) {
+      temp = Builder->CreateAlloca(T());
+      Builder->CreateStore(expr, temp);
+    }
+
+    Node End() {
+      return temp;
+    }
+  };
+
+  // These helper classes must match the behavior of the corresponding
+  // lisp.h macros exactly.
+
+  struct XType {
+    Node expr;
+    XType(Node x) : expr(x) {}
+    operator Node() const {
+#ifndef USE_LISP_UNION_TYPE
+#ifdef USE_LSB_TAG
+      assert(XTYPE (Qnil) == ((enum Lisp_Type) ((Qnil) & TYPEMASK)));
+      return expr & TYPEMASK;
+#else /* USE_LSB_TAG */
+      assert(
+        XTYPE (Qnil) == ((enum Lisp_Type) (((EMACS_UINT) (Qnil)) >> VALBITS)));
+      return expr >> VALBITS;
+#endif /* USE_LSB_TAG */
+#else /* USE_LISP_UNION_TYPE */
+      /* jww (2012-06-26): Use LLVM struct accessor */
+      assert(XTYPE (Qnil) == ((enum Lisp_Type) (Qnil).u.type));
+      return expr.u.type;
+#endif /* USE_LISP_UNION_TYPE */
+    }
+  };
+
+  struct XUInt {
+    Node expr;
+    XUInt(Node x) : expr(x) {}
+    operator Node() const {
+#ifndef USE_LISP_UNION_TYPE
+#ifdef USE_LSB_TAG
+#ifdef USE_2_TAGS_FOR_INTS
+      assert(XUINT(Qnil) == (((EMACS_UINT) (Qnil)) >> (GCTYPEBITS - 1)));
+      return expr >> (GCTYPEBITS - 1);
+#else
+      assert(XUINT(Qnil) == (((EMACS_UINT) (Qnil)) >> GCTYPEBITS));
+      return expr >> GCTYPEBITS;
+#endif
+#else /* USE_LSB_TAG */
+#ifdef USE_2_TAGS_FOR_INTS
+      assert(XUINT(Qnil) == ((EMACS_UINT) ((Qnil) & (1 + (VALMASK << 1)))));
+      return expr & (1 + (VALMASK << 1));
+#else
+      assert(XUINT(Qnil) == ((EMACS_UINT) ((Qnil) & VALMASK)));
+      return expr & VALMASK;
+#endif
+#endif /* USE_LSB_TAG */
+#else /* USE_LISP_UNION_TYPE */
+      /* jww (2012-06-26): Use LLVM struct accessor */
+      assert(XUINT(Qnil) == ((EMACS_UINT) (Qnil).u.val));
+      return expr.u.val;
+#endif /* USE_LISP_UNION_TYPE */
+    }
+  };
+
+  struct XPntr {
+    Node expr;
+    XPntr(Node x) : expr(x) {}
+    operator Node() const {
+#ifndef USE_LISP_UNION_TYPE
+#ifdef USE_LSB_TAG
+      return expr & ~TYPEMASK;
+#else
+#ifdef DATA_SEG_BITS
+      return (expr & VALMASK) | C_UChar(DATA_SEG_BITS);
+#else
+      return expr & VALMASK;
+#endif
+#endif /* USE_LSB_TAG */
+#else /* USE_LISP_UNION_TYPE */
+#ifdef USE_LSB_TAG
+      /* jww (2012-06-26): Use LLVM struct accessor */
+      return expr.s.val << GCTYPEBITS;
+#else
+#ifdef DATA_SEG_BITS
+      return XUInt (expr) | DATA_SEG_BITS;
+#else
+      return XUInt (expr);
+#endif
+#endif /* USE_LSB_TAG */
+#endif /* USE_LISP_UNION_TYPE */
+    }
+  };
+
+  template <unsigned char T>
+  struct XUntag {
+    Node expr;
+    XUntag(Node x) : expr(x) {}
+    operator Node() const {
+#ifdef USE_LSB_TAG
+      return expr - T;
+#else
+      return XPntr (expr);
+#endif
+    }
+  };
+
+  template <unsigned char T>
+  struct AtomP {
+    Node expr;
+    AtomP(Node x) {
+#ifdef USE_LSB_TAG
+      expr = XType (XUntag<T> (x));
+      expr = expr == Node(0);
+#else
+      expr = XType (x) == T;
+#endif
+    }
+    operator Node() const {
+      return expr;
+    }
+  };
+
+  typedef AtomP<Lisp_Cons> ConsP;
+
+  struct XCar {
+    Node expr;
+    XCar(Node x) : expr(x) {}
+    operator Node() const {
+      return expr;
+    }
+  };
+
+  struct NilP {
+    Node expr;
+    NilP(Node x) : expr(x) {}
+    operator Node() const {
+      return expr;
+    }
+  };
 }
 
 using namespace lc;
+
+/* Fetch the next byte from the bytecode stream */
+
+#undef FETCH
+#define FETCH *stream_pc++
+
+/* Push x onto the execution stack.  This used to be #define PUSH(x)
+   (*++stackp = (x)) This oddity is necessary because Alliant can't be
+   bothered to compile the preincrement operator properly, as of 4/91.
+   -JimB */
+
+#undef PUSH
+#define PUSH(x) values.push_back(x)
+
+/* Pop a value off the execution stack.  */
+
+#undef POP
+#define POP (tmp = values.back(), values.pop_back(), tmp)
+
+/* Discard n values from the execution stack.  */
+
+#undef DISCARD
+#define DISCARD(n) values.erase(values.end() - n, values.end())
+
+/* Get the value which is at the top of the execution stack, but don't
+   pop it. */
+
+#undef TOP
+#define TOP (values.back())
 
-Value *CompileByteCode (Function *F, Lisp_Object bytestr, Lisp_Object constants,
+#undef BYTE_CODE_QUIT
+// jww (2012-06-26): Needs to be defined
+#define BYTE_CODE_QUIT
+
+#undef MAYBE_GC
+// jww (2012-06-26): Needs to be defined
+#define MAYBE_GC()
+
+Value *CompileByteCode (Lisp_Object bytestr, Lisp_Object constants,
                         ptrdiff_t nargs, Lisp_Object *args)
 {
   int count = SPECPDL_INDEX ();
   int op;
   Lisp_Object *constantsp;
+  struct byte_stack stack;
   Lisp_Object *top;
-  Lisp_Object result;
+  Node result, tmp;
   unsigned char *stream = SDATA (bytestr);
   unsigned char *stream_pc = stream;
 
@@ -251,13 +539,14 @@ Value *CompileByteCode (Function *F, Lisp_Object bytestr, Lisp_Object constants,
 
   vector<Node> values;
 
-#if 0
   while (1)
   {
     op = FETCH;
+    printf("processing op: %o\n", op);
 
     switch (op)
     {
+#if 0
     case Bvarref + 7:
       op = FETCH2;
       goto varref;
@@ -306,6 +595,9 @@ Value *CompileByteCode (Function *F, Lisp_Object bytestr, Lisp_Object constants,
       if (NILP (v1))
       {
         BYTE_CODE_QUIT;
+        /* jww (2012-06-26): I'll need to create a pending label that
+           gets inserted when stream_pc = stream + op later during
+           processing of this function. */
         stream_pc = stream + op;
       }
       break;
@@ -328,25 +620,16 @@ Value *CompileByteCode (Function *F, Lisp_Object bytestr, Lisp_Object constants,
       //   break;
       // }
     {
-      values.front() =
-        If<LispObject>((values.front() >> VALBITS) ==
-                       Constant<UChar>(Lisp_Cons),
-                       /* has_else= */ true)
-        .Then ([]() {
-          })
-        .Else ([]() {
-            If<LispObject>(values.front() == Obj(Qnil)),
-            /* has_else= */ true)
-            .Then ([]() {
-                return Obj(Qnil);
-              })
-            .Else ([]() {
-                return Call("wrong_type_argument", Obj(Qlistp),
-                            values.front());
-              })
-            .End ()
-          })
-        .End ()
+      Node top = TempVar<> (TOP);
+      TOP = If<> (ConsP (top), true)
+        .Then (XCar (top))
+        .Else (
+          If<> (NilP (top), true)
+          .Then (Qnil)
+          .Else (Call<LispObject>("wrong_type_argument", Qlistp,
+                                  values.front()))
+          .End ())
+        .End ();
       break;
     }
 
@@ -417,17 +700,15 @@ Value *CompileByteCode (Function *F, Lisp_Object bytestr, Lisp_Object constants,
       }
       (void) POP;
       break;
+#endif
 
     case Bdup:
-    {
-      Lisp_Object v1;
-      v1 = TOP;
-      PUSH (v1);
+      PUSH (TOP);
       break;
-    }
 
     /* ------------------ */
 
+#if 0
     case Bvarbind+6:
       op = FETCH;
       goto varbind;
@@ -447,6 +728,7 @@ Value *CompileByteCode (Function *F, Lisp_Object bytestr, Lisp_Object constants,
       /* Specbind can signal and thus GC.  */
       specbind (constantsp[op], POP);
       break;
+#endif
 
     case Bcall+6:
       op = FETCH;
@@ -463,13 +745,16 @@ Value *CompileByteCode (Function *F, Lisp_Object bytestr, Lisp_Object constants,
     case Bcall+4:
     case Bcall+5:
       op -= Bcall;
-    docall:
-      {
+    docall: {
+        BEFORE_POTENTIAL_GC ();
+        Node args = Args(values, op + 1);
         DISCARD (op);
-        TOP = Ffuncall (op + 1, &TOP);
+        TOP = Call<LispObject>("funcall", op + 1, args);
+        AFTER_POTENTIAL_GC ();
         break;
       }
 
+#if 0
     case Bunbind+6:
       op = FETCH;
       goto dounbind;
@@ -593,6 +878,7 @@ Value *CompileByteCode (Function *F, Lisp_Object bytestr, Lisp_Object constants,
       }
       else DISCARD (1);
       break;
+#endif
 
     case Breturn:
       result = POP;
@@ -606,6 +892,7 @@ Value *CompileByteCode (Function *F, Lisp_Object bytestr, Lisp_Object constants,
       PUSH (constantsp[FETCH2]);
       break;
 
+#if 0
     case Bsave_excursion:
       record_unwind_protect (save_excursion_restore,
                              save_excursion_save ());
@@ -836,20 +1123,16 @@ Value *CompileByteCode (Function *F, Lisp_Object bytestr, Lisp_Object constants,
       }
       break;
     }
+#endif
 
+#if 0
     case Badd1:
     {
-      Lisp_Object v1;
-      v1 = TOP;
-      if (INTEGERP (v1))
-      {
-        XSETINT (v1, XINT (v1) + 1);
-        TOP = v1;
-      }
-      else
-      {
-        TOP = Fadd1 (v1);
-      }
+      Node top = TempVar<> (TOP).End();
+      If<> (IntegerP (top), true)
+        .Then(top += 1)
+        .Else(Call<LispObject>("add1", top))
+        .End();
       break;
     }
 
@@ -1325,13 +1608,13 @@ Value *CompileByteCode (Function *F, Lisp_Object bytestr, Lisp_Object constants,
       }
       DISCARD (op);
       break;
+#endif
 
     case 255:
     default:
-      PUSH (constantsp[op - Bconstant]);
+      values.push_back(constantsp[op - Bconstant]);
     }
   }
-#endif
 
  exit:
 
@@ -1339,63 +1622,57 @@ Value *CompileByteCode (Function *F, Lisp_Object bytestr, Lisp_Object constants,
   if (SPECPDL_INDEX () != count)
     abort ();
 
-  return NULL /*result*/;
+  return result;
 }
 
-Function *CompileFunction (Function *F, Lisp_Object bytestr,
-                           Lisp_Object constants,
+Function *CompileFunction (Lisp_Object bytestr, Lisp_Object constants,
                            ptrdiff_t nargs, Lisp_Object *args)
 {
   // Create a new basic block to start insertion into.
-  BasicBlock *BB = BasicBlock::Create(*Context, "entry", F);
+  BasicBlock *BB = BasicBlock::Create(*Context, "entry", TheFunction);
   Builder->SetInsertPoint(BB);
 
-  if (Value *RetVal = CompileByteCode(F, bytestr, constants, nargs, args))
+  if (Value * RetVal = CompileByteCode(bytestr, constants, nargs, args))
     {
       // Finish off the function.
       Builder->CreateRet(RetVal);
 
-      // Validate the generated code, checking for consistency.
-      verifyFunction(*F);
+#if 0
+    // Validate the generated code, checking for consistency.
+      verifyFunction(*TheFunction);
+#endif
 
       // Optimize the function.
-      TheFPM->run(*F);
+      TheFPM->run(*TheFunction);
 
-      return F;
+      return TheFunction;
     }
 
   // Error reading body, remove function.
-  F->eraseFromParent();
+  TheFunction->eraseFromParent();
   return 0;
 }
 
 Function *CreateFunction (const char *name, ptrdiff_t nargs, void *id = NULL)
 {
-  Type ** LispTypes = new Type *[nargs + 1];
-  for (int i = 0; i < nargs; ++i)
-    LispTypes[i] = Type::getInt64Ty (*Context);
-  LispTypes[nargs] = NULL;
-
-  FunctionType *FT =
-    /* jww (2012-06-25): Use getInt32Ty when appropriate */
-    FunctionType::get (/* Result=   */ Type::getInt64Ty (*Context),
-                       /* Params=   */ ArrayRef<Type *>(LispTypes, nargs),
-                       /* isVarArg= */ false);
-  delete[] LispTypes;
-
+  std::vector<Type*> types(nargs, LispObject());
+  FunctionType *FT = FunctionType::get (/* Result=   */ LispObject(),
+                                        /* Params=   */ types,
+                                        /* isVarArg= */ false);
   static char Name[32];
   if (!name)
     sprintf (Name, "__emacs_%p", id);
 
-  Function *F = Function::Create (FT, Function::ExternalLinkage,
-                                  name ? name : Name, TheModule);
+  Function * F = Function::Create (FT, Function::ExternalLinkage,
+                                   name ? name : Name, TheModule);
   F->setCallingConv(CallingConv::C);
 
   if (!name)
   {
     // Set names for all arguments.
     unsigned idx = 0;
-    for (Function::arg_iterator AI = F->arg_begin(); idx != nargs;
+    for (Function::arg_iterator AI = F->arg_begin();
+         idx != nargs;
          ++AI, ++idx)
       {
         sprintf (Name, "__arg%d", idx);
@@ -1420,7 +1697,7 @@ llvm_compile_byte_code (Lisp_Object bytestr, Lisp_Object constants,
       //printf("step 2..\n");
       Context = &getGlobalContext();
       //printf("step 3..\n");
-      TheModule = new Module("Emacs-LLVM-JIT", *Context);
+      TheModule = new Module("llvm-jit-compile", *Context);
       //printf("step 4..\n");
       Builder = new IRBuilder<>(*Context);
       //printf("step 5..\n");
@@ -1429,70 +1706,69 @@ llvm_compile_byte_code (Lisp_Object bytestr, Lisp_Object constants,
       TheExecutionEngine = EngineBuilder(TheModule).create();
       //printf("step 6..\n");
 
-      FunctionPassManager OurFPM(TheModule);
+      TheFPM = new FunctionPassManager(TheModule);
       //printf("step 7..\n");
 
       // Set up the optimizer pipeline.  Start with registering info
       // about how the target lays out data structures.
-      OurFPM.add(new TargetData(*TheExecutionEngine->getTargetData()));
+      TheFPM->add(new TargetData(*TheExecutionEngine->getTargetData()));
       //printf("step 8..\n");
-      // Provide basic AliasAnalysis support for GVN.
-      OurFPM.add(createBasicAliasAnalysisPass());
-      //printf("step 9..\n");
-      // Do simple "peephole" optimizations and bit-twiddling optzns.
-      OurFPM.add(createInstructionCombiningPass());
-      //printf("step 10..\n");
-      // Reassociate expressions.
-      OurFPM.add(createReassociatePass());
-      //printf("step 11..\n");
-      // Eliminate Common SubExpressions.
-      OurFPM.add(createGVNPass());
-      //printf("step 12..\n");
-      // Simplify the control flow graph (deleting unreachable blocks, etc).
-      OurFPM.add(createCFGSimplificationPass());
-      //printf("step 13..\n");
-
-      OurFPM.doInitialization();
-      //printf("step 14..\n");
 
-      // Set the global so the code gen can use this.
-      TheFPM = &OurFPM;
-      //printf("step 15..\n");
+      TheFPM->add(createVerifierPass());
 
-      /* Create mappings for all of the Emacs Lisp builtins. */
-#define MAP_TO_LLVM(name, nargs)                                          \
-      {                                                                   \
-        Lisp_Object sym =                                                 \
-          intern_c_string (const_cast<char *>(#name));                    \
-        TheExecutionEngine->addGlobalMapping(                             \
-          CreateFunction(#name, nargs),                                   \
-          (void *) XSUBR (XSYMBOL (sym)->function)->function.a ## nargs); \
-      }
+      TheFPM->add(createTypeBasedAliasAnalysisPass());
+      TheFPM->add(createBasicAliasAnalysisPass());
 
-#define MAP_TO_LLVM_N(name)                                               \
-      {                                                                   \
-        Lisp_Object sym =                                                 \
-          intern_c_string (const_cast<char *>(#name));                    \
-        Lisp_Object fun = XSYMBOL (sym)->function;                        \
-        Lisp_Subr * sub = XSUBR (fun);                                    \
-        TheExecutionEngine->addGlobalMapping(                             \
-          CreateFunction(#name, sub->max_args),                           \
-          (void *) sub->function.aMANY);                                  \
-      }
+      TheFPM->add(createCFGSimplificationPass());
+      TheFPM->add(createScalarReplAggregatesPass());
+      TheFPM->add(createEarlyCSEPass());
+      TheFPM->add(createLowerExpectIntrinsicPass());
+
+#if 0
+      /* jww (2012-06-26): Additional optimization passes, which Clang
+         does not currently use for FunctionPass optimization. */
+      TheFPM->add(createPromoteMemoryToRegisterPass());
+      TheFPM->add(createInstructionCombiningPass());
+      TheFPM->add(createReassociatePass());
+      TheFPM->add(createGVNPass());
+#endif
 
-      MAP_TO_LLVM_N(funcall);
+      TheFPM->doInitialization();
+      //printf("step 14..\n");
 
+      /* Create mappings for all of the Emacs Lisp builtins. */
+      TheExecutionEngine->addGlobalMapping(
+        Func("funcall", /* ReturnType= */ LispObject(),
+             /* ParamTypes= */ PtrDiffT(), Pointer<LispObject>()),
+        (void *) &Ffuncall);
+      //printf("step 16..\n");
+
+#define MAP_TO_LLVM(name, nargs)                \
+      TheExecutionEngine->addGlobalMapping(     \
+        CreateFunction(#name, nargs),           \
+        (void *) &F ## name);
+
+      //printf("step 17..\n");
+      MAP_TO_LLVM(add1, 1);
       MAP_TO_LLVM(setcar, 2);
+      //printf("step 18..\n");
     }
 
-  return CompileFunction(CreateFunction(NULL, nargs, (void *) &bytestr),
-                         bytestr, constants, nargs, args);
+  //printf("step 19..\n");
+  TheFunction = CreateFunction(NULL, nargs, (void *) &bytestr);
+  //printf("step 20..\n");
+  TheFunction = CompileFunction(bytestr, constants, nargs, args);
+  //printf("step 21..\n");
+  TheFunction->dump();
+
+  //printf("step 22..\n");
+  return TheExecutionEngine->getPointerToFunction(TheFunction);
 }
 
 Lisp_Object Qllvm_jit_compile;
 
 void
-syms_of_lllvm (void)
+syms_of_llvm (void)
 {
   DEFVAR_BOOL ("llvm-jit-compile", llvm_jit_compile,
 	       doc: /* If non-nil, compile byte-code functions with the LLVM JIT. */);
diff --git a/src/unexmacosx.c b/src/unexmacosx.c
index 0d824cc6..57fef4ba 100644
--- a/src/unexmacosx.c
+++ b/src/unexmacosx.c
@@ -848,6 +848,8 @@ copy_data_segment (struct load_command *lc)
 	       || strncmp (sectp->sectname, "__cfstring", 16) == 0
 	       || strncmp (sectp->sectname, "__gcc_except_tab", 16) == 0
 	       || strncmp (sectp->sectname, "__program_vars", 16) == 0
+	       || strncmp (sectp->sectname, "__mod_init_func", 16) == 0
+	       || strncmp (sectp->sectname, "__mod_term_func", 16) == 0
 	       || strncmp (sectp->sectname, "__objc_", 7) == 0)
 	{
 	  if (!unexec_copy (sectp->offset, old_file_offset, sectp->size))
@@ -856,7 +858,8 @@ copy_data_segment (struct load_command *lc)
 	    unexec_error ("cannot write section %s's header", sectp->sectname);
 	}
       else
-	unexec_error ("unrecognized section name in __DATA segment");
+	unexec_error ("unrecognized section name in __DATA segment: %s",
+                      sectp->sectname);
 
       printf ("        section %-16.16s at %#8lx - %#8lx (sz: %#8lx)\n",
 	      sectp->sectname, (long) (sectp->offset),