summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMikael Djurfeldt <djurfeldt@nada.kth.se>1998-07-16 22:31:59 +0000
committerMikael Djurfeldt <djurfeldt@nada.kth.se>1998-07-16 22:31:59 +0000
commitb774ee1fdd672f5a759534b1a7a712b254c9ca56 (patch)
treeb31362cd88d1f6a385741192e92782d95e368d57
parenta515d28771ec68ca5dfb324d8e5c857ddfec6e15 (diff)
downloadguile-b774ee1fdd672f5a759534b1a7a712b254c9ca56.tar.gz
* gh_data.c, gh.h (gh_ints2scm, gh_longs2ivect,
gh_ulongs2uvect): New procedures. (Complements gh_doubles2scm and gh_doubles2dvect.)
-rw-r--r--libguile/gh.h3
-rw-r--r--libguile/gh_data.c60
2 files changed, 49 insertions, 14 deletions
diff --git a/libguile/gh.h b/libguile/gh.h
index 8cd82d172..1b6b1e8a9 100644
--- a/libguile/gh.h
+++ b/libguile/gh.h
@@ -106,6 +106,9 @@ SCM gh_str2scm(char *s, int len);
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_longs2ivect(long *d, int n);
+SCM gh_ulongs2uvect(unsigned long *d, int n);
SCM gh_doubles2scm(double *d, int n);
#ifdef SCM_FLOATS
SCM gh_doubles2dvect(double *d, int n);
diff --git a/libguile/gh_data.c b/libguile/gh_data.c
index 92a70d3ca..13388bd2c 100644
--- a/libguile/gh_data.c
+++ b/libguile/gh_data.c
@@ -122,35 +122,67 @@ gh_symbol2scm (char *symbol_str)
return SCM_CAR (scm_intern (symbol_str, strlen (symbol_str)));
}
-SCM
-gh_doubles2scm (double *d, int n)
+static SCM
+makvect (char* m, int len, int type)
{
SCM ans;
- 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);
SCM_NEWCELL (ans);
SCM_DEFER_INTS;
SCM_SETCHARS (ans, m);
- SCM_SETLENGTH (ans, n, scm_tc7_vector);
+ SCM_SETLENGTH (ans, len, type);
SCM_ALLOW_INTS;
return ans;
}
+SCM
+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]);
+ return makvect ((char *) m, n, scm_tc7_vector);
+}
+
+SCM
+gh_longs2ivect (long *d, int n)
+{
+ char *m = scm_must_malloc (n * sizeof (long), "vector");
+ memcpy (m, d, n * sizeof (long));
+ return makvect (m, n, scm_tc7_ivect);
+}
+
+SCM
+gh_ulongs2uvect (unsigned long *d, int n)
+{
+ char *m = scm_must_malloc (n * sizeof (unsigned long), "vector");
+ memcpy (m, d, n * sizeof (unsigned long));
+ 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
SCM
gh_doubles2dvect (double *d, int n)
{
- SCM ans;
char *m = scm_must_malloc (n * sizeof (double), "vector");
memcpy (m, d, n * sizeof (double));
- SCM_NEWCELL (ans);
- SCM_DEFER_INTS;
- SCM_SETCHARS (ans, m);
- SCM_SETLENGTH (ans, n, scm_tc7_dvect);
- SCM_ALLOW_INTS;
- return ans;
+ return makvect (m, n, scm_tc7_dvect);
}
#endif