[bknr-cvs] r2022 - branches/xml-class-rework/thirdparty/iconv

[bknr at bknr.net]

Author: hhubner
Date: 2006-10-21 12:14:15 -0400 (Sat, 21 Oct 2006)
New Revision: 2022

Modified:
   branches/xml-class-rework/thirdparty/iconv/iconv.lisp
Log:
FreeBSD fixes
Add string mode to convert strings directly
Create output buffer with correct size (after conversion)


Modified: branches/xml-class-rework/thirdparty/iconv/iconv.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/iconv/iconv.lisp	2006-10-21 15:32:24 UTC (rev 2021)
+++ branches/xml-class-rework/thirdparty/iconv/iconv.lisp	2006-10-21 16:14:15 UTC (rev 2022)
@@ -19,7 +19,7 @@
   (sb-alien:get-errno)
   )
 
-(uffi:def-constant EILSEQ 84)           ;invalid multibyte
+(uffi:def-constant EILSEQ #+freebsd 86 #-freebsd 84)           ;invalid multibyte
 (uffi:def-constant EINVAL 22)           ;imcomplete multibyte
 (uffi:def-constant E2BIG 7)             ;not enough outbuf
 
@@ -53,19 +53,15 @@
 
 (defun iconv (from-code to-code from-vector
 	      &optional error-p (error-value #.(char-code #\?)))
-  (declare (type (vector (unsigned-byte 8)) from-vector))
   (with-iconv-cd (cd from-code to-code)
     (let* ((from-len (length from-vector))
 	   (to-len (* from-len 2))
-	   (out (make-array to-len
-			    :element-type '(unsigned-byte 8)
-			    :fill-pointer 0
-			    :adjustable t))
 	   (remain (make-array 3
 			       :element-type '(unsigned-byte 8)
 			       :fill-pointer 0
 			       :adjustable t))
-	   (inbuffer (uffi:allocate-foreign-string from-len :unsigned t))
+	   (string-mode (characterp (aref from-vector 0)))
+	   inbuffer
 	   (outbuffer (uffi:allocate-foreign-string to-len :unsigned t))
 	   (in-ptr (uffi:allocate-foreign-object 'char-ptr))
 	   (out-ptr (uffi:allocate-foreign-object 'char-ptr))
@@ -73,46 +69,52 @@
 	   (outbytesleft (uffi:allocate-foreign-object :unsigned-int)))
       (unwind-protect
 	   (progn
-	     (loop for i from 0 below from-len
-		   do (setf (uffi:deref-array inbuffer :unsigned-char i)
-			    (aref from-vector i)))
+	     (if string-mode
+		 (setf inbuffer (uffi:convert-to-foreign-string from-vector))
+		 (progn
+		   (setf inbuffer (uffi:allocate-foreign-string from-len :unsigned t))
+		   (loop for i from 0 below from-len
+		      do (setf (uffi:deref-array inbuffer :unsigned-char i)
+			       (aref from-vector i)))))
 	     (setf (uffi:deref-pointer in-ptr 'char-ptr) inbuffer
 		   (uffi:deref-pointer out-ptr 'char-ptr) outbuffer
 		   (uffi:deref-pointer inbytesleft :unsigned-int) from-len
 		   (uffi:deref-pointer outbytesleft :unsigned-int) to-len)
-	     (labels ((current ()
-			(- from-len (uffi:deref-pointer
-				     inbytesleft :unsigned-int)))
-		      (self ()
-			(when (= (%iconv cd
-					 in-ptr inbytesleft
-					 out-ptr outbytesleft)
-				 #xffffffff)
-			    (if (= (get-errno) EILSEQ)
-				(if error-p
-				    (error "invalid multibyte(~X)."
-					   (uffi:deref-array
-					    inbuffer :unsigned-byte (current)))
-				    (progn
-				      (setf (uffi:deref-array
-					     inbuffer :unsigned-byte (current))
-					    error-value)
-				      (self)))
-				(loop for i from (current)
-				   below from-len
-				   do (vector-push-extend
-				       (aref from-vector i) remain))))))
+	     (labels
+		 ((current ()
+		    (- from-len (uffi:deref-pointer
+				 inbytesleft :unsigned-int)))
+		  (self ()
+		    (when (= (%iconv cd
+				     in-ptr inbytesleft
+				     out-ptr outbytesleft)
+			     #xffffffff)
+		      (if (= (get-errno) EILSEQ)
+			  (if error-p
+			      (error "invalid multibyte(~X)."
+				     (uffi:deref-array
+				      inbuffer :unsigned-byte (current)))
+			      (progn
+				(setf (uffi:deref-array
+				       inbuffer :unsigned-byte (current))
+					  error-value)
+				(self)))
+			  (loop for i from (current)
+			     below from-len
+			     do (vector-push-extend
+				 (aref from-vector i) remain))))))
 	       (self))
-	     (loop for i from 0
-		   below (- to-len
-			    (uffi:deref-pointer outbytesleft :unsigned-int))
-		   do (vector-push-extend
-		       (uffi:deref-array outbuffer :unsigned-byte i)
-		       out)))
+	     (let* ((out-length (- to-len (uffi:deref-pointer outbytesleft :unsigned-int)))
+		    (out (make-array out-length
+			    :element-type (array-element-type from-vector))))
+	       (dotimes (i out-length)
+		 (setf (aref out i) (if string-mode
+					(code-char (uffi:deref-array outbuffer :unsigned-byte i))
+					(uffi:deref-array outbuffer :unsigned-byte i))))
+	       (values out remain)))
 	(progn (uffi:free-foreign-object outbytesleft)
 	       (uffi:free-foreign-object inbytesleft)
 	       (uffi:free-foreign-object out-ptr)
 	       (uffi:free-foreign-object in-ptr)
 	       (uffi:free-foreign-object outbuffer)
-	       (uffi:free-foreign-object inbuffer)))
-      (values out remain))))
+	       (uffi:free-foreign-object inbuffer))))))