From: Joe Marshall <eval.apply@gmail.com>
Date: Sat, 18 Dec 2010 01:32:08 +0000 (-0800)
Subject: Fix tag table entry for flonum for 64-bit platforms.
X-Git-Tag: 20101221-Gtk~11
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=36ca90b8c977289c3aedcde08996b1ea0d73c08c;p=mit-scheme.git

Fix tag table entry for flonum for 64-bit platforms.
---

diff --git a/src/runtime/generic.scm b/src/runtime/generic.scm
index 39e4d2afb..f99311375 100644
--- a/src/runtime/generic.scm
+++ b/src/runtime/generic.scm
@@ -423,14 +423,18 @@ USA.
 			       ((memq object '(#!optional #!rest #!key #!aux))
 				keyword-tag)
 			       (else constant-tag)))))))
-    (assign-type 'FLONUM
-		 (let ((flonum-vector-tag
-			(make-built-in-tag '(FLONUM-VECTOR))))
-		   (lambda (default-tag)
-		     (lambda (object)
-		       (if (fix:= 2 (system-vector-length object))
-			   default-tag
-			   flonum-vector-tag)))))
+
+    ;; Flonum length can change size on different architectures, so we
+    ;; measure one.
+    (let ((flonum-length (system-vector-length microcode-id/floating-epsilon)))
+      (assign-type 'FLONUM
+		   (let ((flonum-vector-tag
+			  (make-built-in-tag '(FLONUM-VECTOR))))
+		     (lambda (default-tag)
+		       (lambda (object)
+			 (if (fix:= flonum-length (system-vector-length object))
+			     default-tag
+			     flonum-vector-tag))))))
     (assign-type 'RECORD
 		 (let ((dt-tag (make-built-in-tag '(DISPATCH-TAG))))
 		   (lambda (default-tag)