diff options
author | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1998-07-16 22:31:59 +0000 |
---|---|---|
committer | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1998-07-16 22:31:59 +0000 |
commit | b774ee1fdd672f5a759534b1a7a712b254c9ca56 (patch) | |
tree | b31362cd88d1f6a385741192e92782d95e368d57 | |
parent | a515d28771ec68ca5dfb324d8e5c857ddfec6e15 (diff) | |
download | guile-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.h | 3 | ||||
-rw-r--r-- | libguile/gh_data.c | 60 |
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 |