[Git][cmucl/cmucl][issue-158-darwin-pathnames-utf8] 13 commits: Avoid inserting NIL into simple LOOP from FORMAT
Raymond Toy (@rtoy)
gitlab at common-lisp.net
Tue Feb 28 17:05:17 UTC 2023
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/53803637328531223a12e65b648d31434d5a3135...98435a1a9b40866d5fc7cc8c78a05acdc36e634b
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/53803637328531223a12e65b648d31434d5a3135...98435a1a9b40866d5fc7cc8c78a05acdc36e634b
You're receiving this email because of your account on gitlab.common-lisp.net.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20230228/c674824d/attachment-0001.html>
More information about the cmucl-cvs
mailing list