X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Ffunctions.lisp;fp=src%2Ffunctions.lisp;h=927365da1a8518daa13afca5a47530a64966af72;hb=579b6d8e7ce89151996dd3ea9c29bb4419a4a8ed;hp=03b8d59f72bece9e317bd5ac19a94bda89dba1de;hpb=772583326d24ba87e8f3a3fbab5c27664ba2b2a1;p=uffi.git diff --git a/src/functions.lisp b/src/functions.lisp index 03b8d59..927365d 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.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 ))