;;;; *************************************************************************
;;;; 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
;;; Types.
#:sqlite-row
#:sqlite-row-pointer
+ #:sqlite-row-pointer-type
#:sqlite-vm-pointer))
(in-package #:sqlite)
:code code
:message (if message
message
- (sqlite-error-string code)))))
+ (uffi:convert-from-cstring
+ (sqlite-error-string code))))))
(unless (signal condition)
(invoke-debugger condition))))
;;;;
;;;; 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 sqlite-row-pointer (* string-pointer))
+(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-type (* string-pointer))
(def-type sqlite-vm-pointer (* sqlite-vm))
("sqlite_compile" %compile)
((db sqlite-db)
(sql :cstring)
- (sql-tail (* (* :char)))
+ (sql-tail (* (* :unsigned-char)))
(vm (* sqlite-vm))
(error-message (* errmsg)))
:returning :int)
("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))
("sqlite_get_table" %get-table)
((db sqlite-db)
(sql :cstring)
- (result (* (* (* :char))))
+ (result (* (* (* :unsigned-char))))
(rows-n (* :int))
(cols-n (* :int))
(error-message (* errmsg)))
(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))
(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
(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)))))
+ (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)))
((= 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)
(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)
(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)))))
+ (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)))
;;;;
(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 ()
(declaim (inline sqlite-aref))
(defun sqlite-aref (a n)
(declare (type sqlite-row-pointer-type a))
- (convert-from-foreign-string (deref-array (deref-pointer a 'sqlite-row-pointer) '(:array :char) n)))
+ (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)
projects / clsql.git / blobdiff