Raymond Toy pushed to branch issue-158-darwin-pathnames-utf8 at cmucl / cmucl

Commits:

6 changed files:

Changes:

  • .gitlab-ci.yml
    1 1 
     variables:
    2 2 
       download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/2021/07"
    3 3 
       version: "2021-07-x86"
    4 
    -  bootstrap: "-B boot-2021-07-1"
    4 
    +  bootstrap: "-B boot-2021-07-1 -B boot-2021-07-2"
    5 5
    6 6 
     stages:
    7 7 
       - install

  • src/bootfiles/21d/boot-2021-07-2.lisp
    1 
    +;; Bootstrap file for x86 to choose the non-negated forms of the
    2 
    +;; condition flag for conditional jumps.
    3 
    +;;
    4 
    +;; Use bin/build.sh -B boot-2021-07-2 to build this.
    5 
    +
    6 
    +(in-package :x86)
    7 
    +
    8 
    +(ext:without-package-locks
    9 
    +  (handler-bind
    10 
    +      ((error
    11 
    +	 (lambda (c)
    12 
    +	   (declare (ignore c))
    13 
    +	   (invoke-restart 'continue))))
    14 
    +    (defconstant conditions
    15 
    +      '((:o . 0)
    16 
    +	(:no . 1)
    17 
    +	(:b . 2) (:nae . 2) (:c . 2)
    18 
    +	(:ae . 3) (:nb . 3) (:nc . 3)
    19 
    +	(:e . 4) (:eq . 4) (:z . 4)
    20 
    +	(:ne . 5) (:nz . 5)
    21 
    +	(:be . 6) (:na . 6)
    22 
    +	(:a . 7) (:nbe . 7)
    23 
    +	(:s . 8)
    24 
    +	(:ns . 9)
    25 
    +	(:p . 10) (:pe . 10)
    26 
    +	(:np . 11) (:po . 11)
    27 
    +	(:l . 12) (:nge . 12)
    28 
    +	(:ge . 13) (:nl . 13)
    29 
    +	(:le . 14) (:ng . 14)
    30 
    +	(:g . 15) (:nle . 15)))))

  • src/code/pprint.lisp
    ... ... @@ -1837,6 +1837,89 @@ When annotations are present, invoke them at the right positions."
    1837 1837 
       (funcall (formatter "~:<~W~^~3I ~:_~W~I~@:_~@{ ~W~^~_~}~:>")
    1838 1838 
     	   stream list))
    1839 1839
    1840 
    +(defun pprint-define-vop (stream list &rest noise)
    1841 
    +  (declare (ignore noise))
    1842 
    +  (pprint-logical-block (stream list :prefix "(" :suffix ")")
    1843 
    +    ;; Output "define-vop"
    1844 
    +    (output-object (pprint-pop) stream)
    1845 
    +    (pprint-exit-if-list-exhausted)
    1846 
    +    (write-char #\space stream)
    1847 
    +    ;; Output vop name
    1848 
    +    (output-object (pprint-pop) stream)
    1849 
    +    (pprint-exit-if-list-exhausted)
    1850 
    +    (pprint-newline :mandatory stream)
    1851 
    +    (pprint-indent :block 0 stream)
    1852 
    +    ;; Print out each option starting on a new line
    1853 
    +    (loop
    1854 
    +      (write-char #\space stream)
    1855 
    +      (let ((vop-option (pprint-pop)))
    1856 
    +	;; Figure out what option we have and print it neatly
    1857 
    +	(case (car vop-option)
    1858 
    +	  ((:args :results)
    1859 
    +	   ;; :args and :results print out each arg/result indented neatly
    1860 
    +	   (pprint-logical-block (stream vop-option :prefix "(" :suffix ")")
    1861 
    +	     ;; Output :args/:results
    1862 
    +	     (output-object (pprint-pop) stream)
    1863 
    +	     (pprint-exit-if-list-exhausted)
    1864 
    +	     (write-char #\space stream)
    1865 
    +	     (pprint-indent :current 0 stream)
    1866 
    +	     ;; Print each value indented the same amount so the line
    1867 
    +	     ;; up neatly.
    1868 
    +	     (loop
    1869 
    +	       (output-object (pprint-pop) stream)
    1870 
    +	       (pprint-exit-if-list-exhausted)
    1871 
    +	       (pprint-newline :mandatory stream))))
    1872 
    +	  ((:generator)
    1873 
    +	   (pprint-logical-block (stream vop-option :prefix "(" :suffix ")")
    1874 
    +	     ;; Output :generator
    1875 
    +	     (output-object (pprint-pop) stream)
    1876 
    +	     (pprint-exit-if-list-exhausted)
    1877 
    +	     (write-char #\space stream)
    1878 
    +	     ;; Output cost
    1879 
    +	     (output-object (pprint-pop) stream)
    1880 
    +	     (pprint-exit-if-list-exhausted)
    1881 
    +	     ;; Newline and then the body of the generator
    1882 
    +	     (pprint-newline :mandatory stream)
    1883 
    +	     (write-char #\space stream)
    1884 
    +	     (pprint-indent :current 0 stream)
    1885 
    +	     (loop
    1886 
    +	       (output-object (pprint-pop) stream)
    1887 
    +	       (pprint-exit-if-list-exhausted)
    1888 
    +	       (pprint-newline :mandatory stream))))
    1889 
    +	  (t
    1890 
    +	   ;; Everything else just get printed as usual.
    1891 
    +	   (output-object vop-option stream))))
    1892 
    +      (pprint-exit-if-list-exhausted)
    1893 
    +      (pprint-newline :linear stream))))
    1894 
    +
    1895 
    +(defun pprint-sc-case (stream list &rest noise)
    1896 
    +  (declare (ignore noise))
    1897 
    +  (pprint-logical-block (stream list :prefix "(" :suffix ")")
    1898 
    +    ;; Output "sc-case"
    1899 
    +    (output-object (pprint-pop) stream)
    1900 
    +    (pprint-exit-if-list-exhausted)
    1901 
    +    (write-char #\space stream)
    1902 
    +    ;; Output variable name
    1903 
    +    (output-object (pprint-pop) stream)
    1904 
    +    (pprint-exit-if-list-exhausted)
    1905 
    +    ;; Start the cases on a new line, indented.
    1906 
    +    (pprint-newline :mandatory stream)
    1907 
    +    (pprint-indent :block 0 stream)
    1908 
    +    ;; Print out each case.
    1909 
    +    (loop
    1910 
    +      (write-char #\space stream)
    1911 
    +      (pprint-logical-block (stream (pprint-pop) :prefix "(" :suffix ")")
    1912 
    +	;; Output the case item
    1913 
    +	(output-object (pprint-pop) stream)
    1914 
    +	(pprint-exit-if-list-exhausted)
    1915 
    +	(pprint-newline :mandatory stream)
    1916 
    +	;; Output everything else, starting on a new line.
    1917 
    +	(loop
    1918 
    +	  (output-object (pprint-pop) stream)
    1919 
    +	  (pprint-exit-if-list-exhausted)
    1920 
    +	  (pprint-newline :mandatory stream)))
    1921 
    +      (pprint-exit-if-list-exhausted)
    1922 
    +      (pprint-newline :mandatory stream))))
    1840 1923
    1841 1924 
     ;;;; Interface seen by regular (ugly) printer and initialization routines.
    1842 1925
    ... ... @@ -1952,7 +2035,9 @@ When annotations are present, invoke them at the right positions."
    1952 2035 
         (vm::with-fixed-allocation pprint-with-like)
    1953 2036 
         (kernel::number-dispatch pprint-with-like)
    1954 2037 
         (stream::with-stream-class pprint-with-like)
    1955 
    -    (lisp::with-array-data pprint-with-like)))
    2038 
    +    (lisp::with-array-data pprint-with-like)
    2039 
    +    (c:define-vop pprint-define-vop)
    2040 
    +    (c:sc-case pprint-sc-case)))
    1956 2041
    1957 2042 
     (defun pprint-init ()
    1958 2043 
       (setf *initial-pprint-dispatch* (make-pprint-dispatch-table))

  • src/compiler/float-tran.lisp
    ... ... @@ -347,25 +347,25 @@
    347 347 
     ;;;
    348 348
    349 349 
     (deftype single-float-exponent ()
    350 
    -  `(integer ,(- vm:single-float-normal-exponent-min vm:single-float-bias
    351 
    -		vm:single-float-digits)
    350 
    +  `(integer (,(- vm:single-float-normal-exponent-min vm:single-float-bias
    351 
    +		 vm:single-float-digits))
    352 352 
     	    ,(- vm:single-float-normal-exponent-max vm:single-float-bias)))
    353 353
    354 354 
     (deftype double-float-exponent ()
    355 
    -  `(integer ,(- vm:double-float-normal-exponent-min vm:double-float-bias
    356 
    -		vm:double-float-digits)
    355 
    +  `(integer (,(- vm:double-float-normal-exponent-min vm:double-float-bias
    356 
    +		 vm:double-float-digits))
    357 357 
     	    ,(- vm:double-float-normal-exponent-max vm:double-float-bias)))
    358 358
    359 359
    360 360 
     (deftype single-float-int-exponent ()
    361 
    -  `(integer ,(- vm:single-float-normal-exponent-min vm:single-float-bias
    362 
    -		(* vm:single-float-digits 2))
    361 
    +  `(integer (,(- vm:single-float-normal-exponent-min vm:single-float-bias
    362 
    +		 (* vm:single-float-digits 2)))
    363 363 
     	    ,(- vm:single-float-normal-exponent-max vm:single-float-bias
    364 364 
     		vm:single-float-digits)))
    365 365
    366 366 
     (deftype double-float-int-exponent ()
    367 
    -  `(integer ,(- vm:double-float-normal-exponent-min vm:double-float-bias
    368 
    -		(* vm:double-float-digits 2))
    367 
    +  `(integer (,(- vm:double-float-normal-exponent-min vm:double-float-bias
    368 
    +		 (* vm:double-float-digits 2)))
    369 369 
     	    ,(- vm:double-float-normal-exponent-max vm:double-float-bias
    370 370 
     		vm:double-float-digits)))
    371 371

  • src/compiler/x86/insts.lisp
    ... ... @@ -259,22 +259,39 @@
    259 259 
     ;; the first one is the one that is preferred when printing the
    260 260 
     ;; condition code out.
    261 261 
     (defconstant conditions
    262 
    -  '((:o . 0)
    262 
    +  '(
    263 
    +    ;; OF = 1
    264 
    +    (:o . 0)
    265 
    +    ;; OF = 0
    263 266 
         (:no . 1)
    267 
    +    ;; Unsigned <; CF = 1
    264 268 
         (:b . 2) (:nae . 2) (:c . 2)
    265 
    -    (:nb . 3) (:ae . 3) (:nc . 3)
    269 
    +    ;; Unsigned >=; CF = 0
    270 
    +    (:ae . 3) (:nb . 3) (:nc . 3)
    271 
    +    ;; Equal; ZF = 1
    266 272 
         (:e . 4) (:eq . 4) (:z . 4)
    273 
    +    ;; Not equal; ZF = 0
    267 274 
         (:ne . 5) (:nz . 5)
    275 
    +    ;; Unsigned <=; CF = 1 or ZF = 1
    268 276 
         (:be . 6) (:na . 6)
    269 
    -    (:nbe . 7) (:a . 7)
    277 
    +    ;; Unsigned >; CF = 1 and ZF = 0
    278 
    +    (:a . 7) (:nbe . 7)
    279 
    +    ;; SF = 1
    270 280 
         (:s . 8)
    281 
    +    ;; SF = 0
    271 282 
         (:ns . 9)
    283 
    +    ;; Parity even
    272 284 
         (:p . 10) (:pe . 10)
    285 
    +    ;; Parity odd
    273 286 
         (:np . 11) (:po . 11)
    287 
    +    ;; Signed <; SF /= OF
    274 288 
         (:l . 12) (:nge . 12)
    275 
    -    (:nl . 13) (:ge . 13)
    289 
    +    ;; Signed >=; SF = OF
    290 
    +    (:ge . 13) (:nl . 13)
    291 
    +    ;; Signed <=; ZF = 1 or SF /= OF
    276 292 
         (:le . 14) (:ng . 14)
    277 
    -    (:nle . 15) (:g . 15)))
    293 
    +    ;; Signed >; ZF =0 and SF = OF
    294 
    +    (:g . 15) (:nle . 15)))
    278 295
    279 296 
     (defun conditional-opcode (condition)
    280 297 
       (cdr (assoc condition conditions :test #'eq))))

  • tests/issues.lisp
    ... ... @@ -831,6 +831,7 @@
    831 831 
         (assert-true (stream::find-external-format :cp949))))
    832 832
    833 833
    834 
    +
    834 835 
     (define-test issue.158
    835 836 
         (:tag :issues)
    836 837 
       (let* ((name (string #\Hangul_Syllable_Gyek))
    ... ... @@ -878,7 +879,6 @@
    878 879
    879 880
    880 881
    881 
    -
    882 882 
     (define-test issue.166
    883 883 
         (:tag :issues)
    884 884 
       ;; While this tests for the correct return value, the problem was
    ... ... @@ -888,3 +888,58 @@
    888 888 
     			    (nth-value 1 (integer-decode-float least-positive-double-float))))))
    889 889 
         (assert-equal -1126 (funcall f))))
    890 890
    891 
    +
    892 
    +
    893 
    +(define-test issue.167.single
    894 
    +    (:tag :issues)
    895 
    +  (let ((df-min-expo (nth-value 1 (decode-float least-positive-single-float)))
    896 
    +	(df-max-expo (nth-value 1 (decode-float most-positive-single-float))))
    897 
    +    ;; Verify that the min exponent for kernel:single-float-exponent
    898 
    +    ;; is the actual min exponent from decode-float.
    899 
    +    (assert-true (typep df-min-expo 'kernel:single-float-exponent))
    900 
    +    (assert-true (typep (1+ df-min-expo) 'kernel:single-float-exponent))
    901 
    +    (assert-false (typep (1- df-min-expo) 'kernel:single-float-exponent))
    902 
    +
    903 
    +    ;; Verify that the max exponent for kernel:single-float-exponent
    904 
    +    ;; is the actual max exponent from decode-float.
    905 
    +    (assert-true (typep df-max-expo 'kernel:single-float-exponent))
    906 
    +    (assert-true (typep (1- df-max-expo) 'kernel:single-float-exponent))
    907 
    +    (assert-false (typep (1+ df-max-expo) 'kernel:single-float-exponent)))
    908 
    +
    909 
    +  ;; Same as for decode-float, but for integer-decode-float.
    910 
    +  (let ((idf-min-expo (nth-value 1 (integer-decode-float least-positive-single-float)))
    911 
    +	(idf-max-expo (nth-value 1 (integer-decode-float most-positive-single-float))))
    912 
    +    (assert-true (typep idf-min-expo 'kernel:single-float-int-exponent))
    913 
    +    (assert-true (typep (1+ idf-min-expo) 'kernel:single-float-int-exponent))
    914 
    +    (assert-false (typep (1- idf-min-expo) 'kernel:single-float-int-exponent))
    915 
    +
    916 
    +    (assert-true (typep idf-max-expo 'kernel:single-float-int-exponent))
    917 
    +    (assert-true (typep (1- idf-max-expo) 'kernel:single-float-int-exponent))
    918 
    +    (assert-false (typep (1+ idf-max-expo) 'kernel:single-float-int-exponent))))
    919 
    +
    920 
    +(define-test issue.167.double
    921 
    +    (:tag :issues)
    922 
    +  (let ((df-min-expo (nth-value 1 (decode-float least-positive-double-float)))
    923 
    +	(df-max-expo (nth-value 1 (decode-float most-positive-double-float))))
    924 
    +    ;; Verify that the min exponent for kernel:double-float-exponent
    925 
    +    ;; is the actual min exponent from decode-float.
    926 
    +    (assert-true (typep df-min-expo 'kernel:double-float-exponent))
    927 
    +    (assert-true (typep (1+ df-min-expo) 'kernel:double-float-exponent))
    928 
    +    (assert-false (typep (1- df-min-expo) 'kernel:double-float-exponent))
    929 
    +
    930 
    +    ;; Verify that the max exponent for kernel:double-float-exponent
    931 
    +    ;; is the actual max exponent from decode-float.
    932 
    +    (assert-true (typep df-max-expo 'kernel:double-float-exponent))
    933 
    +    (assert-true (typep (1- df-max-expo) 'kernel:double-float-exponent))
    934 
    +    (assert-false (typep (1+ df-max-expo) 'kernel:double-float-exponent)))
    935 
    +
    936 
    +  ;; Same as for decode-float, but for integer-decode-float.
    937 
    +  (let ((idf-min-expo (nth-value 1 (integer-decode-float least-positive-double-float)))
    938 
    +	(idf-max-expo (nth-value 1 (integer-decode-float most-positive-double-float))))
    939 
    +    (assert-true (typep idf-min-expo 'kernel:double-float-int-exponent))
    940 
    +    (assert-true (typep (1+ idf-min-expo) 'kernel:double-float-int-exponent))
    941 
    +    (assert-false (typep (1- idf-min-expo) 'kernel:double-float-int-exponent))
    942 
    +
    943 
    +    (assert-true (typep idf-max-expo 'kernel:double-float-int-exponent))
    944 
    +    (assert-true (typep (1- idf-max-expo) 'kernel:double-float-int-exponent))
    945 
    +    (assert-false (typep (1+ idf-max-expo) 'kernel:double-float-int-exponent))))

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.common-lisp.net. Manage all notifications · Help