Playing with the procedure call mechanism.

* src/objcodes.c (do-pair):  New experiment.
* src/vm_engine.h (ALIGN_AS_NON_IMMEDIATE):  New macro.
  (POP_LIST_ON_STACK):  New experimental macro.
* src/vm_engine.c (call):  In the procedure call case, I tried using the above
  macro.

git-archimport-id: lcourtes@laas.fr--2004-libre/guile-vm--revival--0.6--patch-8

diff --git a/src/objcodes.c b/src/objcodes.c
index b93bed8..0e494b7 100644 (file)
--- a/src/objcodes.c
+++ b/src/objcodes.c
@@ -124,6 +124,38 @@ objcode_free (SCM obj)
  * Scheme interface
  */
 
+#if 0
+SCM_DEFINE (scm_do_pair, "do-pair", 2, 0, 0,
+           (SCM car, SCM cdr),
+           "This is a stupid test to see how cells work.  (Ludo)")
+{
+  static SCM room[512];
+  static SCM *where = &room[0];
+  SCM the_pair;
+  size_t incr;
+
+  if ((scm_t_bits)where & 6)
+    {
+      /* Align the cell pointer so that Guile considers it as a
+        non-immediate object (see tags.h).  */
+      incr = (scm_t_bits)where & 6;
+      incr = (~incr) & 7;
+      where += incr;
+    }
+
+  printf ("do-pair: pool @ %p, pair @ %p\n", &room[0], where);
+  where[0] = car;
+  where[1] = cdr;
+
+  the_pair = PTR2SCM (where);
+  /* This doesn't work because SCM_SET_GC_MARK will look for some sort of a
+     "mark bitmap" at the end of a supposed cell segment which doesn't
+     exist.  */
+
+  return (the_pair);
+}
+#endif
+
 SCM_DEFINE (scm_objcode_p, "objcode?", 1, 0, 0,
            (SCM obj),
            "")

diff --git a/src/vm_engine.h b/src/vm_engine.h
index 5dcb0c4..3c7ef7b 100644 (file)
--- a/src/vm_engine.h
+++ b/src/vm_engine.h
@@ -241,6 +241,76 @@ do                                         \
   PUSH (l);                                    \
 } while (0)
 
+\f
+/* Below is a (slightly broken) experiment to avoid calling `scm_cell' and to
+   allocate cells on the stack.  This is a significant improvement for
+   programs which call a lot of procedures, since the procedure call
+   mechanism uses POP_LIST which normally uses `scm_cons'.
+
+   What it does is that it creates a list whose cells are allocated on the
+   VM's stack instead of being allocated on the heap via `scm_cell'.  This is
+   much faster.  However, if the callee does something like:
+
+     (lambda (. args)
+       (set! the-args args))
+
+   then terrible things may happen since the list of arguments may be
+   overwritten later on.  */
+
+
+/* Awful hack that aligns PTR so that it can be considered as a non-immediate
+   value by Guile.  */
+#define ALIGN_AS_NON_IMMEDIATE(_ptr)           \
+{                                              \
+  if ((scm_t_bits)(_ptr) & 6)                  \
+    {                                          \
+      size_t _incr;                            \
+                                               \
+      _incr = (scm_t_bits)(_ptr) & 6;          \
+      _incr = (~_incr) & 7;                    \
+      (_ptr) += _incr;                         \
+    }                                          \
+}
+
+#define POP_LIST_ON_STACK(n)                   \
+do                                             \
+{                                              \
+  int i;                                       \
+  if (n == 0)                                  \
+    {                                          \
+      sp -= n;                                 \
+      PUSH (SCM_EOL);                          \
+    }                                          \
+  else                                         \
+    {                                          \
+      SCM *list_head, *list;                   \
+                                               \
+      list_head = sp + 1;                      \
+      ALIGN_AS_NON_IMMEDIATE (list_head);      \
+      list = list_head;                                \
+                                               \
+      sp -= n;                                 \
+      for (i = 1; i <= n; i++)                 \
+       {                                       \
+         /* The cell's car and cdr.  */        \
+         *(list) = sp[i];                      \
+         *(list + 1) = PTR2SCM (list + 2);     \
+         list += 2;                            \
+       }                                       \
+                                               \
+      /* The last pair's cdr is '().  */       \
+      list--;                                  \
+      *list = SCM_EOL;                         \
+      /* Push the SCM object that points */    \
+      /* to the first cell.  */                        \
+      PUSH (PTR2SCM (list_head));              \
+    }                                          \
+}                                              \
+while (0)
+
+/* end of the experiment */
+
+\f
 #define POP_LIST_MARK()                                \
 do {                                           \
   SCM o;                                       \

diff --git a/src/vm_system.c b/src/vm_system.c
index a5cd7d0..dc71896 100644 (file)
--- a/src/vm_system.c
+++ b/src/vm_system.c
@@ -380,7 +380,12 @@ VM_DEFINE_INSTRUCTION (call, "call", 1, -1, 1)
         arguments.  */
       SCM args;
 
+#if 1
       POP_LIST (nargs);
+#else
+      /* Experimental:  Build the arglist on the VM stack.  XXX  */
+      POP_LIST_ON_STACK (nargs);
+#endif
       POP (args);
       *sp = scm_apply (x, args, SCM_EOL);
       NEXT;