Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | /* -*- c -*- |
2 | * ----------------------------------------------------------------------- | |
3 | * swig_lib/mzscheme/mzrun.swg | |
4 | * | |
5 | * Author: John Lenz <lenz@cs.wisc.edu> | |
6 | * ----------------------------------------------------------------------- */ | |
7 | ||
8 | #include <stdio.h> | |
9 | #include <string.h> | |
10 | #include <stdlib.h> | |
11 | #include <escheme.h> | |
12 | ||
13 | #ifdef __cplusplus | |
14 | extern "C" { | |
15 | #endif | |
16 | ||
17 | /* Common SWIG API */ | |
18 | ||
19 | #define SWIG_ConvertPtr(s, result, type, flags) \ | |
20 | SWIG_MzScheme_ConvertPtr(s, result, type, flags) | |
21 | #define SWIG_NewPointerObj(ptr, type, owner) \ | |
22 | SWIG_MzScheme_NewPointerObj((void *)ptr, type, owner) | |
23 | #define SWIG_MustGetPtr(s, type, argnum, flags) \ | |
24 | SWIG_MzScheme_MustGetPtr(s, type, argnum, flags, FUNC_NAME, argc, argv) | |
25 | ||
26 | #define SWIG_contract_assert(expr,msg) \ | |
27 | if (!(expr)) { \ | |
28 | char *m=(char *) scheme_malloc(strlen(msg)+1000); \ | |
29 | sprintf(m,"SWIG contract, assertion failed: function=%s, message=%s", \ | |
30 | (char *) FUNC_NAME,(char *) msg); \ | |
31 | scheme_signal_error(m); \ | |
32 | } | |
33 | ||
34 | /* Runtime API */ | |
35 | #define SWIG_GetModule(clientdata) SWIG_MzScheme_GetModule((Scheme_Env *)(clientdata)) | |
36 | #define SWIG_SetModule(clientdata, pointer) SWIG_MzScheme_SetModule((Scheme_Env *) (clientdata), pointer) | |
37 | #define SWIG_MODULE_CLIENTDATA_TYPE Scheme_Env * | |
38 | ||
39 | /* MzScheme-specific SWIG API */ | |
40 | ||
41 | #define SWIG_malloc(size) SWIG_MzScheme_Malloc(size, FUNC_NAME) | |
42 | #define SWIG_free(mem) free(mem) | |
43 | #define SWIG_NewStructFromPtr(ptr,type) \ | |
44 | _swig_convert_struct_##type##(ptr) | |
45 | ||
46 | #define MAXVALUES 6 | |
47 | #define swig_make_boolean(b) (b ? scheme_true : scheme_false) | |
48 | ||
49 | /* ----------------------------------------------------------------------- | |
50 | * mzscheme 30X support code | |
51 | * Contributed by Hans Oesterholt | |
52 | * ----------------------------------------------------------------------- */ | |
53 | ||
54 | #ifndef SCHEME_STR_VAL | |
55 | #define MZSCHEME30X 1 | |
56 | #endif | |
57 | ||
58 | #ifdef MZSCHEME30X | |
59 | /* | |
60 | * This is MZSCHEME 299.100 or higher (30x). From version 299.100 of | |
61 | * mzscheme upwards, strings are in unicode. These functions convert | |
62 | * to and from utf8 encodings of these strings. NB! strlen(s) will be | |
63 | * the size in bytes of the string, not the actual length. | |
64 | */ | |
65 | #define SCHEME_STR_VAL(obj) SCHEME_BYTE_STR_VAL(scheme_char_string_to_byte_string(obj)) | |
66 | #define SCHEME_STRLEN_VAL(obj) SCHEME_BYTE_STRLEN_VAL(scheme_char_string_to_byte_string(obj)) | |
67 | #define SCHEME_STRINGP(obj) SCHEME_CHAR_STRINGP(obj) | |
68 | #define scheme_make_string(s) scheme_make_utf8_string(s) | |
69 | #define scheme_make_sized_string(s,l) scheme_make_sized_utf8_string(s,l) | |
70 | #define scheme_make_sized_offset_string(s,d,l) \ | |
71 | scheme_make_sized_offset_utf8_string(s,d,l) | |
72 | #define SCHEME_MAKE_STRING(s) scheme_make_utf8_string(s) | |
73 | #else | |
74 | #define SCHEME_MAKE_STRING(s) scheme_make_string_without_copying(s) | |
75 | #endif | |
76 | /* ----------------------------------------------------------------------- | |
77 | * End of mzscheme 30X support code | |
78 | * ----------------------------------------------------------------------- */ | |
79 | ||
80 | struct swig_mz_proxy { | |
81 | Scheme_Type mztype; | |
82 | swig_type_info *type; | |
83 | void *object; | |
84 | }; | |
85 | ||
86 | static Scheme_Type swig_type; | |
87 | ||
88 | static void | |
89 | mz_free_swig(void *p, void *data) { | |
90 | struct swig_mz_proxy *proxy = (struct swig_mz_proxy *) p; | |
91 | if (SCHEME_NULLP((Scheme_Object*)p) || SCHEME_TYPE((Scheme_Object*)p) != swig_type) | |
92 | return; | |
93 | if (proxy->type) { | |
94 | if (proxy->type->clientdata) { | |
95 | ((Scheme_Prim *)proxy->type->clientdata)(1, (Scheme_Object **)&proxy); | |
96 | } | |
97 | } | |
98 | } | |
99 | ||
100 | static Scheme_Object * | |
101 | SWIG_MzScheme_NewPointerObj(void *ptr, swig_type_info *type, int owner) { | |
102 | struct swig_mz_proxy *new_proxy; | |
103 | new_proxy = (struct swig_mz_proxy *) scheme_malloc(sizeof(struct swig_mz_proxy)); | |
104 | new_proxy->mztype = swig_type; | |
105 | new_proxy->type = type; | |
106 | new_proxy->object = ptr; | |
107 | if (owner) { | |
108 | scheme_add_finalizer(new_proxy, mz_free_swig, NULL); | |
109 | } | |
110 | return (Scheme_Object *) new_proxy; | |
111 | } | |
112 | ||
113 | static int | |
114 | SWIG_MzScheme_ConvertPtr(Scheme_Object *s, void **result, swig_type_info *type, int flags) { | |
115 | swig_cast_info *cast; | |
116 | ||
117 | if (SCHEME_NULLP(s)) { | |
118 | *result = NULL; | |
119 | return 0; | |
120 | } else if (SCHEME_TYPE(s) == swig_type) { | |
121 | struct swig_mz_proxy *proxy = (struct swig_mz_proxy *) s; | |
122 | if (type) { | |
123 | cast = SWIG_TypeCheckStruct(proxy->type, type); | |
124 | if (cast) { | |
125 | *result = SWIG_TypeCast(cast, proxy->object); | |
126 | return 0; | |
127 | } else { | |
128 | return 1; | |
129 | } | |
130 | } else { | |
131 | *result = proxy->object; | |
132 | return 0; | |
133 | } | |
134 | } | |
135 | return 1; | |
136 | } | |
137 | ||
138 | static SWIGINLINE void * | |
139 | SWIG_MzScheme_MustGetPtr(Scheme_Object *s, swig_type_info *type, | |
140 | int argnum, int flags, const char *func_name, | |
141 | int argc, Scheme_Object **argv) { | |
142 | void *result; | |
143 | if (SWIG_MzScheme_ConvertPtr(s, &result, type, flags)) { | |
144 | scheme_wrong_type(func_name, type->str ? type->str : "void *", argnum - 1, argc, argv); | |
145 | } | |
146 | return result; | |
147 | } | |
148 | ||
149 | static SWIGINLINE void * | |
150 | SWIG_MzScheme_Malloc(size_t size, const char *func_name) { | |
151 | void *p = malloc(size); | |
152 | if (p == NULL) { | |
153 | scheme_signal_error("swig-memory-error"); | |
154 | } else return p; | |
155 | } | |
156 | ||
157 | static Scheme_Object * | |
158 | SWIG_MzScheme_PackageValues(int num, Scheme_Object **values) { | |
159 | /* ignore first value if void */ | |
160 | if (num > 0 && SCHEME_VOIDP(values[0])) | |
161 | num--, values++; | |
162 | if (num == 0) return scheme_void; | |
163 | else if (num == 1) return values[0]; | |
164 | else return scheme_values(num, values); | |
165 | } | |
166 | ||
167 | #ifndef scheme_make_inspector | |
168 | #define scheme_make_inspector(x,y) \ | |
169 | _scheme_apply(scheme_builtin_value("make-inspector"), x, y) | |
170 | #endif | |
171 | ||
172 | /* Function to create a new struct. */ | |
173 | static Scheme_Object * | |
174 | SWIG_MzScheme_new_scheme_struct (Scheme_Env* env, const char* basename, | |
175 | int num_fields, char** field_names) | |
176 | { | |
177 | Scheme_Object *new_type; | |
178 | int count_out, i; | |
179 | Scheme_Object **struct_names; | |
180 | Scheme_Object **vals; | |
181 | Scheme_Object **a = (Scheme_Object**) \ | |
182 | scheme_malloc(num_fields*sizeof(Scheme_Object*)); | |
183 | ||
184 | for (i=0; i<num_fields; ++i) { | |
185 | a[i] = (Scheme_Object*) scheme_intern_symbol(field_names[i]); | |
186 | } | |
187 | ||
188 | new_type = scheme_make_struct_type(scheme_intern_symbol(basename), | |
189 | NULL /*super_type*/, | |
190 | scheme_make_inspector(0, NULL), | |
191 | num_fields, | |
192 | 0 /* auto_fields */, | |
193 | NULL /* auto_val */, | |
194 | NULL /* properties */ | |
195 | #ifdef MZSCHEME30X | |
196 | ,NULL /* Guard */ | |
197 | #endif | |
198 | ); | |
199 | struct_names = scheme_make_struct_names(scheme_intern_symbol(basename), | |
200 | scheme_build_list(num_fields,a), | |
201 | 0 /*flags*/, &count_out); | |
202 | vals = scheme_make_struct_values(new_type, struct_names, count_out, 0); | |
203 | ||
204 | for (i = 0; i < count_out; i++) | |
205 | scheme_add_global_symbol(struct_names[i], vals[i],env); | |
206 | ||
207 | return new_type; | |
208 | } | |
209 | ||
210 | /* The interpreter will store a pointer to this structure in a global | |
211 | variable called swig-runtime-data-type-pointer. The instance of this | |
212 | struct is only used if no other module has yet been loaded */ | |
213 | struct swig_mzscheme_runtime_data { | |
214 | swig_module_info *module_head; | |
215 | Scheme_Type type; | |
216 | }; | |
217 | static struct swig_mzscheme_runtime_data swig_mzscheme_runtime_data; | |
218 | ||
219 | ||
220 | static swig_module_info * | |
221 | SWIG_MzScheme_GetModule(Scheme_Env *env) { | |
222 | Scheme_Object *pointer, *symbol; | |
223 | struct swig_mzscheme_runtime_data *data; | |
224 | ||
225 | /* first check if pointer already created */ | |
226 | symbol = scheme_intern_symbol("swig-runtime-data-type-pointer" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME); | |
227 | pointer = scheme_lookup_global(symbol, env); | |
228 | if (pointer && SCHEME_CPTRP(pointer)) { | |
229 | data = (struct swig_mzscheme_runtime_data *) SCHEME_CPTR_VAL(pointer); | |
230 | swig_type = data->type; | |
231 | return data->module_head; | |
232 | } else { | |
233 | return NULL; | |
234 | } | |
235 | } | |
236 | ||
237 | static void | |
238 | SWIG_MzScheme_SetModule(Scheme_Env *env, swig_module_info *module) { | |
239 | Scheme_Object *pointer, *symbol; | |
240 | struct swig_mzscheme_runtime_data *data; | |
241 | ||
242 | /* first check if pointer already created */ | |
243 | symbol = scheme_intern_symbol("swig-runtime-data-type-pointer" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME); | |
244 | pointer = scheme_lookup_global(symbol, env); | |
245 | if (pointer && SCHEME_CPTRP(pointer)) { | |
246 | data = (struct swig_mzscheme_runtime_data *) SCHEME_CPTR_VAL(pointer); | |
247 | swig_type = data->type; | |
248 | data->module_head = module; | |
249 | } else { | |
250 | /* create a new type for wrapped pointer values */ | |
251 | swig_type = scheme_make_type((char *)"swig"); | |
252 | swig_mzscheme_runtime_data.module_head = module; | |
253 | swig_mzscheme_runtime_data.type = swig_type; | |
254 | ||
255 | /* create a new pointer */ | |
256 | #ifndef MZSCHEME30X | |
257 | pointer = scheme_make_cptr((void *) &swig_mzscheme_runtime_data, "swig_mzscheme_runtime_data"); | |
258 | #else | |
259 | pointer = scheme_make_cptr((void *) &swig_mzscheme_runtime_data, | |
260 | scheme_make_byte_string("swig_mzscheme_runtime_data")); | |
261 | #endif | |
262 | scheme_add_global_symbol(symbol, pointer, env); | |
263 | } | |
264 | } | |
265 | ||
266 | #ifdef __cplusplus | |
267 | } | |
268 | #endif |