Shared Libraries for XLISP-STAT

Table of Contents

Introduction

The primary files in this implementation are xlshlib.c, xlshlib.h, and shlib.lsp. But a number of additional minor changes are also needed, so I'm making this available as a snapshot of the source tree. This snapshot includes Macintosh project files for CodeWarrior Pro 2.

Two larger examples of using this mechanism are also available. One is a regular espressions library, the other a socket library.

Low Level

Interface to dlfcn

<xlshlib.c>=

#include "xlisp.h"
#ifdef SHAREDLIBS
#include <dlfcn.h>
<xlshlib.c macros>
<xlshlib.c body>
#endif /* SHAREDLIBS */

Generic pointers are represented using the new native pointer representation. Errors are signaled by

<xlshlib.c body>= (<-U) [D->]
static void shlib_error()
{
  char *str = dlerror();
  xlfail(str != NULL ? str : "unknown shared library error");
}

Defines shlib_error (links are to index).

A shared library is opened by calling shlib-open with the path name as its argument. This Lisp function is implemented internally by xshlibopen, which calls dlopen with mode RTLD_NOW. This should fail if there are unresolved references instead of causing a core dump later. Some systems ignore the mode (Mac and Windows) and those act like RTLD_NOW anyway as far as I can tell. If the library can't be opened an error is signaled. If the library is opened successfully, its internal reference handle, a void * pointer, is returned as a fixnum.

<xlshlib.c body>+= (<-U) [<-D->]
/* SHLIB-OPEN path */
LVAL xshlibopen()
{
  char *name;
  void *handle;
  name = getstring(xlgastring());
  xllastarg();
  if ((handle = dlopen(name, RTLD_NOW)) == NULL)
    shlib_error();
  return newnatptr(handle, NIL);
}

Defines shlib-open, xshlibopen (links are to index).

<funtab additions>= [D->]
{   "SHARED-LIBRARY::SHLIB-OPEN",         S, xshlibopen      },

The function shlib-symaddr, internally xshlibsymaddr, uses dlsym to look up a symbol in a specified library. By default, an error is signaled if the symbol is not found. To allow searching for variants (e.g. foo, foo_, _foo) an optional argument of NIL causes NIL to be returned if the symbol is not found. The address is returned as a fixnum. [On Windows a function that looks up the address by ordinal value is probably also needed.] The library is protected in the returned function pointer.

<xlshlib.c body>+= (<-U) [<-D->]
/* SHLIB-SYMADDR lib name &optional error */
LVAL xshlibsymaddr()
{
  void *val;
  LVAL lib = xlganatptr();
  void *handle = getnpaddr(lib);
  char *name = getstring(xlgastring());
  int err = moreargs() ? null(xlgetarg()) : TRUE;
  xllastarg();
  if ((val = dlsym(handle, name)) == NULL) {
    if (err)
      shlib_error();
    else
      return NIL;
  }
  return newnatptr(val, lib);
}

Defines shlib-symaddr, xshlibsymaddr (links are to index).

<funtab additions>+= [<-D->]
{   "SHARED-LIBRARY::SHLIB-SYMADDR",      S, xshlibsymaddr   },

A shared library is closed by shlib-close (xshlibclose), which calls dlclose; again, an error is signaled on failure.

<xlshlib.c body>+= (<-U) [<-D->]
/* SHLIB-CLOSE lib */
LVAL xshlibclose()
{
  void *lib = getnpaddr(xlganatptr());
  xllastarg();
  if (dlclose(lib) == -1)
    shlib_error();
  return NIL;
}

Defines shlib-close, xdlclose (links are to index).

<funtab additions>+= [<-D->]
{   "SHARED-LIBRARY::SHLIB-CLOSE",        S, xshlibclose     },

Some Utility Functions

<xlshlib.c body>+= (<-U) [<-D->]
#define MAX_CALLADDR_ARGS 16

/* CALL-BY-ADDRESS &rest args */
LVAL xshlibcalladdr()
{
  void *(*f)() = (void *(*)()) getnpaddr(xlganatptr());
  void *a[MAX_CALLADDR_ARGS];
  int n, i;

  if (xlargc > MAX_CALLADDR_ARGS)
    xltoomany();

  <read arguments for call-by-address>
  
  switch (n) {
  case 0: return cvvoidptr(f());
  case 1: return cvvoidptr(f(a[0]));
  case 2: return cvvoidptr(f(a[0],a[1]));
  case 3: return cvvoidptr(f(a[0],a[1],a[2]));
  case 4: return cvvoidptr(f(a[0],a[1],a[2],a[3]));
  case 5: return cvvoidptr(f(a[0],a[1],a[2],a[3],a[4]));
  case 6: return cvvoidptr(f(a[0],a[1],a[2],a[3],a[4],a[5]));
  case 7: return cvvoidptr(f(a[0],a[1],a[2],a[3],a[4],a[5],a[6]));
  case 8: return cvvoidptr(f(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7]));
  case 9: return cvvoidptr(f(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8]));
  case 10: return cvvoidptr(f(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],
                              a[9]));
  case 11: return cvvoidptr(f(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],
                              a[9],a[10]));
  case 12: return cvvoidptr(f(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],
                              a[9],a[10],a[11]));
  case 13: return cvvoidptr(f(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],
                              a[9],a[10],a[11],a[12]));
  case 14: return cvvoidptr(f(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],
                              a[9],a[10],a[11],a[12],a[13]));
  case 15: return cvvoidptr(f(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],
                              a[9],a[10],a[11],a[12],a[13],a[14]));
  case 16: return cvvoidptr(f(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],
                              a[9],a[10],a[11],a[12],a[13],a[14],a[15]));
  default: xlfail("too many arguments"); return NIL;
  }
}

Defines call-by-address, xcalladdr (links are to index).

<funtab additions>+= [<-D->]
{   "SHARED-LIBRARY::CALL-BY-ADDRESS",    S, xshlibcalladdr  },

The macro cvvoidptr converts the return value to a native pointer representation.

<xlshlib.c macros>= (<-U) [D->]
#define cvvoidptr(x) newnatptr(x, NIL)

Defines cvvoidptr (links are to index).

Arguments can be either native pointers or FIXNUM's.

<read arguments for call-by-address>= (<-U U->)
for (n = xlargc, i = 0; i < n; i++) {
  LVAL arg = xlgetarg();
  if (fixp(arg))
    a[i] = (void *) getfixnum(arg);
  else if (natptrp(arg))
    a[i] = getnpaddr(arg);
  else
    xlbadtype(arg);
}

For MS Windows we probably need a separate function for each calling convention. ****

<xlshlib.c body>+= (<-U) [<-D->]
#ifdef _Windows
typedef void * __stdcall (*stdfun0)(void);
typedef void * __stdcall (*stdfun1)(void *);
typedef void * __stdcall (*stdfun2)(void *, void *);
typedef void * __stdcall (*stdfun3)(void *, void *, void *);
typedef void * __stdcall (*stdfun4)(void *, void *, void *, void *);
typedef void * __stdcall (*stdfun5)(void *, void *, void *, void *, \
 void *);
typedef void * __stdcall (*stdfun6)(void *, void *, void *, void *, \
 void *, void *);
typedef void * __stdcall (*stdfun7)(void *, void *, void *, void *, \
 void *, void *, void *);
typedef void * __stdcall (*stdfun8)(void *, void *, void *, void *, \
 void *, void *, void *, void *);
typedef void * __stdcall (*stdfun9)(void *, void *, void *, void *, \
 void *, void *, void *, void *, void *);
typedef void * __stdcall (*stdfun10)(void *, void *, void *, void *, \
 void *, void *, void *, void *, void *, void *);
typedef void * __stdcall (*stdfun11)(void *, void *, void *, void *, \
 void *, void *, void *, void *, void *, void *, void *);
typedef void * __stdcall (*stdfun12)(void *, void *, void *, void *, \
 void *, void *, void *, void *, void *, void *, void *, void *);
typedef void * __stdcall (*stdfun13)(void *, void *, void *, void *, \
 void *, void *, void *, void *, void *, void *, void *, void *, \
 void *);
typedef void * __stdcall (*stdfun14)(void *, void *, void *, void *, \
 void *, void *, void *, void *, void *, void *, void *, void *, \
 void *, void *);
typedef void * __stdcall (*stdfun15)(void *, void *, void *, void *, \
 void *, void *, void *, void *, void *, void *, void *, void *, \
 void *, void *, void *);
typedef void * __stdcall (*stdfun16)(void *, void *, void *, void *, \
 void *, void *, void *, void *, void *, void *, void *, void *, \
 void *, void *, void *, void *);
                               
LVAL xshlibstdcalladdr()
{
  void *f = getnpaddr(xlganatptr());
  void *a[MAX_CALLADDR_ARGS];
  int n, i;

  if (xlargc > MAX_CALLADDR_ARGS)
    xltoomany();

  <read arguments for call-by-address>
  
  switch (n) {
  case 0: return cvvoidptr(((stdfun0) f)());
  case 1: return cvvoidptr(((stdfun1) f)(a[0]));
  case 2: return cvvoidptr(((stdfun2) f)(a[0],a[1]));
  case 3: return cvvoidptr(((stdfun3) f)(a[0],a[1],a[2]));
  case 4: return cvvoidptr(((stdfun4) f)(a[0],a[1],a[2],a[3]));
  case 5: return cvvoidptr(((stdfun5) f)(a[0],a[1],a[2],a[3],
                                         a[4]));
  case 6: return cvvoidptr(((stdfun6) f)(a[0],a[1],a[2],a[3],
                                         a[4], a[5]));
  case 7: return cvvoidptr(((stdfun7) f)(a[0],a[1],a[2],a[3],
                                         a[4],a[5],a[6]));
  case 8: return cvvoidptr(((stdfun8) f)(a[0],a[1],a[2],a[3],
                                         a[4],a[5],a[6],a[7]));
  case 9: return cvvoidptr(((stdfun9) f)(a[0],a[1],a[2],a[3],
                                         a[4],a[5],a[6],a[7],
                                         a[8]));
  case 10: return cvvoidptr(((stdfun10) f)(a[0],a[1],a[2],a[3],
                                           a[4],a[5],a[6],a[7],
                                           a[8],a[9]));
  case 11: return cvvoidptr(((stdfun11) f)(a[0],a[1],a[2],a[3],
                                           a[4],a[5],a[6],a[7],
                                           a[8],a[9],a[10]));
  case 12: return cvvoidptr(((stdfun12) f)(a[0],a[1],a[2],a[3],
                                           a[4],a[5],a[6],a[7],
                                           a[8],a[9],a[10],a[11]));
  case 13: return cvvoidptr(((stdfun13) f)(a[0],a[1],a[2],a[3],
                                           a[4],a[5],a[6],a[7],
                                           a[8],a[9],a[10],a[11],
                                           a[12]));
  case 14: return cvvoidptr(((stdfun14) f)(a[0],a[1],a[2],a[3],
                                           a[4],a[5],a[6],a[7],
                                           a[8],a[9],a[10],a[11],
                                           a[12],a[13]));
  case 15: return cvvoidptr(((stdfun15) f)(a[0],a[1],a[2],a[3],
                                           a[4],a[5],a[6],a[7],
                                           a[8],a[9],a[10],a[11],
                                           a[12],a[13],a[14]));
  case 16: return cvvoidptr(((stdfun16) f)(a[0],a[1],a[2],a[3],
                                           a[4],a[5],a[6],a[7],
                                           a[8],a[9],a[10],a[11],
                                           a[12],a[13],a[14],a[15]));
  default: xlfail("too many arguments"); return NIL;
  }
}
#endif

Defines stdcall-by-address, xstdcalladdr (links are to index).

<funtab additions>+= [<-D->]
{   "SHARED-LIBRARY::STDCALL-BY-ADDRESS",       S, xshlibstdcalladdr},

As a minimal test, use the file foo.c

<foo.c>=
#include <stdio.h>
void foo()
{
  stdputstr("Hello\n");
}

Defines foo (links are to index).

After creating the shared library foo.dll this produces

> (setf lib (shlib::shlib-open "foo.dll"))
#<Pointer: #7b0317c8>
> (setf foo (shlib::shlib-symaddr lib "foo"))
#<Pointer: #7afed01a>
> (shlib::call-by-address foo)
Hello
#<Pointer: #0>

The existing function address-of can be used to obtain the addresses of Lisp objects. For Lisp vectors, the function array-data-address returns the address of the first vector data entry. Using this function may require a locking mechanism if I ever move to a setup where compaction is possible. ****

<xlshlib.c body>+= (<-U) [<-D->]
/* ARRAY-DATA-ADDRESS array */
LVAL xarraydata_addr()
{
  LVAL x = xlgetarg();
  xllastarg();

  switch (ntype(x)) {
  case DARRAY: x = getdarraydata(x); /* and drop through */
  case VECTOR:
  case STRING:
  case TVEC: return newnatptr(gettvecdata(x), x);
  default: return xlbadtype(x);
  }
}

Defines array-data-address, xarraydata_addr (links are to index).

<funtab additions>+= [<-D->]
{   "ARRAY-DATA-ADDRESS",                       S, xarraydata_addr },

Emulating the Old call-cfun

<oldcfun.lsp>=
(defpackage "SHARED-LIBRARY" (:use "XLISP") (:nicknames "SHLIB"))
(in-package "SHARED-LIBRARY")

<oldcfun.lsp body>

We need a function to copy lisp arguments to fresh typed vector arguments.

<oldcfun.lsp body>= (<-U) [D->]
(defun lisp-to-arg (x)
  (let* ((seq (if (sequencep x) x (list x)))
         (type (if (every #'integerp seq) '(vector c-long) '(vector c-double)))
         (val (coerce seq type)))
    (if (eq val x) (copy-seq val) val)))

Defines lisp-to-arg (links are to index).

To emulate the old behavior, after the call the arguments need to be coerced to lists.

<oldcfun.lsp body>+= (<-U) [<-D->]
(defun arg-to-lisp (x) (coerce x 'list))

Defines arg-to-lisp (links are to index).

The old-call-cfun is then

<oldcfun.lsp body>+= (<-U) [<-D]
(defun old-call-cfun (name lib &rest args)
  (let* ((fun-addr (shlib-symaddr lib name))
         (argvecs (mapcar #'lisp-to-arg args))
         (arg-addrs (mapcar #'array-data-address argvecs)))
    (apply #'call-by-address fun-addr arg-addrs)
    (mapcar #'arg-to-lisp argvecs)))

Defines arg-to-lisp, lisp-to-arg, old-call-cfun (links are to index).

Test code for this is in cfuntest.c.

<cfuntest.c>=
bar(n, x, sum)
     int *n;
     double *x, *sum;
{
  int i;

  for (i = 0, *sum = 0.0; i < *n; i++) {
    *sum += x[i];
  }
}

Defines bar (links are to index).

After creating the library, we can use it as

> (load "oldcfun")
; loading oldcfun.lsp
T
> (setf lib (shlib::shlib-open "cfuntest.dll"))
#<Pointer: #7b0317c8>
> (shlib::old-call-cfun "bar" lib 5 (float (iseq 1 5)) 0.0)
((5) (1.0 2.0 3.0 4.0 5.0) (15.0))

Other Calls

> (setf user (shlib::shlib-open "user32.dll"))
#<Pointer: #bff60000>
> (setf gsm (shlib::shlib-symaddr user "GetSystemMetrics"))
#<Pointer: #bff6488b>
> (pointer-address (shlib::stdcall-by-address gsm 0))
800
> (pointer-address (shlib::stdcall-by-address gsm 1))
600

There are some systems where different pointers have different representations. For example, I seem to remember that Cray uses a special representation for char * pointers. I think this means the array-data-access function should be more careful about the pointer type it converts to long, but I'm not sure.

Lisp Functions

Addresses of dynamically loaded functions can be installed in a new SUBR node with make-subr (xmakesubr). The offset used is zero. This installs a valid SUBR when a workspace is reloaded (but there may be a problem if this is a multiple value subr ****). The optional second argument to make-subr specifies whether the function returns multiple values; the default is NIL. [Storing a pointer in a SUBR does not currently store the protected value of the pointer, only the pointer address. the SUBR note should be changed to allow this protected value, i.e. the shared library handle, to be stored. Then the shared library can be safely closed when all Lisp references to it have disappeared, for example using the new finalization mechanism.]

<xlshlib.c body>+= (<-U) [<-D->]
/* MAKE-SUBR addr &optional mulvalp */
LVAL xmakesubr()
{
  LVAL val;
  LVAL (*fun)(void) = (LVAL (*)(void)) getnpaddr(xlganatptr());
  int mv = moreargs() ? (null(xlgetarg()) ? FALSE : TRUE) : FALSE;
  xllastarg();
  val = cvsubr(fun, SUBR, 0);
  setmulvalp(val, mv);
  return val;
}

Defines make-subr, xmakesubr (links are to index).

<funtab additions>+= [<-D->]
{   "SHARED-LIBRARY::MAKE-SUBR",          S, xmakesubr       },

Some useful macros:

<xlshlib.c macros>+= (<-U) [<-D]
#define setsubr(x,v) getsubr(x)=(v)
#define setoffset(x,v) getoffset(x)=(v)
#define xlgasubr()    (testarg(typearg(subrp)))

Defines setoffset, setsubr, xlgasubr (links are to index).

When a library is unloaded any SUBRs allocated for functions in the library should be invalidated with clear-subr (xclearsubr).

<xlshlib.c body>+= (<-U) [<-D->]
LOCAL LVAL errsubr() { xlfail("SUBR not available"); return NIL; }

/* CLEAR-SUBR subr */
LVAL xclearsubr()
{
  LVAL x = xlgasubr();
  xllastarg();
  setsubr(x, errsubr);
  setoffset(x, 0);
  setmulvalp(x, FALSE);
  return NIL;
}

Defines clear-subr, xclearsubr (links are to index).

<funtab additions>+= [<-D->]
{   "SHARED-LIBRARY::CLEAR-SUBR",         S, xclearsubr      },

The test example is in file baz.c.

<baz.c>=
#include "xlisp.h"

LVAL baz()
{
  FIXTYPE x, y;
  x = getfixnum(xlgafixnum());
  y = getfixnum(xlgafixnum());
  xllastarg();
  return cvfixnum(x + y);
}

Defines baz (links are to index).

Running this produces

> (setf lib (shlib::shlib-open "baz.dll"))
#<Pointer: #7b0317c8>
> (setf (symbol-function 'baz)
        (shlib::make-subr (shlib::shlib-symaddr lib "baz")))
#<Subr: #400be378>
> (baz 1 2)
3
> (shlib::clear-subr #'baz)
NIL
> (baz 1 2)
Error: SUBR not available

Higher Level

• Provide a simple way for initializing itself.
• Provide a reflection mechanism for determining what it contains without initializing it.
• Allow for efficient initialization in staticaly loaded modules.
• Provide support for version management.
• Limit name space pollution by allowing most functions to be declared static.

Versioning

Version information is represented by a structure

<version_info structure>= (U->)
struct version_info { long current, oldest; };

Defines version_info (links are to index).

The current field represents the primary version number; a request and an implementation are compatible if they have the same current version numbers. The oldest field represents the oldest version that is compatible. If the current request is newer than the implementation, but the current implementation is greater than or equal to the oldest version compatible with the request, then the versions are compatible. If the current request is less than the current implementation but the current request is greater than or equal to the oldest version compatible with the implementation, then the versions are compatible. Otherwise, the versions are not compatible. The function check_version implements this comparison.

<check_version function>= (U->)
static int check_version(struct version_info *req, struct version_info *imp)
{
  if (req->current == imp->current)
    return TRUE;
  else if (req->current > imp->current)
    return imp->current >= req->oldest ? TRUE : FALSE;
  else
    return req->current >= imp->oldest ? TRUE : FALSE;
}

Defines check_version (links are to index).

The version fields can be any integers, but I will use the convention that a version has a major and minor component. The macro MAKEVERSION constructs a version number from major and minor components.

<version definitions>= (U-> U->) [D->]
#define MAKEVERSION(major,minor) ((1L<<16) * major + minor)

Defines MAKEVERSION (links are to index).

This versioning system will be used for two purposes: to allow a module to contain version information and to distinguish versions of the module support system itself in case that system should change in an incompatible way. The current module system is 0.1 but it is compatible with the initial module system version 0.0. This is encoded in the macro XLSHLIB_SYSVERSION in the xlshlib.h include file used by modules and in the system implementation file xlshlib.c

<version definitions>+= (U-> U->) [<-D->]
#define XLSHLIB_SYSVERSION {MAKEVERSION(0,1),MAKEVERSION(0,0)}

Defines XLSHLIB_SYSVERSION (links are to index).

In the system implementation, this macro is used as the value of the static variable

<defsysversion variable definition>= (U->)
static struct version_info defsysversion = XLSHLIB_SYSVERSION;

Defines defsysversion (links are to index).

In the header file, this macro is used to form a macro for setting module version information in the module structure.

<version definitions>+= (U-> U->) [<-D]
#define XLSHLIB_VERSION_INFO(maj_cur,min_cur,maj_old,min_old) \
  XLSHLIB_SYSVERSION, \
  {MAKEVERSION(maj_cur,min_cur),MAKEVERSION(maj_old,min_old)}

Defines XLSHLIB_VERSION_INFO (links are to index).

Initialization

xlshlib_modinfo_t *foo__init(void);

<xlshlib_modinfo_t structure>= (U->)
typedef struct {
  struct version_info sysversion;
  struct version_info modversion;
  FUNDEF *funs;
  FIXCONSTDEF *fixconsts;
  FLOCONSTDEF *floconsts;
  STRCONSTDEF *strconsts;
  ULONGCONSTDEF *ulongconsts;
} xlshlib_modinfo_t;

Defines xlshlib_modinfo_t (links are to index).

This allows SUBR's and several kinds of simple constants to be specified.

The FUNDEF structure is the standard structure used in the internal function table. The constant definition structures are

<constant definition structures>= (U->)
typedef struct { char *name; FIXTYPE val; } FIXCONSTDEF;
typedef struct { char *name; FLOTYPE val; } FLOCONSTDEF;
typedef struct { char *name; char *val; } STRCONSTDEF;
typedef struct { char *name; unsigned long val; } ULONGCONSTDEF;

Defines FIXCONSTDEF, FLOCONSTDEF, STRCONSTDEF (links are to index).

The relevant declarations are contained in the header file xlshlib.h.

<xlshlib.h>=
#ifdef _Windows
#define XLGLOBAL __declspec(dllimport)
#endif

#include "xlisp.h"
#define MVSUBR (SUBR + TYPEFIELD + 1)

<version definitions>
<module table definitions>

with

<module table definitions>= (<-U U->)
<version_info structure>
<constant definition structures>
<xlshlib_modinfo_t structure>

As an example, suppose we have a module mymodule that implements a function fred. The module is in the file modex.c, which starts with

<modex.c>= [D->]
#include "xlshlib.h"

static LVAL fred()
{
  FIXTYPE x = getfixnum(xlgafixnum());
  FIXTYPE y = getfixnum(xlgafixnum());
  xllastarg();
  return cvfixnum(x + y);
}

Defines fred (links are to index).

The function table for this single SUBR is

<modex.c>+= [<-D->]
static FUNDEF myfuns[] = {
  { "FOO:FRED", SUBR, fred },
  { NULL, 0, NULL }
};

Defines myfuns (links are to index).

The package specification FOO causes a package FOO to be created at initialization time if one does not already exist. The single colon specifies that FRED should be made an external symbol in the package.

In addition, mymodule defines some constants:

<modex.c>+= [<-D->]
static FIXCONSTDEF myfixconsts[] = {
  { "FOO::FROG", 7 },
  { NULL, 0 }
};

static FLOCONSTDEF myfloconsts[] = {
  { "FOO::FROG-F", 5.0 },
  { NULL, 0 }
};

static STRCONSTDEF mystrconsts[] = {
  { "FOO::FROG-S", "Hello" },
  { NULL, 0 }
};

static ULONGCONSTDEF myulongconsts[] = {
  { "FOO::ULONG-MAX", ULONG_MAX },
  { NULL, 0 }
};

Defines myfixconsts, myfloconsts, mystrconsts, myulongconsts (links are to index).

To complete our example, we specify the module table and the simple initializtion routine:

<modex.c>+= [<-D]
static xlshlib_modinfo_t myinfo = {
  XLSHLIB_VERSION_INFO(0,1,0,1),
  myfuns,
  myfixconsts,
  myfloconsts,
  mystrconsts,
  myulongconsts
};

xlshlib_modinfo_t *mymodule__init() { return &myinfo; }

Defines myinfo, mymodule__init (links are to index).

This specifies current and oldest version fields of 0.1 for the module.

Initializing a Module

<xlshlib.c body>+= (<-U) [<-D->]
<version definitions>
<module table definitions>
<defsysversion variable definition>
<check_version function>

The initialization function is

<xlshlib.c body>+= (<-U) [<-D->]
/* SHLIB-INIT funtab &optional (version -1) (oldest version) */
LVAL xshlibinit()
{
  LVAL subr, val, sym;
  xlshlib_modinfo_t *info = getnpaddr(xlganatptr());
  FUNDEF *p = info->funs;
  FIXCONSTDEF *pfix = info->fixconsts;
  FLOCONSTDEF *pflo = info->floconsts;
  STRCONSTDEF *pstr = info->strconsts;
  struct version_info defversion;

  defversion.current = moreargs()?getfixnum(xlgafixnum()):-1;
  defversion.oldest = moreargs()?getfixnum(xlgafixnum()):defversion.current;
  xllastarg();

  if (! check_version(&defsysversion, &(info->sysversion)))
    xlfail("shared library not compatible with current system");
  if (defversion.current >= 0 &&
      ! check_version(&defversion, &(info->modversion)))
    xlfail("module not compatible with requested version");

  xlsave1(val);
  val = NIL;
  if (p != NULL)
    for (val = NIL; (p->fd_subr) != (LVAL(*)(void)) NULL; p++) {
      subr = cvsubr(p->fd_subr, p->fd_type & TYPEFIELD, 0);
      setmulvalp(subr, (p->fd_type & (TYPEFIELD + 1)) ? TRUE : FALSE);
      val = cons(subr, val);
      if (p->fd_name != NULL) {
        sym = xlenter(p->fd_name);
        setfunction(sym, subr);
      }
    }
  if (pfix != NULL)
    for (; pfix->name != NULL; pfix++) {
      sym = xlenter(pfix->name);
      defconstant(sym, cvfixnum(pfix->val));
    }
  if (pflo != NULL)
    for (; pflo->name != NULL; pflo++) {
      sym = xlenter(pflo->name);
      defconstant(sym, cvflonum(pflo->val));
    }
  if (pstr != NULL)
    for (; pstr->name != NULL; pstr++) {
      sym = xlenter(pstr->name);
      defconstant(sym, cvstring(pstr->val));
    }
  if (info->sysversion.current >= MAKEVERSION(0,1)) {
    ULONGCONSTDEF *pulong = info->ulongconsts;
    if (pulong != NULL)
      for (; pulong->name != NULL; pulong++) {
        sym = xlenter(pulong->name);
        defconstant(sym, ulong2lisp(pulong->val));
      }
  }
  xlpop();
  return xlnreverse(val);
}

Defines shlib-init, xshlibinit (links are to index).

<funtab additions>+= [<-D->]
{   "SHARED-LIBRARY::SHLIB-INIT",         S, xshlibinit      },

Running our example using these raw tools produces

> (setf mex (shlib::shlib-open "modex.dll"))
#<Pointer: #7b0317c8>
> (setf ini (shlib::shlib-symaddr mex "mymodule__init"))
#<Pointer: #7afed01a>
> (setf ftab (shlib::call-by-address ini))
#<Pointer: #7afef058>
> (shlib::shlib-init ftab)
(#<Subr: #400be088>)
> (foo:fred 1 2)
3
> foo::frog
7
> foo::frog-f
5.0
> foo::frog-s
"Hello"
> foo::ulong-max
4294967295

A Reflection Function

<xlshlib.c body>+= (<-U) [<-D]
/* SHLIB-INFO funtab */
LVAL xshlibinfo()
{
  LVAL val;
  xlshlib_modinfo_t *info = getnpaddr(xlganatptr());
  FUNDEF *p = info->funs;
  FIXCONSTDEF *pfix = info->fixconsts;
  FLOCONSTDEF *pflo = info->floconsts;
  STRCONSTDEF *pstr = info->strconsts;
  xllastarg();

  if (! check_version(&defsysversion, &(info->sysversion)))
    xlfail("shared library not compatible with current system");

  xlsave1(val);
  val = cons(cvfixnum((FIXTYPE) info->modversion.current), NIL);
  val = cons(cvfixnum((FIXTYPE) info->modversion.oldest), val);
  val = cons(NIL, val);
  if (p != NULL) {
    for (; (p->fd_subr) != (LVAL(*)(void)) NULL; p++)
      rplaca(val, cons(cvstring(p->fd_name), car(val)));
    rplaca(val, xlnreverse(car(val)));
  }
  val = cons(NIL, val);
  if (pfix != NULL)
    for (; pfix->name != NULL; pfix++)
      rplaca(val, cons(cvstring(pfix->name), car(val)));
  if (pflo != NULL)
    for (; pflo->name != NULL; pflo++)
      rplaca(val, cons(cvstring(pflo->name), car(val)));
  if (pstr != NULL)
    for (; pstr->name != NULL; pstr++)
      rplaca(val, cons(cvstring(pstr->name), car(val)));
  if (info->sysversion.current >= MAKEVERSION(0,1)) {
    ULONGCONSTDEF *pulong = info->ulongconsts;
    for (; pulong->name != NULL; pulong++)
      rplaca(val, cons(cvstring(pulong->name), car(val)));
  }
  rplaca(val, xlnreverse(car(val)));
  xlpop();
  return xlnreverse(val);
}

Defines shlib-info, xshlibinfo (links are to index).

<funtab additions>+= [<-D]
{   "SHARED-LIBRARY::SHLIB-INFO",         S, xshlibinfo      },

A Lisp Front End

<shared library structure definition>= (U->)
(defstruct (shared-library
            (:constructor (make-shared-library (name path handle subrs)))
            (:print-function print-shlib))
  name path handle subrs)

Defines shared-library (links are to index).

The structure print function is

<shared library structure print function>= (U->)
(defun print-shlib (shlib stream depth)
  (format stream "#<shared library ~s>" (shared-library-name shlib)))

Defines print-shlib (links are to index).

A shared library is loaded with load-shared-library. The default module name is determined as the base file name for the path, but an altenate can be specified.

<load-shared-library definition>= (U->)
(defun load-shared-library (path &optional
                                 (name (pathname-name path))
                                 (version -1)
                                 (oldest version))
  (let ((*package* *package*)
        (handle (shlib-open path))
        (success nil))
    (unwind-protect
        (let* ((init (shlib-symaddr handle (format nil "~a__init" name)))
               (ftab (call-by-address init))
               (subrs (shlib-init ftab version oldest))
               (shlib (make-shared-library name path handle subrs)))
          ;;(register-saver shlib #'close-shared-library)
          (setf success t)
          shlib)
      (unless success (shlib-close handle)))))

Defines load-shared-library (links are to index).

A shared library is closed by close-shared-library.

<close-shared-library definition>= (U->)
(defun close-shared-library (shlib)
  ;;(unregister-saver shlib)
  (dolist (s (shared-library-subrs shlib))
    (clear-subr s))
  (shlib-close (shared-library-handle shlib)))

Defines close-shared-library (links are to index).

The function shared-library-information provides information about the library module's content.

<shared-library-information definition>= (U->)
(defun shared-library-information (path &optional (name (pathname-name path)))
  (let ((*package* *package*)
        (handle (shlib-open path)))
    (unwind-protect
        (let* ((init (shlib-symaddr handle (format nil "~a__init" name)))
               (ftab (call-by-address init)))
          (shlib-info ftab))
      (shlib-close handle))))

Defines shared-library-information (links are to index).

The implementation is in the file shlib.lsp.

<shlib.lsp>=
(defpackage "SHARED-LIBRARY" (:use "XLISP") (:nicknames "SHLIB"))
(in-package "SHARED-LIBRARY")
<shared library structure definition>
<shared library structure print function>

(export '(load-shared-library close-shared-library
          shared-library-information))

<load-shared-library definition>
<close-shared-library definition>
<shared-library-information definition>

The example using this front end:

> (use-package "SHLIB")
T
> (shared-library-information "modex.dll" "mymodule")
(1 1 ("FOO:FRED") ("FOO::FROG" "FOO::FROG-F" "FOO::FROG-S" "FOO::ULONG-MAX"))
> (load-shared-library "modex.dll" "mymodule")
#<shared library "mymodule">
> (foo:fred 1 2)
3
> foo::frog
7
> foo::frog-f
5.0
> foo::frog-s
"Hello"
> foo::ulong-max
4294967295

Open Issues

• **** Finalization is not used. It's not clear what the right thing to do would be. Should an attempt be made to reload a library when a workspace is restored? Should a library be unloaded when the last referenfe to its handle disappears? Probably only if SUBR's that refer to the library have a pointer to the library in them --- a good idea in a later redesign.
• **** Should it be possible to have multiple modules in one library?
• **** I have not yet tested this on Windows. In principle it should work, but header files may need to be rewritten to handle the exporting nonsnse. Some issues along these lines will also exist on AIX.
• **** It might be useful to arrange to avoid loading a library that is already loaded in the ``high level'' stuff.
• **** Some help in creating shared libraries is needed. On the UNIX side, either GNU libtool or the Tcl mechanism should be considered. In addition, the header files and CFLAGS need some rearranging.
• **** Some tools for automating generation of interfaces are needed. Perhaps SWIG or something similar can be used.
• **** The ``higher-level'' system described here only deals with native shared libraries. It is not a proper module system in the sense of combining code management, namespace management, separate compilation, etc. Something along these lines is still needed.

Indices

Chunks

• <baz.c>: D1
• <cfuntest.c>: D1
• <check_version function>: D1, U2
• <close-shared-library definition>: D1, U2
• <constant definition structures>: D1, U2
• <defsysversion variable definition>: D1, U2
• <foo.c>: D1
• <funtab additions>: D1, D2, D3, D4, D5, D6, D7, D8, D9, D10
• <load-shared-library definition>: D1, U2
• <modex.c>: D1, D2, D3, D4
• <module table definitions>: U1, D2, U3
• <oldcfun.lsp>: D1
• <oldcfun.lsp body>: U1, D2, D3, D4
• <read arguments for call-by-address>: U1, D2, U3
• <shared library structure definition>: D1, U2
• <shared library structure print function>: D1, U2
• <shared-library-information definition>: D1, U2
• <shlib.lsp>: D1
• <version definitions>: D1, D2, D3, U4, U5
• <version_info structure>: D1, U2
• <xlshlib.c>: D1
• <xlshlib.c body>: U1, D2, D3, D4, D5, D6, D7, D8, D9, D10, D11, D12, D13
• <xlshlib.c macros>: U1, D2, D3
• <xlshlib.h>: D1
• <xlshlib_modinfo_t structure>: D1, U2

Identifiers

• arg-to-lisp: D1, D2
• array-data-address: D1
• bar: D1
• baz: D1
• call-by-address: D1, U2, U3
• check_version: D1, U2, U3
• clear-subr: D1, U2
• close-shared-library: D1, U2
• cvvoidptr: U1, D2, U3
• defsysversion: D1, U2, U3
• FIXCONSTDEF: U1, D2, U3, U4, U5
• FLOCONSTDEF: U1, D2, U3, U4, U5
• foo: D1
• fred: D1, U2
• lisp-to-arg: D1, D2
• load-shared-library: D1, U2
• make-subr: D1
• MAKEVERSION: D1, U2, U3, U4, U5
• myfixconsts: D1, U2
• myfloconsts: D1, U2
• myfuns: D1, U2
• myinfo: D1
• mymodule__init: D1
• mystrconsts: D1, U2
• myulongconsts: D1, U2
• old-call-cfun: D1
• print-shlib: U1, D2
• setoffset: D1, U2
• setsubr: D1, U2
• shared-library: D1, U2, U3, U4, U5, U6
• shared-library-information: D1, U2
• shlib-close: D1, U2, U3, U4
• shlib_error: D1, U2, U3, U4
• shlib-info: D1, U2
• shlib-init: D1, U2
• shlib-open: D1, U2, U3
• shlib-symaddr: D1, U2, U3, U4
• stdcall-by-address: D1
• STRCONSTDEF: U1, D2, U3, U4, U5
• version_info: D1, U2, U3, U4, U5
• xarraydata_addr: D1, U2
• xcalladdr: D1
• xclearsubr: D1, U2
• xdlclose: D1
• xlgasubr: D1, U2
• xlshlib_modinfo_t: D1, U2, U3, U4
• XLSHLIB_SYSVERSION: D1, U2, U3
• XLSHLIB_VERSION_INFO: D1, U2
• xmakesubr: D1, U2
• xshlibinfo: D1, U2
• xshlibinit: D1, U2
• xshlibopen: D1, U2
• xshlibsymaddr: D1, U2
• xstdcalladdr: D1