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

[cmucl-cvs] CMUCL commit: src/tools (build.sh)
by Raymond Toy 25 Sep '10

25 Sep '10

Date: Saturday, September 25, 2010 @ 14:03:16 Author: rtoy Path: /project/cmucl/cvsroot/src/tools Modified: build.sh Set LANG=C before compiling the C code. For some reason on my openSuSE 11.2 system, gcc messages are garbled unless I do this. (Perhaps, I'm missing some localization info? But I have the gcc localization package installed.) ----------+ build.sh | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) Index: src/tools/build.sh diff -u src/tools/build.sh:1.34 src/tools/build.sh:1.35 --- src/tools/build.sh:1.34 Wed Sep 15 20:43:33 2010 +++ src/tools/build.sh Sat Sep 25 14:03:15 2010 @@ -32,7 +32,7 @@ # # For more information see src/BUILDING. # -# $Header: /project/cmucl/cvsroot/src/tools/build.sh,v 1.34 2010-09-16 00:43:33 rtoy Exp $ +# $Header: /project/cmucl/cvsroot/src/tools/build.sh,v 1.35 2010-09-25 18:03:15 rtoy Exp $ # ENABLE2="yes" @@ -120,7 +120,11 @@ then $TOOLDIR/clean-target.sh $CLEAN_FLAGS $TARGET || { echo "Failed: $TOOLDIR/clean-target.sh"; exit 1; } time $BUILDWORLD $TARGET $OLDLISP $BOOT || { echo "Failed: $BUILDWORLD"; exit 1; } - $MAKE -C $TARGET/lisp $MAKE_TARGET || { echo "Failed: $MAKE -C $TARGET/lisp"; exit 1; } + # Set the LANG to C. For whatever reason, if I (rtoy) don't + # do this on my openSuSE system, any messages from gcc are + # basically garbled. This should be harmless on other + # systems. + LANG=C $MAKE -C $TARGET/lisp $MAKE_TARGET || { echo "Failed: $MAKE -C $TARGET/lisp"; exit 1; } if [ "$BUILD_WORLD2" = "yes" ]; then $BUILDWORLD $TARGET $OLDLISP $BOOT || { echo "Failed: $BUILDWORLD"; exit 1; }

1 0

[cmucl-cvs] CMUCL commit: cmucl-www/cmucl-www/www (index.html)
by Raymond Toy 24 Sep '10

24 Sep '10

Date: Friday, September 24, 2010 @ 17:47:19 Author: rtoy Path: /project/cmucl/cvsroot/cmucl-www/cmucl-www/www Modified: index.html Fix typo. ------------+ index.html | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) Index: cmucl-www/cmucl-www/www/index.html diff -u cmucl-www/cmucl-www/www/index.html:1.11 cmucl-www/cmucl-www/www/index.html:1.12 --- cmucl-www/cmucl-www/www/index.html:1.11 Tue Sep 7 11:04:34 2010 +++ cmucl-www/cmucl-www/www/index.html Fri Sep 24 17:47:19 2010 @@ -80,7 +80,7 @@ NaN. This matches what happens for x87. </li> <li> For SSE2 builds, <code>SIGCONTEXT-FLOAT-REGISTER</code> returned the wrong - value for single-floats. Easily noticead when tracing a function + value for single-floats. Easily noticed when tracing a function with single-float arguments. </li> <li> Trac issue #36: file-position broken for utf16 and utf32.

1 0

[cmucl-cvs] CMUCL commit: src/pcl/simple-streams/external-formats (crlf.lisp)
by Raymond Toy 24 Sep '10

24 Sep '10

Date: Friday, September 24, 2010 @ 17:45:33 Author: rtoy Path: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats Modified: crlf.lisp Add some declarations to get rid of compiler notes. -----------+ crlf.lisp | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) Index: src/pcl/simple-streams/external-formats/crlf.lisp diff -u src/pcl/simple-streams/external-formats/crlf.lisp:1.5 src/pcl/simple-streams/external-formats/crlf.lisp:1.6 --- src/pcl/simple-streams/external-formats/crlf.lisp:1.5 Mon Jul 12 10:42:11 2010 +++ src/pcl/simple-streams/external-formats/crlf.lisp Fri Sep 24 17:45:33 2010 @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/crlf.lisp,v 1.5 2010-07-12 14:42:11 rtoy Exp $") +(ext:file-comment "$Header: /project/cmucl/cvsroot/src/pcl/simple-streams/external-formats/crlf.lisp,v 1.6 2010-09-24 21:45:33 rtoy Exp $") (in-package "STREAM") (intl:textdomain "cmucl") @@ -17,9 +17,11 @@ (input (state input unput tmp1 tmp2 tmp3 tmp4) `(multiple-value-bind (,tmp1 ,tmp2) ,input + (declare (type kernel:index ,tmp2)) (when (= ,tmp1 (char-code #\return)) (multiple-value-bind (,tmp3 ,tmp4) ,input + (declare (type kernel:index ,tmp4)) ;; @@ tmp3 may be NIL, if file ends in LF (if (= ,tmp3 (char-code #\newline)) (setq ,tmp1 ,tmp3

1 0

[cmucl-cvs] CMUCL commit: src (3 files)
by Raymond Toy 24 Sep '10

24 Sep '10

Date: Friday, September 24, 2010 @ 08:12:05 Author: rtoy Path: /project/cmucl/cvsroot/src Modified: compiler/fndb.lisp compiler/main.lisp general-info/release-20c.txt Add :decoding-error arg to compile-file to specify how decoding errors should be handled. compiler/main.lisp: o Add DECODING-ERROR slot to SOURCE-INFO structure. o MAKE-FILE-SOURCE-INFO requires a decoding error argument so the SOURCE-INFO structure can be properly initialized. o Add :DECODING-ERROR keyword arg to COMPILE-FILE to specify how decoding errors are handled. Default is T, which means to signal an error. compiler/fndb.lisp: o Tell compiler about the new parameter. general-info/release-20c.txt: o Document change. ------------------------------+ compiler/fndb.lisp | 3 ++- compiler/main.lisp | 29 ++++++++++++++++++++++------- general-info/release-20c.txt | 11 ++++++++++- 3 files changed, 34 insertions(+), 9 deletions(-) Index: src/compiler/fndb.lisp diff -u src/compiler/fndb.lisp:1.146 src/compiler/fndb.lisp:1.147 --- src/compiler/fndb.lisp:1.146 Mon Jul 26 13:20:26 2010 +++ src/compiler/fndb.lisp Fri Sep 24 08:12:05 2010 @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /project/cmucl/cvsroot/src/compiler/fndb.lisp,v 1.146 2010-07-26 17:20:26 rtoy Exp $") + "$Header: /project/cmucl/cvsroot/src/compiler/fndb.lisp,v 1.147 2010-09-24 12:12:05 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1152,6 +1152,7 @@ (:entry-points list) (:byte-compile (member t nil :maybe)) (:external-format symbol) + (:decoding-error (or null symbol function)) (:xref t)) (values (or pathname null) boolean boolean)) Index: src/compiler/main.lisp diff -u src/compiler/main.lisp:1.158 src/compiler/main.lisp:1.159 --- src/compiler/main.lisp:1.158 Wed Sep 15 11:47:29 2010 +++ src/compiler/main.lisp Fri Sep 24 08:12:05 2010 @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /project/cmucl/cvsroot/src/compiler/main.lisp,v 1.158 2010-09-15 15:47:29 rtoy Exp $") + "$Header: /project/cmucl/cvsroot/src/compiler/main.lisp,v 1.159 2010-09-24 12:12:05 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -718,14 +718,19 @@ ;; ;; External format to use for the stream if the stream hasn't been opened #+unicode - (external-format :default)) + (external-format :default) + ;; + ;; How to handle decoding errors when reading the source file. + ;; Default is T to signal an error. + #+unicode + (decoding-error t)) ;;; Make-File-Source-Info -- Internal ;;; ;;; Given a list of pathnames, return a Source-Info structure. ;;; -(defun make-file-source-info (files external-format) +(defun make-file-source-info (files external-format decoding-error) (declare (list files)) (let ((file-info (mapcar #'(lambda (x) @@ -739,7 +744,9 @@ :current-file file-info #+unicode :external-format #+unicode (stream::ef-name - (stream::find-external-format external-format))))) + (stream::find-external-format external-format)) + #+unicode :decoding-error + #+unicode decoding-error))) ;;; MAKE-LISP-SOURCE-INFO -- Interface @@ -880,7 +887,9 @@ (setf (source-info-stream info) (open name :direction :input #+unicode :external-format - #+unicode (source-info-external-format info))))))) + #+unicode (source-info-external-format info) + #+unicode :decoding-error + #+unicode (source-info-decoding-error info))))))) ;;; CLOSE-SOURCE-INFO -- Internal ;;; @@ -1744,6 +1753,7 @@ (error-output t) (load nil) (external-format :default) + (decoding-error t) ((:verbose *compile-verbose*) *compile-verbose*) ((:print *compile-print*) *compile-print*) ((:progress *compile-progress*) *compile-progress*) @@ -1796,7 +1806,12 @@ If non-NIL, enable recording of cross-reference information. The default is the value of C:*RECORD-XREF-INFO* :External-Format - The external format to use when opening the source file" + The external format to use when opening the source file + :Decoding-Error + How to handle decoding errors in the external format when reading the + source file. Default (T) is to signal an error. Nil means silently + continue, replacing the invalid sequence with a suitable replacment + character." (let* ((fasl-file nil) (error-file-stream nil) (output-file-pathname nil) @@ -1805,7 +1820,7 @@ (compile-won nil) (error-severity nil) (source (verify-source-files source)) - (source-info (make-file-source-info source external-format)) + (source-info (make-file-source-info source external-format decoding-error)) (default (pathname (first source)))) (unwind-protect (progn Index: src/general-info/release-20c.txt diff -u src/general-info/release-20c.txt:1.3 src/general-info/release-20c.txt:1.4 --- src/general-info/release-20c.txt:1.3 Fri Sep 17 12:01:05 2010 +++ src/general-info/release-20c.txt Fri Sep 24 08:12:05 2010 @@ -20,11 +20,20 @@ * Known issues: - * Feature enhancements: + * Feature enhancements - Update to Unicode 5.2.0. - Add support for character name completion. This can be used by Slime to do character name completion. + * Changes + - COMPILE-FILE now accepts a :DECODING-ERROR argument that + indicates how to handle decoding errors when reading the file. + It has the same meaning and effect as the :DECODING-ERROR + argument to OPEN. This defaults to T here so that decoding + errors are signaled on invalid sequences instead of silently + replacing the bad sequence with some kind of replacement + character. + * ANSI compliance fixes: * Bugfixes:

1 0

[cmucl-cvs] CMUCL commit: src/lisp (save.c)
by Raymond Toy 24 Sep '10

24 Sep '10

Date: Friday, September 24, 2010 @ 00:08:39 Author: rtoy Path: /project/cmucl/cvsroot/src/lisp Modified: save.c Include libgen.h on Darwin/x86 to get rid of a compiler warning about dirname being undefined. --------+ save.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) Index: src/lisp/save.c diff -u src/lisp/save.c:1.28 src/lisp/save.c:1.29 --- src/lisp/save.c:1.28 Mon Aug 2 17:45:36 2010 +++ src/lisp/save.c Fri Sep 24 00:08:39 2010 @@ -1,6 +1,6 @@ /* - $Header: /project/cmucl/cvsroot/src/lisp/save.c,v 1.28 2010-08-02 21:45:36 rtoy Exp $ + $Header: /project/cmucl/cvsroot/src/lisp/save.c,v 1.29 2010-09-24 04:08:39 rtoy Exp $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -29,7 +29,7 @@ #ifdef FEATURE_EXECUTABLE #include "elf.h" -#if !defined(DARWIN) +#if !(defined(DARWIN) && defined(__ppc__)) #include <libgen.h> #endif #endif

1 0

[cmucl-cvs] CMUCL commit: RELEASE-20B-BRANCH src/code (fd-stream-extfmt.lisp)
by Raymond Toy 24 Sep '10

24 Sep '10

Date: Thursday, September 23, 2010 @ 20:51:03 Author: rtoy Path: /project/cmucl/cvsroot/src/code Tag: RELEASE-20B-BRANCH Modified: fd-stream-extfmt.lisp Merge change from HEAD that fixes the case of changing the external format from :iso8859-1 to something else. -----------------------+ fd-stream-extfmt.lisp | 150 ++++++++++++++++++++++++++++-------------------- 1 file changed, 90 insertions(+), 60 deletions(-) Index: src/code/fd-stream-extfmt.lisp diff -u src/code/fd-stream-extfmt.lisp:1.10.2.1 src/code/fd-stream-extfmt.lisp:1.10.2.2 --- src/code/fd-stream-extfmt.lisp:1.10.2.1 Mon Sep 6 11:41:30 2010 +++ src/code/fd-stream-extfmt.lisp Thu Sep 23 20:51:03 2010 @@ -5,7 +5,7 @@ ;;; domain. ;;; (ext:file-comment - "$Header: /project/cmucl/cvsroot/src/code/fd-stream-extfmt.lisp,v 1.10.2.1 2010-09-06 15:41:30 rtoy Exp $") + "$Header: /project/cmucl/cvsroot/src/code/fd-stream-extfmt.lisp,v 1.10.2.2 2010-09-24 00:51:03 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -76,65 +76,95 @@ (setf (fd-stream-out stream) (ef-cout extfmt) ;;@@ (fd-stream-sout stream) (ef-sout extfmt) )) - ;; FIXME: We currently don't handle the case of changing from - ;; ISO8859-1 to something else. This is because ISO8859-1 doesn't - ;; use the string-buffer, so when we switch to another external - ;; format that does, we need to set up the string-buffer - ;; appropriately. - (when (and lisp::*enable-stream-buffer-p* updatep - (lisp-stream-string-buffer stream)) - ;; We want to reconvert any octets that haven't been converted - ;; yet. So, we need to figure out which octet to start with. - ;; This is done by converting (the previously converted) octets - ;; until we've converted the right number of characters. - (let ((ibuf (lisp-stream-in-buffer stream)) - (sindex (lisp-stream-string-index stream)) - (index 0) - (state (fd-stream-saved-oc-state stream))) - ;; Reconvert all the octets we've already converted and read. - ;; We don't know how many octets that is, but do know how many - ;; characters there are. - (multiple-value-bind (s pos count new-state) - (octets-to-string ibuf - :start 0 - :external-format old-format - :string (make-string (1- sindex)) - :state state - :error (fd-stream-octets-to-char-error stream)) - (declare (ignore s pos)) - (setf state new-state) - (setf index count)) - ;; We now know the last octet that was used. Now convert the - ;; rest of the octets using the new format. The new - ;; characters are placed in the string buffer at the point - ;; just after the last character that we've already read. - (multiple-value-bind (s pos count new-state) - (octets-to-string ibuf - :start index - :end (fd-stream-in-length stream) - :external-format (fd-stream-external-format stream) - :string (lisp-stream-string-buffer stream) - :s-start sindex - :state state - :error (fd-stream-octets-to-char-error stream)) - (cond ((eq (fd-stream-external-format stream) :iso8859-1) - ;; ISO8859-1 doesn't use the string-buffer, so we - ;; need to copy the string to the in-buffer and then - ;; set the string-buffer to nil to indicate we're not - ;; using the string buffer anymore. - (let ((index (- in-buffer-length count))) - (dotimes (k count) - (setf (aref ibuf (+ k index)) - (char-code (aref s (+ k sindex))))) - (setf (lisp-stream-in-index stream) index) - (setf (lisp-stream-string-buffer stream) nil) - (setf (lisp-stream-string-buffer-len stream) 0) - (setf (lisp-stream-string-index stream) 0))) - (t - (setf (lisp-stream-string-index stream) sindex) - (setf (lisp-stream-string-buffer-len stream) pos) - (setf (lisp-stream-in-index stream) (+ index count)) - (setf (fd-stream-oc-state stream) new-state)))))) + ;; The following handles the case of setting the external format + ;; for input streams where we need to handle the various buffering + ;; strategies. + ;; + (cond + ((eq old-format (fd-stream-external-format stream)) + ;; Nothing to do if the new and old formats are the same. + ) + ((and lisp::*enable-stream-buffer-p* updatep + (lisp-stream-string-buffer stream)) + ;; We want to reconvert any octets that haven't been converted + ;; yet. So, we need to figure out which octet to start with. + ;; This is done by converting (the previously converted) octets + ;; until we've converted the right number of characters. Or, + ;; since we have the octet-count, just sum up them up to figure + ;; out how many octets we've already consumed. + (let* ((ibuf (lisp-stream-in-buffer stream)) + (sindex (lisp-stream-string-index stream)) + (octet-count (fd-stream-octet-count stream)) + (oc (make-array in-buffer-length :element-type '(unsigned-byte 8))) + (index (loop for k of-type fixnum from 0 below (1- sindex) + summing (aref octet-count k)))) + ;; We now know the last octet that was used. Now convert the + ;; rest of the octets using the new format. The new + ;; characters are placed in the string buffer at the point + ;; just after the last character that we've already read. + (multiple-value-bind (s pos count new-state) + (stream::octets-to-string-counted ibuf + oc + :start index + :end (fd-stream-in-length stream) + :external-format (fd-stream-external-format stream) + :string (lisp-stream-string-buffer stream) + :s-start sindex + :error (fd-stream-octets-to-char-error stream)) + (replace octet-count oc :start1 index :end2 pos) + (cond ((eq (fd-stream-external-format stream) :iso8859-1) + ;; ISO8859-1 doesn't use the string-buffer, so we + ;; need to copy the string to the in-buffer and then + ;; set the string-buffer to nil to indicate we're not + ;; using the string buffer anymore. + (let ((index (- in-buffer-length count))) + (dotimes (k count) + (setf (aref ibuf (+ k index)) + (char-code (aref s (+ k sindex))))) + (setf (lisp-stream-in-index stream) index) + (setf (lisp-stream-string-buffer stream) nil) + (setf (lisp-stream-string-buffer-len stream) 0) + (setf (lisp-stream-string-index stream) 0))) + (t + (setf (lisp-stream-string-index stream) sindex) + (setf (lisp-stream-string-buffer-len stream) pos) + (setf (lisp-stream-in-index stream) (+ index count)) + (setf (fd-stream-oc-state stream) new-state)))))) + ((and updatep (lisp-stream-in-buffer stream)) + ;; This means the external format was ISO8859-1 and we're + ;; switching to something else. If so, we need to convert all + ;; the octets that haven't been processed yet and place them in + ;; the string buffer. We also need to adjust the in-buffer to + ;; put those octets in the expected place at the beginning of + ;; in-buffer. + (let ((index (lisp-stream-in-index stream)) + (ibuf (lisp-stream-in-buffer stream))) + (setf (lisp-stream-string-buffer stream) + (make-string (1+ in-buffer-length))) + (setf (lisp-stream-string-index stream) 1) + ;; Set the unread char to be the last read octet. + (setf (aref (lisp-stream-string-buffer stream) 0) + (code-char (aref ibuf (1- index)))) + + (let ((oc (or (fd-stream-octet-count stream) + (setf (fd-stream-octet-count stream) + (make-array in-buffer-length :element-type '(unsigned-byte 8)))))) + (multiple-value-bind (s pos count new-state) + (stream::octets-to-string-counted ibuf + oc + :start index + :external-format (fd-stream-external-format stream) + :string (lisp-stream-string-buffer stream) + :s-start 1 + :error (fd-stream-octets-to-char-error stream)) + (declare (ignore s)) + (setf (lisp-stream-string-buffer-len stream) pos) + (setf (fd-stream-oc-state stream) new-state) + ;; Move the octets from the end of the in-buffer to the + ;; beginning. Set the index to the number of octets we've + ;; processed. + (replace ibuf ibuf :start2 index) + (setf (lisp-stream-in-index stream) count)))))) extfmt))

1 0

[cmucl-cvs] CMUCL commit: src/code (fd-stream-extfmt.lisp)
by Raymond Toy 24 Sep '10

24 Sep '10

Date: Thursday, September 23, 2010 @ 20:36:03 Author: rtoy Path: /project/cmucl/cvsroot/src/code Modified: fd-stream-extfmt.lisp o When changing external format from :iso8859-1 to another format, we need to call octets-to-string-counted to setup the octet count array correctly. o Minor cleanup of code. -----------------------+ fd-stream-extfmt.lisp | 105 +++++++++++++++++++++++++----------------------- 1 file changed, 55 insertions(+), 50 deletions(-) Index: src/code/fd-stream-extfmt.lisp diff -u src/code/fd-stream-extfmt.lisp:1.12 src/code/fd-stream-extfmt.lisp:1.13 --- src/code/fd-stream-extfmt.lisp:1.12 Tue Sep 7 23:04:54 2010 +++ src/code/fd-stream-extfmt.lisp Thu Sep 23 20:36:03 2010 @@ -5,7 +5,7 @@ ;;; domain. ;;; (ext:file-comment - "$Header: /project/cmucl/cvsroot/src/code/fd-stream-extfmt.lisp,v 1.12 2010-09-08 03:04:54 rtoy Exp $") + "$Header: /project/cmucl/cvsroot/src/code/fd-stream-extfmt.lisp,v 1.13 2010-09-24 00:36:03 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -92,44 +92,44 @@ ;; until we've converted the right number of characters. Or, ;; since we have the octet-count, just sum up them up to figure ;; out how many octets we've already consumed. - (let ((ibuf (lisp-stream-in-buffer stream)) - (sindex (lisp-stream-string-index stream)) - (index 0) - (octet-count (fd-stream-octet-count stream))) - (setf index (loop for k of-type fixnum from 0 below (1- sindex) summing (aref octet-count k))) + (let* ((ibuf (lisp-stream-in-buffer stream)) + (sindex (lisp-stream-string-index stream)) + (octet-count (fd-stream-octet-count stream)) + (oc (make-array in-buffer-length :element-type '(unsigned-byte 8))) + (index (loop for k of-type fixnum from 0 below (1- sindex) + summing (aref octet-count k)))) ;; We now know the last octet that was used. Now convert the ;; rest of the octets using the new format. The new ;; characters are placed in the string buffer at the point ;; just after the last character that we've already read. - (let ((oc (make-array in-buffer-length :element-type '(unsigned-byte 8)))) - (multiple-value-bind (s pos count new-state) - (stream::octets-to-string-counted ibuf - oc - :start index - :end (fd-stream-in-length stream) - :external-format (fd-stream-external-format stream) - :string (lisp-stream-string-buffer stream) - :s-start sindex - :error (fd-stream-octets-to-char-error stream)) - (replace octet-count oc :start1 index :end2 pos) - (cond ((eq (fd-stream-external-format stream) :iso8859-1) - ;; ISO8859-1 doesn't use the string-buffer, so we - ;; need to copy the string to the in-buffer and then - ;; set the string-buffer to nil to indicate we're not - ;; using the string buffer anymore. - (let ((index (- in-buffer-length count))) - (dotimes (k count) - (setf (aref ibuf (+ k index)) - (char-code (aref s (+ k sindex))))) - (setf (lisp-stream-in-index stream) index) - (setf (lisp-stream-string-buffer stream) nil) - (setf (lisp-stream-string-buffer-len stream) 0) - (setf (lisp-stream-string-index stream) 0))) - (t - (setf (lisp-stream-string-index stream) sindex) - (setf (lisp-stream-string-buffer-len stream) pos) - (setf (lisp-stream-in-index stream) (+ index count)) - (setf (fd-stream-oc-state stream) new-state))))))) + (multiple-value-bind (s pos count new-state) + (stream::octets-to-string-counted ibuf + oc + :start index + :end (fd-stream-in-length stream) + :external-format (fd-stream-external-format stream) + :string (lisp-stream-string-buffer stream) + :s-start sindex + :error (fd-stream-octets-to-char-error stream)) + (replace octet-count oc :start1 index :end2 pos) + (cond ((eq (fd-stream-external-format stream) :iso8859-1) + ;; ISO8859-1 doesn't use the string-buffer, so we + ;; need to copy the string to the in-buffer and then + ;; set the string-buffer to nil to indicate we're not + ;; using the string buffer anymore. + (let ((index (- in-buffer-length count))) + (dotimes (k count) + (setf (aref ibuf (+ k index)) + (char-code (aref s (+ k sindex))))) + (setf (lisp-stream-in-index stream) index) + (setf (lisp-stream-string-buffer stream) nil) + (setf (lisp-stream-string-buffer-len stream) 0) + (setf (lisp-stream-string-index stream) 0))) + (t + (setf (lisp-stream-string-index stream) sindex) + (setf (lisp-stream-string-buffer-len stream) pos) + (setf (lisp-stream-in-index stream) (+ index count)) + (setf (fd-stream-oc-state stream) new-state)))))) ((and updatep (lisp-stream-in-buffer stream)) ;; This means the external format was ISO8859-1 and we're ;; switching to something else. If so, we need to convert all @@ -145,21 +145,26 @@ ;; Set the unread char to be the last read octet. (setf (aref (lisp-stream-string-buffer stream) 0) (code-char (aref ibuf (1- index)))) - (multiple-value-bind (s pos count new-state) - (octets-to-string ibuf - :start index - :external-format (fd-stream-external-format stream) - :string (lisp-stream-string-buffer stream) - :s-start 1 - :error (fd-stream-octets-to-char-error stream)) - (declare (ignore s)) - (setf (lisp-stream-string-buffer-len stream) pos) - (setf (fd-stream-oc-state stream) new-state) - ;; Move the octets from the end of the in-buffer to the - ;; beginning. Set the index to the number of octets we've - ;; processed. - (replace ibuf ibuf :start2 index) - (setf (lisp-stream-in-index stream) count))))) + + (let ((oc (or (fd-stream-octet-count stream) + (setf (fd-stream-octet-count stream) + (make-array in-buffer-length :element-type '(unsigned-byte 8)))))) + (multiple-value-bind (s pos count new-state) + (stream::octets-to-string-counted ibuf + oc + :start index + :external-format (fd-stream-external-format stream) + :string (lisp-stream-string-buffer stream) + :s-start 1 + :error (fd-stream-octets-to-char-error stream)) + (declare (ignore s)) + (setf (lisp-stream-string-buffer-len stream) pos) + (setf (fd-stream-oc-state stream) new-state) + ;; Move the octets from the end of the in-buffer to the + ;; beginning. Set the index to the number of octets we've + ;; processed. + (replace ibuf ibuf :start2 index) + (setf (lisp-stream-in-index stream) count)))))) extfmt))

1 0

[cmucl-cvs] CMUCL commit: src (2 files)
by Raymond Toy 21 Sep '10

21 Sep '10

Date: Monday, September 20, 2010 @ 22:30:54 Author: rtoy Path: /project/cmucl/cvsroot/src Modified: docs/cmu-user/cmu-user.tex general-info/release-20b.txt Merge changes from 20b branch. ------------------------------+ docs/cmu-user/cmu-user.tex | 2 +- general-info/release-20b.txt | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) Index: src/docs/cmu-user/cmu-user.tex diff -u src/docs/cmu-user/cmu-user.tex:1.43 src/docs/cmu-user/cmu-user.tex:1.44 --- src/docs/cmu-user/cmu-user.tex:1.43 Sun Aug 1 12:18:01 2010 +++ src/docs/cmu-user/cmu-user.tex Mon Sep 20 22:30:54 2010 @@ -47,7 +47,7 @@ \newcommand{\keywords}{lisp, Common Lisp, manual, compiler, programming language implementation, programming environment} -\date{August 2010 \\ Snapshot 2010-08} +\date{October 2010 \\ 20b} \begin{document} Index: src/general-info/release-20b.txt diff -u src/general-info/release-20b.txt:1.49 src/general-info/release-20b.txt:1.50 --- src/general-info/release-20b.txt:1.49 Sun Sep 19 00:10:52 2010 +++ src/general-info/release-20b.txt Mon Sep 20 22:30:54 2010 @@ -2,7 +2,7 @@ The CMUCL project is pleased to announce the release of CMUCL 20b. This is a major release which contains numerous enhancements and -bug fixes from the 19f release. +bug fixes from the 20a release. CMUCL is a free, high performance implementation of the Common Lisp programming language which runs on most major Unix platforms. It

1 0

[cmucl-cvs] CMUCL commit: src/code (unidata.lisp)
by Raymond Toy 21 Sep '10

21 Sep '10

Date: Monday, September 20, 2010 @ 20:57:29 Author: rtoy Path: /project/cmucl/cvsroot/src/code Modified: unidata.lisp When there's more than one possible completion, we need to keep the original completions along with the extensions. --------------+ unidata.lisp | 28 ++++++++++++++++------------ 1 file changed, 16 insertions(+), 12 deletions(-) Index: src/code/unidata.lisp diff -u src/code/unidata.lisp:1.21 src/code/unidata.lisp:1.22 --- src/code/unidata.lisp:1.21 Sun Sep 19 21:17:14 2010 +++ src/code/unidata.lisp Mon Sep 20 20:57:29 2010 @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.21 2010-09-20 01:17:14 rtoy Exp $") +(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.22 2010-09-21 00:57:29 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -18,7 +18,7 @@ (defconstant +unidata-path+ #p"ext-formats:unidata.bin") -(defvar *unidata-version* "$Revision: 1.21 $") +(defvar *unidata-version* "$Revision: 1.22 $") (defstruct unidata range @@ -1189,7 +1189,9 @@ (when n (setq completep (> (aref (dictionary-codev dict) n) -1))) #+(or debug-uc) - (format t "n,p,complete = ~S ~S ~S~%" n p completep) + (progn + (format t "n,p,complete = ~S ~S ~S~%" n p completep) + (when n (format t "match = ~S~%" (subseq prefix 0 p)))) (cond ((not p) (values (%str prefix) nil nil)) ((= p (length prefix)) @@ -1246,15 +1248,17 @@ (t ;; There's more than one possible completion. ;; Try to extend each of those completions one - ;; more step. - (let* ((p (mapcan #'(lambda (ex) - (let ((next (node-next (cdr ex) dict))) - (if next - (mapcar #'(lambda (n) - (concatenate 'string (car ex) (car n))) - (node-next (cdr ex) dict)) - (list (car ex))))) - x)) + ;; more step, but we still want to keep the + ;; original completions. + (let* ((p (append (mapcar #'car x) + (mapcan #'(lambda (ex) + (let ((next (node-next (cdr ex) dict))) + (if next + (mapcar #'(lambda (n) + (concatenate 'string (car ex) (car n))) + (node-next (cdr ex) dict)) + (list (car ex))))) + x))) (q (%mip p))) (setq prefix (concatenate 'string prefix q))

1 0

[cmucl-cvs] CMUCL commit: RELEASE-20B-BRANCH src/general-info (release-20b.txt)
by Raymond Toy 21 Sep '10

21 Sep '10

Date: Monday, September 20, 2010 @ 20:19:21 Author: rtoy Path: /project/cmucl/cvsroot/src/general-info Tag: RELEASE-20B-BRANCH Modified: release-20b.txt Fix typo: 19f->20a. -----------------+ release-20b.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) Index: src/general-info/release-20b.txt diff -u src/general-info/release-20b.txt:1.41.2.7 src/general-info/release-20b.txt:1.41.2.8 --- src/general-info/release-20b.txt:1.41.2.7 Sat Sep 18 23:46:02 2010 +++ src/general-info/release-20b.txt Mon Sep 20 20:19:21 2010 @@ -2,7 +2,7 @@ The CMUCL project is pleased to announce the release of CMUCL 20b. This is a major release which contains numerous enhancements and -bug fixes from the 19f release. +bug fixes from the 20a release. CMUCL is a free, high performance implementation of the Common Lisp programming language which runs on most major Unix platforms. It

1 0

[cmucl-cvs] CMUCL commit: RELEASE-20B-BRANCH src/docs/cmu-user (cmu-user.tex)
by Raymond Toy 21 Sep '10

21 Sep '10

Date: Monday, September 20, 2010 @ 20:17:36 Author: rtoy Path: /project/cmucl/cvsroot/src/docs/cmu-user Tag: RELEASE-20B-BRANCH Modified: cmu-user.tex Set date for 20b. --------------+ cmu-user.tex | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) Index: src/docs/cmu-user/cmu-user.tex diff -u src/docs/cmu-user/cmu-user.tex:1.43 src/docs/cmu-user/cmu-user.tex:1.43.2.1 --- src/docs/cmu-user/cmu-user.tex:1.43 Sun Aug 1 12:18:01 2010 +++ src/docs/cmu-user/cmu-user.tex Mon Sep 20 20:17:36 2010 @@ -47,7 +47,7 @@ \newcommand{\keywords}{lisp, Common Lisp, manual, compiler, programming language implementation, programming environment} -\date{August 2010 \\ Snapshot 2010-08} +\date{October 2010 \\ 20b} \begin{document}

1 0

[cmucl-cvs] CMUCL commit: RELEASE-20B-BRANCH src/i18n/locale (3 files)
by Raymond Toy 21 Sep '10

21 Sep '10

Date: Monday, September 20, 2010 @ 20:12:16 Author: rtoy Path: /project/cmucl/cvsroot/src/i18n/locale Tag: RELEASE-20B-BRANCH Modified: cmucl-x87.pot en(a)piglatin/LC_MESSAGES/cmucl-x87.po ko/LC_MESSAGES/cmucl-x87.po Regenerate from current sources. --------------------------------------+ cmucl-x87.pot | 184 ++++++++++++++++++++++++++++++++- en(a)piglatin/LC_MESSAGES/cmucl-x87.po | 184 ++++++++++++++++++++++++++++++++- ko/LC_MESSAGES/cmucl-x87.po | 184 ++++++++++++++++++++++++++++++++- 3 files changed, 549 insertions(+), 3 deletions(-) Index: src/i18n/locale/cmucl-x87.pot diff -u src/i18n/locale/cmucl-x87.pot:1.3 src/i18n/locale/cmucl-x87.pot:1.3.4.1 --- src/i18n/locale/cmucl-x87.pot:1.3 Tue Apr 20 14:05:43 2010 +++ src/i18n/locale/cmucl-x87.pot Mon Sep 20 20:12:16 2010 @@ -15,8 +15,190 @@ "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" +#: src/compiler/x86/float.lisp +msgid "Ignoring bogus i387 Constant ~a" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "float move" +msgstr "" + #: src/compiler/x86/x87-array.lisp src/compiler/x86/x87-c-call.lisp -#: src/compiler/x86/x87-sap.lisp +#: src/compiler/x86/x87-sap.lisp src/compiler/x86/float.lisp msgid "Unknown SC to SC-Case for ~S:~% ~S" msgstr "" +#: src/compiler/x86/float.lisp +msgid "complex float move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "float to pointer coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "" +"Load TN allocated, but no move function?~@\n" +" VM definition inconsistent, recompile and try again." +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "pointer to float coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float to pointer coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex double-double float to pointer coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "pointer to complex float coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "float argument move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float argument move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex double-double-float argument move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline float arithmetic" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline float comparison" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline float coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline float truncate" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline NPX function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline tan function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline sin/cos function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline exp function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline expm1 function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline log function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline log10 function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline pow function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline scalbn function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline scalb function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline log1p function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline log1p with limited x range function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline logb function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline atan function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline atan2 function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline complex single-float creation" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline complex double-float creation" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline complex long-float creation" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float realpart" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float imagpart" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline dummy FP register bias" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double-double float move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double double float to pointer coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "pointer to double-double-float coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double double-float argument move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline double-double-float creation" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double-double high part" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double-double low part" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline complex double-double-float creation" +msgstr "" + Index: src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl-x87.po diff -u src/i18n/locale/en@piglatin/LC_MESSAGES/cmucl-x87.po:1.4.4.2 src/i18n/locale/en@piglatin/LC_MESSAGES/cmucl-x87.po:1.4.4.3 --- src/i18n/locale/en@piglatin/LC_MESSAGES/cmucl-x87.po:1.4.4.2 Wed Sep 15 12:16:44 2010 +++ src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl-x87.po Mon Sep 20 20:12:16 2010 @@ -16,7 +16,189 @@ "Language: Pig Latin\n" "Plural-Forms: nplurals=2; plural=(n != 1);\n" +#: src/compiler/x86/float.lisp +msgid "Ignoring bogus i387 Constant ~a" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "float move" +msgstr "" + #: src/compiler/x86/x87-array.lisp src/compiler/x86/x87-c-call.lisp -#: src/compiler/x86/x87-sap.lisp +#: src/compiler/x86/x87-sap.lisp src/compiler/x86/float.lisp msgid "Unknown SC to SC-Case for ~S:~% ~S" msgstr "Unknownway SC otay SC-Asecay orfay ~S:~% ~S" + +#: src/compiler/x86/float.lisp +msgid "complex float move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "float to pointer coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "" +"Load TN allocated, but no move function?~@\n" +"\t VM definition inconsistent, recompile and try again." +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "pointer to float coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float to pointer coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex double-double float to pointer coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "pointer to complex float coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "float argument move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float argument move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex double-double-float argument move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline float arithmetic" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline float comparison" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline float coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline float truncate" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline NPX function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline tan function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline sin/cos function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline exp function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline expm1 function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline log function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline log10 function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline pow function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline scalbn function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline scalb function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline log1p function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline log1p with limited x range function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline logb function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline atan function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline atan2 function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline complex single-float creation" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline complex double-float creation" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline complex long-float creation" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float realpart" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float imagpart" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline dummy FP register bias" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double-double float move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double double float to pointer coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "pointer to double-double-float coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double double-float argument move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline double-double-float creation" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double-double high part" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double-double low part" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline complex double-double-float creation" +msgstr "" Index: src/i18n/locale/ko/LC_MESSAGES/cmucl-x87.po diff -u src/i18n/locale/ko/LC_MESSAGES/cmucl-x87.po:1.3 src/i18n/locale/ko/LC_MESSAGES/cmucl-x87.po:1.3.4.1 --- src/i18n/locale/ko/LC_MESSAGES/cmucl-x87.po:1.3 Tue Apr 20 14:05:43 2010 +++ src/i18n/locale/ko/LC_MESSAGES/cmucl-x87.po Mon Sep 20 20:12:16 2010 @@ -14,7 +14,189 @@ "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" +#: src/compiler/x86/float.lisp +msgid "Ignoring bogus i387 Constant ~a" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "float move" +msgstr "" + #: src/compiler/x86/x87-array.lisp src/compiler/x86/x87-c-call.lisp -#: src/compiler/x86/x87-sap.lisp +#: src/compiler/x86/x87-sap.lisp src/compiler/x86/float.lisp msgid "Unknown SC to SC-Case for ~S:~% ~S" msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "float to pointer coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "" +"Load TN allocated, but no move function?~@\n" +"\t VM definition inconsistent, recompile and try again." +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "pointer to float coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float to pointer coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex double-double float to pointer coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "pointer to complex float coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "float argument move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float argument move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex double-double-float argument move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline float arithmetic" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline float comparison" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline float coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline float truncate" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline NPX function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline tan function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline sin/cos function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline exp function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline expm1 function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline log function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline log10 function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline pow function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline scalbn function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline scalb function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline log1p function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline log1p with limited x range function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline logb function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline atan function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline atan2 function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline complex single-float creation" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline complex double-float creation" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline complex long-float creation" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float realpart" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float imagpart" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline dummy FP register bias" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double-double float move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double double float to pointer coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "pointer to double-double-float coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double double-float argument move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline double-double-float creation" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double-double high part" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double-double low part" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline complex double-double-float creation" +msgstr ""

1 0

[cmucl-cvs] CMUCL commit: RELEASE-20B-BRANCH src/compiler/x86 (float.lisp)
by Raymond Toy 21 Sep '10

21 Sep '10

Date: Monday, September 20, 2010 @ 20:11:32 Author: rtoy Path: /project/cmucl/cvsroot/src/compiler/x86 Tag: RELEASE-20B-BRANCH Modified: float.lisp Text domain should be cmucl-x87, not cmucl-x86-vm. ------------+ float.lisp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) Index: src/compiler/x86/float.lisp diff -u src/compiler/x86/float.lisp:1.60 src/compiler/x86/float.lisp:1.60.4.1 --- src/compiler/x86/float.lisp:1.60 Tue Apr 20 13:57:47 2010 +++ src/compiler/x86/float.lisp Mon Sep 20 20:11:32 2010 @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group(a)cs.cmu.edu. ;;; (ext:file-comment - "$Header: /project/cmucl/cvsroot/src/compiler/x86/float.lisp,v 1.60 2010-04-20 17:57:47 rtoy Exp $") + "$Header: /project/cmucl/cvsroot/src/compiler/x86/float.lisp,v 1.60.4.1 2010-09-21 00:11:32 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -22,7 +22,7 @@ ;;; (in-package :x86) -(intl:textdomain "cmucl-x86-vm") +(intl:textdomain "cmucl-x87")

1 0

[cmucl-cvs] CMUCL commit: src/code (string.lisp)
by Raymond Toy 20 Sep '10

20 Sep '10

Date: Monday, September 20, 2010 @ 19:01:15 Author: rtoy Path: /project/cmucl/cvsroot/src/code Modified: string.lisp o Inhibit warnings from SURROGATEP; I'm tired seeing the code deletion notes now. o Tell the compiler what type the first return value of CODEPOINT is. Apparently, the compiler can't figure that out itself. -------------+ string.lisp | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) Index: src/code/string.lisp diff -u src/code/string.lisp:1.26 src/code/string.lisp:1.27 --- src/code/string.lisp:1.26 Wed Sep 15 17:06:38 2010 +++ src/code/string.lisp Mon Sep 20 19:01:15 2010 @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /project/cmucl/cvsroot/src/code/string.lisp,v 1.26 2010-09-15 21:06:38 rtoy Exp $") + "$Header: /project/cmucl/cvsroot/src/code/string.lisp,v 1.27 2010-09-20 23:01:15 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -40,7 +40,9 @@ for. :High means to test for the high (leading) surrogate; :Low tests for the low (trailing surrogate). A value of :Any or Nil tests for any surrogate value (high or low)." - (declare (type (or character codepoint) char-or-code)) + (declare (type (or character codepoint) char-or-code) + (type (or null (member :high :leading :low :trailing :any)) surrogate-type) + (optimize (inhibit-warnings 3))) (let ((code (if (characterp char-or-code) (char-code char-or-code) char-or-code))) @@ -74,14 +76,16 @@ (cond ((and (surrogatep code :high) (< (1+ i) end)) (let ((tmp (char-code (schar string (1+ i))))) (if (surrogatep tmp :low) - (values (+ (ash (- code #xD800) 10) tmp #x2400) +1) - (values code nil)))) + (values (truly-the codepoint (+ (ash (- code #xD800) 10) tmp #x2400)) + +1) + (values (truly-the codepoint code) nil)))) ((and (surrogatep code :low) (> i 0)) (let ((tmp (char-code (schar string (1- i))))) (if (surrogatep tmp :high) - (values (+ (ash (- tmp #xD800) 10) code #x2400) -1) - (values code nil)))) - (t (values code nil))))) + (values (truly-the codepoint (+ (ash (- tmp #xD800) 10) code #x2400)) + -1) + (values (truly-the codepoint code) nil)))) + (t (values (truly-the codepoint code) nil))))) (defun surrogates (codepoint) "Return the high and low surrogate characters for Codepoint. If

1 0

[cmucl-cvs] CMUCL commit: src/i18n/locale (4 files)
by Raymond Toy 20 Sep '10

20 Sep '10

Date: Monday, September 20, 2010 @ 16:34:06 Author: rtoy Path: /project/cmucl/cvsroot/src/i18n/locale Modified: en(a)piglatin/LC_MESSAGES/cmucl-x87.po en(a)piglatin/LC_MESSAGES/cmucl.po ko/LC_MESSAGES/cmucl-x87.po ko/LC_MESSAGES/cmucl.po Regenerate cmucl-x87.po and cmucl.po for each locale.from the latest pot files. --------------------------------------+ en(a)piglatin/LC_MESSAGES/cmucl-x87.po | 187 ++++++++++++++++++++++++++++++++- en(a)piglatin/LC_MESSAGES/cmucl.po | 85 ++++++++++++++- ko/LC_MESSAGES/cmucl-x87.po | 184 ++++++++++++++++++++++++++++++++ ko/LC_MESSAGES/cmucl.po | 47 ++++++++ 4 files changed, 498 insertions(+), 5 deletions(-) Index: src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl-x87.po diff -u src/i18n/locale/en@piglatin/LC_MESSAGES/cmucl-x87.po:1.5 src/i18n/locale/en@piglatin/LC_MESSAGES/cmucl-x87.po:1.6 --- src/i18n/locale/en@piglatin/LC_MESSAGES/cmucl-x87.po:1.5 Wed Sep 15 11:50:21 2010 +++ src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl-x87.po Mon Sep 20 16:34:05 2010 @@ -16,7 +16,192 @@ "Language: Pig Latin\n" "Plural-Forms: nplurals=2; plural=(n != 1);\n" +#: src/compiler/x86/float.lisp +msgid "Ignoring bogus i387 Constant ~a" +msgstr "Ignoringway ogusbay i387 Onstantcay ~away" + +#: src/compiler/x86/float.lisp +msgid "float move" +msgstr "oatflay ovemay" + #: src/compiler/x86/x87-array.lisp src/compiler/x86/x87-c-call.lisp -#: src/compiler/x86/x87-sap.lisp +#: src/compiler/x86/x87-sap.lisp src/compiler/x86/float.lisp msgid "Unknown SC to SC-Case for ~S:~% ~S" msgstr "Unknownway SC otay SC-Asecay orfay ~S:~% ~S" + +#: src/compiler/x86/float.lisp +msgid "complex float move" +msgstr "omplexcay oatflay ovemay" + +#: src/compiler/x86/float.lisp +msgid "float to pointer coercion" +msgstr "oatflay otay ointerpay oercioncay" + +#: src/compiler/x86/float.lisp +msgid "" +"Load TN allocated, but no move function?~@\n" +"\t VM definition inconsistent, recompile and try again." +msgstr "" +"Oadlay TN allocatedway, utbay onay ovemay unctionfay?~@\n" +"\t VM efinitionday inconsistentway, ecompileray andway ytray " +"againway." + +#: src/compiler/x86/float.lisp +msgid "pointer to float coercion" +msgstr "ointerpay otay oatflay oercioncay" + +#: src/compiler/x86/float.lisp +msgid "complex float to pointer coercion" +msgstr "omplexcay oatflay otay ointerpay oercioncay" + +#: src/compiler/x86/float.lisp +msgid "complex double-double float to pointer coercion" +msgstr "omplexcay oubleday-oubleday oatflay otay ointerpay oercioncay" + +#: src/compiler/x86/float.lisp +msgid "pointer to complex float coercion" +msgstr "ointerpay otay omplexcay oatflay oercioncay" + +#: src/compiler/x86/float.lisp +msgid "float argument move" +msgstr "oatflay argumentway ovemay" + +#: src/compiler/x86/float.lisp +msgid "complex float argument move" +msgstr "omplexcay oatflay argumentway ovemay" + +#: src/compiler/x86/float.lisp +msgid "complex double-double-float argument move" +msgstr "omplexcay oubleday-oubleday-oatflay argumentway ovemay" + +#: src/compiler/x86/float.lisp +msgid "inline float arithmetic" +msgstr "inlineway oatflay arithmeticway" + +#: src/compiler/x86/float.lisp +msgid "inline float comparison" +msgstr "inlineway oatflay omparisoncay" + +#: src/compiler/x86/float.lisp +msgid "inline float coercion" +msgstr "inlineway oatflay oercioncay" + +#: src/compiler/x86/float.lisp +msgid "inline float truncate" +msgstr "inlineway oatflay uncatetray" + +#: src/compiler/x86/float.lisp +msgid "inline NPX function" +msgstr "inlineway NPX unctionfay" + +#: src/compiler/x86/float.lisp +msgid "inline tan function" +msgstr "inlineway antay unctionfay" + +#: src/compiler/x86/float.lisp +msgid "inline sin/cos function" +msgstr "inlineway insay/oscay unctionfay" + +#: src/compiler/x86/float.lisp +msgid "inline exp function" +msgstr "inlineway expway unctionfay" + +#: src/compiler/x86/float.lisp +msgid "inline expm1 function" +msgstr "inlineway expmway1 unctionfay" + +#: src/compiler/x86/float.lisp +msgid "inline log function" +msgstr "inlineway oglay unctionfay" + +#: src/compiler/x86/float.lisp +msgid "inline log10 function" +msgstr "inlineway oglay10 unctionfay" + +#: src/compiler/x86/float.lisp +msgid "inline pow function" +msgstr "inlineway owpay unctionfay" + +#: src/compiler/x86/float.lisp +msgid "inline scalbn function" +msgstr "inlineway albnscay unctionfay" + +#: src/compiler/x86/float.lisp +msgid "inline scalb function" +msgstr "inlineway albscay unctionfay" + +#: src/compiler/x86/float.lisp +msgid "inline log1p function" +msgstr "inlineway oglay1p unctionfay" + +#: src/compiler/x86/float.lisp +msgid "inline log1p with limited x range function" +msgstr "inlineway oglay1p ithway imitedlay x angeray unctionfay" + +#: src/compiler/x86/float.lisp +msgid "inline logb function" +msgstr "inlineway ogblay unctionfay" + +#: src/compiler/x86/float.lisp +msgid "inline atan function" +msgstr "inlineway atanway unctionfay" + +#: src/compiler/x86/float.lisp +msgid "inline atan2 function" +msgstr "inlineway atanway2 unctionfay" + +#: src/compiler/x86/float.lisp +msgid "inline complex single-float creation" +msgstr "inlineway omplexcay inglesay-oatflay eationcray" + +#: src/compiler/x86/float.lisp +msgid "inline complex double-float creation" +msgstr "inlineway omplexcay oubleday-oatflay eationcray" + +#: src/compiler/x86/float.lisp +msgid "inline complex long-float creation" +msgstr "inlineway omplexcay onglay-oatflay eationcray" + +#: src/compiler/x86/float.lisp +msgid "complex float realpart" +msgstr "omplexcay oatflay ealpartray" + +#: src/compiler/x86/float.lisp +msgid "complex float imagpart" +msgstr "omplexcay oatflay imagpartway" + +#: src/compiler/x86/float.lisp +msgid "inline dummy FP register bias" +msgstr "inlineway ummyday FP egisterray iasbay" + +#: src/compiler/x86/float.lisp +msgid "double-double float move" +msgstr "oubleday-oubleday oatflay ovemay" + +#: src/compiler/x86/float.lisp +msgid "double double float to pointer coercion" +msgstr "oubleday oubleday oatflay otay ointerpay oercioncay" + +#: src/compiler/x86/float.lisp +msgid "pointer to double-double-float coercion" +msgstr "ointerpay otay oubleday-oubleday-oatflay oercioncay" + +#: src/compiler/x86/float.lisp +msgid "double double-float argument move" +msgstr "oubleday oubleday-oatflay argumentway ovemay" + +#: src/compiler/x86/float.lisp +msgid "inline double-double-float creation" +msgstr "inlineway oubleday-oubleday-oatflay eationcray" + +#: src/compiler/x86/float.lisp +msgid "double-double high part" +msgstr "oubleday-oubleday ighhay artpay" + +#: src/compiler/x86/float.lisp +msgid "double-double low part" +msgstr "oubleday-oubleday owlay artpay" + +#: src/compiler/x86/float.lisp +msgid "inline complex double-double-float creation" +msgstr "inlineway omplexcay oubleday-oubleday-oatflay eationcray" Index: src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po diff -u src/i18n/locale/en@piglatin/LC_MESSAGES/cmucl.po:1.9 src/i18n/locale/en@piglatin/LC_MESSAGES/cmucl.po:1.10 --- src/i18n/locale/en@piglatin/LC_MESSAGES/cmucl.po:1.9 Wed Sep 15 11:50:21 2010 +++ src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po Mon Sep 20 16:34:05 2010 @@ -5694,6 +5694,11 @@ " the basic multilingual plane (BMP) are converted into the\n" " corresponding surrogate pairs." msgstr "" +"Onvertcay away equencesay ofway odepointscay otay away ingstray. " +"Odepointscay outsideway\n" +" ethay asicbay ultilingualmay aneplay (BMP) areway onvertedcay intoway " +"ethay\n" +" orrespondingcay urrogatesay airspay." #: src/code/string.lisp msgid "" @@ -5701,6 +5706,11 @@ " pairs in the string are converted into the correspoinding\n" " codepoint." msgstr "" +"Onvertcay away ingstray otay away istlay ofway orrespondingcay odecay " +"ointspay. Urrogatesay\n" +" airspay inway ethay ingstray areway onvertedcay intoway ethay " +"orrespoindingcay\n" +" odepointcay." #: src/code/mipsstrops.lisp msgid "" @@ -7451,6 +7461,28 @@ msgstr "Unrecognizedway oclamationpray: ~S." #: src/code/unidata.lisp +msgid "" +"Search the Unicode name dictionary for the longest entry that\n" +" matches STRING. STRING must be in Unicode name format. That is, it\n" +" must be upper case with spaces separating each word.\n" +"\n" +" Two values are returned. The first value is index into the codebook\n" +" that continues the string.. The second value is the length of the\n" +" substring of string that matches the codebook. " +msgstr "" +"Earchsay ethay Unicodeway amenay ictionaryday orfay ethay ongestlay entryway " +"atthay\n" +" atchesmay STRING. STRING ustmay ebay inway Unicodeway amenay ormatfay. " +"Atthay isway, itway\n" +" ustmay ebay upperway asecay ithway acesspay eparatingsay eachway ordway.\n" +"\n" +" Wotay aluesvay areway eturnedray. Ethay irstfay aluevay isway indexway " +"intoway ethay odebookcay\n" +" atthay ontinuescay ethay ingstray.. Ethay econdsay aluevay isway ethay " +"engthlay ofway ethay\n" +" ubstringsay ofway ingstray atthay atchesmay ethay odebookcay. " + +#: src/code/unidata.lisp msgid "The Unicode data file is broken." msgstr "Ethay Unicodeway ataday ilefay isway okenbray." @@ -7462,6 +7494,49 @@ msgid "No data in file." msgstr "Onay ataday inway ilefay." +#: src/code/unidata.lisp +msgid "Dictionary of Hangul syllables" +msgstr "Ictionaryday ofway Angulhay yllablessay" + +#: src/code/unidata.lisp +msgid "Dictionary of CJK Unified ideographs" +msgstr "Ictionaryday ofway CJK Unifiedway ideographsway" + +#: src/code/unidata.lisp +msgid "" +"Try to complete the string Prefix using the dictionary in Dict.\n" +" Three values are returned: (1) The best match of prefix, (2) a list\n" +" of possible completions, (3) a boolean indicating whether the best\n" +" match is a complete unicode name. " +msgstr "" +"Ytray otay ompletecay ethay ingstray Efixpray usingway ethay ictionaryday " +"inway Ictday.\n" +" Reethay aluesvay areway eturnedray: (1) Ethay estbay atchmay ofway " +"efixpray, (2) away istlay\n" +" ofway ossiblepay ompletionscay, (3) away ooleanbay indicatingway etherwhay " +"ethay estbay\n" +" atchmay isway away ompletecay unicodeway amenay. " + +#: src/code/unidata.lisp +msgid "" +"Search the dictionary in Dict and return a list of the possible\n" +" completions starting with Prefix. If there is no match, NIL is\n" +" returned." +msgstr "" +"Earchsay ethay ictionaryday inway Ictday andway eturnray away istlay ofway " +"ethay ossiblepay\n" +" ompletionscay tartingsay ithway Efixpray. Ifway erethay isway onay " +"atchmay, NIL isway\n" +" eturnedray." + +#: src/code/unidata.lisp +msgid "Build the dictionary for Hangul syllables" +msgstr "Uildbay ethay ictionaryday orfay Angulhay yllablessay" + +#: src/code/unidata.lisp +msgid "Build the dictionary for CJK Unified Ideographs" +msgstr "Uildbay ethay ictionaryday orfay CJK Unifiedway Ideographsway" + #: src/code/char.lisp msgid "The upper exclusive bound on values produced by CHAR-CODE." msgstr "" @@ -18401,7 +18476,10 @@ "\tsame place as normal output.\n" " :status-hook -\n" " This is a function the system calls whenever the status of the\n" -" process changes. The function takes the process as an argument." +" process changes. The function takes the process as an argument.\n" +" :external-format -\n" +" This is the external-format used for communication with the " +"subprocess." msgstr "" "RUN-PROGRAM eatescray away ewnay ocesspray andway unsray ethay unixway " "ogrampray inway ethay\n" @@ -18487,7 +18565,10 @@ " Isthay isway away unctionfay ethay ystemsay allscay eneverwhay ethay " "tatussay ofway ethay\n" " ocesspray angeschay. Ethay unctionfay akestay ethay ocesspray asway " -"anway argumentway." +"anway argumentway.\n" +" :externalway-ormatfay -\n" +" Isthay isway ethay externalway-ormatfay usedway orfay " +"ommunicationcay ithway ethay ubprocesayssay." #: src/code/run-program.lisp msgid "All args to program must be simple strings -- ~S." Index: src/i18n/locale/ko/LC_MESSAGES/cmucl-x87.po diff -u src/i18n/locale/ko/LC_MESSAGES/cmucl-x87.po:1.4 src/i18n/locale/ko/LC_MESSAGES/cmucl-x87.po:1.5 --- src/i18n/locale/ko/LC_MESSAGES/cmucl-x87.po:1.4 Wed Sep 15 16:09:45 2010 +++ src/i18n/locale/ko/LC_MESSAGES/cmucl-x87.po Mon Sep 20 16:34:05 2010 @@ -15,7 +15,189 @@ "Content-Transfer-Encoding: 8bit\n" "Language: Korean\n" +#: src/compiler/x86/float.lisp +msgid "Ignoring bogus i387 Constant ~a" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "float move" +msgstr "" + #: src/compiler/x86/x87-array.lisp src/compiler/x86/x87-c-call.lisp -#: src/compiler/x86/x87-sap.lisp +#: src/compiler/x86/x87-sap.lisp src/compiler/x86/float.lisp msgid "Unknown SC to SC-Case for ~S:~% ~S" msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "float to pointer coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "" +"Load TN allocated, but no move function?~@\n" +"\t VM definition inconsistent, recompile and try again." +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "pointer to float coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float to pointer coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex double-double float to pointer coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "pointer to complex float coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "float argument move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float argument move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex double-double-float argument move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline float arithmetic" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline float comparison" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline float coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline float truncate" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline NPX function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline tan function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline sin/cos function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline exp function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline expm1 function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline log function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline log10 function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline pow function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline scalbn function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline scalb function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline log1p function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline log1p with limited x range function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline logb function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline atan function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline atan2 function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline complex single-float creation" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline complex double-float creation" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline complex long-float creation" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float realpart" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float imagpart" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline dummy FP register bias" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double-double float move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double double float to pointer coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "pointer to double-double-float coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double double-float argument move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline double-double-float creation" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double-double high part" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double-double low part" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline complex double-double-float creation" +msgstr "" Index: src/i18n/locale/ko/LC_MESSAGES/cmucl.po diff -u src/i18n/locale/ko/LC_MESSAGES/cmucl.po:1.11 src/i18n/locale/ko/LC_MESSAGES/cmucl.po:1.12 --- src/i18n/locale/ko/LC_MESSAGES/cmucl.po:1.11 Wed Sep 15 16:09:45 2010 +++ src/i18n/locale/ko/LC_MESSAGES/cmucl.po Mon Sep 20 16:34:05 2010 @@ -5263,6 +5263,17 @@ msgstr "" #: src/code/unidata.lisp +msgid "" +"Search the Unicode name dictionary for the longest entry that\n" +" matches STRING. STRING must be in Unicode name format. That is, it\n" +" must be upper case with spaces separating each word.\n" +"\n" +" Two values are returned. The first value is index into the codebook\n" +" that continues the string.. The second value is the length of the\n" +" substring of string that matches the codebook. " +msgstr "" + +#: src/code/unidata.lisp msgid "The Unicode data file is broken." msgstr "" @@ -5274,6 +5285,37 @@ msgid "No data in file." msgstr "" +#: src/code/unidata.lisp +msgid "Dictionary of Hangul syllables" +msgstr "" + +#: src/code/unidata.lisp +msgid "Dictionary of CJK Unified ideographs" +msgstr "" + +#: src/code/unidata.lisp +msgid "" +"Try to complete the string Prefix using the dictionary in Dict.\n" +" Three values are returned: (1) The best match of prefix, (2) a list\n" +" of possible completions, (3) a boolean indicating whether the best\n" +" match is a complete unicode name. " +msgstr "" + +#: src/code/unidata.lisp +msgid "" +"Search the dictionary in Dict and return a list of the possible\n" +" completions starting with Prefix. If there is no match, NIL is\n" +" returned." +msgstr "" + +#: src/code/unidata.lisp +msgid "Build the dictionary for Hangul syllables" +msgstr "" + +#: src/code/unidata.lisp +msgid "Build the dictionary for CJK Unified Ideographs" +msgstr "" + #: src/code/char.lisp msgid "The upper exclusive bound on values produced by CHAR-CODE." msgstr "" @@ -12982,7 +13024,10 @@ "\tsame place as normal output.\n" " :status-hook -\n" " This is a function the system calls whenever the status of the\n" -" process changes. The function takes the process as an argument." +" process changes. The function takes the process as an argument.\n" +" :external-format -\n" +" This is the external-format used for communication with the " +"subprocess." msgstr "" #: src/code/run-program.lisp

1 0

[cmucl-cvs] CMUCL commit: src/i18n/locale (cmucl-x87.pot)
by Raymond Toy 20 Sep '10

20 Sep '10

Date: Monday, September 20, 2010 @ 16:32:23 Author: rtoy Path: /project/cmucl/cvsroot/src/i18n/locale Modified: cmucl-x87.pot Update from latest sources to get new messages strings from x86/float.lisp. ---------------+ cmucl-x87.pot | 184 +++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 183 insertions(+), 1 deletion(-) Index: src/i18n/locale/cmucl-x87.pot diff -u src/i18n/locale/cmucl-x87.pot:1.3 src/i18n/locale/cmucl-x87.pot:1.4 --- src/i18n/locale/cmucl-x87.pot:1.3 Tue Apr 20 14:05:43 2010 +++ src/i18n/locale/cmucl-x87.pot Mon Sep 20 16:32:23 2010 @@ -15,8 +15,190 @@ "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" +#: src/compiler/x86/float.lisp +msgid "Ignoring bogus i387 Constant ~a" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "float move" +msgstr "" + #: src/compiler/x86/x87-array.lisp src/compiler/x86/x87-c-call.lisp -#: src/compiler/x86/x87-sap.lisp +#: src/compiler/x86/x87-sap.lisp src/compiler/x86/float.lisp msgid "Unknown SC to SC-Case for ~S:~% ~S" msgstr "" +#: src/compiler/x86/float.lisp +msgid "complex float move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "float to pointer coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "" +"Load TN allocated, but no move function?~@\n" +" VM definition inconsistent, recompile and try again." +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "pointer to float coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float to pointer coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex double-double float to pointer coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "pointer to complex float coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "float argument move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float argument move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex double-double-float argument move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline float arithmetic" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline float comparison" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline float coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline float truncate" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline NPX function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline tan function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline sin/cos function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline exp function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline expm1 function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline log function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline log10 function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline pow function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline scalbn function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline scalb function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline log1p function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline log1p with limited x range function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline logb function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline atan function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline atan2 function" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline complex single-float creation" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline complex double-float creation" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline complex long-float creation" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float realpart" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "complex float imagpart" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline dummy FP register bias" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double-double float move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double double float to pointer coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "pointer to double-double-float coercion" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double double-float argument move" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline double-double-float creation" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double-double high part" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "double-double low part" +msgstr "" + +#: src/compiler/x86/float.lisp +msgid "inline complex double-double-float creation" +msgstr "" +

1 0

[cmucl-cvs] CMUCL commit: src/i18n/locale (cmucl.pot)
by Raymond Toy 20 Sep '10

20 Sep '10

Date: Monday, September 20, 2010 @ 16:25:10 Author: rtoy Path: /project/cmucl/cvsroot/src/i18n/locale Modified: cmucl.pot Update from latest sources to get new messages strings. -----------+ cmucl.pot | 47 ++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 46 insertions(+), 1 deletion(-) Index: src/i18n/locale/cmucl.pot diff -u src/i18n/locale/cmucl.pot:1.13 src/i18n/locale/cmucl.pot:1.14 --- src/i18n/locale/cmucl.pot:1.13 Wed Sep 15 16:00:46 2010 +++ src/i18n/locale/cmucl.pot Mon Sep 20 16:25:09 2010 @@ -5265,6 +5265,17 @@ msgstr "" #: src/code/unidata.lisp +msgid "" +"Search the Unicode name dictionary for the longest entry that\n" +" matches STRING. STRING must be in Unicode name format. That is, it\n" +" must be upper case with spaces separating each word.\n" +"\n" +" Two values are returned. The first value is index into the codebook\n" +" that continues the string.. The second value is the length of the\n" +" substring of string that matches the codebook. " +msgstr "" + +#: src/code/unidata.lisp msgid "The Unicode data file is broken." msgstr "" @@ -5276,6 +5287,37 @@ msgid "No data in file." msgstr "" +#: src/code/unidata.lisp +msgid "Dictionary of Hangul syllables" +msgstr "" + +#: src/code/unidata.lisp +msgid "Dictionary of CJK Unified ideographs" +msgstr "" + +#: src/code/unidata.lisp +msgid "" +"Try to complete the string Prefix using the dictionary in Dict.\n" +" Three values are returned: (1) The best match of prefix, (2) a list\n" +" of possible completions, (3) a boolean indicating whether the best\n" +" match is a complete unicode name. " +msgstr "" + +#: src/code/unidata.lisp +msgid "" +"Search the dictionary in Dict and return a list of the possible\n" +" completions starting with Prefix. If there is no match, NIL is\n" +" returned." +msgstr "" + +#: src/code/unidata.lisp +msgid "Build the dictionary for Hangul syllables" +msgstr "" + +#: src/code/unidata.lisp +msgid "Build the dictionary for CJK Unified Ideographs" +msgstr "" + #: src/code/char.lisp msgid "The upper exclusive bound on values produced by CHAR-CODE." msgstr "" @@ -12956,7 +12998,10 @@ " same place as normal output.\n" " :status-hook -\n" " This is a function the system calls whenever the status of the\n" -" process changes. The function takes the process as an argument." +" process changes. The function takes the process as an argument.\n" +" :external-format -\n" +" This is the external-format used for communication with the subproce" +"ss." msgstr "" #: src/code/run-program.lisp

1 0

[cmucl-cvs] CMUCL commit: src/compiler/x86 (float.lisp)
by Raymond Toy 20 Sep '10

20 Sep '10

Date: Monday, September 20, 2010 @ 16:22:03 Author: rtoy Path: /project/cmucl/cvsroot/src/compiler/x86 Modified: float.lisp This entire file should be in the cmucl-x87 domain, not cmucl-x86-vm. ------------+ float.lisp | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) Index: src/compiler/x86/float.lisp diff -u src/compiler/x86/float.lisp:1.60 src/compiler/x86/float.lisp:1.61 --- src/compiler/x86/float.lisp:1.60 Tue Apr 20 13:57:47 2010 +++ src/compiler/x86/float.lisp Mon Sep 20 16:22:03 2010 @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group(a)cs.cmu.edu. ;;; (ext:file-comment - "$Header: /project/cmucl/cvsroot/src/compiler/x86/float.lisp,v 1.60 2010-04-20 17:57:47 rtoy Exp $") + "$Header: /project/cmucl/cvsroot/src/compiler/x86/float.lisp,v 1.61 2010-09-20 20:22:03 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -22,7 +22,7 @@ ;;; (in-package :x86) -(intl:textdomain "cmucl-x86-vm") +(intl:textdomain "cmucl-x87") @@ -1709,6 +1709,7 @@ ;;; Comparisons with 0 can use the FTST instruction. + (define-vop (float-test) (:args (x)) (:temporary (:sc word-reg :offset eax-offset :from :eval) temp)

1 0

[cmucl-cvs] CMUCL commit: src/code (run-program.lisp)
by Raymond Toy 20 Sep '10

20 Sep '10

Date: Monday, September 20, 2010 @ 09:50:53 Author: rtoy Path: /project/cmucl/cvsroot/src/code Modified: run-program.lisp Add support for external formats for RUN-PROGRAM, which now takes an :EXTERNAL-FORMAT keyword argument to specify the format to use for any streams that RUN-PROGRAM needs to create. Patch from Paul Foley. ------------------+ run-program.lisp | 36 ++++++++++++++++++++++++------------ 1 file changed, 24 insertions(+), 12 deletions(-) Index: src/code/run-program.lisp diff -u src/code/run-program.lisp:1.31 src/code/run-program.lisp:1.32 --- src/code/run-program.lisp:1.31 Tue Apr 20 13:57:45 2010 +++ src/code/run-program.lisp Mon Sep 20 09:50:52 2010 @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /project/cmucl/cvsroot/src/code/run-program.lisp,v 1.31 2010-04-20 17:57:45 rtoy Exp $") + "$Header: /project/cmucl/cvsroot/src/code/run-program.lisp,v 1.32 2010-09-20 13:50:52 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -325,7 +325,7 @@ ;;; OPEN-PTY -- internal ;;; -(defun open-pty (pty cookie) +(defun open-pty (pty cookie &optional (external-format :default)) (when pty (multiple-value-bind (master slave name) @@ -340,7 +340,8 @@ (push new-fd *close-on-error*) (copy-descriptor-to-stream new-fd pty cookie))) (values name - (system:make-fd-stream master :input t :output t))))) + (system:make-fd-stream master :input t :output t + :external-format external-format))))) (defmacro round-bytes-to-words (n) @@ -454,7 +455,8 @@ (defun run-program (program args &key (env *environment-list*) (wait t) pty input if-input-does-not-exist output (if-output-exists :error) - (error :output) (if-error-exists :error) status-hook) + (error :output) (if-error-exists :error) status-hook + (external-format :default)) "RUN-PROGRAM creates a new process and runs the unix program in the file specified by the simple-string PROGRAM. ARGS are the standard arguments that can be passed to a Unix program, for no arguments @@ -506,14 +508,16 @@ same place as normal output. :status-hook - This is a function the system calls whenever the status of the - process changes. The function takes the process as an argument." + process changes. The function takes the process as an argument. + :external-format - + This is the external-format used for communication with the subprocess." ;; Make sure the interrupt handler is installed. (system:enable-interrupt unix:sigchld #'sigchld-handler) ;; Make sure all the args are okay. (unless (every #'simple-string-p args) (error (intl:gettext "All args to program must be simple strings -- ~S.") args)) - ;; Pre-pend the program to the argument list. + ;; Prepend the program to the argument list. (push (namestring program) args) ;; Clear random specials used by GET-DESCRIPTOR-FOR to communicate cleanup ;; info. Also, establish proc at this level so we can return it. @@ -526,21 +530,24 @@ (multiple-value-bind (stdin input-stream) (get-descriptor-for input cookie :direction :input - :if-does-not-exist if-input-does-not-exist) + :if-does-not-exist if-input-does-not-exist + :external-format external-format) (multiple-value-bind (stdout output-stream) (get-descriptor-for output cookie :direction :output :if-does-not-exist :create - :if-exists if-output-exists) + :if-exists if-output-exists + :external-format external-format) (multiple-value-bind (stderr error-stream) (if (eq error :output) (values stdout output-stream) (get-descriptor-for error cookie :direction :output :if-does-not-exist :create - :if-exists if-error-exists)) + :if-exists if-error-exists + :external-format external-format)) (multiple-value-bind (pty-name pty-stream) - (open-pty pty cookie) + (open-pty pty cookie external-format) ;; Make sure we are not notified about the child death before ;; we have installed the process struct in *active-processes* (system:without-interrupts @@ -644,6 +651,7 @@ ;;; second value. ;;; (defun get-descriptor-for (object cookie &rest keys &key direction + external-format &allow-other-keys) (cond ((eq object t) ;; No new descriptor is needed. @@ -674,12 +682,16 @@ (:input (push read-fd *close-in-parent*) (push write-fd *close-on-error*) - (let ((stream (system:make-fd-stream write-fd :output t))) + (let ((stream (system:make-fd-stream write-fd :output t + :external-format + external-format))) (values read-fd stream))) (:output (push read-fd *close-on-error*) (push write-fd *close-in-parent*) - (let ((stream (system:make-fd-stream read-fd :input t))) + (let ((stream (system:make-fd-stream read-fd :input t + :external-format + external-format))) (values write-fd stream))) (t (unix:unix-close read-fd)

1 0

[cmucl-cvs] CMUCL commit: src/code (unidata.lisp)
by Raymond Toy 20 Sep '10

20 Sep '10

Date: Sunday, September 19, 2010 @ 21:17:14 Author: rtoy Path: /project/cmucl/cvsroot/src/code Modified: unidata.lisp Was mishandling the case where there are no more completions. In this case we were returning the prefix string, but that would be incorrect if the prefix string is not a valid character. So check that it is valid and return it. Otherwise do nothing (thereby returning nil) so slime can note the character is invalid. --------------+ unidata.lisp | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) Index: src/code/unidata.lisp diff -u src/code/unidata.lisp:1.20 src/code/unidata.lisp:1.21 --- src/code/unidata.lisp:1.20 Sun Sep 19 20:59:22 2010 +++ src/code/unidata.lisp Sun Sep 19 21:17:14 2010 @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.20 2010-09-20 00:59:22 rtoy Exp $") +(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.21 2010-09-20 01:17:14 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -18,7 +18,7 @@ (defconstant +unidata-path+ #p"ext-formats:unidata.bin") -(defvar *unidata-version* "$Revision: 1.20 $") +(defvar *unidata-version* "$Revision: 1.21 $") (defstruct unidata range @@ -1291,7 +1291,12 @@ (if suffixes (loop for n in suffixes do (push (concatenate 'string full-prefix n) names)) - (push full-prefix names)))))) + ;; No suffixes. So either the prefix is the + ;; only possible completion or it's not valid. + ;; Figure that out. If it's valid, add it to + ;; names. + (when (search-dictionary (string-upcase prefix-tail) dictionary) + (push prefix-match names))))))) ;; Match prefix for Hangul syllables or CJK unified ideographs. (cond ((char= (char prefix-match 0) #\H) ;; Add "Hangul_Syllable_" as possible completion for @@ -1312,7 +1317,8 @@ (unless *cjk-unified-ideograph-dictionary* (build-cjk-unified-ideograph-dictionary)) (han-or-cjk-completion prefix-match "Cjk_Unified_Ideograph-" - *cjk-unified-ideograph-dictionary*))))) + *cjk-unified-ideograph-dictionary*) + )))) (setf names (mapcar #'string-capitalize names)) ;;(format t "Final names = ~S~%" names) names)))

1 0

[cmucl-cvs] CMUCL commit: src/code (unidata.lisp)
by Raymond Toy 20 Sep '10

20 Sep '10

Date: Sunday, September 19, 2010 @ 20:59:22 Author: rtoy Path: /project/cmucl/cvsroot/src/code Modified: unidata.lisp Improve completion of Hangul syllables and CJK unified ideographs some more and fix some bugs in previous change. --------------+ unidata.lisp | 87 ++++++++++++++++++++++----------------------------------- 1 file changed, 35 insertions(+), 52 deletions(-) Index: src/code/unidata.lisp diff -u src/code/unidata.lisp:1.19 src/code/unidata.lisp:1.20 --- src/code/unidata.lisp:1.19 Sun Sep 19 19:07:46 2010 +++ src/code/unidata.lisp Sun Sep 19 20:59:22 2010 @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.19 2010-09-19 23:07:46 rtoy Exp $") +(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.20 2010-09-20 00:59:22 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -18,7 +18,7 @@ (defconstant +unidata-path+ #p"ext-formats:unidata.bin") -(defvar *unidata-version* "$Revision: 1.19 $") +(defvar *unidata-version* "$Revision: 1.20 $") (defstruct unidata range @@ -1274,62 +1274,45 @@ completions starting with Prefix. If there is no match, NIL is returned." (let (names) - (cond ((search "Hangul_Syllable_" prefix) - (initialize-reverse-hangul-tables) - (unless *hangul-syllable-dictionary* - (build-hangul-syllable-dictionary)) - (multiple-value-bind (prefix-match next completep) - (unicode-complete-name (subseq prefix 16) - *hangul-syllable-dictionary*) - (loop for x in next - do (push (concatenate 'string "Hangul_Syllable_" prefix-match x) - names)) - (when completep - (push (concatenate 'string "Hangul_Syllable_" prefix-match) - names)))) - ((search "Cjk_Unified_Ideograph-" prefix) - (unless *cjk-unified-ideograph-dictionary* - (build-cjk-unified-ideograph-dictionary)) - (multiple-value-bind (prefix-match next completep) - (unicode-complete-name (subseq prefix 22) - *cjk-unified-ideograph-dictionary*) - (loop for x in next - do (push (concatenate 'string "Cjk_Unified_Ideograph-" prefix-match x) - names)) - (when completep - (push (concatenate 'string "Cjk_Unified_Ideograph-" prefix-match) - names))))) (multiple-value-bind (prefix-match next completep) (unicode-complete-name prefix dict) (loop for x in next do (push (concatenate 'string prefix-match x) names)) (when completep (push prefix-match names)) - ;; Match prefix against Hangul and/or Hangul_syllable - (cond ((search "Hangul_S" prefix-match - :end1 (min 8 (length prefix-match))) - ;; Add syllable as possible completion, and then try to - ;; complete some more so that we don't end up with slime - ;; saying "Hangul_Syllable_" is the only completion. - (multiple-value-bind (m suffixes) - (unicode-complete-name (subseq prefix-match (min 16 (length prefix-match))) - *hangul-syllable-dictionary*) - (declare (ignore m)) - (if suffixes - (loop for n in suffixes - do (push (concatenate 'string "Hangul_Syllable_" n) names)) - (push "Hangul_Syllable_" names)))) - ((or ;;(string= prefix-match "Cjk_") - (search "Cjk_Unified_Ideograph-" prefix-match - :end1 (min 22 (length prefix-match)))) - ;; Try to complete the first part so we don't get - ;; "Cjk_Unified_Ideograph-" as the only completion. - (multiple-value-bind (m suffixes) - (unicode-complete-name (subseq prefix-match (min 22 (length prefix-match))) - *cjk-unified-ideograph-dictionary*) - (declare (ignore m)) - (loop for n in suffixes - do (push (concatenate 'string "Cjk_Unified_Ideograph-" n) names))))) + (flet ((han-or-cjk-completion (prefix-match prefix dictionary) + (let* ((prefix-tail (subseq prefix-match + (min (length prefix) + (length prefix-match)))) + (full-prefix (concatenate 'string prefix prefix-tail))) + (multiple-value-bind (m suffixes) + (unicode-complete-name prefix-tail dictionary) + (declare (ignore m)) + (if suffixes + (loop for n in suffixes + do (push (concatenate 'string full-prefix n) names)) + (push full-prefix names)))))) + ;; Match prefix for Hangul syllables or CJK unified ideographs. + (cond ((char= (char prefix-match 0) #\H) + ;; Add "Hangul_Syllable_" as possible completion for + ;; anything beginning with "H". + (push "Hangul_Syllable_" names) + (when (<= (length names) 1) + ;; Hangul_Syllable is the only match, so let's extend it. + (unless *hangul-syllable-dictionary* + (initialize-reverse-hangul-tables) + (build-hangul-syllable-dictionary)) + (han-or-cjk-completion prefix-match "Hangul_Syllable_" + *hangul-syllable-dictionary*))) + ((char= (char prefix-match 0) #\C) + ;; Add "Cjk_Unified_Ideograph-" as possible completion + ;; for anything beginning with "C". + (push "Cjk_Unified_Ideograph-" names) + (when (<= (length names) 1) + (unless *cjk-unified-ideograph-dictionary* + (build-cjk-unified-ideograph-dictionary)) + (han-or-cjk-completion prefix-match "Cjk_Unified_Ideograph-" + *cjk-unified-ideograph-dictionary*))))) (setf names (mapcar #'string-capitalize names)) ;;(format t "Final names = ~S~%" names) names)))

1 0

[cmucl-cvs] CMUCL commit: src/code (unidata.lisp)
by Raymond Toy 19 Sep '10

19 Sep '10

Date: Sunday, September 19, 2010 @ 19:07:46 Author: rtoy Path: /project/cmucl/cvsroot/src/code Modified: unidata.lisp o Move %STR, %STRX and %MATCH around so that we can inline them (because they're so simple). o Add some comments for %STR. o Change implementation of %MATCH to be simpler and add comments on why we do what we do and explain what happens if we don't. o Handle completion of Hangul syllables better: - Match "Hangul_S" instead of "Hangul_Syllable" because there's #\Hangul_Single_Dot_Tone_Mark. - If we match "Hangul_S", try to complete some Hangul syllables so we don't fool slime into thinking "Hangul_Syllable_" is the only completion. There are obviously more. o Handle completion of CJK Unified Ideographs better by trying to complete more so slime isn't fooled into thinking "CJK_Unified_Ideograph-" is the only possible completion. --------------+ unidata.lisp | 91 +++++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 63 insertions(+), 28 deletions(-) Index: src/code/unidata.lisp diff -u src/code/unidata.lisp:1.18 src/code/unidata.lisp:1.19 --- src/code/unidata.lisp:1.18 Sat Sep 18 22:37:10 2010 +++ src/code/unidata.lisp Sun Sep 19 19:07:46 2010 @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.18 2010-09-19 02:37:10 rtoy Exp $") +(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.19 2010-09-19 23:07:46 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -18,7 +18,7 @@ (defconstant +unidata-path+ #p"ext-formats:unidata.bin") -(defvar *unidata-version* "$Revision: 1.18 $") +(defvar *unidata-version* "$Revision: 1.19 $") (defstruct unidata range @@ -1132,7 +1132,43 @@ (defvar *cjk-unified-ideograph-dictionary* nil "Dictionary of CJK Unified ideographs") -;; +;; Convert the string into the form we want for character names. +;; Basically the Unicode name has spaces replaced by underscores, and +;; the result is capitalized. +(declaim (inline %str %strx)) +(defun %str (x) + (nsubstitute #\_ #\Space (string-capitalize x))) + +(defun %strx (x) + (%str (car x))) + +(declaim (inline %match)) +#+(or) +(defun %match (part prefix posn) + (and (>= (length part) (- (length prefix) posn)) + (string= part prefix :start2 posn :end1 (- (length prefix) posn)))) + +#+(or) +(defun %match (part prefix posn) + (let ((s1 (search part prefix :start2 posn)) + (s2 (search prefix part :start1 posn))) + (or (and s1 (= s1 posn)) + (and s2 (zerop s2))))) + +;; Test if the string PART matches the string PREFIX starting from +;; position POSN. Basically test that the initial parts of the +;; strings match each other exactly. For if the prefix is "BO", then +;; both "B" and "BOX" should match. (This is needed to get the +;; completion of "cjk_radical_bo" to match "cjk_radical_box" as well +;; as "cjk_radical_bone" and others because at one point in the +;; algorithm the part is "B", which we do want to match "BO" so that +;; we can get the possible completions BONE" and "BOLT OF CLOTH". +(defun %match (part prefix posn) + (let ((len (min (length part) + (- (length prefix) posn)))) + (string= part prefix :end1 len :start2 posn :end2 (+ posn len)))) + + (defun unicode-complete-name (prefix &optional (dict (unidata-name+ *unicode-data*))) @@ -1270,36 +1306,35 @@ (when completep (push prefix-match names)) ;; Match prefix against Hangul and/or Hangul_syllable - (cond ((or (string= prefix-match "Hangul_") - (search "Hangul_Syllable_" prefix-match :end1 (min 16 (length prefix-match)))) - ;; Add syllable as possible completion - (push "Hangul_Syllable_" names)) + (cond ((search "Hangul_S" prefix-match + :end1 (min 8 (length prefix-match))) + ;; Add syllable as possible completion, and then try to + ;; complete some more so that we don't end up with slime + ;; saying "Hangul_Syllable_" is the only completion. + (multiple-value-bind (m suffixes) + (unicode-complete-name (subseq prefix-match (min 16 (length prefix-match))) + *hangul-syllable-dictionary*) + (declare (ignore m)) + (if suffixes + (loop for n in suffixes + do (push (concatenate 'string "Hangul_Syllable_" n) names)) + (push "Hangul_Syllable_" names)))) ((or ;;(string= prefix-match "Cjk_") - (search "Cjk_Unified_Ideograph-" prefix-match :end1 (min 22 (length prefix-match)))) - ;; Add Unified - (push "Cjk_Unified_Ideograph-" names))) + (search "Cjk_Unified_Ideograph-" prefix-match + :end1 (min 22 (length prefix-match)))) + ;; Try to complete the first part so we don't get + ;; "Cjk_Unified_Ideograph-" as the only completion. + (multiple-value-bind (m suffixes) + (unicode-complete-name (subseq prefix-match (min 22 (length prefix-match))) + *cjk-unified-ideograph-dictionary*) + (declare (ignore m)) + (loop for n in suffixes + do (push (concatenate 'string "Cjk_Unified_Ideograph-" n) names))))) (setf names (mapcar #'string-capitalize names)) ;;(format t "Final names = ~S~%" names) names))) -;; Convert the string into the form we want for character names. -(defun %str (x) - (nsubstitute #\_ #\Space (string-capitalize x))) - -(defun %strx (x) - (%str (car x))) - -#+(or) -(defun %match (part prefix posn) - (and (>= (length part) (- (length prefix) posn)) - (string= part prefix :start2 posn :end1 (- (length prefix) posn)))) - -(defun %match (part prefix posn) - (let ((s1 (search part prefix :start2 posn)) - (s2 (search prefix part :start1 posn))) - (or (and s1 (= s1 posn)) - (and s2 (zerop s2))))) - +;; Find the longest initial substring of the STRINGS. (defun %mip (strings) (let* ((first (first strings)) (posn (length first)))

1 0

[cmucl-cvs] CMUCL commit: src/general-info (release-20b.txt)
by Raymond Toy 19 Sep '10

19 Sep '10

Date: Sunday, September 19, 2010 @ 00:10:52 Author: rtoy Path: /project/cmucl/cvsroot/src/general-info Modified: release-20b.txt Merge from 20b-branch for bug fix for Unicode 1.0 names. -----------------+ release-20b.txt | 3 +++ 1 file changed, 3 insertions(+) Index: src/general-info/release-20b.txt diff -u src/general-info/release-20b.txt:1.48 src/general-info/release-20b.txt:1.49 --- src/general-info/release-20b.txt:1.48 Wed Sep 8 20:22:03 2010 +++ src/general-info/release-20b.txt Sun Sep 19 00:10:52 2010 @@ -205,6 +205,9 @@ - For SSE2 builds, SIGCONTEXT-FLOAT-REGISTER returned the wrong value for single-floats. Easily noticead when tracing a function with single-float arguments. + - The table for Unicode 1.0 names was constructed incorrectly. + Thus, UNICODE-1.0-NAME would return the wrong names for many + (all?) codepoints. * Trac Tickets: #33: get-dispatch-macro-character doesn't signal errors in

1 0

[cmucl-cvs] CMUCL commit: src/i18n (unidata.bin)
by Raymond Toy 19 Sep '10

19 Sep '10

Date: Sunday, September 19, 2010 @ 00:10:16 Author: rtoy Path: /project/cmucl/cvsroot/src/i18n Modified: unidata.bin Regenerated with correct table for Unicode 1.0 names. -------------+ unidata.bin | <<Binary file>> 1 file changed, 1 insertion(+) Index: src/i18n/unidata.bin <<Binary file>>

1 0

[cmucl-cvs] CMUCL commit: RELEASE-20B-BRANCH src (general-info/release-20b.txt i18n/unidata.bin)
by Raymond Toy 19 Sep '10

19 Sep '10

Date: Saturday, September 18, 2010 @ 23:46:03 Author: rtoy Path: /project/cmucl/cvsroot/src Tag: RELEASE-20B-BRANCH Modified: general-info/release-20b.txt i18n/unidata.bin release-20b.txt: o Note bug fix for Unicode 1.0 names unidata.bin: o Regenerated with correct table for Unicode 1.0 names. ------------------------------+ general-info/release-20b.txt | 3 +++ i18n/unidata.bin | <<Binary file>> 2 files changed, 4 insertions(+) Index: src/general-info/release-20b.txt diff -u src/general-info/release-20b.txt:1.41.2.6 src/general-info/release-20b.txt:1.41.2.7 --- src/general-info/release-20b.txt:1.41.2.6 Wed Sep 8 20:23:56 2010 +++ src/general-info/release-20b.txt Sat Sep 18 23:46:02 2010 @@ -200,6 +200,9 @@ - For SSE2 builds, SIGCONTEXT-FLOAT-REGISTER returned the wrong value for single-floats. Easily noticead when tracing a function with single-float arguments. + - The table for Unicode 1.0 names was constructed incorrectly. + Thus, UNICODE-1.0-NAME would return the wrong names for many + (all?) codepoints. * Trac Tickets: #33: get-dispatch-macro-character doesn't signal errors in Index: src/i18n/unidata.bin <<Binary file>>

1 0