[elephant-cvs] CVS elephant/src/elephant

[ieslick]

Update of /project/elephant/cvsroot/elephant/src/elephant
In directory clnet:/tmp/cvs-serv31080/src/elephant

Modified Files:
	package.lisp unicode2.lisp 
Log Message:
Fixed serialization of char codes > #x7F; added appropriate test; fixed symbol export problem

--- /project/elephant/cvsroot/elephant/src/elephant/package.lisp	2007/02/25 03:37:37	1.19
+++ /project/elephant/cvsroot/elephant/src/elephant/package.lisp	2007/02/25 20:02:32	1.20
@@ -68,6 +68,7 @@
 	   #:add-symbol-conversion #:add-package-conversion
 	   #:*always-convert*
 
+	   #:translate-and-intern-symbol
 	   #:lookup-persistent-symbol
 	   #:lookup-persistent-symbol-id
 	   #:int-byte-spec
--- /project/elephant/cvsroot/elephant/src/elephant/unicode2.lisp	2007/02/24 14:51:59	1.5
+++ /project/elephant/cvsroot/elephant/src/elephant/unicode2.lisp	2007/02/25 20:02:32	1.6
@@ -35,11 +35,12 @@
   "Try to write each format type and bail if code is too big"
   (declare (type buffer-stream bstream)
 	   (type string string))
-  (cond ((and (not (equal "" string)) (< (char-code (char string 0)) #x7F))
-	 (serialize-to-utf8 string bstream))
+  (cond ((and (not (equal "" string)) (> (char-code (char string 0)) #xFFFF))
+	 (serialize-to-utf32le string bstream))
 	;; Accelerate the common case where a character set is not Latin-1
-	((and (not (equal "" string)) (< (char-code (char string 0)) #xFFFF))
-	 (serialize-to-utf16le string bstream))
+	((and (not (equal "" string)) (> (char-code (char string 0)) #xFF))
+	 (or (serialize-to-utf16le string bstream)
+	     (serialize-to-utf32le string bstream)))
 	;; Actually code pages > 0 are rare; so we can pay an extra cost
 	(t (or (serialize-to-utf8 string bstream)
 	       (serialize-to-utf16le string bstream)
@@ -73,13 +74,13 @@
 	       (loop for i fixnum from 0 below characters do
 		    (let ((code (char-code (schar string i))))
 		      (declare (type fixnum code))
-		      (when (> code #x7F) (fail))
+		      (when (> code #xFF) (fail))
 		      (setf (uffi:deref-array buffer 'array-or-pointer-char (+ i size)) code))))
 	      (string
 	       (loop for i fixnum from 0 below characters do 
 		    (let ((code (char-code (char string i))))
 		      (declare (type fixnum code))
-		      (when (> code #x7F) (fail))
+		      (when (> code #xFF) (fail))
 		      (setf (uffi:deref-array buffer 'array-or-pointer-char (+ i size)) code)))))
 	    (setf (buffer-stream-size bstream) needed)
 	    (succeed))))))
@@ -251,7 +252,6 @@
 	 (setf code (dpb (next-byte 1) (byte 8 16) code))
 	 (setf code (dpb (next-byte 2) (byte 8 8) code))
 	 (setf code (dpb (next-byte 3) (byte 8 0) code))
-	 (print code)
 	 (setf (char string i) (code-char code)))
     (incf (elephant-memutil::buffer-stream-position bstream)
 	  (+ pos (* length 4)))