/* dynload.c Dynamic Loader for TinyScheme */
/* Original Copyright (c) 1999 Alexander Shendi     */
/* Modifications for NT and dl_* interface, scm_load_ext: D. Souflis */
/* Refurbished by Stephen Gildea */

#define _SCHEME_SOURCE
#include "dynload.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#ifndef MAXPATHLEN
#define MAXPATHLEN 1024
#endif

static void make_filename(const char *name, char *filename);
static void make_init_fn(const char *name, char *init_fn);

#ifdef _WIN32
#include <windows.h>
#else
typedef void *HMODULE;
typedef void (*FARPROC)();
#define SUN_DL
#include <dlfcn.h>
#endif

#ifdef _WIN32

#define PREFIX ""
#define SUFFIX ".dll"

static void display_w32_error_msg(const char *additional_message) {
  LPVOID msg_buf;

  FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER,
                NULL, GetLastError(), 0, (LPTSTR)&msg_buf, 0, NULL);
  fprintf(stderr, "scheme load-extension: %s: %s", additional_message, msg_buf);
  LocalFree(msg_buf);
}

static HMODULE dl_attach(const char *module) {
  HMODULE dll = LoadLibrary(module);
  if (!dll)
    display_w32_error_msg(module);
  return dll;
}

static FARPROC dl_proc(HMODULE mo, const char *proc) {
  FARPROC procedure = GetProcAddress(mo, proc);
  if (!procedure)
    display_w32_error_msg(proc);
  return procedure;
}

static void dl_detach(HMODULE mo) { (void)FreeLibrary(mo); }

#elif defined(SUN_DL)

#include <dlfcn.h>

#define PREFIX "lib"
#define SUFFIX ".so"

static HMODULE dl_attach(const char *module) {
  HMODULE so = dlopen(module, RTLD_LAZY);
  if (!so) {
    fprintf(stderr, "Error loading scheme extension \"%s\": %s\n", module,
            dlerror());
  }
  return so;
}

static FARPROC dl_proc(HMODULE mo, const char *proc) {
  const char *errmsg;
  FARPROC fp = (FARPROC)dlsym(mo, proc);
  if ((errmsg = dlerror()) == 0) {
    return fp;
  }
  fprintf(stderr, "Error initializing scheme module \"%s\": %s\n", proc,
          errmsg);
  return 0;
}

static void dl_detach(HMODULE mo) { (void)dlclose(mo); }
#endif

pointer scm_load_ext(scheme *sc, pointer args) {
  pointer first_arg;
  pointer retval;
  char filename[MAXPATHLEN], init_fn[MAXPATHLEN + 6];
  char *name;
  HMODULE dll_handle;
  void (*module_init)(scheme * sc);

  if ((args != sc->NIL) && is_string((first_arg = pair_car(args)))) {
    name = string_value(first_arg);
    make_filename(name, filename);
    make_init_fn(name, init_fn);
    dll_handle = dl_attach(filename);
    if (dll_handle == 0) {
      retval = sc->F;
    } else {
      module_init = (void (*)(scheme *))dl_proc(dll_handle, init_fn);
      if (module_init != 0) {
        (*module_init)(sc);
        retval = sc->T;
      } else {
        retval = sc->F;
      }
    }
  } else {
    retval = sc->F;
  }

  return (retval);
}

static void make_filename(const char *name, char *filename) {
  strcpy(filename, name);
  strcat(filename, SUFFIX);
}

static void make_init_fn(const char *name, char *init_fn) {
  const char *p = strrchr(name, '/');
  if (p == 0) {
    p = name;
  } else {
    p++;
  }
  strcpy(init_fn, "init_");
  strcat(init_fn, p);
}
