* numbers.c (num2long): As a software archeologist, I'm proud of

this finding! :) Preliminary dating suggests an almost 4 year old
remnant from the SCM ancestor.  The sample has been removed from
the finding site and is now safely stored in the repository.
* numbers.h: Removed prototype for num2long.
* unif.c (scm_array_set_x): Use scm_num2long instead of num2long.
* gh_data.c (gh_scm2doubles): Make it possible to pass result
array as second arg.
(gh_chars2byvect, gh_shorts2svect, gh_floats2fvect, gh_scm2chars,
gh_scm2shorts, gh_scm2longs, gh_scm2floats): New functions.
* gh.h: Updated and added prototypes.
* gh_data.c (gh_ints2scm): Handle integers outside INUM limits.

NEWS

@@ -6,6 +6,18 @@ Please send Guile bug reports to bug-guile@gnu.org.
 
 Changes since Guile 1.3:
 
+* Changes to the gh_ interface
+
+** gh_scm2doubles
+
+Now takes a second argument which is the result array.  If this
+pointer is NULL, a new array is malloced (the old behaviour).
+
+** gh_chars2byvect, gh_shorts2svect, gh_floats2fvect, gh_scm2chars,
+   gh_scm2shorts, gh_scm2longs, gh_scm2floats
+
+New functions.
+
 
 Changes in Guile 1.3 (released Monday, October 19, 1998):
 

libguile/ChangeLog

@@ -1,3 +1,22 @@
+1998-10-26  Mikael Djurfeldt  <mdj@barbara.nada.kth.se>
+
+	* numbers.c (num2long): As a software archeologist, I'm proud of
+	this finding! :) Preliminary dating suggests an almost 4 year old
+	remnant from the SCM ancestor.  The sample has been removed from
+	the finding site and is now safely stored in the repository.
+
+	* numbers.h: Removed prototype for num2long.
+
+	* unif.c (scm_array_set_x): Use scm_num2long instead of num2long.
+
+	* gh_data.c (gh_scm2doubles): Make it possible to pass result
+	array as second arg.
+	(gh_chars2byvect, gh_shorts2svect, gh_floats2fvect, gh_scm2chars,
+	gh_scm2shorts, gh_scm2longs, gh_scm2floats): New functions.
+	* gh.h: Updated and added prototypes.
+
+	* gh_data.c (gh_ints2scm): Handle integers outside INUM limits.
+
 1998-10-24  Jim Blandy  <jimb@zwingli.cygnus.com>
 
 	* gc.h: Remove all uses of SCM_P.  (Thanks to Richard Polton.)

libguile/gh.h

@@ -108,10 +108,15 @@ SCM gh_str02scm(char *s);
 void gh_set_substr(char *src, SCM dst, int start, int len);
 SCM gh_symbol2scm(char *symbol_str);
 SCM gh_ints2scm(int *d, int n);
+SCM gh_chars2byvect(char *d, int n);
+SCM gh_shorts2svect(short *d, int n);
 SCM gh_longs2ivect(long *d, int n);
 SCM gh_ulongs2uvect(unsigned long *d, int n);
 SCM gh_doubles2scm(double *d, int n);
 #ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+SCM gh_floats2fvect(float *d, int n);
+#endif
 SCM gh_doubles2dvect(double *d, int n);
 #endif
 
@@ -126,7 +131,11 @@ double gh_scm2double(SCM obj);
 char *gh_scm2newstr(SCM str, int *lenp);
 void gh_get_substr(SCM src, char *dst, int start, int len);
 char *gh_symbol2newstr(SCM sym, int *lenp);
-double *gh_scm2doubles(SCM vector);
+char *gh_scm2chars(SCM vector, char *result);
+short *gh_scm2shorts(SCM vector, short *result);
+long *gh_scm2longs(SCM vector, long *result);
+float *gh_scm2floats(SCM vector, float *result);
+double *gh_scm2doubles(SCM vector, double *result);
 
 /* type predicates: tell you if an SCM object has a given type */
 int gh_boolean_p(SCM val);

libguile/gh_data.c

@@ -143,17 +143,41 @@ gh_ints2scm (int *d, int n)
 {
   SCM *m;
   int i;
-  for (i = 0; i < n; ++i)
-    SCM_ASSERT (d[i] >= SCM_INUM (LONG_MIN) && d[i] <= SCM_INUM (LONG_MAX),
-		SCM_MAKINUM (d[i]),
-		SCM_OUTOFRANGE,
-		"gh_ints2scm");
   m = (SCM*) scm_must_malloc (n * sizeof (SCM), "vector");
   for (i = 0; i < n; ++i)
-    m[i] = SCM_MAKINUM (d[i]);
+    m[i] = (d[i] >= SCM_MOST_NEGATIVE_FIXNUM
+	    && d[i] <= SCM_MOST_POSITIVE_FIXNUM
+	    ? SCM_MAKINUM (d[i])
+	    : scm_long2big (d[i]));
   return makvect ((char *) m, n, scm_tc7_vector);
 }
 
+SCM
+gh_doubles2scm (double *d, int n)
+{
+  SCM *m = (SCM*) scm_must_malloc (n * sizeof (SCM), "vector");
+  int i;
+  for (i = 0; i < n; ++i)
+    m[i] = scm_makdbl (d[i], 0.0);
+  return makvect ((char *) m, n, scm_tc7_vector);
+}
+
+SCM
+gh_chars2byvect (char *d, int n)
+{
+  char *m = scm_must_malloc (n * sizeof (char), "vector");
+  memcpy (m, d, n * sizeof (char));
+  return makvect (m, n, scm_tc7_byvect);
+}
+
+SCM
+gh_shorts2svect (short *d, int n)
+{
+  char *m = scm_must_malloc (n * sizeof (short), "vector");
+  memcpy (m, d, n * sizeof (short));
+  return makvect (m, n, scm_tc7_svect);
+}
+
 SCM
 gh_longs2ivect (long *d, int n)
 {
@@ -170,17 +194,17 @@ gh_ulongs2uvect (unsigned long *d, int n)
   return makvect (m, n, scm_tc7_uvect);
 }
 
-SCM
-gh_doubles2scm (double *d, int n)
-{
-  SCM *m = (SCM*) scm_must_malloc (n * sizeof (SCM), "vector");
-  int i;
-  for (i = 0; i < n; ++i)
-    m[i] = scm_makdbl (d[i], 0.0);
-  return makvect ((char *) m, n, scm_tc7_vector);
-}
-
 #ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+SCM
+gh_floats2fvect (float *d, int n)
+{
+  char *m = scm_must_malloc (n * sizeof (float), "vector");
+  memcpy (m, d, n * sizeof (float));
+  return makvect (m, n, scm_tc7_fvect);
+}
+#endif
+
 SCM
 gh_doubles2dvect (double *d, int n)
 {
@@ -223,13 +247,14 @@ gh_scm2char (SCM obj)
   return SCM_ICHR (obj);
 }
 
-/* Convert a vector, weak vector or uniform vector into a malloced
+/* Convert a vector, weak vector, string, substring or uniform vector
-   array of doubles. */
+   into an array of chars.  If result array in arg 2 is NULL, malloc a
-double*
+   new one. */
-gh_scm2doubles (SCM obj)
+char *
+gh_scm2chars (SCM obj, char *m)
 {
   int i, n;
-  double *m = 0;
+  long v;
   SCM val;
   if (!SCM_NIMP (obj))
     scm_wrong_type_arg (0, 0, obj);
@@ -238,35 +263,228 @@ gh_scm2doubles (SCM obj)
     case scm_tc7_vector:
     case scm_tc7_wvect:
       n = SCM_LENGTH (obj);
-      m = (double*) malloc (n * sizeof (double));
+      for (i = 0; i < n; ++i)
+	{
+	  val = SCM_VELTS (obj)[i];
+	  if (SCM_INUMP (val))
+	    {
+	      v = SCM_INUM (val);
+	      if (v < -128 || v > 255)
+		scm_out_of_range (0, obj);
+	    }
+	  else
+	    scm_wrong_type_arg (0, 0, obj);
+	}
+      if (m == 0)
+	m = (char *) malloc (n * sizeof (char));
+      for (i = 0; i < n; ++i)
+	m[i] = SCM_INUM (SCM_VELTS (obj)[i]);
+      break;
+    case scm_tc7_byvect:
+    case scm_tc7_string:
+    case scm_tc7_substring:
+      n = SCM_LENGTH (obj);
+      if (m == 0)
+	m = (char *) malloc (n * sizeof (char));
+      memcpy (m, SCM_VELTS (obj), n * sizeof (char));
+      break;
+    default:
+      scm_wrong_type_arg (0, 0, obj);
+    }
+  return m;
+}
+
+/* Convert a vector, weak vector or uniform vector into an array of
+   shorts.  If result array in arg 2 is NULL, malloc a new one. */
+short *
+gh_scm2shorts (SCM obj, short *m)
+{
+  int i, n;
+  long v;
+  SCM val;
+  if (!SCM_NIMP (obj))
+    scm_wrong_type_arg (0, 0, obj);
+  switch (SCM_TYP7 (obj))
+    {
+    case scm_tc7_vector:
+    case scm_tc7_wvect:
+      n = SCM_LENGTH (obj);
+      for (i = 0; i < n; ++i)
+	{
+	  val = SCM_VELTS (obj)[i];
+	  if (SCM_INUMP (val))
+	    {
+	      v = SCM_INUM (val);
+	      if (v < -32768 || v > 65535)
+		scm_out_of_range (0, obj);
+	    }
+	  else
+	    scm_wrong_type_arg (0, 0, obj);
+	}
+      if (m == 0)
+	m = (short *) malloc (n * sizeof (short));
+      for (i = 0; i < n; ++i)
+	m[i] = SCM_INUM (SCM_VELTS (obj)[i]);
+      break;
+    case scm_tc7_svect:
+      n = SCM_LENGTH (obj);
+      if (m == 0)
+	m = (short *) malloc (n * sizeof (short));
+      memcpy (m, SCM_VELTS (obj), n * sizeof (short));
+      break;
+    default:
+      scm_wrong_type_arg (0, 0, obj);
+    }
+  return m;
+}
+
+/* Convert a vector, weak vector or uniform vector into an array of
+   longs.  If result array in arg 2 is NULL, malloc a new one. */
+long *
+gh_scm2longs (SCM obj, long *m)
+{
+  int i, n;
+  SCM val;
+  if (!SCM_NIMP (obj))
+    scm_wrong_type_arg (0, 0, obj);
+  switch (SCM_TYP7 (obj))
+    {
+    case scm_tc7_vector:
+    case scm_tc7_wvect:
+      n = SCM_LENGTH (obj);
+      for (i = 0; i < n; ++i)
+	{
+	  val = SCM_VELTS (obj)[i];
+	  if (!SCM_INUMP (val) && !(SCM_NIMP (val) && SCM_BIGP (val)))
+	    scm_wrong_type_arg (0, 0, obj);
+	}
+      if (m == 0)
+	m = (long *) malloc (n * sizeof (long));
+      for (i = 0; i < n; ++i)
+	{
+	  val = SCM_VELTS (obj)[i];
+	  m[i] = SCM_INUMP (val) ? SCM_INUM (val) : scm_num2long (val, 0, 0);
+	}
+      break;
+    case scm_tc7_ivect:
+    case scm_tc7_uvect:
+      n = SCM_LENGTH (obj);
+      if (m == 0)
+	m = (long *) malloc (n * sizeof (long));
+      memcpy (m, SCM_VELTS (obj), n * sizeof (long));
+      break;
+    default:
+      scm_wrong_type_arg (0, 0, obj);
+    }
+  return m;
+}
+
+/* Convert a vector, weak vector or uniform vector into an array of
+   floats.  If result array in arg 2 is NULL, malloc a new one. */
+float *
+gh_scm2floats (SCM obj, float *m)
+{
+  int i, n;
+  SCM val;
+  if (!SCM_NIMP (obj))
+    scm_wrong_type_arg (0, 0, obj);
+  switch (SCM_TYP7 (obj))
+    {
+    case scm_tc7_vector:
+    case scm_tc7_wvect:
+      n = SCM_LENGTH (obj);
+      for (i = 0; i < n; ++i)
+	{
+	  val = SCM_VELTS (obj)[i];
+	  if (!SCM_INUMP (val)
+	      && !(SCM_NIMP (val) && (SCM_BIGP (val) || SCM_REALP (val))))
+	    scm_wrong_type_arg (0, 0, val);
+	}
+      if (m == 0)
+	m = (float *) malloc (n * sizeof (float));
       for (i = 0; i < n; ++i)
 	{
 	  val = SCM_VELTS (obj)[i];
 	  if (SCM_INUMP (val))
 	    m[i] = SCM_INUM (val);
-	  else if (SCM_NIMP (val) && SCM_REALP (val))
+	  else if (SCM_BIGP (val))
-	    m[i] = SCM_REALPART (val);
+	    m[i] = scm_num2long (val, 0, 0);
 	  else
-	    {
+	    m[i] = SCM_REALPART (val);
-	      free (m);
-	      scm_wrong_type_arg (0, 0, val);
-	    }
 	}
       break;
 #ifdef SCM_FLOATS
 #ifdef SCM_SINGLES
     case scm_tc7_fvect:
       n = SCM_LENGTH (obj);
-      m = (double*) malloc (n * sizeof (double));
+      if (m == 0)
-      for (i = 0; i < n; ++i)
+	m = (float *) malloc (n * sizeof (float));
-	m[i] = ((float*) SCM_VELTS (obj))[i];
+      memcpy (m, (float *) SCM_VELTS (obj), n * sizeof (float));
       break;
 #endif
     case scm_tc7_dvect:
       n = SCM_LENGTH (obj);
-      m = (double*) malloc (n * sizeof (double));
+      if (m == 0)
+	m = (float*) malloc (n * sizeof (float));
       for (i = 0; i < n; ++i)
-	m[i] = ((double*) SCM_VELTS (obj))[i];
+	m[i] = ((double *) SCM_VELTS (obj))[i];
+      break;
+#endif
+    default:
+      scm_wrong_type_arg (0, 0, obj);
+    }
+  return m;
+}
+
+/* Convert a vector, weak vector or uniform vector into an array of
+   doubles.  If result array in arg 2 is NULL, malloc a new one. */
+double *
+gh_scm2doubles (SCM obj, double *m)
+{
+  int i, n;
+  SCM val;
+  if (!SCM_NIMP (obj))
+    scm_wrong_type_arg (0, 0, obj);
+  switch (SCM_TYP7 (obj))
+    {
+    case scm_tc7_vector:
+    case scm_tc7_wvect:
+      n = SCM_LENGTH (obj);
+      for (i = 0; i < n; ++i)
+	{
+	  val = SCM_VELTS (obj)[i];
+	  if (!SCM_INUMP (val)
+	      && !(SCM_NIMP (val) && (SCM_BIGP (val) || SCM_REALP (val))))
+	    scm_wrong_type_arg (0, 0, val);
+	}
+      if (m == 0)
+	m = (double *) malloc (n * sizeof (double));
+      for (i = 0; i < n; ++i)
+	{
+	  val = SCM_VELTS (obj)[i];
+	  if (SCM_INUMP (val))
+	    m[i] = SCM_INUM (val);
+	  else if (SCM_BIGP (val))
+	    m[i] = scm_num2long (val, 0, 0);
+	  else
+	    m[i] = SCM_REALPART (val);
+	}
+      break;
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+    case scm_tc7_fvect:
+      n = SCM_LENGTH (obj);
+      if (m == 0)
+	m = (double *) malloc (n * sizeof (double));
+      for (i = 0; i < n; ++i)
+	m[i] = ((float *) SCM_VELTS (obj))[i];
+      break;
+#endif
+    case scm_tc7_dvect:
+      n = SCM_LENGTH (obj);
+      if (m == 0)
+	m = (double*) malloc (n * sizeof (double));
+      memcpy (m, SCM_VELTS (obj), n * sizeof (double));
       break;
 #endif
     default:

libguile/numbers.c

@@ -3617,44 +3617,6 @@ scm_num2long(num, pos, s_caller)
 
 
 
-
-
-long
-num2long(num, pos, s_caller)
-     SCM num;
-     char *pos;
-     char *s_caller;
-{
-  long res;
-  if SCM_INUMP(num) {
-    res = SCM_INUM((long)num);
-    return res;
-  }
-  SCM_ASRTGO(SCM_NIMP(num), errout);
-#ifdef SCM_FLOATS
-  if SCM_REALP(num) {
-    double u = SCM_REALPART(num);
-    if (((SCM_MOST_NEGATIVE_FIXNUM * 4) <= u)
-	&& (u <= (SCM_MOST_POSITIVE_FIXNUM * 4 + 3))) {
-      res = u;
-      return res;
-    }
-  }
-#endif
-#ifdef SCM_BIGDIG
-  if SCM_BIGP(num) {
-    scm_sizet l = SCM_NUMDIGS(num);
-    SCM_ASRTGO(SCM_DIGSPERLONG >= l, errout);
-    res = 0;
-    for(;l--;) res = SCM_BIGUP(res) + SCM_BDIGITS(num)[l];
-    return res;
-  }
-#endif
- errout: scm_wta(num, pos, s_caller);
-  return SCM_UNSPECIFIED;
-}
-
-
 #ifdef LONGLONGS
 
 long_long

libguile/numbers.h

@@ -330,7 +330,6 @@ extern SCM scm_long2num SCM_P ((long sl));
 extern SCM scm_long_long2num SCM_P ((long_long sl));
 extern SCM scm_ulong2num SCM_P ((unsigned long sl));
 extern long scm_num2long SCM_P ((SCM num, char *pos, char *s_caller));
-extern long num2long SCM_P ((SCM num, char *pos, char *s_caller));
 extern long_long scm_num2long_long SCM_P ((SCM num, char *pos, char *s_caller));
 extern unsigned long scm_num2ulong SCM_P ((SCM num, char *pos, char *s_caller));
 extern void scm_init_numbers SCM_P ((void));

libguile/unif.c

@@ -1311,7 +1311,7 @@ scm_array_set_x (v, obj, args)
   case scm_tc7_uvect:
     SCM_VELTS(v)[pos] = scm_num2ulong(obj, (char *)SCM_ARG2, s_array_set_x); break;
   case scm_tc7_ivect:
-    SCM_VELTS(v)[pos] = num2long(obj, (char *)SCM_ARG2, s_array_set_x); break;
+    SCM_VELTS(v)[pos] = scm_num2long(obj, (char *)SCM_ARG2, s_array_set_x); break;
 # endif
       break;