Fix bytevector-fill! to accept fill arguments greater than 127.

[bpt/guile.git] / libguile / control.c

diff --git a/libguile/control.c b/libguile/control.c
index 6c20675..f8d2d60 100644 (file)
--- a/libguile/control.c
+++ b/libguile/control.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2010  Free Software Foundation, Inc.
+/* Copyright (C) 2010, 2011, 2012  Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -20,6 +20,8 @@
 #  include <config.h>
 #endif
 
+#include <alloca.h>
+
 #include "libguile/_scm.h"
 #include "libguile/control.h"
 #include "libguile/objcodes.h"
@@ -53,18 +55,18 @@ scm_c_make_prompt (SCM k, SCM *fp, SCM *sp, scm_t_uint8 *abort_ip,
 
 /* Only to be called if the SCM_PROMPT_SETJMP returns 1 */
 SCM
-scm_i_prompt_pop_abort_args_x (SCM prompt)
+scm_i_prompt_pop_abort_args_x (SCM vm)
 {
   size_t i, n;
   SCM vals = SCM_EOL;
 
-  n = scm_to_size_t (SCM_PROMPT_REGISTERS (prompt)->sp[0]);
+  n = scm_to_size_t (SCM_VM_DATA (vm)->sp[0]);
   for (i = 0; i < n; i++)
-    vals = scm_cons (SCM_PROMPT_REGISTERS (prompt)->sp[-(i + 1)], vals);
+    vals = scm_cons (SCM_VM_DATA (vm)->sp[-(i + 1)], vals);
 
   /* The abort did reset the VM's registers, but then these values
      were pushed on; so we need to pop them ourselves. */
-  SCM_VM_DATA (scm_the_vm ())->sp -= n + 1;
+  SCM_VM_DATA (vm)->sp -= n + 1;
   /* FIXME NULLSTACK */
 
   return vals;
@@ -79,37 +81,35 @@ scm_i_prompt_pop_abort_args_x (SCM prompt)
 #define META_HEADER(meta)         meta, 0, 0, 0, 0,      0, 0, 0
 #endif
 
-#define ALIGN_PTR(type,p,align) (type*)(ROUND_UP (((scm_t_bits)p), align))
+#define OBJCODE_TAG SCM_MAKE_OBJCODE_TAG (SCM_OBJCODE_TYPE_STATIC, 0)
 
-#ifdef SCM_ALIGNED
-#define SCM_DECLARE_STATIC_ALIGNED_ARRAY(type, sym)\
+#if defined (SCM_ALIGNED)
+#define SCM_DECLARE_STATIC_ALIGNED_ARRAY(type, sym)     \
 static const type sym[]
-#define SCM_STATIC_ALIGNED_ARRAY(alignment, type, sym)\
+#define SCM_STATIC_ALIGNED_ARRAY(alignment, type, sym)  \
 static SCM_ALIGNED (alignment) const type sym[]
-#else
-#define SCM_DECLARE_STATIC_ALIGNED_ARRAY(type, sym)\
-static type *sym
-#define SCM_STATIC_ALIGNED_ARRAY(alignment, type, sym)                  \
-SCM_SNARF_INIT(sym = scm_malloc (sizeof(sym##__unaligned) + alignment - 1); \
-               sym = ALIGN_PTR (type, sym, alignment);                  \
-               memcpy (sym, sym##__unaligned, sizeof(sym##__unaligned));) \
-static type *sym = NULL;                                                \
-static const type sym##__unaligned[]
-#endif
-
-#define STATIC_OBJCODE_TAG                                      \
-  SCM_PACK (scm_tc7_objcode | (SCM_F_OBJCODE_IS_STATIC << 8))
-
 #define SCM_STATIC_OBJCODE(sym)                                         \
   SCM_DECLARE_STATIC_ALIGNED_ARRAY (scm_t_uint8, sym##__bytecode);      \
   SCM_STATIC_ALIGNED_ARRAY (8, scm_t_cell, sym##__cells) = {            \
-    { STATIC_OBJCODE_TAG, SCM_PACK (sym##__bytecode) },                 \
+    { SCM_PACK (OBJCODE_TAG), SCM_PACK (sym##__bytecode) },             \
     { SCM_BOOL_F, SCM_PACK (0) }                                        \
   };                                                                    \
   static const SCM sym = SCM_PACK (sym##__cells);                       \
   SCM_STATIC_ALIGNED_ARRAY (8, scm_t_uint8, sym##__bytecode)
+#else
+#define SCM_STATIC_OBJCODE(sym)                                         \
+static SCM sym;                                                         \
+static scm_t_uint8 *sym##_bytecode;                                     \
+SCM_SNARF_INIT(sym##_bytecode = scm_gc_malloc_pointerless (sizeof(sym##_bytecode__unaligned), "partial continuation stub"); \
+               memcpy (sym##_bytecode, sym##_bytecode__unaligned, sizeof(sym##_bytecode__unaligned));) \
+SCM_SNARF_INIT(sym = scm_double_cell (OBJCODE_TAG,                      \
+                                      (scm_t_bits)sym##_bytecode,       \
+                                      SCM_UNPACK (SCM_BOOL_F),          \
+                                      0);)                              \
+static const scm_t_uint8 sym##_bytecode__unaligned[]
+#endif
+
 
-  
 SCM_STATIC_OBJCODE (cont_objcode) = {
   /* Like in continuations.c, but with partial-cont-call. */
   OBJCODE_HEADER (8, 19),
@@ -162,7 +162,7 @@ reify_partial_continuation (SCM vm, SCM prompt, SCM extwinds,
   /* Since non-escape continuations should begin with a thunk application, the
      first bit of the stack should be a frame, with the saved fp equal to the fp
      that was current when the prompt was made. */
-  if ((SCM*)(SCM_PROMPT_REGISTERS (prompt)->sp[1])
+  if ((SCM*)SCM_UNPACK (SCM_PROMPT_REGISTERS (prompt)->sp[1])
       != SCM_PROMPT_REGISTERS (prompt)->fp)
     abort ();
 
@@ -212,10 +212,14 @@ scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv, scm_t_int64 cookie)
 
   /* Unwind once more, beyond the prompt. */
   winds = SCM_CDR (winds), delta++;
-  
+
   /* Unwind */
   scm_dowinds (winds, delta);
 
+  /* Unwinding may have changed the current thread's VM, so use the
+     new one.  */
+  vm = scm_the_vm ();
+
   /* Restore VM regs */
   SCM_VM_DATA (vm)->fp = SCM_PROMPT_REGISTERS (prompt)->fp;
   SCM_VM_DATA (vm)->sp = SCM_PROMPT_REGISTERS (prompt)->sp;
@@ -243,7 +247,8 @@ SCM_DEFINE (scm_at_abort, "@abort", 2, 0, 0, (SCM tag, SCM args),
 #define FUNC_NAME s_scm_at_abort
 {
   SCM *argv;
-  size_t i, n;
+  size_t i;
+  long n;
 
   SCM_VALIDATE_LIST_COPYLEN (SCM_ARG2, args, n);
   argv = alloca (sizeof (SCM)*n);