Add primitives to normalize flonums, and to produce the key flonum

parameters: number of bits in significand, and smallest number which
can be added to one and still produce different result.

diff --git a/v7/src/microcode/artutl.c b/v7/src/microcode/artutl.c
index a12b6ec3516a340c6f373cacc57a4d60a2061e64..6d32ccb7ce8c716e9957dc1815f26ee98c551654 100644 (file)
--- a/v7/src/microcode/artutl.c
+++ b/v7/src/microcode/artutl.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/artutl.c,v 1.1 1989/09/20 23:19:25 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/artutl.c,v 1.2 1989/09/24 13:49:38 cph Exp $
 
 Copyright (c) 1989 Massachusetts Institute of Technology
 
@@ -155,6 +155,7 @@ Boolean
 flonum_integer_p (x)
      SCHEME_OBJECT x;
 {
+  extern double modf ();
   double iptr;
   return ((modf ((FLONUM_TO_DOUBLE (x)), (&iptr))) == 0);
 }
@@ -163,6 +164,7 @@ SCHEME_OBJECT
 flonum_floor (x)
      SCHEME_OBJECT x;
 {
+  extern double floor ();
   return (double_to_flonum (floor (FLONUM_TO_DOUBLE (x))));
 }
 
@@ -170,6 +172,7 @@ SCHEME_OBJECT
 flonum_ceiling (x)
      SCHEME_OBJECT x;
 {
+  extern double ceil ();
   return (double_to_flonum (ceil (FLONUM_TO_DOUBLE (x))));
 }
 
@@ -181,6 +184,17 @@ flonum_round (x)
   return
     (double_to_flonum (double_truncate ((dx < 0) ? (dx - 0.5) : (dx + 0.5))));
 }
+
+SCHEME_OBJECT
+flonum_normalize (x)
+     SCHEME_OBJECT x;
+{
+  extern double frexp ();
+  int exponent;
+  double significand = (frexp ((FLONUM_TO_DOUBLE (x)), (&exponent)));
+  return (cons ((double_to_flonum (significand)),
+               (double_to_flonum ((double) exponent))));
+}
 \f
 /* Generic Integer Operations */
 

diff --git a/v7/src/microcode/extern.h b/v7/src/microcode/extern.h
index 31d10e4071c539a52a667dac20aed388dc4eb63c..2a86b0019d7594e205a7f1da14b0b2a848e2a415 100644 (file)
--- a/v7/src/microcode/extern.h
+++ b/v7/src/microcode/extern.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/extern.h,v 9.33 1989/09/20 23:07:50 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/extern.h,v 9.34 1989/09/24 13:49:05 cph Exp $
 
 Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
@@ -172,6 +172,7 @@ extern SCHEME_OBJECT bignum_to_flonum ();
 extern SCHEME_OBJECT flonum_floor ();
 extern SCHEME_OBJECT flonum_ceiling ();
 extern SCHEME_OBJECT flonum_round ();
+extern SCHEME_OBJECT flonum_normalize ();
 extern Boolean integer_zero_p ();
 extern Boolean integer_negative_p ();
 extern Boolean integer_positive_p ();

diff --git a/v7/src/microcode/flonum.c b/v7/src/microcode/flonum.c
index e899b3d3ecf1d884099a9d23dc57516c5d6ee103..7163cb883ae5bd677f71a7077639445c9c210bd6 100644 (file)
--- a/v7/src/microcode/flonum.c
+++ b/v7/src/microcode/flonum.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/flonum.c,v 9.27 1989/09/20 23:08:30 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/flonum.c,v 9.28 1989/09/24 13:49:21 cph Exp $
 
 Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
@@ -253,3 +253,27 @@ DEFINE_PRIMITIVE ("FLONUM-CEILING->EXACT", Prim_flonum_ceiling_to_exact, 1, 1, 0
      FLONUM_EXACT_CONVERSION (flonum_ceiling)
 DEFINE_PRIMITIVE ("FLONUM-ROUND->EXACT", Prim_flonum_round_to_exact, 1, 1, 0)
      FLONUM_EXACT_CONVERSION (flonum_round)
+
+DEFINE_PRIMITIVE ("FLONUM-NORMALIZE", Prim_flonum_normalize, 1, 1, 0)
+{
+  PRIMITIVE_HEADER (1);
+  Set_Time_Zone (Zone_Math);
+  CHECK_ARG (1, FLONUM_P);
+  PRIMITIVE_RETURN (flonum_normalize (ARG_REF (1))); 
+}
+
+#include "float.h"
+#if (FLT_RADIX != 2)
+#include "error: floating point radix not 2!  Arithmetic won't work."
+#endif
+
+#define FLONUM_CONSTANT(expression)                                    \
+{                                                                      \
+  PRIMITIVE_HEADER (0);                                                        \
+  PRIMITIVE_RETURN (expression);                                       \
+}
+
+DEFINE_PRIMITIVE ("FLONUM-MANTISSA-DIGITS", Prim_flonum_mantissa_digits, 0, 0, 0)
+     FLONUM_CONSTANT (long_to_integer (DBL_MANT_DIG))
+DEFINE_PRIMITIVE ("FLONUM-EPSILON", Prim_flonum_epsilon, 0, 0, 0)
+     FLONUM_CONSTANT (double_to_flonum ((double) DBL_EPSILON))

diff --git a/v7/src/microcode/unxutl/ymkfile b/v7/src/microcode/unxutl/ymkfile
index 36b3ef65de226ca6b1bc8cd11e6cc0254bbe0cde..24700e93d6a4426bd182363a0f63d9c362a7ad7b 100644 (file)
--- a/v7/src/microcode/unxutl/ymkfile
+++ b/v7/src/microcode/unxutl/ymkfile
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/unxutl/Attic/ymkfile,v 1.11 1989/09/22 08:47:32 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/unxutl/Attic/ymkfile,v 1.12 1989/09/24 13:50:26 cph Exp $
 
 Copyright (c) 1989 Massachusetts Institute of Technology
 
@@ -468,7 +468,8 @@ memmag.o gcloop.o purify.o purutl.o comutl.o : scheme.touch prims.h \
 
 artutl.o : scheme.touch
 bignum.o : scheme.touch bignumint.h
-bigprm.o flonum.o intprm.o generic.o : scheme.touch prims.h zones.h
+bigprm.o intprm.o generic.o : scheme.touch prims.h zones.h
+flonum.o : scheme.touch prims.h zones.h float.h
 
 storage.o : scheme.touch gctype.c
 

diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h
index adec58430c92b7a1333d22472c603c4641d9449f..eb72e3e0432ba3fbe51d3d2022026c1d8ebe041c 100644 (file)
--- a/v7/src/microcode/version.h
+++ b/v7/src/microcode/version.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.1 1989/09/20 23:03:51 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.2 1989/09/24 13:50:06 cph Exp $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -46,7 +46,7 @@ MIT in each case. */
 #define VERSION                11
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION     1
+#define SUBVERSION     2
 #endif
 
 #ifndef UCODE_TABLES_FILENAME

diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h
index 1ec393049c77ed038d36221cd2be8a53ad42ce94..61ff454b92000b05696484ce8a1df81e7dcdbc6a 100644 (file)
--- a/v8/src/microcode/version.h
+++ b/v8/src/microcode/version.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.1 1989/09/20 23:03:51 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.2 1989/09/24 13:50:06 cph Exp $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -46,7 +46,7 @@ MIT in each case. */
 #define VERSION                11
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION     1
+#define SUBVERSION     2
 #endif
 
 #ifndef UCODE_TABLES_FILENAME