mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
* __scm.h eq.c, eval.c, gc.c, hc.h, gh_data, hash.c, numbers.c,
numbers.h, objects.c, ramap.c, random.c, unif.c, unif.h: Extensive rewrite of handling of real and complex numbers. (SCM_FLOATS, SCM_SINGLES): These #ifdef conditionals have been removed along with the support for floats. (Float vectors are still supported.)
This commit is contained in:
Mikael Djurfeldt
parent
bc86da5de2
commit
950cc72b8f
8 changed files with 116 additions and 145 deletions
|
|
@ -48,7 +48,7 @@
|
|||
* These may be defined or undefined.
|
||||
*/
|
||||
|
||||
/* #define GUILE_DEBUG_FREELIST */
|
||||
#define GUILE_DEBUG_FREELIST
|
||||
|
||||
/* If the compile FLAG `SCM_CAUTIOUS' is #defined then the number of
|
||||
* arguments is always checked for application of closures. If the
|
||||
|
|
@ -69,7 +69,6 @@
|
|||
|
||||
/* All the number support there is.
|
||||
*/
|
||||
#define SCM_FLOATS
|
||||
#define BIGNUMS
|
||||
|
||||
/* GC should relinquish empty cons-pair arenas.
|
||||
|
|
|
|||
153
libguile/eq.c
153
libguile/eq.c
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
|
||||
/* Copyright (C) 1995,1996,1997,1998, 2000 Free Software Foundation, Inc.
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
|
|
@ -76,21 +76,39 @@ SCM_DEFINE1 (scm_eqv_p, "eqv?", scm_tc7_rpsubr,
|
|||
"immediate integers, characters, and inexact numbers.\n")
|
||||
#define FUNC_NAME s_scm_eqv_p
|
||||
{
|
||||
if (x==y) return SCM_BOOL_T;
|
||||
if (SCM_IMP(x)) return SCM_BOOL_F;
|
||||
if (SCM_IMP(y)) return SCM_BOOL_F;
|
||||
/* this ensures that types and scm_length are the same. */
|
||||
if (SCM_CAR(x) != SCM_CAR(y)) return SCM_BOOL_F;
|
||||
if (SCM_NUMP(x)) {
|
||||
# ifdef SCM_BIGDIG
|
||||
if (SCM_BIGP(x)) return SCM_BOOL(0==scm_bigcomp(x, y));
|
||||
# endif
|
||||
#ifdef SCM_FLOATS
|
||||
if (SCM_REALPART(x) != SCM_REALPART(y)) return SCM_BOOL_F;
|
||||
if (SCM_CPLXP(x) && (SCM_IMAG(x) != SCM_IMAG(y))) return SCM_BOOL_F;
|
||||
#endif
|
||||
if (x == y)
|
||||
return SCM_BOOL_T;
|
||||
}
|
||||
if (SCM_IMP (x))
|
||||
return SCM_BOOL_F;
|
||||
if (SCM_IMP (y))
|
||||
return SCM_BOOL_F;
|
||||
/* this ensures that types and scm_length are the same. */
|
||||
if (SCM_CAR (x) != SCM_CAR (y))
|
||||
{
|
||||
/* treat mixes of real and complex types specially */
|
||||
if (SCM_SLOPPY_INEXACTP (x))
|
||||
{
|
||||
if (SCM_SLOPPY_REALP (x))
|
||||
return SCM_BOOL (SCM_SLOPPY_COMPLEXP (y)
|
||||
&& SCM_REAL_VALUE (x) == SCM_COMPLEX_REAL (y)
|
||||
&& 0.0 == SCM_COMPLEX_IMAG (y));
|
||||
else
|
||||
return SCM_BOOL (SCM_SLOPPY_REALP (y)
|
||||
&& SCM_COMPLEX_REAL (x) == SCM_REAL_VALUE (y)
|
||||
&& SCM_COMPLEX_IMAG (x) == 0.0);
|
||||
}
|
||||
return SCM_BOOL_F;
|
||||
}
|
||||
if (SCM_NUMP (x))
|
||||
{
|
||||
# ifdef SCM_BIGDIG
|
||||
if (SCM_BIGP (x))
|
||||
return SCM_BOOL (0 == scm_bigcomp (x, y));
|
||||
# endif
|
||||
if (SCM_REALPART (x) != SCM_REALPART(y)) return SCM_BOOL_F;
|
||||
if (SCM_CPLXP(x) && (SCM_IMAG(x) != SCM_IMAG(y))) return SCM_BOOL_F;
|
||||
return SCM_BOOL_T;
|
||||
}
|
||||
return SCM_BOOL_F;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
|
@ -107,48 +125,71 @@ SCM_DEFINE1 (scm_equal_p, "equal?", scm_tc7_rpsubr,
|
|||
#define FUNC_NAME s_scm_equal_p
|
||||
{
|
||||
SCM_CHECK_STACK;
|
||||
tailrecurse: SCM_TICK;
|
||||
if (x==y) return SCM_BOOL_T;
|
||||
if (SCM_IMP(x)) return SCM_BOOL_F;
|
||||
if (SCM_IMP(y)) return SCM_BOOL_F;
|
||||
if (SCM_CONSP(x) && SCM_CONSP(y)) {
|
||||
if SCM_FALSEP(scm_equal_p(SCM_CAR(x), SCM_CAR(y))) return SCM_BOOL_F;
|
||||
x = SCM_CDR(x);
|
||||
y = SCM_CDR(y);
|
||||
goto tailrecurse;
|
||||
}
|
||||
if (SCM_TYP7S (x) == scm_tc7_string
|
||||
&& SCM_TYP7S (y) == scm_tc7_string)
|
||||
return scm_string_equal_p (x, y);
|
||||
/* This ensures that types and scm_length are the same. */
|
||||
if (SCM_CAR(x) != SCM_CAR(y)) return SCM_BOOL_F;
|
||||
switch (SCM_TYP7(x)) {
|
||||
default: return SCM_BOOL_F;
|
||||
case scm_tc7_vector:
|
||||
case scm_tc7_wvect:
|
||||
return scm_vector_equal_p(x, y);
|
||||
case scm_tc7_smob: {
|
||||
int i = SCM_SMOBNUM(x);
|
||||
if (!(i < scm_numsmob)) return SCM_BOOL_F;
|
||||
if (scm_smobs[i].equalp)
|
||||
return (scm_smobs[i].equalp)(x, y);
|
||||
else
|
||||
return SCM_BOOL_F;
|
||||
}
|
||||
#ifdef HAVE_ARRAYS
|
||||
case scm_tc7_bvect: case scm_tc7_uvect: case scm_tc7_ivect:
|
||||
case scm_tc7_fvect: case scm_tc7_cvect: case scm_tc7_dvect:
|
||||
case scm_tc7_svect:
|
||||
#ifdef HAVE_LONG_LONGS
|
||||
case scm_tc7_llvect:
|
||||
#endif
|
||||
case scm_tc7_byvect:
|
||||
if ( scm_tc16_array
|
||||
&& scm_smobs[0x0ff & (scm_tc16_array >> 8)].equalp)
|
||||
return scm_array_equal_p(x, y);
|
||||
#endif
|
||||
}
|
||||
tailrecurse:
|
||||
SCM_TICK;
|
||||
if (x == y)
|
||||
return SCM_BOOL_T;
|
||||
if (SCM_IMP (x))
|
||||
return SCM_BOOL_F;
|
||||
if (SCM_IMP (y))
|
||||
return SCM_BOOL_F;
|
||||
if (SCM_SLOPPY_CONSP (x) && SCM_SLOPPY_CONSP (y))
|
||||
{
|
||||
if (SCM_FALSEP (scm_equal_p (SCM_CAR (x), SCM_CAR (y))))
|
||||
return SCM_BOOL_F;
|
||||
x = SCM_CDR(x);
|
||||
y = SCM_CDR(y);
|
||||
goto tailrecurse;
|
||||
}
|
||||
if (SCM_TYP7S (x) == scm_tc7_string && SCM_TYP7S (y) == scm_tc7_string)
|
||||
return scm_string_equal_p (x, y);
|
||||
/* This ensures that types and scm_length are the same. */
|
||||
if (SCM_CAR (x) != SCM_CAR (y))
|
||||
{
|
||||
/* treat mixes of real and complex types specially */
|
||||
if (SCM_SLOPPY_INEXACTP (x))
|
||||
{
|
||||
if (SCM_SLOPPY_REALP (x))
|
||||
return SCM_BOOL (SCM_SLOPPY_COMPLEXP (y)
|
||||
&& SCM_REAL_VALUE (x) == SCM_COMPLEX_REAL (y)
|
||||
&& 0.0 == SCM_COMPLEX_IMAG (y));
|
||||
else
|
||||
return SCM_BOOL (SCM_SLOPPY_REALP (y)
|
||||
&& SCM_COMPLEX_REAL (x) == SCM_REAL_VALUE (y)
|
||||
&& SCM_COMPLEX_IMAG (x) == 0.0);
|
||||
}
|
||||
return SCM_BOOL_F;
|
||||
}
|
||||
switch (SCM_TYP7 (x))
|
||||
{
|
||||
default:
|
||||
return SCM_BOOL_F;
|
||||
case scm_tc7_vector:
|
||||
case scm_tc7_wvect:
|
||||
return scm_vector_equal_p (x, y);
|
||||
case scm_tc7_smob:
|
||||
{
|
||||
int i = SCM_SMOBNUM (x);
|
||||
if (!(i < scm_numsmob))
|
||||
return SCM_BOOL_F;
|
||||
if (scm_smobs[i].equalp)
|
||||
return (scm_smobs[i].equalp) (x, y);
|
||||
else
|
||||
return SCM_BOOL_F;
|
||||
}
|
||||
#ifdef HAVE_ARRAYS
|
||||
case scm_tc7_bvect: case scm_tc7_uvect: case scm_tc7_ivect:
|
||||
case scm_tc7_fvect: case scm_tc7_cvect: case scm_tc7_dvect:
|
||||
case scm_tc7_svect:
|
||||
#ifdef HAVE_LONG_LONGS
|
||||
case scm_tc7_llvect:
|
||||
#endif
|
||||
case scm_tc7_byvect:
|
||||
if (scm_tc16_array && scm_smobs[0x0ff & (scm_tc16_array >> 8)].equalp)
|
||||
return scm_array_equal_p (x, y);
|
||||
#endif
|
||||
}
|
||||
return SCM_BOOL_F;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
|
|||
|
|
@ -1786,11 +1786,7 @@ scm_deval_args (SCM l, SCM env, SCM proc, SCM *lloc)
|
|||
*/
|
||||
|
||||
#ifndef DEVAL
|
||||
#ifdef SCM_FLOATS
|
||||
#define CHECK_EQVISH(A,B) (((A) == (B)) || (SCM_NFALSEP (scm_eqv_p ((A), (B)))))
|
||||
#else
|
||||
#define CHECK_EQVISH(A,B) ((A) == (B))
|
||||
#endif
|
||||
#endif /* DEVAL */
|
||||
|
||||
#define BUILTIN_RPASUBR /* Handle rpsubrs and asubrs without calling apply */
|
||||
|
|
@ -2736,7 +2732,6 @@ evapply:
|
|||
case scm_tc7_subr_1o:
|
||||
RETURN (SCM_SUBRF (proc) (t.arg1));
|
||||
case scm_tc7_cxr:
|
||||
#ifdef SCM_FLOATS
|
||||
if (SCM_SUBRF (proc))
|
||||
{
|
||||
if (SCM_INUMP (t.arg1))
|
||||
|
|
@ -2759,7 +2754,6 @@ evapply:
|
|||
SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), t.arg1,
|
||||
SCM_ARG1, SCM_CHARS (SCM_SNAME (proc)));
|
||||
}
|
||||
#endif
|
||||
proc = (SCM) SCM_SNAME (proc);
|
||||
{
|
||||
char *chrs = SCM_CHARS (proc) + SCM_LENGTH (proc) - 1;
|
||||
|
|
@ -3332,7 +3326,6 @@ tail:
|
|||
RETURN (SCM_SUBRF (proc) (arg1))
|
||||
case scm_tc7_cxr:
|
||||
SCM_ASRTGO (SCM_NULLP (args), wrongnumargs);
|
||||
#ifdef SCM_FLOATS
|
||||
if (SCM_SUBRF (proc))
|
||||
{
|
||||
if (SCM_INUMP (arg1))
|
||||
|
|
@ -3352,7 +3345,6 @@ tail:
|
|||
SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
|
||||
SCM_ARG1, SCM_CHARS (SCM_SNAME (proc)));
|
||||
}
|
||||
#endif
|
||||
proc = (SCM) SCM_SNAME (proc);
|
||||
{
|
||||
char *chrs = SCM_CHARS (proc) + SCM_LENGTH (proc) - 1;
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
|
||||
/* Copyright (C) 1995,1996,1997, 2000 Free Software Foundation, Inc.
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
|
|
@ -94,13 +94,12 @@ scm_hasher(SCM obj, unsigned long n, scm_sizet d)
|
|||
return 263 % n;
|
||||
case scm_tc7_smob:
|
||||
switch SCM_TYP16(obj) {
|
||||
case scm_tcs_bignums:
|
||||
case scm_tc16_big:
|
||||
return SCM_INUM(scm_modulo(obj, SCM_MAKINUM(n)));
|
||||
default:
|
||||
return 263 % n;
|
||||
#ifdef SCM_FLOATS
|
||||
case scm_tc16_flo:
|
||||
if SCM_REALP(obj) {
|
||||
case scm_tc16_real:
|
||||
{
|
||||
double r = SCM_REALPART(obj);
|
||||
if (floor(r)==r) {
|
||||
obj = scm_inexact_to_exact (obj);
|
||||
|
|
@ -108,8 +107,8 @@ scm_hasher(SCM obj, unsigned long n, scm_sizet d)
|
|||
return SCM_INUM(scm_modulo(obj, SCM_MAKINUM(n)));
|
||||
}
|
||||
}
|
||||
case scm_tc16_complex:
|
||||
obj = scm_number_to_string(obj, SCM_MAKINUM(10));
|
||||
#endif
|
||||
}
|
||||
case scm_tcs_symbols:
|
||||
case scm_tc7_string:
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright (C) 1995, 1996, 1999 Free Software Foundation, Inc.
|
||||
/* Copyright (C) 1995, 1996, 1999, 2000 Free Software Foundation, Inc.
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
|
|
@ -158,14 +158,7 @@ scm_class_of (SCM x)
|
|||
case scm_tc7_smob:
|
||||
{
|
||||
long type = SCM_TYP16 (x);
|
||||
if (type == scm_tc16_flo)
|
||||
{
|
||||
if (SCM_UNPACK_CAR (x) & SCM_IMAG_PART)
|
||||
return scm_class_complex;
|
||||
else
|
||||
return scm_class_real;
|
||||
}
|
||||
else if (type != scm_tc16_port_with_ps)
|
||||
if (type != scm_tc16_port_with_ps)
|
||||
return scm_smob_class[SCM_TC2SMOBNUM (type)];
|
||||
x = SCM_PORT_WITH_PS_PORT (x);
|
||||
/* fall through to ports */
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright (C) 1996, 1998 Free Software Foundation, Inc.
|
||||
/* Copyright (C) 1996, 1998, 2000 Free Software Foundation, Inc.
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
|
|
@ -579,8 +579,6 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore)
|
|||
break;
|
||||
}
|
||||
#endif
|
||||
#ifdef SCM_FLOATS
|
||||
#ifdef SCM_SINGLES
|
||||
case scm_tc7_fvect:
|
||||
{ /* scope */
|
||||
float f, *ve = (float *) SCM_VELTS (ra);
|
||||
|
|
@ -590,7 +588,6 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore)
|
|||
ve[i] = f;
|
||||
break;
|
||||
}
|
||||
#endif /* SCM_SINGLES */
|
||||
case scm_tc7_dvect:
|
||||
{ /* scope */
|
||||
double f, *ve = (double *) SCM_VELTS (ra);
|
||||
|
|
@ -614,7 +611,6 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore)
|
|||
}
|
||||
break;
|
||||
}
|
||||
#endif /* SCM_FLOATS */
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
|
@ -710,8 +706,6 @@ racp (SCM src, SCM dst)
|
|||
d[i_d] = s[i_s];
|
||||
break;
|
||||
}
|
||||
#ifdef SCM_FLOATS
|
||||
#ifdef SCM_SINGLES
|
||||
case scm_tc7_fvect:
|
||||
{
|
||||
float *d = (float *) SCM_VELTS (dst);
|
||||
|
|
@ -737,7 +731,6 @@ racp (SCM src, SCM dst)
|
|||
}
|
||||
break;
|
||||
}
|
||||
#endif /* SCM_SINGLES */
|
||||
case scm_tc7_dvect:
|
||||
{
|
||||
double *d = (double *) SCM_VELTS (dst);
|
||||
|
|
@ -804,7 +797,6 @@ racp (SCM src, SCM dst)
|
|||
break;
|
||||
}
|
||||
}
|
||||
#endif /* SCM_FLOATS */
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
|
@ -860,15 +852,12 @@ scm_ra_eqp (SCM ra0, SCM ras)
|
|||
if (SCM_VELTS (ra1)[i1] != SCM_VELTS (ra2)[i2])
|
||||
SCM_BITVEC_CLR (ra0, i0);
|
||||
break;
|
||||
#ifdef SCM_FLOATS
|
||||
#ifdef SCM_SINGLES
|
||||
case scm_tc7_fvect:
|
||||
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
|
||||
if (SCM_BITVEC_REF (ra0, i0))
|
||||
if (((float *) SCM_VELTS (ra1))[i1] != ((float *) SCM_VELTS (ra2))[i2])
|
||||
SCM_BITVEC_CLR (ra0, i0);
|
||||
break;
|
||||
#endif /*SCM_SINGLES*/
|
||||
case scm_tc7_dvect:
|
||||
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
|
||||
if (SCM_BITVEC_REF (ra0, i0))
|
||||
|
|
@ -882,7 +871,6 @@ scm_ra_eqp (SCM ra0, SCM ras)
|
|||
((double *) SCM_VELTS (ra1))[2 * i1 + 1] != ((double *) SCM_VELTS (ra2))[2 * i2 + 1])
|
||||
SCM_BITVEC_CLR (ra0, i0);
|
||||
break;
|
||||
#endif /*SCM_FLOATS*/
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
|
@ -924,8 +912,6 @@ ra_compare (SCM ra0,SCM ra1,SCM ra2,int opt)
|
|||
SCM_BITVEC_CLR (ra0, i0);
|
||||
}
|
||||
break;
|
||||
#ifdef SCM_FLOATS
|
||||
#ifdef SCM_SINGLES
|
||||
case scm_tc7_fvect:
|
||||
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
|
||||
if (SCM_BITVEC_REF(ra0, i0))
|
||||
|
|
@ -934,7 +920,6 @@ ra_compare (SCM ra0,SCM ra1,SCM ra2,int opt)
|
|||
((float *) SCM_VELTS (ra1))[i1] >= ((float *) SCM_VELTS (ra2))[i2])
|
||||
SCM_BITVEC_CLR (ra0, i0);
|
||||
break;
|
||||
#endif /*SCM_SINGLES*/
|
||||
case scm_tc7_dvect:
|
||||
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
|
||||
if (SCM_BITVEC_REF (ra0, i0))
|
||||
|
|
@ -943,7 +928,6 @@ ra_compare (SCM ra0,SCM ra1,SCM ra2,int opt)
|
|||
((double *) SCM_VELTS (ra1))[i1] >= ((double *) SCM_VELTS (ra2))[i2])
|
||||
SCM_BITVEC_CLR (ra0, i0);
|
||||
break;
|
||||
#endif /*SCM_FLOATS*/
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
|
@ -1004,16 +988,12 @@ scm_ra_sum (SCM ra0, SCM ras)
|
|||
case scm_tc7_uvect:
|
||||
case scm_tc7_ivect:
|
||||
BINARY_ELTS_CODE( +=, long);
|
||||
#ifdef SCM_FLOATS
|
||||
#ifdef SCM_SINGLES
|
||||
case scm_tc7_fvect:
|
||||
BINARY_ELTS_CODE( +=, float);
|
||||
#endif /* SCM_SINGLES */
|
||||
case scm_tc7_dvect:
|
||||
BINARY_ELTS_CODE( +=, double);
|
||||
case scm_tc7_cvect:
|
||||
BINARY_PAIR_ELTS_CODE( +=, double);
|
||||
#endif /* SCM_FLOATS */
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
|
|
@ -1041,16 +1021,12 @@ scm_ra_difference (SCM ra0, SCM ras)
|
|||
SCM_MAKINUM (i0));
|
||||
break;
|
||||
}
|
||||
#ifdef SCM_FLOATS
|
||||
#ifdef SCM_SINGLES
|
||||
case scm_tc7_fvect:
|
||||
UNARY_ELTS_CODE( = -, float);
|
||||
#endif /* SCM_SINGLES */
|
||||
case scm_tc7_dvect:
|
||||
UNARY_ELTS_CODE( = -, double);
|
||||
case scm_tc7_cvect:
|
||||
UNARY_PAIR_ELTS_CODE( = -, double);
|
||||
#endif /* SCM_FLOATS */
|
||||
}
|
||||
}
|
||||
else
|
||||
|
|
@ -1068,16 +1044,12 @@ scm_ra_difference (SCM ra0, SCM ras)
|
|||
scm_array_set_x (ra0, scm_difference (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)), SCM_MAKINUM (i0));
|
||||
break;
|
||||
}
|
||||
#ifdef SCM_FLOATS
|
||||
#ifdef SCM_SINGLES
|
||||
case scm_tc7_fvect:
|
||||
BINARY_ELTS_CODE( -=, float);
|
||||
#endif /* SCM_SINGLES */
|
||||
case scm_tc7_dvect:
|
||||
BINARY_ELTS_CODE( -=, double);
|
||||
case scm_tc7_cvect:
|
||||
BINARY_PAIR_ELTS_CODE( -=, double);
|
||||
#endif /* SCM_FLOATS */
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
|
|
@ -1111,11 +1083,8 @@ scm_ra_product (SCM ra0, SCM ras)
|
|||
case scm_tc7_uvect:
|
||||
case scm_tc7_ivect:
|
||||
BINARY_ELTS_CODE( *=, long);
|
||||
#ifdef SCM_FLOATS
|
||||
#ifdef SCM_SINGLES
|
||||
case scm_tc7_fvect:
|
||||
BINARY_ELTS_CODE( *=, float);
|
||||
#endif /* SCM_SINGLES */
|
||||
case scm_tc7_dvect:
|
||||
BINARY_ELTS_CODE( *=, double);
|
||||
case scm_tc7_cvect:
|
||||
|
|
@ -1133,7 +1102,6 @@ scm_ra_product (SCM ra0, SCM ras)
|
|||
);
|
||||
break;
|
||||
}
|
||||
#endif /* SCM_FLOATS */
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
|
|
@ -1158,11 +1126,8 @@ scm_ra_divide (SCM ra0, SCM ras)
|
|||
scm_array_set_x (ra0, scm_divide (RVREF (ra0, i0, e0), SCM_UNDEFINED), SCM_MAKINUM (i0));
|
||||
break;
|
||||
}
|
||||
#ifdef SCM_FLOATS
|
||||
#ifdef SCM_SINGLES
|
||||
case scm_tc7_fvect:
|
||||
UNARY_ELTS_CODE( = 1.0 / , float);
|
||||
#endif /* SCM_SINGLES */
|
||||
case scm_tc7_dvect:
|
||||
UNARY_ELTS_CODE( = 1.0 / , double);
|
||||
case scm_tc7_cvect:
|
||||
|
|
@ -1177,7 +1142,6 @@ scm_ra_divide (SCM ra0, SCM ras)
|
|||
}
|
||||
break;
|
||||
}
|
||||
#endif /* SCM_FLOATS */
|
||||
}
|
||||
}
|
||||
else
|
||||
|
|
@ -1195,11 +1159,8 @@ scm_ra_divide (SCM ra0, SCM ras)
|
|||
scm_array_set_x (ra0, scm_divide (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)), SCM_MAKINUM (i0));
|
||||
break;
|
||||
}
|
||||
#ifdef SCM_FLOATS
|
||||
#ifdef SCM_SINGLES
|
||||
case scm_tc7_fvect:
|
||||
BINARY_ELTS_CODE( /=, float);
|
||||
#endif /* SCM_SINGLES */
|
||||
case scm_tc7_dvect:
|
||||
BINARY_ELTS_CODE( /=, double);
|
||||
case scm_tc7_cvect:
|
||||
|
|
@ -1218,7 +1179,6 @@ scm_ra_divide (SCM ra0, SCM ras)
|
|||
)
|
||||
break;
|
||||
}
|
||||
#endif /* SCM_FLOATS */
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
|
|
@ -1289,8 +1249,6 @@ ramap_cxr (SCM ra0,SCM proc,SCM ras)
|
|||
for (; n-- > 0; i0 += inc0, i1 += inc1)
|
||||
scm_array_set_x (ra0, scm_apply (proc, RVREF (ra1, i1, e1), scm_listofnull), SCM_MAKINUM (i0));
|
||||
break;
|
||||
#ifdef SCM_FLOATS
|
||||
#ifdef SCM_SINGLES
|
||||
case scm_tc7_fvect:
|
||||
{
|
||||
float *dst = (float *) SCM_VELTS (ra0);
|
||||
|
|
@ -1310,7 +1268,6 @@ ramap_cxr (SCM ra0,SCM proc,SCM ras)
|
|||
}
|
||||
break;
|
||||
}
|
||||
#endif /* SCM_SINGLES */
|
||||
case scm_tc7_dvect:
|
||||
{
|
||||
double *dst = (double *) SCM_VELTS (ra0);
|
||||
|
|
@ -1330,7 +1287,6 @@ ramap_cxr (SCM ra0,SCM proc,SCM ras)
|
|||
}
|
||||
break;
|
||||
}
|
||||
#endif /* SCM_FLOATS */
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
|
@ -1368,22 +1324,19 @@ ramap_rp (SCM ra0,SCM proc,SCM ras)
|
|||
SCM_BITVEC_CLR (ra0, i0);
|
||||
}
|
||||
break;
|
||||
#ifdef SCM_FLOATS
|
||||
#ifdef SCM_SINGLES
|
||||
case scm_tc7_fvect:
|
||||
{
|
||||
SCM a1 = scm_makflo (1.0), a2 = scm_makflo (1.0);
|
||||
SCM a1 = scm_make_real (1.0), a2 = scm_make_real (1.0);
|
||||
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
|
||||
if (SCM_BITVEC_REF (ra0, i0))
|
||||
{
|
||||
SCM_FLO (a1) = ((float *) SCM_VELTS (ra1))[i1];
|
||||
SCM_FLO (a2) = ((float *) SCM_VELTS (ra2))[i2];
|
||||
SCM_REAL_VALUE (a1) = ((float *) SCM_VELTS (ra1))[i1];
|
||||
SCM_REAL_VALUE (a2) = ((float *) SCM_VELTS (ra2))[i2];
|
||||
if (SCM_FALSEP (SCM_SUBRF (proc) (a1, a2)))
|
||||
SCM_BITVEC_CLR (ra0, i0);
|
||||
}
|
||||
break;
|
||||
}
|
||||
#endif /*SCM_SINGLES*/
|
||||
case scm_tc7_dvect:
|
||||
{
|
||||
SCM a1 = scm_makdbl (1.0 / 3.0, 0.0), a2 = scm_makdbl (1.0 / 3.0, 0.0);
|
||||
|
|
@ -1403,16 +1356,15 @@ ramap_rp (SCM ra0,SCM proc,SCM ras)
|
|||
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
|
||||
if (SCM_BITVEC_REF (ra0, i0))
|
||||
{
|
||||
SCM_REAL (a1) = ((double *) SCM_VELTS (ra1))[2 * i1];
|
||||
SCM_IMAG (a1) = ((double *) SCM_VELTS (ra1))[2 * i1 + 1];
|
||||
SCM_REAL (a2) = ((double *) SCM_VELTS (ra2))[2 * i2];
|
||||
SCM_IMAG (a2) = ((double *) SCM_VELTS (ra2))[2 * i2 + 1];
|
||||
SCM_COMPLEX_REAL (a1) = ((double *) SCM_VELTS (ra1))[2 * i1];
|
||||
SCM_COMPLEX_IMAG (a1) = ((double *) SCM_VELTS (ra1))[2 * i1 + 1];
|
||||
SCM_COMPLEX_REAL (a2) = ((double *) SCM_VELTS (ra2))[2 * i2];
|
||||
SCM_COMPLEX_IMAG (a2) = ((double *) SCM_VELTS (ra2))[2 * i2 + 1];
|
||||
if (SCM_FALSEP (SCM_SUBRF (proc) (a1, a2)))
|
||||
SCM_BITVEC_CLR (ra0, i0);
|
||||
}
|
||||
break;
|
||||
}
|
||||
#endif /*SCM_FLOATS*/
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
|
@ -1857,8 +1809,6 @@ raeql_1 (SCM ra0,SCM as_equal,SCM ra1)
|
|||
return 1;
|
||||
}
|
||||
#endif
|
||||
#ifdef SCM_FLOATS
|
||||
#ifdef SCM_SINGLES
|
||||
case scm_tc7_fvect:
|
||||
{
|
||||
float *v0 = (float *) SCM_VELTS (ra0) + i0;
|
||||
|
|
@ -1868,7 +1818,6 @@ raeql_1 (SCM ra0,SCM as_equal,SCM ra1)
|
|||
return 0;
|
||||
return 1;
|
||||
}
|
||||
#endif /* SCM_SINGLES */
|
||||
case scm_tc7_dvect:
|
||||
{
|
||||
double *v0 = (double *) SCM_VELTS (ra0) + i0;
|
||||
|
|
@ -1891,7 +1840,6 @@ raeql_1 (SCM ra0,SCM as_equal,SCM ra1)
|
|||
}
|
||||
return 1;
|
||||
}
|
||||
#endif /* SCM_FLOATS */
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright (C) 1999 Free Software Foundation, Inc.
|
||||
/* Copyright (C) 1999, 2000 Free Software Foundation, Inc.
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2, or (at your option)
|
||||
|
|
@ -380,7 +380,7 @@ SCM_DEFINE (scm_random, "random", 1, 1, 0,
|
|||
if (SCM_REALP (n))
|
||||
return scm_makdbl (SCM_REALPART (n) * scm_c_uniform01 (SCM_RSTATE (state)),
|
||||
0.0);
|
||||
SCM_VALIDATE_SMOB (1,n,bigpos);
|
||||
SCM_VALIDATE_SMOB (1, n, big);
|
||||
return scm_c_random_bignum (SCM_RSTATE (state), n);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
#ifndef UNIFH
|
||||
#define UNIFH
|
||||
/* Copyright (C) 1995,1996,1997,1999 Free Software Foundation, Inc.
|
||||
/* Copyright (C) 1995,1996,1997,1999, 2000 Free Software Foundation, Inc.
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
|
|
@ -96,7 +96,6 @@ extern long scm_tc16_array;
|
|||
|
||||
|
||||
extern scm_sizet scm_uniform_element_size (SCM obj);
|
||||
extern SCM scm_makflo (float x);
|
||||
extern SCM scm_make_uve (long k, SCM prot);
|
||||
extern SCM scm_uniform_vector_length (SCM v);
|
||||
extern SCM scm_array_p (SCM v, SCM prot);
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue