00001 /* Example for EusLisp foreign language interface 00002 /* last maintained: 2004-Dec-16 by Toshihiro Matsui, DHRC, AIST 00003 /* C program named cfunc.c 00004 /* 00005 /* Compile this program with the following command line on Linux 00006 /* % cc -c -falign-functions=4 cfunc.c; ld -o cfunc.so -shared cfunc.o 00007 */ 00008 00009 static int (*g)(); /* variable to store Lisp function entry */ 00010 static double (*gf)(); 00011 00012 double sync(x) 00013 double x; 00014 { extern double sin(); 00015 return(sin(x)/x);} 00016 00017 char *upperstring(s) 00018 char *s; 00019 { char *ss=s; 00020 while (*s) { if (islower(*s)) *s=toupper(*s); s++;} 00021 return(ss);} 00022 00023 int setlfunc(f) /* remember the argument in g just to see */ 00024 int (*f)(); /* how Lisp function can be called from C */ 00025 { g=f;} 00026 00027 int setlffunc(f) /* remember the argument in g just to see */ 00028 double (*f)(); /* how Lisp function can be called from C */ 00029 { gf=f;} 00030 00031 int callfunc(x) /* apply the Lisp function saved in g to the arg.*/ 00032 int x; 00033 { return((*g)(x));} 00034 00035 double callfltfunc(double dx) 00036 { return((*gf)(dx)); } 00037 00038 00039 /************************* 00040 ;;;; Example program for EusLisp's foreign language interface 00041 ;;;; make foreign-module 00042 (setq m (load-foreign "cfunc.so")) 00043 00044 ;; define foreign functions so that they can be callable from lisp 00045 (defforeign sync m "sync" (:float) :float) 00046 (defforeign toupper m "upperstring" (:string) :string) 00047 (defforeign setlfunc m "setlfunc" (:integer) :integer) 00048 (defforeign setlffunc m "setlffunc" (:integer) :integer) 00049 (defforeign callfunc m "callfunc" (:integer) :integer) 00050 (defforeign callfltfunc m "callfltfunc" (:float) :float) 00051 00052 ;; call them 00053 (sync 1.0) ;; --> 0.841471 00054 (print (toupper "abc123")) ;;--> "ABC123" 00055 00056 ;; define a test function which is callable from C. 00057 (defun-c-callable LISP-INTFUNC ((a :integer)) :integer 00058 (format t "LISP-INTFUNC is called, arg=~s~%" a) 00059 (* a a)) ;; return the square of the arg 00060 (defun-c-callable LISP-FLTFUNC ((f :float)) :float 00061 (format t "LISP-FLTFUNC is called, arg=~s~%" f) 00062 (sqrt f)) ;; return the square root of the arg 00063 00064 ;; call it from C 00065 ;;setlfunc remembers the entry address of Lisp TEST function. 00066 (setlfunc (pod-address 'LISP-INTFUNC)) 00067 (callfunc 12) ;; --> 144 00068 (setlffunc (pod-address 'LISP-FLTFUNC)) 00069 (callfltfunc 2.0) 00070 ********************************/ 00071