Hi! On Thu, 20 May 2004 21:28:49 +0200 (CEST), Manuel Odendahl <manuel@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) ,@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.