# 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
#
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
--- /dev/null
+;;;; -*- 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))))
+
+
+++ /dev/null
-;;;; -*- 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))))
-
-
;;;;
;;;; 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.
;;;;
(: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")))
)
projects / uffi.git / commitdiff