Back to index

texmacs  1.0.7.15
dynload.c
Go to the documentation of this file.
00001 /* dynload.c Dynamic Loader for TinyScheme */
00002 /* Original Copyright (c) 1999 Alexander Shendi     */
00003 /* Modifications for NT and dl_* interface, scm_load_ext: D. Souflis */
00004 /* Refurbished by Stephen Gildea */
00005 
00006 #define _SCHEME_SOURCE
00007 #include "dynload.h"
00008 #include <string.h>
00009 #include <stdio.h>
00010 #include <stdlib.h>
00011 
00012 #ifndef MAXPATHLEN
00013 # define MAXPATHLEN 1024
00014 #endif
00015 
00016 static void make_filename(const char *name, char *filename);
00017 static void make_init_fn(const char *name, char *init_fn);
00018 
00019 #ifdef _WIN32
00020 # include <windows.h>
00021 #else
00022 typedef void *HMODULE;
00023 typedef void (*FARPROC)();
00024 #define SUN_DL
00025 #include <dlfcn.h>
00026 #endif
00027 
00028 #ifdef _WIN32
00029 
00030 #define PREFIX ""
00031 #define SUFFIX ".dll"
00032 
00033  static void display_w32_error_msg(const char *additional_message)
00034  {
00035    LPVOID msg_buf;
00036 
00037    FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER,
00038                NULL, GetLastError(), 0,
00039                (LPTSTR)&msg_buf, 0, NULL);
00040    fprintf(stderr, "scheme load-extension: %s: %s", additional_message, msg_buf);
00041    LocalFree(msg_buf);
00042  }
00043 
00044 static HMODULE dl_attach(const char *module) {
00045   HMODULE dll = LoadLibrary(module);
00046   if (!dll) display_w32_error_msg(module);
00047   return dll;
00048 }
00049 
00050 static FARPROC dl_proc(HMODULE mo, const char *proc) {
00051   FARPROC procedure = GetProcAddress(mo,proc);
00052   if (!procedure) display_w32_error_msg(proc);
00053   return procedure;
00054 }
00055 
00056 static void dl_detach(HMODULE mo) {
00057  (void)FreeLibrary(mo);
00058 }
00059 
00060 #elif defined(SUN_DL)
00061 
00062 #include <dlfcn.h>
00063 
00064 #define PREFIX "lib"
00065 #define SUFFIX ".so"
00066 
00067 static HMODULE dl_attach(const char *module) {
00068   HMODULE so=dlopen(module,RTLD_LAZY);
00069   if(!so) {
00070     fprintf(stderr, "Error loading scheme extension \"%s\": %s\n", module, dlerror());
00071   }
00072   return so;
00073 }
00074 
00075 static FARPROC dl_proc(HMODULE mo, const char *proc) {
00076   const char *errmsg;
00077   FARPROC fp=(FARPROC)dlsym(mo,proc);
00078   if ((errmsg = dlerror()) == 0) {
00079     return fp;
00080   }
00081   fprintf(stderr, "Error initializing scheme module \"%s\": %s\n", proc, errmsg);
00082  return 0;
00083 }
00084 
00085 static void dl_detach(HMODULE mo) {
00086  (void)dlclose(mo);
00087 }
00088 #endif
00089 
00090 pointer scm_load_ext(scheme *sc, pointer args)
00091 {
00092    pointer first_arg;
00093    pointer retval;
00094    char filename[MAXPATHLEN], init_fn[MAXPATHLEN+6];
00095    char *name;
00096    HMODULE dll_handle;
00097    void (*module_init)(scheme *sc);
00098 
00099    if ((args != sc->NIL) && is_string((first_arg = pair_car(args)))) {
00100       name = string_value(first_arg);
00101       make_filename(name,filename);
00102       make_init_fn(name,init_fn);
00103       dll_handle = dl_attach(filename);
00104       if (dll_handle == 0) {
00105          retval = sc -> F;
00106       }
00107       else {
00108          module_init = (void(*)(scheme *))dl_proc(dll_handle, init_fn);
00109          if (module_init != 0) {
00110             (*module_init)(sc);
00111             retval = sc -> T;
00112          }
00113          else {
00114             retval = sc->F;
00115          }
00116       }
00117    }
00118    else {
00119       retval = sc -> F;
00120    }
00121 
00122   return(retval);
00123 }
00124 
00125 static void make_filename(const char *name, char *filename) {
00126  strcpy(filename,name);
00127  strcat(filename,SUFFIX);
00128 }
00129 
00130 static void make_init_fn(const char *name, char *init_fn) {
00131  const char *p=strrchr(name,'/');
00132  if(p==0) {
00133      p=name;
00134  } else {
00135      p++;
00136  }
00137  strcpy(init_fn,"init_");
00138  strcat(init_fn,p);
00139 }
00140 
00141 
00142 /*
00143 Local variables:
00144 c-file-style: "k&r"
00145 End:
00146 */