--- /dev/null
+# -*- Mode: Makefile -*-
+###########################################################################
+# FILE IDENTIFICATION
+#
+# Name: Makefile
+# Purpose: Makefile for the CLSQL UFFI helper package
+# Programer: Kevin M. Rosenberg
+# Date Started: Mar 2002
+#
+# CVS Id: $Id: Makefile,v 1.1 2002/03/27 07:58:42 kevin Exp $
+#
+# This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. 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.
+###########################################################################
+
+
+# These variables are correct for GCC
+# you'll need to modify these for other compilers
+CC=gcc
+SHARED_CC_OPT=-fpic
+SHARED_LD_OPT=-shared
+
+# If you are using Solaris, these are the correct values
+# for creating a shared library
+#CC=cc
+#SHARED_CC_OPT=-KPIC
+#SHARED_LD_OPT=-G
+
+# Nothing to configure beyond this point
+
+BASE=clsql-uffi
+SRC=${BASE}.c
+OBJECT=${BASE}.o
+LIB=${BASE}.so
+
+all: ${LIB}
+
+${LIB}: ${SRC}
+ ${CC} ${SHARED_CC_OPT} -c ${SRC} -o ${OBJECT}
+ ld ${SHARED_LD_OPT} ${OBJECT} -o ${LIB}
+ @rm ${OBJECT}
+
+clean:
+ rm -f ${LIB}
+
+realclean: clean
+ rm -f *~
+
--- /dev/null
+# -*- Mode: Makefile -*-
+###########################################################################
+# FILE IDENTIFICATION
+#
+# Name: Makefile.msvc
+# Purpose: Makefile for the CLSQL UFFI helper package (MSVC)
+# Programer: Kevin M. Rosenberg
+# Date Started: Mar 2002
+#
+# CVS Id: $Id: Makefile.msvc,v 1.1 2002/03/27 07:58:42 kevin Exp $
+#
+# This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. 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.
+###########################################################################
+
+
+BASE=clsql-uffi
+
+# Nothing to configure beyond here
+
+SRC=$(BASE).c
+OBJ=$(BASE).obj
+DLL=$(BASE).dll
+
+$(DLL): $(SRC)
+ cl /MD /LD -D_MT /DWIN32=1 /D__LCC__=1 $(SRC)
+ del $(OBJ) $(BASE).exp
+
+clean:
+ del /q $(DLL)
+
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: clsql-uffi-package.cl
+;;;; Purpose: Package definitions for common UFFI interface routines
+;;;; Programmers: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; $Id: clsql-uffi-package.cl,v 1.1 2002/03/27 07:58:42 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. 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 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :cl-user)
+
+(defpackage :clsql-uffi
+ (:export
+ #:canonicalize-type-list
+ #:convert-raw-field
+ #:atoi
+ #:atol
+ #:atof
+ #:atol64
+ #:make-64-bit-integer
+ #:split-64-bit-integer)
+ (:documentation "Common functions for interfaces using UFFI"))
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: clsql-uffi.cl
+;;;; Purpose: Common functions for interfaces using UFFI
+;;;; Programmers: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; $Id: clsql-uffi.cl,v 1.1 2002/03/27 07:58:42 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. 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 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :clsql-uffi)
+
+
+(defun canonicalize-type-list (types num-fields)
+ "Ensure a field type list meets expectations"
+ (let ((length-types (length types))
+ (new-types '()))
+ (loop for i from 0 below num-fields
+ do
+ (if (>= i length-types)
+ (push t new-types) ;; types is shorted than num-fields
+ (push
+ (case (nth i types)
+ ((:int :long :double :longlong t)
+ (nth i types))
+ (t
+ t))
+ new-types)))
+ (nreverse new-types)))
+
+(uffi:def-function "atoi"
+ ((str (* :unsigned-char)))
+ :returning :int)
+
+(uffi:def-function "atol"
+ ((str (* :unsigned-char)))
+ :returning :long)
+
+(uffi:def-function "atof"
+ ((str (* :unsigned-char)))
+ :returning :double)
+
+(uffi:def-function "atol64"
+ ((str (* :unsigned-char))
+ (high32 (* :int)))
+ :returning :int)
+
+(uffi:def-constant +2^32+ 4294967296)
+(uffi:def-constant +2^32-1+ (1- +2^32+))
+
+(defmacro make-64-bit-integer (high32 low32)
+ `(+ ,low32 (* ,high32 +2^32+)))
+
+(defmacro split-64-bit-integer (int64)
+ `(values (ash ,int64 -32) (logand ,int64 +2^32-1+)))
+
+(defun convert-raw-field (char-ptr types index)
+ (let ((type (if (listp types)
+ (nth index types)
+ types)))
+ (case type
+ (:int
+ (atoi char-ptr))
+ (:long
+ (atol char-ptr))
+ (:double
+ (atof char-ptr))
+ (:longlong
+ (uffi:with-foreign-object (high32-ptr :int)
+ (let ((low32 (atol64 char-ptr high32-ptr))
+ (high32 (uffi:deref-pointer high32-ptr :int)))
+ (if (zerop high32)
+ low32
+ (make-64-bit-integer high32 low32)))))
+ (otherwise
+ (uffi:convert-from-foreign-string char-ptr)))))
projects / clsql.git / commitdiff