SCM_I_IS_VECTOR only true for tc7_vector, not weak vectors

* libguile/tags.h (SCM_TYP7S, SCM_HAS_TYP7S): Remove these, as we no
  longer do the differs-by-one-bit thing for vectors and weak vectors.
* libguile/vectors.h (SCM_I_IS_VECTOR): Use SCM_HAS_TYP7.
  (SCM_I_IS_NONWEAK_VECTOR): Remove.
* libguile/vm-engine.c (vector-length, vector-ref, vector-set!)
  (vector-ref/immediate, vector-set!/immediate): We can inline these
  instructions completely now.

* libguile/vm.c (vm_error_not_a_vector, vm_error_out_of_range): New
  error conditions.

5 files changed, 50 insertions, 56 deletions

diff --git a/libguile/tags.h b/libguile/tags.h
index 4a1b192dd..53d40d89b 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -3,7 +3,7 @@
 #ifndef SCM_TAGS_H
 #define SCM_TAGS_H
 
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012,2013
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012,2013,2014
  * Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
@@ -335,14 +335,9 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
  *   111:  the cell belongs to some other heap object.
  *
  * tc7 (for tc3==1x1):
- *   See below for the list of types.  Note the special case of scm_tc7_vector
- *   and scm_tc7_wvect:  vectors and weak vectors are treated the same in many
- *   cases.  Thus, their tc7-codes are chosen to only differ in one bit.  This
- *   makes it possible to check an object at the same time for being a vector
- *   or a weak vector by comparing its tc7 code with that bit masked (using
- *   the TYP7S macro).  Three more special tc7-codes are of interest:
- *   numbers, ports and smobs in fact each represent collections of types,
- *   which are subdivided using tc16-codes.
+ *   See below for the list of types.  Three special tc7-codes are of
+ *   interest: numbers, ports and smobs in fact each represent
+ *   collections of types, which are subdivided using tc16-codes.
  *
  * tc16 (for tc7==scm_tc7_smob):
  *   The largest part of the space of smob types is not subdivided in a
@@ -396,11 +391,9 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
 
 #define SCM_ITAG7(x) 		(127 & SCM_UNPACK (x))
 #define SCM_TYP7(x) 		(0x7f &        SCM_CELL_TYPE (x))
-#define SCM_TYP7S(x) 		((0x7f & ~2) & SCM_CELL_TYPE (x))
 #define SCM_HAS_HEAP_TYPE(x, type, tag)                         \
   (SCM_NIMP (x) && type (x) == (tag))
 #define SCM_HAS_TYP7(x, tag)    (SCM_HAS_HEAP_TYPE (x, SCM_TYP7, tag))
-#define SCM_HAS_TYP7S(x, tag)   (SCM_HAS_HEAP_TYPE (x, SCM_TYP7S, tag))
 
 /* If you change these numbers, change them also in (system vm
    assembler).  */
diff --git a/libguile/vectors.c b/libguile/vectors.c
index 1c659dee2..bb42e00ba 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -46,13 +46,13 @@
 int
 scm_is_vector (SCM obj)
 {
-  return SCM_I_IS_NONWEAK_VECTOR (obj);
+  return SCM_I_IS_VECTOR (obj);
 }
 
 int
 scm_is_simple_vector (SCM obj)
 {
-  return SCM_I_IS_NONWEAK_VECTOR (obj);
+  return SCM_I_IS_VECTOR (obj);
 }
 
 const SCM *
diff --git a/libguile/vectors.h b/libguile/vectors.h
index 4fe72b0a4..995f64f4e 100644
--- a/libguile/vectors.h
+++ b/libguile/vectors.h
@@ -3,7 +3,7 @@
 #ifndef SCM_VECTORS_H
 #define SCM_VECTORS_H
 
-/* Copyright (C) 1995,1996,1998,2000,2001,2002,2004,2005, 2006, 2008, 2009, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001,2002,2004,2005, 2006, 2008, 2009, 2011, 2014 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
@@ -63,8 +63,7 @@ SCM_API SCM *scm_vector_writable_elements (SCM vec,
 
 /* Internals */
 
-#define SCM_I_IS_VECTOR(x)     (SCM_HAS_TYP7S (x, scm_tc7_vector))
-#define SCM_I_IS_NONWEAK_VECTOR(x) (SCM_HAS_TYP7 (x, scm_tc7_vector))
+#define SCM_I_IS_VECTOR(x)     (SCM_HAS_TYP7 (x, scm_tc7_vector))
 #define SCM_I_VECTOR_ELTS(x)   ((const SCM *) SCM_I_VECTOR_WELTS (x))
 #define SCM_I_VECTOR_WELTS(x)  (SCM_CELL_OBJECT_LOC (x, 1))
 #define SCM_I_VECTOR_LENGTH(x) (((size_t) SCM_CELL_WORD_0 (x)) >> 8)
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index b5cd09541..e95aad54d 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -2574,13 +2574,9 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
   VM_DEFINE_OP (95, vector_length, "vector-length", OP1 (U8_U12_U12) | OP_DST)
     {
       ARGS1 (vect);
-      if (SCM_LIKELY (SCM_I_IS_VECTOR (vect)))
-        RETURN (SCM_I_MAKINUM (SCM_I_VECTOR_LENGTH (vect)));
-      else
-        {
-          SYNC_IP ();
-          RETURN (scm_vector_length (vect));
-        }
+      VM_ASSERT (SCM_I_IS_VECTOR (vect),
+                 vm_error_not_a_vector ("vector-ref", vect));
+      RETURN (SCM_I_MAKINUM (SCM_I_VECTOR_LENGTH (vect)));
     }
 
   /* vector-ref dst:8 src:8 idx:8
@@ -2592,16 +2588,13 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
     {
       scm_t_signed_bits i = 0;
       ARGS2 (vect, idx);
-      if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect)
-                      && SCM_I_INUMP (idx)
-                      && ((i = SCM_I_INUM (idx)) >= 0)
-                      && i < SCM_I_VECTOR_LENGTH (vect)))
-        RETURN (SCM_I_VECTOR_ELTS (vect)[i]);
-      else
-        {
-          SYNC_IP ();
-          RETURN (scm_vector_ref (vect, idx));
-        }
+      VM_ASSERT (SCM_I_IS_VECTOR (vect),
+                 vm_error_not_a_vector ("vector-ref", vect));
+      VM_ASSERT ((SCM_I_INUMP (idx)
+                  && ((i = SCM_I_INUM (idx)) >= 0)
+                  && i < SCM_I_VECTOR_LENGTH (vect)),
+                 vm_error_out_of_range ("vector-ref", idx));
+      RETURN (SCM_I_VECTOR_ELTS (vect)[i]);
     }
 
   /* vector-ref/immediate dst:8 src:8 idx:8
@@ -2616,11 +2609,11 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
       
       UNPACK_8_8_8 (op, dst, src, idx);
       v = LOCAL_REF (src);
-      if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (v)
-                      && idx < SCM_I_VECTOR_LENGTH (v)))
-        LOCAL_SET (dst, SCM_I_VECTOR_ELTS (LOCAL_REF (src))[idx]);
-      else
-        LOCAL_SET (dst, scm_c_vector_ref (v, idx));
+      VM_ASSERT (SCM_I_IS_VECTOR (v),
+                 vm_error_not_a_vector ("vector-ref", v));
+      VM_ASSERT (idx < SCM_I_VECTOR_LENGTH (v),
+                 vm_error_out_of_range ("vector-ref", scm_from_size_t (idx)));
+      LOCAL_SET (dst, SCM_I_VECTOR_ELTS (LOCAL_REF (src))[idx]);
       NEXT (1);
     }
 
@@ -2639,16 +2632,13 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
       idx = LOCAL_REF (idx_var);
       val = LOCAL_REF (src);
 
-      if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect)
-                      && SCM_I_INUMP (idx)
-                      && ((i = SCM_I_INUM (idx)) >= 0)
-                      && i < SCM_I_VECTOR_LENGTH (vect)))
-        SCM_I_VECTOR_WELTS (vect)[i] = val;
-      else
-        {
-          SYNC_IP ();
-          scm_vector_set_x (vect, idx, val);
-        }
+      VM_ASSERT (SCM_I_IS_VECTOR (vect),
+                 vm_error_not_a_vector ("vector-ref", vect));
+      VM_ASSERT ((SCM_I_INUMP (idx)
+                  && ((i = SCM_I_INUM (idx)) >= 0)
+                  && i < SCM_I_VECTOR_LENGTH (vect)),
+                 vm_error_out_of_range ("vector-ref", idx));
+      SCM_I_VECTOR_WELTS (vect)[i] = val;
       NEXT (1);
     }
 
@@ -2666,14 +2656,11 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
       vect = LOCAL_REF (dst);
       val = LOCAL_REF (src);
 
-      if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect)
-                      && idx < SCM_I_VECTOR_LENGTH (vect)))
-        SCM_I_VECTOR_WELTS (vect)[idx] = val;
-      else
-        {
-          SYNC_IP ();
-          scm_vector_set_x (vect, scm_from_uint8 (idx), val);
-        }
+      VM_ASSERT (SCM_I_IS_VECTOR (vect),
+                 vm_error_not_a_vector ("vector-ref", vect));
+      VM_ASSERT (idx < SCM_I_VECTOR_LENGTH (vect),
+                 vm_error_out_of_range ("vector-ref", scm_from_size_t (idx)));
+      SCM_I_VECTOR_WELTS (vect)[idx] = val;
       NEXT (1);
     }
 
diff --git a/libguile/vm.c b/libguile/vm.c
index b0918b6bf..4c67d5040 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -423,6 +423,8 @@ static void vm_error_improper_list (SCM x) SCM_NORETURN SCM_NOINLINE;
 static void vm_error_not_a_pair (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE;
 static void vm_error_not_a_bytevector (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE;
 static void vm_error_not_a_struct (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE;
+static void vm_error_not_a_vector (const char *subr, SCM v) SCM_NORETURN SCM_NOINLINE;
+static void vm_error_out_of_range (const char *subr, SCM k) SCM_NORETURN SCM_NOINLINE;
 static void vm_error_no_values (void) SCM_NORETURN SCM_NOINLINE;
 static void vm_error_not_enough_values (void) SCM_NORETURN SCM_NOINLINE;
 static void vm_error_wrong_number_of_values (scm_t_uint32 expected) SCM_NORETURN SCM_NOINLINE;
@@ -548,6 +550,19 @@ vm_error_not_a_struct (const char *subr, SCM x)
 }
 
 static void
+vm_error_not_a_vector (const char *subr, SCM x)
+{
+  scm_wrong_type_arg_msg (subr, 1, x, "vector");
+}
+
+static void
+vm_error_out_of_range (const char *subr, SCM k)
+{
+  scm_to_size_t (k);
+  scm_out_of_range (subr, k);
+}
+
+static void
 vm_error_no_values (void)
 {
   vm_error ("Zero values returned to single-valued continuation",