r10917: 2006-04-17 Kevin Rosenberg (kevin@rosenberg.net)

[uffi.git] / src / functions.lisp

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


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


@@ -200,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