Index: 64-bit/src/odbc/column.lisp =================================================================== --- 64-bit/src/odbc/column.lisp (revision 64-bit,1) +++ 64-bit/src/odbc/column.lisp (revision 64-bit,4) @@ -77,5 +77,5 @@ column ;(setf value-ptr (cffi:foreign-alloc :long buffer-length)) - (setf ind-ptr (cffi:foreign-alloc :long)) + (setf ind-ptr (cffi:foreign-alloc 'sql-len)) (%bind-column hstmt pos @@ -112,10 +112,11 @@ (cffi:foreign-alloc :char :count (slot-value column 'buffer-length)))) +;; dso+ (defmethod get-column-value ((column string-column)) - (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) :long))) + (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) 'sql-len))) (if (= len $SQL_NULL_DATA) - nil - (progn - (get-string (slot-value column 'value-ptr) len))))) + nil + (progn + (get-string (slot-value column 'value-ptr) len))))) ;;;------------------- ;;; unicode-string @@ -146,12 +147,13 @@ (cffi:foreign-alloc :uchar :count (slot-value column 'buffer-length)))) +;; dso+ (defmethod get-column-value ((column unicode-string-column)) - (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) :long))) + (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) 'sql-len))) ;; len is size in bytes, not characters! (if (= len $SQL_NULL_DATA) - nil - (progn -; (break) - (wchar-bytes-to-string (get-byte-vector (slot-value column 'value-ptr) len)))))) + nil + (progn + ;; (break) + (wchar-bytes-to-string (get-byte-vector (slot-value column 'value-ptr) len)))))) @@ -166,15 +168,16 @@ (declare (ignore args)) (setf (slot-value column 'c-type) $SQL_C_SLONG) - (setf (slot-value column 'buffer-length) - (cffi:foreign-type-size :long)) - (setf (slot-value column 'value-ptr) - (cffi:foreign-alloc :long))) - - + (setf (slot-value column 'buffer-length) + (cffi:foreign-type-size 'sql-integer)) + (setf (slot-value column 'value-ptr) + (cffi:foreign-alloc 'sql-integer))) + + +;; dso+ (defmethod get-column-value ((column integer-column)) - (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) :long))) + (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) 'sql-len))) (if (= len $SQL_NULL_DATA) - nil - (cffi:mem-ref (slot-value column 'value-ptr) :long)))) + nil + (cffi:mem-ref (slot-value column 'value-ptr) 'sql-integer)))) @@ -185,4 +188,5 @@ (defclass double-column (column) ()) +;; dso+ (defmethod initialize-column ((column double-column) args) (declare (ignore args)) @@ -192,12 +196,13 @@ (setf (slot-value column 'value-ptr) (cffi:foreign-alloc :double))) +;; dso+ (defmethod get-column-value ((column double-column)) - ;(%get-long (slot-value column 'ind-ptr)) - ;(%get-double-float (slot-value column 'value-ptr)) - (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) :long))) - (if (= len $SQL_NULL_DATA) - nil - (progn - (cffi:mem-ref (slot-value column 'value-ptr) :double))))) + ;; (%get-long (slot-value column 'ind-ptr)) + ;; (%get-double-float (slot-value column 'value-ptr)) + (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) 'sql-len))) + (if (= len $SQL_NULL_DATA) + nil + (progn + (cffi:mem-ref (slot-value column 'value-ptr) :double))))) ;;;------------------------ @@ -206,4 +211,5 @@ (defclass date-column (column) ()) +;; dso+ (defmethod initialize-column ((column date-column) args) (declare (ignore args)) @@ -213,10 +219,11 @@ (setf (slot-value column 'value-ptr) (cffi:foreign-alloc :uchar :count 32))) +;; dso+ (defmethod get-column-value ((column date-column)) - (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) :long))) + (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) 'sql-len))) (if (= len $SQL_NULL_DATA) - nil - (funcall *universal-time-to-date-dataype* - (timestamp-to-universal-time (slot-value column 'value-ptr)))))) + nil + (funcall *universal-time-to-date-dataype* + (timestamp-to-universal-time (slot-value column 'value-ptr)))))) ;;;-------------------------- @@ -251,4 +258,5 @@ (defclass bigint-column (column) ()) +;; dso+ (defmethod initialize-column ((column bigint-column) args) (declare (ignore args)) @@ -259,9 +267,10 @@ (setf (slot-value column 'value-ptr) (cffi:foreign-alloc :uchar :count 25))) +;; dso+ (defmethod get-column-value ((column bigint-column)) - (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) :long))) - (if (= len $SQL_NULL_DATA) - nil - (parse-integer (get-string (slot-value column 'value-ptr) len))))) + (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) 'sql-len))) + (if (= len $SQL_NULL_DATA) + nil + (parse-integer (get-string (slot-value column 'value-ptr) len))))) ;;;---------------------------- @@ -403,4 +412,5 @@ ;; fetch data via SQlGetData ;; ------------------------------ +;; dso+ (defun get-character-data (hstmt position value-ptr buffer-length ind-ptr) ;; local error handling, we can not use the general error handling @@ -423,22 +433,23 @@ ind-ptr))) (handle-error sqlret) - (let ((len (cffi:mem-ref ind-ptr :long))) - ;(break) + (let ((len (cffi:mem-ref ind-ptr 'sql-len))) + ;;(break) (cond ((= len $sql_null_data) nil) - ;; character data has a 0 byte appended, the length does not include it - ;; but it is taken into account when placing the data into the buffer + ;; character data has a 0 byte appended, the length does not + ;; include it but it is taken into account when placing the + ;; data into the buffer ((and (/= len $SQL_NO_TOTAL) (<= (+ 1 len) buffer-length)) - ;; the data fits into the buffer, return it - (get-string value-ptr len)) + ;; the data fits into the buffer, return it + (get-string value-ptr len)) ;; we have to fetch the data in several steps (t - (let ((sos (make-string-output-stream))) - (loop - (if (and (= sqlret $SQL_SUCCESS_WITH_INFO) - (equal (sql-state nil nil hstmt) - "01004")) + (let ((sos (make-string-output-stream))) + (loop + (if (and (= sqlret $SQL_SUCCESS_WITH_INFO) + (equal (sql-state nil nil hstmt) + "01004")) ;; an 0 byte is append to a string, ignore that @@ -446,20 +457,21 @@ (write-string str sos) (setf sqlret (%sql-get-data-raw hstmt - position - $SQL_C_CHAR - value-ptr - buffer-length - ind-ptr)) + position + $SQL_C_CHAR + value-ptr + buffer-length + ind-ptr)) (handle-error sqlret)) (return))) - ;; fetch the last part of the data - (setf len (cffi:mem-ref ind-ptr :long)) - (let ((str (get-string value-ptr len))) - (write-string str sos)) - (get-output-stream-string sos)))))))) + ;; fetch the last part of the data + (setf len (cffi:mem-ref ind-ptr 'sql-len)) + (let ((str (get-string value-ptr len))) + (write-string str sos)) + (get-output-stream-string sos)))))))) ;;; the version for 16bit unicode -(defun get-unicode-character-data (hstmt position value-ptr buffer-length ind-ptr) +(defun get-unicode-character-data (hstmt position value-ptr buffer-length + ind-ptr) ;; local error handling, we can not use the general error handling ;; since this resets the sql-state @@ -481,39 +493,42 @@ ind-ptr))) (handle-error sqlret) - (let ((len (cffi:mem-ref ind-ptr :long))) + (let ((len (cffi:mem-ref ind-ptr 'sql-len))) (cond ((= len $sql_null_data) nil) - ;; character data has a 0 byte appended, the length does not include it - ;; but it is taken into account when placing the data into the buffer + ;; character data has a 0 byte appended, the length does not + ;; include it but it is taken into account when placing the + ;; data into the buffer ((and (/= len $SQL_NO_TOTAL) (<= (+ 2 len) buffer-length)) - ;; the data fits into the buffer, return it - (%get-unicode-string value-ptr len)) + ;; the data fits into the buffer, return it + (%get-unicode-string value-ptr len)) ;; we have to fetch the data in several steps (t - (let ((sos (make-string-output-stream :element-type 'character))) - (loop - (if (and (= sqlret $SQL_SUCCESS_WITH_INFO) - (equal (sql-state nil nil hstmt) - "01004")) + (let ((sos (make-string-output-stream :element-type 'character))) + (loop + (if (and (= sqlret $SQL_SUCCESS_WITH_INFO) + (equal (sql-state nil nil hstmt) + "01004")) ;; an 0 byte is append to a string, ignore that - (let ((str (%get-unicode-string value-ptr (- buffer-length 2)))) + (let ((str + (%get-unicode-string value-ptr (- buffer-length 2)))) (write-string str sos) (setf sqlret (%sql-get-data-raw hstmt - position - $SQL_C_WCHAR - value-ptr - buffer-length - ind-ptr)) + position + $SQL_C_WCHAR + value-ptr + buffer-length + ind-ptr)) (handle-error sqlret)) (return))) - ;; fetch the last part of the data - (setf len (cffi:mem-ref ind-ptr :long)) - (let ((str (%get-unicode-string value-ptr len))) - (write-string str sos)) - (get-output-stream-string sos)))))))) + ;; fetch the last part of the data + (setf len (cffi:mem-ref ind-ptr 'sql-len)) + (let ((str (%get-unicode-string value-ptr len))) + (write-string str sos)) + (get-output-stream-string sos)))))))) +;; dso+ (defun get-binary-data (hstmt position value-ptr buffer-length ind-ptr) ;; local error handling, we can not use the general error handling @@ -530,38 +545,39 @@ (error condition))))) - (let* ((sqlret (%sql-get-data-raw hstmt - position - $SQL_C_BINARY - value-ptr - buffer-length - ind-ptr))) - (handle-error sqlret) - (let ((len (cffi:mem-ref ind-ptr :long))) - (if (= len $sql_null_data) - nil - (let ((res (make-array 0 :element-type '(unsigned-byte 8) :adjustable t)) - (res-len 0)) - (loop - (if (and (= sqlret $SQL_SUCCESS_WITH_INFO) - (equal (sql-state nil nil hstmt) - "01004")) + (let* ((sqlret (%sql-get-data-raw hstmt + position + $SQL_C_BINARY + value-ptr + buffer-length + ind-ptr))) + (handle-error sqlret) + (let ((len (cffi:mem-ref ind-ptr 'sql-len))) + (if (= len $sql_null_data) + nil + (let ((res (make-array 0 + :element-type '(unsigned-byte 8) + :adjustable t)) + (res-len 0)) + (loop + (if (and (= sqlret $SQL_SUCCESS_WITH_INFO) + (equal (sql-state nil nil hstmt) + "01004")) - (let ((vec (get-byte-vector value-ptr buffer-length))) - (setf res (adjust-array res (+ res-len buffer-length))) - (setf (subseq res res-len (+ res-len buffer-length)) vec) - (setf res-len (length res)) - (setf sqlret (%sql-get-data-raw hstmt - position - $SQL_C_BINARY - value-ptr - buffer-length - ind-ptr)) - (handle-error sqlret)) - (return))) + (let ((vec (get-byte-vector value-ptr buffer-length))) + (setf res (adjust-array res (+ res-len buffer-length))) + (setf (subseq res res-len (+ res-len buffer-length)) vec) + (setf res-len (length res)) + (setf sqlret (%sql-get-data-raw hstmt + position + $SQL_C_BINARY + value-ptr + buffer-length + ind-ptr)) + (handle-error sqlret)) + (return))) - (setf len (cffi:mem-ref ind-ptr :long)) - (let ((vec (get-byte-vector value-ptr len))) - (setf res (adjust-array res (+ res-len len))) - (setf (subseq res res-len (+ res-len len)) vec)) - res)))))) - + (setf len (cffi:mem-ref ind-ptr 'sql-len)) + (let ((vec (get-byte-vector value-ptr len))) + (setf res (adjust-array res (+ res-len len))) + (setf (subseq res res-len (+ res-len len)) vec)) + res)))))) Index: 64-bit/src/odbc/odbc-main.lisp =================================================================== --- 64-bit/src/odbc/odbc-main.lisp (revision 64-bit,1) +++ 64-bit/src/odbc/odbc-main.lisp (revision 64-bit,4) @@ -455,12 +455,16 @@ (send-parameter-data param hstmt))))))))) -;; this functions works only, since we store at -;; value-ptr the position of the parameter -(defun sql-param-data-position (hstmt) - (with-temporary-allocations +;; this functions works only, since we store at value-ptr the position +;; of the parameter +;; dso-- +(defun sql-param-data-position (hstmt) + (with-temporary-allocations ((ptr (cffi:foreign-alloc :pointer))) - (let ((res (with-error-handling (:hstmt hstmt) (%sql-param-data hstmt ptr)))) - (values res (if (= res $SQL_NEED_DATA) - (cffi:mem-ref (cffi:mem-ref ptr :pointer) :long )))))) + (let ((res (with-error-handling (:hstmt hstmt) + (%sql-param-data hstmt ptr)))) + (values res (if (= res $SQL_NEED_DATA) + (cffi:mem-ref (cffi:mem-ref ptr :pointer) :int32)))))) + ; TODO: The :int32 above + ; should probably be changed! (defmethod exec-prepared-query ((query prepared-statement) &rest parameters) Index: 64-bit/src/odbc/parameter.lisp =================================================================== --- 64-bit/src/odbc/parameter.lisp (revision 64-bit,3) +++ 64-bit/src/odbc/parameter.lisp (revision 64-bit,4) @@ -56,7 +56,7 @@ ;;;; dso: not so sure about this one and its callers (defun bind-parameter (hstmt pos param) - (setf (slot-value param 'ind-ptr) + (setf (slot-value param 'ind-ptr) (cffi:foreign-alloc 'sql-len)) - (%sql-bind-parameter + (%sql-bind-parameter hstmt pos @@ -97,4 +97,5 @@ ()) +;; dso+ (defmethod initialize-parameter ((param string-parameter) args) (let ((length-of-buffer (or (car args) *default-string-parameter-size*))) @@ -108,21 +109,25 @@ (setf value-ptr (alloc-chars length-of-buffer))))) +;; dso+ (defmethod set-parameter-value ((param string-parameter) value) (cond ((null value) - (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long) - $SQL_NULL_DATA) - (put-string (slot-value param 'value-ptr) "")) - (t - (cffi:lisp-string-to-foreign value (slot-value param 'value-ptr) (1+ (length value))) - (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long) - (length value))))) - + (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) + $SQL_NULL_DATA) + (put-string (slot-value param 'value-ptr) "")) + (t + (cffi:lisp-string-to-foreign value + (slot-value param 'value-ptr) + (1+ (length value))) + (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) + (length value))))) + +;; dso+ (defmethod get-parameter-value ((param string-parameter)) - (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) :long))) + (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len))) (if (= len $SQL_NULL_DATA) - nil - (progn - (get-string (slot-value param 'value-ptr) len))))) + nil + (progn + (get-string (slot-value param 'value-ptr) len))))) ;;------------------------ @@ -132,6 +137,8 @@ ()) +;; dso+ (defmethod initialize-parameter ((param unicode-string-parameter) args) - (let ((length-of-buffer (* 2 (or (car args) *default-string-parameter-size*)))) + (let ((length-of-buffer + (* 2 (or (car args) *default-string-parameter-size*)))) (with-slots (value-type parameter-type buffer-length column-size value-ptr @@ -143,22 +150,24 @@ (setf value-ptr (cffi:foreign-alloc :uint8 :count length-of-buffer))))) +;; dso+ (defmethod set-parameter-value ((param unicode-string-parameter) value) (cond ((null value) - (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long) - $SQL_NULL_DATA) - ;; not necessary - (%put-unicode-string (slot-value param 'value-ptr) "")) - (t - (%put-unicode-string (slot-value param 'value-ptr) value) - (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long) - (* 2 (length value)))))) - + (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) + $SQL_NULL_DATA) + ;; not necessary + (%put-unicode-string (slot-value param 'value-ptr) "")) + (t + (%put-unicode-string (slot-value param 'value-ptr) value) + (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) + (* 2 (length value)))))) + +;; dso+ (defmethod get-parameter-value ((param unicode-string-parameter)) - (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) :long))) + (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len))) (if (= len $SQL_NULL_DATA) - nil - (progn - (%get-unicode-string (slot-value param 'value-ptr) len))))) + nil + (progn + (%get-unicode-string (slot-value param 'value-ptr) len))))) ;;---------------------- @@ -169,4 +178,5 @@ ()) +;; dso+ (defmethod initialize-parameter ((param integer-parameter) args) (assert (not args)) @@ -179,18 +189,18 @@ (defmethod set-parameter-value ((param integer-parameter) value) - (cond + (cond ((null value) - (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long) - $SQL_NULL_DATA)) - (t (setf (cffi:mem-ref (slot-value param 'value-ptr) :long) - value) - (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long) 0)))) + (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) + $SQL_NULL_DATA)) + (t (setf (cffi:mem-ref (slot-value param 'value-ptr) 'sql-integer) + value) + (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 0)))) (defmethod get-parameter-value ((param integer-parameter)) - (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) :long))) + (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len))) (if (= len $SQL_NULL_DATA) - nil - (progn - (cffi:mem-ref (slot-value param 'value-ptr) :long))))) + nil + (progn + (cffi:mem-ref (slot-value param 'value-ptr) 'sql-integer))))) @@ -202,25 +212,28 @@ ()) +;; dso+ (defmethod initialize-parameter ((param double-parameter) args) (assert (not args)) - (with-slots (value-type parameter-type buffer-length value-ptr - ind-ptr) param - (setf value-type $SQL_C_DOUBLE) - (setf parameter-type $SQL_DOUBLE) - (setf buffer-length 8) - (setf value-ptr (cffi:foreign-alloc :double )))) - + (with-slots (value-type parameter-type buffer-length value-ptr + ind-ptr) param + (setf value-type $SQL_C_DOUBLE) + (setf parameter-type $SQL_DOUBLE) + (setf buffer-length 8) + (setf value-ptr (cffi:foreign-alloc :double)))) + +;; dso+ (defmethod set-parameter-value ((param double-parameter) value) - (cond - ((null value) - (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long) - $SQL_NULL_DATA)) - (t - (setf (cffi:mem-ref (slot-value param 'value-ptr) :double) - (coerce value 'double-float)) - (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long) 8)))) - + (cond + ((null value) + (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) + $SQL_NULL_DATA)) + (t + (setf (cffi:mem-ref (slot-value param 'value-ptr) :double) + (coerce value 'double-float)) + (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 8)))) + +;; dso+ (defmethod get-parameter-value ((param double-parameter)) - (if (= (cffi:mem-ref (slot-value param 'ind-ptr) :long) $SQL_NULL_DATA) + (if (= (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) $SQL_NULL_DATA) nil (cffi:mem-ref (slot-value param 'value-ptr) :double))) @@ -243,23 +256,24 @@ (setf value-ptr (cffi:foreign-alloc :uchar :count 24)))) - +;; dso+ (defmethod set-parameter-value ((param date-parameter) value) (if (null value) - (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long) + (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) $SQL_NULL_DATA) - (progn - ;; fixme warum 1? - (setf (cffi:mem-ref (slot-value param 'ind-ptr) :long) 1) - (multiple-value-bind (sec min hour day month year) - (decode-universal-time - (funcall *date-datatype-to-universal-time* value)) - (%put-sql-c-timestamp (slot-value param 'value-ptr) year month day hour min sec 0))))) - + (progn + ;; fixme warum 1? + (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len) 1) + (multiple-value-bind (sec min hour day month year) + (decode-universal-time + (funcall *date-datatype-to-universal-time* value)) + (%put-sql-c-timestamp (slot-value param 'value-ptr) year month day hour min sec 0))))) + +;; dso+ (defmethod get-parameter-value ((param date-parameter)) - (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) :long))) - (if (= len $SQL_NULL_DATA) - nil - (funcall *universal-time-to-date-dataype* - (timestamp-to-universal-time (slot-value param 'value-ptr)))))) + (let ((len (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len))) + (if (= len $SQL_NULL_DATA) + nil + (funcall *universal-time-to-date-dataype* + (timestamp-to-universal-time (slot-value param 'value-ptr))))))