X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=db-sqlite%2Fsqlite-api-uffi.lisp;h=61d1c7dcd8588056fde2dc6bbb68f38776570441;hp=038d7585508d64fef23c0c726ac25f283ac54240;hb=66b64b326d109d6cb0d96923b60ed6aaeaeabb21;hpb=589ac938c266f00e098f9875642c2792bd19506b diff --git a/db-sqlite/sqlite-api-uffi.lisp b/db-sqlite/sqlite-api-uffi.lisp index 038d758..61d1c7d 100644 --- a/db-sqlite/sqlite-api-uffi.lisp +++ b/db-sqlite/sqlite-api-uffi.lisp @@ -7,7 +7,7 @@ ;;;; 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 ;;;; @@ -16,15 +16,6 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* - -;;; NOTE: Upon reviewing the code, I found this is not UFFI compatible. -;;; it appears to work on CMUCL, but does not work correctly on Lispworks -;;; and Allegro. Mostly, the processing of return strings is still incorrect -;;; UFFI code. -;;; To fix this will require reading the SQLite API and reworking the -;;; code below. -;;; - Kevin Rosenberg - (in-package #:cl-user) (defpackage #:sqlite @@ -61,6 +52,7 @@ ;;; Types. #:sqlite-row #:sqlite-row-pointer + #:sqlite-row-pointer-type #:sqlite-vm-pointer)) (in-package #:sqlite) @@ -100,20 +92,19 @@ ;;;; ;;;; 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-array-pointer string-array-pointer :cstring) +(def-foreign-type string-pointer (* (* :char))) +(def-foreign-type sqlite-row-pointer (* string-pointer)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; 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-db sqlite-db) +(def-type sqlite-row string-pointer) +(def-type sqlite-row-pointer-type (* string-pointer)) (def-type sqlite-vm-pointer (* sqlite-vm)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -166,8 +157,8 @@ ("sqlite_step" %step) ((vm sqlite-vm) (cols-n (* :int)) - (cols (* (* :char))) - (col-names (* (* :char)))) + (cols (* (* (* :char)))) + (col-names (* (* (* :char))))) :returning :int) (declaim (inline %finalize)) @@ -192,7 +183,7 @@ ("sqlite_get_table" %get-table) ((db sqlite-db) (sql :cstring) - (result (* (* :char))) + (result (* (* (* :char)))) (rows-n (* :int)) (cols-n (* :int)) (error-message (* errmsg))) @@ -222,32 +213,31 @@ (defparameter sqlite-version (sqlite-libversion)) (defparameter sqlite-encoding (sqlite-libencoding)) -(def-type sqlite-db-pointer-type sqlite-db-pointer) -(def-type sqlite-vm-pointer-type sqlite-vm-pointer) - (defun sqlite-open (db-name &optional (mode 0)) - (let ((db (%open db-name mode nil))) - (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 nil))) + (if (null-pointer-p db) + (signal-sqlite-error SQLITE-ERROR + (format nil "unable to open ~A" db-name)) + db)))) (defun sqlite-compile (db sql) - (let ((vm (allocate-foreign-object 'sqlite-vm))) - (with-foreign-object (sql-tail '(* :char)) - (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 nil))) + (if (= result SQLITE-OK) + vm + (progn + (free-foreign-object vm) + (signal-sqlite-error result)))))))) (defun sqlite-step (vm) - (declare (type sqlite-vm-pointer-type vm)) + (declare (type sqlite-vm-pointer vm)) (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)) + (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 @@ -257,8 +247,8 @@ ((= 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 (make-null-pointer 'string-pointer) + (make-null-pointer 'string-pointer))) (t (free-foreign-object cols) (free-foreign-object col-names) @@ -274,23 +264,24 @@ (signal-sqlite-error result)))) (defun sqlite-get-table (db sql) - (declare (type sqlite-db-pointer db)) - (let ((rows (allocate-foreign-object '(* :char)))) - (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 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 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))))))))) (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))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -299,7 +290,7 @@ ;;;; (declaim (inline make-null-row)) (defun make-null-row () - (uffi:make-null-pointer 'string-array-pointer)) + (uffi:make-null-pointer 'string-pointer)) (declaim (inline make-null-vm)) (defun make-null-vm () @@ -311,10 +302,10 @@ (declaim (inline sqlite-aref)) (defun sqlite-aref (a n) - (declare (type sqlite-row-pointer a)) - (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))