redo the SCM tagging strategy

Currently failing some guardian tests.

* libguile/tags.h: Refactor tagging so that tc3 bits for a pair live in
  the SCM value, not in the heap words.  Do the same for structs.  This
  more rational tagging strategy will make native code generation
  easier.  Note that this means that to check a heap pointer for its
  type, you first have to ensure that it has the expected tc3, as not
  all the type bits are on the heap.
  (SCM_TYP3): Check the SCM tag type, not the bits in the cell.
  (SCM_HAS_TYP3): New helper.
  (SCM_I_CONSP): Redefine to just check the typ3.
  (scm_tcs_cons_imcar, scm_tcs_cons_nimcar, scm_tcs_struct): Remove, as
  they are no longer necessary.

* libguile/array-handle.c (scm_i_array_implementation_for_obj): Check
  for heap objects before checking type bits, so we don't check pairs.

* libguile/evalext.c (scm_self_evaluating_p):
* libguile/gc.c (scm_i_tag_name):
* libguile/goops.c (scm_class_of)
* libguile/hash.c (scm_hasher):
* libguile/print.c (iprin1): Adapt to tagging changes.

* libguile/gc.c (scm_storage_prehistory): Register all displacements
  here.  There are the same displacements as before, unfortunately.

* libguile/list.c (SCM_I_CONS):
* libguile/pairs.c (scm_cons):
* libguile/pairs.h (scm_is_pair):
* libguile/vm-engine.h (CONS): Tag pairs with scm_tc3_pair.

* libguile/modules.c (scm_post_boot_init_modules):
* libguile/modules.h (SCM_MODULEP):
* libguile/struct.c (struct_finalizer_trampoline, scm_i_alloc_struct):
  (scm_make_vtable_vtable):
* libguile/struct.h (SCM_STRUCTP, SCM_STRUCT_VTABLE_DATA):
  (SCM_STRUCT_VTABLE_SLOTS):
* libguile/vm-i-scheme.c (make-struct): Adapt to struct tagging
  changes.

* libguile/numbers.h (SCM_I_INUMP):
* module/rnrs/arithmetic/fixnums.scm (fixnum?, inline-fixnum?): Adapt
  to the new fixnum tag.

* libguile/numbers.h (SCM_INEXACTP): Make sure of the tc3 before looking
  at the cell type.

17 files changed, 222 insertions, 299 deletions

diff --git a/libguile/array-handle.c b/libguile/array-handle.c
index 7114f78e0..152eea54a 100644
--- a/libguile/array-handle.c
+++ b/libguile/array-handle.c
@@ -51,9 +51,13 @@ scm_t_array_implementation*
 scm_i_array_implementation_for_obj (SCM obj)
 {
   int i;
+
+  if (!(SCM_HAS_TYP3 (obj, scm_tc3_heap)
+        || SCM_HAS_TYP3 (obj, scm_tc3_struct)))
+    return NULL;
+
   for (i = 0; i < num_array_impls_registered; i++)
-    if (SCM_NIMP (obj)
-        && (SCM_CELL_TYPE (obj) & array_impls[i].mask) == array_impls[i].tag)
+    if ((SCM_CELL_TYPE (obj) & array_impls[i].mask) == array_impls[i].tag)
       return &array_impls[i];
   return NULL;
 }
diff --git a/libguile/evalext.c b/libguile/evalext.c
index 3e04a7a59..7c258325c 100644
--- a/libguile/evalext.c
+++ b/libguile/evalext.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009, 2010, 2011, 2013 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
@@ -69,7 +69,11 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
     case scm_tc3_imm24:
 	/* characters, booleans, other immediates */
       return scm_from_bool (!scm_is_null_and_not_nil (obj));
+    case scm_tc3_struct:
+      return SCM_BOOL_T;
     case scm_tc3_cons:
+      return SCM_BOOL_F;
+    case scm_tc3_heap:
       switch (SCM_TYP7 (obj))
 	{
 	case scm_tc7_vector:
@@ -91,15 +95,15 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
 	case scm_tc7_bytevector:
 	case scm_tc7_array:
 	case scm_tc7_bitvector:
-	case scm_tcs_struct:
 	  return SCM_BOOL_T;
 	default:
 	  return SCM_BOOL_F;
 	}
+    default:
+      SCM_MISC_ERROR ("Internal error: Object ~S has unknown type",
+                      scm_list_1 (obj));
+      return SCM_UNSPECIFIED; /* never reached */
     }
-  SCM_MISC_ERROR ("Internal error: Object ~S has unknown type",
-		  scm_list_1 (obj));
-  return SCM_UNSPECIFIED; /* never reached */
 }
 #undef FUNC_NAME
 
diff --git a/libguile/gc.c b/libguile/gc.c
index 71efd032c..9b97886b0 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -640,12 +640,17 @@ scm_storage_prehistory ()
 
   GC_expand_hp (SCM_DEFAULT_INIT_HEAP_SIZE_2);
 
-  /* We only need to register a displacement for those types for which the
-     higher bits of the type tag are used to store a pointer (that is, a
-     pointer to an 8-octet aligned region).  For `scm_tc3_struct', this is
-     handled in `scm_alloc_struct ()'.  */
+  /* SCM values pointing to pairs and structs are tagged.  */
   GC_REGISTER_DISPLACEMENT (scm_tc3_cons);
-  /* GC_REGISTER_DISPLACEMENT (scm_tc3_unused); */
+  GC_REGISTER_DISPLACEMENT (scm_tc3_struct);
+
+  /* The first word of a struct points to `SCM_STRUCT_DATA (vtable)',
+     and `SCM_STRUCT_DATA (vtable)' is 2 words after VTABLE by default.
+     Also, in the general case, `SCM_STRUCT_DATA (obj)' points 2 words
+     after the beginning of a GC-allocated region; that region is
+     different from that of OBJ once OBJ has undergone class
+     redefinition.  */
+  GC_REGISTER_DISPLACEMENT (2 * sizeof (scm_t_bits));
 
   /* Sanity check.  */
   if (!GC_is_visible (&scm_protects))
@@ -950,12 +955,6 @@ scm_i_tag_name (scm_t_bits tag)
 {
   switch (tag & 0x7f) /* 7 bits */
     {
-    case scm_tcs_struct:
-      return "struct";
-    case scm_tcs_cons_imcar:
-      return "cons (immediate car)";
-    case scm_tcs_cons_nimcar:
-      return "cons (non-immediate car)";
     case scm_tc7_pointer:
       return "foreign";
     case scm_tc7_hashtable:
diff --git a/libguile/goops.c b/libguile/goops.c
index 355e5efa4..2d6dfb8f0 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -247,10 +247,26 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
         return scm_class_unknown;
 
     case scm_tc3_cons:
+      return scm_class_pair;
+
+    case scm_tc3_struct:
+      if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS_VALID)
+        return SCM_CLASS_OF (x);
+      else if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS)
+        {
+          /* Goops object */
+          if (! scm_is_false (SCM_OBJ_CLASS_REDEF (x)))
+            scm_change_object_class (x,
+                                     SCM_CLASS_OF (x),         /* old */
+                                     SCM_OBJ_CLASS_REDEF (x)); /* new */
+          return SCM_CLASS_OF (x);
+        }
+      else
+        return scm_i_define_class_for_vtable (SCM_CLASS_OF (x));
+
+    case scm_tc3_heap:
       switch (SCM_TYP7 (x))
 	{
-	case scm_tcs_cons_nimcar:
-	  return scm_class_pair;
 	case scm_tc7_symbol:
 	  return scm_class_symbol;
 	case scm_tc7_vector:
@@ -315,30 +331,12 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
 				    ? SCM_INOUT_PCLASS_INDEX | SCM_PTOBNUM (x)
 				    : SCM_OUT_PCLASS_INDEX | SCM_PTOBNUM (x))
 				 : SCM_IN_PCLASS_INDEX | SCM_PTOBNUM (x))];
-	case scm_tcs_struct:
-	  if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS_VALID)
-	    return SCM_CLASS_OF (x);
-	  else if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS)
-	    {
-	      /* Goops object */
-	      if (! scm_is_false (SCM_OBJ_CLASS_REDEF (x)))
-		scm_change_object_class (x,
-					 SCM_CLASS_OF (x),         /* old */
-					 SCM_OBJ_CLASS_REDEF (x)); /* new */
-	      return SCM_CLASS_OF (x);
-	    }
-	  else
-            return scm_i_define_class_for_vtable (SCM_CLASS_OF (x));
 	default:
-	  if (scm_is_pair (x))
-	    return scm_class_pair;
-	  else
-	    return scm_class_unknown;
+          return scm_class_unknown;
 	}
 
-    case scm_tc3_struct:
-    case scm_tc3_tc7_1:
-    case scm_tc3_tc7_2:
+    case scm_tc3_unused_1:
+    case scm_tc3_unused_2:
       /* case scm_tc3_unused: */
       /* Never reached */
       break;
diff --git a/libguile/hash.c b/libguile/hash.c
index 740dac11f..d1a8ed1a5 100644
--- a/libguile/hash.c
+++ b/libguile/hash.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1995, 1996, 1997, 2000, 2001, 2003, 2004, 2006, 2008,
- *   2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+ *   2009, 2010, 2011, 2012, 2013 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
@@ -306,54 +306,61 @@ scm_raw_ihash (SCM obj, size_t depth)
   if (SCM_IMP (obj))
     return scm_raw_ihashq (SCM_UNPACK (obj));
 
-  switch (SCM_TYP7(obj))
+  switch (SCM_TYP3 (obj))
     {
-      /* FIXME: do better for structs, variables, ...  Also the hashes
-         are currently associative, which ain't the right thing.  */
-    case scm_tc7_smob:
-      return scm_raw_ihashq (SCM_TYP16 (obj));
-    case scm_tc7_number:
-      if (scm_is_integer (obj))
-        {
-          SCM n = SCM_I_MAKINUM (SCM_MOST_POSITIVE_FIXNUM);
-          if (scm_is_inexact (obj))
-            obj = scm_inexact_to_exact (obj);
-          return scm_raw_ihashq (scm_to_ulong (scm_modulo (obj, n)));
-        }
-      else
-        return scm_i_string_hash (scm_number_to_string (obj, scm_from_int (10)));
-    case scm_tc7_string:
-      return scm_i_string_hash (obj);
-    case scm_tc7_symbol:
-      return scm_i_symbol_hash (obj);
-    case scm_tc7_pointer:
-      return scm_raw_ihashq ((scm_t_uintptr) SCM_POINTER_VALUE (obj));
-    case scm_tc7_wvect:
-    case scm_tc7_vector:
-      {
-	size_t len = SCM_SIMPLE_VECTOR_LENGTH (obj);
-        size_t i = depth / 2;
-        unsigned long h = scm_raw_ihashq (SCM_CELL_WORD_0 (obj));
-        if (len)
-          while (i--)
-            h ^= scm_raw_ihash (scm_c_vector_ref (obj, h % len), i);
-        return h;
-      }
-    case scm_tcs_cons_imcar: 
-    case scm_tcs_cons_nimcar:
+    case scm_tc3_cons:
       if (depth)
         return (scm_raw_ihash (SCM_CAR (obj), depth / 2)
                 ^ scm_raw_ihash (SCM_CDR (obj), depth / 2));
       else
         return scm_raw_ihashq (scm_tc3_cons);
-    case scm_tcs_struct:
+
+    case scm_tc3_struct:
       return scm_i_struct_hash (obj, depth);
+
+    case scm_tc3_heap:
+      switch SCM_TYP7(obj)
+        {
+        case scm_tc7_smob:
+          return scm_raw_ihashq (SCM_TYP16 (obj));
+        case scm_tc7_number:
+          if (scm_is_integer (obj))
+            {
+              SCM n = SCM_I_MAKINUM (SCM_MOST_POSITIVE_FIXNUM);
+              if (scm_is_inexact (obj))
+                obj = scm_inexact_to_exact (obj);
+              return scm_raw_ihashq (scm_to_ulong (scm_modulo (obj, n)));
+            }
+          else
+            return scm_i_string_hash (scm_number_to_string (obj,
+                                                            scm_from_int (10)));
+        case scm_tc7_string:
+          return scm_i_string_hash (obj);
+        case scm_tc7_symbol:
+          return scm_i_symbol_hash (obj);
+        case scm_tc7_pointer:
+          return scm_raw_ihashq ((scm_t_uintptr) SCM_POINTER_VALUE (obj));
+        case scm_tc7_wvect:
+        case scm_tc7_vector:
+          {
+            size_t len = SCM_SIMPLE_VECTOR_LENGTH (obj);
+            size_t i = depth / 2;
+            unsigned long h = scm_raw_ihashq (SCM_CELL_WORD_0 (obj));
+            if (len)
+              while (i--)
+                h ^= scm_raw_ihash (scm_c_vector_ref (obj, h % len), i);
+            return h;
+          }
+        default:
+          return scm_raw_ihashq (SCM_CELL_WORD_0 (obj));
+        }
+
     default:
-      return scm_raw_ihashq (SCM_CELL_WORD_0 (obj));
+      /* Invalid object.  */
+      abort ();
     }
 }
 
-
 
 
 unsigned long
diff --git a/libguile/list.c b/libguile/list.c
index 627640334..7d6793999 100644
--- a/libguile/list.c
+++ b/libguile/list.c
@@ -37,7 +37,7 @@
 
 #define SCM_I_CONS(cell, x, y)                          \
   do {                                                  \
-    cell = scm_cell (SCM_UNPACK (x), SCM_UNPACK (y));   \
+    cell = SCM_PACK (SCM_UNPACK (scm_cell (SCM_UNPACK (x), SCM_UNPACK (y))) | scm_tc3_cons); \
   } while (0)
 
 SCM
diff --git a/libguile/modules.c b/libguile/modules.c
index d87ec7a64..f12b97893 100644
--- a/libguile/modules.c
+++ b/libguile/modules.c
@@ -875,7 +875,7 @@ static void
 scm_post_boot_init_modules ()
 {
   SCM module_type = SCM_VARIABLE_REF (scm_c_lookup ("module-type"));
-  scm_module_tag = (SCM_CELL_WORD_1 (module_type) + scm_tc3_struct);
+  scm_module_tag = SCM_CELL_WORD_1 (module_type);
 
   resolve_module_var = scm_c_lookup ("resolve-module");
   define_module_star_var = scm_c_lookup ("define-module*");
diff --git a/libguile/modules.h b/libguile/modules.h
index 28df6c6ea..62d51a72c 100644
--- a/libguile/modules.h
+++ b/libguile/modules.h
@@ -32,8 +32,8 @@
 SCM_API int scm_module_system_booted_p;
 SCM_API scm_t_bits scm_module_tag;
 
-#define SCM_MODULEP(OBJ) \
-  (!SCM_IMP (OBJ) && SCM_CELL_TYPE (OBJ) == scm_module_tag)
+#define SCM_MODULEP(obj) \
+  (SCM_STRUCTP (obj) && SCM_CELL_WORD_0 (obj) == scm_module_tag)
 
 #define SCM_VALIDATE_MODULE(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, MODULEP, "module")
 
diff --git a/libguile/numbers.h b/libguile/numbers.h
index b7bcfe48c..ae879d3fa 100644
--- a/libguile/numbers.h
+++ b/libguile/numbers.h
@@ -56,7 +56,7 @@ typedef scm_t_int32 scm_t_wchar;
 #endif /* (-1 == (((-1) << 2) + 2) >> 2) */
 
 
-#define SCM_I_INUMP(x)	(2 & SCM_UNPACK (x))
+#define SCM_I_INUMP(x)	((SCM_UNPACK (x) & 0x3) == scm_tc2_int)
 #define SCM_I_NINUMP(x) (!SCM_I_INUMP (x))
 #define SCM_I_MAKINUM(x) \
   (SCM_PACK ((((scm_t_signed_bits) (x)) << 2) + scm_tc2_int))
@@ -123,8 +123,9 @@ typedef scm_t_int32 scm_t_wchar;
 #define scm_tc16_complex        (scm_tc7_number + 3 * 256L)
 #define scm_tc16_fraction       (scm_tc7_number + 4 * 256L)
 
-#define SCM_INEXACTP(x) \
-  (!SCM_IMP (x) && (0xfeff & SCM_CELL_TYPE (x)) == scm_tc16_real)
+#define SCM_INEXACTP(x)                                 \
+  (SCM_HAS_TYP3 (x, scm_tc3_heap)                       \
+   && (0xfeff & SCM_CELL_TYPE (x)) == scm_tc16_real)
 #define SCM_REALP(x) (SCM_HAS_TYP16 (x, scm_tc16_real))
 #define SCM_COMPLEXP(x) (SCM_HAS_TYP16 (x, scm_tc16_complex))
 
diff --git a/libguile/pairs.h b/libguile/pairs.h
index 130bf28a6..099d206e3 100644
--- a/libguile/pairs.h
+++ b/libguile/pairs.h
@@ -3,7 +3,7 @@
 #ifndef SCM_PAIRS_H
 #define SCM_PAIRS_H
 
-/* Copyright (C) 1995,1996,2000,2001, 2004, 2006, 2008, 2009, 2010, 2012 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000,2001, 2004, 2006, 2008, 2009, 2010, 2012, 2013 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
@@ -129,7 +129,8 @@ SCM_INLINE SCM scm_cdr (SCM x);
 SCM_INLINE_IMPLEMENTATION SCM
 scm_cons (SCM x, SCM y)
 {
-  return scm_cell (SCM_UNPACK (x), SCM_UNPACK (y));
+  return SCM_PACK (SCM_UNPACK (scm_cell (SCM_UNPACK (x), SCM_UNPACK (y)))
+                   | scm_tc3_cons);
 }
 
 SCM_INLINE_IMPLEMENTATION int
diff --git a/libguile/print.c b/libguile/print.c
index 5d5c56d2f..0f6149fa5 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -522,8 +522,8 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
 {
   switch (SCM_ITAG3 (exp))
     {
-    case scm_tc3_tc7_1:
-    case scm_tc3_tc7_2:
+    case scm_tc3_unused_1:
+    case scm_tc3_unused_2:
       /* These tc3 tags should never occur in an immediate value.  They are
        * only used in cell types of non-immediates, i. e. the value returned
        * by SCM_CELL_TYPE (exp) can use these tags.
@@ -559,53 +559,50 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
 	  scm_ipruk ("immediate", exp, port);
 	}
       break;
+
     case scm_tc3_cons:
+      ENTER_NESTED_DATA (pstate, exp, circref);
+      scm_iprlist ("(", exp, ')', port, pstate);
+      EXIT_NESTED_DATA (pstate);
+      break;
+
+    case scm_tc3_struct:
+      ENTER_NESTED_DATA (pstate, exp, circref);
+      if (SCM_OBJ_CLASS_FLAGS (exp) & SCM_CLASSF_GOOPS)
+        {
+          SCM pwps, print = pstate->writingp ? g_write : g_display;
+          if (SCM_UNPACK (print) == 0)
+            goto print_struct;
+          pwps = scm_i_port_with_print_state (port, pstate->handle);
+          pstate->revealed = 1;
+          scm_call_2 (print, exp, pwps);
+        }
+      else
+        {
+        print_struct:
+          scm_print_struct (exp, port, pstate);
+        }
+      EXIT_NESTED_DATA (pstate);
+      break;
+      
+    case scm_tc3_heap:
       switch (SCM_TYP7 (exp))
 	{
-	case scm_tcs_struct:
-	  {
-	    ENTER_NESTED_DATA (pstate, exp, circref);
-	    if (SCM_OBJ_CLASS_FLAGS (exp) & SCM_CLASSF_GOOPS)
-	      {
-		SCM pwps, print = pstate->writingp ? g_write : g_display;
-		if (SCM_UNPACK (print) == 0)
-		  goto print_struct;
-		pwps = scm_i_port_with_print_state (port, pstate->handle);
-		pstate->revealed = 1;
-		scm_call_2 (print, exp, pwps);
-	      }
-	    else
-	      {
-	      print_struct:
-		scm_print_struct (exp, port, pstate);
-	      }
-	    EXIT_NESTED_DATA (pstate);
-	  }
-	  break;
-	case scm_tcs_cons_imcar:
-	case scm_tcs_cons_nimcar:
-	  ENTER_NESTED_DATA (pstate, exp, circref);
-	  scm_iprlist ("(", exp, ')', port, pstate);
-	  EXIT_NESTED_DATA (pstate);
-	  break;
-	circref:
-	  print_circref (port, pstate, exp);
-	  break;
 	case scm_tc7_number:
           switch SCM_TYP16 (exp) {
-          case scm_tc16_big:
-            scm_bigprint (exp, port, pstate);
-            break;
-          case scm_tc16_real:
-            scm_print_real (exp, port, pstate);
-            break;
-          case scm_tc16_complex:
-            scm_print_complex (exp, port, pstate);
-            break;
-          case scm_tc16_fraction:
-            scm_i_print_fraction (exp, port, pstate);
-            break;
-          }
+            case scm_tc16_big:
+              scm_bigprint (exp, port, pstate);
+              break;
+            case scm_tc16_real:
+              scm_print_real (exp, port, pstate);
+              break;
+            case scm_tc16_complex:
+              scm_print_complex (exp, port, pstate);
+              break;
+            case scm_tc16_fraction:
+              scm_i_print_fraction (exp, port, pstate);
+              break;
+            }
 	  break;
         case scm_tc7_string:
           if (SCM_WRITINGP (pstate))
@@ -746,10 +743,18 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
 	  EXIT_NESTED_DATA (pstate);
 	  break;
 	default:
-          /* case scm_tcs_closures: */
 	punk:
 	  scm_ipruk ("type", exp, port);
 	}
+      break;
+
+    default:
+      scm_ipruk ("unknown!", exp, port);
+      break;
+
+    circref:
+      print_circref (port, pstate, exp);
+      break;
     }
 }
 
diff --git a/libguile/struct.c b/libguile/struct.c
index ed75b8ba5..16a4676e3 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -413,7 +413,7 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0,
 static void
 struct_finalizer_trampoline (void *ptr, void *unused_data)
 {
-  SCM obj = PTR2SCM (ptr);
+  SCM obj = SCM_PACK (((scm_t_bits)ptr) | scm_tc3_struct);
   scm_t_struct_finalize finalize = SCM_STRUCT_FINALIZER (obj);
 
   if (finalize)
@@ -439,7 +439,8 @@ scm_i_alloc_struct (scm_t_bits *vtable_data, int n_words)
 {
   SCM ret;
 
-  ret = scm_words ((scm_t_bits)vtable_data | scm_tc3_struct, n_words + 2);
+  ret = scm_words ((scm_t_bits)vtable_data, n_words + 2);
+  ret = SCM_PACK (SCM_UNPACK (ret) | scm_tc3_struct);
   SCM_SET_CELL_WORD_1 (ret, (scm_t_bits)SCM_CELL_OBJECT_LOC (ret, 2));
 
   /* vtable_data can be null when making a vtable vtable */
@@ -582,7 +583,7 @@ scm_i_make_vtable_vtable (SCM user_fields)
 
   obj = scm_i_alloc_struct (NULL, basic_size);
   /* Make it so that the vtable of OBJ is itself.  */
-  SCM_SET_CELL_WORD_0 (obj, (scm_t_bits) SCM_STRUCT_DATA (obj) | scm_tc3_struct);
+  SCM_SET_CELL_WORD_0 (obj, (scm_t_bits) SCM_STRUCT_DATA (obj));
 
   v = SCM_UNPACK (layout);
   scm_struct_init (obj, layout, 0, 1, &v);
@@ -948,16 +949,6 @@ scm_init_struct ()
 {
   SCM name;
 
-  /* The first word of a struct is equal to `SCM_STRUCT_DATA (vtable) +
-     scm_tc3_struct', and `SCM_STRUCT_DATA (vtable)' is 2 words after VTABLE by
-     default.  */
-  GC_REGISTER_DISPLACEMENT (2 * sizeof (scm_t_bits) + scm_tc3_struct);
-
-  /* In the general case, `SCM_STRUCT_DATA (obj)' points 2 words after the
-     beginning of a GC-allocated region; that region is different from that of
-     OBJ once OBJ has undergone class redefinition.  */
-  GC_REGISTER_DISPLACEMENT (2 * sizeof (scm_t_bits));
-
   required_vtable_fields = scm_from_locale_string (SCM_VTABLE_BASE_LAYOUT);
   scm_c_define ("standard-vtable-fields", required_vtable_fields);
   required_applicable_fields = scm_from_locale_string (SCM_APPLICABLE_BASE_LAYOUT);
diff --git a/libguile/struct.h b/libguile/struct.h
index 97b6768ad..ba7113125 100644
--- a/libguile/struct.h
+++ b/libguile/struct.h
@@ -122,7 +122,7 @@
 
 typedef void (*scm_t_struct_finalize) (SCM obj);
 
-#define SCM_STRUCTP(X)  		(!SCM_IMP(X) && (SCM_TYP3(X) == scm_tc3_struct))
+#define SCM_STRUCTP(X)  		(SCM_TYP3(X) == scm_tc3_struct)
 #define SCM_STRUCT_SLOTS(X) 		((SCM*)SCM_CELL_WORD_1 ((X)))
 #define SCM_STRUCT_SLOT_REF(X,I) 	(SCM_STRUCT_SLOTS (X)[(I)])
 #define SCM_STRUCT_SLOT_SET(X,I,V) 	SCM_STRUCT_SLOTS (X)[(I)]=(V)
@@ -147,8 +147,8 @@ typedef void (*scm_t_struct_finalize) (SCM obj);
 
 /* Structs hold a pointer to their vtable's data, not the vtable itself. To get
    the vtable we have to do an indirection through the self slot. */
-#define SCM_STRUCT_VTABLE_DATA(X)       ((scm_t_bits*)(SCM_CELL_WORD_0 (X) - scm_tc3_struct))
-#define SCM_STRUCT_VTABLE_SLOTS(X)      ((SCM*)(SCM_CELL_WORD_0 (X) - scm_tc3_struct))
+#define SCM_STRUCT_VTABLE_DATA(X)       ((scm_t_bits*)SCM_CELL_WORD_0 (X))
+#define SCM_STRUCT_VTABLE_SLOTS(X)      ((SCM*)SCM_CELL_WORD_0 (X))
 #define SCM_STRUCT_VTABLE(X)            (SCM_STRUCT_VTABLE_SLOTS(X)[scm_vtable_index_self])
 /* But often we just need to access the vtable's data; we can do that without
    the data->self->data indirection. */
diff --git a/libguile/tags.h b/libguile/tags.h
index 043bdbdce..c6271d880 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
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012,2013
  * Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
@@ -277,63 +277,41 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
  * section with the summary of the type codes on the heap.
  *
  * tc1:
- *   0:  For scheme objects, tc1==0 must be fulfilled.
- *  (1:  This can never be the case for a scheme object.)
+ *   0:  A heap object.
+ *   1:  An immediate object.
  *
  * tc2:
- *   00:  Either a heap object or some non-integer immediate
- *  (01:  This can never be the case for a scheme object.)
- *   10:  Small integer
- *  (11:  This can never be the case for a scheme object.)
+ *   00:  A heap object with a tag word on the heap
+ *   10:  A pair or a struct
+ *   11:  Small integer
+ *   01:  Some other immediate
  *
  * tc3:
- *   000:  a heap object (pair, closure, class instance etc.)
- *  (001:  This can never be the case for a scheme object.)
- *   010:  an even small integer (least significant bit is 0).
- *  (011:  This can never be the case for a scheme object.)
- *   100:  Non-integer immediate
- *  (101:  This can never be the case for a scheme object.)
- *   110:  an odd small integer (least significant bit is 1).
- *  (111:  This can never be the case for a scheme object.)
+ *   000:  A heap object with a tag word on the heap
+ *   001:  Some other immediate
+ *   010:  A pair
+ *   011:  Small integer (odd)
+ *   100:  (Unallocated tc3.)
+ *   101:  (Unallocated tc3.)
+ *   110:  A struct
+ *   111:  Small integer (even)
  *
  * The remaining bits of the heap objects form the pointer to the heap
  * cell.  The remaining bits of the small integers form the integer's
  * value and sign.  Thus, the only scheme objects for which a further
- * subdivision is of interest are the ones with tc3==100.
+ * subdivision is of interest are the ones with tc3==001.
  *
- * tc8 (for objects with tc3==100):
- *   00000-100:  special objects ('flags')
- *   00001-100:  characters
- *   00010-100:  unused
- *   00011-100:  unused
+ * tc8 (for objects with tc3==001):
+ *   00000-001:  special objects ('flags')
+ *   00001-001:  characters
+ *   00010-001:  unused
+ *   00011-001:  unused
  *
+ * For heap objects with tc3==000, the remaining tag bits are to be
+ * found in the first word of the object, on the heap.  That tag word
+ * will have a tc3 of 000.
  *
- * Summary of type codes on the heap
- *
- * Here is a summary of tagging in scm_t_bits values as they might occur in
- * the first scm_t_bits variable of a heap cell.
- *
- * tc1:
- *   0:  the cell belongs to a pair.
- *   1:  the cell belongs to a non-pair.
- *
- * tc2:
- *   00:  the cell belongs to a pair with no short integer in its car.
- *   01:  the cell belongs to a non-pair (struct or some other heap object).
- *   10:  the cell belongs to a pair with a short integer in its car.
- *   11:  the cell belongs to a non-pair (closure or some other heap object).
- *
- * tc3:
- *   000:  the cell belongs to a pair with a heap object in its car.
- *   001:  the cell belongs to a struct
- *   010:  the cell belongs to a pair with an even short integer in its car.
- *   011:  the cell belongs to a closure
- *   100:  the cell belongs to a pair with a non-integer immediate in its car.
- *   101:  the cell belongs to some other heap object.
- *   110:  the cell belongs to a pair with an odd short integer in its car.
- *   111:  the cell belongs to some other heap object.
- *
- * tc7 (for tc3==1x1):
+ * tc7 (for tc3==000):
  *   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
@@ -348,59 +326,62 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
  *   predefined way, since smobs can be added arbitrarily by user C code.
  */
 
+
 
 
-/* Checking if a SCM variable holds an immediate or a heap object:
- * This check can either be performed by checking for tc3==000 or tc3==00x,
- * since for a SCM variable it is known that tc1==0.  */
-#define SCM_IMP(x) 		(6 & SCM_UNPACK (x))
+/* Checking if a SCM variable holds an immediate or a heap object:  This
+ * check can either be performed by checking for values with 1 as their
+ * least significant bit.  */
+#define SCM_IMP(x) 		(1 & SCM_UNPACK (x))
 #define SCM_NIMP(x) 		(!SCM_IMP (x))
 #define SCM_HEAP_OBJECT_P(x)    (SCM_NIMP (x))
 
-/* Checking if a SCM variable holds an immediate integer: See numbers.h for
- * the definition of the following macros: SCM_I_FIXNUM_BIT,
- * SCM_MOST_POSITIVE_FIXNUM, SCM_I_INUMP, SCM_I_MAKINUM, SCM_I_INUM.  */
-
-/* Checking if a SCM variable holds a pair (for historical reasons, in Guile
- * also known as a cons-cell): This is done by first checking that the SCM
- * variable holds a heap object, and second, by checking that tc1==0 holds
- * for the SCM_CELL_TYPE of the SCM variable.  
-*/
-
-#define SCM_I_CONSP(x)  (!SCM_IMP (x) && ((1 & SCM_CELL_TYPE (x)) == 0))
 
 
 
 /* Definitions for tc2: */
 
-#define scm_tc2_int              2
+#define scm_tc2_int              3
 
 
 /* Definitions for tc3: */
 
-#define SCM_ITAG3(x) 		 (7 & SCM_UNPACK (x))
-#define SCM_TYP3(x) 		 (7 & SCM_CELL_TYPE (x))
+#define SCM_TYP3(x) 		 (7 & SCM_UNPACK (x))
+#define SCM_ITAG3(x) 		 (SCM_TYP3 (x))
+#define SCM_HAS_TYP3(x, tag)     (SCM_TYP3 (x) == (tag))
 
-#define scm_tc3_cons	 	 0
-#define scm_tc3_struct    	 1
+#define scm_tc3_heap	 	 0
+#define scm_tc3_imm24		 1
+#define scm_tc3_cons	 	 2
 #define scm_tc3_int_1		 (scm_tc2_int + 0)
-#define scm_tc3_unused		 3
-#define scm_tc3_imm24		 4
-#define scm_tc3_tc7_1		 5
+#define scm_tc3_unused_1	 4
+#define scm_tc3_unused_2	 5
+#define scm_tc3_struct    	 6
 #define scm_tc3_int_2		 (scm_tc2_int + 4)
-#define scm_tc3_tc7_2		 7
 
 
-/* As we have seen, heap objects have a tag in their three lowest bits.
-   If you have a heap object and want the pointer to the start of the
-   object, perhaps for GC purposes, you need to mask off the low bits,
-   which is what SCM_HEAP_OBJECT_BASE does.
+/* Checking if a SCM variable holds an immediate integer: See numbers.h for
+   the definition of the following macros: SCM_I_FIXNUM_BIT,
+   SCM_MOST_POSITIVE_FIXNUM, SCM_I_INUMP, SCM_I_MAKINUM, SCM_I_INUM.  */
+
+/* As we have seen, heap objects can have 0, 2, or 6 in their three
+   lowest bits.  If you have a heap object and want the pointer to the
+   start of the object, perhaps for GC purposes, you need to mask off
+   the low bits, which is what SCM_HEAP_OBJECT_BASE does.
 
    Note that you can avoid this macro if you know the specific type of
    the object (pair, struct, or other).
  */
 #define SCM_HEAP_OBJECT_BASE(x) ((scm_t_bits*)((SCM_UNPACK (x)) & ~7))
 
+/* Checking if a SCM variable holds a pair (for historical reasons, in Guile
+ * also known as a cons-cell): This is done by first checking that the SCM
+ * variable holds a heap object, and second, by checking that tc1==0 holds
+ * for the SCM_CELL_TYPE of the SCM variable.  
+*/
+
+#define SCM_I_CONSP(x)  (SCM_HAS_TYP3 (x, scm_tc3_cons))
+
 
 /* Definitions for tc7: */
 
@@ -408,7 +389,7 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
 #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))
+  (SCM_HAS_TYP3 (x, scm_tc3_heap) && 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))
 
@@ -610,74 +591,6 @@ enum scm_tc8_tags
 #endif /* BUILDING_LIBGUILE */
 
 
-/* Dispatching aids:
-
-   When switching on SCM_TYP7 of a SCM value, use these fake case
-   labels to catch types that use fewer than 7 bits for tagging.  */
-
-/* For cons pairs with immediate values in the CAR
- */
-
-#define scm_tcs_cons_imcar \
-       scm_tc2_int + 0:   case scm_tc2_int + 4:   case scm_tc3_imm24 + 0:\
-  case scm_tc2_int + 8:   case scm_tc2_int + 12:  case scm_tc3_imm24 + 8:\
-  case scm_tc2_int + 16:  case scm_tc2_int + 20:  case scm_tc3_imm24 + 16:\
-  case scm_tc2_int + 24:  case scm_tc2_int + 28:  case scm_tc3_imm24 + 24:\
-  case scm_tc2_int + 32:  case scm_tc2_int + 36:  case scm_tc3_imm24 + 32:\
-  case scm_tc2_int + 40:  case scm_tc2_int + 44:  case scm_tc3_imm24 + 40:\
-  case scm_tc2_int + 48:  case scm_tc2_int + 52:  case scm_tc3_imm24 + 48:\
-  case scm_tc2_int + 56:  case scm_tc2_int + 60:  case scm_tc3_imm24 + 56:\
-  case scm_tc2_int + 64:  case scm_tc2_int + 68:  case scm_tc3_imm24 + 64:\
-  case scm_tc2_int + 72:  case scm_tc2_int + 76:  case scm_tc3_imm24 + 72:\
-  case scm_tc2_int + 80:  case scm_tc2_int + 84:  case scm_tc3_imm24 + 80:\
-  case scm_tc2_int + 88:  case scm_tc2_int + 92:  case scm_tc3_imm24 + 88:\
-  case scm_tc2_int + 96:  case scm_tc2_int + 100: case scm_tc3_imm24 + 96:\
-  case scm_tc2_int + 104: case scm_tc2_int + 108: case scm_tc3_imm24 + 104:\
-  case scm_tc2_int + 112: case scm_tc2_int + 116: case scm_tc3_imm24 + 112:\
-  case scm_tc2_int + 120: case scm_tc2_int + 124: case scm_tc3_imm24 + 120
-
-/* For cons pairs with heap objects in the SCM_CAR
- */
-#define scm_tcs_cons_nimcar \
-       scm_tc3_cons + 0:\
-  case scm_tc3_cons + 8:\
-  case scm_tc3_cons + 16:\
-  case scm_tc3_cons + 24:\
-  case scm_tc3_cons + 32:\
-  case scm_tc3_cons + 40:\
-  case scm_tc3_cons + 48:\
-  case scm_tc3_cons + 56:\
-  case scm_tc3_cons + 64:\
-  case scm_tc3_cons + 72:\
-  case scm_tc3_cons + 80:\
-  case scm_tc3_cons + 88:\
-  case scm_tc3_cons + 96:\
-  case scm_tc3_cons + 104:\
-  case scm_tc3_cons + 112:\
-  case scm_tc3_cons + 120
-
-/* For structs
- */
-#define scm_tcs_struct \
-       scm_tc3_struct + 0:\
-  case scm_tc3_struct + 8:\
-  case scm_tc3_struct + 16:\
-  case scm_tc3_struct + 24:\
-  case scm_tc3_struct + 32:\
-  case scm_tc3_struct + 40:\
-  case scm_tc3_struct + 48:\
-  case scm_tc3_struct + 56:\
-  case scm_tc3_struct + 64:\
-  case scm_tc3_struct + 72:\
-  case scm_tc3_struct + 80:\
-  case scm_tc3_struct + 88:\
-  case scm_tc3_struct + 96:\
-  case scm_tc3_struct + 104:\
-  case scm_tc3_struct + 112:\
-  case scm_tc3_struct + 120
-
-
-
 #endif  /* SCM_TAGS_H */
 
 /*
diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h
index 5a4bf40f3..19f384041 100644
--- a/libguile/vm-engine.h
+++ b/libguile/vm-engine.h
@@ -308,7 +308,7 @@
 #define CONS(x,y,z)					\
 {							\
   SYNC_BEFORE_GC ();					\
-  x = scm_cell (SCM_UNPACK (y), SCM_UNPACK (z));	\
+  x = SCM_PACK (SCM_UNPACK (scm_cell (SCM_UNPACK (y), SCM_UNPACK (z))) | scm_tc3_cons); \
 }
 
 /* Pop the N objects on top of the stack and push a list that contains
diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c
index 0e3956363..7679543c7 100644
--- a/libguile/vm-i-scheme.c
+++ b/libguile/vm-i-scheme.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 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
@@ -592,8 +592,8 @@ VM_DEFINE_INSTRUCTION (173, make_struct, "make-struct", 2, -1, 1)
     {
       /* Verily, we are making a simple struct with the right number of
          initializers, and no finalizer. */
-      ret = scm_words ((scm_t_bits)SCM_STRUCT_DATA (vtable) | scm_tc3_struct,
-                       n + 1);
+      ret = scm_words ((scm_t_bits) SCM_STRUCT_DATA (vtable), n + 1);
+      ret = SCM_PACK (SCM_UNPACK (ret) | scm_tc3_struct);
       SCM_SET_CELL_WORD_1 (ret, (scm_t_bits)SCM_CELL_OBJECT_LOC (ret, 2));
       memcpy (SCM_STRUCT_DATA (ret), inits, (n - 1) * sizeof (SCM));
     }
diff --git a/module/rnrs/arithmetic/fixnums.scm b/module/rnrs/arithmetic/fixnums.scm
index e6261999a..ac36c602b 100644
--- a/module/rnrs/arithmetic/fixnums.scm
+++ b/module/rnrs/arithmetic/fixnums.scm
@@ -103,10 +103,10 @@
   (define (least-fixnum) most-negative-fixnum)
 
   (define (fixnum? obj)
-    (not (= 0 (logand 2 (object-address obj)))))
+    (eqv? #b11 (logand #b11 (object-address obj))))
 
   (define-inlinable (inline-fixnum? obj)
-    (not (= 0 (logand 2 (object-address obj)))))
+    (eqv? #b11 (logand #b11 (object-address obj))))
 
   (define-syntax assert-fixnum
     (syntax-rules ()