dynload.c

Go to the documentation of this file.

/* 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 "gerb_file.h"
#include <string.h>
#include <stdio.h>
#include <stdlib.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)();
#ifndef SUN_DL
#define SUN_DL
#endif
#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, (char *) 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; 
}
#if 0
static void dl_detach(HMODULE mo) {
 (void)FreeLibrary(mo);
}
#endif
#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;
}
#if 0
static void dl_detach(HMODULE mo) {
 (void)dlclose(mo);
}
#endif 
#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,'/');/*CHECK ME MINGW PATH SEPARATOR*/
 if(p==0) {
     p=name;
 } else {
     p++;
 }
 strcpy(init_fn,"init_");
 strcat(init_fn,p);
}