[cl-gd-devel] cl-gd memory leak fix

[Edi Weitz]

Hi!

On Thu, 20 May 2004 21:28:49 +0200 (CEST), Manuel Odendahl <manuel at bl0rg.net> wrote:

> We are using cl-gd in our bknr web framework, and use cl-gd to
> scale, transform and otherwise manipulate images.

Cool, so someone is actually using it... :)

> We had the problem that sometimes cl-gd would quit on us saying it
> could not allocate additional memory, which suggested a memory leak
> somewhere. After some code browsing and testing, I found several
> race conditions in cl-gd, having to do with the use of
> UNWIND-PROTECT, which looked like this:
>
> (let*  ((c-style (allocate-foreign-object :int length)))
>   (unwind-protect (yadayada)
>     (free-foreign-object c-style)))
>
> However, if somehow the stack is unwound just after the call to
> ALLOCATE-FOREIGN-OBJECT, C-STYLE will never get freed. I guess the
> UNWIND-PROTECT code was taken from uffi (specifically from
> with-foreign-object), which has the same problem (but this is
> another story). Anyway, while uffi gets fixed to rewrite the above
> nicely, I have added the WITH-SAFE-ALLOC to util.lisp:
>
> (defmacro with-safe-alloc ((var alloc free) &rest body)
>   `(let (,var)
>     (unwind-protect
>         (progn (setf ,var ,alloc)
>                , at body)
>       (when ,var ,free))))
>
> and sprinkled the code with it (I replaced all occurences of
> UNWIND-PROTECT dealing with memory allocation, and quickly browsed
> the code for other allocation code, but couldn't find any).

OK, I'll add that and make a new release. Actually, I didn't steal
from UFFI but wrote this myself and IIRC I was a little bit uneasy
whether what you're describing above could/would actually happen. I
was like "nah, no way," and it turns out I was wrong... :)

> This seems to fix our problems. On another front, I have added the
> function COLOR-COMPONENTS, which returns a list of the color
> copmonents of a color (we needed this somewhere), and the function
> FIND-COLOR-FROM-IMAGE, which tries to FIND-COLOR a color from a
> source image inside a new image (to copy colors between images).
>
> (defun color-components (color &key (image *default-image*))
>   "Returns the color components of COLOR as a list. The components are in the
> order red, green, blue, alpha."
>   (mapcar #'(lambda (c) (color-component c color :image image))
>          '(:red :green :blue :alpha)))
>
> (defun find-color-from-image (color source-image &key alpha exact hwb
>                              resolve (image *default-image*))
>   "Returns the color in IMAGE corresponding to COLOR in SOURCE-IMAGE.  The
> keyword parameters are passed to FIND-COLOR."
>   (let ((red (color-component :red color :image source-image))
>        (blue (color-component :blue color :image source-image))
>        (green (color-component :green color :image source-image))
>        (alpha (when alpha (color-component :alpha color :image source-image))))
>     (find-color red green blue :alpha alpha :exact exact :hwb hwb
>                :resolve resolve :image image)))
>
> I have made a patch file which I'll attach to the mail, and the
> patched cl-gd directory can be downloaded from
> http://bl0rg.net/~manuel/cl-gd-patched.tar.gz. I have changed
> index.html with documentation for the new functions and a
> documentation for COLOR-COMPONENT, which was referenced but not
> included. I have also added the Makefile we have to produce the .so
> file (FreeBSD, haven't checked it on another platform).

I'll add these too. (After removing the tabs... :)

Thanks again,
Edi.