mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00
Code Activity

* gh_data.c, gh.h (gh_ints2scm, gh_longs2ivect,

Browse source 
gh_ulongs2uvect): New procedures.  (Complements gh_doubles2scm and
gh_doubles2dvect.)
This commit is contained in:
Mikael Djurfeldt 1998-07-16 22:31:59 +00:00
parent a515d28771
commit b774ee1fdd
2 changed files with 49 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

3
libguile/gh.h
View file

@ -106,6 +106,9 @@ SCM gh_str2scm(char *s, int len);
SCM gh_str02scm(char *s); SCM gh_str02scm(char *s);
void gh_set_substr(char *src, SCM dst, int start, int len); void gh_set_substr(char *src, SCM dst, int start, int len);
SCM gh_symbol2scm(char *symbol_str); 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); SCM gh_doubles2scm(double *d, int n);
#ifdef SCM_FLOATS #ifdef SCM_FLOATS
SCM gh_doubles2dvect(double *d, int n); SCM gh_doubles2dvect(double *d, int n);

60
libguile/gh_data.c
View file

@ -122,35 +122,67 @@ gh_symbol2scm (char *symbol_str)
return SCM_CAR (scm_intern (symbol_str, strlen (symbol_str))); return SCM_CAR (scm_intern (symbol_str, strlen (symbol_str)));
} }
static SCM
makvect (char* m, int len, int type)
{
SCM ans;
SCM_NEWCELL (ans);
SCM_DEFER_INTS;
SCM_SETCHARS (ans, m);
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 SCM
gh_doubles2scm (double *d, int n) gh_doubles2scm (double *d, int n)
{ {
SCM ans;
SCM *m = (SCM*) scm_must_malloc (n * sizeof (SCM), "vector"); SCM *m = (SCM*) scm_must_malloc (n * sizeof (SCM), "vector");
int i; int i;
for (i = 0; i < n; ++i) for (i = 0; i < n; ++i)
m[i] = scm_makdbl (d[i], 0.0); m[i] = scm_makdbl (d[i], 0.0);
SCM_NEWCELL (ans); return makvect ((char *) m, n, scm_tc7_vector);
SCM_DEFER_INTS;
SCM_SETCHARS (ans, m);
SCM_SETLENGTH (ans, n, scm_tc7_vector);
SCM_ALLOW_INTS;
return ans;
} }
#ifdef SCM_FLOATS #ifdef SCM_FLOATS
SCM SCM
gh_doubles2dvect (double *d, int n) gh_doubles2dvect (double *d, int n)
{ {
SCM ans;
char *m = scm_must_malloc (n * sizeof (double), "vector"); char *m = scm_must_malloc (n * sizeof (double), "vector");
memcpy (m, d, n * sizeof (double)); memcpy (m, d, n * sizeof (double));
SCM_NEWCELL (ans); return makvect (m, n, scm_tc7_dvect);
SCM_DEFER_INTS;
SCM_SETCHARS (ans, m);
SCM_SETLENGTH (ans, n, scm_tc7_dvect);
SCM_ALLOW_INTS;
return ans;
} }
#endif #endif