* convert.i.c: Convert srfi-4 style uniform vectors when
authorMarius Vollmer <mvo@zagadka.de>
Wed, 27 Oct 2004 19:32:11 +0000 (19:32 +0000)
committerMarius Vollmer <mvo@zagadka.de>
Wed, 27 Oct 2004 19:32:11 +0000 (19:32 +0000)
requested.
* convert.c (scm_c_scm2chars, scm_c_chars2scm,
scm_c_chars2byvect): Use a s8vector instead of a scm_tc7_byvect.

libguile/convert.c
libguile/convert.i.c

index 246d02a..b3d3db3 100644 (file)
@@ -28,6 +28,7 @@
 #if SCM_HAVE_ARRAYS
 # include "libguile/unif.h"
 #endif
+#include "libguile/srfi-4.h"
 
 #include "libguile/convert.h"
 
 #define CTYPES2SCM       scm_c_chars2scm
 #define CTYPES2UVECT_FN  "scm_c_chars2byvect"
 #define CTYPES2UVECT     scm_c_chars2byvect
-#define UVECTTYPE        scm_tc7_byvect
+#define UVEC_CREATOR    scm_take_s8vector
 #define SIZEOF_UVECTTYPE 1
 #define UVECTCTYPE       char
-#define ARRAYTYPE        scm_tc7_byvect
+#define UVEC_PREDICATE  scm_s8vector_p
 #define SIZEOF_ARRAYTYPE 1
 #define ARRAYCTYPE       char
 #include "convert.i.c"
index 230aa51..02aa9e9 100644 (file)
@@ -70,6 +70,31 @@ SCM2CTYPES (SCM obj, CTYPE *data)
       return data;
     }
 
+  /* uniform vectors */
+#ifdef UVEC_PREDICATE
+  if (scm_is_true (UVEC_PREDICATE (obj)))
+    {
+      n = scm_c_uniform_vector_length (obj);
+      ARRAYCTYPE *elts = (ARRAYCTYPE *)scm_uniform_vector_elements (obj);
+
+      /* allocate new memory if necessary */
+      if (data == NULL)
+       if ((data = (CTYPE *) malloc (n * sizeof (CTYPE))) == NULL)
+         return NULL;
+
+#if SIZEOF_CTYPE != SIZEOF_ARRAYTYPE
+      /* copy array element by element */
+      for (i = 0; i < n; i++)
+       data[i] = (CTYPE) elts[i];
+#else
+      /* copy whole array */
+      memcpy (data, (CTYPE *) elts, n * sizeof (CTYPE));
+#endif
+      scm_uniform_vector_release (obj);
+      return data;
+    }
+#endif
+      
   /* other conversions */
   switch (SCM_TYP7 (obj))
     {
@@ -127,7 +152,7 @@ SCM2CTYPES (SCM obj, CTYPE *data)
 #endif
        }
       break;
-
+#ifdef ARRAYTPE
 #if SCM_HAVE_ARRAYS
       /* array conversions (uniform vectors) */
     case ARRAYTYPE:
@@ -160,6 +185,7 @@ SCM2CTYPES (SCM obj, CTYPE *data)
 #endif
       break;
 #endif /* SCM_HAVE_ARRAYS */
+#endif
 
 #if SIZEOF_CTYPE == 1
     case scm_tc7_string:
@@ -204,11 +230,16 @@ CTYPES2UVECT (const CTYPE *data, long n)
   v = scm_gc_malloc (n * sizeof (CTYPE), "uvect");
   memcpy (v, data, n * sizeof (CTYPE));
 #endif
+
+#ifdef UVEC_CREATOR
+  return UVEC_CREATOR (v, n);
+#else
   return scm_cell (SCM_MAKE_UVECTOR_TAG (n, UVECTTYPE), (scm_t_bits) v);
+#endif
 }
 #undef FUNC_NAME
 
-#ifdef UVECTTYPE_OPTIONAL
+#if defined(UVECTTYPE_OPTIONAL) || defined(UVEC_CREATOR_OPTIONAL)
 #define FUNC_NAME CTYPES2UVECT_FN_OPTIONAL
 SCM
 CTYPES2UVECT_OPTIONAL (const unsigned CTYPE *data, long n)
@@ -230,11 +261,15 @@ CTYPES2UVECT_OPTIONAL (const unsigned CTYPE *data, long n)
   v = scm_gc_malloc (n * sizeof (CTYPE), "uvect");
   memcpy (v, data, n * sizeof (CTYPE));
 #endif
+#ifdef UVEC_CREATOR_OPTIONAL
+  return UVEC_CREATOR_OPTIONAL (v, n);
+#else
   return scm_cell (SCM_MAKE_UVECTOR_TAG (n, UVECTTYPE_OPTIONAL), 
                   (scm_t_bits) v);
+#endif
 }
 #undef FUNC_NAME
-#endif /* UVECTTYPE_OPTIONAL */
+#endif /* UVECTTYPE_OPTIONAL || UVEC_CREATOR_OPTIONAL */
 
 #endif /* SCM_HAVE_ARRAYS */
 
@@ -278,7 +313,9 @@ CTYPES2SCM (const CTYPE *data, long n)
 #undef SIZEOF_CTYPE
 #undef SIZEOF_UVECTTYPE
 #undef SIZEOF_ARRAYTYPE
+#ifdef ARRAYTYPE
 #undef ARRAYTYPE
+#endif
 #ifdef ARRAYTYPE_OPTIONAL
 #undef ARRAYTYPE_OPTIONAL
 #endif
@@ -294,6 +331,16 @@ CTYPES2SCM (const CTYPE *data, long n)
 #ifdef ARRAYCTYPE
 #undef ARRAYCTYPE
 #endif
+#ifdef UVEC_PREDICATE
+#undef UVEC_PREDICATE
+#endif
+#ifdef UVEC_CREATOR
+#undef UVEC_CREATOR
+#endif
+#ifdef UVEC_CREATOR_OPTIONAL
+#undef UVEC_CREATOR_OPTIONAL
+#endif
+
 
 /*
   Local Variables: