X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-sqlite%2Fsqlite-api-uffi.lisp;h=939651522e882c093298297357ae658530031fd4;hb=7cdc9aa48baa3c52923d61da6fa632eb47ac0b5d;hp=90f8ceff5b05d27a9ba229a15bfa06b3d3c614f3;hpb=fd3c9c9f21ff40904bf27eb7a797bbd6c2d80630;p=clsql.git

diff --git a/db-sqlite/sqlite-api-uffi.lisp b/db-sqlite/sqlite-api-uffi.lisp
index 90f8cef..9396515 100644
--- a/db-sqlite/sqlite-api-uffi.lisp
+++ b/db-sqlite/sqlite-api-uffi.lisp
@@ -4,23 +4,23 @@
 ;;;;
 ;;;; Name:          sqlite-api-uffi.lisp
 ;;;; Purpose:       Low-level SQLite interface using UFFI
-;;;; Programmers:   Aurelio Bignoli
+;;;; Programmers:   Aurelio Bignoli and Kevin Rosenberg
 ;;;; Date Started:  Nov 2003
 ;;;;
-;;;; $Id: sqlite-api-uffi.lisp,v 1.5 2004/03/09 20:57:19 aurelio Exp $
+;;;; $Id$
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2003 by Aurelio Bignoli
+;;;; and Copyright (c) 2003-2004 by Kevin 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
 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
-(declaim (optimize (debug 0) (speed 3) (safety 0) (compilation-speed 0)))
 
-(in-package :cl-user)
+(in-package #:cl-user)
 
-(defpackage :sqlite
-  (:use :common-lisp :uffi)
+(defpackage #:sqlite
+  (:use #:common-lisp #:uffi)
     (:export
            ;;; Conditions
            #:sqlite-error
@@ -53,9 +53,10 @@
 	   ;;; Types.
 	   #:sqlite-row
 	   #:sqlite-row-pointer
+	   #:sqlite-row-pointer-type
 	   #:sqlite-vm-pointer))
 
-(in-package :sqlite)
+(in-package #:sqlite)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;
@@ -84,7 +85,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))))
 
@@ -92,21 +94,24 @@
 ;;;;
 ;;;; Foreign types definitions.
 ;;;;
+(def-foreign-type errmsg (* :char))
 (def-foreign-type sqlite-db :pointer-void)
 (def-foreign-type sqlite-vm :pointer-void)
-(def-foreign-type errmsg :cstring)
+(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))
 
-(def-array-pointer string-array-pointer :cstring)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; Lisp types used in declarations.
 ;;;;
-(def-type sqlite-db-pointer '(* sqlite-db))
-(def-type sqlite-int-pointer '(* :int))
-(def-type sqlite-row 'string-array-pointer)
-(def-type sqlite-row-pointer '(* string-array-pointer))
-(def-type sqlite-vm-pointer '(* sqlite-vm))
+(def-type sqlite-db-type sqlite-db)
+(def-type sqlite-row string-pointer)
+(def-type sqlite-row-pointer-type (* string-pointer))
+(def-type sqlite-vm-pointer (* sqlite-vm))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;
@@ -131,7 +136,7 @@
     ("sqlite_open" %open)
     ((dbname :cstring)
      (mode :int)
-     (error-message '(* errmsg)))
+     (error-message (* errmsg)))
   :returning sqlite-db)
 
 (declaim (inline sqlite-close))
@@ -148,25 +153,25 @@
     ("sqlite_compile" %compile)
     ((db sqlite-db)
      (sql :cstring)
-     (sql-tail '(* :cstring))
-     (vm '(* sqlite-vm))
-     (error-message '(* errmsg)))
+     (sql-tail (* (* :char)))
+     (vm (* sqlite-vm))
+     (error-message (* errmsg)))
   :returning :int)
 
 (declaim (inline %step))
 (def-sqlite-function
     ("sqlite_step" %step)
     ((vm sqlite-vm)
-     (cols-n '(* :int))
-     (cols '(* (* :cstring)))
-     (col-names '(* (* :cstring))))
+     (cols-n (* :int))
+     (cols (* (* (* :char))))
+     (col-names (* (* (* :char)))))
   :returning :int)
 
 (declaim (inline %finalize))
 (def-sqlite-function
     ("sqlite_finalize" %finalize)
     ((vm sqlite-vm)
-     (error-message '(* errmsg)))
+     (error-message (* errmsg)))
   :returning :int)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -176,7 +181,7 @@
 (declaim (inline sqlite-last-insert-rowid))
 (def-sqlite-function
     "sqlite_last_insert_rowid"
-    ((db 'sqlite-db))
+    ((db sqlite-db))
   :returning :int)
 
 (declaim (inline %get-table))
@@ -184,10 +189,10 @@
     ("sqlite_get_table" %get-table)
     ((db sqlite-db)
      (sql :cstring)
-     (result '(* (* :cstring)))
-     (rows-n '(* :int))
-     (cols-n '(* :int))
-     (error-message '(* errmsg)))
+     (result (* (* (* :char))))
+     (rows-n (* :int))
+     (cols-n (* :int))
+     (error-message (* errmsg)))
   :returning :int)
 
 (declaim (inline %free-table))
@@ -215,30 +220,30 @@
 (defparameter sqlite-encoding (sqlite-libencoding))
 
 (defun sqlite-open (db-name &optional (mode 0))
-  (let ((db (%open db-name mode nil)))
-    (declare (type sqlite-db-pointer db))
-    (if (null-pointer-p db)
-	(signal-sqlite-error SQLITE-ERROR
-			     (format nil "unable to open ~A" db-name))
-	db)))
+  (with-cstring (db-name-native db-name) 
+    (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))
+	  db))))
 
 (defun sqlite-compile (db sql)
-  (declare (type sqlite-db-pointer db))
-  (let ((vm (allocate-foreign-object 'sqlite-vm)))
-    (with-foreign-object (sql-tail :cstring)
-      (let ((result (%compile db sql sql-tail vm nil)))
-	(if (= result SQLITE-OK)
-	    vm
-	    (progn
-	      (free-foreign-object vm)
-	      (signal-sqlite-error result)))))))
+  (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 +null-errmsg-pointer+)))
+	  (if (= result SQLITE-OK)
+	      vm
+	      (progn
+		(free-foreign-object vm)
+		(signal-sqlite-error result))))))))
 
 (defun sqlite-step (vm)
   (declare (type sqlite-vm-pointer vm))
   (with-foreign-object (cols-n :int)
-    (let ((cols (allocate-foreign-object '(* :cstring)))
-	  (col-names (allocate-foreign-object '(* :cstring))))
-      (declare (type sqlite-row-pointer cols col-names))
+    (let ((cols (allocate-foreign-object '(* (* :char))))
+	  (col-names (allocate-foreign-object '(* (* :char)))))
+      (declare (type sqlite-row-pointer-type cols col-names))
       (let ((result (%step (deref-pointer vm 'sqlite-vm)
 			   cols-n cols col-names)))
 	(cond
@@ -248,8 +253,7 @@
 	  ((= result SQLITE-DONE)
 	   (free-foreign-object cols)
 	   (free-foreign-object col-names)
-	   (values 0 (make-null-pointer 'string-array-pointer)
-		   (make-null-pointer 'string-array-pointer)))
+	   (values 0 +null-string-pointer-pointer+ +null-string-pointer-pointer+))
 	  (t
 	   (free-foreign-object cols)
 	   (free-foreign-object col-names)
@@ -257,7 +261,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)
@@ -265,23 +269,24 @@
 	(signal-sqlite-error result))))
 
 (defun sqlite-get-table (db sql)
-  (declare (type sqlite-db-pointer db))
-  (let ((rows (allocate-foreign-object '(* :cstring))))
-    (with-foreign-object (rows-n :int)
-      (with-foreign-object (cols-n :int)
-        (declare (type sqlite-row-pointer rows))
-	(let ((result (%get-table db sql rows rows-n cols-n nil)))
-	  (if (= result SQLITE-OK)
-	      (let ((cn (deref-pointer cols-n :int))
-		    (rn (deref-pointer rows-n :int)))
-		(values rows rn cn))
-	      (progn
-		(free-foreign-object rows)
-		(signal-sqlite-error result))))))))
+  (declare (type sqlite-db-type db))
+  (with-cstring (sql-native sql)
+    (let ((rows (allocate-foreign-object '(* (* :char)))))
+      (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 +null-errmsg-pointer+)))
+	    (if (= result SQLITE-OK)
+		(let ((cn (deref-pointer cols-n :int))
+		      (rn (deref-pointer rows-n :int)))
+		  (values rows rn cn))
+		(progn
+		  (free-foreign-object rows)
+		  (signal-sqlite-error result)))))))))
 
 (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)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -290,7 +295,7 @@
 ;;;;
 (declaim (inline make-null-row))
 (defun make-null-row ()
-  (uffi:make-null-pointer 'string-array-pointer))
+  +null-string-pointer-pointer+)
 
 (declaim (inline make-null-vm))
 (defun make-null-vm ()
@@ -302,10 +307,11 @@
 
 (declaim (inline sqlite-aref))
 (defun sqlite-aref (a n)
-  (declare (type sqlite-row-pointer a))
-  (deref-array  (deref-pointer a 'sqlite-row-pointer) '(:array :cstring) 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))