-
+ 09CFEFF5190D4FA74DC28CF4CAFCEF50F2625DF207C8A360B48204E0B7B587F4084F80372D371D6D0FEB6BF464FBA4478DB3C42361676FD64ECC9530B0A097AAtinyscheme/dynload.c(0 . 0)(1 . 146)
1061 /* dynload.c Dynamic Loader for TinyScheme */
1062 /* Original Copyright (c) 1999 Alexander Shendi */
1063 /* Modifications for NT and dl_* interface, scm_load_ext: D. Souflis */
1064 /* Refurbished by Stephen Gildea */
1065
1066 #define _SCHEME_SOURCE
1067 #include "dynload.h"
1068 #include <string.h>
1069 #include <stdio.h>
1070 #include <stdlib.h>
1071
1072 #ifndef MAXPATHLEN
1073 # define MAXPATHLEN 1024
1074 #endif
1075
1076 static void make_filename(const char *name, char *filename);
1077 static void make_init_fn(const char *name, char *init_fn);
1078
1079 #ifdef _WIN32
1080 # include <windows.h>
1081 #else
1082 typedef void *HMODULE;
1083 typedef void (*FARPROC)();
1084 #define SUN_DL
1085 #include <dlfcn.h>
1086 #endif
1087
1088 #ifdef _WIN32
1089
1090 #define PREFIX ""
1091 #define SUFFIX ".dll"
1092
1093 static void display_w32_error_msg(const char *additional_message)
1094 {
1095 LPVOID msg_buf;
1096
1097 FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER,
1098 NULL, GetLastError(), 0,
1099 (LPTSTR)&msg_buf, 0, NULL);
1100 fprintf(stderr, "scheme load-extension: %s: %s", additional_message, msg_buf);
1101 LocalFree(msg_buf);
1102 }
1103
1104 static HMODULE dl_attach(const char *module) {
1105 HMODULE dll = LoadLibrary(module);
1106 if (!dll) display_w32_error_msg(module);
1107 return dll;
1108 }
1109
1110 static FARPROC dl_proc(HMODULE mo, const char *proc) {
1111 FARPROC procedure = GetProcAddress(mo,proc);
1112 if (!procedure) display_w32_error_msg(proc);
1113 return procedure;
1114 }
1115
1116 static void dl_detach(HMODULE mo) {
1117 (void)FreeLibrary(mo);
1118 }
1119
1120 #elif defined(SUN_DL)
1121
1122 #include <dlfcn.h>
1123
1124 #define PREFIX "lib"
1125 #define SUFFIX ".so"
1126
1127 static HMODULE dl_attach(const char *module) {
1128 HMODULE so=dlopen(module,RTLD_LAZY);
1129 if(!so) {
1130 fprintf(stderr, "Error loading scheme extension \"%s\": %s\n", module, dlerror());
1131 }
1132 return so;
1133 }
1134
1135 static FARPROC dl_proc(HMODULE mo, const char *proc) {
1136 const char *errmsg;
1137 FARPROC fp=(FARPROC)dlsym(mo,proc);
1138 if ((errmsg = dlerror()) == 0) {
1139 return fp;
1140 }
1141 fprintf(stderr, "Error initializing scheme module \"%s\": %s\n", proc, errmsg);
1142 return 0;
1143 }
1144
1145 static void dl_detach(HMODULE mo) {
1146 (void)dlclose(mo);
1147 }
1148 #endif
1149
1150 pointer scm_load_ext(scheme *sc, pointer args)
1151 {
1152 pointer first_arg;
1153 pointer retval;
1154 char filename[MAXPATHLEN], init_fn[MAXPATHLEN+6];
1155 char *name;
1156 HMODULE dll_handle;
1157 void (*module_init)(scheme *sc);
1158
1159 if ((args != sc->NIL) && is_string((first_arg = pair_car(args)))) {
1160 name = string_value(first_arg);
1161 make_filename(name,filename);
1162 make_init_fn(name,init_fn);
1163 dll_handle = dl_attach(filename);
1164 if (dll_handle == 0) {
1165 retval = sc -> F;
1166 }
1167 else {
1168 module_init = (void(*)(scheme *))dl_proc(dll_handle, init_fn);
1169 if (module_init != 0) {
1170 (*module_init)(sc);
1171 retval = sc -> T;
1172 }
1173 else {
1174 retval = sc->F;
1175 }
1176 }
1177 }
1178 else {
1179 retval = sc -> F;
1180 }
1181
1182 return(retval);
1183 }
1184
1185 static void make_filename(const char *name, char *filename) {
1186 strcpy(filename,name);
1187 strcat(filename,SUFFIX);
1188 }
1189
1190 static void make_init_fn(const char *name, char *init_fn) {
1191 const char *p=strrchr(name,'/');
1192 if(p==0) {
1193 p=name;
1194 } else {
1195 p++;
1196 }
1197 strcpy(init_fn,"init_");
1198 strcat(init_fn,p);
1199 }
1200
1201
1202 /*
1203 Local variables:
1204 c-file-style: "k&r"
1205 End:
1206 */