X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-oracle%2Foracle-sql.lisp;h=ac8ee155cf97a3cd2665c295e034cf1f87e3ab62;hb=645d2ea7396466b8673e3421b55e45cd327f0195;hp=8ef460229a203916744008f860aa007f7e5b4ed8;hpb=333e8280f2f3438ffd379349bc9746c34cccc159;p=clsql.git diff --git a/db-oracle/oracle-sql.lisp b/db-oracle/oracle-sql.lisp index 8ef4602..ac8ee15 100644 --- a/db-oracle/oracle-sql.lisp +++ b/db-oracle/oracle-sql.lisp @@ -211,6 +211,21 @@ the length of that format.") :unsigned-char)))) (if (string-equal str "NULL") nil str))) +(defun deref-oci-int64 (arrayptr index) + (let ((low32 (uffi:deref-array arrayptr '(:array :unsigned-int) + (+ index index))) + (high32 (uffi:deref-array arrayptr '(:array :unsigned-int) + (+ 1 index index)))) + (make-64-bit-integer high32 low32))) + +(defun deref-oci-int128 (arrayptr index) + (let* ((base (* 4 index)) + (d (uffi:deref-array arrayptr '(:array :unsigned-int) (incf base))) + (c (uffi:deref-array arrayptr '(:array :unsigned-int) (incf base))) + (b (uffi:deref-array arrayptr '(:array :unsigned-int) (incf base))) + (a (uffi:deref-array arrayptr '(:array :unsigned-int) (incf base)))) + (make-128-bit-integer a b c d))) + ;; the OCI library, part Z: no-longer used logic to convert from ;; Oracle's binary date representation to Common Lisp's native date ;; representation @@ -395,7 +410,13 @@ the length of that format.") (#.SQLT-FLT (uffi:deref-array b '(:array :double) irow)) (#.SQLT-INT - (uffi:deref-array b '(:array :int) irow)) + (ecase (cd-sizeof cd) + (4 + (uffi:deref-array b '(:array :int) irow)) + (8 + (deref-oci-int64 b irow)) + (16 + (deref-oci-int128 b irow)))) (#.SQLT-DATE (deref-oci-string b irow (cd-sizeof cd)))))))) (when (and (eq :string (cd-result-type cd)) @@ -626,13 +647,28 @@ the length of that format.") (let ((*scale (uffi:deref-pointer scale :byte)) (*precision (uffi:deref-pointer precision :byte))) - ;; (format t "scale=~d, precision=~d~%" *scale *precision) + ;;(format t "scale=~d, precision=~d~%" *scale *precision) (cond - ((or (and (zerop *scale) (not (zerop *precision))) - (and (minusp *scale) (< *precision 10))) + ((or (and (minusp *scale) (zerop *precision)) + (and (zerop *scale) (< 0 *precision 9))) (setf buffer (acquire-foreign-resource :int +n-buf-rows+) sizeof 4 ;; sizeof(int) dtype #.SQLT-INT)) + ((and (zerop *scale) + (plusp *precision) + #+ignore (< *precision 19)) + (setf buffer (acquire-foreign-resource :unsigned-int + (* 2 +n-buf-rows+)) + sizeof 8 ;; sizeof(int64) + dtype #.SQLT-INT)) + ;; Bug in OCI? But OCI won't take 16-byte buffer for 128-bit + ;; integers + #+ignore + ((and (zerop *scale) (plusp *precision)) + (setf buffer (acquire-foreign-resource :unsigned-int + (* 4 +n-buf-rows+)) + sizeof 8 ;; sizeof(int128) + dtype #.SQLT-INT)) (t (setf buffer (acquire-foreign-resource :double +n-buf-rows+) sizeof 8 ;; sizeof(double)