mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
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.
This commit is contained in:
Andy Wingo
parent
017eb4a6be
commit
b2637c985c
8 changed files with 41 additions and 35 deletions
|
|
@ -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);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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>",
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue