Whacking down memory usage of CLSQL-SYS::MAP-QUERY-FOR-EFFECT

> Interesting hack. The memory savings is nice.
> 
> It seems like a better place to optimize is in database-store-next-row
> from sql/generic-odbc.lisp. The LIST parameter in that function can
> then be passed to fetch-row-fn as a new parameter. When that parameter
> is non-nil, then fetch-row-fn can store the columns in that parameter
> rather than consing a new list.
> 
> Kevin
> 
> On Jul 10, 2010, at 12:52 PM, Jason H wrote:
> 
>> Hi,
>> 
>> A few days ago, I posted a message about CLSQL:MAP-QUERY using more memory
>> than CLSQL:QUERY.  After poking around a bit deeper in the source code,
>> I came up with a hack to greatly reduce the amount of memory used by
>> (CLSQL:MAP-QUERY NIL ...).  With this hack, the profile report of the
>> following 2 test functions:
>> 
>> (defun test-1 ()
>> (clsql:map-query nil
>>     	           #'identity
>> 		   (clsql:query "select c1, c2, c3, c4, c5, c6, c7 from Cells")))
>> 
>> (defun test-2 ()
>> (clsql:query "select c1, c2, c3, c4, c5, c6, c7 from Cells") )
>> 
>> is
>> 
>> seconds  |    consed   | calls |  sec/call  |  name
>> ---------------------------------------------------------
>>   46.778 | 147,860,728 |     1 |  46.777996 | TEST-2
>>   44.614 |  14,768,136 |     1 |  44.613995 | TEST-1
>> 
>> 
>> The old profile report without this hack was:
>> 
>> seconds  |    consed   | calls |  sec/call  |  name
>> ---------------------------------------------------------
>>   46.957 | 147,875,120 |     1 |  46.957000 | TEST-2
>>   44.244 | 161,921,920 |     1 |  44.244000 | TEST-1
>> 
>> 
>> The profiling runs were done with the win32 version of sbcl 1.0.37.12.
>> The hack is attached at the end of this email and is for the ODBC back-end
>> of clsql-5.0.2.
>> 
>> Best,
>> 
>> Jason
>> 
>> ;;-------------------------------------------------------------------------------------------------------------
>> 
>> (in-package :clsql-sys)
>> 
>> ;; new hack
>> (defvar *map-query-for-effect-row*)
>> 
>> ;; replace the old MAP-QUERY-FOR-EFFECT.
>> (defun map-query-for-effect (function query-expression database result-types)
>> (multiple-value-bind (result-set columns)
>>     (database-query-result-set query-expression database :full-set nil
>>                                :result-types result-types)
>>   (let ((flatp (and (= columns 1)
>>                     (typep query-expression 'sql-query)
>>                     (slot-value query-expression 'flatp))))
>>     (when result-set
>>       (unwind-protect
>> 	     (let ((*map-query-for-effect-row* (make-list columns)))
>> 	       (do ((row (make-list columns)))
>> 		   ((not (database-store-next-row result-set database row))
>> 		    nil)
>> 		 (if flatp
>> 		     (apply function row)
>> 		     (funcall function row))))
>>         (database-dump-result-set result-set database))))))
>> 
>> (in-package :odbc-dbi)
>> 
>> ;; new hack adapted from DB-FETCH-QUERY-RESULTS.
>> (defun db-fetch-single-row (query)
>> (declare (type odbc-query query)
>> 	   (special clsql-sys::*map-query-for-effect-row*))
>> (when (query-active-p query)
>>   (with-slots (column-data-ptrs column-c-types column-sql-types
>>                column-out-len-ptrs column-precisions hstmt
>> computed-result-types)
>>       query
>>     (let ((cols-fetched 0))
>> 	(unless (= (%sql-fetch hstmt) odbc::$SQL_NO_DATA_FOUND)
>> 	  (loop for result-type across computed-result-types
>> 	     for data-ptr across column-data-ptrs
>> 	     for c-type across column-c-types
>> 	     for sql-type across column-sql-types
>> 	     for out-len-ptr across column-out-len-ptrs
>> 	     for precision across column-precisions
>> 	     for j from 0    ; column count is zero based in lisp
>> 	     for rest on clsql-sys::*map-query-for-effect-row*
>> 	     do
>> 	       (setf (car rest)
>> 		     (cond ((< 0 precision (query-width query))
>> 			    (read-data data-ptr c-type sql-type out-len-ptr result-type))
>> 			   ((zerop (get-cast-long out-len-ptr))
>> 			    nil)
>> 			   (t
>> 			    (read-data-in-chunks hstmt j data-ptr c-type sql-type
>> 						 out-len-ptr result-type))))
>> 	       (incf cols-fetched)))
>> 	(values clsql-sys::*map-query-for-effect-row* query cols-fetched)))))
>> 
>> ;; replace the old FETCH-ROW.
>> (defun fetch-row (query &optional (eof-errorp t) eof-value)
>> (multiple-value-bind (row query count) (db-fetch-single-row query)
>>   (cond
>>    ((zerop count)
>>     (close-query query)
>>     (when eof-errorp
>>       (error 'clsql:sql-database-data-error
>>              :message "ODBC: Ran out of data in fetch-row"))
>>     eof-value)
>>    (t
>>     row))))
>> _______________________________________________
>> CLSQL mailing list
>> [email protected]
>> http://lists.b9.com/cgi-bin/mailman/listinfo/clsql
>> 
>