/* libsizzle/dynlib.c - shared library handling functions
 
  Copyright (C) 1999, 2000 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
 
  This is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation; either version 2, or (at your option)
  any later version.
  
  This software is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.
  
  You should have received a copy of the GNU General Public License
  along with this package; see the file COPYING.  If not, write to
  the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  Boston, MA 02111-1307, USA.  */

#if HAVE_CONFIG_H
# include <config.h>
#endif 

#if ENABLE_DL

#include <stdio.h>

#include <string.h>
#if HAVE_DLFCN_H
# include <dlfcn.h>
#else
# define RTLD_LAZY   1
# define RTLD_NOW    2
# define RTLD_GLOBAL 4
#endif

#if ENABLE_NLS
# include <libintl.h>
# define _(String) gettext(String)
#else
# define _(String) (String)
#endif

#include "alloc.h"
#include "node.h"
#include "validate.h"
#include "port.h"
#include "capi.h"
#include "dynlib.h"

#ifdef __MINGW32__
# include <windows.h>
# define dlopen(library, flag) LoadLibrary(library)
# define dlclose(handle) FreeLibrary(handle)
# define dlsym(handle, symbol) (void *)GetProcAddress(handle, symbol)

char *
dlerror (void)
{
  static char error[64];

  sprintf (error, "error code %d", GetLastError ());
  return error;
}
#endif /* not __MINGW32__ */

unsigned long zzz_tagged_type_dynlib;

static zzz_scm_t zzz_dl_error_exception;

/*:doc
  %dlopen
  (%dlopen filename flags) => handle
  Open the shared library named @var{filename} using the open flags
  @var{flags}.  @var{flags} may be the bitwise or of the constants
  @code{RTLD_LAZY}, @code{RTLD_GLOBAL} and @code{RTLD_NOW}.  Return a 
  handle which can be used in calls to @code{%dlsym} and @code{%dlclose}.
  The default for @var{flags} is @code{RTLD_NOW}.
  A @code{dl-error} exception is thrown if the library could not be loaded.
  doc:*/
#define FUNC_NAME "%dlopen"
static result_t
sys_dlopen_func (zzz_scm_t env, zzz_scm_t filename, zzz_scm_t flags,
	     zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  void * handle;
  int fl;

  CHECK_TYPE (1, string_p (filename), zzz_string_type_name);
  CHECK_SAFE_FILENAME (1, filename, zzz_safe_filename_type_name);
  if (flags != zzz_undefined)
    {
      CHECK_TYPE (2, integer_p (flags), zzz_integer_type_name);
      fl = integer_val (flags);
    }
  else
    fl = RTLD_NOW;
  handle = dlopen (string_val (filename), fl);
  if (handle)
    {
      *result = zzz_make_dynlib (handle, filename);
    }
  else
    {
      *result = zzz_make_exception
	(zzz_dl_error_exception, zzz_make_string (dlerror (), -1));
      return RESULT_EXCEPTION;
    }
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  %dlclose
  (%dlclose handle) => *unspecified*
  Close the dynamically loaded shared library specified by @var{handler}.
  Only call this once per opened library.
  doc:*/
#define FUNC_NAME "%dlclose"
static result_t
sys_dlclose_func (zzz_scm_t env, zzz_scm_t handle, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, dynlib_p (handle), _("shared library handle"));
  if (dynlib_handle (handle))
    {
      dlclose (dynlib_handle (handle));
      to_tagged_ptr (handle)->fill[1] = 0;
    }
  *result = zzz_unspecified;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  %dlsym
  (%dlsym handle str) => integer
  Find the symbol @var{str} in the shared library specified by @var{handle}.
  Return an integer value denoting an address, which can be used in calls
  to @code{%dlcall}.  A @code{dl-error} exception is thrown if the symbol
  could not be found.
  doc:*/
#define FUNC_NAME "%dlsym"
static result_t
sys_dlsym_func (zzz_scm_t env, zzz_scm_t handle, zzz_scm_t symbol,
	    zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  void * addr, * error;

  CHECK_TYPE (1, dynlib_p (handle), _("shared library handle"));
  CHECK_TYPE (2, string_p (symbol), zzz_string_type_name);
  CHECK_TYPE (1, dynlib_handle (handle) != 0, 
	      _("open shared library handle"));

  addr = dlsym (dynlib_handle (handle), string_val (symbol));
  error = dlerror ();
#ifdef __MINGW32__
  if (addr)
#else
  if (!error)
#endif
    *result = zzz_make_integer ((zzz_object_t) addr);
  else
    {
      *result = zzz_make_exception
	(zzz_dl_error_exception, zzz_make_string (error, -1));
      return RESULT_EXCEPTION;
    }
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

typedef result_t (* init_func_t) (void);

/*:doc
  %dlcall
  (%dlcall address) => *unspecified*
  Call the function specified by @var{address}, which must be a module's
  initialization function of type result_t (* init_func_t) (void).
  A @code{dl-error} exception is thrown if the called function did not
  return @code{RESULT_SUCCESS}.
  doc:*/
#define FUNC_NAME "%dlcall"
static result_t
sys_dlcall_func (zzz_scm_t env, zzz_scm_t address, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  init_func_t func;
  result_t err;

  CHECK_TYPE (1, integer_p (address), zzz_integer_type_name);
  func = (init_func_t) integer_val (address);

  err = func ();
  if (err != RESULT_SUCCESS)
    {
      *result = zzz_make_exception
	(zzz_dl_error_exception,
	 zzz_make_string (_("dynamically called function failed"), -1));
      return RESULT_EXCEPTION;
    }
  *result = zzz_unspecified;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  load-library
  (load-library name [filename]) => *unspecified*
  Load the shared library module called @var{name}.  If @var{filename} is 
  not specified, the file name is constructed by prepending "lib" and
  appending ".so".  After loading, the function @code{zzz_init_@var{name}}
  is called to initialize the module.  An @code{dl-error} exception is 
  thrown if the library could not be loaded or if the init funciotn did not
  return @var{RESULT_SUCCESS}.
  doc:*/
#define FUNC_NAME "load-library"
static result_t
load_library_func (zzz_scm_t env, zzz_scm_t name, zzz_scm_t filename,
		   zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  void * handle;
  init_func_t func;
  result_t err;
  char * path;
  int path_len;

  CHECK_TYPE (1, string_p (name), zzz_string_type_name);
  if (filename != zzz_undefined)
    {
      CHECK_TYPE (2, string_p (filename), zzz_string_type_name);
      CHECK_TYPE (2, filename, zzz_safe_filename_type_name);
      path_len = 0;
      path = string_val (filename);
    }
  else
    {
      path_len = string_len (name) + 8;
      path = zzz_malloc (path_len);
      strcpy (path, "lib");
      strcat (path, string_val (name));
#ifdef _WIN32
      strcat (path, ".dll");
#else /* not _WIN32 */
      strcat (path, ".so");
#endif /* not _WIN32 */
    }
  handle = dlopen (path, RTLD_NOW);
  if (!handle)
    {
      if (path_len)
	zzz_free (path, path_len);
      *result = zzz_make_exception
	(zzz_dl_error_exception, zzz_make_string (dlerror (), -1));
      return RESULT_EXCEPTION;
    }
  if (path_len)
    zzz_free (path, path_len);
  path_len = string_len (name) + 32;
  path = zzz_malloc (path_len);
  strcpy (path, "zzz_init_");
  strcat (path, string_val (name));
  func = (init_func_t) dlsym (handle, path);
  zzz_free (path, path_len);
  if (func)
    {
      err = func ();
      if (err != RESULT_SUCCESS)
	{
	  dlclose (handle);
	  *result = zzz_make_exception
	    (zzz_dl_error_exception,
	     zzz_make_string (_("dynamically called function failed"), -1));
	  return RESULT_EXCEPTION;
	}
    }
  *result = zzz_unspecified;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME



/* Create a module object.  */
zzz_scm_t
zzz_make_dynlib (void * handle, zzz_scm_t name)
{
  return zzz_create_tagged_cell (zzz_tagged_type_dynlib, handle, name, NULL);
}

/* Print the representation for the MODULE object DATA to PORT.  */
static void
dynlib_print (zzz_scm_t port, zzz_tagged_t tagged, zzz_print_state_t state)
{
  zzz_scm_t result;
  char buf[32];
  int len;

  len = sprintf (buf, " %p", tagged_data0 (tagged));
  zzz_port_puts (port, "#<dynlib ", 9, &result);
  zzz_port_print (port, tagged_data1 (tagged), state, &result);
  zzz_port_puts (port, buf, len, &result);
  zzz_port_puts (port, ">", 1, &result);
}

static void
dynlib_mark (zzz_tagged_t tagged)
{
  zzz_scm_t name = tagged_data1 (tagged);
  zzz_mark_cell (name);
}

void
dynlib_free (zzz_tagged_t tagged)
{
  if (tagged_data0 (tagged) != 0)
    {
      /* FIXME: Can be safely close the shared object?  I think not...
	 For now, only mark it as closed, so we get an error when
	 trying to use it.  */
#if 0
      dlclose (tagged_data0 (tagged));
#endif /* 0 */
      tagged->fill[1] = 0;
    }
}

result_t
zzz_init_dynlib (void)
{
  zzz_tagged_type_dynlib =
    zzz_define_tagged_type (zzz_simple_constructor, dynlib_print, dynlib_free,
			    dynlib_mark, NULL);

  /*:doc
    dl-error
    Exception
    This exception is thrown if an error occurs while dealing with shared
    libraries.  The exception includes a human-readable error message.
    doc:*/
  zzz_protect_global (&zzz_dl_error_exception);
  zzz_dl_error_exception = zzz_make_symbol ("dl-error", -1);

  /*:doc
    RTLD_LAZY
    Constant
    If specified as an argument to @code{%dlopen}, symbols in the loaded
    library are relocated as needed.
    doc:*/
  zzz_define_constant ("RTLD_LAZY", zzz_make_integer (RTLD_LAZY));
  /*:doc
    RTLD_NOW
    Constant
    If specified as an argument to @code{%dlopen}, all symbols are relocated
    on load time.
    doc:*/
  zzz_define_constant ("RTLD_NOW", zzz_make_integer (RTLD_NOW));
  /*:doc
    RTLD_GLOBAL
    Constant
    If specified as an argument to @code{%dlopen}, the library will be 
    available to other processes as well.
    doc:*/
  zzz_define_constant ("RTLD_GLOBAL", zzz_make_integer (RTLD_GLOBAL));

  zzz_define_function ("%dlopen", (zzz_prim_t) sys_dlopen_func, argv_1_1_0);
  zzz_define_function ("%dlclose", (zzz_prim_t) sys_dlclose_func, argv_1_0_0);
  zzz_define_function ("%dlsym", (zzz_prim_t) sys_dlsym_func, argv_2_0_0);
  zzz_define_function ("%dlcall", (zzz_prim_t) sys_dlcall_func, argv_1_0_0);
  zzz_define_function ("load-library", (zzz_prim_t) load_library_func,
		       argv_1_1_0);
  return RESULT_SUCCESS;
}

int zzz_config_have_dl = 1;

#else  /* !ENABLE_DL */

int zzz_config_have_dl = 0;

#endif /* !ENABLE_DL */
