r3060: *** empty log message ***

[uffi.git] / src / functions.lisp

diff --git a/src/functions.lisp b/src/functions.lisp
index 03b8d59f72bece9e317bd5ac19a94bda89dba1de..f23ec8f6163de4f38f06083c5233ca952105a90b 100644 (file)
--- a/src/functions.lisp
+++ b/src/functions.lisp
@@ -3,11 +3,11 @@
 ;;;; FILE IDENTIFICATION
 ;;;;
 ;;;; Name:          function.cl
-;;;; Purpose:       UFFI source to C function defintions
+;;;; Purpose:       UFFI source to C function definitions
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: functions.lisp,v 1.1 2002/09/30 10:02:36 kevin Exp $
+;;;; $Id: functions.lisp,v 1.5 2002/10/16 11:56:43 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -21,14 +21,12 @@
 
 (defun process-function-args (args)
   (if (null args)
-      #+lispworks nil
+      #+(or lispworks cmu sbcl scl cormanlisp (and mcl (not openmcl))) nil
       #+allegro '(:void)
-      #+cmu nil
-      #+(and mcl (not openmcl)) nil
       #+mcl (values nil nil)
 
       ;; args not null
-      #+(or lispworks allegro cmu (and mcl (not openmcl)))
+      #+(or lispworks allegro cmu sbcl scl (and mcl (not openmcl)) cormanlisp)
       (let (processed)
        (dolist (arg args)
          (push (process-one-function-arg arg) processed))
@@ -51,7 +49,7 @@
 (defun process-one-function-arg (arg)
   (let ((name (car arg))
        (type (convert-from-uffi-type (cadr arg) :routine)))
-    #+cmu
+    #+(or cmu sbcl scl)
     (list name type :in)
     #+(or allegro lispworks (and mcl (not openmcl)))
     (if (and (listp type) (listp (car type)))
@@ -68,23 +66,28 @@
 ;; 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 mcl) (declare (ignore module))
+  #+(or cmu sbcl scl allegro mcl cormanlisp) (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))))
-    
+
+    ;; todo: calling-convention :stdcall for cormanlisp
     #+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
+    #+(or cmu scl)
     `(alien:def-alien-routine (,foreign-name ,lisp-name)
         ,result-type
        ,@function-args)
+    #+sbcl
+    `(sb-alien:define-alien-routine (,foreign-name ,lisp-name)
+        ,result-type
+       ,@function-args)
     #+lispworks
     `(fli:define-foreign-function (,lisp-name ,foreign-name :source)
         ,function-args
@@ -102,6 +105,12 @@
     (multiple-value-bind (params args) (process-function-args args)
       `(defun ,lisp-name ,params
          (ccl::external-call ,foreign-name ,@args ,result-type)))
+    #+cormanlisp
+    `(ct:defun-dll ,lisp-name (,function-args)
+       :return-type ,result-type
+       ,@(if module (list :library-name module) (values))
+       :entry-name ,foreign-name
+       :linkage-type ,calling-convention) ; we need :pascal
     ))