CLisp 29：调用C程序之回调函数

       从LISP中调用C代码，再从C代码回调LISP的函数。有三种方式：通过输入参数传递函数指针；通过外部变量传递函数指针；编译时静态链接。

 

       先看第一种方式，通过参数传递函数指针。

       typedef int (*LispFunc) (int);

__declspec(dllexport)

int CallLispFunc1(int x, int y, LispFunc f)

{

              if (f) return f(x) * f(y);

              else   return x * y;

}

在LISP定义一个函数类型，避免定义外部函数时参数太长

(def-c-type fcallback (ffi::c-function (:arguments (number int)) (:return-type int))))

(def-call-out call1 (:name “CallLispFunc1”)

       (:return-type int)

       (:arguments (x int) (y int) (f fcallback)))

(defun foo (x) (+ x 1))  被C调用的函数

(call1 3 4 #’foo) => 20

 

再看第二种方式，通过外部变量传递函数指针。

__declspec(dllexport)

LispFunc pf = 0;    前面定义了LispFunc类型

int CallLispFunc2(int x, int y)

{

       if (pf) return pf(x) * pf(y);

       else    return x * y;

}

(def-call-out call2 (:name “CallLispFunc2”)

       (:return-type int)

       (:arguments (x int) (y int))

(call2 3 4) => 12  此时没有设置函数指针

(def-c-var pf fcallback) 外部变量，函数指针

(setf pf #’foo) 设置函数指针，注意是setf，不是setq

(call2 3 4) => 20

 

第三种方式在Windows上没有试成功，找不到需要的文件。

extern int LispCallBack (int);

int CallLispFunc3(int x, inty)

{

       return LispCallBack (x) * LispCallBack (y);

}

上面的C代码不能通过链接，因为找不到函数LispCallBack。需要写一个LISP文件，编译LISP文件后生成另一个C文件，此C文件中带有函数LispCallBack。

(defpackage "ffi-test" (:use "COMMON-LISP" "FFI"))

(in-package "ffi-test")

(eval-when (compile) (setq ffi::*output-c-functions* t))

(def-call-in LispCallBack

  (:arguments (n int))

  (:return-type int)

  (:language :stdc))

(defun LispCallBack (x)

  (+ x 1))

编译上面LISP文件，假设文件名为c2.lisp，编译后生成c2.c文件。

lisp.exe -M fulllisp.mem -q -c c2.lisp

c2.c文件的主要部分如下，不是全部。包含了clisp.h文件，该文件在clisp/linkkit目录下，但它是Linux下的文件，在Windows下编译会报错。首先是没有文件<stdbool.h>，注释掉后又冒出更多的编译错误。即使解决了编译文件，链接时又会找不到funcall函数，Windows下找不到对应的DLL文件。

#include "clisp.h"

int (lispcallback) (int g3553)

{

  begin_callback();

  pushSTACK(sint_to_I(g3553));

  funcall(module__zz__object_tab[0],1);

 {

  int retval;

  if (sint_p(value1)) *&retval=I_to_sint(value1); else error_sint(value1);

  end_callback();

  return retval;

 }

}