1/* -*-c-*- */
2
3/* SWIG pointer structure */
4
5#include <string.h>
6#include <assert.h>
7
8#ifdef __cplusplus
9extern "C" {
10#endif
11
12#define C_bool 0
13#define C_char 1
14#define C_uchar 2
15#define C_short 3
16#define C_ushort 4
17#define C_int 5
18#define C_uint 6
19#define C_int32 7
20#define C_int64 8
21#define C_float 9
22#define C_double 10
23#define C_ptr 11
24#define C_array 12
25#define C_list 13
26#define C_obj 14
27#define C_string 15
28#define C_enum 16
29#define C_director_core 17
30
31
32/* Cast a pointer if possible; returns 1 if successful */
33
34    SWIGSTATIC int
35    SWIG_Cast (void *source, swig_type_info *source_type,
36	       void **ptr, swig_type_info *dest_type)
37    {
38	if( !source ) { // Special case for NULL.  This is a popular question
39	    // for other modules on the list, so I want an easy way out...
40	    *ptr = 0;
41	    return 0;
42	}
43
44#ifdef TYPE_CAST_VERBOSE
45	fprintf( stderr, "Trying to cast %s to %s\n",
46		 source_type ? source_type->str : "<none>",
47		 dest_type ? dest_type->str : "<none>" );
48#endif
49	if (dest_type != source_type) {
50	    /* We have a type mismatch.  Will have to look through our type
51	       mapping table to figure out whether or not we can accept this
52	       datatype.
53	       --
54	       Ignore typechecks for void *.  Allow any conversion. */
55	    if( !dest_type || !source_type ||
56		!strcmp(dest_type->name,"_p_void") ||
57		!strcmp(source_type->name,"_p_void") ) {
58		*ptr = source;
59		return 0;
60	    } else {
61		swig_cast_info *tc =
62		    SWIG_TypeCheckStruct(source_type, dest_type );
63#ifdef TYPE_CAST_VERBOSE
64		fprintf( stderr, "Typecheck -> %s\n",
65			 tc ? tc->str : "<none>" );
66#endif
67		if( tc ) {
68		    int newmemory = 0;
69		    *ptr = SWIG_TypeCast(tc, source, &newmemory);
70		    assert(!newmemory); /* newmemory handling not yet implemented */
71		    return 0;
72		} else
73		    return -1;
74	    }
75	} else {
76	    *ptr = source;
77	    return 0;
78	}
79    }
80
81/* Return 0 if successful. */
82    SWIGSTATIC int
83    SWIG_GetPtr(void *inptr, void **outptr,
84		swig_type_info *intype, swig_type_info *outtype) {
85	if (intype) {
86	    return SWIG_Cast(inptr, intype,
87			     outptr, outtype) == -1;
88	} else {
89	    *outptr = inptr;
90	    return 0;
91	}
92    }
93
94    SWIGSTATIC void caml_print_list( CAML_VALUE v );
95
96    SWIGSTATIC void caml_print_val( CAML_VALUE v ) {
97	switch( SWIG_Tag_val(v) ) {
98	case C_bool:
99	    if( Bool_val(SWIG_Field(v,0)) ) fprintf( stderr, "true " );
100	    else fprintf( stderr, "false " );
101	    break;
102	case C_char:
103	case C_uchar:
104	    fprintf( stderr, "'%c' (\\%03d) ",
105		     (Int_val(SWIG_Field(v,0)) >= ' ' &&
106		      Int_val(SWIG_Field(v,0)) < 127) ? Int_val(SWIG_Field(v,0)) : '.',
107		     Int_val(SWIG_Field(v,0)) );
108	    break;
109	case C_short:
110	case C_ushort:
111	case C_int:
112	    fprintf( stderr, "%d ", (int)caml_long_val(v) );
113	    break;
114
115	case C_uint:
116	case C_int32:
117	    fprintf( stderr, "%ud ", (unsigned int)caml_long_val(v) );
118	    break;
119	case C_int64:
120	    fprintf( stderr, "%ld ", caml_long_val(v) );
121	    break;
122	case C_float:
123	case C_double:
124	    fprintf( stderr, "%f ", caml_double_val(v) );
125	    break;
126
127	case C_ptr:
128	{
129	    void *vout = 0;
130	    swig_type_info *ty = (swig_type_info *)(long)SWIG_Int64_val(SWIG_Field(v,1));
131	    caml_ptr_val_internal(v,&vout,0);
132	    fprintf( stderr, "PTR(%p,%s) ",
133		     vout,
134		     ty ? ty->name : "(null)" );
135	}
136	break;
137	case C_array:
138	{
139	    unsigned int i;
140	    for( i = 0; i < Wosize_val( SWIG_Field(v,0) ); i++ )
141		caml_print_val( SWIG_Field(SWIG_Field(v,0),i) );
142	}
143	break;
144	case C_list:
145	    caml_print_list( SWIG_Field(v,0) );
146	    break;
147	case C_obj:
148	    fprintf( stderr, "OBJ(%p) ", (void *)SWIG_Field(v,0) );
149	    break;
150	case C_string:
151	{
152	    void *cout;
153	    caml_ptr_val_internal(v,&cout,0);
154	    fprintf( stderr, "'%s' ", (char *)cout );
155	}
156	break;
157	}
158    }
159
160    SWIGSTATIC void caml_print_list( CAML_VALUE v ) {
161	CAMLparam1(v);
162	while( v && Is_block(v) ) {
163	    fprintf( stderr, "[ " );
164	    caml_print_val( SWIG_Field(v,0) );
165	    fprintf( stderr, "]\n" );
166	    v = SWIG_Field(v,1);
167	}
168	CAMLreturn0;
169    }
170
171    SWIGSTATIC CAML_VALUE caml_list_nth( CAML_VALUE lst, int n ) {
172	CAMLparam1(lst);
173	int i = 0;
174	while( i < n && lst && Is_block(lst) ) {
175	    i++; lst = SWIG_Field(lst,1);
176	}
177	if( lst == Val_unit ) CAMLreturn(Val_unit);
178	else CAMLreturn(SWIG_Field(lst,0));
179    }
180
181    SWIGSTATIC CAML_VALUE caml_list_append( CAML_VALUE lst, CAML_VALUE elt ) {
182	CAMLparam2(lst,elt);
183	SWIG_CAMLlocal3(v,vt,lh);
184	lh = Val_unit;
185	v = Val_unit;
186
187	/* Appending C_void should have no effect */
188	if( !Is_block(elt) ) return lst;
189
190	while( lst && Is_block(lst) ) {
191	    if( v && v != Val_unit ) {
192		vt = alloc_tuple(2);
193		SWIG_Store_field(v,1,vt);
194		v = vt;
195	    } else {
196		v = lh = alloc_tuple(2);
197	    }
198	    SWIG_Store_field(v,0,SWIG_Field(lst,0));
199	    lst = SWIG_Field(lst,1);
200	}
201
202	if( v && Is_block(v) ) {
203	    vt = alloc_tuple(2);
204	    SWIG_Store_field(v,1,vt);
205	    v = vt;
206	} else {
207	    v = lh = alloc_tuple(2);
208	}
209	SWIG_Store_field(v,0,elt);
210	SWIG_Store_field(v,1,Val_unit);
211
212	CAMLreturn(lh);
213    }
214
215    SWIGSTATIC int caml_list_length( CAML_VALUE lst ) {
216	CAMLparam1(lst);
217	int i = 0;
218	while( lst && Is_block(lst) ) { i++; lst = SWIG_Field(lst,1); }
219	CAMLreturn(i);
220    }
221
222    SWIGSTATIC void caml_array_set( CAML_VALUE arr, int n, CAML_VALUE item ) {
223	CAMLparam2(arr,item);
224	SWIG_Store_field(SWIG_Field(arr,0),n,item);
225	CAMLreturn0;
226    }
227
228    SWIGSTATIC value caml_array_nth( CAML_VALUE arr, int n ) {
229	CAMLparam1(arr);
230	if( SWIG_Tag_val(arr) == C_array )
231	    CAMLreturn(SWIG_Field(SWIG_Field(arr,0),n));
232	else if( SWIG_Tag_val(arr) == C_list )
233	    CAMLreturn(caml_list_nth(arr,0));
234	else
235	    failwith("Need array or list");
236    }
237
238    SWIGSTATIC int caml_array_len( CAML_VALUE arr ) {
239	CAMLparam1(arr);
240	if( SWIG_Tag_val(arr) == C_array )
241	    CAMLreturn(Wosize_val(SWIG_Field(arr,0)));
242	else if( SWIG_Tag_val(arr) == C_list )
243	    CAMLreturn(caml_list_length(arr));
244	else
245	    failwith("Need array or list");
246    }
247
248    SWIGSTATIC CAML_VALUE caml_swig_alloc(int x,int y) {
249	return caml_alloc(x,y);
250    }
251
252    SWIGSTATIC value caml_array_new( int n ) {
253	CAMLparam0();
254	SWIG_CAMLlocal1(vv);
255	vv = caml_swig_alloc(1,C_array);
256	SWIG_Store_field(vv,0,alloc_tuple(n));
257	CAMLreturn(vv);
258    }
259
260    SWIGSTATIC CAML_VALUE caml_val_bool( int b ) {
261	CAMLparam0();
262	SWIG_CAMLlocal1(bv);
263	bv = caml_swig_alloc(1,C_bool);
264	SWIG_Store_field(bv,0,Val_bool(b));
265	CAMLreturn(bv);
266    }
267
268    SWIGSTATIC CAML_VALUE caml_val_char( char c ) {
269	CAMLparam0();
270	SWIG_CAMLlocal1(cv);
271	cv = caml_swig_alloc(1,C_char);
272	SWIG_Store_field(cv,0,Val_int(c));
273	CAMLreturn(cv);
274    }
275
276    SWIGSTATIC CAML_VALUE caml_val_uchar( unsigned char uc ) {
277	CAMLparam0();
278	SWIG_CAMLlocal1(ucv);
279	ucv = caml_swig_alloc(1,C_uchar);
280	SWIG_Store_field(ucv,0,Val_int(uc));
281	CAMLreturn(ucv);
282    }
283
284    SWIGSTATIC CAML_VALUE caml_val_short( short s ) {
285	CAMLparam0();
286	SWIG_CAMLlocal1(sv);
287	sv = caml_swig_alloc(1,C_short);
288	SWIG_Store_field(sv,0,Val_int(s));
289	CAMLreturn(sv);
290    }
291
292    SWIGSTATIC CAML_VALUE caml_val_ushort( unsigned short us ) {
293	CAMLparam0();
294	SWIG_CAMLlocal1(usv);
295	usv = caml_swig_alloc(1,C_ushort);
296	SWIG_Store_field(usv,0,Val_int(us));
297	CAMLreturn(usv);
298    }
299
300    SWIGSTATIC CAML_VALUE caml_val_int( int i ) {
301	CAMLparam0();
302	SWIG_CAMLlocal1(iv);
303	iv = caml_swig_alloc(1,C_int);
304	SWIG_Store_field(iv,0,Val_int(i));
305	CAMLreturn(iv);
306    }
307
308    SWIGSTATIC CAML_VALUE caml_val_uint( unsigned int ui ) {
309	CAMLparam0();
310	SWIG_CAMLlocal1(uiv);
311	uiv = caml_swig_alloc(1,C_int);
312	SWIG_Store_field(uiv,0,Val_int(ui));
313	CAMLreturn(uiv);
314    }
315
316    SWIGSTATIC CAML_VALUE caml_val_long( long l ) {
317	CAMLparam0();
318	SWIG_CAMLlocal1(lv);
319	lv = caml_swig_alloc(1,C_int64);
320	SWIG_Store_field(lv,0,copy_int64(l));
321	CAMLreturn(lv);
322    }
323
324    SWIGSTATIC CAML_VALUE caml_val_ulong( unsigned long ul ) {
325	CAMLparam0();
326	SWIG_CAMLlocal1(ulv);
327	ulv = caml_swig_alloc(1,C_int64);
328	SWIG_Store_field(ulv,0,copy_int64(ul));
329	CAMLreturn(ulv);
330    }
331
332    SWIGSTATIC CAML_VALUE caml_val_float( float f ) {
333	CAMLparam0();
334	SWIG_CAMLlocal1(fv);
335	fv = caml_swig_alloc(1,C_float);
336	SWIG_Store_field(fv,0,copy_double((double)f));
337	CAMLreturn(fv);
338    }
339
340    SWIGSTATIC CAML_VALUE caml_val_double( double d ) {
341	CAMLparam0();
342	SWIG_CAMLlocal1(fv);
343	fv = caml_swig_alloc(1,C_double);
344	SWIG_Store_field(fv,0,copy_double(d));
345	CAMLreturn(fv);
346    }
347
348    SWIGSTATIC CAML_VALUE caml_val_ptr( void *p, swig_type_info *info ) {
349	CAMLparam0();
350	SWIG_CAMLlocal1(vv);
351	vv = caml_swig_alloc(2,C_ptr);
352	SWIG_Store_field(vv,0,copy_int64((long)p));
353	SWIG_Store_field(vv,1,copy_int64((long)info));
354	CAMLreturn(vv);
355    }
356
357    SWIGSTATIC CAML_VALUE caml_val_string( const char *p ) {
358	CAMLparam0();
359	SWIG_CAMLlocal1(vv);
360	if( !p ) CAMLreturn(caml_val_ptr( (void *)p, 0 ));
361	vv = caml_swig_alloc(1,C_string);
362	SWIG_Store_field(vv,0,copy_string(p));
363	CAMLreturn(vv);
364    }
365
366    SWIGSTATIC CAML_VALUE caml_val_string_len( const char *p, int len ) {
367	CAMLparam0();
368	SWIG_CAMLlocal1(vv);
369	if( !p || len < 0 ) CAMLreturn(caml_val_ptr( (void *)p, 0 ));
370	vv = caml_swig_alloc(1,C_string);
371	SWIG_Store_field(vv,0,alloc_string(len));
372	memcpy(String_val(SWIG_Field(vv,0)),p,len);
373	CAMLreturn(vv);
374    }
375
376    #define caml_val_obj(v, name) caml_val_obj_helper(v, SWIG_TypeQuery((name)), name)
377    SWIGSTATIC CAML_VALUE caml_val_obj_helper( void *v, swig_type_info *type, char *name) {
378	CAMLparam0();
379	CAMLreturn(callback2(*caml_named_value("caml_create_object_fn"),
380			     caml_val_ptr(v,type),
381			     copy_string(name)));
382    }
383
384    SWIGSTATIC long caml_long_val_full( CAML_VALUE v, char *name ) {
385	CAMLparam1(v);
386	if( !Is_block(v) ) return 0;
387
388	switch( SWIG_Tag_val(v) ) {
389	case C_bool:
390	case C_char:
391	case C_uchar:
392	case C_short:
393	case C_ushort:
394	case C_int:
395	    CAMLreturn(Int_val(SWIG_Field(v,0)));
396	case C_uint:
397	case C_int32:
398	    CAMLreturn(Int32_val(SWIG_Field(v,0)));
399	case C_int64:
400	    CAMLreturn((long)SWIG_Int64_val(SWIG_Field(v,0)));
401	case C_float:
402	case C_double:
403	    CAMLreturn((long)Double_val(SWIG_Field(v,0)));
404	case C_string:
405	    CAMLreturn((long)String_val(SWIG_Field(v,0)));
406	case C_ptr:
407	    CAMLreturn((long)SWIG_Int64_val(SWIG_Field(SWIG_Field(v,0),0)));
408	case C_enum: {
409	    SWIG_CAMLlocal1(ret);
410	    CAML_VALUE *enum_to_int = caml_named_value(SWIG_MODULE "_enum_to_int");
411	    if( !name ) failwith( "Not an enum conversion" );
412	    ret = callback2(*enum_to_int,*caml_named_value(name),v);
413	    CAMLreturn(caml_long_val(ret));
414	}
415	default:
416	    failwith("No conversion to int");
417	}
418    }
419
420    SWIGSTATIC long caml_long_val( CAML_VALUE v ) {
421	return caml_long_val_full(v,0);
422    }
423
424    SWIGSTATIC double caml_double_val( CAML_VALUE v ) {
425	CAMLparam1(v);
426	if( !Is_block(v) ) return 0.0;
427	switch( SWIG_Tag_val(v) ) {
428	case C_bool:
429	case C_char:
430	case C_uchar:
431	case C_short:
432	case C_ushort:
433	case C_int:
434	    CAMLreturn_type(Int_val(SWIG_Field(v,0)));
435	case C_uint:
436	case C_int32:
437	    CAMLreturn_type(Int32_val(SWIG_Field(v,0)));
438	case C_int64:
439	    CAMLreturn_type(SWIG_Int64_val(SWIG_Field(v,0)));
440	case C_float:
441	case C_double:
442	    CAMLreturn_type(Double_val(SWIG_Field(v,0)));
443	default:
444	    fprintf( stderr, "Unknown block tag %d\n", SWIG_Tag_val(v) );
445	    failwith("No conversion to double");
446	}
447    }
448
449    SWIGSTATIC int caml_ptr_val_internal( CAML_VALUE v, void **out,
450					  swig_type_info *descriptor ) {
451	CAMLparam1(v);
452	void *outptr = NULL;
453        swig_type_info *outdescr = NULL;
454
455	if( v == Val_unit ) {
456	    *out = 0;
457	    CAMLreturn(0);
458	}
459	if( !Is_block(v) ) return -1;
460	switch( SWIG_Tag_val(v) ) {
461	case C_int:
462	    if( !caml_long_val( v ) ) {
463		*out = 0;
464		CAMLreturn(0);
465	    } else {
466		*out = 0;
467		CAMLreturn(1);
468	    }
469	    break;
470	case C_obj:
471	    CAMLreturn
472		(caml_ptr_val_internal
473		 (callback(*caml_named_value("caml_obj_ptr"),v),
474		  out,descriptor));
475	case C_string:
476	    outptr = (void *)String_val(SWIG_Field(v,0));
477	    break;
478	case C_ptr:
479	    outptr = (void *)(long)SWIG_Int64_val(SWIG_Field(v,0));
480            outdescr = (swig_type_info *)(long)SWIG_Int64_val(SWIG_Field(v,1));
481	    break;
482	default:
483	    *out = 0;
484	    CAMLreturn(1);
485	    break;
486	}
487
488	CAMLreturn(SWIG_GetPtr(outptr,out,outdescr,descriptor));
489    }
490
491    SWIGSTATIC void *caml_ptr_val( CAML_VALUE v, swig_type_info *descriptor ) {
492        CAMLparam0();
493#ifdef TYPE_CAST_VERBOSE
494	caml_print_val( v );
495#endif
496	void *out = NULL;
497	if( !caml_ptr_val_internal( v, &out, descriptor ) )
498	    CAMLreturn_type(out);
499	else
500	    failwith( "No appropriate conversion found." );
501    }
502
503    SWIGSTATIC char *caml_string_val( CAML_VALUE v ) {
504	return (char *)caml_ptr_val( v, 0 );
505    }
506
507    SWIGSTATIC int caml_string_len( CAML_VALUE v ) {
508	switch( SWIG_Tag_val(v) ) {
509	case C_string:
510	    return string_length(SWIG_Field(v,0));
511	default:
512	    return strlen((char *)caml_ptr_val(v,0));
513	}
514    }
515
516    SWIGSTATIC int caml_bool_check( CAML_VALUE v ) {
517	CAMLparam1(v);
518
519	if( !Is_block(v) ) return 0;
520
521	switch( SWIG_Tag_val(v) ) {
522	case C_bool:
523	case C_ptr:
524	case C_string:
525	    CAMLreturn(1);
526	default:
527	    CAMLreturn(0);
528	}
529    }
530
531    SWIGSTATIC int caml_int_check( CAML_VALUE v ) {
532	CAMLparam1(v);
533
534	if( !Is_block(v) ) return 0;
535
536	switch( SWIG_Tag_val(v) ) {
537	case C_char:
538	case C_uchar:
539	case C_short:
540	case C_ushort:
541	case C_int:
542	case C_uint:
543	case C_int32:
544	case C_int64:
545	    CAMLreturn(1);
546
547	default:
548	    CAMLreturn(0);
549	}
550    }
551
552    SWIGSTATIC int caml_float_check( CAML_VALUE v ) {
553	CAMLparam1(v);
554	if( !Is_block(v) ) return 0;
555
556	switch( SWIG_Tag_val(v) ) {
557	case C_float:
558	case C_double:
559	    CAMLreturn(1);
560
561	default:
562	    CAMLreturn(0);
563	}
564    }
565
566    SWIGSTATIC int caml_ptr_check( CAML_VALUE v ) {
567	CAMLparam1(v);
568	if( !Is_block(v) ) return 0;
569
570	switch( SWIG_Tag_val(v) ) {
571	case C_string:
572	case C_ptr:
573	case C_int64:
574	    CAMLreturn(1);
575
576	default:
577	    CAMLreturn(0);
578	}
579    }
580
581    static swig_module_info *SWIG_Ocaml_GetModule() {
582      CAML_VALUE pointer;
583
584      pointer = callback(*caml_named_value("swig_find_type_info"), caml_val_int(0));
585      if (Is_block(pointer) && SWIG_Tag_val(pointer) == C_ptr) {
586        return (swig_module_info *)(void *)(long)SWIG_Int64_val(SWIG_Field(pointer,0));
587      }
588      return 0;
589    }
590
591    static void SWIG_Ocaml_SetModule(swig_module_info *pointer) {
592      CAML_VALUE mod_pointer;
593
594      mod_pointer = caml_val_ptr(pointer, NULL);
595      callback(*caml_named_value("swig_set_type_info"), mod_pointer);
596    }
597
598#ifdef __cplusplus
599}
600#endif
601#undef value
602
603