Interfacing to C Code

Luke Tierney

Table of Contents


This report presents a first draft of a system for automating the generation of interfaces between XLISP-STAT and C code. The system uses the new shared library and native pointer mechanisms. Some of the design is derived from the SWIG system [cite beazley97:_swig_users_manual].

To use this code you will need the snapshot of February 3, 1998, or later. This includes support code. You also need the file wrap.lsp, which is available in the Extras/wrappers directory of the source tree. On UNIX systems you should be able to install the wrapper code by running configure and make in the root of the distribution and then configure and make install in the Extras/wrappers subdirectory. On the Macintosh or Win32 you can load wrap.lsp into the executable. Some additional files for the Macintosh and for Win32 are also avilable.

Simple Examples

[*] Suppose we have a C file csimple.c containing

double fred = 2.0;

int cfrog(int x, int y)
  return x + y;

and want to provide access to fred and cfrog from Lisp. To do this, create a file simple.wrp containing

<simple.wrp>= [D->]
(wrap:c-lines "extern double fred;"
              "int cfrog (int, int);")
(wrap:c-variable "fred" :flonum (:get get-fred) (:set set-fred))
(wrap:c-function frog "cfrog" (:integer :integer) :integer)

From within XLISP-STAT, first load wrap.lsp and then evaluate

(wrap:make-wrappers "simple.wrp")
This creates two files, simple.c and simple.lsp. [Don't call the wrappers file csimple.wrp because make-wrappers would end up overwriting csimple.c.]

Next, create a shared library simple.dll from csimple.c and simple.c. On HP-UX, for example, this would be done with

cc -Aa +z -DX11WINDOWS -g -D_XPG2 -D_HPUX_SOURCE \ 
  -I/usr/include/X11R5 -I../.. -c csimple.c -o csimple.o
ld -b -o simple.dll simple.o csimple.o

Finally, load simple.lsp, or byte compile and load simple.fsl, and we can use the wrappers. get-fred returns the current value of the C variable fred,

> (get-fred)
and set-fred changes the value [Eventually these can be replaced by a global symbol macro, but these are not available yet.] :
> (set-fred 3)
> (get-fred)
The Lisp function frog calls the C function cfrog
> (frog 1 2)

C constants can be mapped to Lisp constants by adding appropriate calls to the c-constant macro in the wrapper file simple.wrp.

<simple.wrp>+= [<-D]
(wrap:c-lines "#define A_LONG 7"
              "#define A_FLONUM 3.1415"
              "#define A_STRING \"my string\""
              "#define A_ULONG 0xFFFFFFFF")
(wrap:c-constant a-long "A_LONG" :integer)
(wrap:c-constant a-flonum "A_FLONUM" :flonum)
(wrap:c-constant a-string "A_STRING" :string)
(wrap:c-constant a-ulong "A_ULONG" :unsigned)

These can then be accessed as

> a-long
> a-flonum
> a-string
"my string"
> a-ulong

When accessing system functions we usually need to include a header file. This is done with the c-lines macro. For example, to access the POSIX getlogin and getuid functions we can use

<POSIX wrappers>= (U->) [D->]
(wrap:c-lines "#include <unistd.h>")
(wrap:c-function getuid "getuid" () :integer)
(wrap:c-function getlogin "getlogin" () :string)
Defines getlogin, getuid (links are to index).

<public POSIX symbols>= (U->) [D->]
getuid getlogin

defined in the file posix.wrp. These are used as

> (posix:getuid)
> (posix:getlogin)

As a final, more elaborate example, suppose we want to access the information returned by getpwnam and getpwuid. These functions return a pointer to a struct passwd, which is defined in pwd.h and must contain the fields [cite lewine91:_posix_progr_guide, p. 554]

Member Name Member Type
pw_name char *
pw_uid uid_t
pw_gid gid_t
pw_dir char *
pw_shell char *
These are the fields required by POSIX. Other fields may be available on some systems.

We can provide read access to these elements [I'm not sure how best to deal with other elements on a system-dependent basis; I suppose the #+ mechanism could be used but that seems less than ideal.] of a struct passwd structure referenced by a pointer with

<POSIX wrappers>+= (U->) [<-D->]
(wrap:c-lines "#include <pwd.h>")
(wrap:c-pointer (:struct "passwd")
                (:get pw-name "pw_name" :string)
                (:get pw-uid "pw_uid" :integer)
                (:get pw-gid "pw_gid" :integer)
                (:get pw-dir "pw_dir" :string)
                (:get pw-shell "pw_shell" :string))

Given a pointer p to such a structure, we can then, for example, retrieve the name component with

(pw-name p)

Wrappers for the getpwnam and getpwuid functions that return pointers to the internal struct passwd data are defined as

<POSIX wrappers>+= (U->) [<-D->]
(wrap:c-function base-getpwnam "getpwnam" (:string) (:cptr (:struct "passwd")))
(wrap:c-function base-getpwuid "getpwuid" (:integer) (:cptr (:struct "passwd")))

We can then define user-level functions that return all POSIX-specified elements of the passwd structure as multiple values [This is consistent with the way CL handles the time decomposition functions, for example. An alternative would be to define and return an appropriate Lisp structure or object.] by

<POSIX wrappers>+= (U->) [<-D->]
(defun getpwnam (name)
  (pw-values (base-getpwnam name)))
(defun getpwuid (uid)
  (pw-values (base-getpwuid uid)))
Defines getpwnam, getpwuid (links are to index).

<public POSIX symbols>+= (U->) [<-D->]
getpwnam getpwuid

These functions need locking in a multi-threaded environment. The multiple value returns are constructed by

<POSIX wrappers>+= (U->) [<-D->]
(defun pw-values (pw)
  (when pw
        (values  (pw-name pw)
                 (pw-uid pw)
                 (pw-gid pw)
                 (pw-dir pw)
                 (pw-shell pw))))
Defines pw-values (links are to index).

The (when pw ...) form in this definition allows for the fact that a NULL pointer, the error return for the C functions, is returned as NIL by the wrapper functions.

Some examples:

> (posix:getpwnam "fred")
> (posix:getpwnam "luke")
> (posix:getpwuid 100)

Overview of the Wrapper System

To create an interface to some C code you write a wrapper file with a .wrp extension, such as the file simple.wrp in the previous section. This file can contain Lisp code [Currently there are a few minor restrictions that will be lifted eventually. Top level macrolets are not allowed and nested eval-when expressions do not work properly.] or top-level calls to the wrapper macros. [Top-level means directly at top level or, recursively, in a top level progn, possibly after macro expansion. The process of generating wrappers is very similar to the compiler top level and the two may eventually be merged.] Lisp code is essentially copied with some minor additions and changes to a .lsp file and the wrapper macros produce code in a .c file.

The symbols and macros for the wrapper system are exported from the C-WRAPPERS package with nickname WRAP. Wrapper files could define their packages to :use this package, but that isn't necessary since the wrapper code is not needed at runtime, only at wrap time, which is treated as the equivalent of compile time for determining when expressions are evaluated during wrapping. Instead, it is best to reference the symbols with fully qualified names using the wrap: prefix.

The function make-wrappers is responsible for generating wrappers from its file argument. This function also accepts a :name keyword argument for specifying an alternate module name; the default module name is the base name of the file. The module name is used to construct the names of the C and Lisp output files.

The wrapper macros exported from the C-WRAPPERS package are

writes its argument strings to the C file.
defines a Lisp constant corresponding to a C constant (typically a defined C macro or an enum value).
allows reader and writer functions for accessing a C variable to be specified.
specifies an interface to a C function.
registers a C SUBR implementation.
specifies constructors and accessors for pointers to compound data structures.
specifies version information for the shared library.
Before examining these in detail we need to review how type information is represented and interpreted by the wrappers.

Type Information

There are two forms of type specifiers, Lisp-types and C-types. Lisp-types specify what Lisp type is expected or to be returned, and C-types describe what C-types are expected. C-types can be of the following form: Lisp-types are symbols or lists of the following form. C Pointers are represented in Lisp as a pairing of a native pointer and a type tag. Functions expecting a pointer of a particular type will usually also accept NIL, interpreted as a null pointer, or a pointer of C-type (cptr "void").

The c-lines Macro

This macro takes an arbitrary number of string arguments and writes them without modification to the C file opened by make-wrappers. This macro is used for including header files and small bits of C code. For example,
(wrap:c-lines "#include <stdlib.h>"
              "#include <stdio.h>"
              "#define _POSIX_SOURCE 1"
Larger bits are probably best written in separate files that are compiled separately or included with an #include directive.

The c-constant Macro

This macro is used to define Lisp constants, as with defconstant, that correspond to C constants. The use is
(wrap:c-constant symbol string type)
where symbol is the Lisp symbol for the constant, string is the C name of the constant, and type is one of the symbols :integer, :unsigned, :flonum, or :string. For example,
(wrap:c-constant long-max "LONG_MAX" :integer)
represents the ANSI C macro for the maximal value of a long.

The c-variable Macro

The c-variable macro defines readers and writers for C variables. The macro is called as
(wrap:c-variable name type clause1 clause2 ...)
name is a string naming the C variable and type is a Lisp-type. The clauses are of the form
(:get reader-name)
(:set writer-name)
where reader-name is the symbol naming the reader function and writer-name names the writer function. The reader function takes no arguments and the writer function takes one argument, the new value. The writer function returns its argument.

Section [<-] gives an example of accessing a C variable.

The c-function and c-subr Macros

The c-function macro is used to define a Lisp function to call a specified C function The call is of the form
(wrap:c-function symbol name (type-1 ... type-n) v-type)
where symbol names the Lisp function, name is the C function, type-1 ... type-n are Lisp-types specifying the expected argument types, and v-type is the Lisp-type for the value. The argument list may be empty and the value type may be :void. Errors are signaled if the arguments are not of the specified types. The C compiler should complain if the type casting required at the interface level is not legal. Section [<-] gives several examples of wrapping C functions.

The c-subr macro registers a function written as an internal SUBR with the module. The arguments are the Lisp symbol naming the function and the string naming the C implementation. A third optional argument specifies whether the SUBR returns multiple values; the default is a single-value SUBR. Section [->] gives several examples.

The c-pointer Macro

The c-pointer macro is used to access and allocate compound data types. The macro is used as
(wrap:c-pointer type clause1 ...)
Here type is the C-type of the elements referenced by the pointer, i.e. for a float * value it is "float". The clauses have one of the forms
(:make make-name)
(:cast cast-name)
(:offset offset-name)
(:get reader-name field type)
(:set writer-name field type)

:make clauses define a constructor function make-name that allocates new memory and returns a pointer to it. The memory is from the Lisp heap and is released by the garbage collector when no more references to it exist from Lisp values. The constructor takes an optional size argument representing the number of items of the type to allocate (or the number of bytes if the type is void). The default size is one.

:cast clauses define a casting function that returns a new C pointer to the argument object. The argument can be another C pointer or a native pointer object. The value returned is either the argument, if it is already of the required type, or a new pointer object referencing the same internal data as the argument but with the appropriate type tag.

:offset clauses define a function that returns a new pointer representing the first argument offset by the second argument. For void pointers the offset is interpreted as a byte count; for others it is an element count. Offset functions are rarely needed since accessor functions take an optional offset argument.

:get and :set clauses define readers and writers for the value of a pointer or a field of the data referenced by a pointer. For simple pointers, such as a double * pointer, the field component would be NIL. For a pointer to a structure the field would be a string naming the structure field. The type is the Lisp-type of the return or argument value value. Reader functions require one argument, the pointer to be read. They also accept a second optional argument, an integer representing an offset; the default offset is zero. Writer functions require two arguments, the pointer and a new value. They accept an optional offset as a third argument.

The c-version Macro

The c-version macro is used for specifying version information for the shared library. A complete call is of the form
(wrap:c-version major minor oldmajor oldminor)
The arguments specify the major and minor versions numbers of the current version and the major and minor version numbers of the oldest version. The final three arguments are optional. The default value of minor is zero and the default for the old version numbers are the current ones.

Sections [<-] and [->] contain several examples.

Additional Examples

[*] This section presents some more extensive examples of using the C wrappers facility. Another example is provided by the regular expression library, which has been rewritten to use wrappers.

Basic Pointers

[*] The file wrapptrs.wrp contains wrappers that provide access to basic pointers.

<pointer wrappers package and module setup>
<pointer wrapper code>

The functions defined here are placed in the POINTER-WRAPPERS package with nickname WRAPPTRS. The code is placed in the module named "wrapptrs".

<pointer wrappers package and module setup>= (<-U U->)
(provide "wrapptrs")
(defpackage "POINTER-WRAPPERS" (:nicknames "WRAPPTRS") (:use "XLISP"))
(in-package "WRAPPTRS")

(export '(<public pointer wrapper symbols>))

For generic pointers to void we only need a constructor and a caster.

<pointer wrapper code>= (<-U) [D->]
(wrap:c-pointer "void"
                (:make make-c-void)
                (:cast cast-c-void))
Defines cast-c-void, make-c-void (links are to index).

<public pointer wrapper symbols>= (<-U U->) [D->]
make-c-void cast-c-void

Pointers to generic pointers also need an offset and a reader function. An assignment function might make sense as well but I'll omit it for now.

<pointer wrapper code>+= (<-U) [<-D->]
(wrap:c-pointer (:cptr "void")
                (:make make-c-void-p)
                (:cast cast-c-void-p)
                (:offset offset-c-void-p)
                (:get get-c-void-p nil (:cptr "void")))
Defines cast-c-void-p, get-c-void-p, make-c-void-p, offset-c-void-p (links are to index).

<public pointer wrapper symbols>+= (<-U U->) [<-D->]
make-c-void-p cast-c-void-p offset-c-void-p get-c-void-p

For others we need the full range. The char integral types are

<pointer wrapper code>+= (<-U) [<-D->]
(wrap:c-pointer "char"
                (:make make-c-char)
                (:cast cast-c-char)
                (:offset offset-c-char)
                (:get get-c-char nil :integer)
                (:set set-c-char nil :integer))
(wrap:c-pointer (:signed "char")
                (:make make-c-schar)
                (:cast cast-c-schar)
                (:offset offset-c-schar)
                (:get get-c-schar nil :integer)
                (:set set-c-schar nil :integer))
(wrap:c-pointer (:unsigned "char")
                (:make make-c-uchar)
                (:cast cast-c-uchar)
                (:offset offset-c-uchar)
                (:get get-c-uchar nil :integer)
                (:set set-c-uchar nil :integer))
Defines cast-c-char, cast-c-schar, cast-c-uchar, get-c-char, get-c-schar, get-c-uchar, make-c-char, make-c-schar, make-c-uchar, offset-c-char, offset-c-schar, offset-c-uchar, set-c-char, set-c-schar, set-c-uchar (links are to index).

<public pointer wrapper symbols>+= (<-U U->) [<-D->]
make-c-char cast-c-char offset-c-char get-c-char set-c-char
make-c-schar cast-c-schar offset-c-schar get-c-schar set-c-schar
make-c-uchar cast-c-uchar offset-c-uchar get-c-uchar set-c-uchar

The short integral types are

<pointer wrapper code>+= (<-U) [<-D->]
(wrap:c-pointer "short"
                (:make make-c-short)
                (:cast cast-c-short)
                (:offset offset-c-short)
                (:get get-c-short nil :integer)
                (:set set-c-short nil :integer))
(wrap:c-pointer (:unsigned "short")
                (:make make-c-ushort)
                (:cast cast-c-ushort)
                (:offset offset-c-ushort)
                (:get get-c-ushort nil :integer)
                (:set set-c-ushort nil :integer))
Defines cast-c-short, cast-c-ushort, get-c-short, get-c-ushort, make-c-short, make-c-ushort, offset-c-short, offset-c-ushort, set-c-short, set-c-ushort (links are to index).

<public pointer wrapper symbols>+= (<-U U->) [<-D->]
make-c-short cast-c-short offset-c-short get-c-short set-c-short
make-c-ushort cast-c-ushort offset-c-ushort get-c-ushort set-c-ushort

The int types are

<pointer wrapper code>+= (<-U) [<-D->]
(wrap:c-pointer "int"
                (:make make-c-int)
                (:cast cast-c-int)
                (:offset offset-c-int)
                (:get get-c-int nil :integer)
                (:set set-c-int nil :integer))
(wrap:c-pointer (:unsigned "int")
                (:make make-c-uint)
                (:cast cast-c-uint)
                (:offset offset-c-uint)
                (:get get-c-uint nil :integer)
                (:set set-c-uint nil :integer))
Defines cast-c-int, cast-c-uint, get-c-int, get-c-uint, make-c-int, make-c-uint, offset-c-int, offset-c-uint, set-c-int, set-c-uint (links are to index).

<public pointer wrapper symbols>+= (<-U U->) [<-D->]
make-c-int cast-c-int offset-c-int get-c-int set-c-int
make-c-uint cast-c-uint offset-c-uint get-c-uint set-c-uint

The long types are

<pointer wrapper code>+= (<-U) [<-D->]
(wrap:c-pointer "long"
                (:make make-c-long)
                (:cast cast-c-long)
                (:offset offset-c-long)
                (:get get-c-long nil :integer)
                (:set set-c-long nil :integer))
(wrap:c-pointer (:unsigned "long")
                (:make make-c-ulong)
                (:cast cast-c-ulong)
                (:offset offset-c-ulong)
                (:get get-c-ulong nil :integer)
                (:set set-c-ulong nil :integer))
Defines cast-c-long, cast-c-ulong, get-c-long, get-c-ulong, make-c-long, make-c-ulong, offset-c-long, offset-c-ulong, set-c-long, set-c-ulong (links are to index).

<public pointer wrapper symbols>+= (<-U U->) [<-D->]
make-c-long cast-c-long offset-c-long get-c-long set-c-long
make-c-ulong cast-c-ulong offset-c-ulong get-c-ulong set-c-ulong

Floating point pointer wrappers are defined by

<pointer wrapper code>+= (<-U) [<-D->]
(wrap:c-pointer "float"
                (:make make-c-float)
                (:cast cast-c-float)
                (:offset offset-c-float)
                (:get get-c-float nil :flonum)
                (:set set-c-float nil :flonum))
(wrap:c-pointer "double"
                (:make make-c-double)
                (:cast cast-c-double)
                (:offset offset-c-double)
                (:get get-c-double nil :flonum)
                (:set set-c-double nil :flonum))
Defines cast-c-double, cast-c-float, get-c-double, get-c-float, make-c-double, make-c-float, offset-c-double, offset-c-float, set-c-double, set-c-float (links are to index).

<public pointer wrapper symbols>+= (<-U U->) [<-D->]
make-c-float cast-c-float offset-c-float get-c-float set-c-float
make-c-double cast-c-double offset-c-double get-c-double set-c-double

Finally, for pointers to strings we need a caster, offsetter and reader:

<pointer wrapper code>+= (<-U) [<-D]
(wrap:c-pointer (:cptr "char")
                (:cast cast-c-string)
                (:offset offset-c-string)
                (:get get-c-string nil :string))
Defines cast-c-string, get-c-string, make-c-string, offset-c-string, set-c-string (links are to index).

<public pointer wrapper symbols>+= (<-U U->) [<-D]
make-c-string cast-c-string offset-c-string get-c-string set-c-string

Lisp Data

[*] The file test.wrp contains some examples of using Lisp data and defining SUBRs.

Here is a simple interface to the internal cons function.

<test.wrp>= [D->]
(wrap:c-function my-cons "cons" (:lval :lval) :lval)
Defines my-cons (links are to index).

Instead of using c-function, we can define a SUBR and register it with c-subr.

<test.wrp>+= [<-D->]
(wrap:c-lines "~
static LVAL mycons(void)
  LVAL x = xlgetarg();
  LVAL y = xlgetarg();
  return cons(x,y);
(wrap:c-subr my-cons-1 "mycons")
Defines my-cons-1, mycons (links are to index).

As an example of a multiple value SUBR, here is a function that returns the car and cdr of a cons cell as multiple values.

<test.wrp>+= [<-D]
(wrap:c-lines "~
static LVAL myuncons(void)
  LVAL x = xlgacons();
  xlnumresults = 2;
  xlresults[0] = car(x);
  xlresults[1] = cdr(x);
  return car(x);
(wrap:c-subr my-uncons "myuncons" t)
Defines my-uncons, myuncons (links are to index).

Environment and User Information

A wrapper for the POSIX getenv function is defined by

<POSIX wrappers>+= (U->) [<-D->]
(wrap:c-function base-getenv "getenv" (:string) :string)

The entire environment is available in the global variable environ.

<POSIX wrappers>+= (U->) [<-D->]
(wrap:c-lines "extern char **environ;")
(wrap:c-variable "environ" (:cptr (:cptr "char")) (:get get-environ-cptr))

The public getenv function returns the entire environment if called with no argument and the value of the specified variable if a string argument is supplied:

> (posix:getenv)
("CVSROOT=/NOKOMIS/users/luke/SRC" "EDITOR=/usr/local/bin/emacs" ...)
> (posix:getenv "EDITOR")
The getenv funtion is defined as

<POSIX wrappers>+= (U->) [<-D->]
(defun getenv (&optional name)
  (if name
      (base-getenv name)
    (get-environ (get-environ-cptr) 0 nil)))
Defines getenv (links are to index).

<public POSIX symbols>+= (U->) [<-D]

with the helper function get-environ defined as

<POSIX wrappers>+= (U->) [<-D]
(defun get-environ (p i val)
  (let ((e (get-c-string p i)))
    (if (null e)
        (nreverse val)
      (get-environ p (+ i 1) (cons e val)))))
Defines get-environ (links are to index).

This uses the get-c-string pointer accessor from Section [<-].

Internet Addresses

The functions inet_aton and inet_ntoa convert to and from string representations. [It would be better to use inet_pton and inet_ntop, with compatibility versions provided for systems that don't have them [cite stevens98:_unix_networ_progr, Section 3.7].] The wrappers are in the file inet.wrp. First some package setup, include files and other preliminaries. The package makes use of the pointer wrappers of Section [<-].

<inet.wrp>= [D->]
(eval-when (:compile-toplevel :load-toplevel :execute)
           (require "wrapptrs"))
(defpackage "INTERNET" (:use "XLISP" "WRAPPTRS") (:nicknames "INET"))
(in-package "INET")
(export '(<public internet functions>))
(wrap:c-lines "#include <netinet/in.h>")
(wrap:c-lines "#include <arpa/inet.h>")
(wrap:c-lines "
#define HAVE_INET_ATON 0 /**** configure should do this */
int inet_aton(const char *strptr, struct in_addr *addrptr)
  unsigned long a = inet_addr(strptr); /**** not portable */
  if (a == INADDR_NONE)
    return 0;
  memcpy(addrptr, &a, 4);
  return 1;

The C function inet_aton is accessed by

<inet.wrp>+= [<-D->]
(wrap:c-function base-inet-aton "inet_aton" (:string (:cptr "void")) :integer)
Defines base-inet-aton (links are to index).

The exported interface returns the address as a typed array. [Since there is no unsigned char typed array yet, I'm using a char array, which may be signed or unsigned. I need to add unsigned typed arrays. Also I need to make array-data-address an exported symbol from SHLIB.]

<inet.wrp>+= [<-D->]
(defun inet-aton (string)
  (let* ((i (make-array 4 :element-type 'c-char))
         (vi (cast-c-void (array-data-address i))))
    (if (= (base-inet-aton string vi) 0)
Defines inet-aton (links are to index).

<public internet functions>= (<-U) [D->]

The inverse C function inet_ntoa is a bit unusual in that it takes a structure argument, not a pointer to a structure. This can't be handled directly by the wrapping mechanism, so an intermediate function needs to be defined.

<inet.wrp>+= [<-D->]
(wrap:c-lines "
static char *my_inet_ntoa(struct in_addr *a)
  return inet_ntoa(*a);
(wrap:c-function base-inet-ntoa "my_inet_ntoa" ((:cptr "void")) :string)
Defines base-inet-ntoa (links are to index).

The exported version checks that the address is a character vector of length 4. A version supporting IN6 would switch on the size.

<inet.wrp>+= [<-D->]
(defun inet-ntoa (addr)
  (unless (typep addr '(vector c-char 4))
          (error "~s is not a valid internet address" addr))
  (base-inet-ntoa (cast-c-void (array-data-address addr))))
Defines inet-ntoa (links are to index).

<public internet functions>+= (<-U) [<-D->]

Some examples:

> (inet:inet-aton "")
#(-128 101 50 6)
> (inet:inet-ntoa *)

If IN6 is to be supported, then a representation that includes the address family should probably be included, though the size of the byte array (4 for IN and 16 for IN6) does currently contain that information).

Host information

First the include file and some constants.

<inet.wrp>+= [<-D->]
(wrap:c-lines "#include <netdb.h>"
              "#include <sys/socket.h>")
(wrap:c-constant HOST_NOT_FOUND "HOST_NOT_FOUND" :integer)
(wrap:c-constant TRY_AGAIN "TRY_AGAIN" :integer)
(wrap:c-constant NO_RECOVERY "NO_RECOVERY" :integer)
(wrap:c-constant NO_DATA "NO_DATA" :integer)
(wrap:c-constant AF_INET "AF_INET" :integer)
Defines AF_INET, HOST_NOT_FOUND, NO_DATA, NO_RECOVERY, TRY_AGAIN (links are to index).

Host data is returned in struct hostent structures.

<inet.wrp>+= [<-D->]
(wrap:c-pointer (:struct "hostent")
                (:get hent-name "h_name" :string)
                (:get hent-aliases "h_aliases" (:cptr (:cptr "char")))
                (:get hent-addrtype "h_addrtype" :integer)
                (:get hent-length "h_length" :integer)
                (:get hent-addr-list "h_addr_list" (:cptr (:cptr "void"))))

The internal functions for obtaining host information are

<inet.wrp>+= [<-D->]
(wrap:c-function base-gethostbyname "gethostbyname"
                 (:string) (:cptr (:struct "hostent")))
(wrap:c-function base-gethostbyaddr "gethostbyaddr"
                 ((:cptr "void") :integer :integer) (:cptr (:struct "hostent")))
Defines base-gethostbyaddr, base-gethostbyname (links are to index).

The functions return error information in the global variable h_errno.

<inet.wrp>+= [<-D->]
(wrap:c-lines "extern int h_errno;")
(wrap:c-variable "h_errno" :integer (:get get-h-errno))

Again we return results as multiple values.

<inet.wrp>+= [<-D->]
(defun hent-values (h)
  (if h
      (values (hent-name h)
              (map-cptr-list #'get-c-string (hent-aliases h))
              (hent-addrtype h)
              (hent-length h)
              (flet ((inet-addr (p)
                       (let* ((n (hent-length h))
                              (a (make-array n :element-type 'c-char)))
                         (dotimes (i n a)
                           (setf (elt a i) (get-c-uchar p i))))))
                (mapcar #'inet-addr
                        (map-cptr-list #'get-c-void-p (hent-addr-list h)))))
    (values nil
            (let ((e (get-h-errno)))
               ((= e HOST_NOT_FOUND) 'HOST_NOT_FOUND)
               ((= e TRY_AGAIN) 'TRY_AGAIN)
               ((= e NO_RECOVERY) 'NO_RECOVERY)
               ((= e NO_DATA) 'NO_DATA)
               (t e))))))
Defines hent-values (links are to index).

The helper function map-cptr-list converts a NULL-terminated pointer array to a list using the fun argument for reading elements.

<inet.wrp>+= [<-D->]
(defun map-cptr-list (fun ptr)
  (do* ((val nil)
        (count 0 (+ count 1))
        (v (funcall fun ptr count) (funcall fun ptr count)))
       ((null v) (nreverse val))
       (push v val)))
Defines map-cptr-list (links are to index).

The public functions are

<inet.wrp>+= [<-D]
(defun gethostbyname (hostname)
  (hent-values (base-gethostbyname hostname)))

(defun gethostbyaddr (addr)
  (unless (typep addr '(vector c-char 4))
          (error "~s is not a valid internet address" addr))
  (let ((p (cast-c-void (array-data-address addr))))
    (hent-values (base-gethostbyaddr p 4 AF_INET))))
Defines gethostbyaddr, gethostbyname (links are to index).

<public internet functions>+= (<-U) [<-D]
gethostbyname gethostbyaddr

Again locking is needed in a multi-threaded environment, or the thread-safe versions should be used once they are standardized.

Here are some examples:

> (inet:gethostbyname "nokomis")
(#(-128 101 50 6))
> (inet:gethostbyaddr (inet:inet-aton ""))
(#(-128 101 50 6))


The C Type Registry

A global variable system::*c-types-registry* contains the list of all registered C type identifiers. The variable internal reference is stored in s_types_registry.

<type representation>= (U->) [D->]
static LVAL s_types_registry = NULL;
Defines s_types_registry (links are to index).

<initialize s_types_registry if necessary>= (U->)
if (s_types_registry == NULL) {
  s_types_registry = xlenter("SYSTEM::*C-TYPES-REGISTRY*");
  setvalue(s_types_registry, NIL);

Types are looked up with xlw_lookup_type. First the list of registered types is searched for a matching one. If that fails, a new entry is created and returned.

<wrapper declarations>= (U->) [D->]
LVAL xlw_lookup_type(char *tname);
Defines xlw_lookup_type (links are to index).

<type representation>+= (U->) [<-D]
LVAL xlw_lookup_type(char *tname)
  LVAL next, types;
  <initialize s_types_registry if necessary>
  types = getvalue(s_types_registry);
  for (next = types; consp(next); next = cdr(next))
    if (stringp(car(next)) && strcmp(getstring(car(next)), tname) == 0)
      return car(next);
  types = cons(cvstring(tname), types);
  setvalue(s_types_registry, types);
  return car(types);
Defines xlw_lookup_type (links are to index).

A C file that uses a type tag needs to declare the type with DECLARE_CPTR_TYPE. This macro defines a static variable to hold the type tag and initializes the variable to NULL.

<wrapper macros>= (U->) [D->]
#define DECLARE_CPTR_TYPE(t) static LVAL xlw_##t##_type_tag=NULL;
Defines DECLARE_CPTR_TYPE (links are to index).

This defininiton uses the ANSI C ## facility for merging tokens in macro expansion. The tag for a data type is retrieved with CPTR_TYPE.

<wrapper macros>+= (U->) [<-D->]
#define CPTR_TYPE(t) \
  (xlw_##t##_type_tag == NULL ? \
   xlw_##t##_type_tag = xlw_lookup_type(#t) : xlw_##t##_type_tag)
Defines CPTR_TYPE (links are to index).

The # token in the argument to xlw_lookup_type is the ANSI ``stringization'' token. This approach insures that tokens are only looked up once per file and can be compared using ==.

Using these macros, we can declare a generic pointer, a pointer to void.

<declaration of void pointer type>= (U->)

The type tag would be retrieved by an expression of the form


C Pointer Representation

Typed C pointers are represented by a structure that holds a native pointer and a type tag. [It might be useful to include an optional size value for some rudimentary bounds checking, but since it really can't be done right this might be more trouble than it is worth.] The pointers should never be NULL pointers. A NULL pointer can be passed to an interface function as a Lisp NIL. For now, these pointers are represented by CONS cells with the type in the CAR and the native pointer in the CDR. [This should eventually be replaced by an internal type.]

<wrapper macros>+= (U->) [<-D->]
#define cptrp(x) (consp(x)&&stringp(car(x))&&natptrp(cdr(x)))
#define getcptype(x) car(x)
#define getcpptr(x) cdr(x)
#define getcpaddr(x) getnpaddr(getcpptr(x))
#define getcpprot(x) getnpprot(getcpptr(x))
#define newcptr(x,y) cons(x,y)
Defines cptrp, getcpptr, getcptype, newcptr (links are to index).

The predicate cptr_type_p checks whether the object is a valid pointer either of the specified type or a generic pointer to void.

<wrapper macros>+= (U->) [<-D]
#define cptr_type_p(p,t) \
  (cptrp(p) && \
   (getcptype(p) == (t) || getcptype(p) == CPTR_TYPE(void)))
Defines cptr_type_p (links are to index).

The function xlgacptr reads a C pointer argument off the stack and returns it or signals an error. An argument of NIL is interpreted as a null pointer; an error is signaled for a null pointer if null_ok is false. An error is signaled if the native pointer of a C pointer contains a NULL address.

<C wrapper support code>= (U->) [D->]
LVAL xlgacptr(LVAL type, int null_ok)
  LVAL p = xlgetarg();
  if ((null(p) && null_ok) ||
      (cptr_type_p(p,type) && getcpaddr(p) != NULL))
    return p;
    return xlbadtype(p);
Defines xlgacptr (links are to index).

<wrapper declarations>+= (U->) [<-D->]
LVAL xlgacptr(LVAL type, int null_ok);
Defines xlgacptr (links are to index).

An internal pointer is converted to a C pointer by cvcptr. In addition to the pointer, this function takes the type and data item to protect as arguments. If the pointer is NULL, then NIL is returned. The data argument is protected during allocation.

<C wrapper support code>+= (U->) [<-D->]
LVAL cvcptr(LVAL type, void *v, LVAL data)
  if (v == NULL)
    return NIL;
  else {
    LVAL ptr, val;
    ptr = newnatptr(v, data);
    val = newcptr(type,ptr);
    return val;
Defines cvcptr (links are to index).

<wrapper declarations>+= (U->) [<-D->]
LVAL cvcptr(LVAL type, void *v, LVAL data);
Defines cvcptr (links are to index).

Some Generic Functions and Macros

These functions and macros represent the generic portion of several standard operations that are defined for different types.

Constructor Functions

A generic allocation function is make_cptr. This function is intended for implementing constructor functions. It factors out all the common code for allocating a specified type. The optional element count (or size for void) argument is taken from the stack; the default value is one. The element count must be positive.

<C wrapper support code>+= (U->) [<-D->]
LVAL xlw_make_cptr(LVAL type, size_t elsize)
  LVAL data, count;
  FIXTYPE n = 1;
  if (moreargs()) {
    count = xlgafixnum();
    n = getfixnum(count);
    if (n <= 0)
  data = mktvec(n * elsize, s_c_char);
  return cvcptr(type, gettvecdata(data), data);
Defines xlw_make_cptr (links are to index).

<wrapper declarations>+= (U->) [<-D->]
LVAL xlw_make_cptr(LVAL type, size_t elsize);
Defines xlw_make_cptr (links are to index).

Caster Functions

The second generic function is for casting to the specified type. It takes a C pointer or a native pointer [Perhaps it should also take an array or an integer?] and returns a new C pointer of the specified type.

<C wrapper support code>+= (U->) [<-D->]
LVAL xlw_cast_cptr(LVAL type)
  LVAL p = xlgetarg();
  if (null(p))
    return NIL;
  else if (cptrp(p)) /* won't be a NULL pointer */
    return newcptr(type, getcpptr(p));
  else if (natptrp(p)) /* need to check for NULL */
    return getnpaddr(p) == NULL ? NIL : newcptr(type, p);
    return xlbadtype(p);
Defines xlw_cast_cptr (links are to index).

<wrapper declarations>+= (U->) [<-D->]
LVAL xlw_cast_cptr(LVAL type);
Defines xlw_cast_cptr (links are to index).


The final generic function is the offset function. It returns a new pointer that is the specified offset from the old pointer.

<C wrapper support code>+= (U->) [<-D]
LVAL xlw_offset_cptr(LVAL type, size_t elsize)
  LVAL p = xlgetarg();
  size_t off = getfixnum(xlgafixnum()) * elsize;
  if (! cptr_type_p(p, type))
  return cvcptr(type, (char *) getcpaddr(p) + off, getcpprot(p));
Defines xlw_offset_cptr (links are to index).

<wrapper declarations>+= (U->) [<-D]
LVAL xlw_offset_cptr(LVAL type, size_t elsize);
Defines xlw_offset_cptr (links are to index).

Generating C Code

Top Level

The wrapper generator uses several global variables.

<lisp interface>= (U->) [D->]
(defvar *wrapper-functions*)
(defvar *wrapper-fixnum-constants*)
(defvar *wrapper-unsigned-constants*)
(defvar *wrapper-flonum-constants*)
(defvar *wrapper-string-constants*)
(defvar *wrapper-cptr-types*)
(defvar *wrapper-module-version*)
(defvar *c-output*)
Defines *c-output*, *wrapper-fixnum-constants*, *wrapper-flonum-constants*, *wrapper-functions*, *wrapper-module-version*, *wrapper-string-constants*, *wrapper-unsigned-constants* (links are to index).

One of these is the output stream for the C file, *c-output*. Writing to this stream is handled by the function

<lisp interface>+= (U->) [<-D->]
(defun write-c-line (fmt &rest args)
  (format *c-output* "~&~?~%" fmt args)

The wrapper generating function make-wrapper itself is defined as

<lisp interface>+= (U->) [<-D->]
(defun make-wrappers (file &key (name (pathname-name file)))
  (unless (equal (pathname-type file) "wrp")
          (error "file ~a does not have a .wrp extension" file))
  (let ((c-file (merge-pathnames (make-pathname :name name :type "c") file))
        (lisp-file (merge-pathnames (make-pathname :name name :type "lsp") file))
        (*package* *package*)
        (*readtable* *readtable*)
        (*wrapper-functions* nil)
        (*wrapper-fixnum-constants* nil)
        (*wrapper-unsigned-constants* nil)
        (*wrapper-flonum-constants* nil)
        (*wrapper-string-constants* nil)
        (*wrapper-cptr-types* nil)
        (*wrapper-module-version* nil)
        (eof (cons nil nil)))
    <process the wrapper file>))
Defines make-wrappers (links are to index).

The wrapper file is processed by

<process the wrapper file>= (<-U)
(with-open-file (in file)
  (with-open-file (*c-output* c-file :direction :output)
    (with-open-file (lisp-out lisp-file :direction :output)
      <write header to *c-output*>
      <write header to lisp-out>
       (let ((expr (read in nil eof)))
         (when (eq expr eof) (return))
         (let ((wexpr (wrap-expression expr)))
           (when wexpr
                 (let ((*print-readably* t)
                       (system:*print-symbol-package* t))
                   (format lisp-out "~&~s~%" wexpr))))))
      <write trailer to lisp-out>
      <write trailer to *c-output*>)))

The header for the C file contains a comment labeling the file as automatically generated and brings in two include files.

<write header to *c-output*>= (<-U)
(write-c-line "/* Generated automatically from ~a by make-wrappers. */" file)
(write-c-line "#include \"xlshlib.h\"")
(write-c-line "#include \"xlwrap.h\"")

The header for the Lisp file again contains a comment.

<write header to lisp-out>= (<-U)
(format lisp-out ";; Generated automatically from ~a by make-wrappers.~%" file)

The trailer for the Lisp file loads the DLL. [This needs to be modified if static loading is to be supported.]

<write trailer to lisp-out>= (<-U)
(let ((path (format nil "(merge-pathnames \"~a.dll\" *load-truename*)" name))
      (vers (if *wrapper-module-version*
                (let* ((major (first *wrapper-module-version*))
                       (minor (second *wrapper-module-version*))
                       (oldmajor (third *wrapper-module-version*))
                       (oldminor (fourth *wrapper-module-version*))
                       (vers (+ (* (^ 2 16) major) minor))
                       (oldvers (+ (* (^ 2 16) oldmajor) oldminor)))
                  (format nil "~d ~d" vers oldvers))
  (format lisp-out "(shlib::load-shared-library ~a ~s ~@[ ~a~])~%" path name vers))

The merge-pathname call is used to merge the library file name with the directory provided in the load call for Lisp file, the directory part of *load-truename*. This assumes that the Lisp and library files are in the same directory. [*load-truename* is used instead of *load-pathname* in case the load path has no directory component. This can create problems with shared library systems that use a search path that doesn't contain the current directory.]

The trailer for the C file defines the function and constant tables and the initialization routine for the module.

<write trailer to *c-output*>= (<-U)
(let ((system:*print-symbol-package* t))
  <write functions table>
  <write fixnum constants table>
  <write flonum constants table>
  <write string constants table>
  <write unsigned constants table>
  <write module table>
  <write module initialization routine>

The function table is written by

<write functions table>= (<-U)
(write-c-line "static FUNDEF ~a_funs[] = {" name)
(dolist (e (reverse *wrapper-functions*))
  (let ((sym (first e))
        (fun (second e))
        (mvals (third e)))
    (unless (symbol-package sym) (error "~s has no package" sym))
    (write-c-line "  { \"~s\", ~:[SUBR~;MVSUBR~], ~a }," sym mvals fun)))
(write-c-line "  { NULL, 0, NULL}~%};")

The fixnum constants are written out by

<write fixnum constants table>= (<-U)
(write-c-line "static FIXCONSTDEF ~a_fixconsts[] = {" name)
(dolist (e (reverse *wrapper-fixnum-constants*))
  (let ((sym (car e))
        (val (cdr e)))
    (unless (symbol-package sym) (error "~s has no package" sym))
    (write-c-line "  { \"~s\", ~a }," sym val)))
(write-c-line "  { NULL, 0}~%};")

the flonum constants by

<write flonum constants table>= (<-U)
(write-c-line "static FLOCONSTDEF ~a_floconsts[] = {" name)
(dolist (e (reverse *wrapper-flonum-constants*))
  (let ((sym (car e))
        (val (cdr e)))
    (unless (symbol-package sym) (error "~s has no package" sym))
    (write-c-line "  { \"~s\", ~a }," sym val)))
(write-c-line "  { NULL, 0.0}~%};")

the string constants by

<write string constants table>= (<-U)
(write-c-line "static STRCONSTDEF ~a_strconsts[] = {" name)
(dolist (e (reverse *wrapper-string-constants*))
  (let ((sym (car e))
        (val (cdr e)))
    (unless (symbol-package sym) (error "~s has no package" sym))
    (write-c-line "  { \"~s\", ~a }," sym val)))
(write-c-line "  { NULL, NULL}~%};")

and the unsigned constants by

<write unsigned constants table>= (<-U)
(write-c-line "static ULONGCONSTDEF ~a_ulongconsts[] = {" name)
(dolist (e (reverse *wrapper-unsigned-constants*))
  (let ((sym (car e))
        (val (cdr e)))
    (unless (symbol-package sym) (error "~s has no package" sym))
    (write-c-line "  { \"~s\", ~a }," sym val)))
(write-c-line "  { NULL, 0}~%};")

The module table combines the function and constant tables.

<write module table>= (<-U)
(let ((vers (if *wrapper-module-version* *wrapper-module-version* '(0 1 0 1))))
  (write-c-line "static xlshlib_modinfo_t ~a_info = {~%~
                name vers name name name name name))

The initialization routine returns the module table's address.

<write module initialization routine>= (<-U)
(write-c-line "xlshlib_modinfo_t *~a__init(void) { return &~a_info; }"
              name name))

Wrapping Expressions

Wrappers are defined as macros with expansion functions that may write to the C output file or return expressions for further processing, or both. Thus wrap-exression is essentially just a macro expander. However there are a few twists. In order to allow new wrappers to be defined, it should recursively process macro expansions and top-level progns. It should also insure that in-package and defpackage forms are evaluated at wrapping time and are put in the .lsp file. This essentially means that wrap-expression should act like the compiler top level. Since that is a bit complex, I will temporarily cheat and use a simplified version. This version does not handle macrolet and does not do eval-when right. [This should eventually be changed, but the right way to do that is probably to write a customizable compiler top level.] Here is the resulting simplified definition.

<lisp interface>+= (U->) [<-D->]
(defun wrap-expression (expr)
  (case (first expr)
        (macrolet (error "top level MACROLET not supported in wrappers"))
         (let ((sits (second expr)))
           (when (or (member 'compile sits) (member :compile-toplevel sits))
                 (dolist (e (rest (rest expr)))
                   (eval e))))
        ((defun defstruct do do* dolist dotimes) expr)
        (progn `(progn ,@(mapcar #'wrap-expression (rest expr))))
        ((in-package defpackage defmacro) (eval expr) expr)
        (t (multiple-value-bind (ee again) (macroexpand expr)
             (if again
                 (wrap-expression ee)
Defines wrap-expression (links are to index).

This definition does not include any error catching. [Error catching along the lines used by compile-file could be added.]

Type Specifiers

Type specifiers need to be converted to their C equivalents or to mangled forms for use in constructing tags and variable names. c-type converts to the C representation.

<lisp interface>+= (U->) [<-D->]
(defun c-type (type)
  (case type
        (:void "void")
        (:integer "long")
        (:unsigned "unsigned long")
        (:flonum "double")
        (:string "char *")
        (:lval "LVAL")
        (t (cond
            ((stringp type) type)
            ((signed-type-p type) (format nil "signed ~a" (second type)))
            ((unsigned-type-p type) (format nil "unsigned ~a" (second type)))
            ((pointer-type-p type) (format nil "~a *" (c-type (second type))))
            ((struct-type-p type) (format nil "struct ~a" (second type)))
            ((union-type-p type) (format nil "union ~a" (second type)))
            (t (error "type ~s is unknown" type))))))
Defines c-type (links are to index).

mangled-type creates a single word name for describing the type. It isn't guaranteed to be a one-to one mapping, but will be for reasonable naming schemes.

<lisp interface>+= (U->) [<-D->]
(defun mangled-type (type)
  (case type
        (:void "void")
        (:integer "long")
        (:unsigned "unsigned_long")
        (:flonum "double")
        (:string "c_string")
        (:lval "LVAL")
        (t (cond
            ((stringp type) type)
            ((signed-type-p type) (format nil "signed_~a" (second type)))
            ((unsigned-type-p type) (format nil "unsigned_~a" (second type)))
            ((pointer-type-p type) (format nil "~a_P" (mangled-type (second type))))
            ((struct-type-p type) (format nil "S_~a" (second type)))
            ((union-type-p type) (format nil "U_~a" (second type)))
            (t (error "type ~s is unknown" type))))))
Defines mangled-type (links are to index).

Here are some predicates for recognizing compound type specifiers.

<lisp interface>+= (U->) [<-D->]
(defun pointer-type-p (type)
  (and (consp type) (eq (first type) :cptr)))
(defun signed-type-p (type)
  (and (consp type) (eq (first type) :signed)))
(defun unsigned-type-p (type)
  (and (consp type) (eq (first type) :unsigned)))
(defun struct-type-p (type)
  (and (consp type) (eq (first type) :struct)))
(defun union-type-p (type)
  (and (consp type) (eq (first type) :union)))
Defines pointer-type-p, signed-type-p, struct-type-p, union-type-p, unsigned-type-p (links are to index).

The register-pointer-type function is used to insure that a pointer tag is defined before use and is define only once.

<lisp interface>+= (U->) [<-D->]
(defun register-pointer-type (type)
  (unless *wrapper-cptr-types*
          (push "void" *wrapper-cptr-types*)
          (write-c-line "DECLARE_CPTR_TYPE(~a)" "void"))
  (unless (member type *wrapper-cptr-types* :test #'equal)
          (push type *wrapper-cptr-types*)
          (write-c-line "DECLARE_CPTR_TYPE(~a)" (mangled-type type))))

C Lines

Raw C code is transferred to the C file by c-lines.

<lisp interface>+= (U->) [<-D->]
(defmacro c-lines (&rest lines)
  (dolist (ln lines)
    (write-c-line ln)))
Defines c-lines (links are to index).


Constants are wrapped using c-constant. The arguments are the lisp symbol, the C name, and the return type.

<lisp interface>+= (U->) [<-D->]
(defmacro c-constant (name cname type)
  (case type
        (:integer (push (cons name cname) *wrapper-fixnum-constants*))
        (:unsigned (push (cons name cname) *wrapper-unsigned-constants*))
        (:flonum (push (cons name cname) *wrapper-flonum-constants*))
        (:string (push (cons name cname) *wrapper-string-constants*))
        (t (error "can't handle constants of type ~s" type)))
Defines c-constant (links are to index).


C variable access is wrapped using the c-variable macro. The arguments are the C variable name, the access type, and clauses to specify reader or writer functions.

<lisp interface>+= (U->) [<-D->]
(defmacro c-variable (name type &rest clauses)
  (when (pointer-type-p type)
        (register-pointer-type (second type)))
  (dolist (c clauses)
    (case (first c)
          (:get (write-c-variable-get name type (second c)))
          (:set (write-c-variable-set name type (second c))))))
Defines c-variable (links are to index).

Reader functions are written using the format

<lisp interface>+= (U->) [<-D->]
(defconstant c-variable-get-fmt "~
static LVAL ~a(void) {
  return ~@?;
Defines c-variable-get-fmt (links are to index).

The format is filled in by

<lisp interface>+= (U->) [<-D->]
(defun write-c-variable-get (name type fun)
  (let ((cfun (c-function-name "get_~a_var" name)))
    (write-c-line c-variable-get-fmt cfun (c-value-fmt type) name nil)
    (register-subr fun cfun)))
Defines write-c-variable-get (links are to index).

C function names are generated by c-function-name. [This should probably be modified to use an index to insure uniqueness.]

<lisp interface>+= (U->) [<-D->]
(defun c-function-name (fmt &rest args)
  (format nil "xlw_~?" fmt args))

Lisp functions are registered with register-subr for later entry in the module function table.

<lisp interface>+= (U->) [<-D->]
(defun register-subr (lisp-name c-name &optional mvals)
  (push (list lisp-name c-name mvals) *wrapper-functions*)

The function c-value-fmt produces the format string for the value.

<lisp interface>+= (U->) [<-D->]
(defun c-value-fmt (type)
  (case type
        (:void "NIL")
        (:integer "long2lisp(~a)")
        (:unsigned "ulong2lisp(~a)")
        (:flonum "cvflonum(~a)")
        (:string "cvstrornil(~a)")
        (:lval "~a")
        (t (if (pointer-type-p type)
               (format nil "cvcptr(CPTR_TYPE(~a),~~a,~~a)"
                       (mangled-type (second type)))
             (error "can't handle ~a value type" type)))))
Defines c-value-fmt (links are to index).

For string data, this uses the support function cvstrornil to return NIL for a null pointer and a string converted with cvstring for a non-null pointer.

Variable modifiers are written with the format [This does not yet allow for modifying pointer-valued variables.]

<lisp interface>+= (U->) [<-D->]
(defconstant c-variable-set-fmt "~
static LVAL ~a(void) {
  LVAL xlw__val = xlgetarg();
  ~a = ~@?;
  return xlw__val;
Defines c-variable-set-fmt (links are to index).

This format is filled in by the function

<lisp interface>+= (U->) [<-D->]
(defun write-c-variable-set (name type fun)
  (let ((cfun (c-function-name "set_~a_var" name))
        (afmt (c-argument-fmt type)))
    (write-c-line c-variable-set-fmt cfun name afmt "xlw__val")
    (register-subr fun cfun)))
Defines write-c-variable-set (links are to index).

The argument format is generated by c-argument-fmt.

<lisp interface>+= (U->) [<-D->]
(defun c-argument-fmt (type)
  (case type
        (:integer "lisp2long(~a)")
        (:unsigned "lisp2ulong(~a)")
        (:flonum "makefloat(~a)")
        (:string "getstring(~a)")
        (:lval "~a")
        (t (error "can't handle ~a argument type" type))))
Defines c-argument-fmt (links are to index).


The wrapper macro c-function defines a Lisp wrapper for a specified C function. The arguments are the Lisp function name, the C function name, the argument type list, and the value type. The C template to be filed in is

<lisp interface>+= (U->) [<-D->]
(defconstant c-function-fmt "~
static LVAL ~a(void)
~:{~&  ~a ~a = ~a;~}
~@[~&  ~a xlw__v;~]~&  xllastarg();
  ~@[~*xlw__v = ~]~a(~:[~2*~;~a~{,~a~}~]);
  return ~@?;
Defines c-function-fmt (links are to index).

The c-function wrapper fills in this template.

<lisp interface>+= (U->) [<-D->]
(defmacro c-function (name cname args value)
  (dolist (a args)
    (when (pointer-type-p a)
          (register-pointer-type (second a))))
  (when (pointer-type-p value)
        (register-pointer-type (second value)))
  (let* ((fun (c-function-name "_~a_wrap" cname))
         (ainfo (c-function-arginfo args))
         (anames (mapcar #'second ainfo))
         (vt (if (eq value :void) nil (c-type value))))
    (write-c-line c-function-fmt
                  vt cname anames (first anames) (rest anames)
                  (c-value-fmt value) "xlw__v" "NIL")
     (register-subr name fun)))
Defines c-function (links are to index).

The function c-function-arginfo computes the argument information needed. For each argument it returns a list of the C type, the generated variable name, and the form for reading the variable from the stack.

<lisp interface>+= (U->) [<-D->]
(defun c-function-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 (if (pointer-type-p a)
                     (format nil "getcpaddr(xlgacptr(CPTR_TYPE(~a),~a))"
                             (mangled-type (second a))
                             (if (third a) "TRUE" "FALSE"))
                   (format nil (c-argument-fmt a) "xlgetarg()"))))
        (push (list ct v arg) val)))))
Defines c-function-arginfo (links are to index).

The macro c-subr can be used to register a C SUBR with the module.

<lisp interface>+= (U->) [<-D->]
(defmacro c-subr (fun cfun &optional mvals)
  (register-subr fun cfun mvals))
Defines c-subr (links are to index).

Pointers and Compound Data Structures

C pointers and compound data structures are wrapped by the wrapper macro c-pointer. The macro takes a type argument and optional clauses for defining constructors, casters, offsetters, readers and writers. The c-pointer wrapper macro is defined as

<lisp interface>+= (U->) [<-D->]
(defmacro c-pointer (type &rest clauses)
  (register-pointer-type type)
  (dolist (c clauses)
    (case (first c)
          (:make (write-c-pointer-make type (second c)))
          (:cast (write-c-pointer-cast type (second c)))
          (:offset (write-c-pointer-offset type (second c)))
          (:get (write-c-pointer-get type (second c) (third c) (fourth c)))
          (:set (write-c-pointer-set type (second c) (third c) (fourth c))))))

The :make, :cast, and :offset clauses all take one argument, the name of the function to define. The C template for a constructor function is

<lisp interface>+= (U->) [<-D->]
(defconstant c-pointer-make-fmt "~
static LVAL ~a(void)
  return xlw_make_cptr(CPTR_TYPE(~a), sizeof(~a));
Defines c-pointer-make-fmt (links are to index).

This template is filed in by

<lisp interface>+= (U->) [<-D->]
(defun write-c-pointer-make (type fun)
  (let* ((mt (mangled-type type))
         (ct (c-type type))
         (cfun (c-function-name "make_~a_cptr" mt)))
    (if (equal type "void")
        (write-c-line c-pointer-make-fmt cfun "void" "char")
      (write-c-line c-pointer-make-fmt cfun mt ct))
    (register-subr fun cfun)))
Defines write-c-pointer-make (links are to index).

The caster template is

<lisp interface>+= (U->) [<-D->]
(defconstant c-pointer-cast-fmt "~
static LVAL ~a()
  return xlw_cast_cptr(CPTR_TYPE(~a));
Defines c-pointer-cast-fmt (links are to index).

and is filled in by

<lisp interface>+= (U->) [<-D->]
(defun write-c-pointer-cast (type fun)
  (let* ((mt (mangled-type type))
         (cfun (c-function-name "cast_~a_cptr" mt)))
    (write-c-line c-pointer-cast-fmt cfun mt)
    (register-subr fun cfun)))
Defines write-c-pointer-cast (links are to index).

The offsetter template is

<lisp interface>+= (U->) [<-D->]
(defconstant c-pointer-offset-fmt "~
static LVAL ~a(void)
  return xlw_offset_cptr(CPTR_TYPE(~a), sizeof(~a));
Defines c-pointer-offset-fmt (links are to index).

This template is filled in by

<lisp interface>+= (U->) [<-D->]
(defun write-c-pointer-offset (type fun)
  (let* ((mt (mangled-type type))
         (ct (c-type type))
         (cfun (c-function-name "offset_~a_cptr" mt)))
    (if (equal type "void")
        (write-c-line c-pointer-offset-fmt cfun "void" "char")
      (write-c-line c-pointer-offset-fmt cfun mt ct))
    (register-subr fun cfun)))
Defines write-c-pointer-offset (links are to index).

The :get clause generates reader functions for dereferencing a pointer or reading a field. The C function format is

<lisp interface>+= (U->) [<-D->]
(defconstant c-pointer-get-fmt "~
static LVAL ~a(void)
  LVAL p = xlgacptr(CPTR_TYPE(~a), FALSE);
  ~a *x = getcpaddr(p);
  FIXTYPE off = moreargs() ? getfixnum(xlgafixnum()) : 0;
  return ~@?;
Defines c-pointer-get-fmt (links are to index).

The function write-c-pointer-get fills in this template.

<lisp interface>+= (U->) [<-D->]
(defun write-c-pointer-get (type fun field vtype)
  (when (pointer-type-p vtype)
        (register-pointer-type (second vtype)))
  (let* ((ct (c-type type))
         (mt (mangled-type type))
         (cfun (c-function-name "get_~a~@[_~a~]" mt field))
         (val (format nil "x[off]~@[.~a~]" field))
         (cvt (c-value-fmt vtype)))
    (write-c-line c-pointer-get-fmt cfun mt ct cvt val "p")
    (register-subr fun cfun)))
Defines write-c-pointer-get (links are to index).

The :set clause generates writer functions for assigning new values to a pointer's reference or a field. The C function format is

<lisp interface>+= (U->) [<-D->]
(defconstant c-pointer-set-fmt "~
static LVAL ~a(void)
  ~a *x = getcpaddr(xlgacptr(CPTR_TYPE(~a), FALSE));
  LVAL val = xlgetarg();
  FIXTYPE off = moreargs() ? getfixnum(xlgafixnum()) : 0;
  x[off]~@[.~a~] = ~@?;
  return val;
Defines c-pointer-set-fmt (links are to index).

The format is filled and written to the C stream by the function

<lisp interface>+= (U->) [<-D->]
(defun write-c-pointer-set (type fun field vtype)
  (when (pointer-type-p vtype)
        (register-pointer-type (second vtype)))
  (let* ((mt (mangled-type type))
         (ct (c-type type))
         (cfun (c-function-name "set_~a~@[_~a~]" mt field))
         (cvt (c-argument-fmt vtype)))
    (write-c-line c-pointer-set-fmt cfun ct mt field cvt "val")
    (register-subr fun cfun)))
Defines write-c-pointer-set (links are to index).

This function does not currently allow the assignment of pointer types. [It isn't clear whether such an assignment should assign the pointer or copy the contents of the pointer. Some way of specifying this would be needed.]

Version Information

The macro c-version is used to specify version information for the shared library.

<lisp interface>+= (U->) [<-D->]
(defmacro c-version (&optional (major 0) (minor 0) 
                               (oldmajor major) (oldminor minor))
  (setf *wrapper-module-version* (list major minor oldmajor oldminor))
Defines c-version (links are to index).



Need special versions for Mac (UPP stuff, pascal conventions) and Windows (stdcall for 95//NT, procedure pointer thunking for 3.1?)

Need SUBR to initialize variable?

Use special variable symbol for callback. Store Lisp function in value cell (so can rebind in let) and store pointer to C function in function cell.

<lisp interface>+= (U->) [<-D]
(defconstant c-callback-fmt "~
static ~a ~a(~a x1, ~a x2)
  LVAL xlw_x1, xlw_x2, xlw_v;
  static LVAL fsym = NULL;
  if (fsym == NULL)
    fsym = xlenter(\"~a\");
  xlw_x1 = ~@?;
  xlw_x1 = ~@?;
  xlw_v = xlappn(xlgetfunction(fsym), 2, xlw_x1, xlw_x2);
  return ...;
Defines c-callback-fmt (links are to index).


(provide "posix")

(eval-when (:compile-toplevel :load-toplevel :execute)
           (require "wrapptrs"))
(defpackage "POSIX" (:use "XLISP" "WRAPPTRS"))
(in-package "POSIX")

(export '(<public POSIX symbols>))

<POSIX wrappers>


<wrapper declarations>
<wrapper macros>


#include "xlisp.h"
#include "xlwrap.h"
<type representation>
<declaration of void pointer type>
<C wrapper support code>
#endif /* SHAREDLIBS */


<wrapper package and module setup>= (U-> U->)
(provide "wrappers")
(defpackage "C-WRAPPERS" (:nicknames "WRAP") (:use "XLISP"))
(in-package "C-WRAPPERS")
(export '(<public wrapper symbols>))


<public wrapper symbols>= (U-> U->)
c-lines c-constant c-variable c-function c-subr c-pointer c-version


<wrapper package and module setup>
<lisp interface>


<wrapper package and module setup>
(system:define-autoload-module "wrap"
  (function <public wrapper symbols>))

<pointer wrappers package and module setup>
(system:define-autoload-module "wrapptrs"
  (function <public pointer wrapper symbols>))

Open Issues


[1] David M. Beazley. Swig users manual. beazley/SWIG/, 1997.

[2] Donald Lewine. POSIX Programmer's Guide. O'Reilly &Associates, 1991.

[3] W. Richard Stevens. UNIX Network Programming, volume I. Prentice-Hall, Upper Saddle River, NJ, 1998.