X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=uffi%2Fclsql-uffi.lisp;h=7ac28c00e7f8c54418fde9f8459d5433e9557b4b;hb=c0f15eada06c0c53437a5b3acc72ab1cd3c72df1;hp=63267022dc7ce8c7710b36edee0c395907ce35d8;hpb=f1ff5842ce264fbe47e8ef98e33e4aca3b71d863;p=clsql.git diff --git a/uffi/clsql-uffi.lisp b/uffi/clsql-uffi.lisp index 6326702..7ac28c0 100644 --- a/uffi/clsql-uffi.lisp +++ b/uffi/clsql-uffi.lisp @@ -30,7 +30,7 @@ (nreverse new-types)) (declare (fixnum length-types length-auto-list i)) (if (>= i length-types) - (push t new-types) ;; types is shorted than num-fields + (push t new-types) ;; types is shorter than num-fields (push (case (nth i types) (:int @@ -54,7 +54,9 @@ (:int64 (if (eq :int64 (nth i auto-list)) :int64 - t)) + t)) + (:blob + :blob) (t t)) new-types)))) @@ -73,14 +75,22 @@ (uffi:def-function "atol64" ((str (* :unsigned-char)) - (high32 (* :int))) + (high32 (* :unsigned-int))) + :module "clsql-uffi" :returning :unsigned-int) (uffi:def-constant +2^32+ 4294967296) +(uffi:def-constant +2^64+ 18446744073709551616) (uffi:def-constant +2^32-1+ (1- +2^32+)) (defmacro make-64-bit-integer (high32 low32) - `(+ ,low32 (ash ,high32 32))) + `(if (zerop (ldb (byte 1 31) ,high32)) + (+ ,low32 (ash ,high32 32)) + (- (+ ,low32 (ash ,high32 32)) +2^64+))) + +;; From high to low ints +(defmacro make-128-bit-integer (a b c d) + `(+ ,d (ash ,c 32) (ash ,b 64) (ash ,a 96))) (defmacro split-64-bit-integer (int64) `(values (ash ,int64 -32) (logand ,int64 +2^32-1+))) @@ -90,7 +100,7 @@ (defun convert-raw-field (char-ptr types index &optional length) (declare (optimize (speed 3) (safety 0) (space 0)) (type char-ptr-def char-ptr)) - (let ((type (if (listp types) + (let ((type (if (consp types) (nth index types) types))) (cond @@ -100,16 +110,25 @@ (case type (:double (atof char-ptr)) - ((or :int32 :int) + ((:int32 :int) (atoi char-ptr)) (:int64 - (uffi:with-foreign-object (high32-ptr :int) + (uffi:with-foreign-object (high32-ptr :unsigned-int) (let ((low32 (atol64 char-ptr high32-ptr)) - (high32 (uffi:deref-pointer high32-ptr :int))) + (high32 (uffi:deref-pointer high32-ptr :unsigned-int))) (if (zerop high32) low32 - (make-64-bit-integer high32 low32))))) + (make-64-bit-integer high32 low32))))) + (:blob + (if length + (uffi:convert-from-foreign-usb8 char-ptr length) + (error "Can't return blob since length is not specified."))) (t + ;; sb-unicode still broken with converting with length, assume + ;; that string is null terminated + #+sb-unicode + (uffi:convert-from-foreign-string char-ptr :locale :none) + #-sb-unicode (if length (uffi:convert-from-foreign-string char-ptr :locale :none :null-terminated-p nil