mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-11 22:31:12 +02:00
* 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.
This commit is contained in:
Mikael Djurfeldt
parent
fe1a46f0e2
commit
3ffc7a360f
7 changed files with 293 additions and 74 deletions
12
NEWS
12
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):
|
||||
|
||||
|
|
|
|||
|
|
@ -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.)
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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
|
||||
array of doubles. */
|
||||
double*
|
||||
gh_scm2doubles (SCM obj)
|
||||
/* Convert a vector, weak vector, string, substring or uniform vector
|
||||
into an array of chars. If result array in arg 2 is NULL, malloc a
|
||||
new one. */
|
||||
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))
|
||||
m[i] = SCM_REALPART (val);
|
||||
else if (SCM_BIGP (val))
|
||||
m[i] = scm_num2long (val, 0, 0);
|
||||
else
|
||||
{
|
||||
free (m);
|
||||
scm_wrong_type_arg (0, 0, val);
|
||||
}
|
||||
m[i] = SCM_REALPART (val);
|
||||
}
|
||||
break;
|
||||
#ifdef SCM_FLOATS
|
||||
#ifdef SCM_SINGLES
|
||||
case scm_tc7_fvect:
|
||||
n = SCM_LENGTH (obj);
|
||||
m = (double*) malloc (n * sizeof (double));
|
||||
for (i = 0; i < n; ++i)
|
||||
m[i] = ((float*) SCM_VELTS (obj))[i];
|
||||
if (m == 0)
|
||||
m = (float *) malloc (n * sizeof (float));
|
||||
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:
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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));
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue