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))))))