Optimize odbc::%cstring-to-vector on sbcl if cffi isn't loaded.

[clsql.git] / db-odbc / odbc-api.lisp

diff --git a/db-odbc/odbc-api.lisp b/db-odbc/odbc-api.lisp
index 5d2acf964e88c5b1c25b60a3d2e984e18de3bced..a65f6a0f63662b710e71af34fb30a253b54d7fff 100644 (file)
--- a/db-odbc/odbc-api.lisp
+++ b/db-odbc/odbc-api.lisp
@@ -56,8 +56,15 @@ as possible second argument) to the desired representation of date/time/timestam
 (defun %cstring-into-vector (ptr vector offset size-in-bytes)
   (dotimes (i size-in-bytes)
     (setf (schar vector offset)
-      (ensure-char-character
-       (deref-array ptr '(:array :unsigned-char) i)))
+          (ensure-char-character
+              ;; this is MUCH faster than (sb-alien:deref ptr i) even though
+              ;; sb-alien:deref makes more sense. I snagged this by looking at
+              ;; cffi which we had used previously without this bug
+              #+(and sbcl (not cffi))
+              (sb-sys:sap-ref-8 (sb-alien:alien-sap ptr) i)
+              #-(and sbcl (not cffi))
+              (deref-array ptr '(:array :unsigned-char) i)
+       ))
     (incf offset))
   offset)
 
@@ -673,9 +680,12 @@ as possible second argument) to the desired representation of date/time/timestam
                    (#.$SQL_SMALLINT (get-cast-short data-ptr)) ;; ??
                    (#.$SQL_INTEGER (get-cast-int data-ptr))
                    (#.$SQL_BIGINT (get-cast-big data-ptr))
-                   (#.$SQL_DECIMAL
-                    (let ((*read-base* 10))
-                      (read-from-string (get-cast-foreign-string data-ptr))))
+                   ;; TODO: Change this to read in rationals instead of doubles
+                   ((#.$SQL_DECIMAL #.$SQL_NUMERIC)
+                     (let* ((*read-base* 10)
+                            (*read-default-float-format* 'double-float)
+                            (str (get-cast-foreign-string data-ptr)))
+                       (read-from-string str)))
                    (#.$SQL_BIT (get-cast-byte data-ptr))
                    (t
                     (case c-type
@@ -702,8 +712,7 @@ as possible second argument) to the desired representation of date/time/timestam
                        (get-cast-binary data-ptr out-len *binary-format*))
                       ((#.$SQL_C_SSHORT #.$SQL_C_STINYINT) ; LMH short ints
                        (get-cast-short data-ptr)) ; LMH
-                      (#.$SQL_C_SBIGINT (uffi:allocate-foreign-object #.$ODBC-BIG-TYPE)
-                       (get-cast-short data-ptr))
+                      (#.$SQL_C_SBIGINT (get-cast-big data-ptr))
                       #+ignore
                       (#.$SQL_C_CHAR
                        (code-char (get-cast-short data-ptr)))
@@ -907,26 +916,25 @@ as possible second argument) to the desired representation of date/time/timestam
                                           (let ((*read-base* 10))
                                             (read-from-string str))
                                         str)))
-                    (otherwise
-                    (let ((str)
-                          (offset 0)
-                          (octets (make-array out-len :element-type '(unsigned-byte 8) :initial-element 0)))
-                      (loop
-                         do
-                             (loop for i from 0 to (1- (min out-len +max-precision+))
-                                do (setf (aref octets (+ offset i)) (deref-array data-ptr '(:array :unsigned-byte) i))
-                                finally (incf offset (1- i)))
-                         while
-                           (and (= res $SQL_SUCCESS_WITH_INFO)
-                                (> out-len +max-precision+))
-                         do
-                           (setf res (%sql-get-data hstmt column-nr c-type data-ptr +max-precision+ out-len-ptr)
-                                 out-len (deref-pointer out-len-ptr #.$ODBC-LONG-TYPE)))
-                      (setf str (uffi:octets-to-string octets))
+                   (otherwise
+                    (let ((str (make-string out-len)))
+                      (loop do (if (= c-type #.$SQL_CHAR)
+                                   (setf offset (%cstring-into-vector ;string
+                                                 data-ptr str
+                                                 offset
+                                                 (min out-len (1- +max-precision+))))
+                                   (error 'clsql:sql-database-error :message "wrong type. preliminary."))
+                            while
+                            (and (= res $SQL_SUCCESS_WITH_INFO)
+                                 (> out-len +max-precision+))
+                            do (setf res  (%sql-get-data hstmt column-nr c-type data-ptr
+                                                         +max-precision+ out-len-ptr)
+                                     out-len (deref-pointer out-len-ptr #.$ODBC-LONG-TYPE)))
                       (if (= sql-type $SQL_DECIMAL)
                           (let ((*read-base* 10))
                             (read-from-string str))
                           str))))))
+
     (setf (deref-pointer out-len-ptr #.$ODBC-LONG-TYPE) #.$SQL_NO_TOTAL) ;; reset the out length for the next row
     result))