mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-14 07:30:32 +02:00
Code Activity

(scm_take_u64vector,

Browse source 
scm_array_handle_u64_elements,
scm_array_handle_u64_writable_elements, scm_u64vector_elements,
scm_u64vector_writable_elements): Do not define when scm_t_uint64
is not available.
(scm_take_s64vector, scm_array_handle_s64_elements,
scm_array_handle_s64_writable_elements, scm_s64vector_elements,
scm_s64vector_writable_elements): Likewise for scm_t_int64.
(uvec_sizes, uvec_print, uvec_equalp): Use SCM bignums when
scm_t_int64/scm_t_uint64 are not available.
(uvec_mark): New, to mark the bignums.
(alloc_uvec): Initialize bignums.
(uvec_fast_ref): Return bignums directly.
(scm_uint64_min, scm_uint64_max, scm_int64_min, scm_int64_max,
assert_exact_integer): New.
(uvec_fast_set): Use them to validate the bignums.
(scm_init_srfi_4): Set mark function of smob when needed.
Initialize scm_uint64_min, scm_uint64_max, scm_int64_min,
scm_int64_max.
This commit is contained in:
Marius Vollmer 2005-01-14 18:19:13 +00:00
parent 55fcbb966b
commit 00c17d4526
3 changed files with 127 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

106
libguile/srfi-4.c
View file

@ -35,6 +35,7 @@
#include "libguile/vectors.h"
#include "libguile/unif.h"
#include "libguile/strings.h"
#include "libguile/strports.h"
#include "libguile/dynwind.h"
#include "libguile/deprecation.h"
@ -83,7 +84,11 @@ static const int uvec_sizes[12] = {
1, 1,
2, 2,
4, 4,
#if SCM_HAVE_T_INT64
8, 8,
#else
sizeof (SCM), sizeof (SCM),
#endif
sizeof(float), sizeof(double),
2*sizeof(float), 2*sizeof(double)
};
@ -128,6 +133,7 @@ uvec_print (SCM uvec, SCM port, scm_print_state *pstate)
#endif
float *f32;
double *f64;
SCM *fake_64;
} np;
size_t i = 0;
@ -145,7 +151,10 @@ uvec_print (SCM uvec, SCM port, scm_print_state *pstate)
#if SCM_HAVE_T_INT64
case SCM_UVEC_U64: np.u64 = (scm_t_uint64 *) uptr; break;
case SCM_UVEC_S64: np.s64 = (scm_t_int64 *) uptr; break;
#endif
#else
case SCM_UVEC_U64:
case SCM_UVEC_S64: np.fake_64 = (SCM *) uptr; break;
#endif
case SCM_UVEC_F32: np.f32 = (float *) uptr; break;
case SCM_UVEC_F64: np.f64 = (double *) uptr; break;
case SCM_UVEC_C32: np.f32 = (float *) uptr; break;
@ -173,6 +182,10 @@ uvec_print (SCM uvec, SCM port, scm_print_state *pstate)
#if SCM_HAVE_T_INT64
case SCM_UVEC_U64: scm_uintprint (*np.u64, 10, port); np.u64++; break;
case SCM_UVEC_S64: scm_intprint (*np.s64, 10, port); np.s64++; break;
#else
case SCM_UVEC_U64:
case SCM_UVEC_S64: scm_iprin1 (*np.fake_64, port, pstate);
np.fake_64++; break;
#endif
case SCM_UVEC_F32: scm_i_print_double (*np.f32, port); np.f32++; break;
case SCM_UVEC_F64: scm_i_print_double (*np.f64, port); np.f64++; break;
@ -209,6 +222,20 @@ uvec_equalp (SCM a, SCM b)
result = SCM_BOOL_F;
else if (SCM_UVEC_LENGTH (a) != SCM_UVEC_LENGTH (b))
result = SCM_BOOL_F;
#if SCM_HAVE_T_INT64 == 0
else if (SCM_UVEC_TYPE (a) == SCM_UVEC_U64
|| SCM_UVEC_TYPE (a) == SCM_UVEC_S64)
{
SCM *aptr = (SCM *)SCM_UVEC_BASE (a), *bptr = (SCM *)SCM_UVEC_BASE (b);
size_t len = SCM_UVEC_LENGTH (a), i;
for (i = 0; i < len; i++)
if (scm_is_false (scm_num_eq_p (*aptr++, *bptr++)))
{
result = SCM_BOOL_F;
break;
}
}
#endif
else if (memcmp (SCM_UVEC_BASE (a), SCM_UVEC_BASE (b),
SCM_UVEC_LENGTH (a) * uvec_sizes[SCM_UVEC_TYPE(a)]) != 0)
result = SCM_BOOL_F;
@ -217,6 +244,24 @@ uvec_equalp (SCM a, SCM b)
return result;
}
/* Mark hook. Only used when U64 and S64 are implemented as SCMs. */
#if SCM_HAVE_T_INT64 == 0
static SCM
uvec_mark (SCM uvec)
{
if (SCM_UVEC_TYPE (uvec) == SCM_UVEC_U64
|| SCM_UVEC_TYPE (uvec) == SCM_UVEC_S64)
{
SCM *ptr = (SCM *)SCM_UVEC_BASE (uvec);
size_t len = SCM_UVEC_LENGTH (uvec), i;
for (i = 0; i < len; i++)
scm_gc_mark (*ptr++);
}
return SCM_BOOL_F;
}
#endif
/* Smob free hook for homogeneous numeric vectors. */
static size_t
uvec_free (SCM uvec)
@ -273,6 +318,15 @@ alloc_uvec (int type, size_t len)
if (len > SCM_I_SIZE_MAX / uvec_sizes[type])
scm_out_of_range (NULL, scm_from_size_t (len));
base = scm_gc_malloc (len * uvec_sizes[type], uvec_names[type]);
#if SCM_HAVE_T_INT64 == 0
if (type == SCM_UVEC_U64 || type == SCM_UVEC_S64)
{
SCM *ptr = (SCM *)base;
size_t i;
for (i = 0; i < len; i++)
*ptr++ = SCM_UNSPECIFIED;
}
#endif
return take_uvec (type, base, len);
}
@ -300,6 +354,11 @@ uvec_fast_ref (int type, const void *base, size_t c_idx)
return scm_from_uint64 (((scm_t_uint64*)base)[c_idx]);
else if (type == SCM_UVEC_S64)
return scm_from_int64 (((scm_t_int64*)base)[c_idx]);
#else
else if (type == SCM_UVEC_U64)
return ((SCM *)base)[c_idx];
else if (type == SCM_UVEC_S64)
return ((SCM *)base)[c_idx];
#endif
else if (type == SCM_UVEC_F32)
return scm_from_double (((float*)base)[c_idx]);
@ -315,6 +374,22 @@ uvec_fast_ref (int type, const void *base, size_t c_idx)
return SCM_BOOL_F;
}
#if SCM_HAVE_T_INT64 == 0
static SCM scm_uint64_min, scm_uint64_max;
static SCM scm_int64_min, scm_int64_max;
static void
assert_exact_integer_range (SCM val, SCM min, SCM max)
{
if (!scm_is_integer (val)
|| scm_is_false (scm_exact_p (val)))
scm_wrong_type_arg_msg (NULL, 0, val, "exact integer");
if (scm_is_true (scm_less_p (val, min))
|| scm_is_true (scm_gr_p (val, max)))
scm_out_of_range (NULL, val);
}
#endif
static SCM_C_INLINE void
uvec_fast_set_x (int type, void *base, size_t c_idx, SCM val)
{
@ -335,6 +410,17 @@ uvec_fast_set_x (int type, void *base, size_t c_idx, SCM val)
(((scm_t_uint64*)base)[c_idx]) = scm_to_uint64 (val);
else if (type == SCM_UVEC_S64)
(((scm_t_int64*)base)[c_idx]) = scm_to_int64 (val);
#else
else if (type == SCM_UVEC_U64)
{
assert_exact_integer_range (val, scm_uint64_min, scm_uint64_max);
((SCM *)base)[c_idx] = val;
}
else if (type == SCM_UVEC_S64)
{
assert_exact_integer_range (val, scm_int64_min, scm_int64_max);
((SCM *)base)[c_idx] = val;
}
#endif
else if (type == SCM_UVEC_F32)
(((float*)base)[c_idx]) = scm_to_double (val);
@ -968,12 +1054,16 @@ SCM_DEFINE (scm_uniform_vector_write, "uniform-vector-write", 1, 3, 0,
#define TYPE SCM_UVEC_U64
#define TAG u64
#if SCM_HAVE_T_UINT64
#define CTYPE scm_t_uint64
#endif
#include "libguile/srfi-4.i.c"
#define TYPE SCM_UVEC_S64
#define TAG s64
#if SCM_HAVE_T_INT64
#define CTYPE scm_t_int64
#endif
#include "libguile/srfi-4.i.c"
#define TYPE SCM_UVEC_F32
@ -1031,9 +1121,23 @@ scm_init_srfi_4 (void)
{
scm_tc16_uvec = scm_make_smob_type ("uvec", 0);
scm_set_smob_equalp (scm_tc16_uvec, uvec_equalp);
#if SCM_HAVE_T_INT64 == 0
scm_set_smob_mark (scm_tc16_uvec, uvec_mark);
#endif
scm_set_smob_free (scm_tc16_uvec, uvec_free);
scm_set_smob_print (scm_tc16_uvec, uvec_print);
#if SCM_HAVE_T_INT64 == 0
scm_uint64_min =
scm_permanent_object (scm_from_int (0));
scm_uint64_max =
scm_permanent_object (scm_c_read_string ("18446744073709551615"));
scm_int64_min =
scm_permanent_object (scm_c_read_string ("-9223372036854775808"));
scm_int64_max =
scm_permanent_object (scm_c_read_string ("9223372036854775807"));
#endif
#include "libguile/srfi-4.x"
}