r11214: 2006-10-10 Kevin Rosenberg (kevin@rosenberg.net)

[uffi.git] / src / functions.lisp

diff --git a/src/functions.lisp b/src/functions.lisp
index 5552ffb67f5359084333b919c2a25a568d4ebca4..fb74d6aaf1d7a5c8c08eb54583fe3ee355d0c557 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))


@@ -140,6 +137,7 @@
 (defmacro def-function (names args &key module returning)
   (multiple-value-bind (lisp-args out processed)
       (preprocess-args args)
 (defmacro def-function (names args &key module returning)
   (multiple-value-bind (lisp-args out processed)
       (preprocess-args args)

+    (declare (ignorable lisp-args processed))

     (if (= (length out) 0)
        `(%def-function ,names ,args 
          ,@(if module (list :module module) (values))
     (if (= (length out) 0)
        `(%def-function ,names ,args 
          ,@(if module (list :module module) (values))


@@ -172,7 +170,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))


@@ -200,8 +198,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))
+       #+:win32 :calling-convention #+:win32 :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