gerbv  2.10.1-dev~93f1b5
dynload.c
Go to the documentation of this file.
1 /* dynload.c Dynamic Loader for TinyScheme */
2 /* Original Copyright (c) 1999 Alexander Shendi */
3 /* Modifications for NT and dl_* interface, scm_load_ext: D. Souflis */
4 /* Refurbished by Stephen Gildea */
5 
10 #define _SCHEME_SOURCE
11 #include "dynload.h"
12 #include "gerb_file.h"
13 #include <string.h>
14 #include <stdio.h>
15 #include <stdlib.h>
16 
17 #include "common.h"
18 
19 #ifndef MAXPATHLEN
20 #define MAXPATHLEN 1024
21 #endif
22 
23 static void make_filename(const char* name, char* filename);
24 static void make_init_fn(const char* name, char* init_fn);
25 
26 #ifdef _WIN32
27 #include <windows.h>
28 #else
29 typedef void* HMODULE;
30 typedef void (*FARPROC)();
31 #ifndef SUN_DL
32 #define SUN_DL
33 #endif
34 #include <dlfcn.h>
35 #endif
36 
37 #ifdef _WIN32
38 
39 #define PREFIX ""
40 #define SUFFIX ".dll"
41 
42 static void
43 display_w32_error_msg(const char* additional_message) {
44  LPVOID msg_buf;
45 
46  FormatMessage(
47  FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, GetLastError(), 0, (LPTSTR)&msg_buf, 0, NULL
48  );
49  fprintf(stderr, _("scheme load-extension: %s: %s"), additional_message, (char*)msg_buf);
50  LocalFree(msg_buf);
51 }
52 
53 static HMODULE
54 dl_attach(const char* module) {
55  HMODULE dll = LoadLibrary(module);
56  if (!dll)
57  display_w32_error_msg(module);
58  return dll;
59 }
60 
61 static FARPROC
62 dl_proc(HMODULE mo, const char* proc) {
63  FARPROC procedure = GetProcAddress(mo, proc);
64  if (!procedure)
65  display_w32_error_msg(proc);
66  return procedure;
67 }
68 #if 0
69 static void dl_detach(HMODULE mo) {
70  (void)FreeLibrary(mo);
71 }
72 #endif
73 #elif defined(SUN_DL)
74 
75 #include <dlfcn.h>
76 
77 #define PREFIX "lib"
78 #define SUFFIX ".so"
79 
80 static HMODULE
81 dl_attach(const char* module) {
82  HMODULE so = dlopen(module, RTLD_LAZY);
83  if (!so) {
84  fprintf(stderr, _("Error loading scheme extension \"%s\": %s\n"), module, dlerror());
85  }
86  return so;
87 }
88 
89 static FARPROC
90 dl_proc(HMODULE mo, const char* proc) {
91  const char* errmsg;
92  FARPROC fp = (FARPROC)dlsym(mo, proc);
93  if ((errmsg = dlerror()) == 0) {
94  return fp;
95  }
96  fprintf(stderr, _("Error initializing scheme module \"%s\": %s\n"), proc, errmsg);
97  return 0;
98 }
99 #if 0
100 static void dl_detach(HMODULE mo) {
101  (void)dlclose(mo);
102 }
103 #endif
104 #endif
105 
106 pointer
107 scm_load_ext(scheme* sc, pointer args) {
108  pointer first_arg;
109  pointer retval;
110  char filename[MAXPATHLEN], init_fn[MAXPATHLEN + 6];
111  char* name;
112  HMODULE dll_handle;
113  void (*module_init)(scheme * sc);
114 
115  if ((args != sc->NIL) && is_string((first_arg = pair_car(args)))) {
116  name = string_value(first_arg);
117  make_filename(name, filename);
118  make_init_fn(name, init_fn);
119  dll_handle = dl_attach(filename);
120  if (dll_handle == 0) {
121  retval = sc->F;
122  } else {
123  module_init = (void (*)(scheme*))dl_proc(dll_handle, init_fn);
124  if (module_init != 0) {
125  (*module_init)(sc);
126  retval = sc->T;
127  } else {
128  retval = sc->F;
129  }
130  }
131  } else {
132  retval = sc->F;
133  }
134 
135  return (retval);
136 }
137 
138 static void
139 make_filename(const char* name, char* filename) {
140  strcpy(filename, name);
141  strcat(filename, SUFFIX);
142 }
143 
144 static void
145 make_init_fn(const char* name, char* init_fn) {
146  const char* p = strrchr(name, '/'); /*CHECK ME MINGW PATH SEPARATOR*/
147  if (p == 0) {
148  p = name;
149  } else {
150  p++;
151  }
152  strcpy(init_fn, "init_");
153  strcat(init_fn, p);
154 }
Contains basic defines.
Header info for the dynamic loader functions for TinyScheme.
Header info for the file parsing support functions.