(scm_take_u64vector,

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.

diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c
index 2ee6516..53da9f8 100644 (file)
--- a/libguile/srfi-4.c
+++ b/libguile/srfi-4.c
@@ -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"
 
 }

diff --git a/libguile/srfi-4.h b/libguile/srfi-4.h
index 6bd8fe4..311a42e 100644 (file)
--- a/libguile/srfi-4.h
+++ b/libguile/srfi-4.h
@@ -178,7 +178,6 @@ SCM_API scm_t_int32 *scm_s32vector_writable_elements (SCM uvec,
 
 SCM_API SCM scm_u64vector_p (SCM obj);
 SCM_API SCM scm_make_u64vector (SCM n, SCM fill);
-SCM_API SCM scm_take_u64vector (const scm_t_uint64 *data, size_t n);
 SCM_API SCM scm_u64vector (SCM l);
 SCM_API SCM scm_u64vector_length (SCM uvec);
 SCM_API SCM scm_u64vector_ref (SCM uvec, SCM index);
@@ -186,6 +185,9 @@ SCM_API SCM scm_u64vector_set_x (SCM uvec, SCM index, SCM value);
 SCM_API SCM scm_u64vector_to_list (SCM uvec);
 SCM_API SCM scm_list_to_u64vector (SCM l);
 SCM_API SCM scm_any_to_u64vector (SCM obj);
+
+#if SCM_HAVE_T_UINT64
+SCM_API SCM scm_take_u64vector (const scm_t_uint64 *data, size_t n);
 SCM_API const scm_t_uint64 *scm_array_handle_u64_elements (scm_t_array_handle *h);
 SCM_API scm_t_uint64 *scm_array_handle_u64_writable_elements (scm_t_array_handle *h);
 SCM_API const scm_t_uint64 *scm_u64vector_elements (SCM uvec, 
@@ -196,10 +198,10 @@ SCM_API scm_t_uint64 *scm_u64vector_writable_elements (SCM uvec,
                                                       scm_t_array_handle *h,
                                                       size_t *lenp,
                                                       ssize_t *incp);
+#endif
 
 SCM_API SCM scm_s64vector_p (SCM obj);
 SCM_API SCM scm_make_s64vector (SCM n, SCM fill);
-SCM_API SCM scm_take_s64vector (const scm_t_int64 *data, size_t n);
 SCM_API SCM scm_s64vector (SCM l);
 SCM_API SCM scm_s64vector_length (SCM uvec);
 SCM_API SCM scm_s64vector_ref (SCM uvec, SCM index);
@@ -207,6 +209,9 @@ SCM_API SCM scm_s64vector_set_x (SCM uvec, SCM index, SCM value);
 SCM_API SCM scm_s64vector_to_list (SCM uvec);
 SCM_API SCM scm_list_to_s64vector (SCM l);
 SCM_API SCM scm_any_to_s64vector (SCM obj);
+
+#if SCM_HAVE_T_INT64
+SCM_API SCM scm_take_s64vector (const scm_t_int64 *data, size_t n);
 SCM_API const scm_t_int64 *scm_array_handle_s64_elements (scm_t_array_handle *h);
 SCM_API scm_t_int64 *scm_array_handle_s64_writable_elements (scm_t_array_handle *h);
 SCM_API const scm_t_int64 *scm_s64vector_elements (SCM uvec, 
@@ -216,6 +221,7 @@ SCM_API scm_t_int64 *scm_s64vector_writable_elements (SCM uvec,
                                                      scm_t_array_handle *h,
                                                      size_t *lenp,
                                                      ssize_t *incp);
+#endif
 
 SCM_API SCM scm_f32vector_p (SCM obj);
 SCM_API SCM scm_make_f32vector (SCM n, SCM fill);

diff --git a/libguile/srfi-4.i.c b/libguile/srfi-4.i.c
index e1c3598..101eb38 100644 (file)
--- a/libguile/srfi-4.i.c
+++ b/libguile/srfi-4.i.c
@@ -21,6 +21,8 @@
    The C type of the elements, for example scm_t_uint8.  The code
    below will never do sizeof (CTYPE), thus you can use just 'float'
    for the c32 type, for example.
+
+   When CTYPE is not defined, the functions using it are excluded.
 */
 
 /* The first level does not expand macros in the arguments. */
@@ -55,14 +57,6 @@ SCM_DEFINE (F(scm_make_,TAG,vector), "make-"S(TAG)"vector", 1, 1, 0,
 }
 #undef FUNC_NAME
 
-SCM
-F(scm_take_,TAG,vector) (const CTYPE *data, size_t n)
-{
-  scm_gc_register_collectable_memory ((void *)data, n*uvec_sizes[TYPE],
-                                     uvec_names[TYPE]);
-  return take_uvec (TYPE, data, n);
-}
-
 SCM_DEFINE (F(scm_,TAG,vector), S(TAG)"vector", 0, 0, 1,
             (SCM l),
            "Return a newly allocated uniform numeric vector containing\n"
@@ -138,6 +132,16 @@ SCM_DEFINE (F(scm_any_to_,TAG,vector), "any->"S(TAG)"vector", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+#ifdef CTYPE
+
+SCM
+F(scm_take_,TAG,vector) (const CTYPE *data, size_t n)
+{
+  scm_gc_register_collectable_memory ((void *)data, n*uvec_sizes[TYPE],
+                                     uvec_names[TYPE]);
+  return take_uvec (TYPE, data, n);
+}
+
 const CTYPE *
 F(scm_array_handle_,TAG,_elements) (scm_t_array_handle *h)
 {
@@ -180,6 +184,8 @@ F(scm_,TAG,vector_writable_elements) (SCM uvec,
   return F(scm_array_handle_,TAG,_writable_elements) (h);
 }
 
+#endif
+
 static SCM
 F(,TAG,ref) (scm_t_array_handle *handle, ssize_t pos)
 {