diff --git a/src/foreign/foreign.c b/src/foreign/foreign.c index ad1580910c..9422632d60 100644 --- a/src/foreign/foreign.c +++ b/src/foreign/foreign.c @@ -77,6 +77,70 @@ /* same as the macro in file.c */ #define TO_PATH(x) (SCHEME_PATHP(x) ? (x) : scheme_char_string_to_path(x)) +/*****************************************************************************/ + +/* We'd like to use EnumProcessModules to find all loaded DLLs, but it's + only available in NT 4.0 and later. The alternative, Module32{First,Next}, + is available *except* for NT 4.0! So we try EnumProcessModules first. */ + +#ifdef WINDOWS_DYNAMIC_LOAD +#ifdef MZ_PRECISE_GC +START_XFORM_SKIP; +#endif + +int epm_tried = 1; +typedef BOOL (*EnumProcessModules_t)(HANDLE hProcess, HMODULE* lphModule, DWORD cb, LPDWORD lpcbNeeded); +EnumProcessModules_t _EnumProcessModules; +#include + +BOOL mzEnumProcessModules(HANDLE hProcess, HMODULE* lphModule, DWORD cb, LPDWORD lpcbNeeded) +{ + if (!epm_tried) { + HMODULE hm; + hm = LoadLibrary("psapi.dll"); + if (hm) { + _EnumProcessModules = (EnumProcessModules_t)GetProcAddress(hm, "EnumProcessModules"); + } + epm_tried = 1; + } + + if (_EnumProcessModules) + return _EnumProcessModules(hProcess, lphModule, cb, lpcbNeeded); + else { + HANDLE snapshot; + MODULEENTRY32 mod; + int i, ok; + + snapshot = CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, GetCurrentProcessId()); + if (snapshot == INVALID_HANDLE_VALUE) + return FALSE; + + for (i = 0; 1; i++) { + mod.dwSize = sizeof(mod); + if (!i) + ok = Module32First(snapshot, &mod); + else + ok = Module32Next(snapshot, &mod); + if (!ok) + break; + if (cb >= sizeof(HMODULE)) { + lphModule[i] = mod.hModule; + cb -= sizeof(HMODULE); + } + } + + CloseHandle(snapshot); + *lpcbNeeded = i * sizeof(HMODULE); + return GetLastError() == ERROR_NO_MORE_FILES; + } +} + + +#ifdef MZ_PRECISE_GC +END_XFORM_SKIP; +#endif +#endif + /*****************************************************************************/ /* Library objects */ @@ -125,6 +189,7 @@ static Scheme_Object *foreign_ffi_lib(int argc, Scheme_Object *argv[]) char *name; Scheme_Object *path, *hashname; void *handle; + int null_ok = 0; ffi_lib_struct *lib; if (!(SCHEME_PATH_STRINGP(argv[0]) || SCHEME_FALSEP(argv[0]))) scheme_wrong_type(MYNAME, "string-or-false", 0, argc, argv); @@ -137,11 +202,15 @@ static Scheme_Object *foreign_ffi_lib(int argc, Scheme_Object *argv[]) if (!lib) { Scheme_Hash_Table *ht; #ifdef WINDOWS_DYNAMIC_LOAD - handle = (name==NULL) ? GetModuleHandle(NULL) : LoadLibrary(name); + if (name==NULL) { + handle = NULL; + null_ok = 1; + } else + handle = LoadLibrary(name); #else handle = dlopen(name, RTLD_NOW | RTLD_GLOBAL); #endif - if (handle == NULL) { + if (handle == NULL && !null_ok) { if (argc > 1 && SCHEME_TRUEP(argv[1])) return scheme_false; else { #ifdef WINDOWS_DYNAMIC_LOAD @@ -237,7 +306,32 @@ static Scheme_Object *foreign_ffi_obj(int argc, Scheme_Object *argv[]) obj = (ffi_obj_struct*)scheme_hash_get(lib->objects, (Scheme_Object*)dlname); if (!obj) { #ifdef WINDOWS_DYNAMIC_LOAD - dlobj = GetProcAddress(lib->handle, dlname); + if (lib->handle) { + dlobj = GetProcAddress(lib->handle, dlname); + } else { +# define NUM_QUICK_MODS 16 + HMODULE *mods, me, quick_mods[NUM_QUICK_MODS]; + DWORD cnt = NUM_QUICK_MODS * sizeof(HMODULE), actual_cnt, i; + me = GetCurrentProcess(); + mods = quick_mods; + if (mzEnumProcessModules(me, mods, cnt, &actual_cnt)) { + if (actual_cnt > cnt) { + cnt = actual_cnt; + mods = (HMODULE *)scheme_malloc_atomic(cnt); + if (!mzEnumProcessModules(me, mods, cnt, &actual_cnt)) + mods = NULL; + } + } else + mods = NULL; + if (mods) { + cnt /= sizeof(HMODULE); + for (i = 0; i < cnt; i++) { + dlobj = GetProcAddress(mods[i], dlname); + if (dlobj) break; + } + } else + dlobj = NULL; + } if (!dlobj) { long err; err = GetLastError(); diff --git a/src/foreign/foreign.ssc b/src/foreign/foreign.ssc index d5d998b582..7a48f1eccb 100755 --- a/src/foreign/foreign.ssc +++ b/src/foreign/foreign.ssc @@ -84,6 +84,70 @@ exec mzpp -s "---begin" -o `echo "$0" | sed 's/ssc$/c/'` "$0" /* same as the macro in file.c */ #define TO_PATH(x) (SCHEME_PATHP(x) ? (x) : scheme_char_string_to_path(x)) +/*****************************************************************************/ + +/* We'd like to use EnumProcessModules to find all loaded DLLs, but it's + only available in NT 4.0 and later. The alternative, Module32{First,Next}, + is available *except* for NT 4.0! So we try EnumProcessModules first. */ + +#ifdef WINDOWS_DYNAMIC_LOAD +#ifdef MZ_PRECISE_GC +START_XFORM_SKIP; +#endif + +int epm_tried = 1; +typedef BOOL (*EnumProcessModules_t)(HANDLE hProcess, HMODULE* lphModule, DWORD cb, LPDWORD lpcbNeeded); +EnumProcessModules_t _EnumProcessModules; +#include + +BOOL mzEnumProcessModules(HANDLE hProcess, HMODULE* lphModule, DWORD cb, LPDWORD lpcbNeeded) +{ + if (!epm_tried) { + HMODULE hm; + hm = LoadLibrary("psapi.dll"); + if (hm) { + _EnumProcessModules = (EnumProcessModules_t)GetProcAddress(hm, "EnumProcessModules"); + } + epm_tried = 1; + } + + if (_EnumProcessModules) + return _EnumProcessModules(hProcess, lphModule, cb, lpcbNeeded); + else { + HANDLE snapshot; + MODULEENTRY32 mod; + int i, ok; + + snapshot = CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, GetCurrentProcessId()); + if (snapshot == INVALID_HANDLE_VALUE) + return FALSE; + + for (i = 0; 1; i++) { + mod.dwSize = sizeof(mod); + if (!i) + ok = Module32First(snapshot, &mod); + else + ok = Module32Next(snapshot, &mod); + if (!ok) + break; + if (cb >= sizeof(HMODULE)) { + lphModule[i] = mod.hModule; + cb -= sizeof(HMODULE); + } + } + + CloseHandle(snapshot); + *lpcbNeeded = i * sizeof(HMODULE); + return GetLastError() == ERROR_NO_MORE_FILES; + } +} + + +#ifdef MZ_PRECISE_GC +END_XFORM_SKIP; +#endif +#endif + /*****************************************************************************/ /* Library objects */ @@ -100,6 +164,7 @@ static Scheme_Hash_Table *opened_libs; char *name; Scheme_Object *path, *hashname; void *handle; + int null_ok = 0; ffi_lib_struct *lib; if (!(SCHEME_PATH_STRINGP(argv[0]) || SCHEME_FALSEP(argv[0]))) scheme_wrong_type(MYNAME, "string-or-false", 0, argc, argv); @@ -112,11 +177,15 @@ static Scheme_Hash_Table *opened_libs; if (!lib) { Scheme_Hash_Table *ht; #ifdef WINDOWS_DYNAMIC_LOAD - handle = (name==NULL) ? GetModuleHandle(NULL) : LoadLibrary(name); + if (name==NULL) { + handle = NULL; + null_ok = 1; + } else + handle = LoadLibrary(name); #else handle = dlopen(name, RTLD_NOW | RTLD_GLOBAL); #endif - if (handle == NULL) { + if (handle == NULL && !null_ok) { if (argc > 1 && SCHEME_TRUEP(argv[1])) return scheme_false; else { #ifdef WINDOWS_DYNAMIC_LOAD @@ -176,7 +245,32 @@ static Scheme_Hash_Table *opened_libs; obj = (ffi_obj_struct*)scheme_hash_get(lib->objects, (Scheme_Object*)dlname); if (!obj) { #ifdef WINDOWS_DYNAMIC_LOAD - dlobj = GetProcAddress(lib->handle, dlname); + if (lib->handle) { + dlobj = GetProcAddress(lib->handle, dlname); + } else { +# define NUM_QUICK_MODS 16 + HMODULE *mods, me, quick_mods[NUM_QUICK_MODS]; + DWORD cnt = NUM_QUICK_MODS * sizeof(HMODULE), actual_cnt, i; + me = GetCurrentProcess(); + mods = quick_mods; + if (mzEnumProcessModules(me, mods, cnt, &actual_cnt)) { + if (actual_cnt > cnt) { + cnt = actual_cnt; + mods = (HMODULE *)scheme_malloc_atomic(cnt); + if (!mzEnumProcessModules(me, mods, cnt, &actual_cnt)) + mods = NULL; + } + } else + mods = NULL; + if (mods) { + cnt /= sizeof(HMODULE); + for (i = 0; i < cnt; i++) { + dlobj = GetProcAddress(mods[i], dlname); + if (dlobj) break; + } + } else + dlobj = NULL; + } if (!dlobj) { long err; err = GetLastError();