Commit 850c0d35 authored by rtoy's avatar rtoy
Browse files

Add support for dumping double-double-float arrays, complex 

double-double-floats, and complex double-double-float arrays.

bootfiles/19c/boot-2006-06-2-cross-dd-sparc.lisp:
o Cross-compile with new fops.

compiler/dump.lisp:
o Tell compiler how to dump (complex double-double-float),
  (simple-array double-double-float (*)), and (simple-array (complex
  double-double-float) (*)) objects to a fasl file.

compiler/generic/new-genesis.lisp:
o Dump (complex double-double-float) objects to a core file.
parent 051035b4

bootfiles/19c/Attic/boot-2006-06-2-cross-dd-sparc.lisp

+35 −0
Original line number Diff line number Diff line
@@ -96,6 +96,41 @@ 
  boolean

  (movable foldable flushable))



(in-package "LISP")

#+double-double

(define-fop (fop-double-double-float-vector 88)

  (let* ((length (read-arg 4))

	 (result (make-array length :element-type 'double-double-float)))

    (read-n-bytes *fasl-file* result 0 (* length 4 4))

    result))



#+double-double

(define-fop (fop-complex-double-double-float 89)

  (prepare-for-fast-read-byte *fasl-file*

    (prog1

	(let* ((real-hi-lo (fast-read-u-integer 4))

	       (real-hi-hi (fast-read-s-integer 4))

	       (real-lo-lo (fast-read-u-integer 4))

	       (real-lo-hi (fast-read-s-integer 4))

	       (re (kernel::make-double-double-float

		    (make-double-float real-hi-hi real-hi-lo)

		    (make-double-float real-lo-hi real-lo-lo)))

	       (imag-hi-lo (fast-read-u-integer 4))

	       (imag-hi-hi (fast-read-s-integer 4))

	       (imag-lo-lo (fast-read-u-integer 4))

	       (imag-lo-hi (fast-read-s-integer 4))

	       (im (kernel::make-double-double-float

		    (make-double-float imag-hi-hi imag-hi-lo)

		    (make-double-float imag-lo-hi imag-lo-lo))))

	  (complex re im)) 

      (done-with-fast-read-byte))))



#+double-double

(define-fop (fop-complex-double-double-float-vector 90)

  (let* ((length (read-arg 4))

	 (result (make-array length :element-type '(complex double-double-float))))

    (read-n-bytes *fasl-file* result 0 (* length 4 8))

    result))



;; End changes for double-double

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

bootfiles/19c/boot-2006-06-2-cross-dd-sparc.lisp

+35 −0
Original line number Diff line number Diff line
@@ -96,6 +96,41 @@ 
  boolean

  (movable foldable flushable))



(in-package "LISP")

#+double-double

(define-fop (fop-double-double-float-vector 88)

  (let* ((length (read-arg 4))

	 (result (make-array length :element-type 'double-double-float)))

    (read-n-bytes *fasl-file* result 0 (* length 4 4))

    result))



#+double-double

(define-fop (fop-complex-double-double-float 89)

  (prepare-for-fast-read-byte *fasl-file*

    (prog1

	(let* ((real-hi-lo (fast-read-u-integer 4))

	       (real-hi-hi (fast-read-s-integer 4))

	       (real-lo-lo (fast-read-u-integer 4))

	       (real-lo-hi (fast-read-s-integer 4))

	       (re (kernel::make-double-double-float

		    (make-double-float real-hi-hi real-hi-lo)

		    (make-double-float real-lo-hi real-lo-lo)))

	       (imag-hi-lo (fast-read-u-integer 4))

	       (imag-hi-hi (fast-read-s-integer 4))

	       (imag-lo-lo (fast-read-u-integer 4))

	       (imag-lo-hi (fast-read-s-integer 4))

	       (im (kernel::make-double-double-float

		    (make-double-float imag-hi-hi imag-hi-lo)

		    (make-double-float imag-lo-hi imag-lo-lo))))

	  (complex re im)) 

      (done-with-fast-read-byte))))



#+double-double

(define-fop (fop-complex-double-double-float-vector 90)

  (let* ((length (read-arg 4))

	 (result (make-array length :element-type '(complex double-double-float))))

    (read-n-bytes *fasl-file* result 0 (* length 4 8))

    result))



;; End changes for double-double

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

compiler/dump.lisp

+37 −1
Original line number Diff line number Diff line
@@ -5,7 +5,7 @@ 
;;; Carnegie Mellon University, and has been placed in the public domain.

;;;

(ext:file-comment

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.81.6.1 2006/06/09 16:05:15 rtoy Exp $")

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.81.6.1.4.1 2006/06/22 15:19:30 rtoy Exp $")

;;;

;;; **********************************************************************

;;;
@@ -1103,6 +1103,12 @@ 
    (dump-double (kernel:double-double-hi float))

    (dump-double (kernel:double-double-lo float))))



#+double-double

(defun dump-complex-double-double-float (z file)

  ;; Dump out 2 double-double-floats

  (dump-double-double-float (realpart z) file)

  (dump-double-double-float (imagpart z) file))

	   

;;; Or a complex...



(defun dump-complex (x file)
@@ -1126,6 +1132,10 @@ 
     (dump-fop 'lisp::fop-complex-long-float file)

     (dump-long-float (realpart x) file)

     (dump-long-float (imagpart x) file))

    #+double-double

    ((complex double-double-float)

     (dump-fop 'lisp::fop-complex-double-double-float file)

     (dump-complex-double-double-float x file))

    (t

     (sub-dump-object (realpart x) file)

     (sub-dump-object (imagpart x) file)
@@ -1386,6 +1396,10 @@ 
      ((simple-array long-float (*))

       (dump-long-float-vector simple-version file)

       (eq-save-object x file))

      #+double-double

      ((simple-array double-double-float (*))

       (dump-double-double-float-vector simple-version file)

       (eq-save-object x file))

      ((simple-array (complex single-float) (*))

       (dump-complex-single-float-vector simple-version file)

       (eq-save-object x file))
@@ -1396,6 +1410,10 @@ 
      ((simple-array (complex long-float) (*))

       (dump-complex-long-float-vector simple-version file)

       (eq-save-object x file))

      #+double-double

      ((simple-array (complex double-double-float) (*))

       (dump-complex-double-double-float-vector simple-version file)

       (eq-save-object x file))

      (t

       (dump-i-vector simple-version file)

       (eq-save-object x file)))))
@@ -1508,6 +1526,15 @@ 
     vec (* length vm:word-bytes #+x86 3 #+sparc 4)

     (* vm:word-bytes #+x86 3 #+sparc 4) file)))



#+double-double

(defun dump-double-double-float-vector (vec file)

  (let* ((length (length vec))

	 (element-size (* 4 vm:word-bytes))

	 (bytes (* length element-size)))

    (dump-fop 'lisp::fop-double-double-float-vector file)

    (dump-unsigned-32 length file)

    (dump-data-maybe-byte-swapping vec bytes element-size file)))



;;; DUMP-COMPLEX-SINGLE-FLOAT-VECTOR  --  internal.

;;; 

(defun dump-complex-single-float-vector (vec file)
@@ -1526,6 +1553,15 @@ 
    (dump-data-maybe-byte-swapping vec (* length vm:word-bytes 2 2)

				   (* vm:word-bytes 2) file)))



#+double-double

(defun dump-complex-double-double-float-vector (vec file)

  (let* ((length (length vec))

	 (element-size (* 8 vm:word-bytes))

	 (bytes (* length element-size)))

    (dump-fop 'lisp::fop-complex-double-double-float-vector file)

    (dump-unsigned-32 length file)

    (dump-data-maybe-byte-swapping vec bytes element-size file)))



;;; DUMP-COMPLEX-LONG-FLOAT-VECTOR  --  internal.

;;; 

#+long-float

compiler/generic/new-genesis.lisp

+55 −1
Original line number Diff line number Diff line
@@ -4,7 +4,7 @@ 
;;; Carnegie Mellon University, and has been placed in the public domain.

;;;

(ext:file-comment

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.78.2.1 2006/06/09 16:05:16 rtoy Exp $")

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.78.2.1.4.1 2006/06/22 15:19:30 rtoy Exp $")

;;;

;;; **********************************************************************

;;;
@@ -545,6 +545,55 @@ 
	 (write-indexed des (1+ vm:complex-double-float-imag-slot) low-bits))))

    des))



#+double-double

(defun complex-double-double-float-to-core (num)

  (declare (type (complex double-double-float) num))

  (let ((des (allocate-unboxed-object *dynamic* vm:word-bits

				      (1- vm::complex-double-double-float-size)

				      vm::complex-double-double-float-type)))

    (let* ((real (kernel:double-double-hi (realpart num)))

	   (high-bits (make-random-descriptor (double-float-high-bits real)))

	   (low-bits (make-random-descriptor (double-float-low-bits real))))

      (ecase (c:backend-byte-order c:*backend*)

	(:little-endian

	 (write-indexed des vm:complex-double-double-float-real-hi-slot low-bits)

	 (write-indexed des (1+ vm:complex-double-double-float-real-hi-slot) high-bits))

	(:big-endian

	 (write-indexed des vm:complex-double-double-float-real-hi-slot high-bits)

	 (write-indexed des (1+ vm:complex-double-double-float-real-hi-slot) low-bits))))

    (let* ((real (kernel:double-double-lo (realpart num)))

	   (high-bits (make-random-descriptor (double-float-high-bits real)))

	   (low-bits (make-random-descriptor (double-float-low-bits real))))

      (ecase (c:backend-byte-order c:*backend*)

	(:little-endian

	 (write-indexed des vm:complex-double-double-float-real-lo-slot low-bits)

	 (write-indexed des (1+ vm:complex-double-double-float-real-lo-slot) high-bits))

	(:big-endian

	 (write-indexed des vm:complex-double-double-float-real-lo-slot high-bits)

	 (write-indexed des (1+ vm:complex-double-double-float-real-lo-slot) low-bits))))

    (let* ((imag (kernel:double-double-hi (imagpart num)))

	   (high-bits (make-random-descriptor (double-float-high-bits imag)))

	   (low-bits (make-random-descriptor (double-float-low-bits imag))))

      (ecase (c:backend-byte-order c:*backend*)

	(:little-endian

	 (write-indexed des vm:complex-double-double-float-imag-hi-slot low-bits)

	 (write-indexed des (1+ vm:complex-double-double-float-imag-hi-slot) high-bits))

	(:big-endian

	 (write-indexed des vm:complex-double-double-float-imag-hi-slot high-bits)

	 (write-indexed des (1+ vm:complex-double-double-float-imag-hi-slot) low-bits))))

    (let* ((imag (kernel:double-double-lo (imagpart num)))

	   (high-bits (make-random-descriptor (double-float-high-bits imag)))

	   (low-bits (make-random-descriptor (double-float-low-bits imag))))

      (ecase (c:backend-byte-order c:*backend*)

	(:little-endian

	 (write-indexed des vm:complex-double-double-float-imag-lo-slot low-bits)

	 (write-indexed des (1+ vm:complex-double-double-float-imag-lo-slot) high-bits))

	(:big-endian

	 (write-indexed des vm:complex-double-double-float-imag-lo-slot high-bits)

	 (write-indexed des (1+ vm:complex-double-double-float-imag-lo-slot) low-bits))))

    des))

  



(defun number-to-core (number)

  "Copy the given number to the core, or flame out if we can't deal with it."

  (typecase number
@@ -559,6 +608,8 @@ 
    #+long-float

    ((complex long-float)

     (error "~S isn't a cold-loadable number at all!" number))

    #+double-double

    ((complex double-double-float) (complex-double-double-float-to-core number))

    (complex (number-pair-to-core (number-to-core (realpart number))

				  (number-to-core (imagpart number))

				  vm:complex-type))
@@ -1407,6 +1458,8 @@ 
(not-cold-fop fop-complex-single-float-vector)

(not-cold-fop fop-complex-double-float-vector)

#+long-float (not-cold-fop fop-complex-long-float-vector)

;; Why is this not-cold-fop?  I'm just cargo-culting this.

#+double-double (not-cold-fop fop-complex-double-double-float-vector)



(define-cold-fop (fop-array)

  (let* ((rank (read-arg 4))
@@ -1489,6 +1542,7 @@ 
(cold-number fop-byte-integer)

(cold-number fop-complex-single-float)

(cold-number fop-complex-double-float)

(cold-number fop-complex-double-double-float)



#+long-float

(define-cold-fop (fop-long-float)