From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 25 Sep 1989 16:51:23 +0000 (+0000)
Subject: Add new primitive `flonum-denormalize'.
X-Git-Tag: 20090517-FFI~11769
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5ab141759f9671435439375ebec6d94cf721b2e1;p=mit-scheme.git

Add new primitive `flonum-denormalize'.
---

diff --git a/v7/src/microcode/artutl.c b/v7/src/microcode/artutl.c
index 2ae505a66..7cb2a3a97 100644
--- 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.3 1989/09/24 16:15:01 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/artutl.c,v 1.4 1989/09/25 16:50:56 cph Exp $
 
 Copyright (c) 1989 Massachusetts Institute of Technology
 
@@ -150,7 +150,7 @@ bignum_to_flonum (bignum)
      ? (BIGNUM_TO_FLONUM (bignum))
      : SHARP_F);
 }
-
+
 Boolean
 flonum_integer_p (x)
      SCHEME_OBJECT x;
@@ -195,6 +195,16 @@ flonum_normalize (x)
   return (cons ((double_to_flonum (significand)),
 		(long_to_integer ((long) exponent))));
 }
+
+SCHEME_OBJECT
+flonum_denormalize (x, e)
+     SCHEME_OBJECT x;
+     SCHEME_OBJECT e;
+{
+  extern double ldexp ();
+  return (double_to_flonum (ldexp ((FLONUM_TO_DOUBLE (x)),
+				   ((int) (integer_to_long (e))))));
+}
 
 /* Generic Integer Operations */
 
diff --git a/v7/src/microcode/extern.h b/v7/src/microcode/extern.h
index 2a86b0019..0128d3b98 100644
--- 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.34 1989/09/24 13:49:05 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/extern.h,v 9.35 1989/09/25 16:51:09 cph Exp $
 
 Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
@@ -173,6 +173,7 @@ extern SCHEME_OBJECT flonum_floor ();
 extern SCHEME_OBJECT flonum_ceiling ();
 extern SCHEME_OBJECT flonum_round ();
 extern SCHEME_OBJECT flonum_normalize ();
+extern SCHEME_OBJECT flonum_denormalize ();
 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 89e5b4131..707e711df 100644
--- 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.29 1989/09/24 15:12:57 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/flonum.c,v 9.30 1989/09/25 16:51:17 cph Exp $
 
 Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
@@ -259,5 +259,14 @@ 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))); 
+  PRIMITIVE_RETURN (flonum_normalize (ARG_REF (1)));
+}
+
+DEFINE_PRIMITIVE ("FLONUM-DENORMALIZE", Prim_flonum_denormalize, 2, 2, 0)
+{
+  PRIMITIVE_HEADER (2);
+  Set_Time_Zone (Zone_Math);
+  CHECK_ARG (1, FLONUM_P);
+  CHECK_ARG (1, INTEGER_P);
+  PRIMITIVE_RETURN (flonum_denormalize ((ARG_REF (1)), (ARG_REF (2))));
 }
diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h
index eb72e3e04..a6a0d27a2 100644
--- 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.2 1989/09/24 13:50:06 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.3 1989/09/25 16:51:23 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	2
+#define SUBVERSION	3
 #endif
 
 #ifndef UCODE_TABLES_FILENAME
diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h
index 61ff454b9..f88b690f6 100644
--- 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.2 1989/09/24 13:50:06 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.3 1989/09/25 16:51:23 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	2
+#define SUBVERSION	3
 #endif
 
 #ifndef UCODE_TABLES_FILENAME