From 35a6150bba27d78ccc452aa1c0fc0701def46be2 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Wed, 27 Mar 2002 07:58:42 +0000 Subject: [PATCH] r1672: *** empty log message *** --- interfaces/clsql-uffi/Makefile | 51 +++++++++++++ interfaces/clsql-uffi/Makefile.msvc | 35 +++++++++ interfaces/clsql-uffi/clsql-uffi-package.cl | 33 ++++++++ interfaces/clsql-uffi/clsql-uffi.cl | 85 +++++++++++++++++++++ 4 files changed, 204 insertions(+) create mode 100644 interfaces/clsql-uffi/Makefile create mode 100644 interfaces/clsql-uffi/Makefile.msvc create mode 100644 interfaces/clsql-uffi/clsql-uffi-package.cl create mode 100644 interfaces/clsql-uffi/clsql-uffi.cl diff --git a/interfaces/clsql-uffi/Makefile b/interfaces/clsql-uffi/Makefile new file mode 100644 index 0000000..8bc8436 --- /dev/null +++ b/interfaces/clsql-uffi/Makefile @@ -0,0 +1,51 @@ +# -*- 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 *~ + diff --git a/interfaces/clsql-uffi/Makefile.msvc b/interfaces/clsql-uffi/Makefile.msvc new file mode 100644 index 0000000..ada128e --- /dev/null +++ b/interfaces/clsql-uffi/Makefile.msvc @@ -0,0 +1,35 @@ +# -*- 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) + + diff --git a/interfaces/clsql-uffi/clsql-uffi-package.cl b/interfaces/clsql-uffi/clsql-uffi-package.cl new file mode 100644 index 0000000..2329c5f --- /dev/null +++ b/interfaces/clsql-uffi/clsql-uffi-package.cl @@ -0,0 +1,33 @@ +;;;; -*- 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")) + diff --git a/interfaces/clsql-uffi/clsql-uffi.cl b/interfaces/clsql-uffi/clsql-uffi.cl new file mode 100644 index 0000000..27059e2 --- /dev/null +++ b/interfaces/clsql-uffi/clsql-uffi.cl @@ -0,0 +1,85 @@ +;;;; -*- 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))))) -- 2.34.1