February 2023 - cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl][issue-163-add-command-line-version] Add comment about adding --version
by Raymond Toy (＠rtoy) 28 Feb '23

28 Feb '23

Raymond Toy pushed to branch issue-163-add-command-line-version at cmucl / cmucl Commits: 1d9b25b2 by Raymond Toy at 2023-02-28T11:58:30-08:00 Add comment about adding --version It's added because it's a common command line option for GNU. - - - - - 1 changed file: - src/code/commandline.lisp Changes: ===================================== src/code/commandline.lisp ===================================== @@ -403,7 +403,8 @@ (defswitch "version" #'version-switch-demon "Prints the cmucl version and exits") -;; Make --version work too since that's a common option. +;; Make --version work too since that's a common command line option +;; for GNU software. (defswitch "-version" #'version-switch-demon - "Prints the cmucl version and exits") + "Prints the cmucl version and exits; same as -version") View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/1d9b25b290a9955742ec7ca… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/1d9b25b290a9955742ec7ca… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-170-clean-up-x86-float-compare] Keep single-float/double-float cases together
by Raymond Toy (＠rtoy) 28 Feb '23

28 Feb '23

Raymond Toy pushed to branch issue-170-clean-up-x86-float-compare at cmucl / cmucl Commits: 8d18d306 by Raymond Toy at 2023-02-28T11:46:39-08:00 Keep single-float/double-float cases together Just minor reordering the of the float compare frobs; keep the single-float and double-float cases together instead of ordering them by the operation. I find this easier to read and think about. - - - - - 1 changed file: - src/compiler/x86/float-sse2.lisp Changes: ===================================== src/compiler/x86/float-sse2.lisp ===================================== @@ -972,8 +972,8 @@ (inst jmp ,yep target) (emit-label not-lab))))))))) (frob < single comiss :b :nb) - (frob < double comisd :b :nb) (frob > single comiss :a :na) + (frob < double comisd :b :nb) (frob > double comisd :a :na)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/8d18d306a79505c3874c1b0… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/8d18d306a79505c3874c1b0… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-170-clean-up-x86-float-compare] 10 commits: Fix #168: Use positive forms for conditional jmp.
by Raymond Toy (＠rtoy) 28 Feb '23

28 Feb '23

Raymond Toy pushed to branch issue-170-clean-up-x86-float-compare at cmucl / cmucl Commits: 404e4b28 by Raymond Toy at 2023-02-27T20:18:24+00:00 Fix #168: Use positive forms for conditional jmp. - - - - - 27979066 by Raymond Toy at 2023-02-27T20:18:27+00:00 Merge branch 'issue-168-no-negated-forms-for-jmp' into 'master' Fix #168: Use positive forms for conditional jmp. Closes #168 See merge request cmucl/cmucl!119 - - - - - be6a7f01 by Raymond Toy at 2023-02-28T14:39:15+00:00 Fix #169: pprint define-vop neatly - - - - - 797e2e17 by Raymond Toy at 2023-02-28T14:39:17+00:00 Merge branch 'issue-169-pprint-define-vop' into 'master' Fix #169: pprint define-vop neatly Closes #169 See merge request cmucl/cmucl!120 - - - - - eb943b50 by Raymond Toy at 2023-02-28T15:50:59+00:00 Fix #167: double-float-exponent off by one - - - - - 6ba270b2 by Raymond Toy at 2023-02-28T15:51:05+00:00 Merge branch 'issue-167-exponent-bounds-off-by-one' into 'master' Fix #167: double-float-exponent off by one See merge request cmucl/cmucl!121 - - - - - 9a767f26 by Raymond Toy at 2023-02-28T09:55:59-08:00 Macroize single-float-compare/double-float-compare Use a macro to reduce duplicate code in `single-float-compare` and `double-float-compare`. Modeled after sparc and ppc code for the same. - - - - - 2f4d8408 by Raymond Toy at 2023-02-28T09:57:17-08:00 Merge branch 'master' into issue-170-clean-up-x86-float-compare - - - - - 7c4cecb9 by Raymond Toy at 2023-02-28T10:11:09-08:00 Use comis instead of ucomis for float compares Made a typo when macroizing float compares. I checked; we consistently use comis, so let's use comis instead of ucomis. - - - - - a9178e00 by Raymond Toy at 2023-02-28T10:14:49-08:00 Remove commented-out code that was macroized - - - - - 7 changed files: - .gitlab-ci.yml - + src/bootfiles/21d/boot-2021-07-2.lisp - src/code/pprint.lisp - src/compiler/float-tran.lisp - src/compiler/x86/float-sse2.lisp - src/compiler/x86/insts.lisp - tests/issues.lisp Changes: ===================================== .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" + bootstrap: "-B boot-2021-07-1 -B boot-2021-07-2" stages: - install ===================================== src/bootfiles/21d/boot-2021-07-2.lisp ===================================== @@ -0,0 +1,30 @@ +;; Bootstrap file for x86 to choose the non-negated forms of the +;; condition flag for conditional jumps. +;; +;; Use bin/build.sh -B boot-2021-07-2 to build this. + +(in-package :x86) + +(ext:without-package-locks + (handler-bind + ((error + (lambda (c) + (declare (ignore c)) + (invoke-restart 'continue)))) + (defconstant conditions + '((:o . 0) + (:no . 1) + (:b . 2) (:nae . 2) (:c . 2) + (:ae . 3) (:nb . 3) (:nc . 3) + (:e . 4) (:eq . 4) (:z . 4) + (:ne . 5) (:nz . 5) + (:be . 6) (:na . 6) + (:a . 7) (:nbe . 7) + (:s . 8) + (:ns . 9) + (:p . 10) (:pe . 10) + (:np . 11) (:po . 11) + (:l . 12) (:nge . 12) + (:ge . 13) (:nl . 13) + (:le . 14) (:ng . 14) + (:g . 15) (:nle . 15))))) ===================================== src/code/pprint.lisp ===================================== @@ -1837,6 +1837,89 @@ When annotations are present, invoke them at the right positions." (funcall (formatter "~:<~W~^~3I ~:_~W~I~@:_~@{ ~W~^~_~}~:>") stream list)) +(defun pprint-define-vop (stream list &rest noise) + (declare (ignore noise)) + (pprint-logical-block (stream list :prefix "(" :suffix ")") + ;; Output "define-vop" + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (write-char #\space stream) + ;; Output vop name + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (pprint-newline :mandatory stream) + (pprint-indent :block 0 stream) + ;; Print out each option starting on a new line + (loop + (write-char #\space stream) + (let ((vop-option (pprint-pop))) + ;; Figure out what option we have and print it neatly + (case (car vop-option) + ((:args :results) + ;; :args and :results print out each arg/result indented neatly + (pprint-logical-block (stream vop-option :prefix "(" :suffix ")") + ;; Output :args/:results + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (write-char #\space stream) + (pprint-indent :current 0 stream) + ;; Print each value indented the same amount so the line + ;; up neatly. + (loop + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (pprint-newline :mandatory stream)))) + ((:generator) + (pprint-logical-block (stream vop-option :prefix "(" :suffix ")") + ;; Output :generator + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (write-char #\space stream) + ;; Output cost + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + ;; Newline and then the body of the generator + (pprint-newline :mandatory stream) + (write-char #\space stream) + (pprint-indent :current 0 stream) + (loop + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (pprint-newline :mandatory stream)))) + (t + ;; Everything else just get printed as usual. + (output-object vop-option stream)))) + (pprint-exit-if-list-exhausted) + (pprint-newline :linear stream)))) + +(defun pprint-sc-case (stream list &rest noise) + (declare (ignore noise)) + (pprint-logical-block (stream list :prefix "(" :suffix ")") + ;; Output "sc-case" + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (write-char #\space stream) + ;; Output variable name + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + ;; Start the cases on a new line, indented. + (pprint-newline :mandatory stream) + (pprint-indent :block 0 stream) + ;; Print out each case. + (loop + (write-char #\space stream) + (pprint-logical-block (stream (pprint-pop) :prefix "(" :suffix ")") + ;; Output the case item + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (pprint-newline :mandatory stream) + ;; Output everything else, starting on a new line. + (loop + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (pprint-newline :mandatory stream))) + (pprint-exit-if-list-exhausted) + (pprint-newline :mandatory stream)))) ;;;; Interface seen by regular (ugly) printer and initialization routines. @@ -1952,7 +2035,9 @@ When annotations are present, invoke them at the right positions." (vm::with-fixed-allocation pprint-with-like) (kernel::number-dispatch pprint-with-like) (stream::with-stream-class pprint-with-like) - (lisp::with-array-data pprint-with-like))) + (lisp::with-array-data pprint-with-like) + (c:define-vop pprint-define-vop) + (c:sc-case pprint-sc-case))) (defun pprint-init () (setf *initial-pprint-dispatch* (make-pprint-dispatch-table)) ===================================== src/compiler/float-tran.lisp ===================================== @@ -347,25 +347,25 @@ ;;; (deftype single-float-exponent () - `(integer ,(- vm:single-float-normal-exponent-min vm:single-float-bias - vm:single-float-digits) + `(integer (,(- vm:single-float-normal-exponent-min vm:single-float-bias + vm:single-float-digits)) ,(- vm:single-float-normal-exponent-max vm:single-float-bias))) (deftype double-float-exponent () - `(integer ,(- vm:double-float-normal-exponent-min vm:double-float-bias - vm:double-float-digits) + `(integer (,(- vm:double-float-normal-exponent-min vm:double-float-bias + vm:double-float-digits)) ,(- vm:double-float-normal-exponent-max vm:double-float-bias))) (deftype single-float-int-exponent () - `(integer ,(- vm:single-float-normal-exponent-min vm:single-float-bias - (* vm:single-float-digits 2)) + `(integer (,(- vm:single-float-normal-exponent-min vm:single-float-bias + (* vm:single-float-digits 2))) ,(- vm:single-float-normal-exponent-max vm:single-float-bias vm:single-float-digits))) (deftype double-float-int-exponent () - `(integer ,(- vm:double-float-normal-exponent-min vm:double-float-bias - (* vm:double-float-digits 2)) + `(integer (,(- vm:double-float-normal-exponent-min vm:double-float-bias + (* vm:double-float-digits 2))) ,(- vm:double-float-normal-exponent-max vm:double-float-bias vm:double-float-digits))) ===================================== src/compiler/x86/float-sse2.lisp ===================================== @@ -901,15 +901,14 @@ ;;; comiss and comisd can cope with one or other arg in memory: we ;;; could (should, indeed) extend these to cope with descriptor args ;;; and stack args - -(define-vop (single-float-compare float-compare) - (:args (x :scs (single-reg)) (y :scs (single-reg descriptor-reg))) - (:conditional) - (:arg-types single-float single-float)) -(define-vop (double-float-compare float-compare) - (:args (x :scs (double-reg)) (y :scs (double-reg descriptor-reg))) - (:conditional) - (:arg-types double-float double-float)) +(macrolet + ((frob (name sc ptype) + `(define-vop (,name float-compare) + (:args (x :scs (,sc)) + (y :scs (,sc descriptor-reg))) + (:arg-types ,ptype ,ptype)))) + (frob single-float-compare single-reg single-float) + (frob double-float-compare double-reg double-float)) (macrolet ((frob (size inst) @@ -945,50 +944,6 @@ (frob single ucomiss) (frob double ucomisd)) -#+nil -(define-vop (=/single-float single-float-compare) - (:translate =) - (:info target not-p) - (:vop-var vop) - (:generator 3 - (note-this-location vop :internal-error) - (sc-case y - (single-reg - (inst ucomiss x y)) - (descriptor-reg - (inst ucomiss x (ea-for-sf-desc y)))) - ;; if PF&CF, there was a NaN involved => not equal - ;; otherwise, ZF => equal - (cond (not-p - (inst jmp :p target) - (inst jmp :ne target)) - (t - (let ((not-lab (gen-label))) - (inst jmp :p not-lab) - (inst jmp :e target) - (emit-label not-lab)))))) - -#+nil -(define-vop (=/double-float double-float-compare) - (:translate =) - (:info target not-p) - (:vop-var vop) - (:generator 3 - (note-this-location vop :internal-error) - (sc-case y - (double-reg - (inst ucomisd x y)) - (descriptor-reg - (inst ucomisd x (ea-for-df-desc y)))) - (cond (not-p - (inst jmp :p target) - (inst jmp :ne target)) - (t - (let ((not-lab (gen-label))) - (inst jmp :p not-lab) - (inst jmp :e target) - (emit-label not-lab)))))) - (macrolet ((frob (op size inst yep nope) (let ((ea (ecase size @@ -1016,119 +971,10 @@ (inst jmp :p not-lab) (inst jmp ,yep target) (emit-label not-lab))))))))) - (frob < single ucomiss :b :nb) - (frob < double ucomisd :b :nb) - (frob > single ucomiss :a :na) - (frob > double ucomisd :a :na)) - -#+nil -(defmacro frob-float-compare (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)))))))) - -#+nil -(frob-float-compare < single ucomiss :b :nb) -#+nil -(frob-float-compare < double ucomisd :b :nb) -#+nil -(define-vop (</double-float double-float-compare) - (:translate <) - (:info target not-p) - (:generator 3 - (sc-case y - (double-reg - (inst comisd x y)) - (descriptor-reg - (inst comisd x (ea-for-df-desc y)))) - (cond (not-p - (inst jmp :p target) - (inst jmp :nc target)) - (t - (let ((not-lab (gen-label))) - (inst jmp :p not-lab) - (inst jmp :c target) - (emit-label not-lab)))))) - -#+nil -(define-vop (</single-float single-float-compare) - (:translate <) - (:info target not-p) - (:generator 3 - (sc-case y - (single-reg - (inst comiss x y)) - (descriptor-reg - (inst comiss x (ea-for-sf-desc y)))) - (cond (not-p - (inst jmp :p target) - (inst jmp :nc target)) - (t - (let ((not-lab (gen-label))) - (inst jmp :p not-lab) - (inst jmp :c target) - (emit-label not-lab)))))) - -#+nil -(define-vop (>/double-float double-float-compare) - (:translate >) - (:info target not-p) - (:generator 3 - (sc-case y - (double-reg - (inst comisd x y)) - (descriptor-reg - (inst comisd x (ea-for-df-desc y)))) - (cond (not-p - (inst jmp :p target) - (inst jmp :na target)) - (t - (let ((not-lab (gen-label))) - (inst jmp :p not-lab) - (inst jmp :a target) - (emit-label not-lab)))))) - -#+nil -(define-vop (>/single-float single-float-compare) - (:translate >) - (:info target not-p) - (:generator 3 - (sc-case y - (single-reg - (inst comiss x y)) - (descriptor-reg - (inst comiss x (ea-for-sf-desc y)))) - (cond (not-p - (inst jmp :p target) - (inst jmp :na target)) - (t - (let ((not-lab (gen-label))) - (inst jmp :p not-lab) - (inst jmp :a target) - (emit-label not-lab)))))) - + (frob < single comiss :b :nb) + (frob < double comisd :b :nb) + (frob > single comiss :a :na) + (frob > double comisd :a :na)) ;;;; Conversion: ===================================== src/compiler/x86/insts.lisp ===================================== @@ -259,22 +259,39 @@ ;; the first one is the one that is preferred when printing the ;; condition code out. (defconstant conditions - '((:o . 0) + '( + ;; OF = 1 + (:o . 0) + ;; OF = 0 (:no . 1) + ;; Unsigned <; CF = 1 (:b . 2) (:nae . 2) (:c . 2) - (:nb . 3) (:ae . 3) (:nc . 3) + ;; Unsigned >=; CF = 0 + (:ae . 3) (:nb . 3) (:nc . 3) + ;; Equal; ZF = 1 (:e . 4) (:eq . 4) (:z . 4) + ;; Not equal; ZF = 0 (:ne . 5) (:nz . 5) + ;; Unsigned <=; CF = 1 or ZF = 1 (:be . 6) (:na . 6) - (:nbe . 7) (:a . 7) + ;; Unsigned >; CF = 1 and ZF = 0 + (:a . 7) (:nbe . 7) + ;; SF = 1 (:s . 8) + ;; SF = 0 (:ns . 9) + ;; Parity even (:p . 10) (:pe . 10) + ;; Parity odd (:np . 11) (:po . 11) + ;; Signed <; SF /= OF (:l . 12) (:nge . 12) - (:nl . 13) (:ge . 13) + ;; Signed >=; SF = OF + (:ge . 13) (:nl . 13) + ;; Signed <=; ZF = 1 or SF /= OF (:le . 14) (:ng . 14) - (:nle . 15) (:g . 15))) + ;; Signed >; ZF =0 and SF = OF + (:g . 15) (:nle . 15))) (defun conditional-opcode (condition) (cdr (assoc condition conditions :test #'eq)))) ===================================== tests/issues.lisp ===================================== @@ -840,3 +840,60 @@ (let ((f (compile nil #'(lambda () (nth-value 1 (integer-decode-float least-positive-double-float)))))) (assert-equal -1126 (funcall f)))) + + + +(define-test issue.167.single + (:tag :issues) + (let ((df-min-expo (nth-value 1 (decode-float least-positive-single-float))) + (df-max-expo (nth-value 1 (decode-float most-positive-single-float)))) + ;; Verify that the min exponent for kernel:single-float-exponent + ;; is the actual min exponent from decode-float. + (assert-true (typep df-min-expo 'kernel:single-float-exponent)) + (assert-true (typep (1+ df-min-expo) 'kernel:single-float-exponent)) + (assert-false (typep (1- df-min-expo) 'kernel:single-float-exponent)) + + ;; Verify that the max exponent for kernel:single-float-exponent + ;; is the actual max exponent from decode-float. + (assert-true (typep df-max-expo 'kernel:single-float-exponent)) + (assert-true (typep (1- df-max-expo) 'kernel:single-float-exponent)) + (assert-false (typep (1+ df-max-expo) 'kernel:single-float-exponent))) + + ;; Same as for decode-float, but for integer-decode-float. + (let ((idf-min-expo (nth-value 1 (integer-decode-float least-positive-single-float))) + (idf-max-expo (nth-value 1 (integer-decode-float most-positive-single-float)))) + (assert-true (typep idf-min-expo 'kernel:single-float-int-exponent)) + (assert-true (typep (1+ idf-min-expo) 'kernel:single-float-int-exponent)) + (assert-false (typep (1- idf-min-expo) 'kernel:single-float-int-exponent)) + + (assert-true (typep idf-max-expo 'kernel:single-float-int-exponent)) + (assert-true (typep (1- idf-max-expo) 'kernel:single-float-int-exponent)) + (assert-false (typep (1+ idf-max-expo) 'kernel:single-float-int-exponent)))) + +(define-test issue.167.double + (:tag :issues) + (let ((df-min-expo (nth-value 1 (decode-float least-positive-double-float))) + (df-max-expo (nth-value 1 (decode-float most-positive-double-float)))) + ;; Verify that the min exponent for kernel:double-float-exponent + ;; is the actual min exponent from decode-float. + (assert-true (typep df-min-expo 'kernel:double-float-exponent)) + (assert-true (typep (1+ df-min-expo) 'kernel:double-float-exponent)) + (assert-false (typep (1- df-min-expo) 'kernel:double-float-exponent)) + + ;; Verify that the max exponent for kernel:double-float-exponent + ;; is the actual max exponent from decode-float. + (assert-true (typep df-max-expo 'kernel:double-float-exponent)) + (assert-true (typep (1- df-max-expo) 'kernel:double-float-exponent)) + (assert-false (typep (1+ df-max-expo) 'kernel:double-float-exponent))) + + ;; Same as for decode-float, but for integer-decode-float. + (let ((idf-min-expo (nth-value 1 (integer-decode-float least-positive-double-float))) + (idf-max-expo (nth-value 1 (integer-decode-float most-positive-double-float)))) + (assert-true (typep idf-min-expo 'kernel:double-float-int-exponent)) + (assert-true (typep (1+ idf-min-expo) 'kernel:double-float-int-exponent)) + (assert-false (typep (1- idf-min-expo) 'kernel:double-float-int-exponent)) + + (assert-true (typep idf-max-expo 'kernel:double-float-int-exponent)) + (assert-true (typep (1- idf-max-expo) 'kernel:double-float-int-exponent)) + (assert-false (typep (1+ idf-max-expo) 'kernel:double-float-int-exponent)))) + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/16c9e027291273ac7fb5e5… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/16c9e027291273ac7fb5e5… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-170-clean-up-x86-float-compare
by Raymond Toy (＠rtoy) 28 Feb '23

28 Feb '23

Raymond Toy pushed new branch issue-170-clean-up-x86-float-compare at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-170-clean-up-x86-fl… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-158-darwin-pathnames-utf8] 13 commits: Avoid inserting NIL into simple LOOP from FORMAT
by Raymond Toy (＠rtoy) 28 Feb '23

28 Feb '23

Raymond Toy pushed to branch issue-158-darwin-pathnames-utf8 at cmucl / cmucl Commits: be8cb5d0 by Tarn W. Burton at 2023-02-21T07:48:12-05:00 Avoid inserting NIL into simple LOOP from FORMAT - - - - - 0d3cbc39 by Raymond Toy at 2023-02-21T23:25:27+00:00 Merge branch 'fix-format-nil' into 'master' Fix #165: Avoid inserting NIL into simple LOOP from FORMAT See merge request cmucl/cmucl!114 - - - - - 1c99e654 by Raymond Toy at 2023-02-24T20:47:11+00:00 Fix #159: Don't use /tmp as a path for temp files - - - - - ba0d43d1 by Raymond Toy at 2023-02-24T20:47:11+00:00 Merge branch 'issue-159-use-local-tmp-dir' into 'master' Fix #159: Don't use /tmp as a path for temp files Closes #159 See merge request cmucl/cmucl!116 - - - - - cb945c68 by Raymond Toy at 2023-02-27T15:33:25+00:00 Fix #166: integer-decode-float has incorrect type for exponent - - - - - bb43504b by Raymond Toy at 2023-02-27T15:33:25+00:00 Merge branch 'issue-166-integer-decode-float-min-float' into 'master' Fix #166: integer-decode-float has incorrect type for exponent Closes #166 See merge request cmucl/cmucl!117 - - - - - 404e4b28 by Raymond Toy at 2023-02-27T20:18:24+00:00 Fix #168: Use positive forms for conditional jmp. - - - - - 27979066 by Raymond Toy at 2023-02-27T20:18:27+00:00 Merge branch 'issue-168-no-negated-forms-for-jmp' into 'master' Fix #168: Use positive forms for conditional jmp. Closes #168 See merge request cmucl/cmucl!119 - - - - - be6a7f01 by Raymond Toy at 2023-02-28T14:39:15+00:00 Fix #169: pprint define-vop neatly - - - - - 797e2e17 by Raymond Toy at 2023-02-28T14:39:17+00:00 Merge branch 'issue-169-pprint-define-vop' into 'master' Fix #169: pprint define-vop neatly Closes #169 See merge request cmucl/cmucl!120 - - - - - eb943b50 by Raymond Toy at 2023-02-28T15:50:59+00:00 Fix #167: double-float-exponent off by one - - - - - 6ba270b2 by Raymond Toy at 2023-02-28T15:51:05+00:00 Merge branch 'issue-167-exponent-bounds-off-by-one' into 'master' Fix #167: double-float-exponent off by one See merge request cmucl/cmucl!121 - - - - - 98435a1a by Raymond Toy at 2023-02-28T09:04:34-08:00 Merge branch 'master' into issue-158-darwin-pathnames-utf8 - - - - - 6 changed files: - .gitlab-ci.yml - + src/bootfiles/21d/boot-2021-07-2.lisp - src/code/pprint.lisp - src/compiler/float-tran.lisp - src/compiler/x86/insts.lisp - tests/issues.lisp Changes: ===================================== .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" + bootstrap: "-B boot-2021-07-1 -B boot-2021-07-2" stages: - install ===================================== src/bootfiles/21d/boot-2021-07-2.lisp ===================================== @@ -0,0 +1,30 @@ +;; Bootstrap file for x86 to choose the non-negated forms of the +;; condition flag for conditional jumps. +;; +;; Use bin/build.sh -B boot-2021-07-2 to build this. + +(in-package :x86) + +(ext:without-package-locks + (handler-bind + ((error + (lambda (c) + (declare (ignore c)) + (invoke-restart 'continue)))) + (defconstant conditions + '((:o . 0) + (:no . 1) + (:b . 2) (:nae . 2) (:c . 2) + (:ae . 3) (:nb . 3) (:nc . 3) + (:e . 4) (:eq . 4) (:z . 4) + (:ne . 5) (:nz . 5) + (:be . 6) (:na . 6) + (:a . 7) (:nbe . 7) + (:s . 8) + (:ns . 9) + (:p . 10) (:pe . 10) + (:np . 11) (:po . 11) + (:l . 12) (:nge . 12) + (:ge . 13) (:nl . 13) + (:le . 14) (:ng . 14) + (:g . 15) (:nle . 15))))) ===================================== src/code/pprint.lisp ===================================== @@ -1837,6 +1837,89 @@ When annotations are present, invoke them at the right positions." (funcall (formatter "~:<~W~^~3I ~:_~W~I~@:_~@{ ~W~^~_~}~:>") stream list)) +(defun pprint-define-vop (stream list &rest noise) + (declare (ignore noise)) + (pprint-logical-block (stream list :prefix "(" :suffix ")") + ;; Output "define-vop" + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (write-char #\space stream) + ;; Output vop name + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (pprint-newline :mandatory stream) + (pprint-indent :block 0 stream) + ;; Print out each option starting on a new line + (loop + (write-char #\space stream) + (let ((vop-option (pprint-pop))) + ;; Figure out what option we have and print it neatly + (case (car vop-option) + ((:args :results) + ;; :args and :results print out each arg/result indented neatly + (pprint-logical-block (stream vop-option :prefix "(" :suffix ")") + ;; Output :args/:results + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (write-char #\space stream) + (pprint-indent :current 0 stream) + ;; Print each value indented the same amount so the line + ;; up neatly. + (loop + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (pprint-newline :mandatory stream)))) + ((:generator) + (pprint-logical-block (stream vop-option :prefix "(" :suffix ")") + ;; Output :generator + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (write-char #\space stream) + ;; Output cost + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + ;; Newline and then the body of the generator + (pprint-newline :mandatory stream) + (write-char #\space stream) + (pprint-indent :current 0 stream) + (loop + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (pprint-newline :mandatory stream)))) + (t + ;; Everything else just get printed as usual. + (output-object vop-option stream)))) + (pprint-exit-if-list-exhausted) + (pprint-newline :linear stream)))) + +(defun pprint-sc-case (stream list &rest noise) + (declare (ignore noise)) + (pprint-logical-block (stream list :prefix "(" :suffix ")") + ;; Output "sc-case" + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (write-char #\space stream) + ;; Output variable name + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + ;; Start the cases on a new line, indented. + (pprint-newline :mandatory stream) + (pprint-indent :block 0 stream) + ;; Print out each case. + (loop + (write-char #\space stream) + (pprint-logical-block (stream (pprint-pop) :prefix "(" :suffix ")") + ;; Output the case item + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (pprint-newline :mandatory stream) + ;; Output everything else, starting on a new line. + (loop + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (pprint-newline :mandatory stream))) + (pprint-exit-if-list-exhausted) + (pprint-newline :mandatory stream)))) ;;;; Interface seen by regular (ugly) printer and initialization routines. @@ -1952,7 +2035,9 @@ When annotations are present, invoke them at the right positions." (vm::with-fixed-allocation pprint-with-like) (kernel::number-dispatch pprint-with-like) (stream::with-stream-class pprint-with-like) - (lisp::with-array-data pprint-with-like))) + (lisp::with-array-data pprint-with-like) + (c:define-vop pprint-define-vop) + (c:sc-case pprint-sc-case))) (defun pprint-init () (setf *initial-pprint-dispatch* (make-pprint-dispatch-table)) ===================================== src/compiler/float-tran.lisp ===================================== @@ -347,25 +347,25 @@ ;;; (deftype single-float-exponent () - `(integer ,(- vm:single-float-normal-exponent-min vm:single-float-bias - vm:single-float-digits) + `(integer (,(- vm:single-float-normal-exponent-min vm:single-float-bias + vm:single-float-digits)) ,(- vm:single-float-normal-exponent-max vm:single-float-bias))) (deftype double-float-exponent () - `(integer ,(- vm:double-float-normal-exponent-min vm:double-float-bias - vm:double-float-digits) + `(integer (,(- vm:double-float-normal-exponent-min vm:double-float-bias + vm:double-float-digits)) ,(- vm:double-float-normal-exponent-max vm:double-float-bias))) (deftype single-float-int-exponent () - `(integer ,(- vm:single-float-normal-exponent-min vm:single-float-bias - (* vm:single-float-digits 2)) + `(integer (,(- vm:single-float-normal-exponent-min vm:single-float-bias + (* vm:single-float-digits 2))) ,(- vm:single-float-normal-exponent-max vm:single-float-bias vm:single-float-digits))) (deftype double-float-int-exponent () - `(integer ,(- vm:double-float-normal-exponent-min vm:double-float-bias - (* vm:double-float-digits 2)) + `(integer (,(- vm:double-float-normal-exponent-min vm:double-float-bias + (* vm:double-float-digits 2))) ,(- vm:double-float-normal-exponent-max vm:double-float-bias vm:double-float-digits))) ===================================== src/compiler/x86/insts.lisp ===================================== @@ -259,22 +259,39 @@ ;; the first one is the one that is preferred when printing the ;; condition code out. (defconstant conditions - '((:o . 0) + '( + ;; OF = 1 + (:o . 0) + ;; OF = 0 (:no . 1) + ;; Unsigned <; CF = 1 (:b . 2) (:nae . 2) (:c . 2) - (:nb . 3) (:ae . 3) (:nc . 3) + ;; Unsigned >=; CF = 0 + (:ae . 3) (:nb . 3) (:nc . 3) + ;; Equal; ZF = 1 (:e . 4) (:eq . 4) (:z . 4) + ;; Not equal; ZF = 0 (:ne . 5) (:nz . 5) + ;; Unsigned <=; CF = 1 or ZF = 1 (:be . 6) (:na . 6) - (:nbe . 7) (:a . 7) + ;; Unsigned >; CF = 1 and ZF = 0 + (:a . 7) (:nbe . 7) + ;; SF = 1 (:s . 8) + ;; SF = 0 (:ns . 9) + ;; Parity even (:p . 10) (:pe . 10) + ;; Parity odd (:np . 11) (:po . 11) + ;; Signed <; SF /= OF (:l . 12) (:nge . 12) - (:nl . 13) (:ge . 13) + ;; Signed >=; SF = OF + (:ge . 13) (:nl . 13) + ;; Signed <=; ZF = 1 or SF /= OF (:le . 14) (:ng . 14) - (:nle . 15) (:g . 15))) + ;; Signed >; ZF =0 and SF = OF + (:g . 15) (:nle . 15))) (defun conditional-opcode (condition) (cdr (assoc condition conditions :test #'eq)))) ===================================== tests/issues.lisp ===================================== @@ -831,6 +831,7 @@ (assert-true (stream::find-external-format :cp949)))) + (define-test issue.158 (:tag :issues) (let* ((name (string #\Hangul_Syllable_Gyek)) @@ -878,7 +879,6 @@ - (define-test issue.166 (:tag :issues) ;; While this tests for the correct return value, the problem was @@ -888,3 +888,58 @@ (nth-value 1 (integer-decode-float least-positive-double-float)))))) (assert-equal -1126 (funcall f)))) + + +(define-test issue.167.single + (:tag :issues) + (let ((df-min-expo (nth-value 1 (decode-float least-positive-single-float))) + (df-max-expo (nth-value 1 (decode-float most-positive-single-float)))) + ;; Verify that the min exponent for kernel:single-float-exponent + ;; is the actual min exponent from decode-float. + (assert-true (typep df-min-expo 'kernel:single-float-exponent)) + (assert-true (typep (1+ df-min-expo) 'kernel:single-float-exponent)) + (assert-false (typep (1- df-min-expo) 'kernel:single-float-exponent)) + + ;; Verify that the max exponent for kernel:single-float-exponent + ;; is the actual max exponent from decode-float. + (assert-true (typep df-max-expo 'kernel:single-float-exponent)) + (assert-true (typep (1- df-max-expo) 'kernel:single-float-exponent)) + (assert-false (typep (1+ df-max-expo) 'kernel:single-float-exponent))) + + ;; Same as for decode-float, but for integer-decode-float. + (let ((idf-min-expo (nth-value 1 (integer-decode-float least-positive-single-float))) + (idf-max-expo (nth-value 1 (integer-decode-float most-positive-single-float)))) + (assert-true (typep idf-min-expo 'kernel:single-float-int-exponent)) + (assert-true (typep (1+ idf-min-expo) 'kernel:single-float-int-exponent)) + (assert-false (typep (1- idf-min-expo) 'kernel:single-float-int-exponent)) + + (assert-true (typep idf-max-expo 'kernel:single-float-int-exponent)) + (assert-true (typep (1- idf-max-expo) 'kernel:single-float-int-exponent)) + (assert-false (typep (1+ idf-max-expo) 'kernel:single-float-int-exponent)))) + +(define-test issue.167.double + (:tag :issues) + (let ((df-min-expo (nth-value 1 (decode-float least-positive-double-float))) + (df-max-expo (nth-value 1 (decode-float most-positive-double-float)))) + ;; Verify that the min exponent for kernel:double-float-exponent + ;; is the actual min exponent from decode-float. + (assert-true (typep df-min-expo 'kernel:double-float-exponent)) + (assert-true (typep (1+ df-min-expo) 'kernel:double-float-exponent)) + (assert-false (typep (1- df-min-expo) 'kernel:double-float-exponent)) + + ;; Verify that the max exponent for kernel:double-float-exponent + ;; is the actual max exponent from decode-float. + (assert-true (typep df-max-expo 'kernel:double-float-exponent)) + (assert-true (typep (1- df-max-expo) 'kernel:double-float-exponent)) + (assert-false (typep (1+ df-max-expo) 'kernel:double-float-exponent))) + + ;; Same as for decode-float, but for integer-decode-float. + (let ((idf-min-expo (nth-value 1 (integer-decode-float least-positive-double-float))) + (idf-max-expo (nth-value 1 (integer-decode-float most-positive-double-float)))) + (assert-true (typep idf-min-expo 'kernel:double-float-int-exponent)) + (assert-true (typep (1+ idf-min-expo) 'kernel:double-float-int-exponent)) + (assert-false (typep (1- idf-min-expo) 'kernel:double-float-int-exponent)) + + (assert-true (typep idf-max-expo 'kernel:double-float-int-exponent)) + (assert-true (typep (1- idf-max-expo) 'kernel:double-float-int-exponent)) + (assert-false (typep (1+ idf-max-expo) 'kernel:double-float-int-exponent)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/53803637328531223a12e6… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/53803637328531223a12e6… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #167: double-float-exponent off by one
by Raymond Toy (＠rtoy) 28 Feb '23

28 Feb '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: eb943b50 by Raymond Toy at 2023-02-28T15:50:59+00:00 Fix #167: double-float-exponent off by one - - - - - 6ba270b2 by Raymond Toy at 2023-02-28T15:51:05+00:00 Merge branch 'issue-167-exponent-bounds-off-by-one' into 'master' Fix #167: double-float-exponent off by one See merge request cmucl/cmucl!121 - - - - - 2 changed files: - src/compiler/float-tran.lisp - tests/issues.lisp Changes: ===================================== src/compiler/float-tran.lisp ===================================== @@ -347,25 +347,25 @@ ;;; (deftype single-float-exponent () - `(integer ,(- vm:single-float-normal-exponent-min vm:single-float-bias - vm:single-float-digits) + `(integer (,(- vm:single-float-normal-exponent-min vm:single-float-bias + vm:single-float-digits)) ,(- vm:single-float-normal-exponent-max vm:single-float-bias))) (deftype double-float-exponent () - `(integer ,(- vm:double-float-normal-exponent-min vm:double-float-bias - vm:double-float-digits) + `(integer (,(- vm:double-float-normal-exponent-min vm:double-float-bias + vm:double-float-digits)) ,(- vm:double-float-normal-exponent-max vm:double-float-bias))) (deftype single-float-int-exponent () - `(integer ,(- vm:single-float-normal-exponent-min vm:single-float-bias - (* vm:single-float-digits 2)) + `(integer (,(- vm:single-float-normal-exponent-min vm:single-float-bias + (* vm:single-float-digits 2))) ,(- vm:single-float-normal-exponent-max vm:single-float-bias vm:single-float-digits))) (deftype double-float-int-exponent () - `(integer ,(- vm:double-float-normal-exponent-min vm:double-float-bias - (* vm:double-float-digits 2)) + `(integer (,(- vm:double-float-normal-exponent-min vm:double-float-bias + (* vm:double-float-digits 2))) ,(- vm:double-float-normal-exponent-max vm:double-float-bias vm:double-float-digits))) ===================================== tests/issues.lisp ===================================== @@ -840,3 +840,60 @@ (let ((f (compile nil #'(lambda () (nth-value 1 (integer-decode-float least-positive-double-float)))))) (assert-equal -1126 (funcall f)))) + + + +(define-test issue.167.single + (:tag :issues) + (let ((df-min-expo (nth-value 1 (decode-float least-positive-single-float))) + (df-max-expo (nth-value 1 (decode-float most-positive-single-float)))) + ;; Verify that the min exponent for kernel:single-float-exponent + ;; is the actual min exponent from decode-float. + (assert-true (typep df-min-expo 'kernel:single-float-exponent)) + (assert-true (typep (1+ df-min-expo) 'kernel:single-float-exponent)) + (assert-false (typep (1- df-min-expo) 'kernel:single-float-exponent)) + + ;; Verify that the max exponent for kernel:single-float-exponent + ;; is the actual max exponent from decode-float. + (assert-true (typep df-max-expo 'kernel:single-float-exponent)) + (assert-true (typep (1- df-max-expo) 'kernel:single-float-exponent)) + (assert-false (typep (1+ df-max-expo) 'kernel:single-float-exponent))) + + ;; Same as for decode-float, but for integer-decode-float. + (let ((idf-min-expo (nth-value 1 (integer-decode-float least-positive-single-float))) + (idf-max-expo (nth-value 1 (integer-decode-float most-positive-single-float)))) + (assert-true (typep idf-min-expo 'kernel:single-float-int-exponent)) + (assert-true (typep (1+ idf-min-expo) 'kernel:single-float-int-exponent)) + (assert-false (typep (1- idf-min-expo) 'kernel:single-float-int-exponent)) + + (assert-true (typep idf-max-expo 'kernel:single-float-int-exponent)) + (assert-true (typep (1- idf-max-expo) 'kernel:single-float-int-exponent)) + (assert-false (typep (1+ idf-max-expo) 'kernel:single-float-int-exponent)))) + +(define-test issue.167.double + (:tag :issues) + (let ((df-min-expo (nth-value 1 (decode-float least-positive-double-float))) + (df-max-expo (nth-value 1 (decode-float most-positive-double-float)))) + ;; Verify that the min exponent for kernel:double-float-exponent + ;; is the actual min exponent from decode-float. + (assert-true (typep df-min-expo 'kernel:double-float-exponent)) + (assert-true (typep (1+ df-min-expo) 'kernel:double-float-exponent)) + (assert-false (typep (1- df-min-expo) 'kernel:double-float-exponent)) + + ;; Verify that the max exponent for kernel:double-float-exponent + ;; is the actual max exponent from decode-float. + (assert-true (typep df-max-expo 'kernel:double-float-exponent)) + (assert-true (typep (1- df-max-expo) 'kernel:double-float-exponent)) + (assert-false (typep (1+ df-max-expo) 'kernel:double-float-exponent))) + + ;; Same as for decode-float, but for integer-decode-float. + (let ((idf-min-expo (nth-value 1 (integer-decode-float least-positive-double-float))) + (idf-max-expo (nth-value 1 (integer-decode-float most-positive-double-float)))) + (assert-true (typep idf-min-expo 'kernel:double-float-int-exponent)) + (assert-true (typep (1+ idf-min-expo) 'kernel:double-float-int-exponent)) + (assert-false (typep (1- idf-min-expo) 'kernel:double-float-int-exponent)) + + (assert-true (typep idf-max-expo 'kernel:double-float-int-exponent)) + (assert-true (typep (1- idf-max-expo) 'kernel:double-float-int-exponent)) + (assert-false (typep (1+ idf-max-expo) 'kernel:double-float-int-exponent)))) + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/797e2e1711282e1b531683… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/797e2e1711282e1b531683… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-167-exponent-bounds-off-by-one
by Raymond Toy (＠rtoy) 28 Feb '23

28 Feb '23

Raymond Toy pushed new branch issue-167-exponent-bounds-off-by-one at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-167-exponent-bounds… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #169: pprint define-vop neatly
by Raymond Toy (＠rtoy) 28 Feb '23

28 Feb '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: be6a7f01 by Raymond Toy at 2023-02-28T14:39:15+00:00 Fix #169: pprint define-vop neatly - - - - - 797e2e17 by Raymond Toy at 2023-02-28T14:39:17+00:00 Merge branch 'issue-169-pprint-define-vop' into 'master' Fix #169: pprint define-vop neatly Closes #169 See merge request cmucl/cmucl!120 - - - - - 1 changed file: - src/code/pprint.lisp Changes: ===================================== src/code/pprint.lisp ===================================== @@ -1837,6 +1837,89 @@ When annotations are present, invoke them at the right positions." (funcall (formatter "~:<~W~^~3I ~:_~W~I~@:_~@{ ~W~^~_~}~:>") stream list)) +(defun pprint-define-vop (stream list &rest noise) + (declare (ignore noise)) + (pprint-logical-block (stream list :prefix "(" :suffix ")") + ;; Output "define-vop" + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (write-char #\space stream) + ;; Output vop name + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (pprint-newline :mandatory stream) + (pprint-indent :block 0 stream) + ;; Print out each option starting on a new line + (loop + (write-char #\space stream) + (let ((vop-option (pprint-pop))) + ;; Figure out what option we have and print it neatly + (case (car vop-option) + ((:args :results) + ;; :args and :results print out each arg/result indented neatly + (pprint-logical-block (stream vop-option :prefix "(" :suffix ")") + ;; Output :args/:results + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (write-char #\space stream) + (pprint-indent :current 0 stream) + ;; Print each value indented the same amount so the line + ;; up neatly. + (loop + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (pprint-newline :mandatory stream)))) + ((:generator) + (pprint-logical-block (stream vop-option :prefix "(" :suffix ")") + ;; Output :generator + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (write-char #\space stream) + ;; Output cost + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + ;; Newline and then the body of the generator + (pprint-newline :mandatory stream) + (write-char #\space stream) + (pprint-indent :current 0 stream) + (loop + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (pprint-newline :mandatory stream)))) + (t + ;; Everything else just get printed as usual. + (output-object vop-option stream)))) + (pprint-exit-if-list-exhausted) + (pprint-newline :linear stream)))) + +(defun pprint-sc-case (stream list &rest noise) + (declare (ignore noise)) + (pprint-logical-block (stream list :prefix "(" :suffix ")") + ;; Output "sc-case" + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (write-char #\space stream) + ;; Output variable name + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + ;; Start the cases on a new line, indented. + (pprint-newline :mandatory stream) + (pprint-indent :block 0 stream) + ;; Print out each case. + (loop + (write-char #\space stream) + (pprint-logical-block (stream (pprint-pop) :prefix "(" :suffix ")") + ;; Output the case item + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (pprint-newline :mandatory stream) + ;; Output everything else, starting on a new line. + (loop + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (pprint-newline :mandatory stream))) + (pprint-exit-if-list-exhausted) + (pprint-newline :mandatory stream)))) ;;;; Interface seen by regular (ugly) printer and initialization routines. @@ -1952,7 +2035,9 @@ When annotations are present, invoke them at the right positions." (vm::with-fixed-allocation pprint-with-like) (kernel::number-dispatch pprint-with-like) (stream::with-stream-class pprint-with-like) - (lisp::with-array-data pprint-with-like))) + (lisp::with-array-data pprint-with-like) + (c:define-vop pprint-define-vop) + (c:sc-case pprint-sc-case))) (defun pprint-init () (setf *initial-pprint-dispatch* (make-pprint-dispatch-table)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/27979066cfb973f3c2fa28… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/27979066cfb973f3c2fa28… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-169-pprint-define-vop] Add some comments and do some cosmetic changes.
by Raymond Toy (＠rtoy) 28 Feb '23

28 Feb '23

Raymond Toy pushed to branch issue-169-pprint-define-vop at cmucl / cmucl Commits: c387104a by Raymond Toy at 2023-02-28T06:20:33-08:00 Add some comments and do some cosmetic changes. Add some comments so we know what we're trying to do. Don't need the `kernel:` package for `output-object`, so remove it. And indent the code neatly. - - - - - 1 changed file: - src/code/pprint.lisp Changes: ===================================== src/code/pprint.lisp ===================================== @@ -1841,49 +1841,54 @@ When annotations are present, invoke them at the right positions." (declare (ignore noise)) (pprint-logical-block (stream list :prefix "(" :suffix ")") ;; Output "define-vop" - (kernel:output-object (pprint-pop) stream) + (output-object (pprint-pop) stream) (pprint-exit-if-list-exhausted) (write-char #\space stream) ;; Output vop name - (kernel:output-object (pprint-pop) stream) + (output-object (pprint-pop) stream) (pprint-exit-if-list-exhausted) (pprint-newline :mandatory stream) (pprint-indent :block 0 stream) - ;; Print out each option + ;; Print out each option starting on a new line (loop (write-char #\space stream) (let ((vop-option (pprint-pop))) - (case (car vop-option) - ((:args :results) - (pprint-logical-block (stream vop-option :prefix "(" :suffix ")") - ;; Output :args - (kernel:output-object (pprint-pop) stream) - (pprint-exit-if-list-exhausted) - (write-char #\space stream) - (pprint-indent :current 0 stream) - (loop - (kernel:output-object (pprint-pop) stream) - (pprint-exit-if-list-exhausted) - (pprint-newline :mandatory stream)))) - ((:generator) - (pprint-logical-block (stream vop-option :prefix "(" :suffix ")") - ;; Output :generator - (kernel:output-object (pprint-pop) stream) + ;; Figure out what option we have and print it neatly + (case (car vop-option) + ((:args :results) + ;; :args and :results print out each arg/result indented neatly + (pprint-logical-block (stream vop-option :prefix "(" :suffix ")") + ;; Output :args/:results + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (write-char #\space stream) + (pprint-indent :current 0 stream) + ;; Print each value indented the same amount so the line + ;; up neatly. + (loop + (output-object (pprint-pop) stream) (pprint-exit-if-list-exhausted) - (write-char #\space stream) - ;; Output cost - (kernel:output-object (pprint-pop) stream) + (pprint-newline :mandatory stream)))) + ((:generator) + (pprint-logical-block (stream vop-option :prefix "(" :suffix ")") + ;; Output :generator + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + (write-char #\space stream) + ;; Output cost + (output-object (pprint-pop) stream) + (pprint-exit-if-list-exhausted) + ;; Newline and then the body of the generator + (pprint-newline :mandatory stream) + (write-char #\space stream) + (pprint-indent :current 0 stream) + (loop + (output-object (pprint-pop) stream) (pprint-exit-if-list-exhausted) - ;; Newline and then the body of the generator - (pprint-newline :mandatory stream) - (write-char #\space stream) - (pprint-indent :current 0 stream) - (loop - (kernel:output-object (pprint-pop) stream) - (pprint-exit-if-list-exhausted) - (pprint-newline :mandatory stream)))) - (t - (kernel:output-object vop-option stream)))) + (pprint-newline :mandatory stream)))) + (t + ;; Everything else just get printed as usual. + (output-object vop-option stream)))) (pprint-exit-if-list-exhausted) (pprint-newline :linear stream)))) @@ -1891,26 +1896,26 @@ When annotations are present, invoke them at the right positions." (declare (ignore noise)) (pprint-logical-block (stream list :prefix "(" :suffix ")") ;; Output "sc-case" - (kernel:output-object (pprint-pop) stream) + (output-object (pprint-pop) stream) (pprint-exit-if-list-exhausted) (write-char #\space stream) - ;; Output variable - (kernel:output-object (pprint-pop) stream) + ;; Output variable name + (output-object (pprint-pop) stream) (pprint-exit-if-list-exhausted) + ;; Start the cases on a new line, indented. (pprint-newline :mandatory stream) - ;; Indent for the cases (pprint-indent :block 0 stream) ;; Print out each case. (loop (write-char #\space stream) (pprint-logical-block (stream (pprint-pop) :prefix "(" :suffix ")") ;; Output the case item - (kernel:output-object (pprint-pop) stream) + (output-object (pprint-pop) stream) (pprint-exit-if-list-exhausted) (pprint-newline :mandatory stream) - ;; Output everything else + ;; Output everything else, starting on a new line. (loop - (kernel:output-object (pprint-pop) stream) + (output-object (pprint-pop) stream) (pprint-exit-if-list-exhausted) (pprint-newline :mandatory stream))) (pprint-exit-if-list-exhausted) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/c387104a2aac3db2967a96d… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/c387104a2aac3db2967a96d… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-169-pprint-define-vop
by Raymond Toy (＠rtoy) 28 Feb '23

28 Feb '23

Raymond Toy pushed new branch issue-169-pprint-define-vop at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-169-pprint-define-v… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #168: Use positive forms for conditional jmp.
by Raymond Toy (＠rtoy) 27 Feb '23

27 Feb '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 404e4b28 by Raymond Toy at 2023-02-27T20:18:24+00:00 Fix #168: Use positive forms for conditional jmp. - - - - - 27979066 by Raymond Toy at 2023-02-27T20:18:27+00:00 Merge branch 'issue-168-no-negated-forms-for-jmp' into 'master' Fix #168: Use positive forms for conditional jmp. Closes #168 See merge request cmucl/cmucl!119 - - - - - 3 changed files: - .gitlab-ci.yml - + src/bootfiles/21d/boot-2021-07-2.lisp - src/compiler/x86/insts.lisp Changes: ===================================== .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" + bootstrap: "-B boot-2021-07-1 -B boot-2021-07-2" stages: - install ===================================== src/bootfiles/21d/boot-2021-07-2.lisp ===================================== @@ -0,0 +1,30 @@ +;; Bootstrap file for x86 to choose the non-negated forms of the +;; condition flag for conditional jumps. +;; +;; Use bin/build.sh -B boot-2021-07-2 to build this. + +(in-package :x86) + +(ext:without-package-locks + (handler-bind + ((error + (lambda (c) + (declare (ignore c)) + (invoke-restart 'continue)))) + (defconstant conditions + '((:o . 0) + (:no . 1) + (:b . 2) (:nae . 2) (:c . 2) + (:ae . 3) (:nb . 3) (:nc . 3) + (:e . 4) (:eq . 4) (:z . 4) + (:ne . 5) (:nz . 5) + (:be . 6) (:na . 6) + (:a . 7) (:nbe . 7) + (:s . 8) + (:ns . 9) + (:p . 10) (:pe . 10) + (:np . 11) (:po . 11) + (:l . 12) (:nge . 12) + (:ge . 13) (:nl . 13) + (:le . 14) (:ng . 14) + (:g . 15) (:nle . 15))))) ===================================== src/compiler/x86/insts.lisp ===================================== @@ -259,22 +259,39 @@ ;; the first one is the one that is preferred when printing the ;; condition code out. (defconstant conditions - '((:o . 0) + '( + ;; OF = 1 + (:o . 0) + ;; OF = 0 (:no . 1) + ;; Unsigned <; CF = 1 (:b . 2) (:nae . 2) (:c . 2) - (:nb . 3) (:ae . 3) (:nc . 3) + ;; Unsigned >=; CF = 0 + (:ae . 3) (:nb . 3) (:nc . 3) + ;; Equal; ZF = 1 (:e . 4) (:eq . 4) (:z . 4) + ;; Not equal; ZF = 0 (:ne . 5) (:nz . 5) + ;; Unsigned <=; CF = 1 or ZF = 1 (:be . 6) (:na . 6) - (:nbe . 7) (:a . 7) + ;; Unsigned >; CF = 1 and ZF = 0 + (:a . 7) (:nbe . 7) + ;; SF = 1 (:s . 8) + ;; SF = 0 (:ns . 9) + ;; Parity even (:p . 10) (:pe . 10) + ;; Parity odd (:np . 11) (:po . 11) + ;; Signed <; SF /= OF (:l . 12) (:nge . 12) - (:nl . 13) (:ge . 13) + ;; Signed >=; SF = OF + (:ge . 13) (:nl . 13) + ;; Signed <=; ZF = 1 or SF /= OF (:le . 14) (:ng . 14) - (:nle . 15) (:g . 15))) + ;; Signed >; ZF =0 and SF = OF + (:g . 15) (:nle . 15))) (defun conditional-opcode (condition) (cdr (assoc condition conditions :test #'eq)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/bb43504bf3ac0886cac099… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/bb43504bf3ac0886cac099… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-158-darwin-pathnames-utf8] 4 commits: Undo unnecessary change to unidata.lisp
by Raymond Toy (＠rtoy) 27 Feb '23

27 Feb '23

Raymond Toy pushed to branch issue-158-darwin-pathnames-utf8 at cmucl / cmucl Commits: 4fe2a3f4 by Raymond Toy at 2023-02-27T08:09:42-08:00 Undo unnecessary change to unidata.lisp There was an unneeded indentation change here that should not have been part of the MR. - - - - - 80ac0130 by Tarn W. Burton at 2023-02-27T08:09:42-08:00 Avoid inserting NIL into simple LOOP from FORMAT - - - - - c2311453 by Raymond Toy at 2023-02-27T08:09:42-08:00 Fix #159: Don't use /tmp as a path for temp files - - - - - 53803637 by Raymond Toy at 2023-02-27T08:11:20-08:00 Fix #166: integer-decode-float has incorrect type for exponent - - - - - 10 changed files: - .gitlab-ci.yml - bin/build.sh - + src/bootfiles/21d/boot-2021-07-1.lisp - src/code/exports.lisp - src/code/format.lisp - src/code/unidata.lisp - src/compiler/fndb.lisp - src/compiler/generic/vm-type.lisp - tests/issues.lisp - tests/printer.lisp Changes: ===================================== .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: "" + bootstrap: "-B boot-2021-07-1" stages: - install ===================================== bin/build.sh ===================================== @@ -39,7 +39,7 @@ ENABLE2="yes" ENABLE3="yes" ENABLE4="yes" -version=21c +version=21d SRCDIR=src BINDIR=bin TOOLDIR=$BINDIR ===================================== src/bootfiles/21d/boot-2021-07-1.lisp ===================================== @@ -0,0 +1,17 @@ +;; Bootstrap file +;; +;; Use "bin/build.sh -B boot-2021-07-1" to build this. +;; +;; We want to export the symbols from the KERNEL package which also +;; exists in the C package, so we unintern the conflicting symbols from +;; the C package. + +(in-package "KERNEL") +(ext:without-package-locks + (handler-bind + ((error (lambda (c) + (declare (ignore c)) + (invoke-restart 'lisp::unintern-conflicting-symbols)))) + (export '(DOUBLE-FLOAT-INT-EXPONENT + SINGLE-FLOAT-INT-EXPONENT)))) + ===================================== src/code/exports.lisp ===================================== @@ -2329,10 +2329,11 @@ "DOUBLE-FLOAT-EXPONENT" "DOUBLE-FLOAT-BITS" "DOUBLE-FLOAT-HIGH-BITS" + "DOUBLE-FLOAT-INT-EXPONENT" "DOUBLE-FLOAT-LOW-BITS" "DOUBLE-FLOAT-P" "FLOAT-WAIT" "DYNAMIC-SPACE-FREE-POINTER" "ERROR-NUMBER-OR-LOSE" "FILENAME" "FLOAT-DIGITS" "FLOAT-EXPONENT" "FLOAT-FORMAT-DIGITS" - "FLOAT-FORMAT-MAX" "FLOAT-RADIX" "FORM" "FUNCALLABLE-INSTANCE-P" + "FLOAT-FORMAT-MAX" "FLOAT-INT-EXPONENT" "FLOAT-RADIX" "FORM" "FUNCALLABLE-INSTANCE-P" "FUNCTION-CODE-HEADER" "FUNCTION-TYPE" "FUNCTION-TYPE-ALLOWP" "FUNCTION-TYPE-KEYP" "FUNCTION-TYPE-KEYWORDS" "FUNCTION-TYPE-NARGS" "FUNCTION-TYPE-OPTIONAL" "FUNCTION-TYPE-P" @@ -2426,6 +2427,7 @@ "SIMPLE-ARRAY-SIGNED-BYTE-16-P" "SIMPLE-ARRAY-SIGNED-BYTE-30-P" "SIMPLE-ARRAY-SIGNED-BYTE-32-P" "SIMPLE-ARRAY-SIGNED-BYTE-8-P" "SIMPLE-UNBOXED-ARRAY" "SINGLE-FLOAT-BITS" "SINGLE-FLOAT-EXPONENT" + "SINGLE-FLOAT-INT-EXPONENT" "SINGLE-FLOAT-P" "SINGLE-VALUE-TYPE" "SPECIFIER-TYPE" "STACK-REF" "STD-COMPUTE-CLASS-PRECEDENCE-LIST" "STREAMLIKE" "SIMPLE-STREAM-BUFFER" "STRINGABLE" "STRINGLIKE" ===================================== src/code/format.lisp ===================================== @@ -399,7 +399,8 @@ (form new-directives) (expand-directive (car remaining-directives) (cdr remaining-directives)) - (push form results) + (when form + (push form results)) (setf remaining-directives new-directives))) (reverse results))) ===================================== src/code/unidata.lisp ===================================== @@ -514,7 +514,7 @@ (values split hvec mvec lvec)))) (declare (ignorable #'read16 #'read32 #'read-ntrie)) (with-open-file (,stm *unidata-path* :direction :input - :element-type '(unsigned-byte 8)) + :element-type '(unsigned-byte 8)) (unless (unidata-locate ,stm ,locn) (error (intl:gettext "No data in file."))) ,@body))))) ===================================== src/compiler/fndb.lisp ===================================== @@ -319,7 +319,7 @@ (defknown (float-digits float-precision) (float) float-digits (movable foldable flushable explicit-check)) (defknown integer-decode-float (float) - (values integer float-exponent (member -1 1)) + (values integer float-int-exponent (member -1 1)) (movable foldable flushable explicit-check)) (defknown complex (real &optional real) number ===================================== src/compiler/generic/vm-type.lisp ===================================== @@ -50,6 +50,8 @@ (deftype float-exponent () #-long-float 'double-float-exponent #+long-float 'long-float-exponent) +(deftype float-int-exponent () + 'double-float-int-exponent) (deftype float-digits () #-long-float `(integer 0 ,vm:double-float-digits) #+long-float `(integer 0 ,vm:long-float-digits)) ===================================== tests/issues.lisp ===================================== @@ -18,8 +18,10 @@ (declare (ignore arg)) form) -(defparameter *test-path* - (merge-pathnames (make-pathname :name :unspecific :type :unspecific +(defparameter *tmp-dir* + (merge-pathnames (make-pathname :directory '(:relative "tmp") + :name :unspecific + :type :unspecific :version :unspecific) *load-truename*) "Directory for temporary test files.") @@ -777,10 +779,11 @@ (define-test issue.140.two-way-stream (:tag :issues) + (ensure-directories-exist *tmp-dir*) (with-open-file (in (merge-pathnames "issues.lisp" cmucl-test-runner::*load-path*) :direction :input :external-format :utf-8) - (with-open-file (out "/tmp/output.tst" + (with-open-file (out (merge-pathnames "output.tst" *tmp-dir*) :direction :output :external-format :utf-8 :if-exists :supersede) @@ -803,15 +806,15 @@ ;; Create 3 output streams. The exact external formats aren't ;; really important here as long as they're different for each file ;; so we can tell if we got the right answer. - (with-open-file (s1 "/tmp/broad-1" + (with-open-file (s1 (merge-pathnames "broad-1" *tmp-dir*) :direction :output :if-exists :supersede :external-format :latin1) - (with-open-file (s2 "/tmp/broad-2" + (with-open-file (s2 (merge-pathnames "broad-2" *tmp-dir*) :direction :output :if-exists :supersede :external-format :utf-8) - (with-open-file (s3 "/tmp/broad-3" + (with-open-file (s3 (merge-pathnames "broad-3" *tmp-dir*) :direction :output :if-exists :supersede :external-format :utf-16) @@ -827,6 +830,7 @@ (assert-true (stream::find-external-format :euckr)) (assert-true (stream::find-external-format :cp949)))) + (define-test issue.158 (:tag :issues) (let* ((name (string #\Hangul_Syllable_Gyek)) @@ -872,3 +876,15 @@ #-darwin (assert-equal (pathname-name f) expected-name)))) + + + +(define-test issue.166 + (:tag :issues) + ;; While this tests for the correct return value, the problem was + ;; that the compiler was miscompiling the function below and causing + ;; an error when the function run. + (let ((f (compile nil #'(lambda () + (nth-value 1 (integer-decode-float least-positive-double-float)))))) + (assert-equal -1126 (funcall f)))) + ===================================== tests/printer.lisp ===================================== @@ -113,3 +113,16 @@ (define-test sub-output-integer.1 (assert-prints "-536870912" (princ most-negative-fixnum))) + +;;; Simple LOOP requires only compound forms. Hence NIL is not +;;; permitted. Some FORMAT directives (like newline) return NIL +;;; as the form when they have nothing to add to the body. +;;; Normally this is fine since BLOCK accepts NIL as a form. On +;;; the other hand, when the newline directive is inside of an +;;; iteration directive this will produce something like +;;; (LOOP (fu) nil (bar)) which is not acceptable. To verify +;;; that this is not happening we make sure we are not getting +;;; (BLOCK NIL NIL) since this is easier to test for. +(define-test format-no-nil-form.1 + (assert-equal '(block nil) (third (second (macroexpand-1 '(formatter "~ +")))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/a4475ab65d0aebc845408b… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/a4475ab65d0aebc845408b… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-168-no-negated-forms-for-jmp] 3 commits: Fix #166: integer-decode-float has incorrect type for exponent
by Raymond Toy (＠rtoy) 27 Feb '23

27 Feb '23

Raymond Toy pushed to branch issue-168-no-negated-forms-for-jmp at cmucl / cmucl Commits: cb945c68 by Raymond Toy at 2023-02-27T15:33:25+00:00 Fix #166: integer-decode-float has incorrect type for exponent - - - - - bb43504b by Raymond Toy at 2023-02-27T15:33:25+00:00 Merge branch 'issue-166-integer-decode-float-min-float' into 'master' Fix #166: integer-decode-float has incorrect type for exponent Closes #166 See merge request cmucl/cmucl!117 - - - - - af8179e5 by Raymond Toy at 2023-02-27T07:45:42-08:00 Merge branch 'master' into issue-168-no-negated-forms-for-jmp - - - - - 6 changed files: - .gitlab-ci.yml - + src/bootfiles/21d/boot-2021-07-1.lisp - src/code/exports.lisp - src/compiler/fndb.lisp - src/compiler/generic/vm-type.lisp - tests/issues.lisp Changes: ===================================== .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-2" + bootstrap: "-B boot-2021-07-1 -B boot-2021-07-2" stages: - install ===================================== src/bootfiles/21d/boot-2021-07-1.lisp ===================================== @@ -0,0 +1,17 @@ +;; Bootstrap file +;; +;; Use "bin/build.sh -B boot-2021-07-1" to build this. +;; +;; We want to export the symbols from the KERNEL package which also +;; exists in the C package, so we unintern the conflicting symbols from +;; the C package. + +(in-package "KERNEL") +(ext:without-package-locks + (handler-bind + ((error (lambda (c) + (declare (ignore c)) + (invoke-restart 'lisp::unintern-conflicting-symbols)))) + (export '(DOUBLE-FLOAT-INT-EXPONENT + SINGLE-FLOAT-INT-EXPONENT)))) + ===================================== src/code/exports.lisp ===================================== @@ -2329,10 +2329,11 @@ "DOUBLE-FLOAT-EXPONENT" "DOUBLE-FLOAT-BITS" "DOUBLE-FLOAT-HIGH-BITS" + "DOUBLE-FLOAT-INT-EXPONENT" "DOUBLE-FLOAT-LOW-BITS" "DOUBLE-FLOAT-P" "FLOAT-WAIT" "DYNAMIC-SPACE-FREE-POINTER" "ERROR-NUMBER-OR-LOSE" "FILENAME" "FLOAT-DIGITS" "FLOAT-EXPONENT" "FLOAT-FORMAT-DIGITS" - "FLOAT-FORMAT-MAX" "FLOAT-RADIX" "FORM" "FUNCALLABLE-INSTANCE-P" + "FLOAT-FORMAT-MAX" "FLOAT-INT-EXPONENT" "FLOAT-RADIX" "FORM" "FUNCALLABLE-INSTANCE-P" "FUNCTION-CODE-HEADER" "FUNCTION-TYPE" "FUNCTION-TYPE-ALLOWP" "FUNCTION-TYPE-KEYP" "FUNCTION-TYPE-KEYWORDS" "FUNCTION-TYPE-NARGS" "FUNCTION-TYPE-OPTIONAL" "FUNCTION-TYPE-P" @@ -2426,6 +2427,7 @@ "SIMPLE-ARRAY-SIGNED-BYTE-16-P" "SIMPLE-ARRAY-SIGNED-BYTE-30-P" "SIMPLE-ARRAY-SIGNED-BYTE-32-P" "SIMPLE-ARRAY-SIGNED-BYTE-8-P" "SIMPLE-UNBOXED-ARRAY" "SINGLE-FLOAT-BITS" "SINGLE-FLOAT-EXPONENT" + "SINGLE-FLOAT-INT-EXPONENT" "SINGLE-FLOAT-P" "SINGLE-VALUE-TYPE" "SPECIFIER-TYPE" "STACK-REF" "STD-COMPUTE-CLASS-PRECEDENCE-LIST" "STREAMLIKE" "SIMPLE-STREAM-BUFFER" "STRINGABLE" "STRINGLIKE" ===================================== src/compiler/fndb.lisp ===================================== @@ -319,7 +319,7 @@ (defknown (float-digits float-precision) (float) float-digits (movable foldable flushable explicit-check)) (defknown integer-decode-float (float) - (values integer float-exponent (member -1 1)) + (values integer float-int-exponent (member -1 1)) (movable foldable flushable explicit-check)) (defknown complex (real &optional real) number ===================================== src/compiler/generic/vm-type.lisp ===================================== @@ -50,6 +50,8 @@ (deftype float-exponent () #-long-float 'double-float-exponent #+long-float 'long-float-exponent) +(deftype float-int-exponent () + 'double-float-int-exponent) (deftype float-digits () #-long-float `(integer 0 ,vm:double-float-digits) #+long-float `(integer 0 ,vm:long-float-digits)) ===================================== tests/issues.lisp ===================================== @@ -829,3 +829,14 @@ (*compile-print* nil)) (assert-true (stream::find-external-format :euckr)) (assert-true (stream::find-external-format :cp949)))) + + + +(define-test issue.166 + (:tag :issues) + ;; While this tests for the correct return value, the problem was + ;; that the compiler was miscompiling the function below and causing + ;; an error when the function run. + (let ((f (compile nil #'(lambda () + (nth-value 1 (integer-decode-float least-positive-double-float)))))) + (assert-equal -1126 (funcall f)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/963104015b369a7c835bc7… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/963104015b369a7c835bc7… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #166: integer-decode-float has incorrect type for exponent
by Raymond Toy (＠rtoy) 27 Feb '23

27 Feb '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: cb945c68 by Raymond Toy at 2023-02-27T15:33:25+00:00 Fix #166: integer-decode-float has incorrect type for exponent - - - - - bb43504b by Raymond Toy at 2023-02-27T15:33:25+00:00 Merge branch 'issue-166-integer-decode-float-min-float' into 'master' Fix #166: integer-decode-float has incorrect type for exponent Closes #166 See merge request cmucl/cmucl!117 - - - - - 7 changed files: - .gitlab-ci.yml - bin/build.sh - + src/bootfiles/21d/boot-2021-07-1.lisp - src/code/exports.lisp - src/compiler/fndb.lisp - src/compiler/generic/vm-type.lisp - tests/issues.lisp Changes: ===================================== .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: "" + bootstrap: "-B boot-2021-07-1" stages: - install ===================================== bin/build.sh ===================================== @@ -39,7 +39,7 @@ ENABLE2="yes" ENABLE3="yes" ENABLE4="yes" -version=21c +version=21d SRCDIR=src BINDIR=bin TOOLDIR=$BINDIR ===================================== src/bootfiles/21d/boot-2021-07-1.lisp ===================================== @@ -0,0 +1,17 @@ +;; Bootstrap file +;; +;; Use "bin/build.sh -B boot-2021-07-1" to build this. +;; +;; We want to export the symbols from the KERNEL package which also +;; exists in the C package, so we unintern the conflicting symbols from +;; the C package. + +(in-package "KERNEL") +(ext:without-package-locks + (handler-bind + ((error (lambda (c) + (declare (ignore c)) + (invoke-restart 'lisp::unintern-conflicting-symbols)))) + (export '(DOUBLE-FLOAT-INT-EXPONENT + SINGLE-FLOAT-INT-EXPONENT)))) + ===================================== src/code/exports.lisp ===================================== @@ -2329,10 +2329,11 @@ "DOUBLE-FLOAT-EXPONENT" "DOUBLE-FLOAT-BITS" "DOUBLE-FLOAT-HIGH-BITS" + "DOUBLE-FLOAT-INT-EXPONENT" "DOUBLE-FLOAT-LOW-BITS" "DOUBLE-FLOAT-P" "FLOAT-WAIT" "DYNAMIC-SPACE-FREE-POINTER" "ERROR-NUMBER-OR-LOSE" "FILENAME" "FLOAT-DIGITS" "FLOAT-EXPONENT" "FLOAT-FORMAT-DIGITS" - "FLOAT-FORMAT-MAX" "FLOAT-RADIX" "FORM" "FUNCALLABLE-INSTANCE-P" + "FLOAT-FORMAT-MAX" "FLOAT-INT-EXPONENT" "FLOAT-RADIX" "FORM" "FUNCALLABLE-INSTANCE-P" "FUNCTION-CODE-HEADER" "FUNCTION-TYPE" "FUNCTION-TYPE-ALLOWP" "FUNCTION-TYPE-KEYP" "FUNCTION-TYPE-KEYWORDS" "FUNCTION-TYPE-NARGS" "FUNCTION-TYPE-OPTIONAL" "FUNCTION-TYPE-P" @@ -2426,6 +2427,7 @@ "SIMPLE-ARRAY-SIGNED-BYTE-16-P" "SIMPLE-ARRAY-SIGNED-BYTE-30-P" "SIMPLE-ARRAY-SIGNED-BYTE-32-P" "SIMPLE-ARRAY-SIGNED-BYTE-8-P" "SIMPLE-UNBOXED-ARRAY" "SINGLE-FLOAT-BITS" "SINGLE-FLOAT-EXPONENT" + "SINGLE-FLOAT-INT-EXPONENT" "SINGLE-FLOAT-P" "SINGLE-VALUE-TYPE" "SPECIFIER-TYPE" "STACK-REF" "STD-COMPUTE-CLASS-PRECEDENCE-LIST" "STREAMLIKE" "SIMPLE-STREAM-BUFFER" "STRINGABLE" "STRINGLIKE" ===================================== src/compiler/fndb.lisp ===================================== @@ -319,7 +319,7 @@ (defknown (float-digits float-precision) (float) float-digits (movable foldable flushable explicit-check)) (defknown integer-decode-float (float) - (values integer float-exponent (member -1 1)) + (values integer float-int-exponent (member -1 1)) (movable foldable flushable explicit-check)) (defknown complex (real &optional real) number ===================================== src/compiler/generic/vm-type.lisp ===================================== @@ -50,6 +50,8 @@ (deftype float-exponent () #-long-float 'double-float-exponent #+long-float 'long-float-exponent) +(deftype float-int-exponent () + 'double-float-int-exponent) (deftype float-digits () #-long-float `(integer 0 ,vm:double-float-digits) #+long-float `(integer 0 ,vm:long-float-digits)) ===================================== tests/issues.lisp ===================================== @@ -829,3 +829,14 @@ (*compile-print* nil)) (assert-true (stream::find-external-format :euckr)) (assert-true (stream::find-external-format :cp949)))) + + + +(define-test issue.166 + (:tag :issues) + ;; While this tests for the correct return value, the problem was + ;; that the compiler was miscompiling the function below and causing + ;; an error when the function run. + (let ((f (compile nil #'(lambda () + (nth-value 1 (integer-decode-float least-positive-double-float)))))) + (assert-equal -1126 (funcall f)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/ba0d43d19d909a526ca55c… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/ba0d43d19d909a526ca55c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-166-integer-decode-float-min-float] Ignore the condition arg; we don't use it.
by Raymond Toy (＠rtoy) 27 Feb '23

27 Feb '23

Raymond Toy pushed to branch issue-166-integer-decode-float-min-float at cmucl / cmucl Commits: f1393af8 by Raymond Toy at 2023-02-27T07:14:42-08:00 Ignore the condition arg; we don't use it. Also remove the call to `describe` that was used for debugging. - - - - - 1 changed file: - src/bootfiles/21d/boot-2021-07-1.lisp Changes: ===================================== src/bootfiles/21d/boot-2021-07-1.lisp ===================================== @@ -10,8 +10,7 @@ (ext:without-package-locks (handler-bind ((error (lambda (c) - ;;(declare (ignore c)) - (describe c) + (declare (ignore c)) (invoke-restart 'lisp::unintern-conflicting-symbols)))) (export '(DOUBLE-FLOAT-INT-EXPONENT SINGLE-FLOAT-INT-EXPONENT)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/f1393af8f1c50e2fade81a6… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/f1393af8f1c50e2fade81a6… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-168-no-negated-forms-for-jmp] Add some comments on what the different jmp conditions mean
by Raymond Toy (＠rtoy) 27 Feb '23

27 Feb '23

Raymond Toy pushed to branch issue-168-no-negated-forms-for-jmp at cmucl / cmucl Commits: 96310401 by Raymond Toy at 2023-02-26T16:19:45-08:00 Add some comments on what the different jmp conditions mean I always forget the difference between, say, `:be` and `:le`. The former is for unsigned comparisons and the later for signed. So add some short comments on what the conditions really mean. - - - - - 1 changed file: - src/compiler/x86/insts.lisp Changes: ===================================== src/compiler/x86/insts.lisp ===================================== @@ -259,21 +259,38 @@ ;; the first one is the one that is preferred when printing the ;; condition code out. (defconstant conditions - '((:o . 0) + '( + ;; OF = 1 + (:o . 0) + ;; OF = 0 (:no . 1) + ;; Unsigned <; CF = 1 (:b . 2) (:nae . 2) (:c . 2) + ;; Unsigned >=; CF = 0 (:ae . 3) (:nb . 3) (:nc . 3) + ;; Equal; ZF = 1 (:e . 4) (:eq . 4) (:z . 4) + ;; Not equal; ZF = 0 (:ne . 5) (:nz . 5) + ;; Unsigned <=; CF = 1 or ZF = 1 (:be . 6) (:na . 6) + ;; Unsigned >; CF = 1 and ZF = 0 (:a . 7) (:nbe . 7) + ;; SF = 1 (:s . 8) + ;; SF = 0 (:ns . 9) + ;; Parity even (:p . 10) (:pe . 10) + ;; Parity odd (:np . 11) (:po . 11) + ;; Signed <; SF /= OF (:l . 12) (:nge . 12) + ;; Signed >=; SF = OF (:ge . 13) (:nl . 13) + ;; Signed <=; ZF = 1 or SF /= OF (:le . 14) (:ng . 14) + ;; Signed >; ZF =0 and SF = OF (:g . 15) (:nle . 15))) (defun conditional-opcode (condition) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/963104015b369a7c835bc70… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/963104015b369a7c835bc70… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-168-no-negated-forms-for-jmp] 2 commits: Update CI to use the bootstrap file when building.
by Raymond Toy (＠rtoy) 26 Feb '23

26 Feb '23

Raymond Toy pushed to branch issue-168-no-negated-forms-for-jmp at cmucl / cmucl Commits: 4ec28e36 by Raymond Toy at 2023-02-25T18:47:06-08:00 Update CI to use the bootstrap file when building. - - - - - b4b8f578 by Raymond Toy at 2023-02-25T18:48:35-08:00 Add comment on what this bootstrap file is supposed to do. - - - - - 2 changed files: - .gitlab-ci.yml - src/bootfiles/21d/boot-2021-07-2.lisp Changes: ===================================== .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: "" + bootstrap: "-B boot-2021-07-2" stages: - install ===================================== src/bootfiles/21d/boot-2021-07-2.lisp ===================================== @@ -1,3 +1,8 @@ +;; Bootstrap file for x86 to choose the non-negated forms of the +;; condition flag for conditional jumps. +;; +;; Use bin/build.sh -B boot-2021-07-2 to build this. + (in-package :x86) (ext:without-package-locks View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6bd3fd00f67e5c4c2275f6… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6bd3fd00f67e5c4c2275f6… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-168-no-negated-forms-for-jmp
by Raymond Toy (＠rtoy) 26 Feb '23

26 Feb '23

Raymond Toy pushed new branch issue-168-no-negated-forms-for-jmp at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-168-no-negated-form… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-156-nan-comparisons
by Raymond Toy (＠rtoy) 26 Feb '23

26 Feb '23

Raymond Toy pushed new branch issue-156-nan-comparisons at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-156-nan-comparisons You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-166-integer-decode-float-min-float] 4 commits: Set version to current 21d in build.sh
by Raymond Toy (＠rtoy) 25 Feb '23

25 Feb '23

Raymond Toy pushed to branch issue-166-integer-decode-float-min-float at cmucl / cmucl Commits: dd122d48 by Raymond Toy at 2023-02-25T07:17:01-08:00 Set version to current 21d in build.sh Bootstrap files should come from the 21d directory, not the 21c directory. - - - - - 62dfe149 by Raymond Toy at 2023-02-25T07:17:59-08:00 Move {DOUBLE,SINGLE}-FLOAT-INT-EXPONENT to KERNEL Since {DOUBLE,SINGLE}-FLOAT-EXPONENT is in the KERNEL package, let's do the same for {DOUBLE,SINGLE}-FLOAT-INT-EXPONENT. This requires removing them from the C package so they can be exported from the KERNEL package. To do this, use the bootstrap file boot-2021-07-1 to unintern these from the C package. Then update the KERNEL package to export these symbols. Finally, update the definition of FLOAT-INT-EXPONENT to use KERNEL:DOUBLE-FLOAT-INT-EXPONENT instead of C::DOUBLE-FLOAT-INT-EXPONENT. - - - - - 0dac88e6 by Raymond Toy at 2023-02-25T07:24:24-08:00 Add comment on what the bootfile is doing. - - - - - 7338f627 by Raymond Toy at 2023-02-25T07:25:19-08:00 Update CI to use the bootstrap file. We'll have to continue using the bootstrap file until a new snapshot/release is done. - - - - - 5 changed files: - .gitlab-ci.yml - bin/build.sh - + src/bootfiles/21d/boot-2021-07-1.lisp - src/code/exports.lisp - src/compiler/generic/vm-type.lisp Changes: ===================================== .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: "" + bootstrap: "-B boot-2021-07-1" stages: - install ===================================== bin/build.sh ===================================== @@ -39,7 +39,7 @@ ENABLE2="yes" ENABLE3="yes" ENABLE4="yes" -version=21c +version=21d SRCDIR=src BINDIR=bin TOOLDIR=$BINDIR ===================================== src/bootfiles/21d/boot-2021-07-1.lisp ===================================== @@ -0,0 +1,18 @@ +;; Bootstrap file +;; +;; Use "bin/build.sh -B boot-2021-07-1" to build this. +;; +;; We want to export the symbols from the KERNEL package which also +;; exists in the C package, so we unintern the conflicting symbols from +;; the C package. + +(in-package "KERNEL") +(ext:without-package-locks + (handler-bind + ((error (lambda (c) + ;;(declare (ignore c)) + (describe c) + (invoke-restart 'lisp::unintern-conflicting-symbols)))) + (export '(DOUBLE-FLOAT-INT-EXPONENT + SINGLE-FLOAT-INT-EXPONENT)))) + ===================================== src/code/exports.lisp ===================================== @@ -2329,6 +2329,7 @@ "DOUBLE-FLOAT-EXPONENT" "DOUBLE-FLOAT-BITS" "DOUBLE-FLOAT-HIGH-BITS" + "DOUBLE-FLOAT-INT-EXPONENT" "DOUBLE-FLOAT-LOW-BITS" "DOUBLE-FLOAT-P" "FLOAT-WAIT" "DYNAMIC-SPACE-FREE-POINTER" "ERROR-NUMBER-OR-LOSE" "FILENAME" "FLOAT-DIGITS" "FLOAT-EXPONENT" "FLOAT-FORMAT-DIGITS" @@ -2426,6 +2427,7 @@ "SIMPLE-ARRAY-SIGNED-BYTE-16-P" "SIMPLE-ARRAY-SIGNED-BYTE-30-P" "SIMPLE-ARRAY-SIGNED-BYTE-32-P" "SIMPLE-ARRAY-SIGNED-BYTE-8-P" "SIMPLE-UNBOXED-ARRAY" "SINGLE-FLOAT-BITS" "SINGLE-FLOAT-EXPONENT" + "SINGLE-FLOAT-INT-EXPONENT" "SINGLE-FLOAT-P" "SINGLE-VALUE-TYPE" "SPECIFIER-TYPE" "STACK-REF" "STD-COMPUTE-CLASS-PRECEDENCE-LIST" "STREAMLIKE" "SIMPLE-STREAM-BUFFER" "STRINGABLE" "STRINGLIKE" ===================================== src/compiler/generic/vm-type.lisp ===================================== @@ -51,7 +51,7 @@ #-long-float 'double-float-exponent #+long-float 'long-float-exponent) (deftype float-int-exponent () - 'c::double-float-int-exponent) + 'double-float-int-exponent) (deftype float-digits () #-long-float `(integer 0 ,vm:double-float-digits) #+long-float `(integer 0 ,vm:long-float-digits)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1683679d5ac48e16e0bf9b… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1683679d5ac48e16e0bf9b… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-166-integer-decode-float-min-float
by Raymond Toy (＠rtoy) 25 Feb '23

25 Feb '23

Raymond Toy pushed new branch issue-166-integer-decode-float-min-float at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-166-integer-decode-… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #159: Don't use /tmp as a path for temp files
by Raymond Toy (＠rtoy) 24 Feb '23

24 Feb '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 1c99e654 by Raymond Toy at 2023-02-24T20:47:11+00:00 Fix #159: Don't use /tmp as a path for temp files - - - - - ba0d43d1 by Raymond Toy at 2023-02-24T20:47:11+00:00 Merge branch 'issue-159-use-local-tmp-dir' into 'master' Fix #159: Don't use /tmp as a path for temp files Closes #159 See merge request cmucl/cmucl!116 - - - - - 1 changed file: - tests/issues.lisp Changes: ===================================== tests/issues.lisp ===================================== @@ -18,8 +18,10 @@ (declare (ignore arg)) form) -(defparameter *test-path* - (merge-pathnames (make-pathname :name :unspecific :type :unspecific +(defparameter *tmp-dir* + (merge-pathnames (make-pathname :directory '(:relative "tmp") + :name :unspecific + :type :unspecific :version :unspecific) *load-truename*) "Directory for temporary test files.") @@ -777,10 +779,11 @@ (define-test issue.140.two-way-stream (:tag :issues) + (ensure-directories-exist *tmp-dir*) (with-open-file (in (merge-pathnames "issues.lisp" cmucl-test-runner::*load-path*) :direction :input :external-format :utf-8) - (with-open-file (out "/tmp/output.tst" + (with-open-file (out (merge-pathnames "output.tst" *tmp-dir*) :direction :output :external-format :utf-8 :if-exists :supersede) @@ -803,15 +806,15 @@ ;; Create 3 output streams. The exact external formats aren't ;; really important here as long as they're different for each file ;; so we can tell if we got the right answer. - (with-open-file (s1 "/tmp/broad-1" + (with-open-file (s1 (merge-pathnames "broad-1" *tmp-dir*) :direction :output :if-exists :supersede :external-format :latin1) - (with-open-file (s2 "/tmp/broad-2" + (with-open-file (s2 (merge-pathnames "broad-2" *tmp-dir*) :direction :output :if-exists :supersede :external-format :utf-8) - (with-open-file (s3 "/tmp/broad-3" + (with-open-file (s3 (merge-pathnames "broad-3" *tmp-dir*) :direction :output :if-exists :supersede :external-format :utf-16) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/0d3cbc39b614c0d7ef7e2e… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/0d3cbc39b614c0d7ef7e2e… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch 159-don-t-use-tmp-as-the-path-for-temp-files-in-the-tests
by Raymond Toy (＠rtoy) 23 Feb '23

23 Feb '23

Raymond Toy pushed new branch 159-don-t-use-tmp-as-the-path-for-temp-files-in-the-tests at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/159-don-t-use-tmp-as-the-… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-159-use-local-tmp-dir
by Raymond Toy (＠rtoy) 22 Feb '23

22 Feb '23

Raymond Toy pushed new branch issue-159-use-local-tmp-dir at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-159-use-local-tmp-d… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Avoid inserting NIL into simple LOOP from FORMAT
by Raymond Toy (＠rtoy) 21 Feb '23

21 Feb '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: be8cb5d0 by Tarn W. Burton at 2023-02-21T07:48:12-05:00 Avoid inserting NIL into simple LOOP from FORMAT - - - - - 0d3cbc39 by Raymond Toy at 2023-02-21T23:25:27+00:00 Merge branch 'fix-format-nil' into 'master' Fix #165: Avoid inserting NIL into simple LOOP from FORMAT See merge request cmucl/cmucl!114 - - - - - 2 changed files: - src/code/format.lisp - tests/printer.lisp Changes: ===================================== src/code/format.lisp ===================================== @@ -399,7 +399,8 @@ (form new-directives) (expand-directive (car remaining-directives) (cdr remaining-directives)) - (push form results) + (when form + (push form results)) (setf remaining-directives new-directives))) (reverse results))) ===================================== tests/printer.lisp ===================================== @@ -113,3 +113,16 @@ (define-test sub-output-integer.1 (assert-prints "-536870912" (princ most-negative-fixnum))) + +;;; Simple LOOP requires only compound forms. Hence NIL is not +;;; permitted. Some FORMAT directives (like newline) return NIL +;;; as the form when they have nothing to add to the body. +;;; Normally this is fine since BLOCK accepts NIL as a form. On +;;; the other hand, when the newline directive is inside of an +;;; iteration directive this will produce something like +;;; (LOOP (fu) nil (bar)) which is not acceptable. To verify +;;; that this is not happening we make sure we are not getting +;;; (BLOCK NIL NIL) since this is easier to test for. +(define-test format-no-nil-form.1 + (assert-equal '(block nil) (third (second (macroexpand-1 '(formatter "~ +")))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/4be1d90cfdf7c67efb30a3… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/4be1d90cfdf7c67efb30a3… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0