(if (eq (funcall selector image x y) t)
(set-color out-image x y (funcall modifier image x y))
(set color out-image x y (get-color image x y)))
lisp and large arrays
Author
Hey,
I am in the process of learning Common Lisp and have run into a problem with using large arrays. For practice I am converting a simple image manipulation library I wrote from C to lisp. I knew that it would most likely run slower in lisp but it seems the garbage collector is being invoked constantly causing the program to pretty much be in a stand still.
I am loading a bitmap and storing the image data in an array:
(setq buffer (make-array image-size :element-type '(unsigned-byte 8)))
The buffer later becomes part of a structure:
(setq image (make-bitmap :width width :height height :buffer buffer))
This will be returned from a function.
Firstly will the buffer be copied when I return the bitmap structure from the loading function? I don't want this to happen.
Part of the library does image filtering. The filtering process works by using two function pointers. One function selects which pixels are to be modified and the other function would actually compute the new color for the pixel.
I am using the same strategy in lisp, e.g. in the filter function:
where modifier and selector are closures.
I think though that during this process the actual array of bytes in image is being constantly copied. During execution of the program I receive hundreds of messages like the following:
; [GC completed with 3,968,536 bytes retained and 11,999,712 bytes freed.]
; [GC will next occur when at least 15,968,536 bytes are in use.]
; [GC threshold exceeded with 15,978,384 bytes in use. Commencing GC.]
; [GC completed with 3,980,840 bytes retained and 11,997,544 bytes freed.]
; [GC will next occur when at least 15,980,840 bytes are in use.]
; [GC threshold exceeded with 15,990,656 bytes in use. Commencing GC.]
I'm not sure why this would be happening though, as if I do this:
(defun foo (some-array) (setf (aref some-array 0) 99))
(setq my-array (make-array 10))
(foo my-array)
my-array now has 99 as it's first element.
What am I missing here?
EDIT: I am using CMUCL
Arrays aren't copied implicitly. My guess would be that you're doing something strange in set-color. Without more code, it's hard to say. Can you post a small program that replicates the problem?
Author
OK, This is set-color
I am hoping I did this correctly. In C, each pixel was a structure of 3 bytes. In Lisp I didn't know if a large array of structures would be very efficient so I did this instead. Maybe not such a good idea.
Here is the bulk of the code that would be causing the problems, my Lisp style is probably bad so I apologize in advance ;)
This is used like this:
(setq image2 (filter image1 (modifier-average) nil))
defun set-color (image j i blue green red) (setf (aref (bitmap-buffer image) (+ (* j 3) (* (bitmap-image-height image) i) 0)) blue) (setf (aref (bitmap-buffer image) (+ (* j 3) (* (bitmap-image-height image) i) 1)) green) (setf (aref (bitmap-buffer image) (+ (* j 3) (* (bitmap-image-height image) i) 2)) red))I am hoping I did this correctly. In C, each pixel was a structure of 3 bytes. In Lisp I didn't know if a large array of structures would be very efficient so I did this instead. Maybe not such a good idea.
Here is the bulk of the code that would be causing the problems, my Lisp style is probably bad so I apologize in advance ;)
(defun filter (image modifier selector) "apply a filter to a bitmap" (let* ((buffer (bitmap-buffer image)) (image-width (bitmap-image-width image)) (image-height (bitmap-image-height image)) (out-image (make-bitmap :buffer (make-array (* image-width image-height 3) :element-type '(unsigned-byte 8) :fill-pointer nil) :image-width image-width :image-height image-height))) (loop for j from 0 to image-width by 1 do (loop for i from 0 to image-height by 1 do (if (and (or (eq selector nil) (funcall selector buffer j i)) (not (eq modifier nil))) (multiple-value-bind (b g r) (funcall modifier image j i) (set-color out-image j i b g r)) (Multiple-value-bind (b g r) (get-color image j i) (set-color out-image j i b g r))))) out-image)) ; return (defun modifier-average () "blur pixel modifier" (lambda (image j i) (let ((buffer (bitmap-buffer image)) (image-width (bitmap-image-width image)) (image-height (bitmap-image-height image)) (blue 0) (green 0) (red 0) (count 0)) (loop for y from (if (/= i 0) (1- i) i) to (if (/= i (1- image-height)) (1+ image-height) i) by 1 do (loop for x from (if (/= j 0) (1- j) j) to (if (/= j (1- image-width)) (1+ image-width) j) by 1 do (multiple-value-bind (b g r) (get-color image j i) (setq blue (+ blue b)) (setq green (+ green g)) (setq red (+ red r))) (setq count (1+ count)))) (setq blue (/ blue count)) (setq green (/ green count)) (setq red (/ red count)) (values (floor blue) (floor green) (floor red)))))This is used like this:
(setq image2 (filter image1 (modifier-average) nil))
(loop for y from (if (/= i 0) (1- i) i) to (if (/= i (1- image-height)) (1+ image-height) i) by 1 do (loop for x from (if (/= j 0) (1- j) j) to (if (/= j (1- image-width)) (1+ image-width) j) by 1 doThis topic is closed to new replies.
Advertisement
Popular Topics
Advertisement
