summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMikael Djurfeldt <djurfeldt@nada.kth.se>2000-03-14 06:43:03 +0000
committerMikael Djurfeldt <djurfeldt@nada.kth.se>2000-03-14 06:43:03 +0000
commit950cc72b8f2e9636de633d01975cb1c41e4ab1af (patch)
treeacae7c4a15ca27020559d3d31209913494548f73
parentbc86da5de2a7c9ceee81c334c32d24298ab31d9b (diff)
downloadguile-950cc72b8f2e9636de633d01975cb1c41e4ab1af.tar.gz
* __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.)
-rw-r--r--libguile/__scm.h3
-rw-r--r--libguile/eq.c141
-rw-r--r--libguile/eval.c8
-rw-r--r--libguile/hash.c11
-rw-r--r--libguile/objects.c11
-rw-r--r--libguile/ramap.c68
-rw-r--r--libguile/random.c4
-rw-r--r--libguile/unif.h3
8 files changed, 110 insertions, 139 deletions
diff --git a/libguile/__scm.h b/libguile/__scm.h
index 07a1e994e..aab659c25 100644
--- a/libguile/__scm.h
+++ b/libguile/__scm.h
@@ -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.
diff --git a/libguile/eq.c b/libguile/eq.c
index 885f297a7..8c151b286 100644
--- a/libguile/eq.c
+++ b/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;
+ 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)) {
+ 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));
+ 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
- return SCM_BOOL_T;
- }
+ 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;
+ 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);
}
- 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;
- }
+ 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:
+ 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:
+ 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);
+ 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;
+ }
+ return SCM_BOOL_F;
}
#undef FUNC_NAME
diff --git a/libguile/eval.c b/libguile/eval.c
index f39a8a31c..f2562850b 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -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;
diff --git a/libguile/hash.c b/libguile/hash.c
index 3d55c69d8..9be4b465c 100644
--- a/libguile/hash.c
+++ b/libguile/hash.c
@@ -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:
diff --git a/libguile/objects.c b/libguile/objects.c
index 5026f3b66..17d669bbd 100644
--- a/libguile/objects.c
+++ b/libguile/objects.c
@@ -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 */
diff --git a/libguile/ramap.c b/libguile/ramap.c
index 5c6c97d3e..61caf2fbb 100644
--- a/libguile/ramap.c
+++ b/libguile/ramap.c
@@ -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 */
}
}
diff --git a/libguile/random.c b/libguile/random.c
index 3724bd71f..4bb1c58b0 100644
--- a/libguile/random.c
+++ b/libguile/random.c
@@ -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
diff --git a/libguile/unif.h b/libguile/unif.h
index b7a4ac138..550909e21 100644
--- a/libguile/unif.h
+++ b/libguile/unif.h
@@ -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);