diff --git a/compiler/generic/interr.lisp b/compiler/generic/interr.lisp index f43e9f1ac581936b908431b2f448f26804fb3fd7..d32a60324d7683396f144d0a5e9425579fdbf9fa 100644 --- a/compiler/generic/interr.lisp +++ b/compiler/generic/interr.lisp @@ -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/generic/interr.lisp,v 1.8 1997/11/15 04:39:00 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/interr.lisp,v 1.9 1998/03/21 07:55:52 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -58,6 +58,9 @@ "Object is not of type SINGLE-FLOAT.") (object-not-double-float "Object is not of type DOUBLE-FLOAT.") + #+long-float + (object-not-long-float + "Object is not of type LONG-FLOAT.") (object-not-simple-string "Object is not of type SIMPLE-STRING.") (object-not-simple-bit-vector @@ -153,12 +156,18 @@ "Object is not of type (SIMPLE-ARRAY SINGLE-FLOAT (*)).") (object-not-simple-array-double-float "Object is not of type (SIMPLE-ARRAY DOUBLE-FLOAT (*)).") + #+long-float + (object-not-simple-array-long-float + "Object is not of type (SIMPLE-ARRAY LONG-FLOAT (*)).") #+complex-float (object-not-simple-array-complex-single-float "Object is not of type (SIMPLE-ARRAY (COMPLEX SINGLE-FLOAT) (*)).") #+complex-float (object-not-simple-array-complex-double-float "Object is not of type (SIMPLE-ARRAY (COMPLEX DOUBLE-FLOAT) (*)).") + #+(and complex-float long-float) + (object-not-simple-array-complex-long-float + "Object is not of type (SIMPLE-ARRAY (COMPLEX LONG-FLOAT) (*)).") (object-not-complex "Object is not of type COMPLEX.") #+complex-float @@ -173,6 +182,9 @@ #+complex-float (object-not-complex-double-float "Object is not of type (COMPLEX DOUBLE-FLOAT).") + #+(and complex-float long-float) + (object-not-complex-long-float + "Object is not of type (COMPLEX LONG-FLOAT).") (object-not-weak-pointer "Object is not a WEAK-POINTER.") (object-not-instance diff --git a/compiler/generic/new-genesis.lisp b/compiler/generic/new-genesis.lisp index 8033b9f44cb351526a34dd74d4de822c75a9c92e..ea01bf09d85fb5a20945e582b79037a37fdb4be0 100644 --- a/compiler/generic/new-genesis.lisp +++ b/compiler/generic/new-genesis.lisp @@ -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.32 1998/02/15 15:34:50 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.33 1998/03/21 07:55:52 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -437,6 +437,22 @@ (:big-endian (write-indexed des vm:double-float-value-slot high-bits) (write-indexed des (1+ vm:double-float-value-slot) low-bits))) + des)) + #+(and long-float x86) + (long-float + (let ((des (allocate-unboxed-object *dynamic* vm:word-bits + (1- vm:long-float-size) + vm:long-float-type)) + (exp-bits (make-random-descriptor (long-float-exp-bits num))) + (high-bits (make-random-descriptor (long-float-high-bits num))) + (low-bits (make-random-descriptor (long-float-low-bits num)))) + (ecase (c:backend-byte-order c:*backend*) + (:little-endian + (write-indexed des vm:long-float-value-slot low-bits) + (write-indexed des (1+ vm:long-float-value-slot) high-bits) + (write-indexed des (+ 2 vm:long-float-value-slot) exp-bits)) + (:big-endian + (error "Long-Float not supported"))) des)))) #+complex-float @@ -492,6 +508,9 @@ ((complex single-float) (complex-single-float-to-core number)) #+complex-float ((complex double-float) (complex-double-float-to-core number)) + #+(and complex-float long-float) + ((complex long-float) + (error "~S isn't a cold-loadable number at all!" number)) (complex (number-pair-to-core (number-to-core (realpart number)) (number-to-core (imagpart number)) vm:complex-type)) @@ -755,6 +774,18 @@ (frob "*FP-CONSTANT-1D0*" "X86" (number-to-core 1d0)) (frob "*FP-CONSTANT-0S0*" "X86" (number-to-core 0s0)) (frob "*FP-CONSTANT-1S0*" "X86" (number-to-core 1s0)) + #+long-float + (when (c:backend-featurep :long-float) + (frob "*FP-CONSTANT-0L0*" "X86" (number-to-core 0l0)) + (frob "*FP-CONSTANT-1L0*" "X86" (number-to-core 1l0)) + (frob "*FP-CONSTANT-PI*" "X86" (number-to-core pi)) + (frob "*FP-CONSTANT-L2T*" "X86" (number-to-core (log 10l0 2l0))) + (frob "*FP-CONSTANT-L2E*" "X86" + (number-to-core (log 2.718281828459045235360287471352662L0 2l0))) + (frob "*FP-CONSTANT-LG2*" "X86" (number-to-core (log 2l0 10l0))) + (frob "*FP-CONSTANT-LN2*" "X86" + (number-to-core + (log 2l0 2.718281828459045235360287471352662L0)))) (when (c:backend-featurep :gencgc) (frob "*SCAVENGE-READ-ONLY-SPACE*" "X86" (cold-intern nil)))))) @@ -1301,6 +1332,11 @@ (* len vm:word-bytes 2))) result)) +#+long-float (not-cold-fop fop-long-float-vector) +#+complex-float (not-cold-fop fop-complex-single-float-vector) +#+complex-float (not-cold-fop fop-complex-double-float-vector) +#+(and complex-float long-float) (not-cold-fop fop-complex-long-float-vector) + (define-cold-fop (fop-array) (let* ((rank (read-arg 4)) (data-vector (pop-stack)) @@ -1347,6 +1383,94 @@ #+complex-float (cold-number fop-complex-single-float) #+complex-float (cold-number fop-complex-double-float) +#+long-float +(define-cold-fop (fop-long-float) + (ecase (c:backend-fasl-file-implementation c:*backend*) + (#.c:x86-fasl-file-implementation ; 80 bit long-float format. + (prepare-for-fast-read-byte *fasl-file* + (let* ((des (allocate-unboxed-object *dynamic* vm:word-bits + (1- vm:long-float-size) + vm:long-float-type)) + (low-bits (make-random-descriptor (fast-read-u-integer 4))) + (high-bits (make-random-descriptor (fast-read-u-integer 4))) + (exp-bits (make-random-descriptor (fast-read-s-integer 2)))) + (done-with-fast-read-byte) + (write-indexed des vm:long-float-value-slot low-bits) + (write-indexed des (1+ vm:long-float-value-slot) high-bits) + (write-indexed des (+ 2 vm:long-float-value-slot) exp-bits) + des))) + (#.c:sparc-fasl-file-implementation ; 128 bit long-float format. + (prepare-for-fast-read-byte *fasl-file* + (let* ((des (allocate-unboxed-object *dynamic* vm:word-bits + (1- vm:long-float-size) + vm:long-float-type)) + (low-bits (make-random-descriptor (fast-read-u-integer 4))) + (mid-bits (make-random-descriptor (fast-read-u-integer 4))) + (high-bits (make-random-descriptor (fast-read-u-integer 4))) + (exp-bits (make-random-descriptor (fast-read-s-integer 4)))) + (done-with-fast-read-byte) + (write-indexed des vm:long-float-value-slot exp-bits) + (write-indexed des (1+ vm:long-float-value-slot) high-bits) + (write-indexed des (+ 2 vm:long-float-value-slot) mid-bits) + (write-indexed des (+ 3 vm:long-float-value-slot) low-bits) + des))))) + +#+(and complex-float long-float) +(define-cold-fop (fop-complex-long-float) + (ecase (c:backend-fasl-file-implementation c:*backend*) + (#.c:x86-fasl-file-implementation ; 80 bit long-float format. + (prepare-for-fast-read-byte *fasl-file* + (let* ((des (allocate-unboxed-object *dynamic* vm:word-bits + (1- vm:complex-long-float-size) + vm:complex-long-float-type)) + (real-low-bits (make-random-descriptor (fast-read-u-integer 4))) + (real-high-bits (make-random-descriptor (fast-read-u-integer 4))) + (real-exp-bits (make-random-descriptor (fast-read-s-integer 2))) + (imag-low-bits (make-random-descriptor (fast-read-u-integer 4))) + (imag-high-bits (make-random-descriptor (fast-read-u-integer 4))) + (imag-exp-bits (make-random-descriptor (fast-read-s-integer 2)))) + (done-with-fast-read-byte) + (write-indexed des vm:complex-long-float-real-slot real-low-bits) + (write-indexed des (1+ vm:complex-long-float-real-slot) + real-high-bits) + (write-indexed des (+ 2 vm:complex-long-float-real-slot) + real-exp-bits) + (write-indexed des vm:complex-long-float-imag-slot imag-low-bits) + (write-indexed des (1+ vm:complex-long-float-imag-slot) + imag-high-bits) + (write-indexed des (+ 2 vm:complex-long-float-imag-slot) + imag-exp-bits) + des))) + (#.c:sparc-fasl-file-implementation ; 128 bit long-float format. + (prepare-for-fast-read-byte *fasl-file* + (let* ((des (allocate-unboxed-object *dynamic* vm:word-bits + (1- vm:complex-long-float-size) + vm:complex-long-float-type)) + (real-low-bits (make-random-descriptor (fast-read-u-integer 4))) + (real-mid-bits (make-random-descriptor (fast-read-u-integer 4))) + (real-high-bits (make-random-descriptor (fast-read-u-integer 4))) + (real-exp-bits (make-random-descriptor (fast-read-s-integer 4))) + (imag-low-bits (make-random-descriptor (fast-read-u-integer 4))) + (imag-mid-bits (make-random-descriptor (fast-read-u-integer 4))) + (imag-high-bits (make-random-descriptor (fast-read-u-integer 4))) + (imag-exp-bits (make-random-descriptor (fast-read-s-integer 4)))) + (done-with-fast-read-byte) + (write-indexed des vm:complex-long-float-real-slot real-exp-bits) + (write-indexed des (1+ vm:complex-long-float-real-slot) + real-high-bits) + (write-indexed des (+ 2 vm:complex-long-float-real-slot) + real-mid-bits) + (write-indexed des (+ 3 vm:complex-long-float-real-slot) + real-low-bits) + (write-indexed des vm:complex-long-float-real-slot imag-exp-bits) + (write-indexed des (1+ vm:complex-long-float-real-slot) + imag-high-bits) + (write-indexed des (+ 2 vm:complex-long-float-real-slot) + imag-mid-bits) + (write-indexed des (+ 3 vm:complex-long-float-real-slot) + imag-low-bits) + des))))) + (define-cold-fop (fop-ratio) (let ((den (pop-stack))) (number-pair-to-core (pop-stack) den vm:ratio-type))) diff --git a/compiler/generic/objdef.lisp b/compiler/generic/objdef.lisp index 3c4715b4f8ac7f91274dd7f043ec2c60245112dd..66f78b133e7df9ef91ca38f56060f9ea3c1d0237 100644 --- a/compiler/generic/objdef.lisp +++ b/compiler/generic/objdef.lisp @@ -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/generic/objdef.lisp,v 1.42 1998/01/17 10:24:55 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/objdef.lisp,v 1.43 1998/03/21 07:55:53 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -21,15 +21,15 @@ even-fixnum-type function-pointer-type other-immediate-0-type list-pointer-type odd-fixnum-type instance-pointer-type other-immediate-1-type other-pointer-type bignum-type ratio-type - single-float-type double-float-type complex-type + single-float-type double-float-type long-float-type complex-type simple-array-type simple-string-type simple-bit-vector-type simple-vector-type simple-array-unsigned-byte-2-type simple-array-unsigned-byte-4-type simple-array-unsigned-byte-8-type simple-array-unsigned-byte-16-type simple-array-unsigned-byte-32-type simple-array-signed-byte-8-type simple-array-signed-byte-16-type simple-array-signed-byte-30-type simple-array-signed-byte-32-type - simple-array-single-float-type - simple-array-double-float-type complex-string-type + simple-array-single-float-type simple-array-double-float-type + simple-array-long-float-type complex-string-type complex-bit-vector-type complex-vector-type complex-array-type code-header-type function-header-type closure-header-type closure-function-header-type return-pc-header-type @@ -42,8 +42,10 @@ vector-valid-hashing-subtype vector-must-rehash-subtype forwarding-pointer-type scavenger-hook-type complex-single-float-type complex-double-float-type + complex-long-float-type simple-array-complex-single-float-type - simple-array-complex-double-float-type)) + simple-array-complex-double-float-type + simple-array-complex-long-float-type)) (in-package "KERNEL") (export '(%make-funcallable-instance @@ -112,9 +114,11 @@ ratio single-float double-float + #+long-float long-float complex #+complex-float complex-single-float #+complex-float complex-double-float + #+(and complex-float long-float) complex-long-float simple-array simple-string @@ -131,8 +135,10 @@ #+signed-array simple-array-signed-byte-32 simple-array-single-float simple-array-double-float + #+long-float simple-array-long-float #+complex-float simple-array-complex-single-float #+complex-float simple-array-complex-double-float + #+(and complex-float long-float) simple-array-complex-long-float complex-string complex-bit-vector complex-vector @@ -208,6 +214,12 @@ (filler) (value :c-type "double" :length 2)) +#+long-float +(define-primitive-object (long-float :lowtag other-pointer-type + :header long-float-type) + #+sparc (filler) + (value :c-type "long double" :length #+x86 3 #+sparc 4)) + (define-primitive-object (complex :type complex :lowtag other-pointer-type :header complex-type @@ -487,3 +499,11 @@ (filler) (real :c-type "double" :length 2) (imag :c-type "double" :length 2)) + +#+(and complex-float long-float) +(define-primitive-object (complex-long-float + :lowtag other-pointer-type + :header complex-long-float-type) + #+sparc (filler) + (real :c-type "long double" :length #+x86 3 #+sparc 4) + (imag :c-type "long double" :length #+x86 3 #+sparc 4)) diff --git a/compiler/generic/primtype.lisp b/compiler/generic/primtype.lisp index a63b536042f50e02ea53dd62ffdb4660c2abc2b0..d1e66d5078f58730164b979a54c53a4b7de2bbe1 100644 --- a/compiler/generic/primtype.lisp +++ b/compiler/generic/primtype.lisp @@ -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/generic/primtype.lisp,v 1.18 1998/02/03 19:22:20 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/primtype.lisp,v 1.19 1998/03/21 07:55:54 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -84,12 +84,17 @@ (def-primitive-type complex (descriptor-reg)) (def-primitive-type single-float (single-reg descriptor-reg)) (def-primitive-type double-float (double-reg descriptor-reg)) +#+long-float +(def-primitive-type long-float (long-reg descriptor-reg)) #+complex-float (def-primitive-type complex-single-float (complex-single-reg descriptor-reg) :type (complex single-float)) #+complex-float (def-primitive-type complex-double-float (complex-double-reg descriptor-reg) :type (complex double-float)) +#+(and complex-float long-float) +(def-primitive-type complex-long-float (complex-long-reg descriptor-reg) + :type (complex long-float)) ;;; Primitive other-pointer array types. ;;; @@ -122,12 +127,18 @@ :type (simple-array single-float (*))) (def-primitive-type simple-array-double-float (descriptor-reg) :type (simple-array double-float (*))) +#+long-float +(def-primitive-type simple-array-long-float (descriptor-reg) + :type (simple-array long-float (*))) #+complex-float (def-primitive-type simple-array-complex-single-float (descriptor-reg) :type (simple-array (complex single-float) (*))) #+complex-float (def-primitive-type simple-array-complex-double-float (descriptor-reg) :type (simple-array (complex double-float) (*))) +#+(and complex-float long-float) +(def-primitive-type simple-array-complex-long-float (descriptor-reg) + :type (simple-array (complex long-float) (*))) ;;; Note: The complex array types are not inclueded, 'cause it is pointless to ;;; restrict VOPs to them. @@ -172,10 +183,13 @@ #+signed-array ((signed-byte 32) . simple-array-signed-byte-32) (single-float . simple-array-single-float) (double-float . simple-array-double-float) + #+long-float (long-float . simple-array-long-float) #+complex-float ((complex single-float) . simple-array-complex-single-float) #+complex-float ((complex double-float) . simple-array-complex-double-float) + #+(and complex-float long-float) + ((complex long-float) . simple-array-complex-long-float) (t . simple-vector)) "An a-list for mapping simple array element types to their corresponding primitive types.") @@ -283,9 +297,13 @@ ((short-float single-float) (values (primitive-type-or-lose 'single-float *backend*) exact)) - ((double-float long-float) + ((double-float #-long-float long-float) (values (primitive-type-or-lose 'double-float *backend*) exact)) + #+long-float + (long-float + (values (primitive-type-or-lose 'long-float *backend*) + exact)) (t (any))))) (t @@ -299,10 +317,15 @@ (values (primitive-type-or-lose 'complex-single-float *backend*) exact)) - ((double-float long-float) + ((double-float #-long-float long-float) (values (primitive-type-or-lose 'complex-double-float *backend*) exact)) + #+long-float + (long-float + (values (primitive-type-or-lose 'complex-long-float + *backend*) + exact)) (t (part-of complex)))) (part-of complex)) diff --git a/compiler/generic/vm-fndb.lisp b/compiler/generic/vm-fndb.lisp index 07a8ffbb9191fc9a6eeaa5b6410d1bc3d8983aef..ca765b512a27bb03c4d875f9d0defdb3c41131c8 100644 --- a/compiler/generic/vm-fndb.lisp +++ b/compiler/generic/vm-fndb.lisp @@ -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/generic/vm-fndb.lisp,v 1.59 1998/03/03 17:35:22 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-fndb.lisp,v 1.60 1998/03/21 07:55:55 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -51,6 +51,7 @@ #+complex-float complex-rational-p #+complex-float complex-float-p #+complex-float complex-single-float-p #+complex-float complex-double-float-p + #+(and complex-float long-float) complex-long-float-p base-char-p %standard-char-p %instancep array-header-p simple-array-p simple-array-unsigned-byte-2-p simple-array-unsigned-byte-4-p simple-array-unsigned-byte-8-p @@ -60,8 +61,10 @@ #+signed-array simple-array-signed-byte-30-p #+signed-array simple-array-signed-byte-32-p simple-array-single-float-p simple-array-double-float-p + #+long-float simple-array-long-float-p #+complex-float simple-array-complex-single-float-p #+complex-float simple-array-complex-double-float-p + #+(and complex-float long-float) simple-array-complex-long-float-p system-area-pointer-p realp unsigned-byte-32-p signed-byte-32-p weak-pointer-p scavenger-hook-p code-component-p lra-p funcallable-instance-p dylan::dylan-function-p) @@ -120,14 +123,15 @@ (foldable flushable)) (defknown %raw-ref-double (raw-vector index) double-float (foldable flushable)) +#+long-float +(defknown %raw-ref-long (raw-vector index) long-float + (foldable flushable)) (defknown %raw-set-single (raw-vector index single-float) single-float (unsafe)) (defknown %raw-set-double (raw-vector index double-float) double-float (unsafe)) - -(defknown %raw-bits (t fixnum) (unsigned-byte 32) - (foldable flushable)) -(defknown (%set-raw-bits) (t fixnum (unsigned-byte 32)) (unsigned-byte 32) +#+long-float +(defknown %raw-set-long (raw-vector index long-float) long-float (unsafe)) #+complex-float @@ -151,6 +155,11 @@ (unsafe)) ) ; end progn complex-float +(defknown %raw-bits (t fixnum) (unsigned-byte 32) + (foldable flushable)) +(defknown (%set-raw-bits) (t fixnum (unsigned-byte 32)) (unsigned-byte 32) + (unsafe)) + (defknown allocate-vector ((unsigned-byte 8) index index) (simple-array * (*)) (flushable movable)) diff --git a/compiler/generic/vm-tran.lisp b/compiler/generic/vm-tran.lisp index 114a49cc4ad010a6c659961571fda9756734d0a2..ae86f4356479123e45c5b011e68d01f573b1571c 100644 --- a/compiler/generic/vm-tran.lisp +++ b/compiler/generic/vm-tran.lisp @@ -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/generic/vm-tran.lisp,v 1.35 1997/01/18 14:31:17 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-tran.lisp,v 1.36 1998/03/21 07:55:55 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -20,6 +20,7 @@ ;;; equivalent types. ;;; (def-source-transform short-float-p (x) `(single-float-p ,x)) +#-long-float (def-source-transform long-float-p (x) `(double-float-p ,x)) (def-source-transform compiled-function-p (x) diff --git a/compiler/generic/vm-type.lisp b/compiler/generic/vm-type.lisp index 367cd379f5eef193065c613341b09da51775a618..f95c2332a1effed094a1805bb80a375ccb18c884 100644 --- a/compiler/generic/vm-type.lisp +++ b/compiler/generic/vm-type.lisp @@ -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/generic/vm-type.lisp,v 1.35 1998/01/25 15:11:21 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-type.lisp,v 1.36 1998/03/21 07:55:56 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -24,7 +24,9 @@ ;;; This is be expanded before the translator gets a chance, so we will get ;;; precedence. ;;; +#-long-float (setf (info type kind 'long-float) :defined) +#-long-float (deftype long-float (&optional low high) `(double-float ,low ,high)) ;;; @@ -44,8 +46,12 @@ ;;; ;;; Worst case values for float attributes. ;;; -(deftype float-exponent () 'double-float-exponent) -(deftype float-digits () `(integer 0 ,vm:double-float-digits)) +(deftype float-exponent () + #-long-float 'double-float-exponent + #+long-float 'long-float-exponent) +(deftype float-digits () + #-long-float `(integer 0 ,vm:double-float-digits) + #+long-float `(integer 0 ,vm:long-float-digits)) (deftype float-radix () '(integer 2 2)) ;;; ;;; A code for Boole. @@ -92,7 +98,9 @@ #+signed-array (signed-byte 30) #+signed-array (signed-byte 32) #+complex-float (complex single-float) #+complex-float (complex double-float) - base-char single-float double-float)) + #+(and complex-float long-float) (complex long-float) + base-char single-float double-float + #+long-float long-float)) (deftype unboxed-array (&optional dims) (collect ((types (list 'or))) @@ -119,7 +127,8 @@ (defun float-format-name (x) (etypecase x (single-float 'single-float) - (double-float 'double-float))) + (double-float 'double-float) + #+long-float (long-float 'long-float))) ;;; Specialize-Array-Type -- Internal ;;; diff --git a/compiler/generic/vm-typetran.lisp b/compiler/generic/vm-typetran.lisp index 6e2a660f9eca83d23e11147ca0dbc7d1b6540384..b105664857cf22fb77af0ee8365974d5a0aee179 100644 --- a/compiler/generic/vm-typetran.lisp +++ b/compiler/generic/vm-typetran.lisp @@ -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/generic/vm-typetran.lisp,v 1.14 1998/02/03 19:22:23 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-typetran.lisp,v 1.15 1998/03/21 07:55:56 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -31,6 +31,8 @@ (define-type-predicate complex-double-float-p (complex double-float)) #+complex-float (define-type-predicate complex-single-float-p (complex single-float)) +#+(and complex-float long-float) +(define-type-predicate complex-long-float-p (complex long-float)) (define-type-predicate double-float-p double-float) (define-type-predicate fixnump fixnum) (define-type-predicate long-float-p long-float) @@ -64,12 +66,18 @@ (simple-array single-float (*))) (define-type-predicate simple-array-double-float-p (simple-array double-float (*))) +#+long-float +(define-type-predicate simple-array-long-float-p + (simple-array long-float (*))) #+complex-float (define-type-predicate simple-array-complex-single-float-p (simple-array (complex single-float) (*))) #+complex-float (define-type-predicate simple-array-complex-double-float-p (simple-array (complex double-float) (*))) +#+(and complex-float long-float) +(define-type-predicate simple-array-complex-long-float-p + (simple-array (complex long-float) (*))) (define-type-predicate system-area-pointer-p system-area-pointer) (define-type-predicate unsigned-byte-32-p (unsigned-byte 32)) (define-type-predicate signed-byte-32-p (signed-byte 32))