Re: patch: improve oracle performance on sbcl and cmucl
James Bielman <[email protected]> Sun, 13 Nov 2005 00:21:04 -0800
| Newsgroups | gmane.lisp.clsql.devel |
|---|---|
| Organization | Hayton Systems, Inc. |
| Message-ID | <[email protected]> |
Sorry to reply to myself again, but right after I sent the patch
I realized the declarations that needed to be added to speed it up
even more.
Here's an updated version of the patch. It's now within spitting
distance of OpenMCL and actually beats LispWorks! :-)
(SBCL):
* (time (length (clsql:query "select object_name from all_objects")))
Evaluation took:
21.875 seconds of real time
0.318952 seconds of user run time
0.017998 seconds of system run time
0 page faults and
3,073,208 bytes consed.
39031
(OpenMCL):
? (time (length (clsql:query "select object_name from all_objects")))
(LENGTH (CLSQL-SYS:QUERY "select object_name from all_objects")) took
21,890 milliseconds (21.890 seconds) to run.
Of that, 333 milliseconds (0.333 seconds) were spent in user mode
78 milliseconds (0.078 seconds) were spent in system mode
21,479 milliseconds (21.479 seconds) were spent executing other
OS processes.
40 milliseconds (0.040 seconds) was spent in GC.
2,538,656 bytes of memory allocated.
39031
(LispWorks):
CL-USER 3 > (time (length (clsql:query "select object_name from
all_objects")))
Timing the evaluation of (LENGTH (CLSQL-SYS:QUERY "select object_name
from all_o
; Loading fasl
file /usr/local/lib/LispWorks/lib/4-3-0-0/modules/util/callcoun.u
user time = 1.374
system time = 0.018
Elapsed time = 0:00:24
Allocation = 4458536 bytes standard / 5160804 bytes conses
0 Page faults
Calls to %EVAL 35
39031
James
_______________________________________________
CLSQL-Devel mailing list
[email protected]
http://lists.b9.com/mailman/listinfo/clsql-devel
clsql-oracle-performance.diff
(text/x-patch, 6.5 KB)
diff -rN -u old-clsql-devel/db-oracle/oracle-api.lisp new-clsql-devel/db-oracle/oracle-api.lisp
--- old-clsql-devel/db-oracle/oracle-api.lisp 2005-11-12 23:17:53.000000000 -0800
+++ new-clsql-devel/db-oracle/oracle-api.lisp 2005-11-12 23:18:02.000000000 -0800
@@ -53,36 +53,18 @@
;;; unless NULLS-OK is set.
(defmacro def-oci-routine ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
- (let ((ll (mapcar (lambda (x) (declare (ignore x)) (gensym)) c-parms)))
- `(let ((%lisp-oci-fn (uffi:def-function
- (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
- ,c-parms
- :returning ,c-return)))
- (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
- (let ((result (funcall %lisp-oci-fn ,@ll)))
- (case result
- (#.+oci-success+
- +oci-success+)
- (#.+oci-error+
- (handle-oci-error :database database :nulls-ok nulls-ok))
- (#.+oci-no-data+
- (error 'sql-database-error :message "OCI No Data Found"))
- (#.+oci-success-with-info+
- (error 'sql-database-error :message "internal error: unexpected +oci-success-with-info"))
- (#.+oci-invalid-handle+
- (error 'sql-database-error :message "OCI Invalid Handle"))
- (#.+oci-need-data+
- (error 'sql-database-error :message "OCI Need Data"))
- (#.+oci-still-executing+
- (error 'sql-temporary-error :message "OCI Still Executing"))
- (#.+oci-continue+
- (error 'sql-database-error :message "OCI Continue"))
- (1804
- (error 'sql-database-error :message "Check ORACLE_HOME and NLS settings."))
- (t
- (error 'sql-database-error
- :message
- (format nil "OCI unknown error, code=~A" result)))))))))
+ (let ((ll (mapcar (lambda (x) (declare (ignore x)) (gensym)) c-parms))
+ (c-oci-fn (intern (concatenate 'string "%" (symbol-name lisp-oci-fn)))))
+ `(progn
+ (declaim (inline ,c-oci-fn ,lisp-oci-fn))
+ (uffi:def-function (,c-oci-symbol ,c-oci-fn)
+ ,c-parms
+ :returning ,c-return)
+ (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
+ (let ((result (,c-oci-fn ,@ll)))
+ (if (= result #.+oci-success+)
+ +oci-success+
+ (handle-oci-result result database nulls-ok)))))))
(defmacro def-raw-oci-routine
@@ -162,6 +144,7 @@
(p0 :pointer-void) ; svc
(p1 :pointer-void)) ; err
+(declaim (inline oci-error-get))
(uffi:def-function ("OCIErrorGet" oci-error-get)
((handlp :pointer-void)
(recordno ub4)
diff -rN -u old-clsql-devel/db-oracle/oracle-sql.lisp new-clsql-devel/db-oracle/oracle-sql.lisp
--- old-clsql-devel/db-oracle/oracle-sql.lisp 2005-11-12 23:17:53.000000000 -0800
+++ new-clsql-devel/db-oracle/oracle-sql.lisp 2005-11-13 00:18:29.000000000 -0800
@@ -120,6 +120,31 @@
:documentation
"The major version number of the Oracle server, should be 8, 9, or 10")))
+;;; Handle a non-successful result from an OCI function.
+(defun handle-oci-result (result database nulls-ok)
+ (case result
+ (#.+oci-success+
+ +oci-success+)
+ (#.+oci-error+
+ (handle-oci-error :database database :nulls-ok nulls-ok))
+ (#.+oci-no-data+
+ (error 'sql-database-error :message "OCI No Data Found"))
+ (#.+oci-success-with-info+
+ (error 'sql-database-error :message "internal error: unexpected +oci-success-with-info"))
+ (#.+oci-invalid-handle+
+ (error 'sql-database-error :message "OCI Invalid Handle"))
+ (#.+oci-need-data+
+ (error 'sql-database-error :message "OCI Need Data"))
+ (#.+oci-still-executing+
+ (error 'sql-temporary-error :message "OCI Still Executing"))
+ (#.+oci-continue+
+ (error 'sql-database-error :message "OCI Continue"))
+ (1804
+ (error 'sql-database-error :message "Check ORACLE_HOME and NLS settings."))
+ (t
+ (error 'sql-database-error
+ :message
+ (format nil "OCI unknown error, code=~A" result)))))
;;; Handle the messy case of return code=+oci-error+, querying the
;;; system for subcodes and reporting them as appropriate. ERRHP and
@@ -129,8 +154,8 @@
(cond
(database
(with-slots (errhp) database
- (let ((errcode (uffi:allocate-foreign-object 'sb4))
- (errbuf (uffi:allocate-foreign-string #.+errbuf-len+)))
+ (uffi:with-foreign-objects ((errcode 'sb4)
+ (errbuf '(:array :unsigned-char #.+errbuf-len+)))
;; ensure errbuf empty string
(setf (uffi:deref-array errbuf '(:array :unsigned-char) 0)
(uffi:ensure-char-storable (code-char 0)))
@@ -144,8 +169,6 @@
+errbuf-len+ +oci-htype-error+))
(let ((subcode (uffi:deref-pointer errcode 'sb4))
(errstr (uffi:convert-from-foreign-string errbuf)))
- (uffi:free-foreign-object errcode)
- (uffi:free-foreign-object errbuf)
(unless (and nulls-ok (= subcode +null-value-returned+))
(error 'sql-database-error
:database database
@@ -341,7 +364,9 @@
;; STREAM which has no more data, and QC is not a STREAM, we signal
;; DBI-ERROR instead.
-(uffi:def-type short-array (:array :short))
+(uffi:def-type short-array (:array :short nil))
+(uffi:def-type int-array (:array :int nil))
+(uffi:def-type double-array (:array :double nil))
(uffi:def-type int-pointer (* :int))
(uffi:def-type double-pointer (* :double))
@@ -378,7 +403,7 @@
(defun fetch-row (qc &optional (eof-errorp t) eof-value)
- ;;(declare (optimize (speed 3)))
+ (declare (optimize (speed 3)))
(cond ((zerop (qc-n-from-oci qc))
(if eof-errorp
(error 'sql-database-error :message
@@ -398,17 +423,21 @@
(value
(let* ((arb (foreign-resource-buffer (cd-indicators cd)))
(indicator (uffi:deref-array arb '(:array :short) irow)))
- ;;(declare (type short-array arb))
+ (declare (type short-array arb))
(unless (= indicator -1)
(ecase (cd-oci-data-type cd)
(#.SQLT-STR
(deref-oci-string b irow (cd-sizeof cd)))
(#.SQLT-FLT
- (uffi:deref-array b '(:array :double) irow))
+ (locally
+ (declare (type double-array b))
+ (uffi:deref-array b '(:array :double) irow)))
(#.SQLT-INT
(ecase (cd-sizeof cd)
(4
- (uffi:deref-array b '(:array :int) irow))))
+ (locally
+ (declare (type int-array b))
+ (uffi:deref-array b '(:array :int) irow)))))
(#.SQLT-DATE
(deref-oci-string b irow (cd-sizeof cd))))))))
(when (and (eq :string (cd-result-type cd))