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

[bknr at bknr.net]

Author: hhubner
Date: 2006-10-21 11:32:24 -0400 (Sat, 21 Oct 2006)
New Revision: 2021

Modified:
   branches/xml-class-rework/thirdparty/iconv/iconv.lisp
Log:
Fix memory leak, make it run with current UFFI.


Modified: branches/xml-class-rework/thirdparty/iconv/iconv.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/iconv/iconv.lisp	2006-10-21 13:34:15 UTC (rev 2020)
+++ branches/xml-class-rework/thirdparty/iconv/iconv.lisp	2006-10-21 15:32:24 UTC (rev 2021)
@@ -23,23 +23,24 @@
 (uffi:def-constant EINVAL 22)           ;imcomplete multibyte
 (uffi:def-constant E2BIG 7)             ;not enough outbuf
 
-(uffi:def-foreign-type  iconv-t '(* :void))
+(uffi:def-foreign-type char-ptr (* :unsigned-char))
+(uffi:def-foreign-type iconv-t :pointer-void)
 
 (uffi:def-function ("iconv_open" iconv-open)
     ((tocode :cstring)
      (fromcode :cstring))
-  :returning iconv-t)
+  :returning 'iconv-t)
 
 (uffi:def-function ("iconv_close" iconv-close)
-    ((cd iconv-t))
+    ((cd 'iconv-t))
   :returning :int)
 
 (uffi:def-function ("iconv" %iconv)
-    ((cd iconv-t)
-     (inbuf (* :unsigned-long))
-     (inbytesleft (* :unsigned-int))
-     (outbuf (* :unsigned-long))
-     (outbytesleft (* :unsigned-int)))
+    ((cd 'iconv-t)
+     (inbuf (* char-ptr))
+     (inbytesleft (* :unsigned-long))
+     (outbuf (* char-ptr))
+     (outbytesleft (* :unsigned-long)))
   :returning :unsigned-int)
 
 (defmacro with-iconv-cd ((cd from to) &body body)
@@ -64,30 +65,29 @@
 			       :element-type '(unsigned-byte 8)
 			       :fill-pointer 0
 			       :adjustable t))
-	   (inbuffer (uffi:allocate-foreign-object :unsigned-byte from-len))
-	   (outbuffer (uffi:allocate-foreign-object :unsigned-byte to-len))
-	   (in-ptr (uffi:allocate-foreign-object :unsigned-long))
-	   (out-ptr (uffi:allocate-foreign-object :unsigned-long))
+	   (inbuffer (uffi:allocate-foreign-string from-len :unsigned t))
+	   (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)))
       (unwind-protect
 	   (progn
 	     (loop for i from 0 below from-len
-		   do (setf (uffi:deref-array inbuffer :unsigned-byte i)
+		   do (setf (uffi:deref-array inbuffer :unsigned-char i)
 			    (aref from-vector i)))
-	     (setf (uffi:deref-pointer in-ptr :unsigned-long)
-		   (uffi:pointer-address inbuffer)
-		   (uffi:deref-pointer out-ptr :unsigned-long)
-		   (uffi:pointer-address outbuffer)
+	     (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 ()
-			(if (= (%iconv cd in-ptr inbytesleft out-ptr
-				       outbytesleft)
-			       #xffffffff)
+			(when (= (%iconv cd
+					 in-ptr inbytesleft
+					 out-ptr outbytesleft)
+				 #xffffffff)
 			    (if (= (get-errno) EILSEQ)
 				(if error-p
 				    (error "invalid multibyte(~X)."
@@ -99,9 +99,9 @@
 					    error-value)
 				      (self)))
 				(loop for i from (current)
-				      below from-len
-				      do (vector-push-extend
-					  (aref from-vector i) remain))))))
+				   below from-len
+				   do (vector-push-extend
+				       (aref from-vector i) remain))))))
 	       (self))
 	     (loop for i from 0
 		   below (- to-len
@@ -111,6 +111,8 @@
 		       out)))
 	(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))))