* backtrace.c, debug.c, debug.h, deprecation.c, eq.c, eval.c

[bpt/guile.git] / libguile / gh_data.c

diff --git a/libguile/gh_data.c b/libguile/gh_data.c
index c9b762c..1ed6033 100644 (file)
--- a/libguile/gh_data.c
+++ b/libguile/gh_data.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2004 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2004, 2006 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 as published by the Free Software Foundation; either
@@ -11,7 +11,7 @@
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  */
 \f
 
@@ -28,6 +28,8 @@
 
 #include <assert.h>
 
+#if SCM_ENABLE_DEPRECATED
+
 /* data conversion C->scheme */
 
 SCM 
@@ -106,7 +108,7 @@ gh_ints2scm (const int *d, long n)
   long i;
   SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED);
   for (i = 0; i < n; ++i)
-    SCM_VECTOR_SET (v, i, scm_from_int (d[i]));
+    SCM_SIMPLE_VECTOR_SET (v, i, scm_from_int (d[i]));
 
   return v;
 }
@@ -118,7 +120,7 @@ gh_doubles2scm (const double *d, long n)
   SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED);
 
   for(i = 0; i < n; i++) 
-    SCM_VECTOR_SET (v, i, scm_from_double (d[i]));
+    SCM_SIMPLE_VECTOR_SET (v, i, scm_from_double (d[i]));
   return v;
 }
 
@@ -128,7 +130,7 @@ gh_chars2byvect (const char *d, long n)
 {
   char *m = scm_malloc (n);
   memcpy (m, d, n * sizeof (char));
-  return scm_take_s8vector (m, n);
+  return scm_take_s8vector ((scm_t_int8 *)m, n);
 }
 
 SCM
@@ -224,10 +226,10 @@ gh_scm2chars (SCM obj, char *m)
     {
     case scm_tc7_vector:
     case scm_tc7_wvect:
-      n = SCM_VECTOR_LENGTH (obj);
+      n = SCM_SIMPLE_VECTOR_LENGTH (obj);
       for (i = 0; i < n; ++i)
        {
-         val = SCM_VELTS (obj)[i];
+         val = SCM_SIMPLE_VECTOR_REF (obj, i);
          if (SCM_I_INUMP (val))
            {
              v = SCM_I_INUM (val);
@@ -242,24 +244,31 @@ gh_scm2chars (SCM obj, char *m)
       if (m == NULL)
        return NULL;
       for (i = 0; i < n; ++i)
-       m[i] = SCM_I_INUM (SCM_VELTS (obj)[i]);
+       m[i] = SCM_I_INUM (SCM_SIMPLE_VECTOR_REF (obj, i));
       break;
-#if SCM_HAVE_ARRAYS
     case scm_tc7_smob:
       if (scm_is_true (scm_s8vector_p (obj)))
        {
-         n = scm_to_long (scm_s8vector_length (obj));
+         scm_t_array_handle handle;
+         size_t len;
+         ssize_t inc;
+         const scm_t_int8 *elts;
+
+         elts = scm_s8vector_elements (obj, &handle, &len, &inc);
+         if (inc != 1)
+           scm_misc_error (NULL, "only contiguous vectors are supported: ~a",
+                           scm_list_1 (obj));
          if (m == 0)
-           m = (char *) malloc (n * sizeof (char));
+           m = (char *) malloc (len);
+         if (m != NULL)
+           memcpy (m, elts, len);
+         scm_array_handle_release (&handle);
          if (m == NULL)
            return NULL;
-         memcpy (m, scm_s8vector_elements (obj), n * sizeof (char));
-         scm_remember_upto_here_1 (obj);
          break;
        }
       else
        goto wrong_type;
-#endif
     case scm_tc7_string:
       n = scm_i_string_length (obj);
       if (m == 0)
@@ -278,13 +287,24 @@ gh_scm2chars (SCM obj, char *m)
 static void *
 scm2whatever (SCM obj, void *m, size_t size)
 {
-  size_t n = scm_c_uniform_vector_length (obj);
+  scm_t_array_handle handle;
+  size_t len;
+  ssize_t inc;
+  const void *elts;
+
+  elts = scm_uniform_vector_elements (obj, &handle, &len, &inc);
+
+  if (inc != 1)
+    scm_misc_error (NULL, "only contiguous vectors can be converted: ~a",
+                   scm_list_1 (obj));
+
   if (m == 0)
-    m = malloc (n * sizeof (size));
-  if (m == NULL)
-    return NULL;
-  memcpy (m, scm_uniform_vector_elements (obj), n * size);
-  scm_uniform_vector_release (obj);
+    m = malloc (len * sizeof (size));
+  if (m != NULL)
+    memcpy (m, elts, len * size);
+
+  scm_array_handle_release (&handle);
+
   return m;
 }
 
@@ -313,10 +333,10 @@ gh_scm2shorts (SCM obj, short *m)
     {
     case scm_tc7_vector:
     case scm_tc7_wvect:
-      n = SCM_VECTOR_LENGTH (obj);
+      n = SCM_SIMPLE_VECTOR_LENGTH (obj);
       for (i = 0; i < n; ++i)
        {
-         val = SCM_VELTS (obj)[i];
+         val = SCM_SIMPLE_VECTOR_REF (obj, i);
          if (SCM_I_INUMP (val))
            {
              v = SCM_I_INUM (val);
@@ -331,7 +351,7 @@ gh_scm2shorts (SCM obj, short *m)
       if (m == NULL)
        return NULL;
       for (i = 0; i < n; ++i)
-       m[i] = SCM_I_INUM (SCM_VELTS (obj)[i]);
+       m[i] = SCM_I_INUM (SCM_SIMPLE_VECTOR_REF (obj, i));
       break;
     default:
       scm_wrong_type_arg (0, 0, obj);
@@ -356,10 +376,10 @@ gh_scm2longs (SCM obj, long *m)
     {
     case scm_tc7_vector:
     case scm_tc7_wvect:
-      n = SCM_VECTOR_LENGTH (obj);
+      n = SCM_SIMPLE_VECTOR_LENGTH (obj);
       for (i = 0; i < n; ++i)
        {
-         val = SCM_VELTS (obj)[i];
+         val = SCM_SIMPLE_VECTOR_REF (obj, i);
          if (!SCM_I_INUMP (val) && !SCM_BIGP (val))
            scm_wrong_type_arg (0, 0, obj);
        }
@@ -369,7 +389,7 @@ gh_scm2longs (SCM obj, long *m)
        return NULL;
       for (i = 0; i < n; ++i)
        {
-         val = SCM_VELTS (obj)[i];
+         val = SCM_SIMPLE_VECTOR_REF (obj, i);
          m[i] = SCM_I_INUMP (val) 
            ? SCM_I_INUM (val) 
            : scm_to_long (val);
@@ -400,10 +420,10 @@ gh_scm2floats (SCM obj, float *m)
     {
     case scm_tc7_vector:
     case scm_tc7_wvect:
-      n = SCM_VECTOR_LENGTH (obj);
+      n = SCM_SIMPLE_VECTOR_LENGTH (obj);
       for (i = 0; i < n; ++i)
        {
-         val = SCM_VELTS (obj)[i];
+         val = SCM_SIMPLE_VECTOR_REF (obj, i);
          if (!SCM_I_INUMP (val)
              && !(SCM_BIGP (val) || SCM_REALP (val)))
            scm_wrong_type_arg (0, 0, val);
@@ -414,7 +434,7 @@ gh_scm2floats (SCM obj, float *m)
        return NULL;
       for (i = 0; i < n; ++i)
        {
-         val = SCM_VELTS (obj)[i];
+         val = SCM_SIMPLE_VECTOR_REF (obj, i);
          if (SCM_I_INUMP (val))
            m[i] = SCM_I_INUM (val);
          else if (SCM_BIGP (val))
@@ -448,10 +468,10 @@ gh_scm2doubles (SCM obj, double *m)
     {
     case scm_tc7_vector:
     case scm_tc7_wvect:
-      n = SCM_VECTOR_LENGTH (obj);
+      n = SCM_SIMPLE_VECTOR_LENGTH (obj);
       for (i = 0; i < n; ++i)
        {
-         val = SCM_VELTS (obj)[i];
+         val = SCM_SIMPLE_VECTOR_REF (obj, i);
          if (!SCM_I_INUMP (val)
              && !(SCM_BIGP (val) || SCM_REALP (val)))
            scm_wrong_type_arg (0, 0, val);
@@ -462,7 +482,7 @@ gh_scm2doubles (SCM obj, double *m)
        return NULL;
       for (i = 0; i < n; ++i)
        {
-         val = SCM_VELTS (obj)[i];
+         val = SCM_SIMPLE_VECTOR_REF (obj, i);
          if (SCM_I_INUMP (val))
            m[i] = SCM_I_INUM (val);
          else if (SCM_BIGP (val))
@@ -570,17 +590,16 @@ gh_vector_ref (SCM vec, SCM pos)
 unsigned long 
 gh_vector_length (SCM v)
 {
-  return (unsigned long) SCM_VECTOR_LENGTH (v);
+  return (unsigned long) scm_c_vector_length (v);
 }
 
-#if SCM_HAVE_ARRAYS
 /* uniform vector support */
 
 /* returns the length as a C unsigned long integer */
 unsigned long
 gh_uniform_vector_length (SCM v)
 {
-  return (unsigned long) SCM_UVECTOR_LENGTH (v);
+  return (unsigned long) scm_c_uniform_vector_length (v);
 }
 
 /* gets the given element from a uniform vector; ilist is a list (or
@@ -595,7 +614,6 @@ gh_uniform_vector_ref (SCM v, SCM ilist)
 /* sets an individual element in a uniform vector */
 /* SCM */
 /* gh_list_to_uniform_array ( */
-#endif
 
 /* Data lookups between C and Scheme
 
@@ -632,6 +650,8 @@ gh_module_lookup (SCM module, const char *sname)
 }
 #undef FUNC_NAME
 
+#endif /* SCM_ENABLE_DEPRECATED */
+
 /*
   Local Variables:
   c-file-style: "gnu"