/*
 * Copyright (c) 2003-2012
 * Distributed Systems Software.  All rights reserved.
 * See the file LICENSE for redistribution information.
 */

/*
 * Support for dynamic loading, allowing extensible DACS expressions.
 * If myfunc.c contains a function of interest, compile a shared
 * library by doing something like this:
 *   gcc -export-dynamic -shared myfunc.c -o myfunc.so.1
 * Then load the library using dynload_load(), find the symbol (function name)
 * of interest using dynload_symbol, and then call it (or whatever).
 * If the code being loaded references symbols within the program that does
 * the loading, it seems necessary that the program also be compiled with
 * the -export-dynamic flag.
 *
 * A full-blown implementation of this requires something along the lines
 * of libffi (liberal license):
 *   http://sourceware.org/libffi/ or http://sablevm.org/download/snapshot/
 * or ffcall (GPL):
 *   http://directory.fsf.org/libs/C_libraries/ffcall.html
 * or perl's C::DynaLib or perlxs:
 *   http://aspn.activestate.com/ASPN/CodeDoc/C-DynaLib/DynaLib.html
 *   http://aspn.activestate.com/ASPN/docs/ActivePerl/5.8/lib/Pod/perlxs.html
 *
 * Also see: www.dyncall.org
 */

#ifndef lint
static const char copyright[] =
"Copyright (c) 2003-2012\n\
Distributed Systems Software.  All rights reserved.";
static const char revid[] =
  "$Id: dynload.c 2594 2012-10-19 17:28:49Z brachman $";
#endif

#include "auth.h"
#include "acs.h"
#include "local.h"

#include <dlfcn.h>
#include <string.h>
#include <stdlib.h>
#include <stdio.h>

static const char *log_module_name = "dynload";

/*
 * Open the shared object in PATH and return a descriptor for operations on it,
 * or return NULL and optionally set ERR to an error message.
 */
void *
dynload_load(char *path, char **err)
{
  void *handle;
 
  if ((handle = dlopen(path, RTLD_NOW | RTLD_GLOBAL)) == NULL) {
	if (err != NULL)
	  *err = strdup(dlerror());
	return(NULL);
  }

  return(handle);
}

/*
 * Resolve SYMBOL in the shared object HANDLE and return its address,
 * or return NULL and optionally set ERR to an error message.
 */
void *
dynload_symbol(void *handle, char *symbol, char **err)
{
  void *sym;

  if ((sym = dlsym(handle, symbol)) == NULL) {
	if (err != NULL)
	  *err = strdup(dlerror());
	return(NULL);
  }

  return(sym);
}

#ifdef HAVE_DLFUNC
/*
 * Resolve SYMBOL in the shared object HANDLE, which is assumed to be a
 * function, and return its address, or return NULL and optionally set ERR
 * to an error message.
 * Not all platforms have dlfunc(), which may result in an unavoidable
 * compilation warning when the void * returned by dlsym() is cast to a
 * function pointer.
 */
dlfunc_t
dynload_func_symbol(void *handle, char *symbol, char **err)
{
  dlfunc_t sym;

  if ((sym = dlfunc(handle, symbol)) == NULL) {
	if (err != NULL)
	  *err = strdup(dlerror());
	return(NULL);
  }

  return(sym);
}
#else
dlfunc_t
dynload_func_symbol(void *handle, char *symbol, char **err)
{

  return(dynload_symbol(handle, symbol, err));
}
#endif

/*
 * Resolve SYMBOL, a user-provided function found in the shared object
 * descriptor HANDLE, and call it to obtain a list of symbols that need to
 * be registered.
 * Return 0 if ok, -1 otherwise.
 */
int
dynload_register(void *handle, char *symbol, char **err)
{
  int i;
  dlfunc_t sym;
  Dsvec *dsv;
  Dsvec *(*callback)(void);

  if ((sym = dynload_func_symbol(handle, symbol, err)) == NULL)
	return(-1);

  callback = (Dsvec * (*)(void)) sym;
  if ((dsv = callback()) == NULL)
	return(-1);

  for (i = 0; dsvec_ptr(dsv, i, char *) != NULL; i++) {
	fprintf(stderr, "%s\n", dsvec_ptr(dsv, i, char *));
  }

  return(0);
}

/*
 * Close the shared object descriptor HANDLE.
 */
int
dynload_unload(void *handle, char **err)
{

  if (dlclose(handle) == -1) {
	if (err != NULL)
	  *err = strdup(dlerror());
	return(-1);
  }

  return(0);
}

/*
 * Purely for testing purposes.
 */
int
dynload_sqrt(void)
{
  char *errmsg;
  void *h;
  dlfunc_t sym;
  double (*sqrt_func)(double);

  if ((h = dynload_load("/usr/lib/libm.so", &errmsg)) == NULL) {
	fprintf(stderr, "dynload_load failed: %s\n", errmsg);
	return(-1);
  }

  if ((sym = dynload_func_symbol(h, "sqrt", &errmsg)) == NULL) {
	fprintf(stderr, "dynload_symbol failed: %s\n", errmsg);
	return(-1);
  }

  sqrt_func = (double (*)(double)) sym;
  fprintf(stderr, "sqrt(36.0) = %f\n", sqrt_func(36.0));

  if (dynload_unload(h, &errmsg) == -1) {
	fprintf(stderr, "dynload_unload failed: %s\n", errmsg);
	return(-1);
  }

  return(0);
}

int
wrap_strsplit(char *name, int nargs, Arglist *arglist, Expr_result *result)
{
  int limit;
  char *delimit, *str;
  Arglist *a;
  Dsvec *dsv;
  Value v;

  a = arglist;
  if (a == NULL || a->result->value.token != T_STRING) {
  fail:
	result->err = ACS_EXPR_EVAL_ERROR;
	result->errmsg = "Yabba dabba";
	return(-1);
  }
  str = a->result->value.val.strval;

  a = a->next;
  if (a == NULL || a->result->value.token != T_STRING)
	goto fail;
  delimit = a->result->value.val.strval;

  a = a->next;
  if (a == NULL || a->result->value.token != T_INTEGER)
	goto fail;
  limit = a->result->value.val.intval;

  if (a->next != NULL)
	goto fail;

  init_value(&v, T_LIST, sizeof(Value));
  dsv = strsplit(str, delimit, limit);
  result->value.token = T_LIST;
  result->value = v;

  return(0);
}

#ifdef NOTDEF

/*
 * An interface to this functionality might be provided through DACS
 * expressions:
 *    module_load(module_name, path)
 * where module_name is a symbolic name for the loaded module
 * and PATH is passed to dynload_load().  The module may optionally
 * provide a function called MODULE_NAME_register, which takes no arguments
 * and returns a struct Function.
 *
 * A Function describes a callable function.
 * SYMBOL_NAME is passed to dynload_symbol() to get the function's
 * entry point.  FUNCTION_NAME is the name by which this
 * function will be invoked within a DACS expression.  ARGDESC
 * is a description of the function's arguments (same syntax as for the
 * built-in functions), and RESULT_TYPE is what the function returns.
 *
 * FUNCTION_NAME probably ought to be something not already defined, unless
 * the caller wants to override a built-in or previously-loaded function.
 * A new notation or convention might be defined to unambiguously
 * reference a function from within expressions:
 * e.g., MODULE_NAME.FUNCTION_NAME(...)
 *
 * An alternate method of registering a function (e.g., for a library
 * without a register function)
 *   module_add_function(module_name, path, symbol_name, function_name,
 *     argdesc, result_type)
 * Since libm won't have a registration function, one would say:
 *   module_load("LIBM", "/usr/lib/libm.so");
 *   module_add_function("LIBM", "sqrt", "square_root", "r", "r");
 *
 *   module_unload(module_name)
 * results in a call to dynload_unload() and undefines all symbols
 * associated with MODULE_NAME.
 * Also:
 *   module_unload_function(module_name, function_name)
 *
 * Function names in expressions look like [module-name.]function-name;
 * e.g., libm.sqrt(77.0).
 * A special module namespace is identified by "" and refers to the
 * default namespace where the predefined functions live.
 * If the module-name is absent, then expression processing first looks for
 * a dynamically loaded function-name; if not found, it will look for a
 * predefined function - this provides a way of overriding a predefined
 * function.
 * Predefined functions cannot be deleted or unloaded.
 */

typedef struct Function {
  char *symbol_name;		/* Symbol name to use to load the function. */
  char *function_name;		/* Symbolic name to call the function. */
  char *argdesc;			/* DACS expr syntax for checking args. */
  char *resultdesc;			/* Result type */
  void *funcptr;			/* Address of function in memory. */
} Function;

typedef struct Module {
  char *name;				/* Name for this collection of functions. */
  char *path;				/* File where functions were loaded from. */
  void *handle;
  Dsvec *functions;			/* Functions associated with this module. */
} Module;

static Dsvec *modules = NULL;

static Module *
find_module(char *module_name)
{
  int i;
  Module *m;

  if (modules == NULL)
	return(NULL);

  for (i = 0; i < dsvec_len(modules); i++) {
	m = dsvec_ptr(modules, i, Module *);
	if (streq(m->name, module_name))
	  return(m);
  }

  return(NULL);
}

static int
delete_module(Module *m)
{
  int i;
  Module *mm;

  if (modules == NULL)
	return(-1);

  if (dsvec_delete_ptr(modules, m) == -1)
	return(-1);

  return(0);
}

static Function *
find_function(Module *m, char *function_name)
{
  int i;
  Function *f;

  if (m == NULL || m->functions == NULL)
	return(NULL);

  for (i = 0; i < dsvec_len(m->functions); i++) {
	f = dsvec_ptr(m->functions, i, Function *);
	if (streq(f->function_name, function_name))
	  return(f);
  }

  return(NULL);
}

int
module_lookup_function(char *name, Module **m_p, Function **f_p)
{
  char *func_name, *mod_name, *n, *p;
  Function *f;
  Module *m;

  if ((p = strchr(name, (int) ':')) == NULL) {
	mod_name = "";
	func_name = name;
  }
  else if (*(p + 1) == ':') {
	mod_name = strndup(name, p - name);
	func_name = p + 2;
  }
  else
	return(-1);

  m = find_module(mod_name);

  if ((f = find_function(m, func_name)) == NULL)
	return(-1);

  if (m_p != NULL)
	*m_p = m;
  if (f_p != NULL)
	*f_p = f;

  return(1);
}

#include "ffi.h"

/*
 * Our syntax is much like that of C/C++.  A comma-separated list
 * of elements is expected, each of which looks like:
 *   [<direction>] [<sign>] [<size>] [<type>] [<pointer>]
 * At least one of <sign>, <size>, and <type> must appear.
 * Patently invalid combinations are detected ("unsigned float").
 * The <direction> indicates whether the element is input only (the default),
 * output only, or both input and output.  For pointers, either kind of
 * output element may optionally be followed by an integer, within square
 * brackets, that indicates the size of the element in units
 * ("out[10] int *" means the element points to a vector of 10 integers).
 *
 * XXX Doesn't grok "const".
 * XXX Could include basic "system" types, like time_t and size_t.
 */
typedef struct Typedesc {
  enum direction { IN_ONLY, OUT_ONLY, IN_OUT } direction;
  enum sign { SIGNED, UNSIGNED, DEFSIGN } sign;
  enum size { SHORT, REGULAR, LONG } size;
  enum type {
	CHAR, INT, FLOAT, DOUBLE, VOID,
	TYPE_UINT8, TYPE_INT8, TYPE_UINT16, TYPE_INT16, TYPE_UINT32, TYPE_INT32,
	TYPE_UINT64, TYPE_INT64
  } type;
  int is_pointer;
  int short_form;
  long alloc;
} Typedesc;

static Dsvec *
parse_typedesc(char *str)
{
  char *e, *p, *q;
  Dsvec *dsv;
  Typedesc *desc;
  extern int is_intval_str(char *str, long *val, char **endp);

  dsv = NULL;
  p = strdup(str);
  while (p != NULL && *p != '\0') {
	if ((e = strchr(p, (int) ',')) != NULL)
	  *e++ = '\0';
	desc = ALLOC(Typedesc);
	while (*p == ' ')
	  p++;

	if ((q = strprefix(p, "inout")) != NULL) {
	  desc->direction = IN_OUT;
	  p = q;
	}
	else if (strprefix(p, "int") == NULL && (q = strprefix(p, "in")) != NULL) {
	  desc->direction = IN_ONLY;
	  p = q;
	}
	else if ((q = strprefix(p, "out")) != NULL) {
	  desc->direction = OUT_ONLY;
	  p = q;
	}
	else
	  desc->direction = IN_ONLY;

	desc->alloc = 0;
	if (desc->direction == IN_OUT || desc->direction == OUT_ONLY) {
	  if (*p == '[') {
		if (is_intval_str(p + 1, &desc->alloc, &q) != 1 || desc->alloc < 1)
		  return(NULL);
		if (*q != ']')
		  return(NULL);
		p = q + 1;
	  }
	}
	while (*p == ' ')
	  p++;


	if ((q = strprefix(p, "unsigned")) != NULL) {
	  desc->sign = UNSIGNED;
	  p = q;
	}
	else if ((q = strprefix(p, "signed")) != NULL) {
	  desc->sign = SIGNED;
	  p = q;
	}
	else
	  desc->sign = DEFSIGN;
	while (*p == ' ')
	  p++;

	if ((q = strprefix(p, "short")) != NULL) {
	  desc->size = SHORT;
	  p = q;
	}
	else if ((q = strprefix(p, "long")) != NULL) {
	  desc->size = LONG;
	  p = q;
	}
	else
	  desc->size = REGULAR;
	while (*p == ' ')
	  p++;

	desc->short_form = 0;
	desc->type = INT;
	if ((q = strprefix(p, "char")) != NULL) {
	  desc->type = CHAR;
	  p = q;
	}
	else if ((q = strprefix(p, "int")) != NULL) {
	  desc->type = INT;
	  p = q;
	}
	else if ((q = strprefix(p, "float")) != NULL) {
	  desc->type = FLOAT;
	  p = q;
	}
	else if ((q = strprefix(p, "double")) != NULL) {
	  desc->type = DOUBLE;
	  p = q;
	}
	else if ((q = strprefix(p, "void")) != NULL) {
	  desc->type = VOID;
	  p = q;
	}
	else if ((q = strprefix(p, "uint8")) != NULL) {
	  desc->type = TYPE_UINT8;
	  desc->short_form = 1;
	  p = q;
	}
	else if ((q = strprefix(p, "sint8")) != NULL
			 || (q = strprefix(p, "int8")) != NULL) {
	  desc->type = TYPE_INT8;
	  desc->short_form = 1;
	  p = q;
	}
	else if ((q = strprefix(p, "uint16")) != NULL) {
	  desc->type = TYPE_UINT16;
	  desc->short_form = 1;
	  p = q;
	}
	else if ((q = strprefix(p, "sint16")) != NULL
			 || (q = strprefix(p, "int16")) != NULL) {
	  desc->type = TYPE_INT16;
	  desc->short_form = 1;
	  p = q;
	}
	else if ((q = strprefix(p, "uint32")) != NULL) {
	  desc->type = TYPE_UINT32;
	  desc->short_form = 1;
	  p = q;
	}
	else if ((q = strprefix(p, "sint32")) != NULL
			 || (q = strprefix(p, "int32")) != NULL) {
	  desc->type = TYPE_INT32;
	  desc->short_form = 1;
	  p = q;
	}
	else if ((q = strprefix(p, "uint64")) != NULL) {
	  desc->type = TYPE_UINT64;
	  desc->short_form = 1;
	  p = q;
	}
	else if ((q = strprefix(p, "sint64")) != NULL
			 || (q = strprefix(p, "int64")) != NULL) {
	  desc->type = TYPE_INT64;
	  desc->short_form = 1;
	  p = q;
	}

	if (*p != '*' && *p != ' ' && *p != '\0')
	  return(NULL);
	while (*p == ' ')
	  p++;
	desc->is_pointer = 0;
	while (*p == '*') {
	  desc->is_pointer++;
	  p++;
	  while (*p == ' ')
		p++;
	}
	if (*p != '\0')
	  return(NULL);

	/* Some combinations are invalid ("unsigned short float"). */
	if (desc->sign != DEFSIGN
		&& (desc->type == FLOAT || desc->type == DOUBLE || desc->type == VOID))
	  return(NULL);
	if (desc->size != REGULAR
		&& (desc->type == FLOAT || desc->type == CHAR || desc->type == VOID))
	  return(NULL);
	if (desc->size == SHORT && desc->type == DOUBLE)
	  return(NULL);
	if ((desc->sign != UNSIGNED || desc->size != REGULAR) && desc->short_form)
	  return(NULL);
	if (desc->direction != IN_ONLY && !desc->is_pointer)
	  return(NULL);

	if (dsv == NULL)
	  dsv = dsvec_init(NULL, sizeof(Typedesc *));
	dsvec_add_ptr(dsv, desc);
	p = e;
  }

  return(dsv);
}

/*
 * Call dynamically loaded function F in module M with ARGLIST, putting
 * the result in RESULT.
 * Return -1 if evaluation fails, 0 otherwise.
 */
int
module_eval_function(Module *m, Function *f,
					 Lex_state *e, Arglist *arglist, Expr_result *result)
{
  int argcount, argnum, i, is_inout[10];
  Arglist *x;
  Dsvec *argvec, *resvec;
  Typedesc *desc;
  void *arg_values[10];
  char ch_val;
  short short_val;
  unsigned char uch_val;
  unsigned short ushort_val;
  int int_val;
  unsigned int uint_val;
  float float_val;
  unsigned long ulong_val;
  long double longdouble_val;
  int16 int16_val;
  uint16 uint16_val;
  ffi_cif cif;
  ffi_status ffi_st;
  ffi_type *result_type, *arg_types[10];

  /*
   * Marshall the arguments, converting when necessary.
   */
  for (argcount = 0, x = arglist; x != NULL; argcount++, x = x->next)
	;
  log_msg((LOG_TRACE_LEVEL, "Expecting %d argument%s for %s::%s",
		   argcount, argcount == 1 ? "" : "s", m->name, f->function_name));

  x = arglist;
  argnum = 0;
  if ((argvec = parse_typedesc(f->argdesc)) == NULL) {
	log_msg((LOG_ERROR_LEVEL, "Invalid argument descriptor: %s", f->argdesc));
	return(-1);
  }
  if ((resvec = parse_typedesc(f->resultdesc)) == NULL
	  || dsvec_len(resvec) != 1) {
	log_msg((LOG_ERROR_LEVEL, "Invalid result descriptor: %s", f->resultdesc));
	return(-1);
  }

  for (i = 0; i < dsvec_len(argvec); i++) {
	Typedesc *desc;

	desc = dsvec_ptr_index(argvec, i);

	switch (desc->type) {
	case TYPE_INT8:
	case TYPE_UINT8:
	  /* if (sizeof(int8) <= sizeof(char)) ... */
	  /* if (sizeof(int8) <= sizeof(int)) ... */
	  /* if (sizeof(int8) <= sizeof(long)) ... */
	  break;

	case CHAR:
	  if (desc->is_pointer) { /* [unsigned] char *foo */
		arg_types[argnum] = &ffi_type_pointer;
		if (desc->direction == OUT_ONLY)
		  x->result->value.val.strval = malloc(desc->alloc);
		arg_values[argnum] = &x->result->value.val.strval;
	  }
	  else if (desc->sign == UNSIGNED) {
		/* unsigned char foo */
		arg_types[argnum] = &ffi_type_uchar;
		uch_val = x->result->value.val.intval;
		arg_values[argnum] = &uch_val;
	  }
	  else { /* char foo */
		arg_types[argnum] = &ffi_type_schar;
		ch_val = x->result->value.val.intval;
		arg_values[argnum] = &ch_val;
	  }
	  break;

	case TYPE_INT16:
	case TYPE_UINT16:
	  if (desc->is_pointer) { /* int16 *foo */
		arg_types[argnum] = &ffi_type_pointer;
		if (desc->direction == OUT_ONLY)
		  arg_values[argnum] = malloc(sizeof(int16) * desc->alloc);
	  }
	  else if (desc->type == TYPE_INT16) {
		arg_types[argnum] = &ffi_type_int16;
		int16_val = x->result->value.val.intval;
		arg_values[argnum] = &int16_val;
	  }
	  else if (desc->type == TYPE_UINT16) {
		arg_types[argnum] = &ffi_type_uint16;
		uint16_val = x->result->value.val.intval;
		arg_values[argnum] = &uint16_val;
	  }
	  break;

	case TYPE_INT32:
	case TYPE_UINT32:
	  break;

	case TYPE_INT64:
	case TYPE_UINT64:
	  break;

	case INT:
	  if (desc->is_pointer) { /* [unsigned] int *foo */
		arg_types[argnum] = &ffi_type_pointer;
		if (desc->direction == OUT_ONLY)
		  arg_values[argnum] = malloc(sizeof(int) * desc->alloc);
	  }
	  else if (desc->sign == UNSIGNED) {
		if (desc->size == SHORT) { /* unsigned short foo */
		  arg_types[argnum] = &ffi_type_ushort;
		  ushort_val = x->result->value.val.intval;
		  arg_values[argnum] = &ushort_val;
		}
		else if (desc->size == LONG) { /* unsigned long foo */
		  arg_types[argnum] = &ffi_type_ulong;
		  ulong_val = x->result->value.val.intval;
		  arg_values[argnum] = &ulong_val;
		}
		else { /* unsigned int foo */
		  arg_types[argnum] = &ffi_type_uint;
		  uint_val = x->result->value.val.intval;
		  arg_values[argnum] = &uint_val;
		}
	  }
	  else {
		if (desc->size == SHORT) { /* short foo */
		  arg_types[argnum] = &ffi_type_sshort;
		  short_val = x->result->value.val.intval;
		  arg_values[argnum] = &short_val;
		}
		else if (desc->size == LONG) { /* long foo */
		  arg_types[argnum] = &ffi_type_slong;
		  arg_values[argnum] = &x->result->value.val.intval;
		}
		else { /* int foo */
		  arg_types[argnum] = &ffi_type_sint;
		  int_val = x->result->value.val.intval;
		  arg_values[argnum] = &int_val;
		}
	  }
	  break;

	case FLOAT:
	  if (desc->is_pointer) { /* float *foo */
		arg_types[argnum] = &ffi_type_pointer;
		if (desc->direction == OUT_ONLY)
		  arg_values[argnum] = malloc(sizeof(float) * desc->alloc);
	  }
	  else { /* float foo */
		arg_types[argnum] = &ffi_type_float;
		float_val = x->result->value.val.realval;
		arg_values[argnum] = &float_val;
	  }
	  break;

	case DOUBLE:
	  if (desc->is_pointer) { /* double *foo */
		arg_types[argnum] = &ffi_type_pointer;
		if (desc->direction == OUT_ONLY)
		  arg_values[argnum] = malloc(sizeof(double) * desc->alloc);
	  }
	  else if (desc->size == LONG) {
		arg_types[argnum] = &ffi_type_longdouble;
		arg_values[argnum] = &longdouble_val;
	  }
	  else { /* double foo */
		arg_types[argnum] = &ffi_type_double;
		arg_values[argnum] = &x->result->value.val.realval;
	  }
	  break;

	case VOID:
	  if (desc->is_pointer) { /* void *foo */
		arg_types[argnum] = &ffi_type_pointer;
		if (desc->direction == OUT_ONLY)
		  arg_values[argnum] = malloc(desc->alloc);
	  }
	  else { /* void foo */
		arg_types[argnum] = &ffi_type_pointer;
		arg_values[argnum] = NULL;
	  }
	  break;

	default:
	  break;
	}

	argnum++;
	x = x->next;
  }

  if (argcount != argnum) {
	log_msg((LOG_ERROR_LEVEL,
			 "Argument mismatch for %s::%s, expect %d, got %d",
			 m->name, f->function_name, argnum, argcount));
	return(-1);
  }

  /*
   * Determine the type of the result, call the function, and store
   * the result(s).
   */
  desc = dsvec_ptr_index(resvec, 0);
  switch (desc->type) {
  case CHAR:
	{
	  char ch_result;
	  unsigned char uch_result;
	  void *r;

	  if (desc->sign == UNSIGNED) {
		result_type = &ffi_type_uchar;
		r = &uch_result;
	  }
	  else {
		result_type = &ffi_type_schar;
		r = &ch_result;
	  }
	  ffi_st = ffi_prep_cif(&cif, FFI_DEFAULT_ABI, argnum, result_type,
							arg_types);
	  if (ffi_st != FFI_OK)
		return(-1);
	  ffi_call(&cif, f->funcptr, r, arg_values);
	  result->value.token = T_INTEGER;
	  if (desc->sign == UNSIGNED)
		result->value.val.intval = (unsigned long) uch_result;
	  else
		result->value.val.intval = (long) ch_result;
	}
	break;

  case INT:
	{
	  int int_result;
	  unsigned int uint_result;
	  short short_result;
	  unsigned short ushort_result;
	  long long_result;
	  unsigned long ulong_result;
	  void *r;

	  if (desc->sign == UNSIGNED) {
		if (desc->size == SHORT) {
		  result_type = &ffi_type_ushort;
		  r = &ushort_result;
		}
		else if (desc->size == LONG) {
		  result_type = &ffi_type_ulong;
		  r = &ulong_result;
		}
		else {
		  result_type = &ffi_type_uint;
		  r = &uint_result;
		}
	  }
	  else {
		if (desc->size == SHORT) {
		  result_type = &ffi_type_sshort;
		  r = &short_result;
		}
		else if (desc->size == LONG) {
		  result_type = &ffi_type_slong;
		  r = &long_result;
		}
		else {
		  result_type = &ffi_type_sint;
		  r = &int_result;
		}
	  }
	  ffi_st = ffi_prep_cif(&cif, FFI_DEFAULT_ABI, argnum, result_type,
							arg_types);
	  if (ffi_st != FFI_OK)
		return(-1);
	  ffi_call(&cif, f->funcptr, r, arg_values);
	  result->value.token = T_INTEGER;
	  if (desc->sign == UNSIGNED) {
		if (desc->size == LONG)
		  result->value.val.intval = (unsigned long) ulong_result;
		else if (desc->size == SHORT)
		  result->value.val.intval = (unsigned long) ushort_result;
		else
		  result->value.val.intval = (unsigned long) uint_result;
	  }
	  else {
		if (desc->size == LONG)
		  result->value.val.intval = (long) long_result;
		else if (desc->size == SHORT)
		  result->value.val.intval = (long) short_result;
		else
		  result->value.val.intval = (long) int_result;
	  }
	}
	break;

  case FLOAT:
	{
	  float f_result;

	  result_type = &ffi_type_float;
	  ffi_st = ffi_prep_cif(&cif, FFI_DEFAULT_ABI, argnum, result_type,
							arg_types);
	  if (ffi_st != FFI_OK)
		return(-1);
	  ffi_call(&cif, f->funcptr, &f_result, arg_values);
	  result->value.token = T_REAL;
	  result->value.val.realval = (double) f_result;
	}
	break;

  case DOUBLE:
	{
	  double d_result;

	  result_type = &ffi_type_double;
	  ffi_st = ffi_prep_cif(&cif, FFI_DEFAULT_ABI, argnum, result_type,
							arg_types);
	  if (ffi_st != FFI_OK)
		return(-1);
	  ffi_call(&cif, f->funcptr, &d_result, arg_values);
	  result->value.token = T_REAL;
	  result->value.val.realval = d_result;
	}
	break;

  case 'p':
	{
	  char *p_result;

	  result_type = &ffi_type_pointer;
	  ffi_st = ffi_prep_cif(&cif, FFI_DEFAULT_ABI, argnum, result_type,
							arg_types);
	  if (ffi_st != FFI_OK)
		return(-1);
	  ffi_call(&cif, f->funcptr, &p_result, arg_values);
	  result->value.token = T_STRING;
	  if (p_result != NULL)
		result->value.val.strval = strdup(p_result);
	  else
		result->value.val.strval = NULL;
	}
	break;

  default:
	break;
  }

#ifdef NOTDEF
  x = arglist;
  for (i = 0; i < argnum; i++) {
	char *val;
	Var *var;
	extern int is_reserved_namespace(char *);

	if (is_inout[i]) {
	  if (arg_types[i] == &ffi_type_pointer) {
		log_msg((LOG_TRACE_LEVEL, "Set arg %d to string %s",
				 i, *(char **) arg_values[i]));
		val = *(char **) arg_values[i];
		if ((var = var_parse_name(val, NULL)) == NULL) {
		  /* "Invalid variable name on LHS of assignment" */
		  return(-1);
		}
		else if (var->ns == NULL) {
		  /* "Namespace is required for assignment" */
		  return(-1);
		}
		else if (var->flags != NULL) {
		  /* "No modifier flags allowed on LHS of assignment" */
		  return(-1);
		}
		if (is_reserved_namespace(var->ns)) {
		  /* "Can't assign to reserved namespace '%s'", var->ns */
		  return(-1);
		}

		var_ns_new(&e->env->namespaces, var->ns, NULL);
		var_ns_add_key(e->env->namespaces, var->ns, var->varname, val);
	  }
	  else if (arg_types[i] == &ffi_type_double) {
		log_msg((LOG_TRACE_LEVEL, "Set arg %d to double %f",
				 i, *(double *) arg_values[i]));
	  }
	}
	x = x->next;
  }
#endif

  return(0);
}

int
module_load(char *module_name, char *path)
{
  char *errmsg, *register_func;
  void *h, *sym;
  Module *module;

  if ((h = dynload_load(path, &errmsg)) == NULL)
	return(-1);

  /* XXX check for duplicate name. */
  module = ALLOC(Module);
  module->name = strdup(module_name);
  module->path = strdup(path);
  module->handle = h;
  module->functions = dsvec_init(NULL, sizeof(Function *));

  register_func = ds_xprintf("%s_register", module_name);
  if ((sym = dynload_symbol(h, register_func, &errmsg)) != NULL) {
	/*
	 * XXX call the registration function to get descriptions
	 * of each function available in this module.
	 */
  }

  if (modules == NULL)
	modules = dsvec_init(NULL, sizeof(Module *));

  dsvec_add_ptr(modules, module);

  return(0);
}

int
module_add_function(char *module_name, char *path, char *symbol_name,
					char *function_name, char *argdesc, char *resultdesc)
{
  char *errmsg;
  void *h, *sym;
  Function *f;
  Module *m;

  if ((m = find_module(module_name)) == NULL) {
	if ((h = dynload_load(path, &errmsg)) == NULL)
	  return(-1);

	m = ALLOC(Module);
	m->name = strdup(module_name);
	m->path = strdup(path);
	m->handle = h;
	m->functions = dsvec_init(NULL, sizeof(Function *));
	if (modules == NULL)
	  modules = dsvec_init(NULL, sizeof(Module *));
	dsvec_add_ptr(modules, m);
  }
  else
	h = m->handle;

  if ((sym = dynload_symbol(h, symbol_name, &errmsg)) == NULL)
	return(-1);

  f = ALLOC(Function);
  f->symbol_name = strdup(symbol_name);
  f->function_name = strdup(function_name);
  f->argdesc = strdup(argdesc);
  f->resultdesc = strdup(resultdesc);
  f->funcptr = sym;

  dsvec_add_ptr(m->functions, f);

  return(0);
}

int
module_unload(char *module_name)
{
  char *errmsg;
  Module *m;

  if ((m = find_module(module_name)) == NULL)
	return(-1);

  if (dynload_unload(m->handle, &errmsg) == -1)
	return(-1);

  delete_module(m);

  return(0);
}

int
module_unload_function(char *module_name, char *function_name)
{

  return(-1);
}

int
module_test(Lex_state *e, int which)
{
  Arglist *a;
  Function *f;
  Module *m;
  Expr_result result;
  extern Arglist *expr_init_arg(void);

  if (which == 1) {
	if (module_add_function("libm", "/usr/lib/libm.so", "sqrt", "sqrt",
							"double", "double") == -1)
	  return(-1);

	if (module_lookup_function("libm::sqrt", &m, &f) == -1)
	  return(-1);

	a = expr_init_arg();
	a->result->value.token = T_REAL;
	a->result->value.val.realval = 1958.0;

	if (module_eval_function(m, f, e, a, &result) == -1)
	  return(-1);

	printf("%s\n", acs_format_result(&result));
	return(0);
  }

  if (which == 2) {
	if (module_add_function("libc", "/usr/lib/libc.so",
							"gethostname", "gethostname",
							"out[100] char *, int", "int") == -1)
	  return(-1);

	if (module_lookup_function("libc::gethostname", &m, &f) == -1)
	  return(-1);

	a = expr_init_arg();
	a->result->value.token = T_STRING;
	a->result->value.is_var_reference = 0;
	a->result->value.varname = "foo::baz";
	a->result->value.is_quoted = 0;
	a->result->value.val.strval = malloc(100);
	a->next = expr_init_arg();
	a->next->result->value.token = T_INTEGER;
	a->next->result->value.val.intval = 100;

	if (module_eval_function(m, f, e, a, &result) == -1)
	  return(-1);

	printf("%s\n", acs_format_result(&result));
	return(0);
  }

  return(0);
}
#endif

#ifdef PROG

int
main(int argc, char **argv)
{
  char *err;
  void *h, *sym;

  dynload_sqrt();

  if ((h = dynload_load("/tmp/libmine.so", &err)) == NULL) {
  fail:
	fprintf(stderr, "%s\n", err);
	exit(1);
  }
  if ((sym = dynload_symbol(h, argv[1], &err)) == NULL)
	goto fail;

  dynload_unload(h, &err);

  exit(0);
}

#endif
