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

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-04-6-ga602748
by Raymond Toy 20 Apr '12

20 Apr '12

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via a60274829b62c938292920f8f19b1c269240e8c2 (commit) via 99d39125b83f6173912c2a689e41db4c40096061 (commit) from 9f6b065b0ea4b758a00fa9b3b790b5ef2bb8853d (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit a60274829b62c938292920f8f19b1c269240e8c2 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Apr 20 09:35:43 2012 -0700 Oops. Debugging print accidentally left in. diff --git a/src/code/stream.lisp b/src/code/stream.lisp index a91d4d7..b5d34ad 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -829,6 +829,7 @@ (flet ((convert-buffer () (let ((old-state (fd-stream-oc-state stream))) + #+(or debug-frc-sr) (format t "old-state = ~S~%" old-state) (multiple-value-bind (s char-count octet-count new-state) (stream::octets-to-string-counted commit 99d39125b83f6173912c2a689e41db4c40096061 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Apr 20 09:34:48 2012 -0700 UTF-16-BE and UTF-16-LE external formats were returning the incorrect number of octets for surrogate pairs. Two was returned instead of four. * src/pcl/simple-streams/external-formats/utf-16-be.lisp: * src/pcl/simple-streams/external-formats/utf-16-le.lisp: * Return correct number of octets * src/general-info/release-20d.txt * Update. diff --git a/src/general-info/release-20d.txt b/src/general-info/release-20d.txt index 6bd52d5..fe9baaf 100644 --- a/src/general-info/release-20d.txt +++ b/src/general-info/release-20d.txt @@ -61,6 +61,9 @@ New in this release: double-float multiplier from being used when sse3 is available. * External format for UTF-32 was generating an error when converting octets to a string. + * The UTF-16-BE and UTF-16-LE external formats were returning the + incorrect number of octets when surrogates pairs were decoded. + This confuses the stream buffering code. * Trac Tickets: * #50: Print/read error with make-pathname. diff --git a/src/pcl/simple-streams/external-formats/utf-16-be.lisp b/src/pcl/simple-streams/external-formats/utf-16-be.lisp index e2780ea..948a24e 100644 --- a/src/pcl/simple-streams/external-formats/utf-16-be.lisp +++ b/src/pcl/simple-streams/external-formats/utf-16-be.lisp @@ -21,10 +21,11 @@ By default, illegal inputs and illegal outputs are replaced by the Unicode replacement character.") () - (octets-to-code (state input unput error c1 c2 code next) + (octets-to-code (state input unput error c1 c2 code wd next) `(let* ((,c1 ,input) (,c2 ,input) - (,code (+ (* 256 ,c1) ,c2))) + (,code (+ (* 256 ,c1) ,c2)) + (, wd 2)) (declare (type lisp:codepoint ,code)) (cond ((lisp::surrogatep ,code :low) ;; Got low surrogate. Combine with the state (high @@ -55,7 +56,8 @@ Unicode replacement character.") ;; unput 2 so it'll be read as another character ;; next time around? (if (lisp::surrogatep ,next :low) - (setq ,code (+ (ash (- ,code #xD800) 10) ,next #x2400)) + (setq ,code (+ (ash (- ,code #xD800) 10) ,next #x2400) + ,wd 4) (setf ,code (if ,error (locally @@ -74,7 +76,7 @@ Unicode replacement character.") (funcall ,error "BOM is not valid within a UTF-16 stream" ,code 2)) +replacement-character-code+))) (t (setf ,state nil))) - (values ,code 2))) + (values ,code ,wd))) (code-to-octets (code state output error c c1 c2) `(flet ((output (code) (,output (ldb (byte 8 8) code)) diff --git a/src/pcl/simple-streams/external-formats/utf-16-le.lisp b/src/pcl/simple-streams/external-formats/utf-16-le.lisp index b7faa28..6fb4b65 100644 --- a/src/pcl/simple-streams/external-formats/utf-16-le.lisp +++ b/src/pcl/simple-streams/external-formats/utf-16-le.lisp @@ -22,10 +22,11 @@ By default, illegal inputs and illegal outputs are replaced by the Unicode replacement character.") () - (octets-to-code (state input unput error c1 c2 code next) + (octets-to-code (state input unput error c1 c2 code wd next) `(let* ((,c1 ,input) (,c2 ,input) - (,code (+ (* 256 ,c2) ,c1))) + (,code (+ (* 256 ,c2) ,c1)) + (,wd 2)) (declare (type lisp:codepoint ,code)) (cond ((lisp::surrogatep ,code :low) ;; If possible combine this low surrogate with the @@ -56,14 +57,15 @@ Unicode replacement character.") ;; unput 2 so it'll be read as another character ;; next time around? (if (lisp::surrogatep ,next :low) - (setq ,code (+ (ash (- ,code #xD800) 10) ,next #x2400)) + (setq ,code (+ (ash (- ,code #xD800) 10) ,next #x2400) + ,wd 4) (setq ,code (if ,error (locally ;; No warnings about fdefinition (declare (optimize (ext:inhibit-warnings 3))) (funcall ,error "High surrogate followed by #x~4,'0X ~ - instead of low surrogate" ,next 2)) + instead of low surrogate" ,next ,wd)) +replacement-character-code+))))) ((= ,code #xFFFE) ;; replace with REPLACEMENT CHARACTER. @@ -75,7 +77,7 @@ Unicode replacement character.") (funcall ,error "BOM is not valid within a UTF-16 stream" ,code 2)) +replacement-character-code+))) (t (setf ,state nil))) - (values ,code 2))) + (values ,code ,wd))) (code-to-octets (code state output error c c1 c2) `(flet ((output (code) (,output (ldb (byte 8 0) code)) ----------------------------------------------------------------------- Summary of changes: src/code/stream.lisp | 1 + src/general-info/release-20d.txt | 3 +++ .../simple-streams/external-formats/utf-16-be.lisp | 10 ++++++---- .../simple-streams/external-formats/utf-16-le.lisp | 12 +++++++----- 4 files changed, 17 insertions(+), 9 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-04-4-g9f6b065
by Raymond Toy 20 Apr '12

20 Apr '12

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 9f6b065b0ea4b758a00fa9b3b790b5ef2bb8853d (commit) from f3db74d49bf24c108053873f06905dbb2ed3cebd (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 9f6b065b0ea4b758a00fa9b3b790b5ef2bb8853d Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Apr 20 08:41:14 2012 -0700 Test for state change was wrong. diff --git a/src/code/stream.lisp b/src/code/stream.lisp index 92987b7..a91d4d7 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -829,6 +829,7 @@ (flet ((convert-buffer () (let ((old-state (fd-stream-oc-state stream))) + (format t "old-state = ~S~%" old-state) (multiple-value-bind (s char-count octet-count new-state) (stream::octets-to-string-counted ibuf @@ -847,7 +848,6 @@ (format t "char-count = ~A~%" char-count) (format t "octet-count = ~A~%" octet-count) (format t "in-index = ~A~%" (lisp-stream-in-index stream)) - (format t "old state = ~S~%" old-state) (format t "new state = ~S~%" new-state)) ;; FIXME: We need to know if a BOM ;; character was read so that we can @@ -869,8 +869,9 @@ ;; octet-count by 2 for the BOM because ;; OCTETS-TO-STRING doesn't include that ;; in its count. - (when (not (eql (cadr old-state) - (cadr new-state))) + (when (and (consp (cdr new-state)) + (not (eql (cadr old-state) + (cadr new-state)))) #+debug-frc-sr (format t "state changed from ~S to ~S~%" old-state new-state) ;; See utf-16.lisp and utf-32.lisp to ----------------------------------------------------------------------- Summary of changes: src/code/stream.lisp | 7 ++++--- 1 files changed, 4 insertions(+), 3 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-04-3-gf3db74d
by Raymond Toy 19 Apr '12

19 Apr '12

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via f3db74d49bf24c108053873f06905dbb2ed3cebd (commit) from 4c7f35da68188371f72ad068860df3f86a69f6b2 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit f3db74d49bf24c108053873f06905dbb2ed3cebd Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Apr 18 23:53:31 2012 -0700 Fix ticket:58. Handle the BOM character for utf-16 and utf-32. This is a bit of a hack. * src/code/stream.lisp: * Check the state to see if a BOM was read. This critically depends on knowing the format of the state variable for utf16 and utf32 formats, but the stream code shouldn't have to know the state internals. * src/general-info/release-20d.txt * Update. diff --git a/src/code/stream.lisp b/src/code/stream.lisp index 77a90f7..92987b7 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -828,35 +828,70 @@ ;; haven't processed yet and the ones we just read in. (flet ((convert-buffer () - (multiple-value-bind (s char-count octet-count new-state) - (stream::octets-to-string-counted - ibuf - (fd-stream-octet-count stream) - :start 0 - :end (fd-stream-in-length stream) - :state (fd-stream-oc-state stream) - :string sbuf - :s-start 1 - :external-format (fd-stream-external-format stream) - :error (fd-stream-octets-to-char-error stream)) - (declare (ignore s) - (type (integer 0 #.in-buffer-length) char-count octet-count)) - #+(or debug-frc-sr) - (progn - (format t "char-count = ~A~%" char-count) - (format t "octet-count = ~A~%" octet-count) - (format t "in-index = ~A~%" (lisp-stream-in-index stream))) - (when (> char-count 0) - (setf (fd-stream-oc-state stream) new-state) - (setf (lisp-stream-string-buffer-len stream) (1+ char-count)) - (setf (lisp-stream-string-index stream) 2) - (setf (lisp-stream-in-index stream) octet-count) + (let ((old-state (fd-stream-oc-state stream))) + (multiple-value-bind (s char-count octet-count new-state) + (stream::octets-to-string-counted + ibuf + (fd-stream-octet-count stream) + :start 0 + :end (fd-stream-in-length stream) + :state (fd-stream-oc-state stream) + :string sbuf + :s-start 1 + :external-format (fd-stream-external-format stream) + :error (fd-stream-octets-to-char-error stream)) + (declare (ignore s) + (type (integer 0 #.in-buffer-length) char-count octet-count)) #+(or debug-frc-sr) (progn - (format t "new in-index = ~A~%" (lisp-stream-in-index stream)) - (format t "new sbuf = ~S~%" - (subseq sbuf 0 (1+ char-count)))) - (schar sbuf 1))))) + (format t "char-count = ~A~%" char-count) + (format t "octet-count = ~A~%" octet-count) + (format t "in-index = ~A~%" (lisp-stream-in-index stream)) + (format t "old state = ~S~%" old-state) + (format t "new state = ~S~%" new-state)) + ;; FIXME: We need to know if a BOM + ;; character was read so that we can + ;; adjust the octet count correctly + ;; because OCTETS-TO-CHAR does not include + ;; the BOM in the number of octets + ;; processed. To do that, we look into + ;; the state, and thus is very fragile. + ;; OCTETS-TO-CHAR and thus + ;; OCTETS-TO-STRING-COUNTED should + ;; indicate that instead of doing it here. + ;; + ;; So far, only utf-16 and utf-32 needs to + ;; handle BOM specially. In both of these + ;; cases, (cadr state) contains + ;; information about whether a BOM + ;; character was read or not. If a BOM + ;; was read, then we need to increment the + ;; octet-count by 2 for the BOM because + ;; OCTETS-TO-STRING doesn't include that + ;; in its count. + (when (not (eql (cadr old-state) + (cadr new-state))) + #+debug-frc-sr + (format t "state changed from ~S to ~S~%" old-state new-state) + ;; See utf-16.lisp and utf-32.lisp to + ;; see where the 1 and 2 come from. + ;; They indicate that the BOM was read, + ;; and whether we're reading big-endian + ;; or little-endian data. + (when (member (cadr new-state) '(1 2)) + ;; We read a BOM. + (incf octet-count 2))) + (when (> char-count 0) + (setf (fd-stream-oc-state stream) new-state) + (setf (lisp-stream-string-buffer-len stream) (1+ char-count)) + (setf (lisp-stream-string-index stream) 2) + (setf (lisp-stream-in-index stream) octet-count) + #+(or debug-frc-sr) + (progn + (format t "new in-index = ~A~%" (lisp-stream-in-index stream)) + (format t "new sbuf = ~S~%" + (subseq sbuf 0 (1+ char-count)))) + (schar sbuf 1)))))) (let ((out (convert-buffer))) (or out ;; There weren't enough octets to convert at diff --git a/src/general-info/release-20d.txt b/src/general-info/release-20d.txt index 44626fd..6bd52d5 100644 --- a/src/general-info/release-20d.txt +++ b/src/general-info/release-20d.txt @@ -67,6 +67,7 @@ New in this release: * #53: UTF-8 in core. * #52: UNICODE-COMPLETE-NAME misses a completion. * #55: blocked signals. + * #58: UTF-16 buffering problem. * Other changes: * The layout of the cmucl directories has been changed. ----------------------------------------------------------------------- Summary of changes: src/code/stream.lisp | 89 ++++++++++++++++++++++++++----------- src/general-info/release-20d.txt | 1 + 2 files changed, 63 insertions(+), 27 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-04-2-g4c7f35d
by Raymond Toy 19 Apr '12

19 Apr '12

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 4c7f35da68188371f72ad068860df3f86a69f6b2 (commit) from 236396d8493829ba75607f3a5c54af708ff35f5c (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 4c7f35da68188371f72ad068860df3f86a69f6b2 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Apr 18 21:38:46 2012 -0700 Add many additional aliases to match glibc iconv aliases. Donated by Douglas Crosher. * src/pcl/simple-streams/external-formats/aliases * Add additional aliases. * src/general-info/release-20d.txt: * Update diff --git a/src/general-info/release-20d.txt b/src/general-info/release-20d.txt index 176d102..44626fd 100644 --- a/src/general-info/release-20d.txt +++ b/src/general-info/release-20d.txt @@ -39,6 +39,8 @@ New in this release: and is up-to-date. It will run on OSX 10.4 and 10.5. However, only the Unicode build is supported. * Updated to Unicode 6.1.0. + * Many additional aliases for external formats added that match + the glibc iconv aliases. * ANSI compliance fixes: * CMUCL was not printing pathnames like (make-pathname :directory diff --git a/src/pcl/simple-streams/external-formats/aliases b/src/pcl/simple-streams/external-formats/aliases index 1897a5d..2e9214f 100644 --- a/src/pcl/simple-streams/external-formats/aliases +++ b/src/pcl/simple-streams/external-formats/aliases @@ -10,50 +10,185 @@ null void latin1 iso8859-1 latin-1 iso8859-1 +l1 iso8859-1 iso-8859-1 iso8859-1 +iso-ir-100 iso8859-1 +iso_8859-1\:1987 iso8859-1 +iso_8859-1 iso8859-1 +iso88591 iso8859-1 +ibm819 iso8859-1 +cp819 iso8859-1 +csisolatin1 iso8859-1 +8859_1 iso8859-1 +osf00010001 iso8859-1 latin2 iso8859-2 latin-2 iso8859-2 +l2 iso8859-2 iso-8859-2 iso8859-2 +iso-ir-101 iso8859-2 +iso_8859-2\:1987 iso8859-2 +iso_8859-2 iso8859-2 +iso88592 iso8859-2 +csisolatin2 iso8859-2 +8859_2 iso8859-2 +osf00010002 iso8859-2 +ibm912 iso8859-2 +cp912 iso8859-2 latin3 iso8859-3 latin-3 iso8859-3 +l3 iso8859-3 iso-8859-3 iso8859-3 +iso-ir-109 iso8859-3 +iso_8859-3\:1988 iso8859-3 +iso_8859-3 iso8859-3 +iso88593 iso8859-3 +csisolatin3 iso8859-3 +8859_3 iso8859-3 +osf00010003 iso8859-3 latin4 iso8859-4 latin-4 iso8859-4 +l4 iso8859-4 iso-8859-4 iso8859-4 +iso-ir-110 iso8859-4 +iso_8859-4\:1988 iso8859-4 +iso_8859-4 iso8859-4 +iso88594 iso8859-4 +csisolatin4 iso8859-4 +8859_4 iso8859-4 +osf00010004 iso8859-4 cyrillic iso8859-5 iso-8859-5 iso8859-5 +iso-ir-144 iso8859-5 +iso_8859-5\:1988 iso8859-5 +iso_8859-5 iso8859-5 +iso88595 iso8859-5 +cyrillic iso8859-5 +csisolatincyrillic iso8859-5 +8859_5 iso8859-5 +osf00010005 iso8859-5 +ibm915 iso8859-5 +cp915 iso8859-5 + arabic iso8859-6 iso-8859-6 iso8859-6 +iso-ir-127 iso8859-6 +iso_8859-6\:1987 iso8859-6 +iso_8859-6 iso8859-6 +iso88596 iso8859-6 +ecma-114 iso8859-6 +asmo-708 iso8859-6 +arabic iso8859-6 +csisolatinarabic iso8859-6 +8859_6 iso8859-6 +osf00010006 iso8859-6 +ibm1089 iso8859-6 +cp1089 iso8859-6 greek iso8859-7 iso-8859-7 iso8859-7 +iso-ir-126 iso8859-7 +iso_8859-7\:2003 iso8859-7 +iso_8859-7\:1987 iso8859-7 +iso_8859-7 iso8859-7 +iso88597 iso8859-7 +elot_928 iso8859-7 +ecma-118 iso8859-7 +greek iso8859-7 +greek8 iso8859-7 +csisolatingreek iso8859-7 +8859_7 iso8859-7 +osf00010007 iso8859-7 +ibm813 iso8859-7 +cp813 iso8859-7 hebrew iso8859-8 iso-8859-8 iso8859-8 +iso-ir-138 iso8859-8 +iso_8859-8\:1988 iso8859-8 +iso_8859-8 iso8859-8 +iso88598 iso8859-8 +hebrew iso8859-8 +csisolatinhebrew iso8859-8 +8859_8 iso8859-8 +osf00010008 iso8859-8 +ibm916 iso8859-8 +cp916 iso8859-8 latin5 iso8859-9 latin-5 iso8859-9 +l5 iso8859-9 iso-8859-9 iso8859-9 +iso-ir-148 iso8859-9 +iso_8859-9\:1989 iso8859-9 +iso_8859-9 iso8859-9 +iso88599 iso8859-9 +csisolatin5 iso8859-9 +8859_9 iso8859-9 +osf00010009 iso8859-9 +ibm920 iso8859-9 +cp920 iso8859-9 +ts-5881 iso8859-9 +ecma-128 iso8859-9 latin6 iso8859-10 latin-6 iso8859-10 +l6 iso8859-10 iso-8859-10 iso8859-10 +iso-ir-157 iso8859-10 +iso_8859-10\:1992 iso8859-10 +iso_8859-10 iso8859-10 +iso885910 iso8859-10 +csisolatin6 iso8859-10 +osf0001000a iso8859-10 latin7 iso8859-13 latin-7 iso8859-13 +l7 iso8859-13 iso-8859-13 iso8859-13 +iso885913 iso8859-13 +iso-ir-179 iso8859-13 +baltic iso8859-13 latin8 iso8859-14 latin-8 iso8859-14 +l8 iso8859-14 iso-8859-14 iso8859-14 +iso885914 iso8859-14 +iso-ir-199 iso8859-14 +iso_8859-14\:1998 iso8859-14 +iso_8859-14 iso8859-14 +iso-celtic iso8859-14 latin9 iso8859-15 latin-9 iso8859-15 +latin9 iso8859-15 iso-8859-15 iso8859-15 +iso885915 iso8859-15 +iso-ir-203 iso8859-15 +iso_8859-15 iso8859-15 +iso_8859-15\:1998 iso8859-15 + +ansi_x3.4 ascii +iso-ir-6 ascii +ansi_x3.4-1986 ascii +iso_646.irv\:1991 ascii +iso646-us ascii +us-ascii ascii +us ascii +ibm367 ascii +cp367 ascii +csascii ascii +osf00010020 ascii +ansi_x3.4-1968 ascii + +macuk mac-cyrillic +mac-uk mac-cyrillic +macukrainian mac-cyrillic +maccyrillic mac-cyrillic utf utf-8 utf8 utf-8 @@ -87,6 +222,7 @@ utf32le utf-32-le windows-1252 cp1252 windows-cp1252 cp1252 windows-latin1 cp1252 +ms-ansi cp1252 ;; These are not yet implemented ;;iso-2022-jp iso2022-jp ----------------------------------------------------------------------- Summary of changes: src/general-info/release-20d.txt | 2 + src/pcl/simple-streams/external-formats/aliases | 136 +++++++++++++++++++++++ 2 files changed, 138 insertions(+), 0 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-04-1-g236396d
by Raymond Toy 19 Apr '12

19 Apr '12

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 236396d8493829ba75607f3a5c54af708ff35f5c (commit) from 3b9e43c17458d68ccf262530c34459eb007d58e1 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 236396d8493829ba75607f3a5c54af708ff35f5c Author: Raymond Toy <rtoy(a)google.com> Date: Wed Apr 18 15:02:31 2012 -0700 Fix typo in external format for utf-32. utf-32.lisp:: * Fix typo. release-20d.txt:: * Update. diff --git a/src/general-info/release-20d.txt b/src/general-info/release-20d.txt index fc525cc..176d102 100644 --- a/src/general-info/release-20d.txt +++ b/src/general-info/release-20d.txt @@ -57,6 +57,8 @@ New in this release: returned instead. * Some VOP costs were incorrect which prevented the fast complex double-float multiplier from being used when sse3 is available. + * External format for UTF-32 was generating an error when + converting octets to a string. * Trac Tickets: * #50: Print/read error with make-pathname. diff --git a/src/pcl/simple-streams/external-formats/utf-32.lisp b/src/pcl/simple-streams/external-formats/utf-32.lisp index 469327e..1fd3cf1 100644 --- a/src/pcl/simple-streams/external-formats/utf-32.lisp +++ b/src/pcl/simple-streams/external-formats/utf-32.lisp @@ -38,7 +38,7 @@ By default, illegal inputs and illegal outputs are replaced by the Unicode replacement character.") () - (octets-to-code (state input unput code error c1 c2 c3 c4 st wd) + (octets-to-code (state input unput error code c1 c2 c3 c4 st wd) `(block nil (when (null ,state) (setf ,state 0)) (tagbody ----------------------------------------------------------------------- Summary of changes: src/general-info/release-20d.txt | 2 ++ .../simple-streams/external-formats/utf-32.lisp | 2 +- 2 files changed, 3 insertions(+), 1 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp annotated tag snapshot-2012-04 created. snapshot-2012-04
by Raymond Toy 02 Apr '12

02 Apr '12

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The annotated tag, snapshot-2012-04 has been created at 87c20607e9bca49530f1d5d9d7604dad604ed0e7 (tag) tagging 3b9e43c17458d68ccf262530c34459eb007d58e1 (commit) replaces snapshot-2012-03 tagged by Raymond Toy on Sat Mar 31 13:14:23 2012 -0700 - Log ----------------------------------------------------------------- Snapshot 2012-04 Alex Goncharov (1): .gitignore: add build-* Raymond Toy (7): Set the generator costs for the complex multiply vops to be the number Oops. Long-standing bug that cmu-contribs was defined so it couldn't Add contrib for packed SSE2 operations. Update. Microoptimization: (logand x #xffffffff) can be just a register move Add comments, clean up code a little. Clarify a comment. ----------------------------------------------------------------------- hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-03-8-g3b9e43c
by Raymond Toy 30 Mar '12

30 Mar '12

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 3b9e43c17458d68ccf262530c34459eb007d58e1 (commit) from 26419b3ce542bb406d08585c051a1dc97ba208fb (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 3b9e43c17458d68ccf262530c34459eb007d58e1 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Thu Mar 29 18:53:33 2012 -0700 Clarify a comment. diff --git a/src/compiler/sparc/arith.lisp b/src/compiler/sparc/arith.lisp index 796bc4c..a4d36f6 100644 --- a/src/compiler/sparc/arith.lisp +++ b/src/compiler/sparc/arith.lisp @@ -201,7 +201,9 @@ ;; This vop is intended to handle the case (logand x #xffffffff) when ;; x is a (signed-byte 32). We can just do a register move instead of -;; and'ing with #xffffffff. +;; and'ing with #xffffffff. Some other special cases are handled too +;; when the constant can fit inside the immediate operaand of the and +;; instruction. (define-vop (fast-logand-c/signed-unsigned=>unsigned fast-unsigned-binop-c) (:args (x :scs (signed-reg))) (:translate logand) @@ -214,7 +216,7 @@ ((typep y '(unsigned-byte 13)) (inst and r x y)) (t - ;; The constant is really a (signed-byte 13), so convert it + ;; The constant operand is really a (signed-byte 13), so convert it ;; to a negative number so the immediate operand gets ;; signed extended to the right bits. (inst and r x (- y #x100000000)) ----------------------------------------------------------------------- Summary of changes: src/compiler/sparc/arith.lisp | 6 ++++-- 1 files changed, 4 insertions(+), 2 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-03-7-g26419b3
by Raymond Toy 29 Mar '12

29 Mar '12

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 26419b3ce542bb406d08585c051a1dc97ba208fb (commit) via bd6f5eacbbf9869a0a69973d50d14577c9bfb3cc (commit) from b08f245dbb9de963ca05142bb20d8fd27071a343 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 26419b3ce542bb406d08585c051a1dc97ba208fb Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Mar 28 21:14:12 2012 -0700 Add comments, clean up code a little. diff --git a/src/contrib/packed-sse2/packed-sse2.lisp b/src/contrib/packed-sse2/packed-sse2.lisp index c3b9668..4d8de08 100644 --- a/src/contrib/packed-sse2/packed-sse2.lisp +++ b/src/contrib/packed-sse2/packed-sse2.lisp @@ -9,7 +9,11 @@ ;; SSE2 Packed operations. ;; -;; We use (complex double-float) variables to hold the packed values. +;; We use (complex double-float) variables to hold the packed values, +;; including packed doubles and packed singles. For convenience, use +;; sse2-setpd or sse2-setps to initialize the packed variables with +;; the given scalar values. To extract the individual components of +;; the packed values, use sse2-getpd or sse2-getps. (in-package #:vm) @@ -128,47 +132,51 @@ (declaim (inline sse2-shufpd sse2-shufps)) -(defun sse2-shufpd (x y i) +;; This needs better documentation. I (rtoy) can never remember what +;; the magic I values actually do. +(defun sse2-shufpd (dst src i) "Shuffle packed doubles in X and Y according to I." - (declare (type (complex double-float) x y) + (declare (type (complex double-float) dst src) (type (unsigned-byte 2) i)) (ecase i (0 - (%sse2-shufpd x y 0)) + (%sse2-shufpd dst src 0)) (1 - (%sse2-shufpd x y 1)) + (%sse2-shufpd dst src 1)) (2 - (%sse2-shufpd x y 2)) + (%sse2-shufpd dst src 2)) (3 - (%sse2-shufpd x y 3)))) + (%sse2-shufpd dst src 3)))) -(defun sse2-shufps (x y i) +(defun sse2-shufps (dst src i) "Shuffle packed singles in X and Y according to I." - (declare (type (complex double-float) x y) + (declare (type (complex double-float) dst src) (type (unsigned-byte 4) i)) (ecase i (0 - (%sse2-shufps x y 0)) + (%sse2-shufps dst src 0)) (1 - (%sse2-shufps x y 1)) + (%sse2-shufps dst src 1)) (2 - (%sse2-shufps x y 2)) + (%sse2-shufps dst src 2)) (3 - (%sse2-shufps x y 3)) + (%sse2-shufps dst src 3)) (4 - (%sse2-shufps x y 4)) + (%sse2-shufps dst src 4)) (5 - (%sse2-shufps x y 5)) + (%sse2-shufps dst src 5)) (6 - (%sse2-shufps x y 6)) + (%sse2-shufps dst src 6)) (7 - (%sse2-shufps x y 7)))) + (%sse2-shufps dst src 7)))) ;; x is the high part and y is the low part. (declaim (inline sse2-setpd sse2-getpd sse2-setps sse2-getps)) (defun sse2-setpd (x y) "Create a packed double with X in the high part and Y in the low part" (declare (type double-float x y)) + ;; Complex double-floats store the real part in the low half of the + ;; sse2 register. (complex y x)) (defun sse2-getpd (pd) @@ -185,7 +193,12 @@ (flet ((pack-singles-to-double (hi lo) (let ((hi-bits (single-float-bits hi)) (lo-bits (single-float-bits lo))) + ;; Create a double-float where the most significant 32 + ;; bits contain the hi float and the low 32-bits contain + ;; the low float. (make-double-float hi-bits (logand #xffffffff lo-bits))))) + ;; Pack the singles into a double and the pack the two doubles + ;; into a (complex double-float). (sse2-setpd (pack-singles-to-double x3 x2) (pack-singles-to-double x1 x0)))) commit bd6f5eacbbf9869a0a69973d50d14577c9bfb3cc Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Mar 28 21:11:18 2012 -0700 Microoptimization: (logand x #xffffffff) can be just a register move without and'ing. (If x is a signed-byte 32.) diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp index 96b480e..69d3426 100644 --- a/src/compiler/x86/arith.lisp +++ b/src/compiler/x86/arith.lisp @@ -348,8 +348,18 @@ (define-vop (fast-logand-c/signed-unsigned=>unsigned fast-logand-c/unsigned=>unsigned) (:args (x :target r :scs (signed-reg signed-stack))) - (:arg-types signed-num (:constant (unsigned-byte 32)))) - + (:arg-types signed-num (:constant (unsigned-byte 32))) + (:generator 1 + (cond ((and (= y #xffffffff) + (sc-is x signed-reg)) + ;; Just move x to the result if we're and'ing with all + ;; ones, which doesn't change the bits. + (unless (location= x r) + (move r x))) + (t + (move r x) + (inst and r y))))) + (define-vop (fast-logand/unsigned-signed=>unsigned fast-logand/unsigned=>unsigned) (:args (x :target r :scs (unsigned-reg) ----------------------------------------------------------------------- Summary of changes: src/compiler/x86/arith.lisp | 14 +++++++- src/contrib/packed-sse2/packed-sse2.lisp | 47 +++++++++++++++++++----------- 2 files changed, 42 insertions(+), 19 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-03-5-gb08f245
by Raymond Toy 27 Mar '12

27 Mar '12

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via b08f245dbb9de963ca05142bb20d8fd27071a343 (commit) from 5a97fd587b09075dd769dc1499c42054dcd9b983 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit b08f245dbb9de963ca05142bb20d8fd27071a343 Author: Raymond Toy <rtoy(a)google.com> Date: Tue Mar 27 16:38:23 2012 -0700 Update. diff --git a/src/general-info/release-20d.txt b/src/general-info/release-20d.txt index 58a431b..fc525cc 100644 --- a/src/general-info/release-20d.txt +++ b/src/general-info/release-20d.txt @@ -21,7 +21,13 @@ New in this release: * Known issues: * Feature enhancements - + * Added a new contrib, "contrib-packed-sse2" to allow packed + operations ala SSE2. Support for some packed sse2 operations + like multiply, divide, and shuffle for both packed singles and + doubles. All operatios are done on top of (complex + double-float) numbers. Utility functions are provided to set + and access these packed numbers. + * Changes * ASDF2 updated to version 2.019. * Behavior of STRING-TO-OCTETS has changed. This is an @@ -49,6 +55,8 @@ New in this release: * LISP:UNICODE-COMPLETE now longer signals an error if the prefix isn't a prefix of the name of any unicode character. Nil is returned instead. + * Some VOP costs were incorrect which prevented the fast complex + double-float multiplier from being used when sse3 is available. * Trac Tickets: * #50: Print/read error with make-pathname. ----------------------------------------------------------------------- Summary of changes: src/general-info/release-20d.txt | 10 +++++++++- 1 files changed, 9 insertions(+), 1 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-03-4-g5a97fd5
by Raymond Toy 27 Mar '12

27 Mar '12

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 5a97fd587b09075dd769dc1499c42054dcd9b983 (commit) via 788a393ba3cc06a662da170b1eb9bc5d4863b176 (commit) from 522f9205c9ed5e1ed23389e2c2b186de352835df (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 5a97fd587b09075dd769dc1499c42054dcd9b983 Author: Raymond Toy <rtoy(a)google.com> Date: Tue Mar 27 16:20:18 2012 -0700 Add contrib for packed SSE2 operations. src/contrib/contrib.lisp: o Define the module src/contrib/packed-sse2/compile-packed-sse2.lisp: o New file to compile the contrib. src/contrib/packed-sse2/packed-sse2.lisp: o New file implementing the packed sse2 vops and functions. diff --git a/src/contrib/contrib.lisp b/src/contrib/contrib.lisp index 66bd69f..1c9fd69 100644 --- a/src/contrib/contrib.lisp +++ b/src/contrib/contrib.lisp @@ -40,4 +40,8 @@ (defmodule "contrib-sprof" "modules:sprof/compile-sprof") +;; packed sse2 needs to be compiled to work. +(defmodule "contrib-packed-sse2" + "modules:packed-sse2/compile-packed-sse2") + (provide "cmu-contribs") diff --git a/src/contrib/packed-sse2/compile-packed-sse2.lisp b/src/contrib/packed-sse2/compile-packed-sse2.lisp new file mode 100644 index 0000000..8aac5e8 --- /dev/null +++ b/src/contrib/packed-sse2/compile-packed-sse2.lisp @@ -0,0 +1,2 @@ +(compile-file "modules:packed-sse2/packed-sse2" + :load t) diff --git a/src/contrib/packed-sse2/packed-sse2.lisp b/src/contrib/packed-sse2/packed-sse2.lisp new file mode 100644 index 0000000..c3b9668 --- /dev/null +++ b/src/contrib/packed-sse2/packed-sse2.lisp @@ -0,0 +1,210 @@ +;;;; -*- Mode: LISP; -*- + +(in-package "CL-USER") +;; Fail if we don't have sse2! + +(eval-when (:load-toplevel :compile-toplevel :execute) + (unless (featurep :sse2) + (error "Cannot use packed SSE2 instructions without SSE2 support."))) + +;; SSE2 Packed operations. +;; +;; We use (complex double-float) variables to hold the packed values. + +(in-package #:vm) + +(export '(sse2-mulpd sse2-mulps + sse2-divpd sse2-divps + sse2-shufpd sse2-shufps + sse2-setpd sse2-setps + sse2-getpd sse2-getps)) + +(defknown (sse2-mulpd sse2-mulps) ((complex double-float) (complex double-float)) + (complex double-float) + (movable foldable flushable)) + +(defknown (sse2-divpd sse2-divps) ((complex double-float) (complex double-float)) + (complex double-float) + (movable foldable flushable)) + +(macrolet + ((generate (movinst opinst commutative) + `(cond + ((location= x r) + (inst ,opinst x y)) + ((and ,commutative (location= y r)) + (inst ,opinst y x)) + ((not (location= r y)) + (inst ,movinst r x) + (inst ,opinst r y)) + (t + (inst ,movinst tmp x) + (inst ,opinst tmp y) + (inst ,movinst r tmp)))) + (packed-op (op inst float-type cost &optional commutative) + (let* ((vop-name (symbolicate (symbol-name op) "/COMPLEX-" float-type "-FLOAT")) + (c-type (symbolicate "COMPLEX-" float-type "-FLOAT")) + (complex-reg (symbolicate "COMPLEX-" float-type "-REG"))) + ;; Note: It would probably improve things if we could use + ;; memory operands, but we can't because the instructions + ;; assumed 128-bit alignment, which we can't guarantee. + `(define-vop (,vop-name) + (:args (x :scs (,complex-reg) :target r) + (y :scs (,complex-reg))) + (:results (r :scs (,complex-reg))) + (:arg-types ,c-type ,c-type) + (:result-types ,c-type) + (:policy :fast-safe) + (:note "inline packed arithmetic") + (:translate ,op) + (:temporary (:sc ,complex-reg) tmp) + (:generator ,cost + (generate movaps ,inst ,commutative)))))) + (packed-op sse2-mulpd mulpd double 1 t) + (packed-op sse2-mulps mulps double 1 t) + (packed-op sse2-divpd divpd double 1) + (packed-op sse2-divps divps double 1)) + +(defun sse2-mulpd (x y) + "Packed multiply of packed doubles in X and Y" + (declare (type (complex double-float) x y)) + (sse2-mulpd x y)) + +(defun sse2-mulps (x y) + "Packed multiply of packed singles in X and Y" + (declare (type (complex double-float) x y)) + (sse2-mulps x y)) + +(defun sse2-divpd (x y) + "Packed divide of packed doubles in X and Y" + (declare (type (complex double-float) x y)) + (sse2-divpd x y)) + +(defun sse2-divps (x y) + "Packed divide of packed singles in X and Y" + (declare (type (complex double-float) x y)) + (sse2-divps x y)) + +(defknown (%sse2-shufpd %sse2-shufps) ((complex double-float) (complex double-float) fixnum) + (complex double-float) + (movable foldable flushable)) + +(macrolet + ((generate (movinst opinst commutative) + `(cond + ((location= x r) + (inst ,opinst x y i)) + ((and ,commutative (location= y r)) + (inst ,opinst y x i)) + ((not (location= r y)) + (inst ,movinst r x) + (inst ,opinst r y i)) + (t + (inst ,movinst tmp x) + (inst ,opinst tmp y i) + (inst ,movinst r tmp)))) + (packed-op (op inst float-type cost &optional commutative) + (let* ((vop-name (symbolicate (symbol-name op) "/COMPLEX-" float-type "-FLOAT")) + (c-type (symbolicate "COMPLEX-" float-type "-FLOAT")) + (complex-reg (symbolicate "COMPLEX-" float-type "-REG"))) + ;; Note: It would probably improve things if we could use + ;; memory operands, but we can't because the instructions + ;; assumed 128-bit alignment, which we can't guarantee. + `(define-vop (,vop-name) + (:args (x :scs (,complex-reg) :target r) + (y :scs (,complex-reg))) + (:info i) + (:results (r :scs (,complex-reg))) + (:arg-types ,c-type ,c-type (:constant integer)) + (:result-types ,c-type) + (:policy :fast-safe) + (:note "inline packed arithmetic") + (:translate ,op) + (:temporary (:sc ,complex-reg) tmp) + (:generator ,cost + (generate movaps ,inst ,commutative)))))) + (packed-op %sse2-shufpd shufpd double 1) + (packed-op %sse2-shufps shufps double 1)) + +(declaim (inline sse2-shufpd sse2-shufps)) + +(defun sse2-shufpd (x y i) + "Shuffle packed doubles in X and Y according to I." + (declare (type (complex double-float) x y) + (type (unsigned-byte 2) i)) + (ecase i + (0 + (%sse2-shufpd x y 0)) + (1 + (%sse2-shufpd x y 1)) + (2 + (%sse2-shufpd x y 2)) + (3 + (%sse2-shufpd x y 3)))) + +(defun sse2-shufps (x y i) + "Shuffle packed singles in X and Y according to I." + (declare (type (complex double-float) x y) + (type (unsigned-byte 4) i)) + (ecase i + (0 + (%sse2-shufps x y 0)) + (1 + (%sse2-shufps x y 1)) + (2 + (%sse2-shufps x y 2)) + (3 + (%sse2-shufps x y 3)) + (4 + (%sse2-shufps x y 4)) + (5 + (%sse2-shufps x y 5)) + (6 + (%sse2-shufps x y 6)) + (7 + (%sse2-shufps x y 7)))) + +;; x is the high part and y is the low part. +(declaim (inline sse2-setpd sse2-getpd sse2-setps sse2-getps)) +(defun sse2-setpd (x y) + "Create a packed double with X in the high part and Y in the low part" + (declare (type double-float x y)) + (complex y x)) + +(defun sse2-getpd (pd) + "Extract the components of a packed double PD. Two values are + returned; the high part is the first value and the low part in the + second." + (declare (type (complex double-float) pd)) (values + (imagpart pd) (realpart pd))) + +;; x3 is the high part and x0 is the low. +(defun sse2-setps (x3 x2 x1 x0) + "Create a packed single with X3 in the highest part and X0 in the lowest" + (declare (single-float x3 x2 x1 x0)) + (flet ((pack-singles-to-double (hi lo) + (let ((hi-bits (single-float-bits hi)) + (lo-bits (single-float-bits lo))) + (make-double-float hi-bits (logand #xffffffff lo-bits))))) + (sse2-setpd (pack-singles-to-double x3 x2) + (pack-singles-to-double x1 x0)))) + +(defun sse2-getps (ps) + "Extract the components of a packed single PS. Four values are + returned. The first value is the highest part of the packed single + and the last value is the lowest part of the packed single." + (declare (type (complex double-float) ps)) + (flet ((unpack-double-to-singles (d) + (multiple-value-bind (hi lo) + (double-float-bits d) + (values (make-single-float hi) + (if (logbitp 31 lo) + (- (make-single-float (ldb (byte 31 0) lo))) + (make-single-float lo)))))) + (multiple-value-bind (x3 x2) + (unpack-double-to-singles (imagpart ps)) + (multiple-value-bind (x1 x0) + (unpack-double-to-singles (realpart ps)) + (values x3 x2 x1 x0))))) + +(provide "contrib-packed-sse2") commit 788a393ba3cc06a662da170b1eb9bc5d4863b176 Author: Raymond Toy <rtoy(a)google.com> Date: Tue Mar 27 16:19:03 2012 -0700 Oops. Long-standing bug that cmu-contribs was defined so it couldn't be loaded to get the other contribs. diff --git a/src/code/module.lisp b/src/code/module.lisp index 0f3f861..70ccba7 100644 --- a/src/code/module.lisp +++ b/src/code/module.lisp @@ -147,3 +147,10 @@ (defmodule "asdf" "modules:asdf/asdf") + +;; Allow user to specify "cmu-contribs" or :cmu-contribs. +(defmodule "cmu-contribs" + "modules:contrib") + +(defmodule :cmu-contribs + "modules:contrib") ----------------------------------------------------------------------- Summary of changes: src/code/module.lisp | 7 + src/contrib/contrib.lisp | 4 + src/contrib/packed-sse2/compile-packed-sse2.lisp | 2 + src/contrib/packed-sse2/packed-sse2.lisp | 210 ++++++++++++++++++++++ 4 files changed, 223 insertions(+), 0 deletions(-) create mode 100644 src/contrib/packed-sse2/compile-packed-sse2.lisp create mode 100644 src/contrib/packed-sse2/packed-sse2.lisp hooks/post-receive -- CMU Common Lisp

1 0