From b2637c985ce93bc15e0378b8120d04a98ebdd212 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Mon, 9 Jan 2012 17:24:57 +0100 Subject: [PATCH] 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 declarations. * libguile/print.c (iprin1): Call scm_i_print_array as needed. * libguile/evalext.c (scm_self_evaluating_p): Add a case for arrays. --- libguile/array-map.c | 3 +-- libguile/arrays.c | 24 +++++++++--------------- libguile/arrays.h | 11 +++++------ libguile/eq.c | 17 +++++++++++------ libguile/evalext.c | 1 + libguile/goops.c | 5 +++++ libguile/print.c | 11 +++++++---- libguile/tags.h | 4 ++-- 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, "", scm_class_class, class_bytevector, SCM_EOL); + make_stdcls (&class_array, "", + scm_class_class, scm_class_top, SCM_EOL); make_stdcls (&scm_class_number, "", scm_class_class, scm_class_top, SCM_EOL); make_stdcls (&scm_class_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 -- 2.20.1