Callbacks

Luke Tierney
1999/10/07

Introduction

This note describes one possible approach to adding callbacks to the wrapper system. To use it, load in the file wrappers file wrap.lsp and then the file callback.lsp before creating your wrappers. You can ignore the warning about a constant being redefined when you load the callback file---eventually this callback code will be merged into the wrappers file. The examples from this note are in the file cbtest.wrp.

Issues

Ideally, one would like to be able to write an expression like 
(make-mycallback #'(lambda (x) (sqrt x)) (:flonum) :flonum)
to produce a native pointer object that contains a C function pointer that can be used with the specified signature to call the Lisp closure argument. Unfortunately it does not seem possible to implement this in portable C code. CLISP [cite clisp_common_lisp] includes some very fancy code based on the guts of GCC that is able to do something like this on most architectures, but it is too complex for me to emulate and since it is GPL I can't use it directly. I also don't think it has been ported to the Macintosh, though it may have, and if not it may be possible to adapt the AIX code.

As an alternative, the approach used here creates a global C function pointer that calls a specified global Lisp function. As a variation, the callback can be configured to call a function stored in a global variable. This allows a user-specified function to be passed via a dynamically scoped variable. This approach is certainly not ideal, but should work for most purposes.

Interface and Examples

Callbacks are added by the c-callback macro. This macro defines a C function that calls a specified global lisp function. The arguments to the macro are the C function name (a string), the lisp function name (a symbol), a list of argument types, and a value type. Keyword arguments can be used to specify whether the function should be declared static (:static, default true), whether interrupts are allowed (:interrupts-allowed, default true) and whether non-local exits are to be trapped (:trap-exits, default nil). If the the :trap-exits keyword is not nil is should be a string specifying the C expression to use for producing a value when a non-local exit is attempted.

As an example, the file cbtest.wrp contains a little zero finder written in C and a lisp interface. 

<cbtest.wrp>=
(wrap:c-lines "
<zero finder C code>
")
<interface wrapper example code>

The zero finder C code is 

<zero finder C code>= (<-U)
#include <math.h>
#include <stdio.h>

#define SIGNUM(x) (((x) > 0) ? 1 : ((x) < 0) ? -1 : 0)

double zero(double (*f)(double), double a, double b, double fa, double fb,
            double tol)
{
  if (b - a <= tol)
    return (b + a)/2.0;
  else if (0 <= fa && 0 <= fb)
    return fa < fb ? a : b;
  else if (0 >= fa && 0 >= fb)
    return fa < fb ? b : a;
  else {
    double c = (b + a) / 2.0;
    double fc = f(c);
    if (SIGNUM(fa) == SIGNUM(fc))
      return zero(f, c, b, fc, fb, tol);
    else
      return zero(f, a, c, fa, fc, tol);
  }
}
Defines zero (links are to index).

The function to zero is a static C function called g. This function is a callback to a global lisp function. The base interface function calls zero with this static function. 

<interface wrapper example code>= (<-U) [D->]
(wrap:c-callback "g" zerofun (:flonum) :flonum)
(wrap:c-lines "
double base_zero(double a, double b, double tol)
{
  return zero(g, a, b, g(a), g(b), tol);
}
")
(wrap:c-function base-zero "base_zero" (:flonum :flonum :flonum) :flonum)
Defines base-zero, base_zero, g (links are to index).

The lisp function zero uses a dynamically scoped variable to hold its user function to zero, and this variable is looked up and used by the zerofun function. 

<interface wrapper example code>+= (<-U) [<-D->]
(defvar *zerofun*)
(defun zerofun (x) (funcall *zerofun* x))
(defun zero (f a b &optional (tol .00001))
  (let ((*zerofun* f))
    (base-zero a b tol)))
Defines zero, *zerofun*, zerofun (links are to index).

Using this code produces 

> (zero #'cos 0 pi)
1.5707993228511228

As an alternative, the callback can be configured to look up its Lisp function in the variable binding of a specified symbol. The expression 

<interface wrapper example code>+= (<-U) [<-D->]
(wrap:c-callback-variable "gv" *zerofun* (:flonum) :flonum)
Defines gv (links are to index).

defines a static C function gv that calls the Lisp function stored as the variable binding of the dynamically scoped variable *zerofun*. With this approach it is not necessary to define the intermediate Lisp function zerofun. The base interface function is defined to use gv, 

<interface wrapper example code>+= (<-U) [<-D->]
(wrap:c-lines "
double base_zero_v(double a, double b, double tol)
{
  return zero(gv, a, b, gv(a), gv(b), tol);
}
")
(wrap:c-function base-zero-v "base_zero_v" (:flonum :flonum :flonum) :flonum)
Defines base-zero-v, base_zero_v (links are to index).

and the user level interface stores the user function and calls the base interface. 

<interface wrapper example code>+= (<-U) [<-D]
(defun zero-v (f a b &optional (tol .00001))
  (let ((*zerofun* f))
    (base-zero-v a b tol)))
Defines zero-v (links are to index).

Using this version produces 

> (zero-v #'cos 0 pi)
1.5707993228511228

Implementation

The implementation is in callback.lsp. 

<callback.lsp>=
(in-package "WRAP")

<callback wrapping macros>
<callback support code>

The support code consists of format constants and functions. 

<callback support code>= (<-U) [D->]
<callback support constants>
<callback support functions>

The two public macros are defined in terms of a common wrapping function. 

<callback wrapping macros>= (<-U)
(export '(c-callback c-callback-variable))

(defmacro c-callback (cname lname args value &key
                            (static t)
                            (interrupts-allowed t)
                            trap-exits)
  (write-c-callback cname lname args value nil
                    static interrupts-allowed trap-exits))

(defmacro c-callback-variable (cname lname args value &key
                                     (static t)
                                     (interrupts-allowed t)
                                     trap-exits)
  (write-c-callback cname lname args value t
                    static interrupts-allowed trap-exits))
Defines c-callback, c-callback-variable (links are to index).

The wrapping function fills in the template 

<callback support constants>= (<-U) [D->]
(defconstant c-callback-fmt "~
~@[~*static ~]~a ~a(~:[~3*~;~a ~a~:{,~a ~a~}~])
{~
~@[~& ~a xlw__vv;~]
  ~a~
~@[~&  return xlw__vv;~]
}")
Defines c-callback-fmt (links are to index).

The wrapping function is defined by 

<callback support functions>= (<-U) [D->]
(defun write-c-callback (cname lname args value variable
                               static interrupts-allowed trap-exits)
  (dolist (a args)
    (when (pointer-type-p a)
          (register-pointer-type (second a))))
  (when (pointer-type-p value)
        (register-pointer-type (second value)))
  (let* ((ainfo (c-callback-arginfo args))
         (vtype (c-type value))
         (vvtype (if (eq value :void) nil vtype))
         (call <make call from lname, variable, ainfo, and value>)
         (ebody (if trap-exits
                    <wrap exit trapping around call>
                    call))
         (body (if interrupts-allowed
                   ebody
                 (format nil c-callback-disable-interrupts-fmt ebody))))
    (write-c-line c-callback-fmt static vtype cname
                  args (first (first ainfo)) (second (first ainfo))
                  (rest ainfo)
                  vvtype body vvtype)))
Defines write-c-callback (links are to index).

The arguments are processed by c-callback-arginfo. This function returns a list of entries, each consisting of the C type, a variable name, and a C expression for converting the Lisp argument to the appropriate C type. 

<callback support code>+= (<-U) [<-D]
(defun c-callback-arginfo (args)
  (let ((val nil)
        (count 0))
    (dolist (a args (nreverse val))
      (incf count)
      (let* ((ct (c-type a))
             (v (format nil "xlw__x~d" count))
             (arg (format nil (c-value-fmt a) v "NIL")))
        (push (list ct v arg) val)))))
Defines c-callback-arginfo (links are to index).

The value returned by the Lisp function needs to be converted back to the appropriate C type. This is handled by c-callback-value-fmt. For the pointer case, this function needs to fill in a template. It would be better to make this code into a C function that is part of the support code, and I will do that eventually, but it isn't a big issue since pointer return values are likely to be rare in callbacks. 

<callback support functions>+= (<-U) [<-D]
(defun c-callback-value-fmt (value)
  (cond
   ((eq value :void) nil)
   ((pointer-type-p value)
    (let ((null-ok (if (rest (rest value)) (third value) t))
          (mt (mangled-type (second value))))
      (format nil c-callback-ptr-value-fmt null-ok mt)))
   (t (format nil "xlw__vv = ~@?;" (c-argument-fmt value) "xlw__v"))))
Defines c-callback-value-fmt (links are to index).

<callback support constants>+= (<-U) [<-D->]
(defconstant c-callback-ptr-value-fmt "{
      int null_ok = ~:[FALSE~;TRUE~];
      if (null(xlw__v)) {
        if (! null_ok) xlbadtype(xlw__v);
        xlw__vv = NULL;
      }
      else {
        if (! cptr_type_p(xlw__v,CPTR_TYPE(~a)) ||
            (getcpaddr(xlw__v) == NULL && ! null_ok))
          xlbadtype(xlw__v);
        xlw__vv = getcpaddr(xlw__v);
      }
    }")
Defines c-callback-ptr-value-fmt (links are to index).

The call is constructed by filling in the template 

<callback support constants>+= (<-U) [<-D->]
(defconstant c-callback-call-fmt "{
    FRAMEP newfp;
    LVAL xlw__v;
    static LVAL fsym = NULL;
    if (fsym == NULL)
      fsym = xlenter(\"~a::~a\");
    newfp = xlsp;
    pusharg(cvfixnum((FIXTYPE)(newfp - xlfp)));
    pusharg(~a(fsym));
    pusharg(cvfixnum((FIXTYPE)~d));
~{    pusharg(~a);~&~}~
~&    xlfp = newfp;
    xlw__v = xlapply(~d);~
~@[~&    ~a~]
  }")
Defines c-callback-call-fmt (links are to index).

The template is filled by 

<make call from lname, variable, ainfo, and value>= (<-U)
(format nil c-callback-call-fmt
        (package-name (symbol-package lname)) (symbol-name lname)
        (if variable "xlgetvalue" "xlgetfunction")
        (length ainfo)
        (mapcar #'third ainfo)
        (length ainfo)
        (c-callback-value-fmt value))

Exit trapping is wrapped around the call by filling in the template 

<callback support constants>+= (<-U) [<-D->]
(defconstant c-callback-exit-trap-fmt "{
    CONTEXT cntxt;
    xlbegin(&cntxt, CF_UNWIND | CF_ERROR, NIL);
    if (setjmp(cntxt.c_jmpbuf))
      xlw__vv = ~a;
    else
      ~a
    xlend(&cntxt);
  }")
Defines c-callback-exit-trap-fmt (links are to index).

The template is filled with 

<wrap exit trapping around call>= (<-U)
(let ((exit-value (if (stringp trap-exits) trap-exits 0)))
  (format nil c-callback-exit-trap-fmt exit-value call))

Finally, interrupts are disabled by filling in the template 

<callback support constants>+= (<-U) [<-D]
(defconstant c-callback-disable-interrupts-fmt "~&
  disable_interrupts();
  ~a
  enable_interrupts();
")
Defines c-callback-disable-interrupts-fmt (links are to index).

The handling of interrupts needs to be cleaned up once I figure out how to handle it properly for the whole system.

References

[1] CLISP common lisp. http://clisp.cons.org/ haible/clisp.html.

Indices

Chunks

Identifiers