X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=uffi%2Fclsql-uffi.lisp;h=6f62d958ce28ea9e3f82799e46be8d40041b4f0f;hb=da9282a5c0ce927c613f1706f1c51796c75e16e4;hp=d901481dce0dbbe853e997cad73717e911b228c4;hpb=2d7fb2dcce0f94745672b4f2aff6be39d610a063;p=clsql.git

diff --git a/uffi/clsql-uffi.lisp b/uffi/clsql-uffi.lisp
index d901481..6f62d95 100644
--- a/uffi/clsql-uffi.lisp
+++ b/uffi/clsql-uffi.lisp
@@ -7,9 +7,7 @@
 ;;;; Programmers:   Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id$
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of CLSQL, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
 ;;;;
 ;;;; CLSQL users are granted the rights to distribute and use this software
 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
@@ -30,41 +28,77 @@
        (nreverse new-types))
     (declare (fixnum length-types length-auto-list i))
     (if (>= i length-types)
-	(push t new-types) ;; types is shorter than num-fields
-	(push
-	 (case (nth i types)
-	   (:int
-	    (case (nth i auto-list)
-	      (:int32
-	       :int32)
-	      (:int64
-	       :int64)
-	      (t
-	       t)))
-	   (:double
-	    (case (nth i auto-list)
-	      (:double
-	       :double)
-	      (t
-	       t)))
-	   (:int32
-	    (if (eq :int32 (nth i auto-list))
-		:int32
-		t))
-	   (:int64
-	    (if (eq :int64 (nth i auto-list))
-		:int64
-	      t))
-	   (:blob
-	    :blob)
-	   (t
-	    t))
-	 new-types))))
+        (push t new-types) ;; types is shorter than num-fields
+        (push
+         (case (nth i types)
+           (:int
+            (case (nth i auto-list)
+              (:int32
+               :int32)
+              (:int64
+               :int64)
+              (t
+               t)))
+           (:double
+            (case (nth i auto-list)
+              (:double
+               :double)
+              (t
+               t)))
+           (:int32
+            (if (eq :int32 (nth i auto-list))
+                :int32
+                t))
+           (:int64
+            (if (eq :int64 (nth i auto-list))
+                :int64
+              t))
+           (:blob
+            :blob)
+           (:uint
+            :uint)
+           (t
+            t))
+         new-types))))
 
 (uffi:def-function "atoi"
     ((str (* :unsigned-char)))
   :returning :int)
 
+(uffi:def-function ("strtoul" c-strtoul)
+    ((str (* :unsigned-char))
+     (endptr (* :unsigned-char))
+     (radix :int))
+  :returning :unsigned-long)
+
+#-windows
+(uffi:def-function ("strtoull" c-strtoull)
+    ((str (* :unsigned-char))
+     (endptr (* :unsigned-char))
+     (radix :int))
+  :returning :unsigned-long-long)
+
+#-windows
+(uffi:def-function ("strtoll" c-strtoll)
+    ((str (* :unsigned-char))
+     (endptr (* :unsigned-char))
+     (radix :int))
+  :returning :long-long)
+
+#+windows
+(uffi:def-function ("_strtoui64" c-strtoull)
+    ((str (* :unsigned-char))
+     (endptr (* :unsigned-char))
+     (radix :int))
+  :returning :unsigned-long-long)
+
+#+windows
+(uffi:def-function ("_strtoi64" c-strtoll)
+    ((str (* :unsigned-char))
+     (endptr (* :unsigned-char))
+     (radix :int))
+  :returning :long-long)
+
 (uffi:def-function "atol"
     ((str (* :unsigned-char)))
   :returning :long)
@@ -73,12 +107,6 @@
     ((str (* :unsigned-char)))
   :returning :double)
 
-(uffi:def-function "atol64"
-    ((str (* :unsigned-char))
-     (high32 (* :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+))
@@ -97,36 +125,43 @@
 
 (uffi:def-type char-ptr-def (* :unsigned-char))
 
-(defun convert-raw-field (char-ptr types index &optional length)
+(defun strtoul (char-ptr)
   (declare (optimize (speed 3) (safety 0) (space 0))
- 	   (type char-ptr-def char-ptr))
-  (let ((type (if (consp types)
-		  (nth index types)
-		  types)))
-    (cond
-      ((uffi:null-pointer-p char-ptr)
-       nil)
-      (t
-       (case type
-	 (:double
-	  (atof char-ptr))
-	 ((:int32 :int)
-	  (atoi char-ptr))
-	 (:int64
-	  (uffi:with-foreign-object (high32-ptr :int)
-	    (let ((low32 (atol64 char-ptr high32-ptr))
-		  (high32 (uffi:deref-pointer high32-ptr :int)))
-	      (if (zerop 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
-                                                :null-terminated-p nil
-                                                :length length)
-            (uffi:convert-from-foreign-string char-ptr :locale :none))))))))
+           (type char-ptr-def char-ptr))
+  (c-strtoul char-ptr uffi:+null-cstring-pointer+ 10))
+
+(defun strtoull (char-ptr)
+  (declare (optimize (speed 3) (safety 0) (space 0))
+           (type char-ptr-def char-ptr))
+  (c-strtoull char-ptr uffi:+null-cstring-pointer+ 10))
+
+(defun strtoll (char-ptr)
+  (declare (optimize (speed 3) (safety 0) (space 0))
+           (type char-ptr-def char-ptr))
+  (c-strtoll char-ptr uffi:+null-cstring-pointer+ 10))
 
+(defun convert-raw-field (char-ptr type &key length encoding)
+  (declare (optimize (speed 3) (safety 0) (space 0))
+           (type char-ptr-def char-ptr))
+  (unless (uffi:null-pointer-p char-ptr)
+    (case type
+      (:double (atof char-ptr))
+      (:int (atol char-ptr))
+      (:int32 (atoi char-ptr))
+      (:uint32 (strtoul char-ptr))
+      (:uint (strtoul char-ptr))
+      (:int64 (strtoll char-ptr))
+      (:uint64 (strtoull char-ptr))
+      (:blob
+       (if length
+           (uffi:convert-from-foreign-usb8 char-ptr length)
+           (error "Can't return blob since length is not specified.")))
+      (t
+       ;; NB: this used to manually expand the arg list based on if length and encoding
+       ;; were provided.  If this is required the macro is aweful and should be rewritten
+       ;; to accept nil args (as it appears to)
+       (uffi:convert-from-foreign-string
+        char-ptr
+        :null-terminated-p (null length)
+        :length length
+        :encoding encoding)))))