X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=uffi%2Fclsql-uffi.lisp;h=6e7784917d9a97cc2bd68fa427e9c2981926eeed;hb=e7d3c396e803dc0dcc5acb773de5c872568c66e3;hp=e1f687b53494cd28b2f9471bff3d0a444e49207e;hpb=bc4310a463731d7cf760d28e57700c3c772cb6ef;p=clsql.git diff --git a/uffi/clsql-uffi.lisp b/uffi/clsql-uffi.lisp index e1f687b..6e77849 100644 --- a/uffi/clsql-uffi.lisp +++ b/uffi/clsql-uffi.lisp @@ -21,16 +21,16 @@ (defun canonicalize-type-list (types auto-list) "Ensure a field type list meets expectations" - (declaim (optimize (speed 3) (safety 0))) + (declare (optimize (speed 3) (safety 0))) (do ((i 0 (1+ i)) (new-types '()) (length-types (length types)) (length-auto-list (length auto-list))) ((= i length-auto-list) (nreverse new-types)) - (declaim (fixnum length-types length-auto-list i)) + (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,15 +110,19 @@ (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 (if length (uffi:convert-from-foreign-string char-ptr :locale :none