1 /* Part of Scheme 48 1.9. See file COPYING for notices and license.
2 *
3 * Authors: Mike Sperber, Marcus Crestani
4 */
5
6 #define NO_OLD_FFI 1
7
8 /*
9 * Load DLLs on Windows.
10 */
11
12 #include <windows.h>
13 #include "scheme48.h"
14 #include "io.h"
15
16 extern int s48_utf_8of16_to_utf_16(const unsigned char* utf_8of16,
17 LPWSTR utf_16,
18 int* errorp);
19
20 static s48_ref_t
shared_object_dlopen(s48_call_t call,s48_ref_t name,s48_ref_t complete_name_p)21 shared_object_dlopen(s48_call_t call, s48_ref_t name, s48_ref_t complete_name_p)
22 {
23 HINSTANCE handle;
24 s48_ref_t res;
25 char *full_name;
26 WCHAR* name_utf16;
27 size_t len = strlen(s48_extract_byte_vector_readonly_2(call, name));
28
29 if (!s48_false_p_2(call, complete_name_p))
30 {
31 full_name = s48_make_local_buf(call, len + 5);
32 memcpy(full_name,
33 s48_extract_byte_vector_readonly_2(call, name),
34 len);
35 memcpy(full_name + len,
36 ".dll",
37 5);
38 len += 4;
39 }
40 else
41 full_name = s48_extract_byte_vector_readonly_2(call, name);
42
43 name_utf16 = malloc(sizeof(WCHAR) * (len + 1));
44 if (name_utf16 == NULL)
45 s48_out_of_memory_error_2(call);
46 s48_utf_8of16_to_utf_16(full_name, name_utf16, NULL);
47
48 handle = LoadLibraryW(name_utf16);
49
50 free(name_utf16);
51 if (handle == NULL)
52 s48_os_error_2(call, "shared_object_dlopen", GetLastError(), 1, name);
53
54 res = s48_make_value_2(call, HINSTANCE);
55 s48_set_value_2(call, res, HINSTANCE, handle);
56
57 return res;
58 }
59
60 static s48_ref_t
shared_object_dlsym(s48_call_t call,s48_ref_t handle,s48_ref_t name)61 shared_object_dlsym(s48_call_t call, s48_ref_t handle, s48_ref_t name)
62 {
63 void *entry;
64 HINSTANCE native_handle;
65 char *native_name;
66
67 native_handle = s48_extract_value_2(call, handle, HINSTANCE);
68 native_name = s48_extract_byte_vector_readonly_2(call, name);
69
70 entry = GetProcAddress(native_handle, native_name);
71
72 if (entry == NULL)
73 s48_os_error_2(call, "shared_object_dlsym", GetLastError(), 2,
74 handle, name);
75
76 return s48_enter_pointer_2(call, entry);
77 }
78
79 static s48_ref_t
shared_object_dlclose(s48_call_t call,s48_ref_t handle)80 shared_object_dlclose(s48_call_t call, s48_ref_t handle)
81 {
82 HINSTANCE native_handle = s48_extract_value_2(call, handle, HINSTANCE);
83
84 if (!FreeLibrary(native_handle) < 0)
85 s48_os_error_2(call, "shared_object_dlclose", GetLastError(), 1, handle);
86 return s48_unspecific_2(call);
87 }
88
89 typedef void (*thunk)();
90
91 static s48_ref_t
shared_object_call_thunk(s48_call_t call,s48_ref_t value)92 shared_object_call_thunk(s48_call_t call, s48_ref_t value)
93 {
94 thunk entry;
95
96 entry = s48_extract_value_2(call, value, thunk);
97 entry();
98 return s48_unspecific_2(call);
99 }
100
101 void
s48_init_dynlink(void)102 s48_init_dynlink(void)
103 {
104 S48_EXPORT_FUNCTION(shared_object_dlopen);
105 S48_EXPORT_FUNCTION(shared_object_dlsym);
106 S48_EXPORT_FUNCTION(shared_object_dlclose);
107 S48_EXPORT_FUNCTION(shared_object_call_thunk);
108 }
109