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