X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fgeneric%2Fgenesis.lisp;h=9b059d44a43dd413e5eab2dd630afb2ca2313590;hb=095a47764e687fa76cf0e2803633d30c65c00f40;hp=fdfa8482bbef48ebd2c664503bdad811de837cfc;hpb=5e1fcdac979db9a6aebe69531229355def8c0f90;p=sbcl.git

diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index fdfa848..9b059d4 100644
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -663,6 +663,30 @@ core and return a descriptor to it."
     (write-wordindexed des 2 second)
     des))
 
+(defun write-double-float-bits (address index x)
+  (let ((hi (double-float-high-bits x))
+	(lo (double-float-low-bits x)))
+    (ecase sb!vm::n-word-bits
+      (32
+       (let ((high-bits (make-random-descriptor hi))
+	     (low-bits (make-random-descriptor lo)))
+	 (ecase sb!c:*backend-byte-order*
+	   (:little-endian
+	    (write-wordindexed address index low-bits)
+	    (write-wordindexed address (1+ index) high-bits))
+	   (:big-endian
+	    (write-wordindexed address index high-bits)
+	    (write-wordindexed address (1+ index) low-bits)))))
+      (64
+       (let ((bits (make-random-descriptor
+		    (ecase sb!c:*backend-byte-order*
+		      (:little-endian (logior lo (ash hi 32)))
+		      ;; Just guessing.
+		      #+nil (:big-endian (logior (logand hi #xffffffff)
+						 (ash lo 32)))))))
+	 (write-wordindexed address index bits))))
+    address))
+
 (defun float-to-core (x)
   (etypecase x
     (single-float
@@ -678,17 +702,8 @@ core and return a descriptor to it."
      (let ((des (allocate-unboxed-object *dynamic*
 					 sb!vm:n-word-bits
 					 (1- sb!vm:double-float-size)
-					 sb!vm:double-float-widetag))
-	   (high-bits (make-random-descriptor (double-float-high-bits x)))
-	   (low-bits (make-random-descriptor (double-float-low-bits x))))
-       (ecase sb!c:*backend-byte-order*
-	 (:little-endian
-	  (write-wordindexed des sb!vm:double-float-value-slot low-bits)
-	  (write-wordindexed des (1+ sb!vm:double-float-value-slot) high-bits))
-	 (:big-endian
-	  (write-wordindexed des sb!vm:double-float-value-slot high-bits)
-	  (write-wordindexed des (1+ sb!vm:double-float-value-slot) low-bits)))
-       des))))
+					 sb!vm:double-float-widetag)))
+       (write-double-float-bits des sb!vm:double-float-value-slot x)))))
 
 (defun complex-single-float-to-core (num)
   (declare (type (complex single-float) num))
@@ -706,39 +721,10 @@ core and return a descriptor to it."
   (let ((des (allocate-unboxed-object *dynamic* sb!vm:n-word-bits
 				      (1- sb!vm:complex-double-float-size)
 				      sb!vm:complex-double-float-widetag)))
-    (let* ((real (realpart num))
-	   (high-bits (make-random-descriptor (double-float-high-bits real)))
-	   (low-bits (make-random-descriptor (double-float-low-bits real))))
-      (ecase sb!c:*backend-byte-order*
-	(:little-endian
-	 (write-wordindexed des sb!vm:complex-double-float-real-slot low-bits)
-	 (write-wordindexed des
-			    (1+ sb!vm:complex-double-float-real-slot)
-			    high-bits))
-	(:big-endian
-	 (write-wordindexed des sb!vm:complex-double-float-real-slot high-bits)
-	 (write-wordindexed des
-			    (1+ sb!vm:complex-double-float-real-slot)
-			    low-bits))))
-    (let* ((imag (imagpart num))
-	   (high-bits (make-random-descriptor (double-float-high-bits imag)))
-	   (low-bits (make-random-descriptor (double-float-low-bits imag))))
-      (ecase sb!c:*backend-byte-order*
-	(:little-endian
-	 (write-wordindexed des
-			    sb!vm:complex-double-float-imag-slot
-			    low-bits)
-	 (write-wordindexed des
-			    (1+ sb!vm:complex-double-float-imag-slot)
-			    high-bits))
-	(:big-endian
-	 (write-wordindexed des
-			    sb!vm:complex-double-float-imag-slot
-			    high-bits)
-	 (write-wordindexed des
-			    (1+ sb!vm:complex-double-float-imag-slot)
-			    low-bits))))
-    des))
+    (write-double-float-bits des sb!vm:complex-double-float-real-slot
+			     (realpart num))
+    (write-double-float-bits des sb!vm:complex-double-float-imag-slot
+			     (imagpart num))))
 
 ;;; Copy the given number to the core.
 (defun number-to-core (number)
@@ -2455,12 +2441,12 @@ core and return a descriptor to it."
 		       ;; itself.) Ask on the mailing list whether
 		       ;; this is documented somewhere, and if not,
 		       ;; try to reverse engineer some documentation.
-		       #!-x86
+		       #!-(or x86 x86-64)
 		       ;; a pointer back to the function object, as
 		       ;; described in CMU CL
 		       ;; src/docs/internals/object.tex
 		       fn
-		       #!+x86
+		       #!+(or x86 x86-64)
 		       ;; KLUDGE: a pointer to the actual code of the
 		       ;; object, as described nowhere that I can find
 		       ;; -- WHN 19990907
@@ -3106,7 +3092,7 @@ initially undefined function references:~2%")
 			      sb!vm:unbound-marker-widetag))
 	   *cold-assembler-fixups*
 	   *cold-assembler-routines*
-	   #!+x86 *load-time-code-fixups*)
+	   #!+(or x86 x86-64) *load-time-code-fixups*)
 
       ;; Prepare for cold load.
       (initialize-non-nil-symbols)
@@ -3174,7 +3160,7 @@ initially undefined function references:~2%")
 
       ;; Tidy up loose ends left by cold loading. ("Postpare from cold load?")
       (resolve-assembler-fixups)
-      #!+x86 (output-load-time-code-fixups)
+      #!+(or x86 x86-64) (output-load-time-code-fixups)
       (foreign-symbols-to-core)
       (finish-symbols)
       (/show "back from FINISH-SYMBOLS")