r11088: Automated commit for Debian build of uffi upstream-version-1.5.16

[uffi.git] / src / functions.lisp

diff --git a/src/functions.lisp b/src/functions.lisp
index 35f9f9837c5b8d5037253c53f16c744b105fe6c3..dc7dca2841e45874ca33066a865b9547ac01708c 100644 (file)
--- a/src/functions.lisp
+++ b/src/functions.lisp
@@ -9,23 +9,20 @@
 ;;;;
 ;;;; $Id$
 ;;;;
 ;;;;
 ;;;; $Id$
 ;;;;

-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2005 by Kevin M. Rosenberg

 ;;;;
 ;;;;

-;;;; UFFI 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.

 ;;;; *************************************************************************
 
 (in-package #:uffi)
 
 (defun process-function-args (args)
   (if (null args)
 ;;;; *************************************************************************
 
 (in-package #:uffi)
 
 (defun process-function-args (args)
   (if (null args)

-      #+(or lispworks cmu sbcl scl cormanlisp (and mcl (not openmcl))) nil
+      #+(or lispworks cmu sbcl scl cormanlisp digitool) nil

       #+allegro '(:void)
       #+openmcl (values nil nil)
 
       ;; args not null
       #+allegro '(:void)
       #+openmcl (values nil nil)
 
       ;; args not null

-      #+(or lispworks allegro cmu sbcl scl (and mcl (not openmcl)) cormanlisp)
+      #+(or lispworks allegro cmu sbcl scl digitool cormanlisp)

       (let (processed)
        (dolist (arg args)
          (push (process-one-function-arg arg) processed))
       (let (processed)
        (dolist (arg args)
          (push (process-one-function-arg arg) processed))


@@ -50,7 +47,7 @@
     #+(or cmu sbcl scl)
     ;(list name type :in)
     `(,name ,type ,@(if (= (length arg) 3) (list (third arg)) (values)))
     #+(or cmu sbcl scl)
     ;(list name type :in)
     `(,name ,type ,@(if (= (length arg) 3) (list (third arg)) (values)))

-    #+(or allegro lispworks (and mcl (not openmcl)))
+    #+(or allegro lispworks digitool)

     (if (and (listp type) (listp (car type)))
        (append (list name) type)
       (list name type))
     (if (and (listp type) (listp (car type)))
        (append (list name) type)
       (list name type))


@@ -138,8 +135,6 @@
 
 
 (defmacro def-function (names args &key module returning)
 
 
 (defmacro def-function (names args &key module returning)

-  #+(or cmu sbcl scl allegro mcl cormanlisp) (declare (ignore module))
-

   (multiple-value-bind (lisp-args out processed)
       (preprocess-args args)
     (if (= (length out) 0)
   (multiple-value-bind (lisp-args out processed)
       (preprocess-args args)
     (if (= (length out) 0)


@@ -174,7 +169,7 @@
 ;; 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)
 ;; 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 sbcl scl allegro mcl cormanlisp) (declare (ignore module))
+  #+(or cmu sbcl scl allegro openmcl digitool cormanlisp) (declare (ignore module))

   
   (let* ((result-type (convert-from-uffi-type returning :return))
         (function-args (process-function-args args))
   
   (let* ((result-type (convert-from-uffi-type returning :return))
         (function-args (process-function-args args))


@@ -202,8 +197,8 @@
        ,@(if module (list :module module) (values))
        :result-type ,result-type
       :language :ansi-c
        ,@(if module (list :module module) (values))
        :result-type ,result-type
       :language :ansi-c

-       :calling-convention :cdecl)
-    #+(and mcl (not openmcl))
+       #-macosx :calling-convention #-macosx :cdecl)
+    #+digitool

     `(eval-when (:compile-toplevel :load-toplevel :execute)
        (ccl:define-entry-point (,lisp-name ,foreign-name)
          ,function-args
     `(eval-when (:compile-toplevel :load-toplevel :execute)
        (ccl:define-entry-point (,lisp-name ,foreign-name)
          ,function-args