Create external frames dynamically.

diff --git a/src/vm.c b/src/vm.c
index 51fa23a..c614409 100644 (file)
--- a/src/vm.c
+++ b/src/vm.c
@@ -44,7 +44,7 @@
 #include "vm.h"
 
 /* default stack size in the number of SCM */
-#define VM_DEFAULT_STACK_SIZE  (1 * 1024)   /* = 128KB */
+#define VM_DEFAULT_STACK_SIZE  (16 * 1024)   /* = 64KB */
 #define VM_MAXIMUM_STACK_SIZE  (1024 * 1024) /* = 4MB */
 
 /* I sometimes use this for debugging. */
@@ -526,21 +526,9 @@ SCM_DEFINE (scm_bytecode_decode, "bytecode-decode", 1, 0, 0,
 static long scm_program_tag;
 
 static SCM
-make_program (SCM bytecode, SCM parent)
+make_program (SCM code, SCM env)
 {
-  SCM env = SCM_PROGRAM_P (parent) ? SCM_PROGRAM_ENV (parent) : SCM_BOOL_F;
-  int nexts = SCM_BYTECODE_NEXTS (bytecode);
-
-  if (nexts)
-    {
-      SCM tmp = SCM_VM_MAKE_EXTERNAL (nexts);
-      SCM_VM_EXTERNAL_LINK (tmp) = env;
-      env = tmp;
-    }
-
-  SCM_RETURN_NEWSMOB2 (scm_program_tag,
-                      SCM_UNPACK (bytecode),
-                      SCM_UNPACK (env));
+  SCM_RETURN_NEWSMOB2 (scm_program_tag, SCM_UNPACK (code), SCM_UNPACK (env));
 }
 
 static SCM
@@ -629,16 +617,6 @@ SCM_DEFINE (scm_program_base, "program-base", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_program_external, "program-external", 1, 0, 0,
-           (SCM program),
-"")
-#define FUNC_NAME s_scm_program_external
-{
-  SCM_VALIDATE_PROGRAM (1, program);
-  return SCM_PROGRAM_ENV (program);
-}
-#undef FUNC_NAME
-
 \f
 /*
  * VM Frame
@@ -652,6 +630,7 @@ struct scm_vm_frame {
   SCM program;
   SCM variables;
   SCM dynamic_link;
+  SCM external_link;
   SCM stack_pointer;
   SCM return_address;
 };
@@ -668,6 +647,7 @@ make_vm_frame (SCM *fp)
   struct scm_vm_frame *p = scm_must_malloc (sizeof (*p), "make_vm_frame");
   p->program        = SCM_VM_FRAME_PROGRAM (fp);
   p->dynamic_link   = SCM_VM_FRAME_DYNAMIC_LINK (fp);
+  p->external_link  = SCM_VM_FRAME_EXTERNAL_LINK (fp);
   p->stack_pointer  = SCM_VM_FRAME_STACK_POINTER (fp);
   p->return_address = SCM_VM_FRAME_RETURN_ADDRESS (fp);
 
@@ -688,6 +668,7 @@ mark_vm_frame (SCM frame)
   struct scm_vm_frame *p = SCM_VM_FRAME_DATA (frame);
   scm_gc_mark (p->program);
   scm_gc_mark (p->dynamic_link);
+  scm_gc_mark (p->external_link);
   return p->variables;
 }
 
@@ -739,6 +720,16 @@ SCM_DEFINE (scm_frame_dynamic_link, "frame-dynamic-link", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_frame_external_link, "frame-external-link", 1, 0, 0,
+           (SCM frame),
+"")
+#define FUNC_NAME s_scm_frame_external_link
+{
+  SCM_VALIDATE_VM_FRAME (1, frame);
+  return SCM_VM_FRAME_DATA (frame)->external_link;
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_frame_stack_pointer, "frame-stack-pointer", 1, 0, 0,
            (SCM frame),
 "")

diff --git a/src/vm.h b/src/vm.h
index dc493bf..4de9a50 100644 (file)
--- a/src/vm.h
+++ b/src/vm.h
@@ -188,13 +188,14 @@ extern SCM scm_program_base (SCM program);
 
 /* VM frame is allocated in the stack */
 /* NOTE: Modify make_vm_frame and VM_NEW_FRAME too! */
-#define SCM_VM_FRAME_DATA_SIZE         5
+#define SCM_VM_FRAME_DATA_SIZE         6
 #define SCM_VM_FRAME_VARIABLE(FP,N)    (FP[N])
 #define SCM_VM_FRAME_SIZE(FP)          (FP[-1])
 #define SCM_VM_FRAME_PROGRAM(FP)       (FP[-2])
 #define SCM_VM_FRAME_DYNAMIC_LINK(FP)  (FP[-3])
-#define SCM_VM_FRAME_STACK_POINTER(FP) (FP[-4])
-#define SCM_VM_FRAME_RETURN_ADDRESS(FP)        (FP[-5])
+#define SCM_VM_FRAME_EXTERNAL_LINK(FP) (FP[-4])
+#define SCM_VM_FRAME_STACK_POINTER(FP) (FP[-5])
+#define SCM_VM_FRAME_RETURN_ADDRESS(FP)        (FP[-6])
 
 \f
 /*

diff --git a/src/vm_engine.c b/src/vm_engine.c
index 2c6a185..20b8058 100644 (file)
--- a/src/vm_engine.c
+++ b/src/vm_engine.c
@@ -61,24 +61,24 @@ VM_NAME (SCM vm, SCM program)
 #define FUNC_NAME "vm-engine"
 {
   /* Copies of VM registers */
-  SCM ac = SCM_PACK (0);
-  SCM *pc = NULL;
-  SCM *sp = NULL;
-  SCM *fp = NULL;
+  SCM ac = SCM_PACK (0);       /* accumulator */
+  SCM *pc = NULL;              /* program counter */
+  SCM *sp = NULL;              /* stack pointer */
+  SCM *fp = NULL;              /* frame pointer */
 
-  /* Stack boundaries */
-  SCM *stack_base = NULL;
-  SCM *stack_limit = NULL;
+  /* Cache variables */
+  struct scm_vm *vmp = NULL;   /* the VM data pointer */
+  SCM ext = SCM_BOOL_F;                /* the current external frame */
+  SCM *stack_base = NULL;      /* stack base address */
+  SCM *stack_limit = NULL;     /* stack limit address */
 
   /* Function arguments */
   int an = 0;
   SCM a2 = SCM_PACK (0);
   SCM a3 = SCM_PACK (0);
 
-  /* Miscellaneous variables */
+  /* Internal variables */
   SCM dynwinds = SCM_EOL;
-  struct scm_vm *vmp = NULL;
-
 #if VM_USE_HOOK
   SCM hook_args = SCM_LIST1 (vm);
 #endif

diff --git a/src/vm_engine.h b/src/vm_engine.h
index 19493b3..c19aef5 100644 (file)
--- a/src/vm_engine.h
+++ b/src/vm_engine.h
@@ -237,7 +237,7 @@
  */
 
 /* an = the number of arguments */
-#define VM_SETUP_ARGS(PROG,NREQS,RESTP)                                \
+#define VM_FRAME_INIT_ARGS(PROG,NREQS,RESTP)                   \
 {                                                              \
   if (RESTP)                                                   \
     /* have a rest argument */                                 \
@@ -260,49 +260,66 @@
     }                                                          \
 }
 
-#define VM_EXPORT_ARGS(FP,PROG)                                        \
-{                                                              \
-  int *exts = SCM_PROGRAM_EXTS (PROG);                         \
-  if (exts)                                                    \
-    {                                                          \
-      int n = exts[0];                                         \
-      while (n-- > 0)                                          \
-       SCM_VM_EXTERNAL_VARIABLE (SCM_PROGRAM_ENV (PROG), n)    \
-         = SCM_VM_FRAME_VARIABLE (FP, exts[n + 1]);    \
-    }                                                          \
-}
-
-#undef VM_FRAME_INIT_VARIABLES
+#undef VM_FRAME_INIT_LOCAL_VARIABLES
 #if VM_INIT_LOCAL_VARIABLES
 /* This is necessary when creating frame objects for debugging */
-#define VM_FRAME_INIT_VARIABLES(FP,NVARS)              \
+#define VM_FRAME_INIT_LOCAL_VARIABLES(FP,NVARS)                \
 {                                                      \
   int i;                                               \
   for (i = 0; i < NVARS; i++)                          \
     SCM_VM_FRAME_VARIABLE (FP, i) = SCM_UNDEFINED;     \
 }
 #else
-#define VM_FRAME_INIT_VARIABLES(FP,NVARS)
+#define VM_FRAME_INIT_LOCAL_VARIABLES(FP,NVARS)
 #endif
 
+#define VM_FRAME_INIT_EXTERNAL_VARIABLES(FP,PROG)      \
+{                                                      \
+  int *exts = SCM_PROGRAM_EXTS (PROG);                 \
+  if (exts)                                            \
+    {                                                  \
+      /* Export variables */                           \
+      int n = exts[0];                                 \
+      while (n-- > 0)                                  \
+       SCM_VM_EXTERNAL_VARIABLE (ext, n)               \
+         = SCM_VM_FRAME_VARIABLE (FP, exts[n + 1]);    \
+    }                                                  \
+}
+
 #define VM_NEW_FRAME(FP,PROG,DL,SP,RA)                                   \
 {                                                                        \
   int nvars = SCM_PROGRAM_NVARS (PROG); /* the number of local vars */   \
   int nreqs = SCM_PROGRAM_NREQS (PROG); /* the number of required args */ \
   int restp = SCM_PROGRAM_RESTP (PROG); /* have a rest argument or not */ \
+  int nexts = SCM_PROGRAM_NEXTS (PROG);        /* the number of external vars */ \
                                                                          \
-  VM_SETUP_ARGS (PROG, nreqs, restp);                                    \
+  VM_FRAME_INIT_ARGS (PROG, nreqs, restp);                               \
+                                                                         \
+  /* Allocate the new frame */                                           \
   if (sp - nvars - SCM_VM_FRAME_DATA_SIZE < stack_base - 1)              \
     SCM_MISC_ERROR ("FIXME: Stack overflow", SCM_EOL);                   \
   sp -= nvars + SCM_VM_FRAME_DATA_SIZE;                                          \
   FP = sp + SCM_VM_FRAME_DATA_SIZE + 1;                                          \
+                                                                         \
+  /* Setup the new external frame */                                     \
+  if (!SCM_FALSEP (SCM_PROGRAM_ENV (PROG)))                              \
+    ext = SCM_PROGRAM_ENV (PROG);      /* Use program's environment */   \
+  if (nexts)                                                             \
+    {                                                                    \
+      SCM new = SCM_VM_MAKE_EXTERNAL (nexts); /* new external */         \
+      SCM_VM_EXTERNAL_LINK (new) = ext;                                          \
+      ext = new;                                                         \
+    }                                                                    \
+                                                                         \
+  /* Setup the new frame */                                              \
   SCM_VM_FRAME_SIZE (FP) = SCM_MAKINUM (nvars);                                  \
   SCM_VM_FRAME_PROGRAM (FP) = PROG;                                      \
   SCM_VM_FRAME_DYNAMIC_LINK (FP) = DL;                                   \
+  SCM_VM_FRAME_EXTERNAL_LINK (FP) = ext;                                 \
   SCM_VM_FRAME_STACK_POINTER (FP) = SP;                                          \
   SCM_VM_FRAME_RETURN_ADDRESS (FP) = RA;                                 \
-  VM_FRAME_INIT_VARIABLES (FP, nvars);                                   \
-  VM_EXPORT_ARGS (FP, PROG);                                             \
+  VM_FRAME_INIT_LOCAL_VARIABLES (FP, nvars);                             \
+  VM_FRAME_INIT_EXTERNAL_VARIABLES (FP, PROG);                           \
 }
 
 \f

diff --git a/src/vm_system.c b/src/vm_system.c
index f07e5af..fe13fcf 100644 (file)
--- a/src/vm_system.c
+++ b/src/vm_system.c
@@ -47,14 +47,12 @@
  * Variable access
  */
 
-#undef LOCAL_VAR
 #define LOCAL_VAR(OFFSET)      SCM_VM_FRAME_VARIABLE (fp, OFFSET)
 
-#undef EXTERNAL_FOCUS
 #define EXTERNAL_FOCUS(DEPTH)                          \
 {                                                      \
   int depth = DEPTH;                                   \
-  env = SCM_PROGRAM_ENV (SCM_VM_FRAME_PROGRAM (fp));   \
+  env = ext;                                           \
   while (depth-- > 0)                                  \
    {                                                   \
      VM_ASSERT_LINK (env);                             \
@@ -62,16 +60,12 @@
    }                                                   \
 }
 
-#undef EXTERNAL_VAR
 #define EXTERNAL_VAR(OFFSET)   SCM_VM_EXTERNAL_VARIABLE (env, OFFSET)
-#undef EXTERNAL_VAR0
-#define EXTERNAL_VAR0(OFFSET)  SCM_VM_EXTERNAL_VARIABLE (SCM_PROGRAM_ENV (SCM_VM_FRAME_PROGRAM (fp)), OFFSET)
-#define EXTERNAL_VAR1(OFFSET)  SCM_VM_EXTERNAL_VARIABLE (SCM_VM_EXTERNAL_LINK (SCM_PROGRAM_ENV (SCM_VM_FRAME_PROGRAM (fp))), OFFSET)
-#define EXTERNAL_VAR2(OFFSET)  SCM_VM_EXTERNAL_VARIABLE (SCM_VM_EXTERNAL_LINK (SCM_VM_EXTERNAL_LINK (SCM_PROGRAM_ENV (SCM_VM_FRAME_PROGRAM (fp)))), OFFSET)
+#define EXTERNAL_VAR0(OFFSET)  SCM_VM_EXTERNAL_VARIABLE (ext, OFFSET)
+#define EXTERNAL_VAR1(OFFSET)  SCM_VM_EXTERNAL_VARIABLE (SCM_VM_EXTERNAL_LINK (ext), OFFSET)
+#define EXTERNAL_VAR2(OFFSET)  SCM_VM_EXTERNAL_VARIABLE (SCM_VM_EXTERNAL_LINK (SCM_VM_EXTERNAL_LINK (ext)), OFFSET)
 
-#undef TOPLEVEL_VAR
 #define TOPLEVEL_VAR(CELL)             SCM_CDR (CELL)
-#undef TOPLEVEL_VAR_SET
 #define TOPLEVEL_VAR_SET(CELL,OBJ)     SCM_SETCDR (CELL, OBJ)
 
 \f
@@ -399,7 +393,7 @@ SCM_DEFINE_INSTRUCTION (jump, "%jump", INST_ADDR)
 SCM_DEFINE_INSTRUCTION (make_program, "%make-program", INST_CODE)
 {
   SYNC (); /* must be called before GC */
-  RETURN (SCM_MAKE_PROGRAM (FETCH (), SCM_VM_FRAME_PROGRAM (fp)));
+  RETURN (SCM_MAKE_PROGRAM (FETCH (), SCM_VM_FRAME_EXTERNAL_LINK (fp)));
 }
 
 /* Before:
@@ -487,7 +481,7 @@ SCM_DEFINE_INSTRUCTION (tail_call, "%tail-call", INST_INUM)
          int nvars = SCM_PROGRAM_NVARS (ac); /* the number of local vars */
          int nreqs = SCM_PROGRAM_NREQS (ac); /* the number of require args */
          int restp = SCM_PROGRAM_RESTP (ac); /* have a rest argument */
-         VM_SETUP_ARGS (ac, nreqs, restp);
+         VM_FRAME_INIT_ARGS (ac, nreqs, restp);
 
          /* Move arguments */
          nreqs += restp;
@@ -497,7 +491,7 @@ SCM_DEFINE_INSTRUCTION (tail_call, "%tail-call", INST_INUM)
              POP (obj);
              SCM_VM_FRAME_VARIABLE (fp, nvars++) = obj;
            }
-         VM_EXPORT_ARGS (fp, ac);
+         VM_FRAME_INIT_EXTERNAL_VARIABLES (fp, ac);
        }
       else
        /* Dynamic return call */
@@ -545,5 +539,6 @@ SCM_DEFINE_INSTRUCTION (return, "%return", INST_NONE)
   fp = SCM_VM_ADDRESS (SCM_VM_FRAME_DYNAMIC_LINK (last_fp));
   sp = SCM_VM_ADDRESS (SCM_VM_FRAME_STACK_POINTER (last_fp));
   pc = SCM_VM_ADDRESS (SCM_VM_FRAME_RETURN_ADDRESS (last_fp));
+  ext = SCM_VM_FRAME_EXTERNAL_LINK (fp);
   NEXT;
 }