X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-sqlite%2Fsqlite-api-uffi.lisp;h=98667493ad0c94c581019abcfb65b9bc7f9f208a;hb=333e8280f2f3438ffd379349bc9746c34cccc159;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..9866749 100644 --- a/db-sqlite/sqlite-api-uffi.lisp +++ b/db-sqlite/sqlite-api-uffi.lisp @@ -2,14 +2,15 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: sqlite-api-uffi.lisp -;;;; Purpose: Low-level SQLite interface using UFFI -;;;; Programmers: Aurelio Bignoli and Kevin Rosenberg -;;;; Date Started: Nov 2003 +;;;; Name: sqlite-api-uffi.lisp +;;;; Purpose: Low-level SQLite interface using UFFI +;;;; Authors: Aurelio Bignoli and Kevin Rosenberg +;;;; Created: Nov 2003 ;;;; ;;;; $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 @@ -52,6 +53,7 @@ ;;; Types. #:sqlite-row #:sqlite-row-pointer + #:sqlite-row-pointer-type #:sqlite-vm-pointer)) (in-package #:sqlite) @@ -83,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)))) @@ -91,18 +94,23 @@ ;;;; ;;;; Foreign types definitions. ;;;; -(def-foreign-type errmsg (* :char)) +(def-foreign-type errmsg (* :unsigned-char)) (def-foreign-type sqlite-db :pointer-void) (def-foreign-type sqlite-vm :pointer-void) -(def-foreign-type string-pointer (* (* :char))) +(def-foreign-type string-pointer (* (* :unsigned-char))) +(def-foreign-type sqlite-row-pointer (* (* :unsigned-char))) + +(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)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -145,7 +153,7 @@ ("sqlite_compile" %compile) ((db sqlite-db) (sql :cstring) - (sql-tail (* (* :char))) + (sql-tail (* (* :unsigned-char))) (vm (* sqlite-vm)) (error-message (* errmsg))) :returning :int) @@ -155,8 +163,8 @@ ("sqlite_step" %step) ((vm sqlite-vm) (cols-n (* :int)) - (cols (* (* (* :char)))) - (col-names (* (* (* :char))))) + (cols (* (* (* :unsigned-char)))) + (col-names (* (* (* :unsigned-char))))) :returning :int) (declaim (inline %finalize)) @@ -181,7 +189,7 @@ ("sqlite_get_table" %get-table) ((db sqlite-db) (sql :cstring) - (result (* (* (* :char)))) + (result (* (* (* :unsigned-char)))) (rows-n (* :int)) (cols-n (* :int)) (error-message (* errmsg))) @@ -213,7 +221,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)) @@ -222,8 +230,8 @@ (defun sqlite-compile (db sql) (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))) + (with-foreign-object (sql-tail '(* :unsigned-char)) + (let ((result (%compile db sql-native sql-tail vm +null-errmsg-pointer+))) (if (= result SQLITE-OK) vm (progn @@ -233,9 +241,9 @@ (defun sqlite-step (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 '(* (* :unsigned-char)))) + (col-names (allocate-foreign-object '(* (* :unsigned-char))))) + (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 +253,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 +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) @@ -262,13 +269,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)) + (let ((rows (allocate-foreign-object '(* (* :unsigned-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))) + (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 +286,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 +295,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 +307,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 (* :unsigned-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))