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