From: Kevin M. Rosenberg Date: Sat, 9 Mar 2002 21:53:58 +0000 (+0000) Subject: r1522: *** empty log message *** X-Git-Tag: v1.6.1~626 X-Git-Url: http://git.kpe.io/?a=commitdiff_plain;h=e41ee8065d399e0fb1d0d851a27aa53ba9015cf2;p=uffi.git r1522: *** empty log message *** --- diff --git a/Makefile b/Makefile index fdbd5ad..47318fb 100644 --- a/Makefile +++ b/Makefile @@ -5,7 +5,7 @@ # Programer: Kevin M. Rosenberg, M.D. # Date Started: Mar 2002 # -# CVS Id: $Id: Makefile,v 1.3 2002/03/09 21:19:31 kevin Exp $ +# CVS Id: $Id: Makefile,v 1.4 2002/03/09 21:53:58 kevin Exp $ # # Copyright (c) 2002 by Kevin M. Rosenberg # @@ -41,7 +41,7 @@ realclean: clean docs: @(cd doc; make dist-doc) -VERSION=0.1.2 +VERSION=0.1.3-pre DISTDIR=uffi-${VERSION} DIST_TARBALL=${DISTDIR}.tar.gz DIST_ZIP=${DISTDIR}.zip diff --git a/src/functions.cl b/src/functions.cl new file mode 100644 index 0000000..05777f8 --- /dev/null +++ b/src/functions.cl @@ -0,0 +1,94 @@ +;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;;; ************************************************************************* +;;;; FILE IDENTIFICATION +;;;; +;;;; Name: function.cl +;;;; Purpose: UFFI source to C function defintions +;;;; Programmer: Kevin M. Rosenberg +;;;; Date Started: Feb 2002 +;;;; +;;;; Copyright (c) 2002 Kevin M. Rosenberg +;;;; +;;;; $Id: functions.cl,v 1.1 2002/03/09 21:53:58 kevin Exp $ +;;;; +;;;; This file is part of the UFFI. +;;;; +;;;; UFFI is free software; you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License (version 2) as +;;;; published by the Free Software Foundation. +;;;; +;;;; UFFI is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with UFFI; if not, write to the Free Software +;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +;;;; ************************************************************************* + +(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) +(in-package :uffi) + +(defun process-function-args (args) + (if (null args) + #+lispworks nil + #+allegro '(:void) + #+cmu nil + (let (processed) + (dolist (arg args) + (push (process-one-function-arg arg) processed)) + (nreverse processed)))) + +(defun process-one-function-arg (arg) + (let ((name (car arg)) + (type (convert-from-uffi-type (cadr arg) :routine))) + #+cmu + (list name type :in) + #+(or allegro lispworks) + (if (and (listp type) (listp (car type))) + (append (list name) type) + (list name type)) + )) + +(defun allegro-convert-return-type (type) + (if (and (listp type) (not (listp (car type)))) + (list type) + type)) + +;; name is either a string representing foreign name, or a list +;; of foreign-name as a string and lisp name as a symbol +(defmacro def-function (names args &key module returning) + #+(or cmu allegro) (declare (ignore module)) + + (let* ((result-type (convert-from-uffi-type returning :return)) + (function-args (process-function-args args)) + (foreign-name (if (atom names) names (car names))) + (lisp-name (if (atom names) (make-lisp-name names) (cadr names)))) + + #+allegro + `(ff:def-foreign-call (,lisp-name ,foreign-name) + ,function-args + :returning ,(allegro-convert-return-type result-type) + :call-direct t + :strings-convert nil) + #+cmu + `(alien:def-alien-routine (,foreign-name ,lisp-name) + ,result-type + ,@function-args) + #+lispworks + `(fli:define-foreign-function (,lisp-name ,foreign-name :object) + ,function-args + ,@(if module (list :module module) (values)) + :result-type ,result-type + :calling-convention :cdecl) + )) + + +(defun make-lisp-name (name) + (let ((converted (substitute #\- #\_ name))) + (intern + #+case-sensitive converted + #-case-sensitive (string-upcase converted)))) + + diff --git a/src/routine.cl b/src/routine.cl deleted file mode 100644 index 9dd7aa4..0000000 --- a/src/routine.cl +++ /dev/null @@ -1,94 +0,0 @@ -;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ************************************************************************* -;;;; FILE IDENTIFICATION -;;;; -;;;; Name: function.cl -;;;; Purpose: UFFI source to C function defintions -;;;; Programmer: Kevin M. Rosenberg -;;;; Date Started: Feb 2002 -;;;; -;;;; Copyright (c) 2002 Kevin M. Rosenberg -;;;; -;;;; $Id: routine.cl,v 1.2 2002/03/09 21:19:31 kevin Exp $ -;;;; -;;;; This file is part of the UFFI. -;;;; -;;;; UFFI is free software; you can redistribute it and/or modify -;;;; it under the terms of the GNU General Public License (version 2) as -;;;; published by the Free Software Foundation. -;;;; -;;;; UFFI is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;;; GNU General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with UFFI; if not, write to the Free Software -;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -;;;; ************************************************************************* - -(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) -(in-package :uffi) - -(defun process-function-args (args) - (if (null args) - #+lispworks nil - #+allegro '(:void) - #+cmu nil - (let (processed) - (dolist (arg args) - (push (process-one-function-arg arg) processed)) - (nreverse processed)))) - -(defun process-one-function-arg (arg) - (let ((name (car arg)) - (type (convert-from-uffi-type (cadr arg) :routine))) - #+cmu - (list name type :in) - #+(or allegro lispworks) - (if (and (listp type) (listp (car type))) - (append (list name) type) - (list name type)) - )) - -(defun allegro-convert-return-type (type) - (if (and (listp type) (not (listp (car type)))) - (list type) - type)) - -;; name is either a string representing foreign name, or a list -;; of foreign-name as a string and lisp name as a symbol -(defmacro def-function (names args &key module returning) - #+(or cmu allegro) (declare (ignore module)) - - (let* ((result-type (convert-from-uffi-type returning :return)) - (function-args (process-function-args args)) - (foreign-name (if (atom names) names (car names))) - (lisp-name (if (atom names) (make-lisp-name names) (cadr names)))) - - #+allegro - `(ff:def-foreign-call (,lisp-name ,foreign-name) - ,function-args - :returning ,(allegro-convert-return-type result-type) - :call-direct t - :strings-convert nil) - #+cmu - `(alien:def-alien-routine (,foreign-name ,lisp-name) - ,result-type - ,@function-args) - #+lispworks - `(fli:define-foreign-function (,lisp-name ,foreign-name :object) - ,function-args - ,@(if module (list :module module) (values)) - :result-type ,result-type - :calling-convention :cdecl) - )) - - -(defun make-lisp-name (name) - (let ((converted (substitute #\- #\_ name))) - (intern - #+case-sensitive converted - #-case-sensitive (string-upcase converted)))) - - diff --git a/uffi.system b/uffi.system index f5c5ba7..020d8c0 100644 --- a/uffi.system +++ b/uffi.system @@ -9,7 +9,7 @@ ;;;; ;;;; Copyright (c) 2002 Kevin M. Rosenberg ;;;; -;;;; $Id: uffi.system,v 1.1 2002/03/09 19:55:33 kevin Exp $ +;;;; $Id: uffi.system,v 1.2 2002/03/09 21:53:58 kevin Exp $ ;;;; ;;;; This file is part of UFFI. ;;;; @@ -82,7 +82,7 @@ (:file "strings" :depends-on ("immediates")) (:file "objects" :depends-on ("immediates")) (:file "aggregates" :depends-on ("immediates")) - (:file "routine" :depends-on ("immediates")) + (:file "functions" :depends-on ("immediates")) (:file "libraries" :depends-on ("package"))) )