Merge remote-tracking branch 'local-2.0/stable-2.0'
authorAndy Wingo <wingo@pobox.com>
Thu, 10 May 2012 11:02:11 +0000 (13:02 +0200)
committerAndy Wingo <wingo@pobox.com>
Thu, 10 May 2012 11:02:11 +0000 (13:02 +0200)
Conflicts:
libguile/vm-engine.c
libguile/vm-i-system.c
libguile/vm.c

1  2 
libguile/frames.c
libguile/vm-engine.c
libguile/vm-i-system.c
libguile/vm.c

Simple merge
@@@ -86,49 -86,55 +86,73 @@@ VM_NAME (SCM vm, SCM program, SCM *argv
    jump_table = jump_table_pointer;
  #endif
  
-   /* Initialization */
-   {
-     SCM prog = program;
-     /* Boot program */
-     program = vm_make_boot_program (nargs);
-     /* Initial frame */
-     CACHE_REGISTER ();
-     PUSH (SCM_PACK (fp)); /* dynamic link */
-     PUSH (SCM_PACK (0)); /* mvra */
-     PUSH (SCM_PACK (ip)); /* ra */
-     CACHE_PROGRAM ();
-     PUSH (program);
-     fp = sp + 1;
-     ip = SCM_C_OBJCODE_BASE (bp);
-     /* MV-call frame, function & arguments */
-     PUSH (SCM_PACK (0)); /* dynamic link */
-     PUSH (SCM_PACK (0)); /* mvra */
-     PUSH (SCM_PACK (0)); /* ra */
-     PUSH (prog);
-     VM_ASSERT (sp + nargs < stack_limit, vm_error_too_many_args (nargs));
-     while (nargs--)
-       PUSH (*argv++);
-   }
 +  if (SCM_I_SETJMP (registers))
 +    {
 +      /* Non-local return.  Cache the VM registers back from the vp, and
 +         go to the handler.
 +
 +         Note, at this point, we must assume that any variable local to
 +         vm_engine that can be assigned *has* been assigned. So we need to pull
 +         all our state back from the ip/fp/sp.
 +      */
 +      CACHE_REGISTER ();
 +      program = SCM_FRAME_PROGRAM (fp);
 +      CACHE_PROGRAM ();
 +      /* The stack contains the values returned to this continuation,
 +         along with a number-of-values marker -- like an MV return. */
 +      ABORT_CONTINUATION_HOOK ();
 +      NEXT;
 +    }
 +
 -      else if (SCM_NIMP (program) && SCM_TYP7 (program) == scm_tc7_smob
+   /* Initial frame */
+   CACHE_REGISTER ();
+   PUSH (SCM_PACK (fp)); /* dynamic link */
+   PUSH (SCM_PACK (0)); /* mvra */
+   PUSH (SCM_PACK (ip)); /* ra */
+   PUSH (boot_continuation);
+   fp = sp + 1;
+   ip = SCM_C_OBJCODE_BASE (SCM_PROGRAM_DATA (boot_continuation));
+   /* MV-call frame, function & arguments */
+   PUSH (SCM_PACK (fp)); /* dynamic link */
+   PUSH (SCM_PACK (ip + 1)); /* mvra */
+   PUSH (SCM_PACK (ip)); /* ra */
+   PUSH (program);
+   fp = sp + 1;
+   VM_ASSERT (sp + nargs < stack_limit, vm_error_too_many_args (nargs));
+   while (nargs--)
+     PUSH (*argv++);
+   PUSH_CONTINUATION_HOOK ();
+  apply:
+   program = fp[-1];
+   if (!SCM_PROGRAM_P (program))
+     {
+       if (SCM_STRUCTP (program) && SCM_STRUCT_APPLICABLE_P (program))
+         fp[-1] = SCM_STRUCT_PROCEDURE (program);
 -          fp[-1] = SCM_SMOB_DESCRIPTOR (program).apply_trampoline_objcode;
++      else if (SCM_HAS_TYP7 (program, scm_tc7_smob)
+                && SCM_SMOB_APPLICABLE_P (program))
+         {
+           /* (smob arg0 ... argN) => (apply-smob smob arg0 ... argN) */
+           int i;
+           PUSH (SCM_BOOL_F);
+           for (i = sp - fp; i >= 0; i--)
+             fp[i] = fp[i - 1];
++          fp[-1] = SCM_SMOB_DESCRIPTOR (program).apply_trampoline;
+         }
+       else
+         {
+           SYNC_ALL();
+           vm_error_wrong_type_apply (program);
+         }
+       goto apply;
+     }
+   CACHE_PROGRAM ();
+   ip = SCM_C_OBJCODE_BASE (bp);
+   APPLY_HOOK ();
  
    /* Let's go! */
    NEXT;
@@@ -828,56 -798,37 +811,37 @@@ VM_DEFINE_INSTRUCTION (56, tail_call, "
    nargs = FETCH ();
  
   vm_tail_call:
-   program = sp[-nargs];
    VM_HANDLE_INTERRUPTS;
  
-   if (SCM_UNLIKELY (!SCM_PROGRAM_P (program)))
-     {
-       if (SCM_STRUCTP (program) && SCM_STRUCT_APPLICABLE_P (program))
-         {
-           sp[-nargs] = SCM_STRUCT_PROCEDURE (program);
-           goto vm_tail_call;
-         }
-       else if (SCM_HAS_TYP7 (program, scm_tc7_smob)
-                && SCM_SMOB_APPLICABLE_P (program))
-         {
-           PUSH (program);
-           prepare_smob_call (sp, ++nargs, program);
-           goto vm_tail_call;
-         }
-       else
-         {
-           SYNC_ALL();
-           vm_error_wrong_type_apply (program);
-         }
-     }
-   else
-     {
-       int i;
+   {
+     int i;
  #ifdef VM_ENABLE_STACK_NULLING
-       SCM *old_sp = sp;
-       CHECK_STACK_LEAK ();
+     SCM *old_sp = sp;
+     CHECK_STACK_LEAK ();
  #endif
  
-       /* switch programs */
-       CACHE_PROGRAM ();
-       /* shuffle down the program and the arguments */
-       for (i = -1, sp = sp - nargs + 1; i < nargs; i++)
-         SCM_FRAME_STACK_ADDRESS (fp)[i] = sp[i];
+     /* shuffle down the program and the arguments */
+     for (i = -1, sp = sp - nargs + 1; i < nargs; i++)
+       SCM_FRAME_STACK_ADDRESS (fp)[i] = sp[i];
  
-       sp = fp + i - 1;
+     sp = fp + i - 1;
  
-       NULLSTACK (old_sp - sp);
+     NULLSTACK (old_sp - sp);
+   }
  
-       ip = SCM_C_OBJCODE_BASE (bp);
+   program = fp[-1];
  
-       APPLY_HOOK ();
-       NEXT;
-     }
+   if (SCM_UNLIKELY (!SCM_PROGRAM_P (program)))
+     goto apply;
+   CACHE_PROGRAM ();
+   ip = SCM_C_OBJCODE_BASE (bp);
+   APPLY_HOOK ();
+   NEXT;
  }
  
 -VM_DEFINE_INSTRUCTION (55, subr_call, "subr-call", 1, -1, -1)
 +VM_DEFINE_INSTRUCTION (57, subr_call, "subr-call", 1, -1, -1)
  {
    SCM pointer, ret;
    SCM (*subr)();
diff --cc libguile/vm.c
@@@ -1124,6 -1060,33 +1060,33 @@@ SCM scm_load_compiled_with_vm (SCM file
    return scm_c_vm_run (scm_the_vm (), program, NULL, 0);
  }
  
 -
 -  const scm_t_uint8 text[] = {
+   
+ static SCM
+ make_boot_program (void)
+ {
+   struct scm_objcode *bp;
+   size_t bp_size;
+   SCM u8vec, ret;
 -  u8vec = scm_c_take_gc_bytevector ((scm_t_int8*)bp, bp_size);
++    
++  const scm_t_uint8 text[] = { 
+     scm_op_make_int8_1,
+     scm_op_halt
+   };
+   bp_size = sizeof (struct scm_objcode) + sizeof (text);
+   bp = scm_gc_malloc_pointerless (bp_size, "boot-program");
+   memcpy (SCM_C_OBJCODE_BASE (bp), text, sizeof (text));
+   bp->len = sizeof(text);
+   bp->metalen = 0;
++  u8vec = scm_c_take_gc_bytevector ((scm_t_int8*)bp, bp_size, SCM_BOOL_F);
+   ret = scm_make_program (scm_bytecode_to_native_objcode (u8vec),
+                           SCM_BOOL_F, SCM_BOOL_F);
+   SCM_SET_CELL_WORD_0 (ret, (SCM_CELL_WORD_0 (ret) | SCM_F_PROGRAM_IS_BOOT));
+   return ret;
+ }
  void
  scm_bootstrap_vm (void)
  {