X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-sqlite%2Fsqlite-api-uffi.lisp;h=73a12eb107e81c2d8e6b05084dab61134d38fb17;hb=23b76563b25a517ad20f29d6dc5a65c8b958a042;hp=e6af621cec4b67e2a6736e1734c2f99fad94fb01;hpb=56ccd9c18c38262936b8988264edfb927e83eb49;p=clsql.git

diff --git a/db-sqlite/sqlite-api-uffi.lisp b/db-sqlite/sqlite-api-uffi.lisp
index e6af621..73a12eb 100644
--- a/db-sqlite/sqlite-api-uffi.lisp
+++ b/db-sqlite/sqlite-api-uffi.lisp
@@ -52,6 +52,7 @@
 	   ;;; Types.
 	   #:sqlite-row
 	   #:sqlite-row-pointer
+	   #:sqlite-row-pointer-type
 	   #:sqlite-vm-pointer))
 
 (in-package #:sqlite)
@@ -83,7 +84,8 @@
 			 :code code
 			 :message (if message
 				      message
-				      (sqlite-error-string code)))))
+				    (uffi:convert-from-cstring
+				     (sqlite-error-string code))))))
     (unless (signal condition)
       (invoke-debugger condition))))
 
@@ -95,14 +97,19 @@
 (def-foreign-type sqlite-db :pointer-void)
 (def-foreign-type sqlite-vm :pointer-void)
 (def-foreign-type string-pointer (* (* :char)))
+(def-foreign-type sqlite-row-pointer (* string-pointer))
+
+(defvar +null-errmsg-pointer+ (make-null-pointer 'errmsg))
+(defvar +null-string-pointer-pointer+ (make-null-pointer 'string-pointer))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; Lisp types used in declarations.
 ;;;;
-(def-type sqlite-db sqlite-db)
+(def-type sqlite-db-type sqlite-db)
 (def-type sqlite-row string-pointer)
-(def-type sqlite-row-pointer (* string-pointer))
+(def-type sqlite-row-pointer-type (* string-pointer))
 (def-type sqlite-vm-pointer (* sqlite-vm))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -213,7 +220,7 @@
 
 (defun sqlite-open (db-name &optional (mode 0))
   (with-cstring (db-name-native db-name) 
-    (let ((db (%open db-name-native mode nil)))
+    (let ((db (%open db-name-native mode +null-errmsg-pointer+)))
       (if (null-pointer-p db)
 	  (signal-sqlite-error SQLITE-ERROR
 			       (format nil "unable to open ~A" db-name))
@@ -223,7 +230,7 @@
   (with-cstring (sql-native sql)
     (let ((vm (allocate-foreign-object 'sqlite-vm)))
       (with-foreign-object (sql-tail '(* :char))
-	(let ((result (%compile db sql-native sql-tail vm nil)))
+	(let ((result (%compile db sql-native sql-tail vm +null-errmsg-pointer+)))
 	  (if (= result SQLITE-OK)
 	      vm
 	      (progn
@@ -235,7 +242,7 @@
   (with-foreign-object (cols-n :int)
     (let ((cols (allocate-foreign-object '(* (* :char))))
 	  (col-names (allocate-foreign-object '(* (* :char)))))
-      (declare (type sqlite-row-pointer cols col-names))
+      (declare (type sqlite-row-pointer-type cols col-names))
       (let ((result (%step (deref-pointer vm 'sqlite-vm)
 			   cols-n cols col-names)))
 	(cond
@@ -245,8 +252,7 @@
 	  ((= result SQLITE-DONE)
 	   (free-foreign-object cols)
 	   (free-foreign-object col-names)
-	   (values 0 (make-null-pointer 'string-pointer)
-		   (make-null-pointer 'string-pointer)))
+	   (values 0 +null-string-pointer-pointer+ +null-string-pointer-pointer+))
 	  (t
 	   (free-foreign-object cols)
 	   (free-foreign-object col-names)
@@ -254,7 +260,7 @@
 
 (defun sqlite-finalize (vm)
   (declare (type sqlite-vm-pointer vm))
-  (let ((result (%finalize (deref-pointer vm 'sqlite-vm) nil)))
+  (let ((result (%finalize (deref-pointer vm 'sqlite-vm) +null-errmsg-pointer+)))
     (if (= result SQLITE-OK)
 	(progn
 	  (free-foreign-object vm)
@@ -262,13 +268,13 @@
 	(signal-sqlite-error result))))
 
 (defun sqlite-get-table (db sql)
-  (declare (type sqlite-db db))
+  (declare (type sqlite-db-type db))
   (with-cstring (sql-native sql)
     (let ((rows (allocate-foreign-object '(* (* :char)))))
-      (declare (type sqlite-row-pointer rows))
+      (declare (type sqlite-row-pointer-type rows))
       (with-foreign-object (rows-n :int)
 	(with-foreign-object (cols-n :int)
-	  (let ((result (%get-table db sql-native rows rows-n cols-n nil)))
+	  (let ((result (%get-table db sql-native rows rows-n cols-n +null-errmsg-pointer+)))
 	    (if (= result SQLITE-OK)
 		(let ((cn (deref-pointer cols-n :int))
 		      (rn (deref-pointer rows-n :int)))
@@ -279,7 +285,7 @@
 
 (declaim (inline sqlite-free-table))
 (defun sqlite-free-table (table)
-  (declare (type sqlite-row-pointer table))
+  (declare (type sqlite-row-pointer-type table))
   (%free-table (deref-pointer table 'sqlite-row-pointer)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -288,7 +294,7 @@
 ;;;;
 (declaim (inline make-null-row))
 (defun make-null-row ()
-  (uffi:make-null-pointer 'string-pointer))
+  +null-string-pointer-pointer+)
 
 (declaim (inline make-null-vm))
 (defun make-null-vm ()
@@ -300,10 +306,11 @@
 
 (declaim (inline sqlite-aref))
 (defun sqlite-aref (a n)
-  (declare (type sqlite-row-pointer a))
-  (convert-from-foreign-string (deref-array  (deref-pointer a 'sqlite-row-pointer) '(:array :char) n)))
+  (declare (type sqlite-row-pointer-type a))
+  (convert-from-foreign-string
+   (deref-array (deref-pointer a 'sqlite-row-pointer) '(:array (* :char)) n)))
 
 (declaim (inline sqlite-free-row))
 (defun sqlite-free-row (row)
-  (declare (type sqlite-row-pointer row))
+  (declare (type sqlite-row-pointer-type row))
   (free-foreign-object row))