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

bknr at bknr.net bknr at bknr.net
Sun Oct 22 16:41:02 UTC 2006


Author: hhubner
Date: 2006-10-22 12:40:58 -0400 (Sun, 22 Oct 2006)
New Revision: 2024

Modified:
   branches/xml-class-rework/thirdparty/iconv/iconv.asd
   branches/xml-class-rework/thirdparty/iconv/iconv.lisp
Log:
converted to use cffi-uffi-compat


Modified: branches/xml-class-rework/thirdparty/iconv/iconv.asd
===================================================================
--- branches/xml-class-rework/thirdparty/iconv/iconv.asd	2006-10-22 15:57:04 UTC (rev 2023)
+++ branches/xml-class-rework/thirdparty/iconv/iconv.asd	2006-10-22 16:40:58 UTC (rev 2024)
@@ -4,4 +4,4 @@
   :author "Yoshinori Tahara <read.eval.print at gmail.com>"
   :version "0.2"
   :components ((:file "iconv"))
-  :depends-on (uffi))
+  :depends-on (cffi-uffi-compat))

Modified: branches/xml-class-rework/thirdparty/iconv/iconv.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/iconv/iconv.lisp	2006-10-22 15:57:04 UTC (rev 2023)
+++ branches/xml-class-rework/thirdparty/iconv/iconv.lisp	2006-10-22 16:40:58 UTC (rev 2024)
@@ -1,16 +1,19 @@
 (defpackage :koto.iconv
   (:nicknames :iconv)
-  (:use :cl :uffi)
+  (:use :cl :cffi-uffi-compat)
   (:export
    :iconv
    :EILSEQ
    :EINVAL
    :E2BIG))
-   
+
 (in-package :iconv)
 
+(cffi-uffi-compat:load-foreign-library "/usr/lib/libc.so")
+(cffi-uffi-compat:load-foreign-library "/usr/local/lib/libiconv.so")
+   
 #-:sbcl
-(uffi:def-foreign-var ("errno" errno) :int "iconv")
+(cffi-uffi-compat:def-foreign-var ("errno" errno) :int "iconv")
 
 (defun get-errno ()
   #-:sbcl
@@ -19,71 +22,58 @@
   (sb-alien:get-errno)
   )
 
-(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
+(cffi-uffi-compat:def-constant EILSEQ #+freebsd 86 #-freebsd 84)           ;invalid multibyte
+(cffi-uffi-compat:def-constant EINVAL 22)           ;imcomplete multibyte
+(cffi-uffi-compat:def-constant E2BIG 7)             ;not enough outbuf
 
-(uffi:def-foreign-type char-ptr (* :unsigned-char))
-(uffi:def-foreign-type iconv-t :pointer-void)
+(cffi-uffi-compat:def-foreign-type uchar-ptr (* :unsigned-char))
+(cffi-uffi-compat:def-foreign-type iconv-t :pointer-void)
 
-(uffi:def-function ("iconv_open" iconv-open)
+(cffi-uffi-compat:def-function ("iconv_open" iconv-open)
     ((tocode :cstring)
      (fromcode :cstring))
   :returning 'iconv-t)
 
-(uffi:def-function ("iconv_close" iconv-close)
+(cffi-uffi-compat:def-function ("iconv_close" iconv-close)
     ((cd 'iconv-t))
   :returning :int)
 
-(uffi:def-function ("iconv" %iconv)
+(cffi-uffi-compat:def-function ("iconv" %iconv)
     ((cd 'iconv-t)
-     (inbuf (* char-ptr))
+     (inbuf (* uchar-ptr))
      (inbytesleft (* :unsigned-long))
-     (outbuf (* char-ptr))
+     (outbuf (* uchar-ptr))
      (outbytesleft (* :unsigned-long)))
   :returning :unsigned-int)
 
 (defmacro with-iconv-cd ((cd from to) &body body)
-  `(uffi:with-cstrings ((fromcode ,from)
+  `(cffi-uffi-compat:with-cstrings ((fromcode ,from)
 			(tocode ,to))
     (let ((,cd (iconv-open tocode fromcode)))
       (unwind-protect
 	   (progn , at body)
 	(iconv-close ,cd)))))
 
-(defun iconv (from-code to-code from-vector
+(defun iconv (from-code to-code from-string
 	      &optional error-p (error-value #.(char-code #\?)))
   (with-iconv-cd (cd from-code to-code)
-    (let* ((from-len (length from-vector))
+    (let* ((from-len (length from-string))
 	   (to-len (* from-len 2))
-	   (remain (make-array 3
-			       :element-type '(unsigned-byte 8)
-			       :fill-pointer 0
-			       :adjustable 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))
-	   (inbytesleft (uffi:allocate-foreign-object :unsigned-int))
-	   (outbytesleft (uffi:allocate-foreign-object :unsigned-int)))
+	   (inbuffer (cffi-uffi-compat:convert-to-foreign-string from-string))
+	   (outbuffer (cffi-uffi-compat:allocate-foreign-string to-len :unsigned t))
+	   (in-ptr (cffi-uffi-compat:allocate-foreign-object 'uchar-ptr))
+	   (out-ptr (cffi-uffi-compat:allocate-foreign-object 'uchar-ptr))
+	   (inbytesleft (cffi-uffi-compat:allocate-foreign-object :unsigned-int))
+	   (outbytesleft (cffi-uffi-compat:allocate-foreign-object :unsigned-int)))
       (unwind-protect
 	   (progn
-	     (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)
+	     (setf (cffi-uffi-compat:deref-pointer in-ptr 'uchar-ptr) inbuffer
+		   (cffi-uffi-compat:deref-pointer out-ptr 'uchar-ptr) outbuffer
+		   (cffi-uffi-compat:deref-pointer inbytesleft :unsigned-int) from-len
+		   (cffi-uffi-compat:deref-pointer outbytesleft :unsigned-int) to-len)
 	     (labels
 		 ((current ()
-		    (- from-len (uffi:deref-pointer
-				 inbytesleft :unsigned-int)))
+		    (- from-len (cffi-uffi-compat:deref-pointer inbytesleft :unsigned-int)))
 		  (self ()
 		    (when (= (%iconv cd
 				     in-ptr inbytesleft
@@ -92,29 +82,17 @@
 		      (if (= (get-errno) EILSEQ)
 			  (if error-p
 			      (error "invalid multibyte(~X)."
-				     (uffi:deref-array
-				      inbuffer :unsigned-byte (current)))
+				     (cffi-uffi-compat:deref-array inbuffer (cffi-uffi-compat::convert-uffi-type :unsigned-byte) (current)))
 			      (progn
-				(setf (uffi:deref-array
-				       inbuffer :unsigned-byte (current))
-					  error-value)
+				(setf (cffi-uffi-compat:deref-array inbuffer (cffi-uffi-compat::convert-uffi-type :unsigned-byte) (current))
+				      error-value)
 				(self)))
-			  (loop for i from (current)
-			     below from-len
-			     do (vector-push-extend
-				 (aref from-vector i) remain))))))
+			  (error "unexpected iconv error ~A" (get-errno))))))
 	       (self))
-	     (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))))))
+	     (cffi-uffi-compat:convert-from-foreign-string outbuffer :length (- to-len (cffi-uffi-compat:deref-pointer outbytesleft :unsigned-int))))
+	(cffi-uffi-compat:free-foreign-object outbytesleft)
+	(cffi-uffi-compat:free-foreign-object inbytesleft)
+	(cffi-uffi-compat:free-foreign-object out-ptr)
+	(cffi-uffi-compat:free-foreign-object in-ptr)
+	(cffi-uffi-compat:free-foreign-object outbuffer)
+	(cffi-uffi-compat:free-foreign-object inbuffer)))))




More information about the Bknr-cvs mailing list