X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Ffunctions.lisp;h=ad8aca4382a2ff8b7091b9606b63a83bc931789f;hb=7653a03580807774202e699a091a2e8520db5cf8;hp=03b8d59f72bece9e317bd5ac19a94bda89dba1de;hpb=a95b9a217335917d96b8c0cced4f49c3e4846115;p=uffi.git

diff --git a/src/functions.lisp b/src/functions.lisp
index 03b8d59..ad8aca4 100644
--- 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.4 2002/10/14 03:07:41 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 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 (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)
     (list name type :in)
     #+(or allegro lispworks (and mcl (not openmcl)))
     (if (and (listp type) (listp (car type)))
@@ -68,13 +66,14 @@
 ;; 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 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
@@ -85,6 +84,10 @@
     `(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
     ))