Further internationalization.

[clsql.git] / uffi / clsql-uffi.lisp

diff --git a/uffi/clsql-uffi.lisp b/uffi/clsql-uffi.lisp
index 7ac28c00e7f8c54418fde9f8459d5433e9557b4b..7a4dbbb1ddc821f1923b2e71c9fd2f4785e50f4a 100644 (file)
--- 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,49 @@
        (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)
+
 (uffi:def-function "atol"
     ((str (* :unsigned-char)))
   :returning :long)
@@ -97,41 +103,42 @@
 
 (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 :unsigned-int)
-           (let ((low32 (atol64 char-ptr high32-ptr))
-                 (high32 (uffi:deref-pointer high32-ptr :unsigned-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
-         ;; 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
-                                                :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 convert-raw-field (char-ptr type &key length encoding)
+  (declare (optimize (speed 3) (safety 0) (space 0))
+           (type char-ptr-def char-ptr))
+  (cond
+    ((uffi:null-pointer-p char-ptr)
+     nil)
+    (t
+     (case type
+       (:double
+        (atof char-ptr))
+       (:int
+        (atol char-ptr))
+       (:int32
+        (atoi char-ptr))
+       (:uint32
+        (strtoul char-ptr))
+       (:uint
+        (strtoul char-ptr))
+       ((:int64 :uint64)
+        (uffi:with-foreign-object (high32-ptr :unsigned-int)
+          (let ((low32 (atol64 char-ptr high32-ptr))
+                (high32 (uffi:deref-pointer high32-ptr :unsigned-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
+        (uffi:convert-from-foreign-string char-ptr
+                                          :null-terminated-p nil
+                                          :length length
+                                          :encoding encoding))))))