From 10d47c5561917eb0b9b7fc5a3ef0154ff38925fc Mon Sep 17 00:00:00 2001
From: Noah Lavine <nlavine@haverford.edu>
Date: Sun, 18 Jul 2010 13:35:27 -0400
Subject: [PATCH] Add JIT Infrastructure

Add a dummy JIT compiler, and the infrastructure to invoke it on object code,
run the JIT code if it's generated, and cache the JIT code for future use.
---
 libguile/Makefile.am   |    2 +
 libguile/init.c        |    4 ++-
 libguile/vm-engine.c   |   22 ++++++++++++++++-
 libguile/vm-engine.h   |    2 +
 libguile/vm-i-system.c |   17 +++++++++++++
 libguile/vm-jit.c      |   60 ++++++++++++++++++++++++++++++++++++++++++++++++
 libguile/vm-jit.h      |   39 +++++++++++++++++++++++++++++++
 7 files changed, 144 insertions(+), 2 deletions(-)
 create mode 100644 libguile/vm-jit.c
 create mode 100644 libguile/vm-jit.h

diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 5eea8dc..3da0009 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -210,6 +210,7 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES =				\
 	vectors.c				\
 	version.c				\
 	vm.c					\
+	vm-jit.c				\
 	vports.c				\
 	weaks.c
 
@@ -583,6 +584,7 @@ modinclude_HEADERS =				\
 	vectors.h				\
 	vm-engine.h				\
 	vm-expand.h				\
+	vm-jit.h				\
 	vm.h					\
 	vports.h				\
 	weaks.h
diff --git a/libguile/init.c b/libguile/init.c
index 4843910..7c88a4a 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -128,6 +128,7 @@
 #include "libguile/vectors.h"
 #include "libguile/version.h"
 #include "libguile/vm.h"
+#include "libguile/vm-jit.h"
 #include "libguile/vports.h"
 #include "libguile/weaks.h"
 #include "libguile/guardians.h"
@@ -546,7 +547,8 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_weaks ();
   scm_init_guardians (); /* requires smob_prehistory */
   scm_init_vports ();
-  scm_init_standard_ports ();  /* Requires fports */
+  scm_init_jit ();
+  scm_init_standard_ports ();  /* Requires fports, jit */
   scm_init_expand ();   /* Requires structs */
   scm_init_memoize ();  /* Requires smob_prehistory */
   scm_init_eval ();     /* Requires smob_prehistory */
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 7f4641a..a567a85 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -31,7 +31,7 @@
 #endif
 
 #include "vm-engine.h"
-
+#include "tags.h" /* for SCM_BOOL_F */
 
 static SCM
 VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
@@ -47,6 +47,7 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
   SCM *objects = NULL;			/* constant objects */
   size_t object_count = 0;              /* length of OBJECTS */
   SCM *stack_limit = vp->stack_limit;	/* stack limit address */
+  jitf *jitcode = NULL;  /* JIT code, if any */
 
   SCM dynstate = SCM_I_CURRENT_THREAD->dynamic_state;
   scm_t_int64 vm_cookie = vp->cookie++;
@@ -80,6 +81,10 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
   {
     SCM prog = program;
 
+    /* program could also be a smob. maybe other things? */
+    if (SCM_PROGRAM_P(program))
+      jitcode = (jitf *)SCM_OBJCODE_JITCODE(SCM_PROGRAM_OBJCODE(program));
+
     /* Boot program */
     program = vm_make_boot_program (nargs);
 
@@ -105,6 +110,21 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
 
   /* Let's go! */
   BOOT_HOOK ();
+
+  if (jitcode == NULL) {
+    jitcode = jit_objcode(bp);
+    SCM_OBJCODE_JITCODE(SCM_PROGRAM_OBJCODE(program)) = jitcode;
+  }
+  if (jitcode != SCM_BOOL_F) {
+    scm_t_uint8 *sip = ip;
+    SCM *ssp = sp;
+    SCM *sfp = fp;
+    SCM_JITCODE_ENTER(jitcode, sip, ssp, sfp);
+    ip = sip;
+    sp = ssp;
+    fp = sfp;
+  }
+  /* if the jitcode runs, we'll still want to do NEXT afterwards */
   NEXT;
 
 #ifndef HAVE_LABELS_AS_VALUES
diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h
index 836648c..b90e481 100644
--- a/libguile/vm-engine.h
+++ b/libguile/vm-engine.h
@@ -90,6 +90,8 @@
 #define FP_REG
 #endif
 
+#include "vm-jit.h"
+
 
 /*
  * Cache/Sync
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 11f8ae0..5499bcf 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -744,6 +744,7 @@ VM_DEFINE_INSTRUCTION (53, new_frame, "new-frame", 0, 0, 3)
 
 VM_DEFINE_INSTRUCTION (54, call, "call", 1, -1, 1)
 {
+  (jitf *)jitcode = NULL;
   nargs = FETCH ();
 
  vm_call:
@@ -778,6 +779,22 @@ VM_DEFINE_INSTRUCTION (54, call, "call", 1, -1, 1)
   ip = SCM_C_OBJCODE_BASE (bp);
   ENTER_HOOK ();
   APPLY_HOOK ();
+
+  jitcode = SCM_OBJCODE_JITCODE(SCM_PROGRAM_OBJCODE(program));
+  if (jitcode == NULL) {
+    jitcode = jit_objcode(bp);
+    SCM_OBJCODE_JITCODE(SCM_PROGRAM_OBJCODE(program)) = jitcode;
+  }
+  if (jitcode != SCM_BOOL_F) {
+    scm_t_uint8 *sip = ip;
+    SCM *ssp = sp;
+    SCM *sfp = fp;
+    SCM_JITCODE_ENTER(jitcode, sip, ssp, sfp);
+    ip = sip;
+    sp = ssp;
+    fp = sfp;
+  }
+  /* if the jitcode runs, we'll still want to do NEXT afterwards */
   NEXT;
 }
 
diff --git a/libguile/vm-jit.c b/libguile/vm-jit.c
new file mode 100644
index 0000000..d9a4a08
--- /dev/null
+++ b/libguile/vm-jit.c
@@ -0,0 +1,60 @@
+#include <stdio.h>
+
+#include "libguile/instructions.h"
+#include "libguile/snarf.h"
+#include "libguile/objcodes.h"
+#include "libguile/symbols.h"
+#include "libguile/list.h"
+#include "libguile/tags.h"
+#include "libguile/strings.h" /* for scm_from_locale_string, for the init function */
+#include "libguile/struct.h"
+#include "libguile/numbers.h"
+
+#include "libguile/vm-jit.h" /* defines struct scm_jit_code */
+#include "lightning.h"
+
+/* SCM jitcode_vtable = NULL; */
+
+/* jit_objcode: this procedure either JITs the given object code, and returns a
+ * pointer to an scm_jit_code object with the results, or SCM_BOOL_F if it
+ * couldn't jit the code. this will most likely occur if the jitter hits an
+ * object code that it doesn't know how to translate. */
+jitf *jit_objcode(struct scm_objcode *objcode)
+{
+  /* SCM code; */
+  jitf *code;
+  jit_insn *buffer, *end;
+
+  buffer = scm_gc_calloc(32 * sizeof (jit_insn), "JIT instruction buffer");
+  if (buffer == NULL)
+    return (jitf *)SCM_BOOL_F;
+
+  /* Make a test function */
+  jit_set_ip(buffer);
+  jit_prolog(3);
+  jit_movi_p(JIT_R0, "JIT code called!\n");
+  jit_prepare(1);
+  jit_pusharg_p(JIT_R0);
+  jit_finish(printf);
+  jit_ret();
+
+  end = (jit_insn *)jit_get_ip().ptr;
+  jit_flush_code(buffer, end);
+
+  /* Make the struct */
+  /* code = scm_c_make_structv(jitcode_vtable, 1, 1, (scm_t_bits *)buffer); */
+  code = scm_gc_malloc (sizeof (jitf *), "a table of pointers to machine code");
+  if (code == NULL)
+    return (jitf *)SCM_BOOL_F;
+  
+  *code = (jitf *)buffer;
+
+  return code;
+}
+
+void scm_init_jit (void)
+{
+  /* jitcode_vtable = scm_make_vtable (scm_from_locale_string("pO"), SCM_UNDEFINED); */
+  
+  return;
+}
diff --git a/libguile/vm-jit.h b/libguile/vm-jit.h
new file mode 100644
index 0000000..8251fef
--- /dev/null
+++ b/libguile/vm-jit.h
@@ -0,0 +1,39 @@
+#ifndef _SCM_VM_JIT_H_
+#define _SCM_VM_JIT_H_
+
+#include "_scm.h"
+#include "libguile/struct.h"
+
+/* jitted code for a procedure will be stored as an array of pointers to the
+ * blocks of the machine code. the generated machine code will expect this array
+ * to be available (how?) when it is called, and all machine code branches will
+ * indirect through this array. this is done to make the code relocatable: as
+ * long as the block array points to the correct blocks, then the code can be
+ * loaded anywhere in memory. this is important because it will allow us to
+ * store the code to a .go file and mmap() it back into memory and have it still
+ * work, which will allow fast startups. if we're storing code for a procedure,
+ * the first pointer in the block array will point to the procedure entry point.
+ *
+ * a block is a basic block of the object code. it's not really a basic block
+ * from the JIT perspective, because all of the instructions are implemented as
+ * calls to C functions.
+ *
+ * (one could also implement position-independent code by only using relative
+ * branches, but it's not clear that GNU Lightning supports this, so I'll use
+ * the table method.) */
+
+typedef void (*jitf)(void *block_pointers, scm_t_uint8 **ip,
+                     SCM **sp, SCM **fp);
+
+/* the first block is number 1. */
+#define SCM_C_JITCODE_BLOCK(block_pointers, n)                           \
+  (*((block_pointers) + (n) - 1))
+  /*  SCM_STRUCT_SLOT_REF(obj, n - 1) */
+#define SCM_JITCODE_ENTER(obj, ip, sp, fp)                    \
+  ((jitf)(SCM_C_JITCODE_BLOCK(obj, 1)))(SCM_C_JITCODE_BLOCK(obj, 1), &ip, &sp, &fp)
+
+jitf *jit_objcode(struct scm_objcode *objcode);
+
+void scm_init_jit (void);
+
+#endif /* not _SCM_VM_JIT_H_ */
-- 
1.7.1

