summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/array-map.c3
-rw-r--r--libguile/arrays.c24
-rw-r--r--libguile/arrays.h11
-rw-r--r--libguile/eq.c17
-rw-r--r--libguile/evalext.c1
-rw-r--r--libguile/goops.c5
-rw-r--r--libguile/print.c11
-rw-r--r--libguile/tags.h4
8 files changed, 41 insertions, 35 deletions
diff --git a/libguile/array-map.c b/libguile/array-map.c
index d442bdf4e..ef6f80dd3 100644
--- 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 d99081caf..c17f125fb 100644
--- 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 9b14d4e36..5ea604d6a 100644
--- 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 11dce99a1..d286d5c72 100644
--- 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 1e5bd6822..2dfaa1363 100644
--- 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 31fa17975..e951309d0 100644
--- 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 2551bdf91..e0a6daa52 100644
--- 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 26ec16425..37fcb8063 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
+/* 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