From 00a3e3481193cfac421ed3a866e6dadb1da3aa4b Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Wed, 1 Mar 2023 08:59:50 -0800 Subject: [PATCH 01/26] Address #156: Add vops for <= and >= Add vops to handle the comparisons `<=` and `>=` for both 32-bit signed and unsigned words and for single-float and double-float. This isn't used by the compiler yet, but we can test this by compiling lisp and using the new lisp and compiling ``` (c::def-source-transform <= (&rest args) (c::multi-compare '<= args nil)) ``` Then we can compile this test code: ``` (defun c<= (x y) (declare (single-float x y)) (<= x y)) (defun si-<= (x y) (declare (type (signed-byte 32) x y)) (<= x y)) (defun ui-<= (x y) (declare (type (unsigned-byte 32) x y)) (<= x y)) ``` The key parts of the disassembly are then: ``` * (disassemble 'c<=) ... 96: comiss xmm0, [edi-3] ; No-arg-parsing entry point ; [:non-local-entry] 9a: jp L0 9c: jbe L2 ;;; [6] (<= X Y) 9e: L0: mov edx, 2800000b ; nil ; [:block-start] a3: L1: mov ecx, dword ptr [ebp-8] ; [:block-start] ... b2: L2: mov edx, 28000027 ; t ; [:block-start] b7: jmp L1 ... ``` For the word operations, we can see ``` * (disassemble 'si-<=) ... ef4: L10: cmp ebx, edi ; No-arg-parsing entry point ; [:non-local-entry] ef6: jle L12 ... * (disassemble 'ui-<=) ... 8f6: L18: cmp ebx, edi ; No-arg-parsing entry point ; [:non-local-entry] 8f8: jbe L20 ... ``` To test handling of NaN, we have ``` * (set-floating-point-modes :traps nil) * (defvar *sn* (* 0 ext:single-float-positive-infinity)) * (c<= 1.0 2.0) T * (c<= 2.0 2.0) T * (c<= 3.0 2.0) NIL * (c<= 1.0 *sn*) NIL * (c<= *sn* 1.0) NIL * (c<= *sn* *sn*) NIL ``` This are the expected result when comparing with NaN. --- src/compiler/x86/arith.lisp | 5 +++-- src/compiler/x86/float-sse2.lisp | 6 +++++- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp index b5c396503..2768b92a8 100644 --- a/src/compiler/x86/arith.lisp +++ b/src/compiler/x86/arith.lisp @@ -1039,8 +1039,9 @@ '(t t t t nil nil)))) (define-conditional-vop < :l :b :ge :ae) - +(define-conditional-vop <= :le :be :g :a) (define-conditional-vop > :g :a :le :be) +(define-conditional-vop >= :ge :ae :l :b) (define-vop (fast-if-eql/signed fast-conditional/signed) (:translate eql) @@ -1907,4 +1908,4 @@ vm:other-pointer-type)) s1))) ) - \ No newline at end of file + diff --git a/src/compiler/x86/float-sse2.lisp b/src/compiler/x86/float-sse2.lisp index 2a22f0138..4fabdf24d 100644 --- a/src/compiler/x86/float-sse2.lisp +++ b/src/compiler/x86/float-sse2.lisp @@ -972,9 +972,13 @@ (inst jmp ,yep target) (emit-label not-lab))))))))) (frob < single comiss :b :nb) + (frob <= single comiss :be :nbe) (frob > single comiss :a :na) + (frob >= single comiss :ae :nae) (frob < double comisd :b :nb) - (frob > double comisd :a :na)) + (frob <= double comisd :be :nbe) + (frob > double comisd :a :na) + (frob >= double comisd :ae :naa)) ;;;; Conversion: -- GitLab From 892fe1bc43a8bf593a49c8c5f43335630fbee8d1 Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Wed, 1 Mar 2023 10:53:15 -0800 Subject: [PATCH 02/26] Address #156: Add two-arg-<= and two-arg->= This brings us more in line with sparc and ppc. Also, x86 didn't define static functions for `two-arg-<`, `two-arg->`, `two-arg-=`, and `two-arg-/=`. Also add `generic-<=` and `generic->=` for consistency with sparc and ppc. Don't know why these aren't defined for x86, but let's add them for consistency with sparc and ppc. --- src/assembly/x86/arith.lisp | 2 ++ src/compiler/x86/arith.lisp | 9 ++++++++- src/compiler/x86/parms.lisp | 4 ++++ 3 files changed, 14 insertions(+), 1 deletion(-) diff --git a/src/assembly/x86/arith.lisp b/src/assembly/x86/arith.lisp index 5d6d432c0..f18edd499 100644 --- a/src/assembly/x86/arith.lisp +++ b/src/assembly/x86/arith.lisp @@ -214,7 +214,9 @@ ); eval-when (define-cond-assem-rtn generic-< < two-arg-< :l) +(define-cond-assem-rtn generic-<= <= two-arg-<= :le) (define-cond-assem-rtn generic-> > two-arg-> :g) +(define-cond-assem-rtn generic->= >= two-arg->= :ge) (define-assembly-routine (generic-eql (:cost 10) diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp index b5c396503..e610596e0 100644 --- a/src/compiler/x86/arith.lisp +++ b/src/compiler/x86/arith.lisp @@ -1506,6 +1506,13 @@ (define-static-function two-arg-/ (x y) :translate /) +(define-static-function two-arg-< (x y) :translate <) +(define-static-function two-arg-<= (x y) :translate <=) +(define-static-function two-arg-> (x y) :translate >) +(define-static-function two-arg->= (x y) :translate >=) +(define-static-function two-arg-= (x y) :translate =) +(define-static-function two-arg-/= (x y) :translate /=) + (define-static-function two-arg-gcd (x y) :translate gcd) (define-static-function two-arg-lcm (x y) :translate lcm) @@ -1907,4 +1914,4 @@ vm:other-pointer-type)) s1))) ) - \ No newline at end of file + diff --git a/src/compiler/x86/parms.lisp b/src/compiler/x86/parms.lisp index 0b5235705..efbac7351 100644 --- a/src/compiler/x86/parms.lisp +++ b/src/compiler/x86/parms.lisp @@ -395,10 +395,14 @@ *static-blue-bag* ; Must be last or change C code )) +;; FIXME: This should be reordered to match more closely the order +;; used for sparc and ppc. However, I (rtoy) think that requires a +;; cross-compile. (defparameter static-functions '(length two-arg-+ two-arg-- two-arg-* two-arg-/ two-arg-< two-arg-> two-arg-= eql %negate two-arg-and two-arg-ior two-arg-xor two-arg-gcd two-arg-lcm + two-arg-<= two-arg->= two-arg-/= )) ;;; -- GitLab From 62d141d795281b5bfe99752a980706a15b444208 Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Wed, 1 Mar 2023 17:09:05 -0800 Subject: [PATCH 03/26] Fix typo: :naa should be :nae --- src/compiler/x86/float-sse2.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/compiler/x86/float-sse2.lisp b/src/compiler/x86/float-sse2.lisp index 4fabdf24d..63de39ae6 100644 --- a/src/compiler/x86/float-sse2.lisp +++ b/src/compiler/x86/float-sse2.lisp @@ -978,7 +978,7 @@ (frob < double comisd :b :nb) (frob <= double comisd :be :nbe) (frob > double comisd :a :na) - (frob >= double comisd :ae :naa)) + (frob >= double comisd :ae :nae)) ;;;; Conversion: -- GitLab From 9ca44f6d211c5e7624f4e89bb4e2485f6560be99 Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Thu, 2 Mar 2023 10:41:16 -0800 Subject: [PATCH 04/26] Add bootstrap file for CI Forgot to add boot-2021-07-3.lisp that's required to add the new static functions for x86. --- .gitlab-ci.yml | 2 +- src/bootfiles/21d/boot-2021-07-3.lisp | 14 ++++++++++++++ 2 files changed, 15 insertions(+), 1 deletion(-) create mode 100644 src/bootfiles/21d/boot-2021-07-3.lisp diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 3824a76e8..c483cd1b5 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -1,7 +1,7 @@ variables: download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/2021/07" version: "2021-07-x86" - bootstrap: "-B boot-2021-07-1 -B boot-2021-07-2" + bootstrap: "-B boot-2021-07-1 -B boot-2021-07-2 -B boot-2021-07-3" stages: - install diff --git a/src/bootfiles/21d/boot-2021-07-3.lisp b/src/bootfiles/21d/boot-2021-07-3.lisp new file mode 100644 index 000000000..33ac5481e --- /dev/null +++ b/src/bootfiles/21d/boot-2021-07-3.lisp @@ -0,0 +1,14 @@ +;; Bootstrap file for x86 to add two-arg->= and two-arg-<= to static +;; functions list. +;; +;; Use bin/build.sh -B boot-2021-07-3 to build this (along with any +;; other bootfiles that are still needed). +(in-package :x86) +#+x86 +(ext:without-package-locks + (defparameter static-functions + '(length + two-arg-+ two-arg-- two-arg-* two-arg-/ two-arg-< two-arg-> two-arg-= eql + %negate two-arg-and two-arg-ior two-arg-xor two-arg-gcd two-arg-lcm + two-arg-<= two-arg->= two-arg-/= + ))) -- GitLab From 0b4ec82d2de83ee986b48218fac1b0ff0c2a6b7a Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Thu, 2 Mar 2023 10:50:47 -0800 Subject: [PATCH 05/26] Add x86 reader conditional Don't set package to "X86" if we're not building on x86. One less thing to worry about when bootstrapping. --- src/bootfiles/21d/boot-2021-07-3.lisp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/bootfiles/21d/boot-2021-07-3.lisp b/src/bootfiles/21d/boot-2021-07-3.lisp index 33ac5481e..821b7384b 100644 --- a/src/bootfiles/21d/boot-2021-07-3.lisp +++ b/src/bootfiles/21d/boot-2021-07-3.lisp @@ -3,7 +3,9 @@ ;; ;; Use bin/build.sh -B boot-2021-07-3 to build this (along with any ;; other bootfiles that are still needed). +#+x86 (in-package :x86) + #+x86 (ext:without-package-locks (defparameter static-functions -- GitLab From 4a2498625db26616238341d2cce8bf0f5a26465e Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Tue, 7 Mar 2023 10:03:23 -0800 Subject: [PATCH 06/26] Implement two-arg-<= and two-arg->= for x86 These are needed so that we can handle `<=` and `>=` comparisons when we don't convert `<=` to `>` and `>=` to `>` in `multi-compare`. --- src/code/numbers.lisp | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp index 4caf12f90..b8cf2582a 100644 --- a/src/code/numbers.lisp +++ b/src/code/numbers.lisp @@ -1033,6 +1033,24 @@ ((bignum bignum) (plusp (bignum-compare x y)))) +#+x86 +(two-arg- two-arg-<= <= floor ceiling + ((fixnum bignum) + (bignum-plus-p y)) + ((bignum fixnum) + (not (bignum-plus-p x))) + ((bignum bignum) + (not (plusp (bignum-compare x y))))) + +#+x86 +(two-arg- two-arg->= >= ceiling floor + ((fixnum bignum) + (not (bignum-plus-p y))) + ((bignum fixnum) + (bignum-plus-p x)) + ((bignum bignum) + (not (minusp (bignum-compare x y))))) + (defun two-arg-= (x y) (number-dispatch ((x number) (y number)) -- GitLab From 32586b5ae2dd2f6c6bffa504e52e2777b2f57ea4 Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Tue, 7 Mar 2023 10:04:55 -0800 Subject: [PATCH 07/26] Handle <= and >= for double-doubles If we don't convert `<=` to '>` in the source transforms, we need to handle `<=` when applied to double-doubles. --- src/compiler/float-tran-dd.lisp | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/src/compiler/float-tran-dd.lisp b/src/compiler/float-tran-dd.lisp index 93de466bc..5fb91afb6 100644 --- a/src/compiler/float-tran-dd.lisp +++ b/src/compiler/float-tran-dd.lisp @@ -687,4 +687,17 @@ (kernel:double-double-lo a) (kernel:double-double-hi b) (kernel:double-double-lo b))) + +(deftransform <= ((a b) (vm::double-double-float vm::double-double-float) *) + `(not (dd> (kernel:double-double-hi b) + (kernel:double-double-lo b) + (kernel:double-double-hi a) + (kernel:double-double-lo a)))) + + +(deftransform >= ((a b) (vm::double-double-float vm::double-double-float) *) + `(not (dd< (kernel:double-double-hi b) + (kernel:double-double-lo b) + (kernel:double-double-hi a) + (kernel:double-double-lo a)))) ) ; end progn -- GitLab From c1caff648899f0b2cae4ec1b58bb3e171832215e Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Tue, 7 Mar 2023 10:06:24 -0800 Subject: [PATCH 08/26] Don't transform <= and >= to > and <, respectively. To handle NaN we don't transform `<=` to '>`. We can handle `<=` directly now since we've added the necessary functions and vops to handle these for both fixnums and floats. --- src/compiler/srctran.lisp | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index 14c353c10..e6e6362f8 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -3598,8 +3598,14 @@ (def-source-transform = (&rest args) (multi-compare '= args nil)) (def-source-transform < (&rest args) (multi-compare '< args nil)) (def-source-transform > (&rest args) (multi-compare '> args nil)) -(def-source-transform <= (&rest args) (multi-compare '> args t)) -(def-source-transform >= (&rest args) (multi-compare '< args t)) +#-x86 +(progn + (def-source-transform <= (&rest args) (multi-compare '> args t)) + (def-source-transform >= (&rest args) (multi-compare '< args t))) +#+x86 +(progn + (def-source-transform <= (&rest args) (multi-compare '<= args nil)) + (def-source-transform >= (&rest args) (multi-compare '>= args nil))) (def-source-transform char= (&rest args) (multi-compare 'char= args nil)) (def-source-transform char< (&rest args) (multi-compare 'char< args nil)) -- GitLab From 4e9213513b572059b56804f708691a399e5e6577 Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Tue, 7 Mar 2023 10:25:44 -0800 Subject: [PATCH 09/26] Add dd>= and dd<= to handle <= and >= The previous implementation didn't handle NaN correctly because `(<= a0 b0)` would return NIL correctly for NaN, but then we'd invert that with `NOT`, returning `T`. Implement this directly. --- src/compiler/float-tran-dd.lisp | 28 +++++++++++++++++++--------- 1 file changed, 19 insertions(+), 9 deletions(-) diff --git a/src/compiler/float-tran-dd.lisp b/src/compiler/float-tran-dd.lisp index 5fb91afb6..171aa9932 100644 --- a/src/compiler/float-tran-dd.lisp +++ b/src/compiler/float-tran-dd.lisp @@ -667,7 +667,17 @@ (or (> a0 b0) (and (= a0 b0) (> a1 b1)))) - + +(declaim (inline dd<=)) +(defun dd<= (a0 a1 b0 b1) + (and (<= a0 b0) + (<= a1 b1))) + +(declaim (inline dd>=)) +(defun dd>= (a0 a1 b0 b1) + (and (>= a0 b0) + (>= a1 b1))) + (deftransform = ((a b) (vm::double-double-float vm::double-double-float) *) `(dd= (kernel:double-double-hi a) (kernel:double-double-lo a) @@ -689,15 +699,15 @@ (kernel:double-double-lo b))) (deftransform <= ((a b) (vm::double-double-float vm::double-double-float) *) - `(not (dd> (kernel:double-double-hi b) - (kernel:double-double-lo b) - (kernel:double-double-hi a) - (kernel:double-double-lo a)))) + `(dd<= (kernel:double-double-hi b) + (kernel:double-double-lo b) + (kernel:double-double-hi a) + (kernel:double-double-lo a))) (deftransform >= ((a b) (vm::double-double-float vm::double-double-float) *) - `(not (dd< (kernel:double-double-hi b) - (kernel:double-double-lo b) - (kernel:double-double-hi a) - (kernel:double-double-lo a)))) + `(dd>= (kernel:double-double-hi b) + (kernel:double-double-lo b) + (kernel:double-double-hi a) + (kernel:double-double-lo a))) ) ; end progn -- GitLab From c139d6d5ce1d768e617d11934f70d6c7994fb2e7 Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Tue, 7 Mar 2023 10:28:05 -0800 Subject: [PATCH 10/26] Add some comments. --- src/code/numbers.lisp | 35 +++++++++++++++++++---------------- src/compiler/srctran.lisp | 4 ++++ 2 files changed, 23 insertions(+), 16 deletions(-) diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp index b8cf2582a..7c3c4f0b4 100644 --- a/src/code/numbers.lisp +++ b/src/code/numbers.lisp @@ -1033,23 +1033,26 @@ ((bignum bignum) (plusp (bignum-compare x y)))) +;; This should probably be used for all architectures, but we've only +;; written all the necessary support only on x86, currently. See +;; issue #156. #+x86 -(two-arg- two-arg-<= <= floor ceiling - ((fixnum bignum) - (bignum-plus-p y)) - ((bignum fixnum) - (not (bignum-plus-p x))) - ((bignum bignum) - (not (plusp (bignum-compare x y))))) - -#+x86 -(two-arg- two-arg->= >= ceiling floor - ((fixnum bignum) - (not (bignum-plus-p y))) - ((bignum fixnum) - (bignum-plus-p x)) - ((bignum bignum) - (not (minusp (bignum-compare x y))))) +(progn + (two-arg- two-arg-<= <= floor ceiling + ((fixnum bignum) + (bignum-plus-p y)) + ((bignum fixnum) + (not (bignum-plus-p x))) + ((bignum bignum) + (not (plusp (bignum-compare x y))))) + + (two-arg- two-arg->= >= ceiling floor + ((fixnum bignum) + (not (bignum-plus-p y))) + ((bignum fixnum) + (bignum-plus-p x)) + ((bignum bignum) + (not (minusp (bignum-compare x y)))))) (defun two-arg-= (x y) diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index e6e6362f8..aff736fb8 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -3598,6 +3598,10 @@ (def-source-transform = (&rest args) (multi-compare '= args nil)) (def-source-transform < (&rest args) (multi-compare '< args nil)) (def-source-transform > (&rest args) (multi-compare '> args nil)) +;; We want to handle <= directly as <= instead of transforming to >. +;; This is needed to handle NaN values. See issue #156. This should +;; probably apply to all architectures, but we've only implemented the +;; necessary changes for x86 right now. #-x86 (progn (def-source-transform <= (&rest args) (multi-compare '> args t)) -- GitLab From bd505bab9b50e50016cea7c1207ceb06b86a1f22 Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Wed, 8 Mar 2023 07:51:50 -0800 Subject: [PATCH 11/26] Use existing function to compute >= and <= The code assumed if a0 >= b0 and a1 >= b1 implied a >= b for a bigfloat. But I forgot that 1.99999...w0 is represented as 2d0 and a tiny negative number. So `(<= 2w0 1.99999...w0)` would return false because, while a0 <= b0, a1 <= b1 is false. So for simplicity just use the obvious replacement that a <= b is the same as a < b or a = b, which we already have. [skip ci] --- src/compiler/float-tran-dd.lisp | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/compiler/float-tran-dd.lisp b/src/compiler/float-tran-dd.lisp index 171aa9932..c13f4487e 100644 --- a/src/compiler/float-tran-dd.lisp +++ b/src/compiler/float-tran-dd.lisp @@ -670,13 +670,13 @@ (declaim (inline dd<=)) (defun dd<= (a0 a1 b0 b1) - (and (<= a0 b0) - (<= a1 b1))) + (or (dd> a0 a1 b0 b1) + (dd= a0 a1 b0 b1))) (declaim (inline dd>=)) (defun dd>= (a0 a1 b0 b1) - (and (>= a0 b0) - (>= a1 b1))) + (or (dd> a0 a1 b0 b1) + (dd= a0 a1 b0 b1))) (deftransform = ((a b) (vm::double-double-float vm::double-double-float) *) `(dd= (kernel:double-double-hi a) -- GitLab From 64c9296fa3ff2c5a0b8fd5d5f0199996f2a3ea2b Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Thu, 9 Mar 2023 19:49:21 -0800 Subject: [PATCH 12/26] Fix errors in dd >= and <= implmeentation For `dd<=`, we accidentally used `dd>` instead of `dd<`. Oops. The deftransforms had swapped the args because of a previous implementation that we changed, but we forgot to revert the swapping. Now `(describe decode-float)` correctly returns ``` (VALUES (OR (SINGLE-FLOAT 0.5 (1.0)) (DOUBLE-FLOAT 0.5d0 (1.0d0)) (DOUBLE-DOUBLE-FLOAT 0.5w0 (1.0w0))) KERNEL:DOUBLE-FLOAT-EXPONENT (OR (SINGLE-FLOAT 1.0 1.0) (SINGLE-FLOAT -1.0 -1.0) (DOUBLE-FLOAT -1.0d0 -1.0d0) (DOUBLE-FLOAT 1.0d0 1.0d0) (DOUBLE-DOUBLE-FLOAT -1.0w0 -1.0w0) (DOUBLE-DOUBLE-FLOAT 1.0w0 1.0w0))) ``` like we used to. --- src/compiler/float-tran-dd.lisp | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/compiler/float-tran-dd.lisp b/src/compiler/float-tran-dd.lisp index c13f4487e..ee1c07fd2 100644 --- a/src/compiler/float-tran-dd.lisp +++ b/src/compiler/float-tran-dd.lisp @@ -670,7 +670,7 @@ (declaim (inline dd<=)) (defun dd<= (a0 a1 b0 b1) - (or (dd> a0 a1 b0 b1) + (or (dd< a0 a1 b0 b1) (dd= a0 a1 b0 b1))) (declaim (inline dd>=)) @@ -699,15 +699,15 @@ (kernel:double-double-lo b))) (deftransform <= ((a b) (vm::double-double-float vm::double-double-float) *) - `(dd<= (kernel:double-double-hi b) - (kernel:double-double-lo b) - (kernel:double-double-hi a) - (kernel:double-double-lo a))) + `(dd<= (kernel:double-double-hi a) + (kernel:double-double-lo a) + (kernel:double-double-hi b) + (kernel:double-double-lo b))) (deftransform >= ((a b) (vm::double-double-float vm::double-double-float) *) - `(dd>= (kernel:double-double-hi b) - (kernel:double-double-lo b) - (kernel:double-double-hi a) - (kernel:double-double-lo a))) + `(dd>= (kernel:double-double-hi a) + (kernel:double-double-lo a) + (kernel:double-double-hi b) + (kernel:double-double-lo b))) ) ; end progn -- GitLab From 60c3920704106eef2bc45ee41ef39170e7ec38be Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Fri, 10 Mar 2023 14:51:32 -0800 Subject: [PATCH 13/26] Split the <= and >= macros from the others When !129 lands we'll probably need to rework the vops for <= and >=, so let's split these out now, even if they're basically duplicating the code. The < and > vops are going to be replaced, and I have not thought exactly how these will fit with < and > yet. But since <= and >= don't quite fully work, keep them separate. --- src/compiler/x86/float-sse2.lisp | 36 +++++++++++++++++++++++++++++--- 1 file changed, 33 insertions(+), 3 deletions(-) diff --git a/src/compiler/x86/float-sse2.lisp b/src/compiler/x86/float-sse2.lisp index 63de39ae6..2936d6ae7 100644 --- a/src/compiler/x86/float-sse2.lisp +++ b/src/compiler/x86/float-sse2.lisp @@ -972,12 +972,42 @@ (inst jmp ,yep target) (emit-label not-lab))))))))) (frob < single comiss :b :nb) - (frob <= single comiss :be :nbe) (frob > single comiss :a :na) - (frob >= single comiss :ae :nae) (frob < double comisd :b :nb) + (frob > double comisd :a :na)) + + + +(macrolet + ((frob (op size inst yep nope) + (let ((ea (ecase size + (single + 'ea-for-sf-desc) + (double + 'ea-for-df-desc))) + (name (symbolicate op "/" size "-FLOAT")) + (sc-type (symbolicate size "-REG")) + (inherit (symbolicate size "-FLOAT-COMPARE"))) + `(define-vop (,name ,inherit) + (:translate ,op) + (:info target not-p) + (:generator 3 + (sc-case y + (,sc-type + (inst ,inst x y)) + (descriptor-reg + (inst ,inst x (,ea y)))) + (cond (not-p + (inst jmp :p target) + (inst jmp ,nope target)) + (t + (let ((not-lab (gen-label))) + (inst jmp :p not-lab) + (inst jmp ,yep target) + (emit-label not-lab))))))))) + (frob <= single comiss :be :nbe) + (frob >= single comiss :ae :nae) (frob <= double comisd :be :nbe) - (frob > double comisd :a :na) (frob >= double comisd :ae :nae)) -- GitLab From 7ae79da601d4a56ba939417fb244244be8c7a431 Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Fri, 10 Mar 2023 18:37:11 -0800 Subject: [PATCH 14/26] Add deftransform for >= and <= for integers. See the comments in the code for this change. I'm not sure this is what we want, but the testsuite passes now when it was previously failing. The failure had something to do with utf-16-be external format and there were warnings about `(>= foo 0)` having to use `generic->=` because the first type was `unsigned-byte`. This doesn't happen anymore. --- src/compiler/srctran.lisp | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index aff736fb8..0864c0f06 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -3537,6 +3537,29 @@ (deftransform > ((x y) (real real) * :when :both) (ir1-transform-< y x x y '<)) + +#+x86 +(progn + ;; When x and y are integers, we want to transform <= to > and >= to + ;; <. But we don't want to do this for floats because it messes up + ;; comparisons with NaN. + ;; + ;; I'm not sure about this. The transformation is right, but + ;; perhaps what we really need is an ir-transform-<= to determine x + ;; <= y is definitely true or false, like for ir1-transform-<. + ;; + ;; For now this allows the testsuite to pass. Perhaps there's a bug + ;; in generic->=? + (deftransform <= ((x y) (integer integer) * :when :both) + ;; (<= x y) is the same as (not (> x y)) + `(not (> x y))) + + + (deftransform >= ((x y) (integer integer) * :when :both) + ;; (>= x y) is the same as (not (< x y)) + `(not (< x y)))) + + ;; Like IR1-TRANSFORM-< but for CHAR<. This is needed so that the ;; vops for base-char comparison with a constant gets used when the ;; first arg is the constant. -- GitLab From dd3bbe83eeb868486a31d46c41d905bbcb2dad9d Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Sat, 11 Mar 2023 15:25:33 -0800 Subject: [PATCH 15/26] Add deftransforms for >= for floats and rationals Add a deftransform for >= (and <=) to hande when the two args are different types of floats, just like how < is done. Likewise, add a deftransform to handle comparisons between a float and rational. This is the same as how it's handled for < and friends. --- src/compiler/float-tran.lisp | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp index f4d4843e0..199195241 100644 --- a/src/compiler/float-tran.lisp +++ b/src/compiler/float-tran.lisp @@ -568,7 +568,7 @@ (%deftransform x '(function (rational float) *) #'float-contagion-arg1) (%deftransform x '(function (float rational) *) #'float-contagion-arg2)) -(dolist (x '(= < > + * / -)) +(dolist (x '(= < > + * / - #+x86 <= #+x86 >=)) (%deftransform x '(function (single-float double-float) *) #'float-contagion-arg1) (%deftransform x '(function (double-float single-float) *) @@ -591,7 +591,11 @@ `(,',op x (float y x))))) (frob <) (frob >) - (frob =)) + (frob =) + #+x86 + (frob <=) + #+x86 + (frob >=)) ;; Convert (/ x n) to (* x (/ n)) when x is a float and n is a power ;; of two, because (/ n) can be reprsented exactly. -- GitLab From 8bb4ed863f8dcf1ac5c49c83cdaafa009ec73110 Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Tue, 14 Mar 2023 11:56:27 -0700 Subject: [PATCH 16/26] Fix bug in two-arg->= and two-arg-<= We were handling comparisons of a ratio to an integer and vice versa incorrectly. Use the floor/ceiling appropriately. Now `(kernel::two-arg->= 4e-8 1)` returns `NIL` as expected instead of `T`. --- src/code/numbers.lisp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp index 7c3c4f0b4..8205e04b7 100644 --- a/src/code/numbers.lisp +++ b/src/code/numbers.lisp @@ -1038,7 +1038,7 @@ ;; issue #156. #+x86 (progn - (two-arg- two-arg-<= <= floor ceiling + (two-arg- two-arg-<= <= ceiling floor ((fixnum bignum) (bignum-plus-p y)) ((bignum fixnum) @@ -1046,7 +1046,7 @@ ((bignum bignum) (not (plusp (bignum-compare x y))))) - (two-arg- two-arg->= >= ceiling floor + (two-arg- two-arg->= >= floor ceiling ((fixnum bignum) (not (bignum-plus-p y))) ((bignum fixnum) -- GitLab From 29cd008228a0d93a40a3803d5820997e32a72112 Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Tue, 14 Mar 2023 13:02:52 -0700 Subject: [PATCH 17/26] Add more NaN tests Add tests to verify that we handle NaNs correctly in comparisons. This includes adding tests for <= and >=, and also updating the existing tests for < and > to handle NaN in the second or third arg. --- tests/nan.lisp | 134 +++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 129 insertions(+), 5 deletions(-) diff --git a/tests/nan.lisp b/tests/nan.lisp index 1b885d020..3891c671b 100644 --- a/tests/nan.lisp +++ b/tests/nan.lisp @@ -34,7 +34,11 @@ (frob double-float <) (frob double-float >) (frob single-float =) - (frob double-float =))) + (frob double-float =) + (frob single-float >=) + (frob double-float >=) + (frob single-float <=) + (frob double-float <=))) (define-test nan-single.< (:tag :nan) @@ -101,7 +105,10 @@ (ext:with-float-traps-masked (:invalid) (assert-false (stst-<3 *single-float-nan* 2f0 3f0)) (assert-false (stst-<3 1f0 *single-float-nan* 3f0)) - (assert-false (stst-<3 *single-float-nan* *single-float-nan* 3f0)))) + (assert-false (stst-<3 *single-float-nan* *single-float-nan* 3f0)) + (assert-false (stst-<3 1f0 2f0 *single-float-nan*)) + (assert-false (stst-<3 1f0 *single-float-nan* 3f0)) + (assert-false (stst-<3 1f0 *single-float-nan* *single-float-nan*)))) (define-test nan-double.<3 (:tag :nan) @@ -120,7 +127,10 @@ (ext:with-float-traps-masked (:invalid) (assert-false (dtst-<3 *double-float-nan* 2d0 3d0)) (assert-false (dtst-<3 1d0 *double-float-nan* 3d0)) - (assert-false (dtst-<3 *double-float-nan* *double-float-nan* 3d0)))) + (assert-false (dtst-<3 *double-float-nan* *double-float-nan* 3d0)) + (assert-false (dtst-<3 1d0 2d0 *double-float-nan*)) + (assert-false (dtst-<3 1d0 *double-float-nan* 3d0)) + (assert-false (dtst-<3 1d0 *double-float-nan* *double-float-nan*)))) (define-test nan-single.>3 (:tag :nan) @@ -139,7 +149,10 @@ (ext:with-float-traps-masked (:invalid) (assert-false (stst->3 *single-float-nan* 2f0 3f0)) (assert-false (stst->3 1f0 *single-float-nan* 3f0)) - (assert-false (stst->3 *single-float-nan* *single-float-nan* 3f0)))) + (assert-false (stst->3 *single-float-nan* *single-float-nan* 3f0)) + (assert-false (stst->3 1f0 2f0 *single-float-nan*)) + (assert-false (stst->3 1f0 *single-float-nan* 3f0)) + (assert-false (stst->3 1f0 *single-float-nan* *single-float-nan*)))) (define-test nan-double.>3 (:tag :nan) @@ -158,7 +171,118 @@ (ext:with-float-traps-masked (:invalid) (assert-false (dtst->3 *double-float-nan* 2d0 3d0)) (assert-false (dtst->3 1d0 *double-float-nan* 3d0)) - (assert-false (dtst->3 *double-float-nan* *double-float-nan* 3d0)))) + (assert-false (dtst->3 *double-float-nan* *double-float-nan* 3d0)) + (assert-false (dtst->3 1d0 2d0 *double-float-nan*)) + (assert-false (dtst->3 1d0 *double-float-nan* 3d0)) + (assert-false (dtst->3 1d0 *double-float-nan* *double-float-nan*)))) + +(define-test nan-single.>= + (:tag :nan) + :Basic tests with regular numbers + (assert-true (stst->= 1f0 1f0)) + (assert-true (stst->= 2f0 1f0)) + (assert-false (stst->= 0f0 1f0)) + (ext:with-float-traps-masked (:invalid) + (assert-false (stst->= 1f0 *single-float-nan*)) + (assert-false (stst->= *single-float-nan* 1f0)) + (assert-false (stst->= *single-float-nan* *single-float-nan*)))) + +(define-test nan-single.<= + (:tag :nan) + :Basic tests with regular numbers + (assert-true (stst-<= 1f0 1f0)) + (assert-true (stst-<= 1f0 2f0)) + (assert-false (stst-<= 2f0 1f0)) + (ext:with-float-traps-masked (:invalid) + (assert-false (stst-<= 1f0 *single-float-nan*)) + (assert-false (stst-<= *single-float-nan* 1f0)) + (assert-false (stst-<= *single-float-nan* *single-float-nan*)))) + +(define-test nan-single.>=3 + (:tag :nan) + :Basic tests with regular numbers + (assert-true (stst->=3 1f0 1f0 1f0)) + (assert-true (stst->=3 2f0 1f0 1f0)) + (assert-false (stst->=3 0f0 1f0 1f0)) + (assert-false (stst->=3 2f0 0f0 1f0)) + + (ext:with-float-traps-masked (:invalid) + (assert-false (stst->=3 1f0 *single-float-nan* 2f0)) + (assert-false (stst->=3 *single-float-nan* 1f0 2f0)) + (assert-false (stst->=3 *single-float-nan* *single-float-nan* 2f0)) + (assert-false (stst->=3 2f0 1f0 *single-float-nan*)) + (assert-false (stst->=3 2f0 *single-float-nan* 1f0)) + (assert-false (stst->=3 2f0 *single-float-nan* *single-float-nan*)))) + +(define-test nan-single.<=3 + (:tag :nan) + :Basic tests with regular numbers + (assert-true (stst-<=3 1f0 1f0 1f0)) + (assert-true (stst-<=3 1f0 2f0 2f0)) + (assert-false (stst-<=3 1f0 3f0 2f0)) + (assert-false (stst-<=3 2f0 1f0 1f0)) + + (ext:with-float-traps-masked (:invalid) + (assert-false (stst-<=3 1f0 *single-float-nan* 2f0)) + (assert-false (stst-<=3 *single-float-nan* 1f0 2f0)) + (assert-false (stst-<=3 *single-float-nan* *single-float-nan* 2f0)) + (assert-false (stst-<=3 1f0 2f0 *single-float-nan*)) + (assert-false (stst-<=3 1f0 *single-float-nan* 1f0)) + (assert-false (stst-<=3 1f0 *single-float-nan* *single-float-nan*)))) + +(define-test nan-double.>= + (:tag :nan) + :Basic tests with regular numbers + (assert-true (dtst->= 1f0 1f0)) + (assert-true (dtst->= 2f0 1f0)) + (assert-false (dtst->= 0f0 1f0)) + (ext:with-float-traps-masked (:invalid) + (assert-false (dtst->= 1f0 *double-float-nan*)) + (assert-false (dtst->= *double-float-nan* 1f0)) + (assert-false (dtst->= *double-float-nan* *double-float-nan*)))) + +(define-test nan-double.<= + (:tag :nan) + :Basic tests with regular numbers + (assert-true (dtst-<= 1f0 1f0)) + (assert-true (dtst-<= 1f0 2f0)) + (assert-false (dtst-<= 2f0 1f0)) + (ext:with-float-traps-masked (:invalid) + (assert-false (dtst-<= 1f0 *double-float-nan*)) + (assert-false (dtst-<= *double-float-nan* 1f0)) + (assert-false (dtst-<= *double-float-nan* *double-float-nan*)))) + +(define-test nan-double.>=3 + (:tag :nan) + :Basic tests with regular numbers + (assert-true (dtst->=3 1d0 1d0 1d0)) + (assert-true (dtst->=3 2d0 1d0 1d0)) + (assert-false (dtst->=3 0d0 1d0 1d0)) + (assert-false (dtst->=3 2d0 0d0 1d0)) + + (ext:with-float-traps-masked (:invalid) + (assert-false (dtst->=3 1d0 *double-float-nan* 2d0)) + (assert-false (dtst->=3 *double-float-nan* 1d0 2d0)) + (assert-false (dtst->=3 *double-float-nan* *double-float-nan* 2d0)) + (assert-false (dtst->=3 2d0 1d0 *double-float-nan*)) + (assert-false (dtst->=3 2d0 *double-float-nan* 1d0)) + (assert-false (dtst->=3 2d0 *double-float-nan* *double-float-nan*)))) + +(define-test nan-double.<=3 + (:tag :nan) + :Basic tests with regular numbers + (assert-true (dtst-<=3 1d0 1d0 1d0)) + (assert-true (dtst-<=3 1d0 2d0 2d0)) + (assert-false (dtst-<=3 1d0 3d0 2d0)) + (assert-false (dtst-<=3 2d0 1d0 1d0)) + + (ext:with-float-traps-masked (:invalid) + (assert-false (dtst-<=3 1d0 *double-float-nan* 2d0)) + (assert-false (dtst-<=3 *double-float-nan* 1d0 2d0)) + (assert-false (dtst-<=3 *double-float-nan* *double-float-nan* 2d0)) + (assert-false (dtst-<=3 1d0 2d0 *double-float-nan*)) + (assert-false (dtst-<=3 1d0 *double-float-nan* 1d0)) + (assert-false (dtst-<=3 1d0 *double-float-nan* *double-float-nan*)))) (define-test nan-single.= (:tag :nan) -- GitLab From cd340ff8c6bbe64d33c7cb7d3f9b450ce92983d8 Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Thu, 16 Mar 2023 10:10:00 -0700 Subject: [PATCH 18/26] Add ir1 transform for >= Without this, the compiler can't statically determine if x >= y is always T or NIL, like it can for x < y (and x > y). We choose >= because only `interval-<` and `interval->=` are implemented so >= is a natural choice. --- src/compiler/srctran.lisp | 53 ++++++++++++++++++++++++++++++++++++++- 1 file changed, 52 insertions(+), 1 deletion(-) diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index 0864c0f06..11ed96a1e 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -3537,8 +3537,59 @@ (deftransform > ((x y) (real real) * :when :both) (ir1-transform-< y x x y '<)) +#+(and x86) +(defun ir1-transform->=-helper (x y) + (flet ((maybe-convert (type) + (numeric-type->interval + (cond ((numeric-type-p type) type) + ((member-type-p type) (convert-member-type type)) + (t (give-up)))))) + (let ((xi (mapcar #'maybe-convert + (prepare-arg-for-derive-type (continuation-type x)))) + (yi (mapcar #'maybe-convert + (prepare-arg-for-derive-type (continuation-type y)))) + (definitely-true t) + (definitely-false t)) + (dolist (x-arg xi) + (dolist (y-arg yi) + (setf definitely-true (and definitely-true + (interval->= x-arg y-arg))) + (setf definitely-false (and definitely-false + (interval-< x-arg y-arg))))) + (values definitely-true definitely-false)))) -#+x86 +#+(and x86) +(defun ir1-transform->= (x y first second inverse) + (if (same-leaf-ref-p x y) + 't + (multiple-value-bind (definitely-true definitely-false) + (ir1-transform->=-helper x y) + (cond (definitely-true + t) + (definitely-false + nil) + ((and (constant-continuation-p first) + (not (constant-continuation-p second))) + #+nil + (format t "swapping ~A~%" inverse) + `(,inverse y x)) + (t + (give-up)))))) + +#+(and x86) +(deftransform <= ((x y) (real real) * :when :both) + #+nli + (format t "transform <=~%") + (ir1-transform->= y x x y '>=)) + +#+(and x86) +(deftransform >= ((x y) (real real) * :when :both) + #+nil + (format t "transform >=~%") + (ir1-transform->= x y x y '<=)) + + +#+(and nil x86) (progn ;; When x and y are integers, we want to transform <= to > and >= to ;; <. But we don't want to do this for floats because it messes up -- GitLab From 49d36d2dd91786fc6df688c6161614f424bce82a Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Thu, 16 Mar 2023 10:12:24 -0700 Subject: [PATCH 19/26] Update cmucl.pot --- src/i18n/locale/cmucl.pot | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/i18n/locale/cmucl.pot b/src/i18n/locale/cmucl.pot index 5f8c6bc23..ed3b5c562 100644 --- a/src/i18n/locale/cmucl.pot +++ b/src/i18n/locale/cmucl.pot @@ -21588,3 +21588,9 @@ msgid "" "Unicode replacement character." msgstr "" +transform <= +transform >= +transform <= +transform >= +transform >= +transform <= -- GitLab From 07cc6791a1b285aca7d733f296d560d7ee070f3d Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Thu, 16 Mar 2023 10:26:24 -0700 Subject: [PATCH 20/26] Add some comments and indent code neatly. --- src/compiler/srctran.lisp | 43 +++++++++++++++++++++------------------ 1 file changed, 23 insertions(+), 20 deletions(-) diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index 11ed96a1e..a208fd443 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -3537,6 +3537,11 @@ (deftransform > ((x y) (real real) * :when :both) (ir1-transform-< y x x y '<)) +;;; Ir1-transform->=-helper -- Internal +;;; +;;; Derives the result type of the comparison X >= Y returning two +;;; values: the first true if X >= Y, and the second true if X < Y. +;;; This is the equivalent of ir1-transform-<-helper, but for >=. #+(and x86) (defun ir1-transform->=-helper (x y) (flet ((maybe-convert (type) @@ -3558,34 +3563,33 @@ (interval-< x-arg y-arg))))) (values definitely-true definitely-false)))) +;;; IR1-TRANSFORM->= -- Internal +;;; +;;; Like IR1-TRANSFORM-< but for >=. This is needed so that the +;;; compiler can statically determine (>= X Y) using type information. #+(and x86) (defun ir1-transform->= (x y first second inverse) - (if (same-leaf-ref-p x y) - 't - (multiple-value-bind (definitely-true definitely-false) - (ir1-transform->=-helper x y) - (cond (definitely-true - t) - (definitely-false - nil) - ((and (constant-continuation-p first) - (not (constant-continuation-p second))) - #+nil - (format t "swapping ~A~%" inverse) - `(,inverse y x)) - (t - (give-up)))))) + ;; If the leaves are the same, the (>= X Y) is true. + (if (same-leaf-ref-p x y) + 't + (multiple-value-bind (definitely-true definitely-false) + (ir1-transform->=-helper x y) + (cond (definitely-true + t) + (definitely-false + nil) + ((and (constant-continuation-p first) + (not (constant-continuation-p second))) + `(,inverse y x)) + (t + (give-up)))))) #+(and x86) (deftransform <= ((x y) (real real) * :when :both) - #+nli - (format t "transform <=~%") (ir1-transform->= y x x y '>=)) #+(and x86) (deftransform >= ((x y) (real real) * :when :both) - #+nil - (format t "transform >=~%") (ir1-transform->= x y x y '<=)) @@ -3605,7 +3609,6 @@ ;; (<= x y) is the same as (not (> x y)) `(not (> x y))) - (deftransform >= ((x y) (integer integer) * :when :both) ;; (>= x y) is the same as (not (< x y)) `(not (< x y)))) -- GitLab From 0c089ccc6c2ed2e35902c140e4b976d8dc356ab6 Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Wed, 3 May 2023 15:56:22 -0700 Subject: [PATCH 21/26] Fix download URL for latest snapshot In the merge with master, we got the updated version correct, but forgot to update the URL with the right directory for the snapshot. --- .gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index dea41868b..901e45455 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -1,5 +1,5 @@ variables: - download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/2021/07" + download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/2023/04" version: "2023-04-x86" bootstrap: "-B boot-2021-07-1 -B boot-2021-07-2 -B boot-2021-07-3" -- GitLab From a886eca53758acba9dd23c60301076e52ae5c372 Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Fri, 8 Dec 2023 15:49:42 -0800 Subject: [PATCH 22/26] Update to current HEAD Update .gitlab-ci.yml to use the bootstrap file for this change. Move the bootstrap from 21d to 21e and rename it appropriately to show what the snapshot is needed to build this. --- .gitlab-ci.yml | 2 +- .../{21d/boot-2021-07-3.lisp => 21e/boot-2023-08-1.lisp} | 0 2 files changed, 1 insertion(+), 1 deletion(-) rename src/bootfiles/{21d/boot-2021-07-3.lisp => 21e/boot-2023-08-1.lisp} (100%) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 109806215..939ec6d26 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -1,7 +1,7 @@ variables: download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/2023/08" version: "2023-08-x86" - bootstrap: "-B boot-2023-08" + bootstrap: "-B boot-2023-08 -B 2023-08-1" stages: diff --git a/src/bootfiles/21d/boot-2021-07-3.lisp b/src/bootfiles/21e/boot-2023-08-1.lisp similarity index 100% rename from src/bootfiles/21d/boot-2021-07-3.lisp rename to src/bootfiles/21e/boot-2023-08-1.lisp -- GitLab From caf77e6f2ffaf314b2931441d8b44feb172c2f87 Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Fri, 8 Dec 2023 15:54:45 -0800 Subject: [PATCH 23/26] Fix typo in -B option The bootfile is named boot-2023-08-1, not 2023-08-1. --- .gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 939ec6d26..20e8da9bc 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -1,7 +1,7 @@ variables: download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/2023/08" version: "2023-08-x86" - bootstrap: "-B boot-2023-08 -B 2023-08-1" + bootstrap: "-B boot-2023-08 -B boot-2023-08-1" stages: -- GitLab From b41b11a72f6bfd46f6137d05fd5e6f3a0b07fd71 Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Mon, 27 May 2024 07:23:39 -0700 Subject: [PATCH 24/26] Handle NaN in ir1-transform->= Previously, when `x` and `y` are the same leaf, the transform would immediately return `T`. However, this is not correct if `x` is a float because NaN >= NaN is always false. So add check that `x` is not a float. Manually tested (for now) the with ``` (defun bar (x) (declare (double-float x)) (<= x y)) ``` returns `NIL` for `(bar *nan*)` and `T` for `(bar pi)`. Without this, it always returned `T`. Update cmucl.pot too because it was regenerated. --- src/compiler/srctran.lisp | 6 ++++-- src/i18n/locale/cmucl.pot | 6 ------ 2 files changed, 4 insertions(+), 8 deletions(-) diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index a208fd443..0c15e89fe 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -3569,8 +3569,10 @@ ;;; compiler can statically determine (>= X Y) using type information. #+(and x86) (defun ir1-transform->= (x y first second inverse) - ;; If the leaves are the same, the (>= X Y) is true. - (if (same-leaf-ref-p x y) + ;; If the leaves are the same, the (>= X Y) is true, provided that + ;; neither x nor y is a float. This happens when x or y is NaN. + (if (and (same-leaf-ref-p x y) + (not (csubtypep (continuation-type x) (specifier-type 'float)))) 't (multiple-value-bind (definitely-true definitely-false) (ir1-transform->=-helper x y) diff --git a/src/i18n/locale/cmucl.pot b/src/i18n/locale/cmucl.pot index 556f34f26..68afe90a6 100644 --- a/src/i18n/locale/cmucl.pot +++ b/src/i18n/locale/cmucl.pot @@ -21701,9 +21701,3 @@ msgid "" "Unicode replacement character." msgstr "" -transform <= -transform >= -transform <= -transform >= -transform >= -transform <= -- GitLab From d6f90bdc8caf884eae3e81b6375aae0beb7307f7 Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Thu, 6 Jun 2024 06:17:40 -0700 Subject: [PATCH 25/26] Rename bootstrap file to latest snapshot --- src/bootfiles/21e/{boot-2023-08-1.lisp => boot-2024-04-1.lisp} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/bootfiles/21e/{boot-2023-08-1.lisp => boot-2024-04-1.lisp} (100%) diff --git a/src/bootfiles/21e/boot-2023-08-1.lisp b/src/bootfiles/21e/boot-2024-04-1.lisp similarity index 100% rename from src/bootfiles/21e/boot-2023-08-1.lisp rename to src/bootfiles/21e/boot-2024-04-1.lisp -- GitLab From a63fe0d0c933ed06bf0877efd7b90de913e3ea48 Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Thu, 6 Jun 2024 07:24:32 -0700 Subject: [PATCH 26/26] Update CI with new name for bootstrap file. --- .gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 6314ff87d..c0061359a 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -1,7 +1,7 @@ variables: download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/2024/04" version: "2024-04-x86" - bootstrap: "-B boot-2023-08-1" + bootstrap: "-B boot-2024-04-1" stages: -- GitLab