allocate a tc7 to arrays

* libguile/tags.h (scm_tc7_array): Allocate a tag for arrays.
* libguile/arrays.h (SCM_I_ARRAYP): Change to use scm_tc7_array.  The
  previous definition was not externally usable because scm_i_tc16_array
  was internal.
  (scm_i_print_array): Declare, though internally.

* libguile/arrays.c (scm_i_make_array): Use scm_cell with the tc7
  instead of NEWSMOB.
  (scm_i_print_array): Make not static.
  (SCM_ARRAY_IMPLEMENTATION): Adapt.
  (scm_init_arrays): Remove array smob declaration.

* libguile/eq.c (scm_equal_p): Refactor to put the string, pointer, and
  bytevector cases in the switch.  Add a case for arrays.

* libguile/goops.c: Add <array> declarations.

* libguile/print.c (iprin1): Call scm_i_print_array as needed.

* libguile/evalext.c (scm_self_evaluating_p): Add a case for arrays.

diff --git a/libguile/array-map.c b/libguile/array-map.c
index d442bdf..ef6f80d 100644 (file)
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1996,1998,2000,2001,2004,2005, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1998,2000,2001,2004,2005, 2006, 2008, 2009, 2010, 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
@@ -892,7 +892,6 @@ SCM_DEFINE (scm_i_array_equal_p, "array-equal?", 0, 2, 1,
 void
 scm_init_array_map (void)
 {
-  scm_smobs[SCM_TC2SMOBNUM (scm_i_tc16_array)].equalp = scm_array_equal_p;
 #include "libguile/array-map.x"
   scm_add_feature (s_scm_array_for_each);
 }

diff --git a/libguile/arrays.c b/libguile/arrays.c
index d99081c..c17f125 100644 (file)
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -33,7 +33,6 @@
 #include "libguile/chars.h"
 #include "libguile/eval.h"
 #include "libguile/fports.h"
-#include "libguile/smob.h"
 #include "libguile/feature.h"
 #include "libguile/root.h"
 #include "libguile/strings.h"
@@ -54,11 +53,10 @@
 #include "libguile/uniform.h"
 
 
-scm_t_bits scm_i_tc16_array;
 #define SCM_SET_ARRAY_CONTIGUOUS_FLAG(x) \
-  (SCM_SET_SMOB_FLAGS ((x), SCM_SMOB_FLAGS (x) | SCM_I_ARRAY_FLAG_CONTIGUOUS))
+  (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) | (SCM_I_ARRAY_FLAG_CONTIGUOUS << 16)))
 #define SCM_CLR_ARRAY_CONTIGUOUS_FLAG(x) \
-  (SCM_SET_SMOB_FLAGS ((x), SCM_SMOB_FLAGS (x) & ~SCM_I_ARRAY_FLAG_CONTIGUOUS))
+  (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & ~(SCM_I_ARRAY_FLAG_CONTIGUOUS << 16)))
 
 
 SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0, 
@@ -115,10 +113,10 @@ SCM
 scm_i_make_array (int ndim)
 {
   SCM ra;
-  SCM_NEWSMOB(ra, ((scm_t_bits) ndim << 17) + scm_i_tc16_array,
-              scm_gc_malloc ((sizeof (scm_i_t_array) +
-                             ndim * sizeof (scm_t_array_dim)),
-                            "array"));
+  ra = scm_cell (((scm_t_bits) ndim << 17) + scm_tc7_array,
+                 SCM_UNPACK (scm_gc_malloc ((sizeof (scm_i_t_array) +
+                                             ndim * sizeof (scm_t_array_dim)),
+                                            "array")));
   SCM_I_ARRAY_V (ra) = SCM_BOOL_F;
   return ra;
 }
@@ -743,7 +741,7 @@ scm_i_print_array_dimension (scm_t_array_handle *h, int dim, int pos,
 /* Print an array.
 */
 
-static int
+int
 scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
 {
   scm_t_array_handle h;
@@ -1015,18 +1013,14 @@ array_get_handle (SCM array, scm_t_array_handle *h)
   h->base = SCM_I_ARRAY_BASE (array);
 }
 
-SCM_ARRAY_IMPLEMENTATION (SCM_SMOB_TYPE_BITS (scm_i_tc16_array),
-                          SCM_SMOB_TYPE_MASK,
+SCM_ARRAY_IMPLEMENTATION (scm_tc7_array,
+                          0x7f,
                           array_handle_ref, array_handle_set,
                           array_get_handle)
 
 void
 scm_init_arrays ()
 {
-  scm_i_tc16_array = scm_make_smob_type ("array", 0);
-  scm_set_smob_print (scm_i_tc16_array, scm_i_print_array);
-  scm_set_smob_equalp (scm_i_tc16_array, scm_array_equal_p);
-
   scm_add_feature ("array");
 
 #include "libguile/arrays.x"

diff --git a/libguile/arrays.h b/libguile/arrays.h
index 9b14d4e..5ea604d 100644 (file)
--- a/libguile/arrays.h
+++ b/libguile/arrays.h
@@ -59,21 +59,20 @@ typedef struct scm_i_t_array
   unsigned long base;
 } scm_i_t_array;
 
-SCM_INTERNAL scm_t_bits scm_i_tc16_array;
-
 #define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 0)
 
-#define SCM_I_ARRAYP(a)            SCM_TYP16_PREDICATE (scm_i_tc16_array, a)
-#define SCM_I_ARRAY_NDIM(x)  ((size_t) (SCM_SMOB_FLAGS (x)>>1))
-#define SCM_I_ARRAY_CONTP(x) (SCM_SMOB_FLAGS(x) & SCM_I_ARRAY_FLAG_CONTIGUOUS)
+#define SCM_I_ARRAYP(a)            SCM_TYP16_PREDICATE (scm_tc7_array, a)
+#define SCM_I_ARRAY_NDIM(x)  ((size_t) (SCM_CELL_WORD_0 (x)>>17))
+#define SCM_I_ARRAY_CONTP(x) (SCM_CELL_WORD_0 (x) & (SCM_I_ARRAY_FLAG_CONTIGUOUS << 16))
 
-#define SCM_I_ARRAY_MEM(a)  ((scm_i_t_array *) SCM_SMOB_DATA_1 (a))
+#define SCM_I_ARRAY_MEM(a)  ((scm_i_t_array *) SCM_CELL_WORD_1 (a))
 #define SCM_I_ARRAY_V(a)    (SCM_I_ARRAY_MEM (a)->v)
 #define SCM_I_ARRAY_BASE(a) (SCM_I_ARRAY_MEM (a)->base)
 #define SCM_I_ARRAY_DIMS(a) \
   ((scm_t_array_dim *)((char *) SCM_I_ARRAY_MEM (a) + sizeof (scm_i_t_array)))
 
 SCM_INTERNAL SCM scm_i_make_array (int ndim);
+SCM_INTERNAL int scm_i_print_array (SCM array, SCM port, scm_print_state *pstate);
 SCM_INTERNAL SCM scm_i_read_array (SCM port, int c);
 
 SCM_INTERNAL void scm_init_arrays (void);

diff --git a/libguile/eq.c b/libguile/eq.c
index 11dce99..d286d5c 100644 (file)
--- a/libguile/eq.c
+++ b/libguile/eq.c
@@ -302,10 +302,6 @@ scm_equal_p (SCM x, SCM y)
       y = SCM_CDR(y);
       goto tailrecurse;
     }
-  if (SCM_TYP7 (x) == scm_tc7_string && SCM_TYP7 (y) == scm_tc7_string)
-    return scm_string_equal_p (x, y);
-  if (SCM_TYP7 (x) == scm_tc7_bytevector && SCM_TYP7 (y) == scm_tc7_bytevector)
-    return scm_bytevector_eq_p (x, y);
   if (SCM_TYP7 (x) == scm_tc7_smob && SCM_TYP16 (x) == SCM_TYP16 (y))
     {
       int i = SCM_SMOBNUM (x);
@@ -316,8 +312,6 @@ scm_equal_p (SCM x, SCM y)
       else
        goto generic_equal;
     }
-  if (SCM_POINTER_P (x) && SCM_POINTER_P (y))
-    return scm_from_bool (SCM_POINTER_VALUE (x) == SCM_POINTER_VALUE (y));
 
   /* This ensures that types and scm_length are the same.  */
   if (SCM_CELL_TYPE (x) != SCM_CELL_TYPE (y))
@@ -352,7 +346,18 @@ scm_equal_p (SCM x, SCM y)
           return scm_complex_equalp (x, y);
        case scm_tc16_fraction:
           return scm_i_fraction_equalp (x, y);
+        default:
+          /* assert not reached? */
+          return SCM_BOOL_F;
         }
+    case scm_tc7_pointer:
+      return scm_from_bool (SCM_POINTER_VALUE (x) == SCM_POINTER_VALUE (y));
+    case scm_tc7_string:
+      return scm_string_equal_p (x, y);
+    case scm_tc7_bytevector:
+      return scm_bytevector_eq_p (x, y);
+    case scm_tc7_array:
+      return scm_array_equal_p (x, y);
     case scm_tc7_vector:
     case scm_tc7_wvect:
       return scm_i_vector_equal_p (x, y);

diff --git a/libguile/evalext.c b/libguile/evalext.c
index 1e5bd68..2dfaa13 100644 (file)
--- a/libguile/evalext.c
+++ b/libguile/evalext.c
@@ -87,6 +87,7 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
        case scm_tc7_smob:
        case scm_tc7_program:
        case scm_tc7_bytevector:
+       case scm_tc7_array:
        case scm_tcs_struct:
          return SCM_BOOL_T;
        default:

diff --git a/libguile/goops.c b/libguile/goops.c
index 31fa179..e951309 100644 (file)
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -168,6 +168,7 @@ static SCM class_vm;
 static SCM class_vm_cont;
 static SCM class_bytevector;
 static SCM class_uvec;
+static SCM class_array;
 
 static SCM vtable_class_map = SCM_BOOL_F;
 static scm_i_pthread_mutex_t vtable_class_map_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
@@ -288,6 +289,8 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
             return class_bytevector;
           else
             return class_uvec;
+       case scm_tc7_array:
+          return class_array;
        case scm_tc7_string:
          return scm_class_string;
         case scm_tc7_number:
@@ -2523,6 +2526,8 @@ create_standard_classes (void)
               scm_class_class, scm_class_top,             SCM_EOL);
   make_stdcls (&class_uvec,               "<uvec>",
               scm_class_class, class_bytevector,          SCM_EOL);
+  make_stdcls (&class_array,              "<array>",
+              scm_class_class, scm_class_top,             SCM_EOL);
   make_stdcls (&scm_class_number,         "<number>",
               scm_class_class, scm_class_top,             SCM_EOL);
   make_stdcls (&scm_class_complex,        "<complex>",

diff --git a/libguile/print.c b/libguile/print.c
index 2551bdf..e0a6daa 100644 (file)
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -646,6 +646,13 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
        case scm_tc7_with_fluids:
          scm_i_with_fluids_print (exp, port, pstate);
          break;
+       case scm_tc7_array:
+         ENTER_NESTED_DATA (pstate, exp, circref);
+          scm_i_print_array (exp, port, pstate);
+          break;
+       case scm_tc7_bytevector:
+         scm_i_print_bytevector (exp, port, pstate);
+         break;
        case scm_tc7_wvect:
          ENTER_NESTED_DATA (pstate, exp, circref);
          if (SCM_IS_WHVEC (exp))
@@ -653,10 +660,6 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
          else
            scm_puts ("#w(", port);
          goto common_vector_printer;
-
-       case scm_tc7_bytevector:
-         scm_i_print_bytevector (exp, port, pstate);
-         break;
        case scm_tc7_vector:
          ENTER_NESTED_DATA (pstate, exp, circref);
          scm_puts ("#(", port);

diff --git a/libguile/tags.h b/libguile/tags.h
index 26ec164..37fcb80 100644 (file)
--- 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
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2012
  * Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
@@ -424,7 +424,7 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
 #define scm_tc7_with_fluids    63
 #define scm_tc7_unused_19      69
 #define scm_tc7_program                79
-#define scm_tc7_unused_9       85
+#define scm_tc7_array          85
 #define scm_tc7_unused_10      87
 #define scm_tc7_unused_20      93
 #define scm_tc7_unused_11      95