From: Taylor R Campbell <campbell@mumble.net>
Date: Sat, 28 Aug 2010 20:55:04 +0000 (+0000)
Subject: Fix SVM interpreter's decoding of doubles.
X-Git-Tag: 20101212-Gtk~81
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d7d7e1e79b670d9006b9e32d6a9df1f5d1adad9a;p=mit-scheme.git

Fix SVM interpreter's decoding of doubles.

They are encoded as 64-bit significand and 16-bit exponent, not as
machine (IEEE 754) doubles.
---

diff --git a/src/microcode/svm1-interp.c b/src/microcode/svm1-interp.c
index db8ac4cca..d1aa86d06 100644
--- a/src/microcode/svm1-interp.c
+++ b/src/microcode/svm1-interp.c
@@ -318,6 +318,16 @@ decode_unsigned_32 (void)
   return ((b3 << 24) | (b2 << 16) | (b1 << 8) | b0);
 }
 
+static uint64_t
+decode_unsigned_64 (void)
+{
+  uint64_t b0, b1, b2, b3, b4, b5, b6, b7;
+  b0 = NEXT_BYTE; b1 = NEXT_BYTE; b2 = NEXT_BYTE; b3 = NEXT_BYTE;
+  b4 = NEXT_BYTE; b5 = NEXT_BYTE; b6 = NEXT_BYTE; b7 = NEXT_BYTE;
+  return ((b7 << 56) | (b6 << 48) | (b5 << 40) | (b4 << 32)
+	  | (b3 << 24) | (b2 << 16) | (b1 << 8) | b0);
+}
+
 static long
 decode_signed_8 (void)
 {
@@ -351,30 +361,27 @@ decode_signed_32 (void)
 #endif
 }
 
+static int64_t
+decode_signed_64 (void)
+{
+  uint64_t n = (decode_unsigned_64 ());
+  if (n < ((uint64_t) 0x8000000000000000))
+    return ((int64_t) n);
+  n -= ((uint64_t) 0x8000000000000000);
+  {
+    int64_t r = ((int64_t) n);
+    r -= ((int64_t) 0x4000000000000000);
+    r -= ((int64_t) 0x4000000000000000);
+    return (r);
+  }
+}
+
 static double
 decode_float (void)
 {
-  union { double f; byte_t b [(sizeof (double))]; } x;
-
-  if (little_endian_p)
-    {
-      unsigned int i = 0;
-      while (i < (sizeof (double)))
-	{
-	  ((x.b) [i]) = NEXT_BYTE;
-	  i += 1;
-	}
-    }
-  else
-    {
-      unsigned int i = (sizeof (double));
-      while (i > 0)
-	{
-	  i -= 1;
-	  ((x.b) [i]) = NEXT_BYTE;
-	}
-    }
-  return (x.f);
+  int64_t significand = (decode_signed_64 ());
+  int exponent = (decode_signed_16 ());
+  return (ldexp (((double) significand), exponent));
 }
 
 /* Instruction definitions */