From c270f65ca9b263e4807cb0c1081e0ae6967e2beb Mon Sep 17 00:00:00 2001 From: Douglas Katzman Date: Mon, 28 Jan 2019 16:43:40 -0500 Subject: [PATCH] Change all #!+long-float to #+long-float For a feature that has not worked since forever ago, this was probably the biggest offender in terms of lines needing conditionalization. --- src/code/array.lisp | 8 +- src/code/bignum.lisp | 2 +- src/code/class.lisp | 4 +- src/code/coerce.lisp | 4 +- src/code/debug-int.lisp | 16 +-- src/code/defsetfs.lisp | 2 +- src/code/early-extensions.lisp | 4 +- src/code/early-float.lisp | 12 +- src/code/early-raw-slots.lisp | 4 +- src/code/early-type.lisp | 4 +- src/code/float.lisp | 38 +++--- src/code/fop.lisp | 4 +- src/code/irrat.lisp | 24 ++-- src/code/late-type.lisp | 6 +- src/code/numbers.lisp | 48 +++---- src/code/pred.lisp | 4 +- src/code/print.lisp | 18 +-- src/code/reader.lisp | 2 +- src/code/target-format.lisp | 4 +- src/code/target-random.lisp | 4 +- src/code/target-sxhash.lisp | 6 +- src/code/unportable-float.lisp | 2 +- src/compiler/dump.lisp | 4 +- src/compiler/float-tran.lisp | 6 +- src/compiler/generic/early-objdef.lisp | 2 +- src/compiler/generic/genesis.lisp | 2 +- src/compiler/generic/interr.lisp | 4 +- src/compiler/generic/late-type-vops.lisp | 12 +- src/compiler/generic/objdef.lisp | 2 +- src/compiler/generic/vm-array.lisp | 2 +- src/compiler/generic/vm-fndb.lisp | 6 +- src/compiler/generic/vm-tran.lisp | 2 +- src/compiler/generic/vm-type.lisp | 14 +- src/compiler/generic/vm-typetran.lisp | 6 +- src/compiler/saptran.lisp | 4 +- src/compiler/sparc/array.lisp | 8 +- src/compiler/sparc/c-call.lisp | 6 +- src/compiler/sparc/float.lisp | 100 +++++++------- src/compiler/sparc/insts.lisp | 2 +- src/compiler/sparc/sap.lisp | 2 +- src/compiler/sparc/vm.lisp | 8 +- src/compiler/srctran.lisp | 10 +- src/compiler/typetran.lisp | 2 +- src/compiler/x86/c-call.lisp | 6 +- src/compiler/x86/float.lisp | 164 +++++++++++------------ src/compiler/x86/sap.lisp | 10 +- src/compiler/x86/vm.lisp | 10 +- 47 files changed, 307 insertions(+), 307 deletions(-) diff --git a/src/code/array.lisp b/src/code/array.lisp index 5c3477985..200c4999c 100644 --- a/src/code/array.lisp +++ b/src/code/array.lisp @@ -218,7 +218,7 @@ (%integer-vector-widetag-and-n-bits-shift nil (integer-length (1- (cadr type)))) (ill-type))) - #!+long-float + #+long-float (long-float (with-parameters (long-float :intervals t) (low high) (if (and (not (eq low '*)) @@ -257,7 +257,7 @@ ((csubtypep ctype (specifier-type '(complex single-float))) (result simple-array-complex-single-float-widetag)) - #!+long-float + #+long-float ((csubtypep ctype (specifier-type '(complex long-float))) (result simple-array-complex-long-float-widetag)) @@ -271,7 +271,7 @@ (single-float (result simple-array-complex-single-float-widetag)) - #!+long-float + #+long-float (long-float (result simple-array-complex-long-float-widetag)) @@ -309,7 +309,7 @@ (result simple-array-double-float-widetag)) ((csubtypep ctype (specifier-type 'single-float)) (result simple-array-single-float-widetag)) - #!+long-float + #+long-float ((csubtypep ctype (specifier-type 'long-float)) (result simple-array-long-float-widetag)) ((csubtypep ctype (specifier-type 'complex-double-float)) diff --git a/src/code/bignum.lisp b/src/code/bignum.lisp index 24cc14e7a..ae9a09942 100644 --- a/src/code/bignum.lisp +++ b/src/code/bignum.lisp @@ -1234,7 +1234,7 @@ (check-exponent len sb-vm:double-float-bias sb-vm:double-float-normal-exponent-max) plusp)) - #!+long-float + #+long-float (long-float (long-float-from-bits bits diff --git a/src/code/class.lisp b/src/code/class.lisp index 4b0379b38..ff8bb9f16 100644 --- a/src/code/class.lisp +++ b/src/code/class.lisp @@ -928,7 +928,7 @@ between the ~A definition and the ~A definition" :inherits (complex number) :codes (,sb-vm:complex-double-float-widetag) :prototype-form (complex 42d0 42d0)) - #!+long-float + #+long-float (complex-long-float :translation (complex long-float) :inherits (complex number) @@ -961,7 +961,7 @@ between the ~A definition and the ~A definition" :inherits (float real number) :codes (,sb-vm:double-float-widetag) :prototype-form 42d0) - #!+long-float + #+long-float (long-float :translation long-float :inherits (float real number) diff --git a/src/code/coerce.lisp b/src/code/coerce.lisp index 74de9cd92..6f1ec7476 100644 --- a/src/code/coerce.lisp +++ b/src/code/coerce.lisp @@ -145,7 +145,7 @@ (unless (typep res output-type-spec) (coerce-error)) res)) - #!+long-float + #+long-float ((csubtypep type (specifier-type 'long-float)) (let ((res (%long-float object))) (unless (typep res output-type-spec) @@ -165,7 +165,7 @@ ((csubtypep type (specifier-type '(complex double-float))) (complex (%double-float (realpart object)) (%double-float (imagpart object)))) - #!+long-float + #+long-float ((csubtypep type (specifier-type '(complex long-float))) (complex (%long-float (realpart object)) (%long-float (imagpart object)))) diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index cfa81953f..0b92097f8 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -2386,14 +2386,14 @@ register." (escaped-float-value single-float)) (#.sb-vm:double-reg-sc-number (escaped-float-value double-float)) - #!+long-float + #+long-float (#.sb-vm:long-reg-sc-number (escaped-float-value long-float)) (#.sb-vm:complex-single-reg-sc-number (escaped-float-value complex-single-float)) (#.sb-vm:complex-double-reg-sc-number (escaped-float-value complex-double-float)) - #!+long-float + #+long-float (#.sb-vm:complex-long-reg-sc-number (escaped-float-value sb-kernel::complex-long-float)) (#.sb-vm:single-stack-sc-number @@ -2402,7 +2402,7 @@ register." (#.sb-vm:double-stack-sc-number (with-nfp (nfp) (sap-ref-double nfp (number-stack-offset)))) - #!+long-float + #+long-float (#.sb-vm:long-stack-sc-number (with-nfp (nfp) (sap-ref-long nfp (number-stack-offset)))) @@ -2416,7 +2416,7 @@ register." (complex (sap-ref-double nfp (number-stack-offset)) (sap-ref-double nfp (number-stack-offset 8))))) - #!+long-float + #+long-float (#.sb-vm:complex-long-stack-sc-number (with-nfp (nfp) (complex @@ -2564,14 +2564,14 @@ register." (set-escaped-float-value single-float value)) (#.sb-vm:double-reg-sc-number (set-escaped-float-value double-float value)) - #!+long-float + #+long-float (#.sb-vm:long-reg-sc-number (set-escaped-float-value long-float value)) (#.sb-vm:complex-single-reg-sc-number (set-escaped-float-value complex-single-float value)) (#.sb-vm:complex-double-reg-sc-number (set-escaped-float-value complex-double-float value)) - #!+long-float + #+long-float (#.sb-vm:complex-long-reg-sc-number (set-escaped-float-value complex-long-float)) (#.sb-vm:single-stack-sc-number @@ -2582,7 +2582,7 @@ register." (with-nfp (nfp) (setf (sap-ref-double nfp (number-stack-offset)) (the double-float value)))) - #!+long-float + #+long-float (#.sb-vm:long-stack-sc-number (with-nfp (nfp) (setf (sap-ref-long nfp (number-stack-offset)) @@ -2611,7 +2611,7 @@ register." (imagpart (the (complex double-float) value)) #!-(or x86 x86-64) (the double-float (realpart value))))) - #!+long-float + #+long-float (#.sb-vm:complex-long-stack-sc-number (with-nfp (nfp) (setf (sap-ref-long diff --git a/src/code/defsetfs.lisp b/src/code/defsetfs.lisp index 4c270dbda..1481cbfa5 100644 --- a/src/code/defsetfs.lisp +++ b/src/code/defsetfs.lisp @@ -179,7 +179,7 @@ (defsetf sap-ref-lispobj %set-sap-ref-lispobj) (defsetf sap-ref-single %set-sap-ref-single) (defsetf sap-ref-double %set-sap-ref-double) -#!+long-float (defsetf sap-ref-long %set-sap-ref-long) +#+long-float (defsetf sap-ref-long %set-sap-ref-long) (defsetf subseq (sequence start &optional end) (v) `(progn (replace ,sequence ,v :start1 ,start :end1 ,end) ,v)) diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index 16686596d..bbe56c9e4 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -1564,7 +1564,7 @@ to :INTERPRET, an interpreter will be used.") (typecase x (single-float (zerop x)) (double-float (zerop x)) - #!+long-float + #+long-float (long-float (zerop x)) (t nil))) @@ -1578,7 +1578,7 @@ to :INTERPRET, an interpreter will be used.") (if (eql x 0.0d0) (make-unportable-float :double-float-negative-zero) 0.0d0)) - #!+long-float + #+long-float (long-float (if (eql x 0.0l0) (make-unportable-float :long-float-negative-zero) diff --git a/src/code/early-float.lisp b/src/code/early-float.lisp index 500ae38e5..0c48f2fbf 100644 --- a/src/code/early-float.lisp +++ b/src/code/early-float.lisp @@ -55,12 +55,12 @@ (defconstant least-negative-single-float (single-from-bits 1 0 1)) (defconstant least-negative-short-float (single-from-bits 1 0 1)) (defconstant least-positive-double-float (double-from-bits 0 0 1)) -#!-long-float +#-long-float (defconstant least-positive-long-float (double-from-bits 0 0 1)) #!+(and long-float x86) (defconstant least-positive-long-float (long-from-bits 0 0 1)) (defconstant least-negative-double-float (double-from-bits 1 0 1)) -#!-long-float +#-long-float (defconstant least-negative-long-float (double-from-bits 1 0 1)) #!+(and long-float x86) (defconstant least-negative-long-float (long-from-bits 1 0 1)) @@ -75,7 +75,7 @@ least-negative-normalized-single-float) (defconstant least-positive-normalized-double-float (double-from-bits 0 sb-vm:double-float-normal-exponent-min 0)) -#!-long-float +#-long-float (defconstant least-positive-normalized-long-float least-positive-normalized-double-float) #!+(and long-float x86) @@ -84,7 +84,7 @@ (ash sb-vm:long-float-hidden-bit 32))) (defconstant least-negative-normalized-double-float (double-from-bits 1 sb-vm:double-float-normal-exponent-min 0)) -#!-long-float +#-long-float (defconstant least-negative-normalized-long-float least-negative-normalized-double-float) #!+(and long-float x86) @@ -159,7 +159,7 @@ (defconstant double-float-epsilon (double-from-bits 0 (- sb-vm:double-float-bias (1- sb-vm:double-float-digits)) 1)) -#!-long-float +#-long-float (defconstant long-float-epsilon double-float-epsilon) #!+(and long-float x86) (defconstant long-float-epsilon @@ -167,7 +167,7 @@ (+ 1 (ash sb-vm:long-float-hidden-bit 32)))) (defconstant double-float-negative-epsilon (double-from-bits 0 (- sb-vm:double-float-bias sb-vm:double-float-digits) 1)) -#!-long-float +#-long-float (defconstant long-float-negative-epsilon double-float-negative-epsilon) #!+(and long-float x86) (defconstant long-float-negative-epsilon diff --git a/src/code/early-raw-slots.lisp b/src/code/early-raw-slots.lisp index d617457a1..ddaea6cab 100644 --- a/src/code/early-raw-slots.lisp +++ b/src/code/early-raw-slots.lisp @@ -144,12 +144,12 @@ :init-vop 'sb-vm::raw-instance-init/complex-double :alignment double-float-alignment :n-words (/ 16 sb-vm:n-word-bytes)) - #!+long-float + #+long-float (make-raw-slot-data :raw-type long-float :accessor-name '%raw-instance-ref/long :init-vop 'sb-vm::raw-instance-init/long :n-words #!+x86 3 #!+sparc 4) - #!+long-float + #+long-float (make-raw-slot-data :raw-type complex-long-float :accessor-name '%raw-instance-ref/complex-long :init-vop 'sb-vm::raw-instance-init/complex-long diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp index 5b98f1b15..79158bbfa 100644 --- a/src/code/early-type.lisp +++ b/src/code/early-type.lisp @@ -356,7 +356,7 @@ (return-from make-numeric-type (if (bounds-unbounded-p low high) (specifier-type 'float) - (unionize (single-float double-float #!+long-float (error "long-float")) + (unionize (single-float double-float #+long-float (error "long-float")) (:class 'float :format thing)))))) (multiple-value-bind (low high) (case class @@ -624,7 +624,7 @@ (etypecase z (single-float 0) (double-float 2 - #!+long-float (long-float 4))))) + #+long-float (long-float 4))))) (if (= pass 0) (setf (ldb (byte 1 (+ pair-idx sign)) presence) 1) (if (= (ldb (byte 2 pair-idx) presence) #b11) diff --git a/src/code/float.lisp b/src/code/float.lisp index 067466f7b..409ddb721 100644 --- a/src/code/float.lisp +++ b/src/code/float.lisp @@ -129,7 +129,7 @@ ((double-float) (frob sb-vm:double-float-digits sb-vm:double-float-bias integer-decode-double-denorm)) - #!+long-float + #+long-float ((long-float) (frob sb-vm:long-float-digits sb-vm:long-float-bias integer-decode-long-denorm))))) @@ -142,7 +142,7 @@ (* (if (etypecase float1 (single-float (minusp (single-float-bits float1))) (double-float (minusp (double-float-high-bits float1))) - #!+long-float + #+long-float (long-float (minusp (long-float-exp-bits float1)))) (float -1 float1) (float 1 float1)) @@ -151,8 +151,8 @@ (defun float-format-digits (format) (ecase format ((short-float single-float) sb-vm:single-float-digits) - ((double-float #!-long-float long-float) sb-vm:double-float-digits) - #!+long-float + ((double-float #-long-float long-float) sb-vm:double-float-digits) + #+long-float (long-float sb-vm:long-float-digits))) #!-sb-fluid (declaim (inline float-digits float-radix)) @@ -162,7 +162,7 @@ (number-dispatch ((f float)) ((single-float) sb-vm:single-float-digits) ((double-float) sb-vm:double-float-digits) - #!+long-float + #+long-float ((long-float) sb-vm:long-float-digits))) (defun float-radix (x) @@ -357,7 +357,7 @@ (integer-decode-single-float x)) ((double-float) (integer-decode-double-float x)) - #!+long-float + #+long-float ((long-float) (integer-decode-long-float x)))) @@ -477,7 +477,7 @@ (decode-single-float f)) ((double-float) (decode-double-float f)) - #!+long-float + #+long-float ((long-float) (decode-long-float f)))) @@ -609,7 +609,7 @@ (scale-single-float f ex)) ((double-float) (scale-double-float f ex)) - #!+long-float + #+long-float ((long-float) (scale-long-float f ex)))) @@ -622,8 +622,8 @@ (declare (explicit-check)) (if otherp (number-dispatch ((number real) (other float)) - (((foreach rational single-float double-float #!+long-float long-float) - (foreach single-float double-float #!+long-float long-float)) + (((foreach rational single-float double-float #+long-float long-float) + (foreach single-float double-float #+long-float long-float)) (coerce number '(dispatch-type other)))) (if (floatp number) number @@ -632,7 +632,7 @@ (macrolet ((frob (name type) `(defun ,name (x) (number-dispatch ((x real)) - (((foreach single-float double-float #!+long-float long-float + (((foreach single-float double-float #+long-float long-float sb-vm:signed-word ,@(and (sb-c::template-translates-arg-p '%double-float 0 'word) '(word)))) @@ -643,7 +643,7 @@ (bignum-to-float x ',type)))))) (frob %single-float single-float) (frob %double-float double-float) - #!+long-float + #+long-float (frob %long-float long-float)) ;;; Convert a ratio to a float. We avoid any rounding error by doing an @@ -689,7 +689,7 @@ (single-from-bits sign sb-vm:single-float-bias bits)) (double-float (double-from-bits sign sb-vm:double-float-bias bits)) - #!+long-float + #+long-float (long-float (long-from-bits sign sb-vm:long-float-bias bits)))))) (loop @@ -781,7 +781,7 @@ (number-dispatch ((number real)) ((integer) number) ((ratio) (values (truncate (numerator number) (denominator number)))) - (((foreach single-float double-float #!+long-float long-float)) + (((foreach single-float double-float #+long-float long-float)) (if (and (<= (float most-negative-fixnum number) number) (< number (float most-positive-fixnum number))) (truly-the fixnum (%unary-truncate number)) @@ -805,7 +805,7 @@ res))))))) (def single-float %unary-truncate/single-float) (def double-float %unary-truncate/double-float) - #!+long-float + #+long-float (def double-float %unary-truncate/long-float)) ;;; Similar to %UNARY-TRUNCATE, but rounds to the nearest integer. If we @@ -818,7 +818,7 @@ (number-dispatch ((number real)) ((integer) number) ((ratio) (values (round (numerator number) (denominator number)))) - (((foreach single-float double-float #!+long-float long-float)) + (((foreach single-float double-float #+long-float long-float)) (if (< (float most-negative-fixnum number) number (float most-positive-fixnum number)) @@ -841,7 +841,7 @@ (number-dispatch ((number real)) ((integer) (float number)) ((ratio) (float (truncate (numerator number) (denominator number)))) - (((foreach single-float double-float #!+long-float long-float)) + (((foreach single-float double-float #+long-float long-float)) (%unary-ftruncate number)))) (defun rational (x) @@ -850,7 +850,7 @@ completely accurate, giving a result that isn't as pretty." (declare (explicit-check)) (number-dispatch ((x real)) - (((foreach single-float double-float #!+long-float long-float)) + (((foreach single-float double-float #+long-float long-float)) (multiple-value-bind (bits exp) (integer-decode-float x) (if (eql bits 0) 0 @@ -929,7 +929,7 @@ (= x (float (rationalize x) x))" (declare (explicit-check)) (number-dispatch ((x real)) - (((foreach single-float double-float #!+long-float long-float)) + (((foreach single-float double-float #+long-float long-float)) ;; This is a fairly straigtforward implementation of the ;; iterative algorithm above. (multiple-value-bind (frac expo sign) diff --git a/src/code/fop.lisp b/src/code/fop.lisp index 116334ab6..cad1133d9 100644 --- a/src/code/fop.lisp +++ b/src/code/fop.lisp @@ -347,11 +347,11 @@ (,reader)))))) (define-complex-fop 72 fop-complex-single-float single-float) (define-complex-fop 73 fop-complex-double-float double-float) - #!+long-float + #+long-float (define-complex-fop 67 fop-complex-long-float long-float) (define-float-fop 46 fop-single-float single-float) (define-float-fop 47 fop-double-float double-float) - #!+long-float + #+long-float (define-float-fop 52 fop-long-float long-float))) #!+sb-simd-pack diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index 9f162e040..c7cd69d28 100644 --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -15,8 +15,8 @@ ;;;; miscellaneous constants, utility functions, and macros (defconstant pi - #!+long-float 3.14159265358979323846264338327950288419716939937511l0 - #!-long-float 3.14159265358979323846264338327950288419716939937511d0) + #+long-float 3.14159265358979323846264338327950288419716939937511l0 + #-long-float 3.14159265358979323846264338327950288419716939937511d0) (eval-when (:compile-toplevel :load-toplevel :execute) (defun handle-reals (function var) @@ -778,7 +778,7 @@ ;;; Create complex number with real part X and imaginary part Y ;;; such that has the same type as Z. If Z has type (complex ;;; rational), the X and Y are coerced to single-float. -#!+long-float (eval-when (:compile-toplevel :load-toplevel :execute) +#+long-float (eval-when (:compile-toplevel :load-toplevel :execute) (error "needs work for long float support")) (declaim (inline coerce-to-complex-type)) (defun coerce-to-complex-type (x y z) @@ -794,7 +794,7 @@ ;;; Compute |(x+i*y)/2^k|^2 scaled to avoid over/underflow. The ;;; result is r + i*k, where k is an integer. -#!+long-float (eval-when (:compile-toplevel :load-toplevel :execute) +#+long-float (eval-when (:compile-toplevel :load-toplevel :execute) (error "needs work for long float support")) (defun cssqs (z) (declare (muffle-conditions compiler-note)) @@ -818,9 +818,9 @@ ((let ((threshold ;; (/ least-positive-double-float double-float-epsilon) (load-time-value - #!-long-float + #-long-float (make-double-float #x1fffff #xfffffffe) - #!+long-float + #+long-float (error "(/ least-positive-long-float long-float-epsilon)"))) (traps (ldb sb-vm:float-sticky-bits (sb-vm:floating-point-modes)))) @@ -896,9 +896,9 @@ ;; choose them. We'll just assume his choices matches our ;; implementation of log1p. (let ((t0 (load-time-value - #!-long-float + #-long-float (make-double-float #x3fe6a09e #x667f3bcd) - #!+long-float + #+long-float (error "(/ (sqrt 2l0))"))) ;; KLUDGE: if repeatable fasls start failing under some weird ;; xc host, this 1.2d0 might be a good place to examine: while @@ -907,9 +907,9 @@ (t1 1.2d0) (t2 3d0) (ln2 (load-time-value - #!-long-float + #-long-float (make-double-float #x3fe62e42 #xfefa39ef) - #!+long-float + #+long-float (error "(log 2l0)"))) (x (float (realpart z) 1.0d0)) (y (float (imagpart z) 1.0d0))) @@ -1004,9 +1004,9 @@ (declare (optimize (speed 3) (space 0))) (cond ((> (abs x) (load-time-value - #!-long-float + #-long-float (make-double-float #x406633ce #x8fb9f87e) - #!+long-float + #+long-float (error "(/ (+ (log 2l0) (log most-positive-long-float)) 4l0)"))) (coerce-to-complex-type (float-sign x) (float-sign y) z)) diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index b3808a47d..7f511f884 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -2324,7 +2324,7 @@ used for a COMPLEX component.~:@>" ,(coerced-float-bound high 'single-float t)) (double-float ,(coerced-float-bound low 'double-float nil) ,(coerced-float-bound high 'double-float t)) - #!+long-float ,(error "stub: no long float support yet")))) + #+long-float ,(error "stub: no long float support yet")))) (macrolet ((define-float-format (f) `(!def-bounded-type ,f float ,f))) (define-float-format single-float) @@ -2503,13 +2503,13 @@ used for a COMPLEX component.~:@>" ((nil) ;; A double-float with any real number is a ;; double-float. - #!-long-float + #-long-float (if (eq format1 'double-float) 'double-float nil) ;; A long-float with any real number is a ;; long-float. - #!+long-float + #+long-float (if (eq format1 'long-float) 'long-float nil))) diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp index a2f470800..98f41903e 100644 --- a/src/code/numbers.lisp +++ b/src/code/numbers.lisp @@ -48,7 +48,7 @@ ;;; our guess for the preferred order in which to do type tests ;;; (cheaper and/or more probable first.) (defconstant-eqx +type-test-ordering+ - '(fixnum single-float double-float integer #!+long-float long-float + '(fixnum single-float double-float integer #+long-float long-float sb-vm:signed-word word bignum complex ratio) #'equal) @@ -179,15 +179,15 @@ (defun float-contagion (op x y &optional (rat-types '(fixnum bignum ratio))) `(((single-float single-float) (,op ,x ,y)) (((foreach ,@rat-types) - (foreach single-float double-float #!+long-float long-float)) + (foreach single-float double-float #+long-float long-float)) (,op (coerce ,x '(dispatch-type ,y)) ,y)) - (((foreach single-float double-float #!+long-float long-float) + (((foreach single-float double-float #+long-float long-float) (foreach ,@rat-types)) (,op ,x (coerce ,y '(dispatch-type ,x)))) - #!+long-float + #+long-float (((foreach single-float double-float long-float) long-float) (,op (coerce ,x 'long-float) ,y)) - #!+long-float + #+long-float ((long-float (foreach single-float double-float)) (,op ,x (coerce ,y 'long-float))) (((foreach single-float double-float) double-float) @@ -216,7 +216,7 @@ (defun canonical-complex (realpart imagpart) (if (eql imagpart 0) realpart - (cond #!+long-float + (cond #+long-float ((and (typep realpart 'long-float) (typep imagpart 'long-float)) (truly-the (complex long-float) (complex realpart imagpart))) @@ -259,7 +259,7 @@ "Return a complex number with the specified real and imaginary components." (declare (explicit-check)) (flet ((%%make-complex (realpart imagpart) - (cond #!+long-float + (cond #+long-float ((and (typep realpart 'long-float) (typep imagpart 'long-float)) (truly-the (complex long-float) @@ -282,7 +282,7 @@ (defun realpart (number) "Extract the real part of a number." (etypecase number - #!+long-float + #+long-float ((complex long-float) (truly-the long-float (realpart number))) ((complex double-float) @@ -297,7 +297,7 @@ (defun imagpart (number) "Extract the imaginary part of a number." (etypecase number - #!+long-float + #+long-float ((complex long-float) (truly-the long-float (imagpart number))) ((complex double-float) @@ -406,7 +406,7 @@ (canonical-complex (,op (realpart x) (realpart y)) (,op (imagpart x) (imagpart y)))) (((foreach bignum fixnum ratio single-float double-float - #!+long-float long-float) complex) + #+long-float long-float) complex) (complex (,op x (realpart y)) (,op 0 (imagpart y)))) ((complex (or rational float)) (complex (,op (realpart x) y) (,op (imagpart x) 0))) @@ -471,7 +471,7 @@ (iy (imagpart y))) (canonical-complex (- (* rx ry) (* ix iy)) (+ (* rx iy) (* ix ry))))) (((foreach bignum fixnum ratio single-float double-float - #!+long-float long-float) + #+long-float long-float) complex) (complex*real y x)) ((complex (or rational float)) @@ -575,7 +575,7 @@ (defun %negate (n) (declare (explicit-check)) (number-dispatch ((n number)) - (((foreach fixnum single-float double-float #!+long-float long-float)) + (((foreach fixnum single-float double-float #+long-float long-float)) (%negate n)) ((bignum) (negate-bignum n)) @@ -616,16 +616,16 @@ ((bignum bignum) (bignum-truncate number divisor)) - (((foreach single-float double-float #!+long-float long-float) + (((foreach single-float double-float #+long-float long-float) (or rational single-float)) (if (eql divisor 1) (let ((res (%unary-truncate number))) (values res (- number (coerce res '(dispatch-type number))))) (truncate-float (dispatch-type number)))) - #!+long-float + #+long-float ((long-float (or single-float double-float long-float)) (truncate-float long-float)) - #!+long-float + #+long-float (((foreach double-float single-float) long-float) (truncate-float long-float)) ((double-float (or single-float double-float)) @@ -633,7 +633,7 @@ ((single-float double-float) (truncate-float double-float)) (((foreach fixnum bignum ratio) - (foreach single-float double-float #!+long-float long-float)) + (foreach single-float double-float #+long-float long-float)) (truncate-float (dispatch-type divisor)))))) (defun %multiply-high (x y) @@ -710,16 +710,16 @@ (multiple-value-bind (q r) (truncate number divisor) (values (float q) r))) - (((foreach single-float double-float #!+long-float long-float) + (((foreach single-float double-float #+long-float long-float) (or rational single-float)) (if (eql divisor 1) (let ((res (%unary-ftruncate number))) (values res (- number (coerce res '(dispatch-type number))))) (ftruncate-float (dispatch-type number)))) - #!+long-float + #+long-float ((long-float (or single-float double-float long-float)) (ftruncate-float long-float)) - #!+long-float + #+long-float (((foreach double-float single-float) long-float) (ftruncate-float long-float)) ((double-float (or single-float double-float)) @@ -727,7 +727,7 @@ ((single-float double-float) (ftruncate-float double-float)) (((foreach fixnum bignum ratio) - (foreach single-float double-float #!+long-float long-float)) + (foreach single-float double-float #+long-float long-float)) (ftruncate-float (dispatch-type divisor)))))) (defun ffloor (number &optional (divisor 1)) @@ -865,10 +865,10 @@ the first." (defun basic-compare (op &key infinite-x-finite-y infinite-y-finite-x) `(((fixnum fixnum) (,op x y)) ((single-float single-float) (,op x y)) - #!+long-float + #+long-float (((foreach single-float double-float long-float) long-float) (,op (coerce x 'long-float) y)) - #!+long-float + #+long-float ((long-float (foreach single-float double-float)) (,op x (coerce y 'long-float))) ((fixnum (foreach single-float double-float)) @@ -890,7 +890,7 @@ the first." (,op (coerce x 'double-float) y)) ((double-float single-float) (,op x (coerce y 'double-float))) - (((foreach single-float double-float #!+long-float long-float) rational) + (((foreach single-float double-float #+long-float long-float) rational) (if (eql y 0) (,op x (coerce 0 '(dispatch-type x))) (if (float-infinity-p x) @@ -961,7 +961,7 @@ the first." (and (= (realpart x) (realpart y)) (= (imagpart x) (imagpart y)))) (((foreach fixnum bignum ratio single-float double-float - #!+long-float long-float) complex) + #+long-float long-float) complex) (and (= x (realpart y)) (zerop (imagpart y)))) ((complex (or float rational)) diff --git a/src/code/pred.lisp b/src/code/pred.lisp index 46d715730..72f5e1fee 100644 --- a/src/code/pred.lisp +++ b/src/code/pred.lisp @@ -117,7 +117,7 @@ (def-type-predicate-wrapper complexp) (def-type-predicate-wrapper complex-double-float-p) (def-type-predicate-wrapper complex-float-p) - #!+long-float (def-type-predicate-wrapper complex-long-float-p) + #+long-float (def-type-predicate-wrapper complex-long-float-p) (def-type-predicate-wrapper complex-rational-p) (def-type-predicate-wrapper complex-single-float-p) ;; (COMPLEX-VECTOR-P is not included here since it's awkward to express @@ -304,7 +304,7 @@ (foo (single-float eql) (double-float eql) - #!+long-float + #+long-float (long-float eql) (bignum #!-integer-eql-vop (lambda (x y) (zerop (bignum-compare x y))) diff --git a/src/code/print.lisp b/src/code/print.lisp index e7990d4bb..43cbc8501 100644 --- a/src/code/print.lisp +++ b/src/code/print.lisp @@ -1264,7 +1264,7 @@ variable: an unreadable object representing the error is printed instead.") (- 2 sb-vm:single-float-bias sb-vm:single-float-digits)) (defconstant double-float-min-e (- 2 sb-vm:double-float-bias sb-vm:double-float-digits)) -#!+long-float +#+long-float (defconstant long-float-min-e (nth-value 1 (decode-float least-positive-long-float))) @@ -1283,7 +1283,7 @@ variable: an unreadable object representing the error is printed instead.") (etypecase float (single-float single-float-min-e) (double-float double-float-min-e) - #!+long-float + #+long-float (long-float long-float-min-e)))) (multiple-value-bind (f e) (integer-decode-float float) @@ -1442,7 +1442,7 @@ variable: an unreadable object representing the error is printed instead.") (eval-when (:compile-toplevel :execute) (setf *read-default-float-format* - #!+long-float 'long-float #!-long-float 'double-float)) + #+long-float 'long-float #-long-float 'double-float)) (defun scale-exponent (original-x) (let* ((x (coerce original-x 'long-float))) (multiple-value-bind (sig exponent) (decode-float x) @@ -1461,15 +1461,15 @@ variable: an unreadable object representing the error is printed instead.") ;; ulp in this value, which is a ;; little unfortunate.) (load-time-value - #!-long-float + #-long-float (make-double-float 1070810131 1352628735) - #!+long-float + #+long-float (error "(log 2 10) not computed"))))))) (x (if (minusp ex) (if (float-denormalized-p x) - #!-long-float + #-long-float (* x 1.0e16 (expt 10.0e0 (- (- ex) 16))) - #!+long-float + #+long-float (* x 1.0e18 (expt 10.0e0 (- (- ex) 18))) (* x 10.0e0 (expt 10.0e0 (- (- ex) 1)))) (/ x 10.0e0 (expt 10.0e0 (1- ex)))))) @@ -1517,9 +1517,9 @@ variable: an unreadable object representing the error is printed instead.") (cond ((case *read-default-float-format* ((short-float single-float) (typep x 'single-float)) - ((double-float #!-long-float long-float) + ((double-float #-long-float long-float) (typep x 'double-float)) - #!+long-float + #+long-float (long-float (typep x 'long-float))) (unless (eql exp 0) diff --git a/src/code/reader.lisp b/src/code/reader.lisp index e4684ec46..adb940e51 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -1672,7 +1672,7 @@ extended :: syntax." ;; Use the least positive float, because denormalized exponent ;; can be larger than normalized. (let* ((max-exponent - #!-long-float + #-long-float (+ sb-vm:double-float-digits sb-vm:double-float-bias)) (number-magnitude (integer-length number)) (divisor-magnitude (1- (integer-length divisor))) diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp index 89c2cec96..7b612a61b 100644 --- a/src/code/target-format.lisp +++ b/src/code/target-format.lisp @@ -642,9 +642,9 @@ (if (case *read-default-float-format* ((short-float single-float) (typep number 'single-float)) - ((double-float #!-long-float long-float) + ((double-float #-long-float long-float) (typep number 'double-float)) - #!+long-float + #+long-float (long-float (typep number 'long-float))) #\e diff --git a/src/code/target-random.lisp b/src/code/target-random.lisp index 876c9d9f8..b16eb744b 100644 --- a/src/code/target-random.lisp +++ b/src/code/target-random.lisp @@ -405,7 +405,7 @@ http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/emt.html (defun random (arg &optional (state *random-state*)) #!-sb-fluid (declare (inline %random-fixnum %random-single-float %random-double-float - #!+long-float %random-long-float)) + #+long-float %random-long-float)) (declare (explicit-check)) (cond ((and (fixnump arg) (> arg 0)) @@ -414,7 +414,7 @@ http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/emt.html (%random-single-float arg state)) ((and (typep arg 'double-float) (> arg 0.0d0)) (%random-double-float arg state)) - #!+long-float + #+long-float ((and (typep arg 'long-float) (> arg 0.0l0)) (%random-long-float arg state)) ((and (bignump arg) (> arg 0)) diff --git a/src/code/target-sxhash.lisp b/src/code/target-sxhash.lisp index b0827de3c..a8d810024 100644 --- a/src/code/target-sxhash.lisp +++ b/src/code/target-sxhash.lisp @@ -295,13 +295,13 @@ (integer (sb-bignum:sxhash-bignum x)) (single-float (sxhash x)) ; through DEFTRANSFORM (double-float (sxhash x)) ; through DEFTRANSFORM - #!+long-float (long-float (error "stub: no LONG-FLOAT")) + #+long-float (long-float (error "stub: no LONG-FLOAT")) (ratio (let ((result 127810327)) (declare (type fixnum result)) (mixf result (sxhash-number (numerator x))) (mixf result (sxhash-number (denominator x))) result)) - #!+long-float + #+long-float ((complex long-float) (hash-complex-float)) ((complex double-float) @@ -582,7 +582,7 @@ (etypecase key (single-float (hash-float single-float key)) (double-float (hash-float double-float key)) - #!+long-float + #+long-float (long-float (error "LONG-FLOAT not currently supported"))))) (rational (if (and (<= most-negative-double-float key diff --git a/src/code/unportable-float.lisp b/src/code/unportable-float.lisp index d036573cd..795f97eab 100644 --- a/src/code/unportable-float.lisp +++ b/src/code/unportable-float.lisp @@ -32,5 +32,5 @@ (:double-float-negative-zero (make-double-float (opaque-identity #x-80000000) (opaque-identity #x00000000))) - #!+long-float + #+long-float (:long-float-negative-zero (error "write LONG-FLOAT creation form"))))) diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp index fcd011bdb..89f9ac801 100644 --- a/src/compiler/dump.lisp +++ b/src/compiler/dump.lisp @@ -533,7 +533,7 @@ (declare (double-float x)) (dump-integer-as-n-bytes (double-float-low-bits x) 4 file) (dump-integer-as-n-bytes (double-float-high-bits x) 4 file))) - #!+long-float + #+long-float (long-float (dump-fop 'fop-long-float file) (dump-long-float x file)))) @@ -580,7 +580,7 @@ (dump-complex-single-float (realpart x) (imagpart x) file)) ((complex double-float) (dump-complex-double-float (realpart x) (imagpart x) file)) - #!+long-float + #+long-float ((complex long-float) (dump-fop 'fop-complex-long-float file) (dump-long-float (realpart x) file) diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp index e40cee628..aae809d2f 100644 --- a/src/compiler/float-tran.lisp +++ b/src/compiler/float-tran.lisp @@ -662,7 +662,7 @@ ;; the host does not have long floats, then setting *R-D-F-F* to ;; LONG-FLOAT doesn't actually buy us anything. FIXME. (setf *read-default-float-format* - #!+long-float 'long-float #!-long-float 'double-float)) + #+long-float 'long-float #-long-float 'double-float)) ;;; Test whether the numeric-type ARG is within the domain specified by ;;; DOMAIN-LOW and DOMAIN-HIGH, consider negative and positive zero to ;;; be distinct. @@ -681,7 +681,7 @@ (typecase arg-lo-val (single-float 0f0) (double-float 0d0) - #!+long-float + #+long-float (long-float 0l0)) arg-lo-val arg-lo)) (when (and arg-hi (zerop arg-hi-val) (floatp arg-hi-val) (consp arg-hi) @@ -690,7 +690,7 @@ (typecase arg-lo-val (single-float (load-time-value (make-unportable-float :single-float-negative-zero))) (double-float (load-time-value (make-unportable-float :double-float-negative-zero))) - #!+long-float + #+long-float (long-float (load-time-value (make-unportable-float :long-float-negative-zero)))) arg-hi-val arg-hi)) (flet ((fp-neg-zero-p (f) ; Is F -0.0? diff --git a/src/compiler/generic/early-objdef.lisp b/src/compiler/generic/early-objdef.lisp index 2e883bd7f..94ddf764f 100644 --- a/src/compiler/generic/early-objdef.lisp +++ b/src/compiler/generic/early-objdef.lisp @@ -117,7 +117,7 @@ ;;; * BIGNUM + RATIO (+ FIXNUM) = RATIONAL ;;; ;;; * SINGLE-FLOAT + DOUBLE-FLOAT + LONG-FLOAT = FLOAT -;;; But: There's not a snowball's chance that #!+long-float works. +;;; But: There's not a snowball's chance that #+long-float works. ;;; changeset 7646ae obliterated LONG-FLOAT-WIDETAG. ;;; ;;; * RATIONAL + FLOAT = REAL diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index c40d6e91c..ce7ec4fde 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -848,7 +848,7 @@ core and return a descriptor to it." sb-vm:ratio-widetag)) ((complex single-float) (complex-single-float-to-core number)) ((complex double-float) (complex-double-float-to-core number)) - #!+long-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)) diff --git a/src/compiler/generic/interr.lisp b/src/compiler/generic/interr.lisp index 0c6f41c22..7cd5faa58 100644 --- a/src/compiler/generic/interr.lisp +++ b/src/compiler/generic/interr.lisp @@ -118,7 +118,7 @@ ratio single-float double-float - #!+long-float long-float + #+long-float long-float simple-string fixnum vector @@ -150,7 +150,7 @@ ((complex float) object-not-complex-float) ((complex single-float) object-not-complex-single-float) ((complex double-float) object-not-complex-double-float) - #!+long-float ((complex long-float) object-not-complex-long-float) + #+long-float ((complex long-float) object-not-complex-long-float) #!+sb-simd-pack simd-pack #!+sb-simd-pack-256 simd-pack-256 weak-pointer diff --git a/src/compiler/generic/late-type-vops.lisp b/src/compiler/generic/late-type-vops.lisp index 565019a69..93cc53b2c 100644 --- a/src/compiler/generic/late-type-vops.lisp +++ b/src/compiler/generic/late-type-vops.lisp @@ -94,13 +94,13 @@ (!define-type-vop complexp (complex-widetag complex-single-float-widetag complex-double-float-widetag - #!+long-float complex-long-float-widetag)) + #+long-float complex-long-float-widetag)) (!define-type-vop complex-rational-p (complex-widetag)) (!define-type-vop complex-float-p (complex-single-float-widetag complex-double-float-widetag - #!+long-float complex-long-float-widetag)) + #+long-float complex-long-float-widetag)) (!define-type-vop complex-single-float-p (complex-single-float-widetag)) @@ -226,11 +226,11 @@ ratio-widetag single-float-widetag double-float-widetag - #!+long-float long-float-widetag + #+long-float long-float-widetag complex-widetag complex-single-float-widetag complex-double-float-widetag - #!+long-float complex-long-float-widetag + #+long-float complex-long-float-widetag . #.fixnum-lowtags)) (!define-type-vop rationalp @@ -240,14 +240,14 @@ (bignum-widetag . #.fixnum-lowtags)) (!define-type-vop floatp - (single-float-widetag double-float-widetag #!+long-float long-float-widetag)) + (single-float-widetag double-float-widetag #+long-float long-float-widetag)) (!define-type-vop realp (ratio-widetag bignum-widetag single-float-widetag double-float-widetag - #!+long-float long-float-widetag + #+long-float long-float-widetag . #.fixnum-lowtags)) #!+sb-simd-pack diff --git a/src/compiler/generic/objdef.lisp b/src/compiler/generic/objdef.lisp index 89df858c8..9f338a777 100644 --- a/src/compiler/generic/objdef.lisp +++ b/src/compiler/generic/objdef.lisp @@ -73,7 +73,7 @@ #!-64-bit (filler) (value :c-type "double" :length #.(/ 64 n-word-bits))) -#!+long-float +#+long-float (!define-primitive-object (long-float :lowtag other-pointer-lowtag :widetag long-float-widetag) #!+sparc (filler) diff --git a/src/compiler/generic/vm-array.lisp b/src/compiler/generic/vm-array.lisp index a353ab509..877ce49be 100644 --- a/src/compiler/generic/vm-array.lisp +++ b/src/compiler/generic/vm-array.lisp @@ -129,7 +129,7 @@ simple-array-complex-single-float) ((complex double-float) #C(0.0d0 0.0d0) 128 simple-array-complex-double-float) - #!+long-float + #+long-float ((complex long-float) #C(0.0l0 0.0l0) #!+x86 192 #!+sparc 256 simple-array-complex-long-float) (t 0 #.n-word-bits simple-vector)))) diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp index a3b7070c8..b97baaa66 100644 --- a/src/compiler/generic/vm-fndb.lisp +++ b/src/compiler/generic/vm-fndb.lisp @@ -18,7 +18,7 @@ (defknown (fixnump bignump ratiop short-float-p single-float-p double-float-p long-float-p complex-rational-p complex-float-p complex-single-float-p - complex-double-float-p #!+long-float complex-long-float-p + complex-double-float-p #+long-float complex-long-float-p complex-vector-p #!+sb-unicode base-char-p %standard-char-p %instancep @@ -50,10 +50,10 @@ #!+64-bit simple-array-signed-byte-64-p simple-array-single-float-p simple-array-double-float-p - #!+long-float simple-array-long-float-p + #+long-float simple-array-long-float-p simple-array-complex-single-float-p simple-array-complex-double-float-p - #!+long-float simple-array-complex-long-float-p + #+long-float simple-array-complex-long-float-p simple-rank-1-array-*-p system-area-pointer-p realp ;; #!-64-bit diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp index 21498914e..4a605e707 100644 --- a/src/compiler/generic/vm-tran.lisp +++ b/src/compiler/generic/vm-tran.lisp @@ -15,7 +15,7 @@ ;;; transform picks whichever predicate was defined last when there ;;; are multiple predicates for equivalent types. (define-source-transform short-float-p (x) `(single-float-p ,x)) -#!-long-float +#-long-float (define-source-transform long-float-p (x) `(double-float-p ,x)) (define-source-transform compiled-function-p (x) diff --git a/src/compiler/generic/vm-type.lisp b/src/compiler/generic/vm-type.lisp index 7fe46aa3d..76d8b7ab5 100644 --- a/src/compiler/generic/vm-type.lisp +++ b/src/compiler/generic/vm-type.lisp @@ -25,15 +25,15 @@ ;;; worst-case values for float attributes (sb-xc:deftype float-exponent () - #!-long-float 'double-float-exponent - #!+long-float 'long-float-exponent) + #-long-float 'double-float-exponent + #+long-float 'long-float-exponent) (sb-xc:deftype float-digits () - #!-long-float `(integer 0 ,sb-vm:double-float-digits) - #!+long-float `(integer 0 ,sb-vm:long-float-digits)) + #-long-float `(integer 0 ,sb-vm:double-float-digits) + #+long-float `(integer 0 ,sb-vm:long-float-digits)) (sb-xc:deftype float-radix () '(integer 2 2)) (sb-xc:deftype float-int-exponent () - #!-long-float 'double-float-int-exponent - #!+long-float 'long-float-int-exponent) + #-long-float 'double-float-int-exponent + #+long-float 'long-float-int-exponent) ;;; a code for BOOLE (sb-xc:deftype boole-code () '(unsigned-byte 4)) @@ -94,7 +94,7 @@ (etypecase x (single-float 'single-float) (double-float 'double-float) - #!+long-float (long-float 'long-float))) + #+long-float (long-float 'long-float))) (declaim (ftype (sfunction (ctype) ctype) %upgraded-array-element-type)) (defun %upgraded-array-element-type (eltype) diff --git a/src/compiler/generic/vm-typetran.lisp b/src/compiler/generic/vm-typetran.lisp index 2413a54e4..41ce93867 100644 --- a/src/compiler/generic/vm-typetran.lisp +++ b/src/compiler/generic/vm-typetran.lisp @@ -22,7 +22,7 @@ #!+sb-unicode (define-type-predicate character-string-p (vector character)) (define-type-predicate complex-double-float-p (complex double-float)) (define-type-predicate complex-single-float-p (complex single-float)) -#!+long-float +#+long-float (define-type-predicate complex-long-float-p (complex long-float)) ;;; (COMPLEX-VECTOR-P isn't here because it's not so much a Lisp-level ;;; type predicate as just a hack to get at the type code so that we @@ -82,14 +82,14 @@ (simple-array single-float (*))) (define-type-predicate simple-array-double-float-p (simple-array double-float (*))) -#!+long-float +#+long-float (define-type-predicate simple-array-long-float-p (simple-array long-float (*))) (define-type-predicate simple-array-complex-single-float-p (simple-array (complex single-float) (*))) (define-type-predicate simple-array-complex-double-float-p (simple-array (complex double-float) (*))) -#!+long-float +#+long-float (define-type-predicate simple-array-complex-long-float-p (simple-array (complex long-float) (*))) (define-type-predicate simple-base-string-p simple-base-string) diff --git a/src/compiler/saptran.lisp b/src/compiler/saptran.lisp index fa8498177..a8de5433d 100644 --- a/src/compiler/saptran.lisp +++ b/src/compiler/saptran.lisp @@ -175,8 +175,8 @@ (def %set-sap-ref-single t single-float) (def sap-ref-double) (def %set-sap-ref-double t double-float) - #!+long-float (def sap-ref-long) - #!+long-float (def %set-sap-ref-long t long-float)) + #+long-float (def sap-ref-long) + #+long-float (def %set-sap-ref-long t long-float)) (macrolet ((def (fun args 32-bit 64-bit) `(deftransform ,fun (,args) diff --git a/src/compiler/sparc/array.lisp b/src/compiler/sparc/array.lisp index bc59a908f..fd26a111a 100644 --- a/src/compiler/sparc/array.lisp +++ b/src/compiler/sparc/array.lisp @@ -361,7 +361,7 @@ (unless (location= result value) (move-double-reg result value)))) -#!+long-float +#+long-float (define-vop (data-vector-ref/simple-array-long-float) (:note "inline array access") (:translate data-vector-ref) @@ -378,7 +378,7 @@ other-pointer-lowtag)) (load-long-reg value object offset nil))) -#!+long-float +#+long-float (define-vop (data-vector-set/simple-array-long-float) (:note "inline array store") (:translate data-vector-set) @@ -539,7 +539,7 @@ (unless (location= result-imag value-imag) (move-double-reg result-imag value-imag))))) -#!+long-float +#+long-float (define-vop (data-vector-ref/simple-array-complex-long-float) (:note "inline array access") (:translate data-vector-ref) @@ -560,7 +560,7 @@ (inst add offset (* 4 n-word-bytes)) (load-long-reg imag-tn object offset nil)))) -#!+long-float +#+long-float (define-vop (data-vector-set/simple-array-complex-long-float) (:note "inline array store") (:translate data-vector-set) diff --git a/src/compiler/sparc/c-call.lisp b/src/compiler/sparc/c-call.lisp index c1df46995..158a092c5 100644 --- a/src/compiler/sparc/c-call.lisp +++ b/src/compiler/sparc/c-call.lisp @@ -69,7 +69,7 @@ (declare (ignore type state)) (make-wired-tn* 'single-float single-reg-sc-number 0)) -#!+long-float +#+long-float (define-alien-type-method (long-float :result-tn) (type) (declare (ignore type)) (make-wired-tn* 'long-float long-reg-sc-number 0)) @@ -111,7 +111,7 @@ (and (alien-integer-type-p type) (> (sb-alien::alien-integer-type-bits type) 32))) arg-types) - #!+long-float (some #'alien-long-float-type-p arg-types) + #+long-float (some #'alien-long-float-type-p arg-types) (and (alien-integer-type-p result-type) (> (sb-alien::alien-integer-type-bits result-type) 32))) (collect ((new-args) (lambda-vars) (new-arg-types)) @@ -137,7 +137,7 @@ (new-args `(double-float-low-bits ,arg)) (new-arg-types (parse-alien-type '(signed 32) nil)) (new-arg-types (parse-alien-type '(unsigned 32) nil))) - #!+long-float + #+long-float ((alien-long-float-type-p type) (new-args `(long-float-exp-bits ,arg)) (new-args `(long-float-high-bits ,arg)) diff --git a/src/compiler/sparc/float.lisp b/src/compiler/sparc/float.lisp index 93abcc7e5..11efb8271 100644 --- a/src/compiler/sparc/float.lisp +++ b/src/compiler/sparc/float.lisp @@ -57,7 +57,7 @@ (when restore-offset (inst sub offset (* 2 n-word-bytes))))))))) -#!+long-float +#+long-float (define-move-fun (load-long 2) (vop x y) ((long-stack) (long-reg)) (let ((nfp (current-nfp-tn vop)) @@ -87,7 +87,7 @@ (when restore-offset (inst sub offset (* 2 n-word-bytes))))))))) -#!+long-float +#+long-float (define-move-fun (store-long 2) (vop x y) ((long-reg) (long-stack)) (let ((nfp (current-nfp-tn vop)) @@ -147,7 +147,7 @@ (define-move-vop ,vop :move (,sc) (,sc))))) (frob single-move single-reg :single) (frob double-move double-reg :double) - #!+long-float + #+long-float (frob long-move long-reg :long)) @@ -179,7 +179,7 @@ single-float-size single-float-widetag single-float-value-slot) (frob move-from-double double-reg :double double-float-size double-float-widetag double-float-value-slot) - #!+long-float + #+long-float (frob move-from-long long-reg :long long-float-size long-float-widetag long-float-value-slot)) @@ -199,7 +199,7 @@ (frob move-to-single single-reg :single single-float-value-slot) (frob move-to-double double-reg :double double-float-value-slot)) -#!+long-float +#+long-float (define-vop (move-to-long) (:args (x :scs (descriptor-reg))) (:results (y :scs (long-reg))) @@ -207,7 +207,7 @@ (:generator 2 (load-long-reg y x (- (* long-float-value-slot n-word-bytes) other-pointer-lowtag)))) -#!+long-float +#+long-float (define-move-vop move-to-long :move (descriptor-reg) (long-reg)) (macrolet ((frob (name sc stack-sc format) @@ -236,7 +236,7 @@ (frob move-single-float-arg single-reg single-stack :single) (frob move-double-float-arg double-reg double-stack :double)) -#!+long-float +#+long-float (define-vop (move-long-float-arg) (:args (x :scs (long-reg) :target y) (nfp :scs (any-reg) :load-if (not (sc-is y long-reg)))) @@ -251,7 +251,7 @@ (let ((offset (* (tn-offset y) n-word-bytes))) (store-long-reg x nfp offset)))))) ;;; -#!+long-float +#+long-float (define-move-vop move-long-float-arg :move-arg (long-reg descriptor-reg) (long-reg)) @@ -272,11 +272,11 @@ (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg) :offset (+ (tn-offset x) 2))) -#!+long-float +#+long-float (defun complex-long-reg-real-tn (x) (make-random-tn :kind :normal :sc (sc-or-lose 'long-reg) :offset (tn-offset x))) -#!+long-float +#+long-float (defun complex-long-reg-imag-tn (x) (make-random-tn :kind :normal :sc (sc-or-lose 'long-reg) :offset (+ (tn-offset x) 4))) @@ -320,7 +320,7 @@ (inst stdf imag-tn nfp (+ offset (* 2 n-word-bytes)))))) -#!+long-float +#+long-float (define-move-fun (load-complex-long 5) (vop x y) ((complex-long-stack) (complex-long-reg)) (let ((nfp (current-nfp-tn vop)) @@ -330,7 +330,7 @@ (let ((imag-tn (complex-long-reg-imag-tn y))) (load-long-reg imag-tn nfp (+ offset (* 4 n-word-bytes)))))) -#!+long-float +#+long-float (define-move-fun (store-complex-long 5) (vop x y) ((complex-long-reg) (complex-long-stack)) (let ((nfp (current-nfp-tn vop)) @@ -381,7 +381,7 @@ (define-move-vop complex-double-move :move (complex-double-reg) (complex-double-reg)) -#!+long-float +#+long-float (define-vop (complex-long-move) (:args (x :scs (complex-long-reg) :target y :load-if (not (location= x y)))) @@ -398,7 +398,7 @@ (y-imag (complex-long-reg-imag-tn y))) (move-long-reg y-imag x-imag))))) ;;; -#!+long-float +#+long-float (define-move-vop complex-long-move :move (complex-long-reg) (complex-long-reg)) @@ -446,7 +446,7 @@ (define-move-vop move-from-complex-double :move (complex-double-reg) (descriptor-reg)) -#!+long-float +#+long-float (define-vop (move-from-complex-long) (:args (x :scs (complex-long-reg) :to :save)) (:results (y :scs (descriptor-reg))) @@ -464,7 +464,7 @@ n-word-bytes) other-pointer-lowtag)))))) ;;; -#!+long-float +#+long-float (define-move-vop move-from-complex-long :move (complex-long-reg) (descriptor-reg)) @@ -499,7 +499,7 @@ (define-move-vop move-to-complex-double :move (descriptor-reg) (complex-double-reg)) -#!+long-float +#+long-float (define-vop (move-to-complex-long) (:args (x :scs (descriptor-reg))) (:results (y :scs (complex-long-reg))) @@ -511,7 +511,7 @@ (let ((imag-tn (complex-long-reg-imag-tn y))) (load-long-reg imag-tn x (- (* complex-long-float-imag-slot n-word-bytes) other-pointer-lowtag))))) -#!+long-float +#+long-float (define-move-vop move-to-complex-long :move (descriptor-reg) (complex-long-reg)) @@ -566,7 +566,7 @@ (define-move-vop move-complex-double-float-arg :move-arg (complex-double-reg descriptor-reg) (complex-double-reg)) -#!+long-float +#+long-float (define-vop (move-complex-long-float-arg) (:args (x :scs (complex-long-reg) :target y) (nfp :scs (any-reg) :load-if (not (sc-is y complex-long-reg)))) @@ -588,14 +588,14 @@ (store-long-reg real-tn nfp offset)) (let ((imag-tn (complex-long-reg-imag-tn x))) (store-long-reg imag-tn nfp (+ offset (* 4 n-word-bytes))))))))) -#!+long-float +#+long-float (define-move-vop move-complex-long-float-arg :move-arg (complex-long-reg descriptor-reg) (complex-long-reg)) (define-move-vop move-arg :move-arg - (single-reg double-reg #!+long-float long-reg - complex-single-reg complex-double-reg #!+long-float complex-long-reg) + (single-reg double-reg #+long-float long-reg + complex-single-reg complex-double-reg #+long-float complex-long-reg) (descriptor-reg)) @@ -618,7 +618,7 @@ (:result-types ,ptype)))) (frob single-float-op single-reg single-float) (frob double-float-op double-reg double-float) - #!+long-float + #+long-float (frob long-float-op long-reg long-float)) (macrolet ((frob (op sinst sname scost dinst dname dcost) @@ -636,7 +636,7 @@ (frob * fmuls */single-float 4 fmuld */double-float 5) (frob / fdivs //single-float 12 fdivd //double-float 19)) -#!+long-float +#+long-float (macrolet ((frob (op linst lname lcost) `(define-vop (,lname long-float-op) (:translate ,op) @@ -725,7 +725,7 @@ (note-this-location vop :internal-error) (negate-double-reg y x))) -#!+long-float +#+long-float (define-vop (abs/long-float) (:args (x :scs (long-reg))) (:results (y :scs (long-reg))) @@ -754,7 +754,7 @@ :offset (+ i 1 (tn-offset x))))) (inst fmovs y-odd x-odd))))))) -#!+long-float +#+long-float (define-vop (%negate/long-float) (:args (x :scs (long-reg))) (:results (y :scs (long-reg))) @@ -815,10 +815,10 @@ (:arg-types ,ptype ,ptype)))) (frob single-float-compare single-reg single-float) (frob double-float-compare double-reg double-float) - #!+long-float + #+long-float (frob long-float-compare long-reg long-float)) -(macrolet ((frob (translate yep nope sname dname #!+long-float lname) +(macrolet ((frob (translate yep nope sname dname #+long-float lname) `(progn (define-vop (,sname single-float-compare) (:translate ,translate) @@ -826,15 +826,15 @@ (define-vop (,dname double-float-compare) (:translate ,translate) (:variant :double ,yep ,nope)) - #!+long-float + #+long-float (define-vop (,lname long-float-compare) (:translate ,translate) (:variant :long ,yep ,nope))))) - (frob < :l :ge :g :le >/single-float >/double-float #!+long-float >/long-float) - (frob = :eq :ne =/single-float =/double-float #!+long-float =/long-float)) + (frob < :l :ge :g :le >/single-float >/double-float #+long-float >/long-float) + (frob = :eq :ne =/single-float =/double-float #+long-float =/long-float)) -#!+long-float +#+long-float (deftransform eql ((x y) (long-float long-float)) '(and (= (long-float-low-bits x) (long-float-low-bits y)) (= (long-float-mid-bits x) (long-float-mid-bits y)) @@ -875,7 +875,7 @@ (inst ,inst y temp)))))) (frob %single-float/signed %single-float fitos single-reg single-float) (frob %double-float/signed %double-float fitod double-reg double-float) - #!+long-float + #+long-float (frob %long-float/signed %long-float fitoq long-reg long-float)) (macrolet ((frob (name translate inst from-sc from-type to-sc to-type) @@ -894,18 +894,18 @@ (inst ,inst y x))))) (frob %single-float/double-float %single-float fdtos double-reg double-float single-reg single-float) - #!+long-float + #+long-float (frob %single-float/long-float %single-float fqtos long-reg long-float single-reg single-float) (frob %double-float/single-float %double-float fstod single-reg single-float double-reg double-float) - #!+long-float + #+long-float (frob %double-float/long-float %double-float fqtod long-reg long-float double-reg double-float) - #!+long-float + #+long-float (frob %long-float/single-float %long-float fstoq single-reg single-float long-reg long-float) - #!+long-float + #+long-float (frob %long-float/double-float %long-float fdtoq double-reg double-float long-reg long-float)) @@ -937,7 +937,7 @@ (* (tn-offset stack-temp) n-word-bytes)))))))) (frob %unary-truncate/single-float single-reg single-float fstoi) (frob %unary-truncate/double-float double-reg double-float fdtoi) - #!+long-float + #+long-float (frob %unary-truncate/long-float long-reg long-float fqtoi) ;; KLUDGE -- these two forms were protected by #-sun4. ;; (frob %unary-round single-reg single-float fstoir) @@ -1014,7 +1014,7 @@ (inst lddf res (current-nfp-tn vop) (* (tn-offset temp) n-word-bytes))))) -#!+long-float +#+long-float (define-vop (make-long-float) (:args (hi-bits :scs (signed-reg)) (lo1-bits :scs (unsigned-reg)) @@ -1125,7 +1125,7 @@ (loadw lo-bits float (1+ double-float-value-slot) other-pointer-lowtag))))) -#!+long-float +#+long-float (define-vop (long-float-exp-bits) (:args (float :scs (long-reg descriptor-reg) :load-if (not (sc-is float long-stack)))) @@ -1153,7 +1153,7 @@ (loadw exp-bits float long-float-value-slot other-pointer-lowtag))))) -#!+long-float +#+long-float (define-vop (long-float-high-bits) (:args (float :scs (long-reg descriptor-reg) :load-if (not (sc-is float long-stack)))) @@ -1181,7 +1181,7 @@ (loadw high-bits float (1+ long-float-value-slot) other-pointer-lowtag))))) -#!+long-float +#+long-float (define-vop (long-float-mid-bits) (:args (float :scs (long-reg descriptor-reg) :load-if (not (sc-is float long-stack)))) @@ -1209,7 +1209,7 @@ (loadw mid-bits float (+ 2 long-float-value-slot) other-pointer-lowtag))))) -#!+long-float +#+long-float (define-vop (long-float-low-bits) (:args (float :scs (long-reg descriptor-reg) :load-if (not (sc-is float long-stack)))) @@ -1345,7 +1345,7 @@ ;;;; Special functions. -#!-long-float +#-long-float (define-vop (fsqrt) (:args (x :scs (double-reg))) (:results (y :scs (double-reg))) @@ -1363,7 +1363,7 @@ (note-this-location vop :internal-error) (inst fsqrtd y x))) -#!+long-float +#+long-float (define-vop (fsqrt-long) (:args (x :scs (long-reg))) (:results (y :scs (long-reg))) @@ -1437,7 +1437,7 @@ (inst stdf real nfp offset)) (inst stdf imag nfp (+ offset (* 2 n-word-bytes)))))))) -#!+long-float +#+long-float (define-vop (make-complex-long-float) (:translate complex) (:args (real :scs (long-reg) :target r @@ -1530,7 +1530,7 @@ (:note "complex double float imagpart") (:variant :imag)) -#!+long-float +#+long-float (define-vop (complex-long-float-value) (:args (x :scs (complex-long-reg) :target r :load-if (not (sc-is x complex-long-stack)))) @@ -1553,13 +1553,13 @@ (* (+ (ecase slot (:real 0) (:imag 4)) (tn-offset x)) n-word-bytes)))))) -#!+long-float +#+long-float (define-vop (realpart/complex-long-float complex-long-float-value) (:translate realpart) (:note "complex long float realpart") (:variant :real)) -#!+long-float +#+long-float (define-vop (imagpart/complex-long-float complex-long-float-value) (:translate imagpart) (:note "complex long float imagpart") diff --git a/src/compiler/sparc/insts.lisp b/src/compiler/sparc/insts.lisp index 99115e17b..51ac82b85 100644 --- a/src/compiler/sparc/insts.lisp +++ b/src/compiler/sparc/insts.lisp @@ -71,7 +71,7 @@ Otherwise, use the Sparc register names") (let ((offset (tn-offset loc))) (aver (zerop (mod offset 2))) (values (+ offset 32) 2))) - #!+long-float + #+long-float (long-reg (let ((offset (tn-offset loc))) (aver (zerop (mod offset 4))) diff --git a/src/compiler/sparc/sap.lisp b/src/compiler/sparc/sap.lisp index 6ae21328d..6ac3e2567 100644 --- a/src/compiler/sparc/sap.lisp +++ b/src/compiler/sparc/sap.lisp @@ -256,7 +256,7 @@ single-reg single-float :single) (def-system-ref-and-set sap-ref-double %set-sap-ref-double double-reg double-float :double) - #!+long-float + #+long-float (def-system-ref-and-set sap-ref-long %set-sap-ref-long long-reg long-float :long-float) ) ; MACROLET diff --git a/src/compiler/sparc/vm.lisp b/src/compiler/sparc/vm.lisp index 1a7d2cc33..60dfbdf3b 100644 --- a/src/compiler/sparc/vm.lisp +++ b/src/compiler/sparc/vm.lisp @@ -154,13 +154,13 @@ (single-stack non-descriptor-stack) ; single-floats (double-stack non-descriptor-stack :element-size 2 :alignment 2) ; double floats. - #!+long-float + #+long-float (long-stack non-descriptor-stack :element-size 4 :alignment 4) ; long floats. ;; complex-single-floats (complex-single-stack non-descriptor-stack :element-size 2) ;; complex-double-floats. (complex-double-stack non-descriptor-stack :element-size 4 :alignment 2) - #!+long-float + #+long-float ;; complex-long-floats. (complex-long-stack non-descriptor-stack :element-size 8 :alignment 4) @@ -223,7 +223,7 @@ :alternate-scs (double-stack)) ;; Non-Descriptor double-floats. - #!+long-float + #+long-float (long-reg float-registers :locations #.(loop for i from 0 to #!-sparc-64 31 #!+sparc-64 63 by 4 collect i) @@ -250,7 +250,7 @@ :save-p t :alternate-scs (complex-double-stack)) - #!+long-float + #+long-float (complex-long-reg float-registers :locations #.(loop for i from 0 to #!-sparc-64 31 #!+sparc-64 63 by 8 collect i) diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index a6b9a8902..b4029354a 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -1740,14 +1740,14 @@ (values 'integer nil)) (rational (values 'rational nil)) - ((or single-float double-float #!+long-float long-float) + ((or single-float double-float #+long-float long-float) (values 'float rem-type)) (float (values 'float nil)) (real (values nil nil))) (when (member rem-type '(float single-float double-float - #!+long-float long-float)) + #+long-float long-float)) (setf rem (interval-func #'(lambda (x) (coerce-for-bound x rem-type)) rem))) @@ -1886,14 +1886,14 @@ (values 'integer nil)) (rational (values 'rational nil)) - ((or single-float double-float #!+long-float long-float) + ((or single-float double-float #+long-float long-float) (values 'float result-type)) (float (values 'float nil)) (real (values nil nil))) (when (member result-type '(float single-float double-float - #!+long-float long-float)) + #+long-float long-float)) ;; Make sure that the limits on the interval have ;; the right type. (setf rem (interval-func (lambda (x) @@ -4832,7 +4832,7 @@ (specifier-type '(complex single-float))) (csubtypep result-typeoid (specifier-type '(complex double-float))) - #!+long-float + #+long-float (csubtypep result-typeoid (specifier-type '(complex long-float)))) ;; float complex types are never canonicalized. diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp index d26dd6c77..102772aed 100644 --- a/src/compiler/typetran.lisp +++ b/src/compiler/typetran.lisp @@ -1167,7 +1167,7 @@ 'x) ((csubtypep tspec (specifier-type 'double-float)) `(the ,tval (%double-float x))) - ;; FIXME: #!+long-float (t ,(error "LONG-FLOAT case needed")) + ;; FIXME: #+long-float (t ,(error "LONG-FLOAT case needed")) ((csubtypep tspec (specifier-type 'float)) `(the ,tval (%single-float x))) ((csubtypep tspec (specifier-type 'complex)) diff --git a/src/compiler/x86/c-call.lisp b/src/compiler/x86/c-call.lisp index adbe6384d..05424bf0b 100644 --- a/src/compiler/x86/c-call.lisp +++ b/src/compiler/x86/c-call.lisp @@ -37,7 +37,7 @@ sap-stack-sc-number stack-frame-size))) -#!+long-float +#+long-float (define-alien-type-method (long-float :arg-tn) (type state) (declare (ignore type)) (let ((stack-frame-size (arg-state-stack-frame-size state))) @@ -87,7 +87,7 @@ (make-wired-tn* 'system-area-pointer sap-reg-sc-number (result-reg-offset num-results)))) -#!+long-float +#+long-float (define-alien-type-method (long-float :result-tn) (type state) (declare (ignore type)) (let ((num-results (result-state-num-results state))) @@ -258,7 +258,7 @@ (let ((ea (ea-for-df-stack fp-temp))) (inst fstpd ea) (inst fldd ea))) - #!+long-float + #+long-float (long-reg ; nothing to do! ))) diff --git a/src/compiler/x86/float.lisp b/src/compiler/x86/float.lisp index b9e43750a..8dc3d5f83 100644 --- a/src/compiler/x86/float.lisp +++ b/src/compiler/x86/float.lisp @@ -17,7 +17,7 @@ (ea-for-xf-desc tn single-float-value-slot)) (defun ea-for-df-desc (tn) (ea-for-xf-desc tn double-float-value-slot)) - #!+long-float + #+long-float (defun ea-for-lf-desc (tn) (ea-for-xf-desc tn long-float-value-slot)) ;; complex floats @@ -29,10 +29,10 @@ (ea-for-xf-desc tn complex-double-float-real-slot)) (defun ea-for-cdf-imag-desc (tn) (ea-for-xf-desc tn complex-double-float-imag-slot)) - #!+long-float + #+long-float (defun ea-for-clf-real-desc (tn) (ea-for-xf-desc tn complex-long-float-real-slot)) - #!+long-float + #+long-float (defun ea-for-clf-imag-desc (tn) (ea-for-xf-desc tn complex-long-float-imag-slot))) @@ -46,7 +46,7 @@ (ea-for-xf-stack tn :single)) (defun ea-for-df-stack (tn) (ea-for-xf-stack tn :double)) - #!+long-float + #+long-float (defun ea-for-lf-stack (tn) (ea-for-xf-stack tn :long))) @@ -92,10 +92,10 @@ (ea-for-cxf-stack tn :double :real base)) (defun ea-for-cdf-imag-stack (tn &optional (base ebp-tn)) (ea-for-cxf-stack tn :double :imag base)) - #!+long-float + #+long-float (defun ea-for-clf-real-stack (tn &optional (base ebp-tn)) (ea-for-cxf-stack tn :long :real base)) - #!+long-float + #+long-float (defun ea-for-clf-imag-stack (tn &optional (base ebp-tn)) (ea-for-cxf-stack tn :long :imag base))) @@ -121,7 +121,7 @@ ;;; The x86 can't store a long-float to memory without popping the ;;; stack and marking a register as empty, so it is necessary to ;;; restore the register from memory. -#!+long-float +#+long-float (defun store-long-float (ea) (inst fstpl ea) (inst fldl ea)) @@ -159,13 +159,13 @@ ;; This may not be necessary as ST0 is likely invalid now. (inst fxch x)))) -#!+long-float +#+long-float (define-move-fun (load-long 2) (vop x y) ((long-stack) (long-reg)) (with-empty-tn@fp-top(y) (inst fldl (ea-for-lf-stack x)))) -#!+long-float +#+long-float (define-move-fun (store-long 2) (vop x y) ((long-reg) (long-stack)) (cond ((zerop (tn-offset x)) @@ -184,28 +184,28 @@ ;;; "immediate-constant-sc" in vm.lisp. (eval-when (:compile-toplevel :execute) (setf *read-default-float-format* - #!+long-float 'long-float #!-long-float 'double-float)) + #+long-float 'long-float #-long-float 'double-float)) (define-move-fun (load-fp-constant 2) (vop x y) - ((fp-constant) (single-reg double-reg #!+long-float long-reg)) + ((fp-constant) (single-reg double-reg #+long-float long-reg)) (let ((value (tn-value x))) (with-empty-tn@fp-top(y) - (cond ((or (eql value 0f0) (eql value 0d0) #!+long-float (eql value 0l0)) + (cond ((or (eql value 0f0) (eql value 0d0) #+long-float (eql value 0l0)) (inst fldz)) ((= value 1e0) (inst fld1)) - #!+long-float + #+long-float ((= value (coerce pi *read-default-float-format*)) (inst fldpi)) - #!+long-float + #+long-float ((= value (log 10e0 2e0)) (inst fldl2t)) - #!+long-float + #+long-float ((= value (log 2.718281828459045235360287471352662e0 2e0)) (inst fldl2e)) - #!+long-float + #+long-float ((= value (log 2e0 10e0)) (inst fldlg2)) - #!+long-float + #+long-float ((= value (log 2e0 2.718281828459045235360287471352662e0)) (inst fldln2)) (t (warn "ignoring bogus i387 constant ~A" value)))))) @@ -239,11 +239,11 @@ (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg) :offset (1+ (tn-offset x)))) -#!+long-float +#+long-float (defun complex-long-reg-real-tn (x) (make-random-tn :kind :normal :sc (sc-or-lose 'long-reg) :offset (tn-offset x))) -#!+long-float +#+long-float (defun complex-long-reg-imag-tn (x) (make-random-tn :kind :normal :sc (sc-or-lose 'long-reg) :offset (1+ (tn-offset x)))) @@ -295,7 +295,7 @@ (inst fstd (ea-for-cdf-imag-stack y)) (inst fxch imag-tn))) -#!+long-float +#+long-float (define-move-fun (load-complex-long 2) (vop x y) ((complex-long-stack) (complex-long-reg)) (let ((real-tn (complex-long-reg-real-tn y))) @@ -305,7 +305,7 @@ (with-empty-tn@fp-top(imag-tn) (inst fldl (ea-for-clf-imag-stack x))))) -#!+long-float +#+long-float (define-move-fun (store-complex-long 2) (vop x y) ((complex-long-reg) (complex-long-stack)) (let ((real-tn (complex-long-reg-real-tn x))) @@ -349,11 +349,11 @@ (:results (y :scs (double-reg) :load-if (not (location= x y))))) (define-move-vop double-move :move (double-reg) (double-reg)) -#!+long-float +#+long-float (define-vop (long-move float-move) (:args (x :scs (long-reg) :target y :load-if (not (location= x y)))) (:results (y :scs (long-reg) :load-if (not (location= x y))))) -#!+long-float +#+long-float (define-move-vop long-move :move (long-reg) (long-reg)) ;;; complex float register to register moves @@ -395,12 +395,12 @@ (define-move-vop complex-double-move :move (complex-double-reg) (complex-double-reg)) -#!+long-float +#+long-float (define-vop (complex-long-move complex-float-move) (:args (x :scs (complex-long-reg) :target y :load-if (not (location= x y)))) (:results (y :scs (complex-long-reg) :load-if (not (location= x y))))) -#!+long-float +#+long-float (define-move-vop complex-long-move :move (complex-long-reg) (complex-long-reg)) @@ -430,7 +430,7 @@ (define-move-vop move-from-double :move (double-reg) (descriptor-reg)) -#!+long-float +#+long-float (define-vop (move-from-long) (:args (x :scs (long-reg) :to :save)) (:results (y :scs (descriptor-reg))) @@ -440,7 +440,7 @@ (fixed-alloc y long-float-widetag long-float-size node) (with-tn@fp-top(x) (store-long-float (ea-for-lf-desc y))))) -#!+long-float +#+long-float (define-move-vop move-from-long :move (long-reg) (descriptor-reg)) @@ -453,20 +453,20 @@ (1f0 (load-symbol-value y *fp-constant-1f0*)) (0d0 (load-symbol-value y *fp-constant-0d0*)) (1d0 (load-symbol-value y *fp-constant-1d0*)) - #!+long-float + #+long-float (0l0 (load-symbol-value y *fp-constant-0l0*)) - #!+long-float + #+long-float (1l0 (load-symbol-value y *fp-constant-1l0*)) - #!+long-float + #+long-float (#.pi (load-symbol-value y *fp-constant-pi*)) - #!+long-float + #+long-float (#.(log 10l0 2l0) (load-symbol-value y *fp-constant-l2t*)) - #!+long-float + #+long-float (#.(log 2.718281828459045235360287471352662L0 2l0) (load-symbol-value y *fp-constant-l2e*)) - #!+long-float + #+long-float (#.(log 2l0 10l0) (load-symbol-value y *fp-constant-lg2*)) - #!+long-float + #+long-float (#.(log 2l0 2.718281828459045235360287471352662L0) (load-symbol-value y *fp-constant-ln2*))))) (define-move-vop move-from-fp-constant :move @@ -491,7 +491,7 @@ (inst fldd (ea-for-df-desc x))))) (define-move-vop move-to-double :move (descriptor-reg) (double-reg)) -#!+long-float +#+long-float (define-vop (move-to-long) (:args (x :scs (descriptor-reg))) (:results (y :scs (long-reg))) @@ -499,7 +499,7 @@ (:generator 2 (with-empty-tn@fp-top(y) (inst fldl (ea-for-lf-desc x))))) -#!+long-float +#+long-float (define-move-vop move-to-long :move (descriptor-reg) (long-reg)) ;;; Move from complex float to a descriptor reg. allocating a new @@ -536,7 +536,7 @@ (define-move-vop move-from-complex-double :move (complex-double-reg) (descriptor-reg)) -#!+long-float +#+long-float (define-vop (move-from-complex-long) (:args (x :scs (complex-long-reg) :to :save)) (:results (y :scs (descriptor-reg))) @@ -550,7 +550,7 @@ (let ((imag-tn (complex-long-reg-imag-tn x))) (with-tn@fp-top(imag-tn) (store-long-float (ea-for-clf-imag-desc y)))))) -#!+long-float +#+long-float (define-move-vop move-from-complex-long :move (complex-long-reg) (descriptor-reg)) @@ -567,19 +567,19 @@ ,@(ecase format (:single '((inst fld (ea-for-csf-real-desc x)))) (:double '((inst fldd (ea-for-cdf-real-desc x)))) - #!+long-float + #+long-float (:long '((inst fldl (ea-for-clf-real-desc x))))))) (let ((imag-tn (complex-double-reg-imag-tn y))) (with-empty-tn@fp-top(imag-tn) ,@(ecase format (:single '((inst fld (ea-for-csf-imag-desc x)))) (:double '((inst fldd (ea-for-cdf-imag-desc x)))) - #!+long-float + #+long-float (:long '((inst fldl (ea-for-clf-imag-desc x))))))))) (define-move-vop ,name :move (descriptor-reg) (,sc))))) (frob move-to-complex-single complex-single-reg :single) (frob move-to-complex-double complex-double-reg :double) - #!+long-float + #+long-float (frob move-to-complex-double complex-long-reg :long)) ;;;; the move argument vops @@ -617,7 +617,7 @@ ,@(ecase format (:single '((inst fst ea))) (:double '((inst fstd ea))) - #!+long-float + #+long-float (:long '((store-long-float ea)))))) ;; Lisp stack (let ((ea (make-ea @@ -632,13 +632,13 @@ ,@(ecase format (:single '((inst fst ea))) (:double '((inst fstd ea))) - #!+long-float + #+long-float (:long '((store-long-float ea))))))))))) (define-move-vop ,name :move-arg (,sc descriptor-reg) (,sc))))) (frob move-single-float-arg single-reg single-stack :single) (frob move-double-float-arg double-reg double-stack :double) - #!+long-float + #+long-float (frob move-long-float-arg long-reg long-stack :long)) ;;;; complex float MOVE-ARG VOP @@ -679,7 +679,7 @@ (:double '((inst fstd (ea-for-cdf-real-stack y fp)))) - #!+long-float + #+long-float (:long '((store-long-float (ea-for-clf-real-stack y fp)))))) @@ -692,7 +692,7 @@ (:double '((inst fstd (ea-for-cdf-real-stack y fp)))) - #!+long-float + #+long-float (:long '((store-long-float (ea-for-clf-real-stack y fp))))) @@ -704,7 +704,7 @@ '((inst fst (ea-for-csf-imag-stack y fp)))) (:double '((inst fstd (ea-for-cdf-imag-stack y fp)))) - #!+long-float + #+long-float (:long '((store-long-float (ea-for-clf-imag-stack y fp))))) @@ -715,13 +715,13 @@ complex-single-reg complex-single-stack :single) (frob move-complex-double-float-arg complex-double-reg complex-double-stack :double) - #!+long-float + #+long-float (frob move-complex-long-float-arg complex-long-reg complex-long-stack :long)) (define-move-vop move-arg :move-arg - (single-reg double-reg #!+long-float long-reg - complex-single-reg complex-double-reg #!+long-float complex-long-reg) + (single-reg double-reg #+long-float long-reg + complex-single-reg complex-double-reg #+long-float complex-long-reg) (descriptor-reg)) @@ -760,7 +760,7 @@ fop fopr sname scost fopd foprd dname dcost lname lcost) - #!-long-float (declare (ignore lcost lname)) + #-long-float (declare (ignore lcost lname)) `(progn (define-vop (,sname) (:translate ,op) @@ -1044,7 +1044,7 @@ (double-stack (inst fstd (ea-for-df-stack r)))))))) - #!+long-float + #+long-float (define-vop (,lname) (:translate ,op) (:args (x :scs (long-reg) :to :eval) @@ -1169,11 +1169,11 @@ (frob abs/single-float fabs abs single-reg single-float) (frob abs/double-float fabs abs double-reg double-float) - #!+long-float + #+long-float (frob abs/long-float fabs abs long-reg long-float) (frob %negate/single-float fchs %negate single-reg single-float) (frob %negate/double-float fchs %negate double-reg double-float) - #!+long-float + #+long-float (frob %negate/long-float fchs %negate long-reg long-float)) ;;;; comparison @@ -1222,7 +1222,7 @@ (y :scs (double-reg))) (:arg-types double-float double-float)) -#!+long-float +#+long-float (define-vop (=/long-float =/float) (:translate =) (:args (x :scs (long-reg)) @@ -1327,7 +1327,7 @@ (inst and ah-tn #x45) ; C3 C2 C0 (inst cmp ah-tn #x01))))) -#!+long-float +#+long-float (define-vop (long-float) (:translate >) (:args (x :scs (long-reg)) @@ -1531,7 +1531,7 @@ (:args (x :scs (double-reg))) (:arg-types double-float (:constant (double-float 0d0 0d0))) (:variant #x40)) -#!+long-float +#+long-float (define-vop (=0/long-float float-test) (:translate =) (:args (x :scs (long-reg))) @@ -1548,7 +1548,7 @@ (:args (x :scs (double-reg))) (:arg-types double-float (:constant (double-float 0d0 0d0))) (:variant #x01)) -#!+long-float +#+long-float (define-vop (<0/long-float float-test) (:translate <) (:args (x :scs (long-reg))) @@ -1565,14 +1565,14 @@ (:args (x :scs (double-reg))) (:arg-types double-float (:constant (double-float 0d0 0d0))) (:variant #x00)) -#!+long-float +#+long-float (define-vop (>0/long-float float-test) (:translate >) (:args (x :scs (long-reg))) (:arg-types long-float (:constant (long-float 0l0 0l0))) (:variant #x00)) -#!+long-float +#+long-float (deftransform eql ((x y) (long-float long-float)) `(and (= (long-float-low-bits x) (long-float-low-bits y)) (= (long-float-high-bits x) (long-float-high-bits y)) @@ -1605,7 +1605,7 @@ (inst fild x)))))))) (frob %single-float/signed %single-float single-reg single-float) (frob %double-float/signed %double-float double-reg double-float) - #!+long-float + #+long-float (frob %long-float/signed %long-float long-reg long-float)) (macrolet ((frob (name translate to-sc to-type) @@ -1628,7 +1628,7 @@ (inst add esp-tn 8))))) (frob %single-float/unsigned %single-float single-reg single-float) (frob %double-float/unsigned %double-float double-reg double-float) - #!+long-float + #+long-float (frob %long-float/unsigned %long-float long-reg long-float)) (macrolet ((frob (name translate from-sc from-type to-sc to-type @@ -1671,20 +1671,20 @@ (frob %single-float/double-float %single-float double-reg double-float single-reg single-float single-stack fst fld) - #!+long-float + #+long-float (frob %single-float/long-float %single-float long-reg long-float single-reg single-float single-stack fst fld) (frob %double-float/single-float %double-float single-reg single-float double-reg double-float) - #!+long-float + #+long-float (frob %double-float/long-float %double-float long-reg long-float double-reg double-float double-stack fstd fldd) - #!+long-float + #+long-float (frob %long-float/single-float %long-float single-reg single-float long-reg long-float) - #!+long-float + #+long-float (frob %long-float/double-float %long-float double-reg double-float long-reg long-float)) @@ -1727,11 +1727,11 @@ '((inst fldcw scw))))))))) (frob %unary-truncate/single-float single-reg single-float nil) (frob %unary-truncate/double-float double-reg double-float nil) - #!+long-float + #+long-float (frob %unary-truncate/long-float long-reg long-float nil) (frob %unary-round single-reg single-float t) (frob %unary-round double-reg double-float t) - #!+long-float + #+long-float (frob %unary-round long-reg long-float t)) (macrolet ((frob (trans from-sc from-type round-p) @@ -1774,11 +1774,11 @@ '((inst fldcw scw))))))) (frob %unary-truncate/single-float single-reg single-float nil) (frob %unary-truncate/double-float double-reg double-float nil) - #!+long-float + #+long-float (frob %unary-truncate/long-float long-reg long-float nil) (frob %unary-round single-reg single-float t) (frob %unary-round double-reg double-float t) - #!+long-float + #+long-float (frob %unary-round long-reg long-float t)) (define-vop (make-single-float) @@ -1861,7 +1861,7 @@ (inst fldd (register-inline-constant :double-float-bits (logior (ash hi 32) lo)))))) -#!+long-float +#+long-float (define-vop (make-long-float) (:args (exp-bits :scs (signed-reg)) (hi-bits :scs (unsigned-reg)) @@ -1960,7 +1960,7 @@ (loadw lo-bits float double-float-value-slot other-pointer-lowtag))))) -#!+long-float +#+long-float (define-vop (long-float-exp-bits) (:args (float :scs (long-reg descriptor-reg) :load-if (not (sc-is float long-stack)))) @@ -1990,7 +1990,7 @@ (make-ea-for-object-slot float (+ 2 long-float-value-slot) other-pointer-lowtag :word)))))) -#!+long-float +#+long-float (define-vop (long-float-high-bits) (:args (float :scs (long-reg descriptor-reg) :load-if (not (sc-is float long-stack)))) @@ -2015,7 +2015,7 @@ (loadw hi-bits float (1+ long-float-value-slot) other-pointer-lowtag))))) -#!+long-float +#+long-float (define-vop (long-float-low-bits) (:args (float :scs (long-reg descriptor-reg) :load-if (not (sc-is float long-stack)))) @@ -2093,7 +2093,7 @@ (inst add esp-tn npx-env-size) ; Pop stack. (move res new))) -#!-long-float +#-long-float (progn ;;; Let's use some of the 80387 special functions. @@ -3101,7 +3101,7 @@ (t (inst fstd r))))) ) ; PROGN #!-LONG-FLOAT -#!+long-float +#+long-float (progn ;;; Lets use some of the 80387 special functions. @@ -4167,7 +4167,7 @@ (inst fstd (ea-for-cdf-imag-stack r)) (inst fxch imag))))) -#!+long-float +#+long-float (define-vop (make-complex-long-float) (:translate complex) (:args (real :scs (long-reg) :target r @@ -4220,7 +4220,7 @@ (:policy :fast-safe) (:generator 3 (cond ((sc-is x complex-single-reg complex-double-reg - #!+long-float complex-long-reg) + #+long-float complex-long-reg) (let ((value-tn (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg) @@ -4258,7 +4258,7 @@ (1 (ea-for-cdf-imag-desc x))))))) (with-empty-tn@fp-top(r) (inst fldd ea)))) - #!+long-float + #+long-float ((sc-is r long-reg) (let ((ea (sc-case x (complex-long-stack @@ -4293,7 +4293,7 @@ (:note "complex float realpart") (:variant 0)) -#!+long-float +#+long-float (define-vop (realpart/complex-long-float complex-float-value) (:translate realpart) (:args (x :scs (complex-long-reg complex-long-stack descriptor-reg) @@ -4324,7 +4324,7 @@ (:note "complex float imagpart") (:variant 1)) -#!+long-float +#+long-float (define-vop (imagpart/complex-long-float complex-float-value) (:translate imagpart) (:args (x :scs (complex-long-reg complex-long-stack descriptor-reg) diff --git a/src/compiler/x86/sap.lisp b/src/compiler/x86/sap.lisp index 8009bea80..ec5b64263 100644 --- a/src/compiler/x86/sap.lisp +++ b/src/compiler/x86/sap.lisp @@ -408,8 +408,8 @@ (:args (sap :scs (sap-reg)) (offset :scs (signed-reg))) (:arg-types system-area-pointer signed-num) - (:results (result :scs (#!+long-float long-reg #!-long-float double-reg))) - (:result-types #!+long-float long-float #!-long-float double-float) + (:results (result :scs (#+long-float long-reg #-long-float double-reg))) + (:result-types #+long-float long-float #-long-float double-float) (:generator 5 (with-empty-tn@fp-top(result) (inst fldl (make-ea :dword :base sap :index offset))))) @@ -420,13 +420,13 @@ (:args (sap :scs (sap-reg))) (:arg-types system-area-pointer (:constant (signed-byte 32))) (:info offset) - (:results (result :scs (#!+long-float long-reg #!-long-float double-reg))) - (:result-types #!+long-float long-float #!-long-float double-float) + (:results (result :scs (#+long-float long-reg #-long-float double-reg))) + (:result-types #+long-float long-float #-long-float double-float) (:generator 4 (with-empty-tn@fp-top(result) (inst fldl (make-ea :dword :base sap :disp offset))))) -#!+long-float +#+long-float (define-vop (%set-sap-ref-long) (:translate %set-sap-ref-long) (:policy :fast-safe) diff --git a/src/compiler/x86/vm.lisp b/src/compiler/x86/vm.lisp index e2b498756..b8ee03edd 100644 --- a/src/compiler/x86/vm.lisp +++ b/src/compiler/x86/vm.lisp @@ -146,11 +146,11 @@ (sap-stack stack) ; System area pointers. (single-stack stack) ; single-floats (double-stack stack :element-size 2) ; double-floats. - #!+long-float + #+long-float (long-stack stack :element-size 3) ; long-floats. (complex-single-stack stack :element-size 2) ; complex-single-floats (complex-double-stack stack :element-size 4) ; complex-double-floats - #!+long-float + #+long-float (complex-long-stack stack :element-size 6) ; complex-long-floats ;; @@ -253,7 +253,7 @@ :alternate-scs (double-stack)) ;; non-descriptor LONG-FLOATs - #!+long-float + #+long-float (long-reg float-registers :locations (0 1 2 3 4 5 6 7) :constant-scs (fp-constant) @@ -274,7 +274,7 @@ :save-p t :alternate-scs (complex-double-stack)) - #!+long-float + #+long-float (complex-long-reg float-registers :locations (0 2 4 6) :element-size 2 @@ -361,7 +361,7 @@ (case value ((0d0 1d0) fp-constant-sc-number) (t fp-double-immediate-sc-number))) - #!+long-float + #+long-float (long-float (when (or (eql value 0l0) (eql value 1l0) (eql value pi)