r2927: Integrate Reini Urban's cormanlisp patches into main UFFI source

[uffi.git] / src / functions.lisp

diff --git a/src/functions.lisp b/src/functions.lisp
index 03b8d59f72bece9e317bd5ac19a94bda89dba1de..927365da1a8518daa13afca5a47530a64966af72 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.2 2002/10/01 17:05:29 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 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 (and mcl (not openmcl)) cormanlisp)
       (let (processed)
        (dolist (arg args)
          (push (process-one-function-arg arg) processed))
@@ -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 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
@@ -102,6 +101,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
     ))