diff --git a/Examples/test-suite/multivalue.i b/Examples/test-suite/multivalue.i index f92e6c78b..3bc3471a1 100644 --- a/Examples/test-suite/multivalue.i +++ b/Examples/test-suite/multivalue.i @@ -26,6 +26,11 @@ void divide_v(int a, int b, int *OUTPUT, int *OUTPUT); void divide_mv(int a, int b, int *OUTPUT, int *OUTPUT); +#else +%include "typemaps.i" +void divide_l(int a, int b, int *OUTPUT, int *OUTPUT); +void divide_v(int a, int b, int *OUTPUT, int *OUTPUT); +void divide_mv(int a, int b, int *OUTPUT, int *OUTPUT); #endif %{ @@ -49,4 +54,3 @@ void divide_mv(int a, int b, int *quotient_p, int *remainder_p) } %} - diff --git a/Examples/test-suite/ocaml/Makefile.in b/Examples/test-suite/ocaml/Makefile.in index fd1daed15..775b1ea71 100644 --- a/Examples/test-suite/ocaml/Makefile.in +++ b/Examples/test-suite/ocaml/Makefile.in @@ -34,6 +34,12 @@ FAILING_C_TESTS = \ enums \ preproc_constants_c \ +CPP_TEST_CASES += \ + inout \ + +C_TEST_CASES += \ + multivalue \ + ml_runme = $(SCRIPTPREFIX)$*$(SCRIPTSUFFIX) run_testcase = \ diff --git a/Examples/test-suite/ocaml/inout_runme.ml b/Examples/test-suite/ocaml/inout_runme.ml new file mode 100644 index 000000000..767bb43e6 --- /dev/null +++ b/Examples/test-suite/ocaml/inout_runme.ml @@ -0,0 +1,8 @@ +open Swig +open Inout + +let _ = + assert (_AddOne1 '(1.) as float = 2.); + assert (_AddOne3 '(1, 1, 1) = C_list ['2.;'2.;'2.]); + assert (_AddOne1r '(1.) as float = 2.); +;; diff --git a/Examples/test-suite/ocaml/multivalue_runme.ml b/Examples/test-suite/ocaml/multivalue_runme.ml new file mode 100644 index 000000000..d7e19e7d8 --- /dev/null +++ b/Examples/test-suite/ocaml/multivalue_runme.ml @@ -0,0 +1,8 @@ +open Swig +open Multivalue + +let _ = + assert (_divide_l '(37, 5) = C_list ['7;'2]); + assert (_divide_v '(41, 7) = C_list ['5;'6]); + assert (_divide_mv '(91, 13) = C_list ['7;'0]); +;; diff --git a/Lib/ocaml/ocaml.i b/Lib/ocaml/ocaml.i index 96a36c8b2..cc26d1859 100644 --- a/Lib/ocaml/ocaml.i +++ b/Lib/ocaml/ocaml.i @@ -8,7 +8,7 @@ %insert(runtime) "swigrun.swg" /* Include headers */ -%insert(runtime) "ocamldec.swg" +%insert(runtime) "ocamlrundec.swg" /* Type registration */ %insert(init) "swiginit.swg" @@ -28,18 +28,14 @@ %} /*#ifndef SWIG_NOINCLUDE*/ -%insert(runtime) "ocaml.swg" +%insert(runtime) "ocamlrun.swg" /*#endif*/ %insert(classtemplate) "class.swg" -/* Definitions */ -#define SWIG_malloc(size) swig_malloc(size, FUNC_NAME) -#define SWIG_free(mem) free(mem) - /* Read in standard typemaps. */ %include -%include +%include %include %include %include diff --git a/Lib/ocaml/ocaml.swg b/Lib/ocaml/ocaml.swg index 3d552cc50..ac496bdba 100644 --- a/Lib/ocaml/ocaml.swg +++ b/Lib/ocaml/ocaml.swg @@ -1,607 +1,311 @@ -/* -*-c-*- */ +/* ----------------------------------------------------------------------------- + * ocaml.swg + * + * The Ocaml module handles all types uniformly via typemaps. Here + * are the definitions. + * ----------------------------------------------------------------------------- */ -/* SWIG pointer structure */ +/* Pointers */ -#include -#include +%typemap(in) void "" -#ifdef __cplusplus -extern "C" { -#endif +%typemap(out) void "$result = Val_int(0);" -#define C_bool 0 -#define C_char 1 -#define C_uchar 2 -#define C_short 3 -#define C_ushort 4 -#define C_int 5 -#define C_uint 6 -#define C_int32 7 -#define C_int64 8 -#define C_float 9 -#define C_double 10 -#define C_ptr 11 -#define C_array 12 -#define C_list 13 -#define C_obj 14 -#define C_string 15 -#define C_enum 16 -#define C_director_core 17 +%typemap(in) void * { + $1 = caml_ptr_val($input,$descriptor); +} +%typemap(varin) void * { + $1 = ($ltype)caml_ptr_val($input,$descriptor); +} -/* Cast a pointer if possible; returns 1 if successful */ - - SWIGINTERN int - SWIG_Cast (void *source, swig_type_info *source_type, - void **ptr, swig_type_info *dest_type) - { - if( !source ) { /* Special case for NULL. This is a popular question - for other modules on the list, so I want an easy way out... */ - *ptr = 0; - return 0; - } +%typemap(out) void * { + $result = caml_val_ptr($1,$descriptor); +} -#ifdef TYPE_CAST_VERBOSE - fprintf( stderr, "Trying to cast %s to %s\n", - source_type ? source_type->str : "", - dest_type ? dest_type->str : "" ); -#endif - if (dest_type != source_type) { - /* We have a type mismatch. Will have to look through our type - mapping table to figure out whether or not we can accept this - datatype. - -- - Ignore typechecks for void *. Allow any conversion. */ - if( !dest_type || !source_type || - !strcmp(dest_type->name,"_p_void") || - !strcmp(source_type->name,"_p_void") ) { - *ptr = source; - return 0; - } else { - swig_cast_info *tc = - SWIG_TypeCheckStruct(source_type, dest_type ); -#ifdef TYPE_CAST_VERBOSE - fprintf( stderr, "Typecheck -> %s\n", - tc ? tc->type->str : "" ); -#endif - if( tc ) { - int newmemory = 0; - *ptr = SWIG_TypeCast(tc, source, &newmemory); - assert(!newmemory); /* newmemory handling not yet implemented */ - return 0; - } else - return -1; - } - } else { - *ptr = source; - return 0; - } +%typemap(varout) void * { + $result = caml_val_ptr($1,$descriptor); +} + +%typemap(in) char *& (char *temp) { + temp = (char*)caml_val_ptr($1,$descriptor); + $1 = &temp; +} + +%typemap(argout) char *& { + swig_result = caml_list_append(swig_result,caml_val_string_len(*$1, strlen(*$1))); +} + +%typemap(in) SWIGTYPE & { + $1 = ($ltype) caml_ptr_val($input,$1_descriptor); +} + +%typemap(in) SWIGTYPE && { + $1 = ($ltype) caml_ptr_val($input,$1_descriptor); +} + +%typemap(varin) SWIGTYPE & { + $1 = *(($ltype) caml_ptr_val($input,$1_descriptor)); +} + +%typemap(varin) SWIGTYPE && { + $1 = *(($ltype) caml_ptr_val($input,$1_descriptor)); +} + +%typemap(varout) SWIGTYPE &, SWIGTYPE && { + $result = SWIG_Ocaml_ptr_to_val("create_$ntype_from_ptr", (void *)&$1, $1_descriptor); +} + +%typemap(out) SWIGTYPE &, SWIGTYPE && { + $result = SWIG_Ocaml_ptr_to_val("create_$ntype_from_ptr", (void *)$1, $1_descriptor); +} + +#if 0 +%typemap(argout) SWIGTYPE & { + CAML_VALUE *fromval = caml_named_value("create_$ntype_from_ptr"); + if( fromval ) { + swig_result = + caml_list_append(swig_result, + caml_callback(*fromval,caml_val_ptr((void *) $1, + $1_descriptor))); + } else { + swig_result = + caml_list_append(swig_result, + caml_val_ptr ((void *) $1,$1_descriptor)); } - -/* Return 0 if successful. */ - SWIGINTERN int - SWIG_GetPtr(void *inptr, void **outptr, - swig_type_info *intype, swig_type_info *outtype) { - if (intype) { - return SWIG_Cast(inptr, intype, - outptr, outtype) == -1; - } else { - *outptr = inptr; - return 0; - } +} +%typemap(argout) SWIGTYPE && { + CAML_VALUE *fromval = caml_named_value("create_$ntype_from_ptr"); + if( fromval ) { + swig_result = + caml_list_append(swig_result, + caml_callback(*fromval,caml_val_ptr((void *) $1, + $1_descriptor))); + } else { + swig_result = + caml_list_append(swig_result, + caml_val_ptr ((void *) $1,$1_descriptor)); } - - SWIGINTERN void caml_print_list( CAML_VALUE v ); - - SWIGINTERN void caml_print_val( CAML_VALUE v ) { - switch( SWIG_Tag_val(v) ) { - case C_bool: - if( Bool_val(SWIG_Field(v,0)) ) fprintf( stderr, "true " ); - else fprintf( stderr, "false " ); - break; - case C_char: - case C_uchar: - fprintf( stderr, "'%c' (\\%03d) ", - (Int_val(SWIG_Field(v,0)) >= ' ' && - Int_val(SWIG_Field(v,0)) < 127) ? Int_val(SWIG_Field(v,0)) : '.', - Int_val(SWIG_Field(v,0)) ); - break; - case C_short: - case C_ushort: - case C_int: - fprintf( stderr, "%d ", (int)caml_long_val(v) ); - break; - - case C_uint: - case C_int32: - fprintf( stderr, "%ud ", (unsigned int)caml_long_val(v) ); - break; - case C_int64: - fprintf( stderr, "%ld ", caml_long_val(v) ); - break; - case C_float: - case C_double: - fprintf( stderr, "%f ", caml_double_val(v) ); - break; - - case C_ptr: - { - void *vout = 0; - swig_type_info *ty = (swig_type_info *)(long)SWIG_Int64_val(SWIG_Field(v,1)); - caml_ptr_val_internal(v,&vout,0); - fprintf( stderr, "PTR(%p,%s) ", - vout, - ty ? ty->name : "(null)" ); - } - break; - case C_array: - { - unsigned int i; - for( i = 0; i < Wosize_val( SWIG_Field(v,0) ); i++ ) - caml_print_val( SWIG_Field(SWIG_Field(v,0),i) ); - } - break; - case C_list: - caml_print_list( SWIG_Field(v,0) ); - break; - case C_obj: - fprintf( stderr, "OBJ(%p) ", (void *)SWIG_Field(v,0) ); - break; - case C_string: - { - void *cout; - caml_ptr_val_internal(v,&cout,0); - fprintf( stderr, "'%s' ", (char *)cout ); - } - break; - } - } - - SWIGINTERN void caml_print_list( CAML_VALUE v ) { - CAMLparam1(v); - while( v && Is_block(v) ) { - fprintf( stderr, "[ " ); - caml_print_val( SWIG_Field(v,0) ); - fprintf( stderr, "]\n" ); - v = SWIG_Field(v,1); - } - CAMLreturn0; - } - - SWIGINTERN CAML_VALUE caml_list_nth( CAML_VALUE lst, int n ) { - CAMLparam1(lst); - int i = 0; - while( i < n && lst && Is_block(lst) ) { - i++; lst = SWIG_Field(lst,1); - } - if( lst == Val_unit ) CAMLreturn(Val_unit); - else CAMLreturn(SWIG_Field(lst,0)); - } - - SWIGINTERN CAML_VALUE caml_list_append( CAML_VALUE lst, CAML_VALUE elt ) { - CAMLparam2(lst,elt); - SWIG_CAMLlocal3(v,vt,lh); - lh = Val_unit; - v = Val_unit; - - /* Appending C_void should have no effect */ - if( !Is_block(elt) ) return lst; - - while( lst && Is_block(lst) ) { - if( v && v != Val_unit ) { - vt = caml_alloc_tuple(2); - SWIG_Store_field(v,1,vt); - v = vt; - } else { - v = lh = caml_alloc_tuple(2); - } - SWIG_Store_field(v,0,SWIG_Field(lst,0)); - lst = SWIG_Field(lst,1); - } - - if( v && Is_block(v) ) { - vt = caml_alloc_tuple(2); - SWIG_Store_field(v,1,vt); - v = vt; - } else { - v = lh = caml_alloc_tuple(2); - } - SWIG_Store_field(v,0,elt); - SWIG_Store_field(v,1,Val_unit); - - CAMLreturn(lh); - } - - SWIGINTERN int caml_list_length( CAML_VALUE lst ) { - CAMLparam1(lst); - int i = 0; - while( lst && Is_block(lst) ) { i++; lst = SWIG_Field(lst,1); } - CAMLreturn(i); - } - - SWIGINTERN void caml_array_set( CAML_VALUE arr, int n, CAML_VALUE item ) { - CAMLparam2(arr,item); - SWIG_Store_field(SWIG_Field(arr,0),n,item); - CAMLreturn0; - } - - SWIGINTERN value caml_array_nth( CAML_VALUE arr, int n ) { - CAMLparam1(arr); - if( SWIG_Tag_val(arr) == C_array ) - CAMLreturn(SWIG_Field(SWIG_Field(arr,0),n)); - else if( SWIG_Tag_val(arr) == C_list ) - CAMLreturn(caml_list_nth(arr,0)); - else - caml_failwith("Need array or list"); - } - - SWIGINTERN int caml_array_len( CAML_VALUE arr ) { - CAMLparam1(arr); - if( SWIG_Tag_val(arr) == C_array ) - CAMLreturn(Wosize_val(SWIG_Field(arr,0))); - else if( SWIG_Tag_val(arr) == C_list ) - CAMLreturn(caml_list_length(arr)); - else - caml_failwith("Need array or list"); - } - - SWIGINTERN CAML_VALUE caml_swig_alloc(int x,int y) { - return caml_alloc(x,y); - } - - SWIGINTERN value caml_array_new( int n ) { - CAMLparam0(); - SWIG_CAMLlocal1(vv); - vv = caml_swig_alloc(1,C_array); - SWIG_Store_field(vv,0,caml_alloc_tuple(n)); - CAMLreturn(vv); - } - - SWIGINTERN CAML_VALUE caml_val_bool( int b ) { - CAMLparam0(); - SWIG_CAMLlocal1(bv); - bv = caml_swig_alloc(1,C_bool); - SWIG_Store_field(bv,0,Val_bool(b)); - CAMLreturn(bv); - } - - SWIGINTERN CAML_VALUE caml_val_char( char c ) { - CAMLparam0(); - SWIG_CAMLlocal1(cv); - cv = caml_swig_alloc(1,C_char); - SWIG_Store_field(cv,0,Val_int(c)); - CAMLreturn(cv); - } - - SWIGINTERN CAML_VALUE caml_val_uchar( unsigned char uc ) { - CAMLparam0(); - SWIG_CAMLlocal1(ucv); - ucv = caml_swig_alloc(1,C_uchar); - SWIG_Store_field(ucv,0,Val_int(uc)); - CAMLreturn(ucv); - } - - SWIGINTERN CAML_VALUE caml_val_short( short s ) { - CAMLparam0(); - SWIG_CAMLlocal1(sv); - sv = caml_swig_alloc(1,C_short); - SWIG_Store_field(sv,0,Val_int(s)); - CAMLreturn(sv); - } - - SWIGINTERN CAML_VALUE caml_val_ushort( unsigned short us ) { - CAMLparam0(); - SWIG_CAMLlocal1(usv); - usv = caml_swig_alloc(1,C_ushort); - SWIG_Store_field(usv,0,Val_int(us)); - CAMLreturn(usv); - } - - SWIGINTERN CAML_VALUE caml_val_int( int i ) { - CAMLparam0(); - SWIG_CAMLlocal1(iv); - iv = caml_swig_alloc(1,C_int); - SWIG_Store_field(iv,0,Val_int(i)); - CAMLreturn(iv); - } - - SWIGINTERN CAML_VALUE caml_val_uint( unsigned int ui ) { - CAMLparam0(); - SWIG_CAMLlocal1(uiv); - uiv = caml_swig_alloc(1,C_int); - SWIG_Store_field(uiv,0,Val_int(ui)); - CAMLreturn(uiv); - } - - SWIGINTERN CAML_VALUE caml_val_long( long l ) { - CAMLparam0(); - SWIG_CAMLlocal1(lv); - lv = caml_swig_alloc(1,C_int64); - SWIG_Store_field(lv,0,caml_copy_int64(l)); - CAMLreturn(lv); - } - - SWIGINTERN CAML_VALUE caml_val_ulong( unsigned long ul ) { - CAMLparam0(); - SWIG_CAMLlocal1(ulv); - ulv = caml_swig_alloc(1,C_int64); - SWIG_Store_field(ulv,0,caml_copy_int64(ul)); - CAMLreturn(ulv); - } - - SWIGINTERN CAML_VALUE caml_val_float( float f ) { - CAMLparam0(); - SWIG_CAMLlocal1(fv); - fv = caml_swig_alloc(1,C_float); - SWIG_Store_field(fv,0,caml_copy_double((double)f)); - CAMLreturn(fv); - } - - SWIGINTERN CAML_VALUE caml_val_double( double d ) { - CAMLparam0(); - SWIG_CAMLlocal1(fv); - fv = caml_swig_alloc(1,C_double); - SWIG_Store_field(fv,0,caml_copy_double(d)); - CAMLreturn(fv); - } - - SWIGINTERN CAML_VALUE caml_val_ptr( void *p, swig_type_info *info ) { - CAMLparam0(); - SWIG_CAMLlocal1(vv); - vv = caml_swig_alloc(2,C_ptr); - SWIG_Store_field(vv,0,caml_copy_int64((long)p)); - SWIG_Store_field(vv,1,caml_copy_int64((long)info)); - CAMLreturn(vv); - } - - SWIGINTERN CAML_VALUE caml_val_string( const char *p ) { - CAMLparam0(); - SWIG_CAMLlocal1(vv); - if( !p ) CAMLreturn(caml_val_ptr( (void *)p, 0 )); - vv = caml_swig_alloc(1,C_string); - SWIG_Store_field(vv,0,caml_copy_string(p)); - CAMLreturn(vv); - } - - SWIGINTERN CAML_VALUE caml_val_string_len( const char *p, int len ) { - CAMLparam0(); - SWIG_CAMLlocal1(vv); - if( !p || len < 0 ) CAMLreturn(caml_val_ptr( (void *)p, 0 )); - vv = caml_swig_alloc(1,C_string); - SWIG_Store_field(vv,0,caml_alloc_string(len)); - memcpy(String_val(SWIG_Field(vv,0)),p,len); - CAMLreturn(vv); - } - - #define caml_val_obj(v, name) caml_val_obj_helper(v, SWIG_TypeQuery((name)), name) - SWIGINTERN CAML_VALUE caml_val_obj_helper( void *v, swig_type_info *type, char *name) { - CAMLparam0(); - CAMLreturn(caml_callback2(*caml_named_value("caml_create_object_fn"), - caml_val_ptr(v,type), - caml_copy_string(name))); - } - - SWIGINTERN long caml_long_val_full( CAML_VALUE v, const char *name ) { - CAMLparam1(v); - if( !Is_block(v) ) return 0; - - switch( SWIG_Tag_val(v) ) { - case C_bool: - case C_char: - case C_uchar: - case C_short: - case C_ushort: - case C_int: - CAMLreturn(Int_val(SWIG_Field(v,0))); - case C_uint: - case C_int32: - CAMLreturn(Int32_val(SWIG_Field(v,0))); - case C_int64: - CAMLreturn((long)SWIG_Int64_val(SWIG_Field(v,0))); - case C_float: - case C_double: - CAMLreturn((long)Double_val(SWIG_Field(v,0))); - case C_string: - CAMLreturn((long)String_val(SWIG_Field(v,0))); - case C_ptr: - CAMLreturn((long)SWIG_Int64_val(SWIG_Field(SWIG_Field(v,0),0))); - case C_enum: { - SWIG_CAMLlocal1(ret); - CAML_VALUE *enum_to_int = caml_named_value(SWIG_MODULE "_enum_to_int"); - if( !name ) caml_failwith( "Not an enum conversion" ); - ret = caml_callback2(*enum_to_int,*caml_named_value(name),v); - CAMLreturn(caml_long_val(ret)); - } - default: - caml_failwith("No conversion to int"); - } - } - - SWIGINTERN long caml_long_val( CAML_VALUE v ) { - return caml_long_val_full(v,0); - } - - SWIGINTERN double caml_double_val( CAML_VALUE v ) { - CAMLparam1(v); - if( !Is_block(v) ) return 0.0; - switch( SWIG_Tag_val(v) ) { - case C_bool: - case C_char: - case C_uchar: - case C_short: - case C_ushort: - case C_int: - CAMLreturn_type(Int_val(SWIG_Field(v,0))); - case C_uint: - case C_int32: - CAMLreturn_type(Int32_val(SWIG_Field(v,0))); - case C_int64: - CAMLreturn_type(SWIG_Int64_val(SWIG_Field(v,0))); - case C_float: - case C_double: - CAMLreturn_type(Double_val(SWIG_Field(v,0))); - default: - fprintf( stderr, "Unknown block tag %d\n", SWIG_Tag_val(v) ); - caml_failwith("No conversion to double"); - } - } - - SWIGINTERN int caml_ptr_val_internal( CAML_VALUE v, void **out, - swig_type_info *descriptor ) { - CAMLparam1(v); - void *outptr = NULL; - swig_type_info *outdescr = NULL; - static CAML_VALUE *func_val = NULL; - - if( v == Val_unit ) { - *out = 0; - CAMLreturn_type(0); - } - if( !Is_block(v) ) return -1; - switch( SWIG_Tag_val(v) ) { - case C_obj: - if (!func_val) { - func_val = caml_named_value("caml_obj_ptr"); - } - CAMLreturn_type(caml_ptr_val_internal(caml_callback(*func_val, v), out, descriptor)); - case C_string: - outptr = (void *)String_val(SWIG_Field(v,0)); - break; - case C_ptr: - outptr = (void *)(long)SWIG_Int64_val(SWIG_Field(v,0)); - outdescr = (swig_type_info *)(long)SWIG_Int64_val(SWIG_Field(v,1)); - break; - default: - *out = 0; - CAMLreturn_type(1); - break; - } - - CAMLreturn_type(SWIG_GetPtr(outptr, out, outdescr, descriptor)); - } - - SWIGINTERN void *caml_ptr_val( CAML_VALUE v, swig_type_info *descriptor ) { - CAMLparam0(); -#ifdef TYPE_CAST_VERBOSE - caml_print_val( v ); -#endif - void *out = NULL; - if( !caml_ptr_val_internal( v, &out, descriptor ) ) - CAMLreturn_type(out); - else - caml_failwith( "No appropriate conversion found." ); - } - - SWIGINTERN char *caml_string_val( CAML_VALUE v ) { - return (char *)caml_ptr_val( v, 0 ); - } - - SWIGINTERN int caml_string_len( CAML_VALUE v ) { - switch( SWIG_Tag_val(v) ) { - case C_string: - return caml_string_length(SWIG_Field(v,0)); - default: - return strlen((char *)caml_ptr_val(v,0)); - } - } - - SWIGINTERN int caml_bool_check( CAML_VALUE v ) { - CAMLparam1(v); - - if( !Is_block(v) ) return 0; - - switch( SWIG_Tag_val(v) ) { - case C_bool: - case C_ptr: - case C_string: - CAMLreturn(1); - default: - CAMLreturn(0); - } - } - - SWIGINTERN int caml_int_check( CAML_VALUE v ) { - CAMLparam1(v); - - if( !Is_block(v) ) return 0; - - switch( SWIG_Tag_val(v) ) { - case C_char: - case C_uchar: - case C_short: - case C_ushort: - case C_int: - case C_uint: - case C_int32: - case C_int64: - CAMLreturn(1); - - default: - CAMLreturn(0); - } - } - - SWIGINTERN int caml_float_check( CAML_VALUE v ) { - CAMLparam1(v); - if( !Is_block(v) ) return 0; - - switch( SWIG_Tag_val(v) ) { - case C_float: - case C_double: - CAMLreturn(1); - - default: - CAMLreturn(0); - } - } - - SWIGINTERN int caml_ptr_check( CAML_VALUE v ) { - CAMLparam1(v); - if( !Is_block(v) ) return 0; - - switch( SWIG_Tag_val(v) ) { - case C_string: - case C_ptr: - case C_int64: - CAMLreturn(1); - - default: - CAMLreturn(0); - } - } - - SWIGINTERN CAML_VALUE SWIG_Ocaml_ptr_to_val(const char *name, void *ptr, swig_type_info *descriptor) { - CAMLparam0(); - SWIG_CAMLlocal1(result); - - CAML_VALUE *fromval = caml_named_value(name); - if (fromval) { - result = caml_callback(*fromval, caml_val_ptr(ptr, descriptor)); - } else { - result = caml_val_ptr(ptr, descriptor); - } - CAMLreturn(result); - } - - static swig_module_info *SWIG_Ocaml_GetModule(void *SWIGUNUSEDPARM(clientdata)) { - CAML_VALUE pointer; - - pointer = caml_callback(*caml_named_value("swig_find_type_info"), caml_val_int(0)); - if (Is_block(pointer) && SWIG_Tag_val(pointer) == C_ptr) { - return (swig_module_info *)(void *)(long)SWIG_Int64_val(SWIG_Field(pointer,0)); - } - return 0; - } - - static void SWIG_Ocaml_SetModule(swig_module_info *pointer) { - CAML_VALUE mod_pointer; - - mod_pointer = caml_val_ptr(pointer, NULL); - caml_callback(*caml_named_value("swig_set_type_info"), mod_pointer); - } - -#ifdef __cplusplus } #endif -#undef value + +%typemap(in) SWIGTYPE { + $1 = *(($&1_ltype) caml_ptr_val($input,$&1_descriptor)) ; +} + +#ifdef __cplusplus + +%typemap(out) SWIGTYPE { + $&1_ltype temp = new $ltype((const $1_ltype &) $1); + $result = SWIG_Ocaml_ptr_to_val("create_$ntype_from_ptr", (void *)temp, $&1_descriptor); +} + +#else + +%typemap(out) SWIGTYPE { + void *temp = calloc(1,sizeof($ltype)); + memmove(temp, &$1, sizeof($1_type)); + $result = SWIG_Ocaml_ptr_to_val("create_$ntype_from_ptr", temp, $&1_descriptor); +} + +#endif + +%typemap(directorin) SWIGTYPE { + $<ype temp = new $ltype((const $ltype &)$1); + swig_result = SWIG_Ocaml_ptr_to_val("create_$ltype_from_ptr", (void *)temp, $&1_descriptor); + args = caml_list_append(args, swig_result); +} + +%typemap(directorin) SWIGTYPE *, SWIGTYPE [], SWIGTYPE &, SWIGTYPE && { + swig_result = SWIG_Ocaml_ptr_to_val("create_$ltype_from_ptr", (void *)&$1, $&1_descriptor); + args = caml_list_append(args, swig_result); +} + +/* The SIMPLE_MAP macro below defines the whole set of typemaps needed + for simple types. */ + +%define SIMPLE_MAP(C_NAME, C_TO_OCAML, OCAML_TO_C) +/* In */ +%typemap(in) C_NAME { + $1 = OCAML_TO_C($input); +} +%typemap(varin) C_NAME { + $1 = OCAML_TO_C($input); +} +%typemap(in) const C_NAME & ($*1_ltype temp) { + temp = ($*1_ltype) OCAML_TO_C($input); + $1 = &temp; +} +%typemap(varin) const C_NAME & { + $1 = OCAML_TO_C($input); +} +%typemap(directorout) C_NAME { + $1 = OCAML_TO_C($input); +} +/* Out */ +%typemap(out) C_NAME { + $result = C_TO_OCAML($1); +} +%typemap(varout) C_NAME { + $result = C_TO_OCAML($1); +} +%typemap(varout) const C_NAME & { + $result = C_TO_OCAML($1); +} +%typemap(out) const C_NAME & { + $result = C_TO_OCAML(*$1); +} +%typemap(directorin) C_NAME { + args = caml_list_append(args, C_TO_OCAML($1)); +} +%enddef + +SIMPLE_MAP(bool, caml_val_bool, caml_long_val); +SIMPLE_MAP(char, caml_val_char, caml_long_val); +SIMPLE_MAP(signed char, caml_val_char, caml_long_val); +SIMPLE_MAP(unsigned char, caml_val_uchar, caml_long_val); +SIMPLE_MAP(int, caml_val_int, caml_long_val); +SIMPLE_MAP(short, caml_val_short, caml_long_val); +SIMPLE_MAP(wchar_t, caml_val_short, caml_long_val); +SIMPLE_MAP(long, caml_val_long, caml_long_val); +SIMPLE_MAP(ptrdiff_t, caml_val_int, caml_long_val); +SIMPLE_MAP(unsigned int, caml_val_uint, caml_long_val); +SIMPLE_MAP(unsigned short, caml_val_ushort, caml_long_val); +SIMPLE_MAP(unsigned long, caml_val_ulong, caml_long_val); +SIMPLE_MAP(size_t, caml_val_int, caml_long_val); +SIMPLE_MAP(float, caml_val_float, caml_double_val); +SIMPLE_MAP(double, caml_val_double, caml_double_val); +SIMPLE_MAP(long long,caml_val_ulong,caml_long_val); +SIMPLE_MAP(unsigned long long,caml_val_ulong,caml_long_val); + +/* Void */ + +%typemap(out) void "$result = Val_unit;"; + +/* Pass through value */ + +%typemap (in) CAML_VALUE "$1=$input;"; +%typemap (out) CAML_VALUE "$result=$1;"; + +#if 0 +%include +#endif + +/* Handle char arrays as strings */ + +%define %char_ptr_in(how) +%typemap(how) char *, signed char *, unsigned char * { + $1 = ($ltype)caml_string_val($input); +} +/* Again work around the empty array bound bug */ +%typemap(how) char [ANY], signed char [ANY], unsigned char [ANY] { + char *temp = caml_string_val($input); + strcpy((char *)$1,temp); +} +%enddef + +%char_ptr_in(in); +%char_ptr_in(varin); +%char_ptr_in(directorout); + +%define %char_ptr_out(how) +%typemap(how) + char *, signed char *, unsigned char *, + const char *, const signed char *, const unsigned char * { + $result = caml_val_string((char *)$1); +} +/* I'd like to use the length here but can't because it might be empty */ +%typemap(how) + char [ANY], signed char [ANY], unsigned char [ANY], + const char [ANY], const signed char [ANY], const unsigned char [ANY] { + $result = caml_val_string((char *)$1); +} +%enddef + +%char_ptr_out(out); +%char_ptr_out(varout); +%char_ptr_out(directorin); + +%define %swigtype_ptr_in(how) +%typemap(how) SWIGTYPE * { + $1 = ($ltype)caml_ptr_val($input,$1_descriptor); +} +%typemap(how) SWIGTYPE (CLASS::*) { + void *v = caml_ptr_val($input,$1_descriptor); + memcpy(& $1, &v, sizeof(v)); +} +%enddef + +%typemap(out) SWIGTYPE * { + $result = SWIG_Ocaml_ptr_to_val("create_$ntype_from_ptr", (void *)$1, $1_descriptor); +} + +%define %swigtype_ptr_out(how) +%typemap(how) SWIGTYPE (CLASS::*) { + void *v; + memcpy(&v,& $1, sizeof(void *)); + $result = caml_val_ptr (v,$1_descriptor); +} +%enddef + +%swigtype_ptr_in(in); +%swigtype_ptr_in(varin); +%swigtype_ptr_in(directorout); +%swigtype_ptr_out(out); +%swigtype_ptr_out(varout); +%swigtype_ptr_out(directorin); + +%define %swigtype_array_fail(how,msg) +%typemap(how) SWIGTYPE [] { + caml_failwith(msg); +} +%enddef + +%swigtype_array_fail(in,"Array arguments for arbitrary types need a typemap"); +%swigtype_array_fail(varin,"Assignment to global arrays for arbitrary types need a typemap"); +%swigtype_array_fail(out,"Array arguments for arbitrary types need a typemap"); +%swigtype_array_fail(varout,"Array variables need a typemap"); +%swigtype_array_fail(directorin,"Array results with arbitrary types need a typemap"); +%swigtype_array_fail(directorout,"Array arguments with arbitrary types need a typemap"); + +/* C++ References */ + +/* Enums */ +%define %swig_enum_in(how) +%typemap(how) enum SWIGTYPE { + $1 = ($type)caml_long_val_full($input,"$type_marker"); +} +%enddef + +%define %swig_enum_out(how) +%typemap(how) enum SWIGTYPE { + $result = caml_callback2(*caml_named_value(SWIG_MODULE "_int_to_enum"),*caml_named_value("$type_marker"),Val_int((int)$1)); +} +%enddef + +%swig_enum_in(in) +%swig_enum_in(varin) +%swig_enum_in(directorout) +%swig_enum_out(out) +%swig_enum_out(varout) +%swig_enum_out(directorin) + +%typemap(in) (char *STRING, int LENGTH), (char *STRING, size_t LENGTH) { + $1 = ($1_ltype) caml_string_val($input); + $2 = ($2_ltype) caml_string_len($input); +} + +%typemap(out) SWIGTYPE *DYNAMIC, SWIGTYPE &DYNAMIC { + swig_type_info *ty = SWIG_TypeDynamicCast($1_descriptor, (void **)&$1); + $result = SWIG_Ocaml_ptr_to_val("create_$ntype_from_ptr", (void *)$1, ty); +} + +/* Array reference typemaps */ +%apply SWIGTYPE & { SWIGTYPE ((&)[ANY]) } +%apply SWIGTYPE && { SWIGTYPE ((&)[ANY]) } + +/* const pointers */ +%apply SWIGTYPE * { SWIGTYPE *const } +%apply SWIGTYPE (CLASS::*) { SWIGTYPE (CLASS::*const) } +%apply SWIGTYPE & { SWIGTYPE (CLASS::*const&) } diff --git a/Lib/ocaml/ocamlrun.swg b/Lib/ocaml/ocamlrun.swg new file mode 100644 index 000000000..3d552cc50 --- /dev/null +++ b/Lib/ocaml/ocamlrun.swg @@ -0,0 +1,607 @@ +/* -*-c-*- */ + +/* SWIG pointer structure */ + +#include +#include + +#ifdef __cplusplus +extern "C" { +#endif + +#define C_bool 0 +#define C_char 1 +#define C_uchar 2 +#define C_short 3 +#define C_ushort 4 +#define C_int 5 +#define C_uint 6 +#define C_int32 7 +#define C_int64 8 +#define C_float 9 +#define C_double 10 +#define C_ptr 11 +#define C_array 12 +#define C_list 13 +#define C_obj 14 +#define C_string 15 +#define C_enum 16 +#define C_director_core 17 + + +/* Cast a pointer if possible; returns 1 if successful */ + + SWIGINTERN int + SWIG_Cast (void *source, swig_type_info *source_type, + void **ptr, swig_type_info *dest_type) + { + if( !source ) { /* Special case for NULL. This is a popular question + for other modules on the list, so I want an easy way out... */ + *ptr = 0; + return 0; + } + +#ifdef TYPE_CAST_VERBOSE + fprintf( stderr, "Trying to cast %s to %s\n", + source_type ? source_type->str : "", + dest_type ? dest_type->str : "" ); +#endif + if (dest_type != source_type) { + /* We have a type mismatch. Will have to look through our type + mapping table to figure out whether or not we can accept this + datatype. + -- + Ignore typechecks for void *. Allow any conversion. */ + if( !dest_type || !source_type || + !strcmp(dest_type->name,"_p_void") || + !strcmp(source_type->name,"_p_void") ) { + *ptr = source; + return 0; + } else { + swig_cast_info *tc = + SWIG_TypeCheckStruct(source_type, dest_type ); +#ifdef TYPE_CAST_VERBOSE + fprintf( stderr, "Typecheck -> %s\n", + tc ? tc->type->str : "" ); +#endif + if( tc ) { + int newmemory = 0; + *ptr = SWIG_TypeCast(tc, source, &newmemory); + assert(!newmemory); /* newmemory handling not yet implemented */ + return 0; + } else + return -1; + } + } else { + *ptr = source; + return 0; + } + } + +/* Return 0 if successful. */ + SWIGINTERN int + SWIG_GetPtr(void *inptr, void **outptr, + swig_type_info *intype, swig_type_info *outtype) { + if (intype) { + return SWIG_Cast(inptr, intype, + outptr, outtype) == -1; + } else { + *outptr = inptr; + return 0; + } + } + + SWIGINTERN void caml_print_list( CAML_VALUE v ); + + SWIGINTERN void caml_print_val( CAML_VALUE v ) { + switch( SWIG_Tag_val(v) ) { + case C_bool: + if( Bool_val(SWIG_Field(v,0)) ) fprintf( stderr, "true " ); + else fprintf( stderr, "false " ); + break; + case C_char: + case C_uchar: + fprintf( stderr, "'%c' (\\%03d) ", + (Int_val(SWIG_Field(v,0)) >= ' ' && + Int_val(SWIG_Field(v,0)) < 127) ? Int_val(SWIG_Field(v,0)) : '.', + Int_val(SWIG_Field(v,0)) ); + break; + case C_short: + case C_ushort: + case C_int: + fprintf( stderr, "%d ", (int)caml_long_val(v) ); + break; + + case C_uint: + case C_int32: + fprintf( stderr, "%ud ", (unsigned int)caml_long_val(v) ); + break; + case C_int64: + fprintf( stderr, "%ld ", caml_long_val(v) ); + break; + case C_float: + case C_double: + fprintf( stderr, "%f ", caml_double_val(v) ); + break; + + case C_ptr: + { + void *vout = 0; + swig_type_info *ty = (swig_type_info *)(long)SWIG_Int64_val(SWIG_Field(v,1)); + caml_ptr_val_internal(v,&vout,0); + fprintf( stderr, "PTR(%p,%s) ", + vout, + ty ? ty->name : "(null)" ); + } + break; + case C_array: + { + unsigned int i; + for( i = 0; i < Wosize_val( SWIG_Field(v,0) ); i++ ) + caml_print_val( SWIG_Field(SWIG_Field(v,0),i) ); + } + break; + case C_list: + caml_print_list( SWIG_Field(v,0) ); + break; + case C_obj: + fprintf( stderr, "OBJ(%p) ", (void *)SWIG_Field(v,0) ); + break; + case C_string: + { + void *cout; + caml_ptr_val_internal(v,&cout,0); + fprintf( stderr, "'%s' ", (char *)cout ); + } + break; + } + } + + SWIGINTERN void caml_print_list( CAML_VALUE v ) { + CAMLparam1(v); + while( v && Is_block(v) ) { + fprintf( stderr, "[ " ); + caml_print_val( SWIG_Field(v,0) ); + fprintf( stderr, "]\n" ); + v = SWIG_Field(v,1); + } + CAMLreturn0; + } + + SWIGINTERN CAML_VALUE caml_list_nth( CAML_VALUE lst, int n ) { + CAMLparam1(lst); + int i = 0; + while( i < n && lst && Is_block(lst) ) { + i++; lst = SWIG_Field(lst,1); + } + if( lst == Val_unit ) CAMLreturn(Val_unit); + else CAMLreturn(SWIG_Field(lst,0)); + } + + SWIGINTERN CAML_VALUE caml_list_append( CAML_VALUE lst, CAML_VALUE elt ) { + CAMLparam2(lst,elt); + SWIG_CAMLlocal3(v,vt,lh); + lh = Val_unit; + v = Val_unit; + + /* Appending C_void should have no effect */ + if( !Is_block(elt) ) return lst; + + while( lst && Is_block(lst) ) { + if( v && v != Val_unit ) { + vt = caml_alloc_tuple(2); + SWIG_Store_field(v,1,vt); + v = vt; + } else { + v = lh = caml_alloc_tuple(2); + } + SWIG_Store_field(v,0,SWIG_Field(lst,0)); + lst = SWIG_Field(lst,1); + } + + if( v && Is_block(v) ) { + vt = caml_alloc_tuple(2); + SWIG_Store_field(v,1,vt); + v = vt; + } else { + v = lh = caml_alloc_tuple(2); + } + SWIG_Store_field(v,0,elt); + SWIG_Store_field(v,1,Val_unit); + + CAMLreturn(lh); + } + + SWIGINTERN int caml_list_length( CAML_VALUE lst ) { + CAMLparam1(lst); + int i = 0; + while( lst && Is_block(lst) ) { i++; lst = SWIG_Field(lst,1); } + CAMLreturn(i); + } + + SWIGINTERN void caml_array_set( CAML_VALUE arr, int n, CAML_VALUE item ) { + CAMLparam2(arr,item); + SWIG_Store_field(SWIG_Field(arr,0),n,item); + CAMLreturn0; + } + + SWIGINTERN value caml_array_nth( CAML_VALUE arr, int n ) { + CAMLparam1(arr); + if( SWIG_Tag_val(arr) == C_array ) + CAMLreturn(SWIG_Field(SWIG_Field(arr,0),n)); + else if( SWIG_Tag_val(arr) == C_list ) + CAMLreturn(caml_list_nth(arr,0)); + else + caml_failwith("Need array or list"); + } + + SWIGINTERN int caml_array_len( CAML_VALUE arr ) { + CAMLparam1(arr); + if( SWIG_Tag_val(arr) == C_array ) + CAMLreturn(Wosize_val(SWIG_Field(arr,0))); + else if( SWIG_Tag_val(arr) == C_list ) + CAMLreturn(caml_list_length(arr)); + else + caml_failwith("Need array or list"); + } + + SWIGINTERN CAML_VALUE caml_swig_alloc(int x,int y) { + return caml_alloc(x,y); + } + + SWIGINTERN value caml_array_new( int n ) { + CAMLparam0(); + SWIG_CAMLlocal1(vv); + vv = caml_swig_alloc(1,C_array); + SWIG_Store_field(vv,0,caml_alloc_tuple(n)); + CAMLreturn(vv); + } + + SWIGINTERN CAML_VALUE caml_val_bool( int b ) { + CAMLparam0(); + SWIG_CAMLlocal1(bv); + bv = caml_swig_alloc(1,C_bool); + SWIG_Store_field(bv,0,Val_bool(b)); + CAMLreturn(bv); + } + + SWIGINTERN CAML_VALUE caml_val_char( char c ) { + CAMLparam0(); + SWIG_CAMLlocal1(cv); + cv = caml_swig_alloc(1,C_char); + SWIG_Store_field(cv,0,Val_int(c)); + CAMLreturn(cv); + } + + SWIGINTERN CAML_VALUE caml_val_uchar( unsigned char uc ) { + CAMLparam0(); + SWIG_CAMLlocal1(ucv); + ucv = caml_swig_alloc(1,C_uchar); + SWIG_Store_field(ucv,0,Val_int(uc)); + CAMLreturn(ucv); + } + + SWIGINTERN CAML_VALUE caml_val_short( short s ) { + CAMLparam0(); + SWIG_CAMLlocal1(sv); + sv = caml_swig_alloc(1,C_short); + SWIG_Store_field(sv,0,Val_int(s)); + CAMLreturn(sv); + } + + SWIGINTERN CAML_VALUE caml_val_ushort( unsigned short us ) { + CAMLparam0(); + SWIG_CAMLlocal1(usv); + usv = caml_swig_alloc(1,C_ushort); + SWIG_Store_field(usv,0,Val_int(us)); + CAMLreturn(usv); + } + + SWIGINTERN CAML_VALUE caml_val_int( int i ) { + CAMLparam0(); + SWIG_CAMLlocal1(iv); + iv = caml_swig_alloc(1,C_int); + SWIG_Store_field(iv,0,Val_int(i)); + CAMLreturn(iv); + } + + SWIGINTERN CAML_VALUE caml_val_uint( unsigned int ui ) { + CAMLparam0(); + SWIG_CAMLlocal1(uiv); + uiv = caml_swig_alloc(1,C_int); + SWIG_Store_field(uiv,0,Val_int(ui)); + CAMLreturn(uiv); + } + + SWIGINTERN CAML_VALUE caml_val_long( long l ) { + CAMLparam0(); + SWIG_CAMLlocal1(lv); + lv = caml_swig_alloc(1,C_int64); + SWIG_Store_field(lv,0,caml_copy_int64(l)); + CAMLreturn(lv); + } + + SWIGINTERN CAML_VALUE caml_val_ulong( unsigned long ul ) { + CAMLparam0(); + SWIG_CAMLlocal1(ulv); + ulv = caml_swig_alloc(1,C_int64); + SWIG_Store_field(ulv,0,caml_copy_int64(ul)); + CAMLreturn(ulv); + } + + SWIGINTERN CAML_VALUE caml_val_float( float f ) { + CAMLparam0(); + SWIG_CAMLlocal1(fv); + fv = caml_swig_alloc(1,C_float); + SWIG_Store_field(fv,0,caml_copy_double((double)f)); + CAMLreturn(fv); + } + + SWIGINTERN CAML_VALUE caml_val_double( double d ) { + CAMLparam0(); + SWIG_CAMLlocal1(fv); + fv = caml_swig_alloc(1,C_double); + SWIG_Store_field(fv,0,caml_copy_double(d)); + CAMLreturn(fv); + } + + SWIGINTERN CAML_VALUE caml_val_ptr( void *p, swig_type_info *info ) { + CAMLparam0(); + SWIG_CAMLlocal1(vv); + vv = caml_swig_alloc(2,C_ptr); + SWIG_Store_field(vv,0,caml_copy_int64((long)p)); + SWIG_Store_field(vv,1,caml_copy_int64((long)info)); + CAMLreturn(vv); + } + + SWIGINTERN CAML_VALUE caml_val_string( const char *p ) { + CAMLparam0(); + SWIG_CAMLlocal1(vv); + if( !p ) CAMLreturn(caml_val_ptr( (void *)p, 0 )); + vv = caml_swig_alloc(1,C_string); + SWIG_Store_field(vv,0,caml_copy_string(p)); + CAMLreturn(vv); + } + + SWIGINTERN CAML_VALUE caml_val_string_len( const char *p, int len ) { + CAMLparam0(); + SWIG_CAMLlocal1(vv); + if( !p || len < 0 ) CAMLreturn(caml_val_ptr( (void *)p, 0 )); + vv = caml_swig_alloc(1,C_string); + SWIG_Store_field(vv,0,caml_alloc_string(len)); + memcpy(String_val(SWIG_Field(vv,0)),p,len); + CAMLreturn(vv); + } + + #define caml_val_obj(v, name) caml_val_obj_helper(v, SWIG_TypeQuery((name)), name) + SWIGINTERN CAML_VALUE caml_val_obj_helper( void *v, swig_type_info *type, char *name) { + CAMLparam0(); + CAMLreturn(caml_callback2(*caml_named_value("caml_create_object_fn"), + caml_val_ptr(v,type), + caml_copy_string(name))); + } + + SWIGINTERN long caml_long_val_full( CAML_VALUE v, const char *name ) { + CAMLparam1(v); + if( !Is_block(v) ) return 0; + + switch( SWIG_Tag_val(v) ) { + case C_bool: + case C_char: + case C_uchar: + case C_short: + case C_ushort: + case C_int: + CAMLreturn(Int_val(SWIG_Field(v,0))); + case C_uint: + case C_int32: + CAMLreturn(Int32_val(SWIG_Field(v,0))); + case C_int64: + CAMLreturn((long)SWIG_Int64_val(SWIG_Field(v,0))); + case C_float: + case C_double: + CAMLreturn((long)Double_val(SWIG_Field(v,0))); + case C_string: + CAMLreturn((long)String_val(SWIG_Field(v,0))); + case C_ptr: + CAMLreturn((long)SWIG_Int64_val(SWIG_Field(SWIG_Field(v,0),0))); + case C_enum: { + SWIG_CAMLlocal1(ret); + CAML_VALUE *enum_to_int = caml_named_value(SWIG_MODULE "_enum_to_int"); + if( !name ) caml_failwith( "Not an enum conversion" ); + ret = caml_callback2(*enum_to_int,*caml_named_value(name),v); + CAMLreturn(caml_long_val(ret)); + } + default: + caml_failwith("No conversion to int"); + } + } + + SWIGINTERN long caml_long_val( CAML_VALUE v ) { + return caml_long_val_full(v,0); + } + + SWIGINTERN double caml_double_val( CAML_VALUE v ) { + CAMLparam1(v); + if( !Is_block(v) ) return 0.0; + switch( SWIG_Tag_val(v) ) { + case C_bool: + case C_char: + case C_uchar: + case C_short: + case C_ushort: + case C_int: + CAMLreturn_type(Int_val(SWIG_Field(v,0))); + case C_uint: + case C_int32: + CAMLreturn_type(Int32_val(SWIG_Field(v,0))); + case C_int64: + CAMLreturn_type(SWIG_Int64_val(SWIG_Field(v,0))); + case C_float: + case C_double: + CAMLreturn_type(Double_val(SWIG_Field(v,0))); + default: + fprintf( stderr, "Unknown block tag %d\n", SWIG_Tag_val(v) ); + caml_failwith("No conversion to double"); + } + } + + SWIGINTERN int caml_ptr_val_internal( CAML_VALUE v, void **out, + swig_type_info *descriptor ) { + CAMLparam1(v); + void *outptr = NULL; + swig_type_info *outdescr = NULL; + static CAML_VALUE *func_val = NULL; + + if( v == Val_unit ) { + *out = 0; + CAMLreturn_type(0); + } + if( !Is_block(v) ) return -1; + switch( SWIG_Tag_val(v) ) { + case C_obj: + if (!func_val) { + func_val = caml_named_value("caml_obj_ptr"); + } + CAMLreturn_type(caml_ptr_val_internal(caml_callback(*func_val, v), out, descriptor)); + case C_string: + outptr = (void *)String_val(SWIG_Field(v,0)); + break; + case C_ptr: + outptr = (void *)(long)SWIG_Int64_val(SWIG_Field(v,0)); + outdescr = (swig_type_info *)(long)SWIG_Int64_val(SWIG_Field(v,1)); + break; + default: + *out = 0; + CAMLreturn_type(1); + break; + } + + CAMLreturn_type(SWIG_GetPtr(outptr, out, outdescr, descriptor)); + } + + SWIGINTERN void *caml_ptr_val( CAML_VALUE v, swig_type_info *descriptor ) { + CAMLparam0(); +#ifdef TYPE_CAST_VERBOSE + caml_print_val( v ); +#endif + void *out = NULL; + if( !caml_ptr_val_internal( v, &out, descriptor ) ) + CAMLreturn_type(out); + else + caml_failwith( "No appropriate conversion found." ); + } + + SWIGINTERN char *caml_string_val( CAML_VALUE v ) { + return (char *)caml_ptr_val( v, 0 ); + } + + SWIGINTERN int caml_string_len( CAML_VALUE v ) { + switch( SWIG_Tag_val(v) ) { + case C_string: + return caml_string_length(SWIG_Field(v,0)); + default: + return strlen((char *)caml_ptr_val(v,0)); + } + } + + SWIGINTERN int caml_bool_check( CAML_VALUE v ) { + CAMLparam1(v); + + if( !Is_block(v) ) return 0; + + switch( SWIG_Tag_val(v) ) { + case C_bool: + case C_ptr: + case C_string: + CAMLreturn(1); + default: + CAMLreturn(0); + } + } + + SWIGINTERN int caml_int_check( CAML_VALUE v ) { + CAMLparam1(v); + + if( !Is_block(v) ) return 0; + + switch( SWIG_Tag_val(v) ) { + case C_char: + case C_uchar: + case C_short: + case C_ushort: + case C_int: + case C_uint: + case C_int32: + case C_int64: + CAMLreturn(1); + + default: + CAMLreturn(0); + } + } + + SWIGINTERN int caml_float_check( CAML_VALUE v ) { + CAMLparam1(v); + if( !Is_block(v) ) return 0; + + switch( SWIG_Tag_val(v) ) { + case C_float: + case C_double: + CAMLreturn(1); + + default: + CAMLreturn(0); + } + } + + SWIGINTERN int caml_ptr_check( CAML_VALUE v ) { + CAMLparam1(v); + if( !Is_block(v) ) return 0; + + switch( SWIG_Tag_val(v) ) { + case C_string: + case C_ptr: + case C_int64: + CAMLreturn(1); + + default: + CAMLreturn(0); + } + } + + SWIGINTERN CAML_VALUE SWIG_Ocaml_ptr_to_val(const char *name, void *ptr, swig_type_info *descriptor) { + CAMLparam0(); + SWIG_CAMLlocal1(result); + + CAML_VALUE *fromval = caml_named_value(name); + if (fromval) { + result = caml_callback(*fromval, caml_val_ptr(ptr, descriptor)); + } else { + result = caml_val_ptr(ptr, descriptor); + } + CAMLreturn(result); + } + + static swig_module_info *SWIG_Ocaml_GetModule(void *SWIGUNUSEDPARM(clientdata)) { + CAML_VALUE pointer; + + pointer = caml_callback(*caml_named_value("swig_find_type_info"), caml_val_int(0)); + if (Is_block(pointer) && SWIG_Tag_val(pointer) == C_ptr) { + return (swig_module_info *)(void *)(long)SWIG_Int64_val(SWIG_Field(pointer,0)); + } + return 0; + } + + static void SWIG_Ocaml_SetModule(swig_module_info *pointer) { + CAML_VALUE mod_pointer; + + mod_pointer = caml_val_ptr(pointer, NULL); + caml_callback(*caml_named_value("swig_set_type_info"), mod_pointer); + } + +#ifdef __cplusplus +} +#endif +#undef value + diff --git a/Lib/ocaml/ocamldec.swg b/Lib/ocaml/ocamlrundec.swg similarity index 99% rename from Lib/ocaml/ocamldec.swg rename to Lib/ocaml/ocamlrundec.swg index 0c2faf771..555f9a44f 100644 --- a/Lib/ocaml/ocamldec.swg +++ b/Lib/ocaml/ocamlrundec.swg @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * ocamldec.swg + * ocamlrundec.swg * * Ocaml runtime code -- declarations * ----------------------------------------------------------------------------- */ diff --git a/Lib/ocaml/typemaps.i b/Lib/ocaml/typemaps.i index 23e2955fb..39231e221 100644 --- a/Lib/ocaml/typemaps.i +++ b/Lib/ocaml/typemaps.i @@ -1,321 +1,44 @@ -/* ----------------------------------------------------------------------------- +/* ---------------------------------------------------------------------------- * typemaps.i * - * The Ocaml module handles all types uniformly via typemaps. Here - * are the definitions. - * ----------------------------------------------------------------------------- */ + * These typemaps provide support for input/output arguments for C/C++ pointers + * and C++ references. +* ---------------------------------------------------------------------------- */ -/* Pointers */ - -%typemap(in) void "" - -%typemap(out) void "$result = Val_int(0);" - -%typemap(in) void * { - $1 = caml_ptr_val($input,$descriptor); -} - -%typemap(varin) void * { - $1 = ($ltype)caml_ptr_val($input,$descriptor); -} - -%typemap(out) void * { - $result = caml_val_ptr($1,$descriptor); -} - -%typemap(varout) void * { - $result = caml_val_ptr($1,$descriptor); -} - -%typemap(in) char *& (char *temp) { - temp = (char*)caml_val_ptr($1,$descriptor); +%define INPUT_OUTPUT_INOUT_TYPEMAPS(type, c_to_ocaml, ocaml_to_c) +%typemap(in) type *INPUT(type temp), type &INPUT(type temp) { + temp = (type)ocaml_to_c($input); $1 = &temp; } +%typemap(typecheck) type *INPUT = type; +%typemap(typecheck) type &INPUT = type; -%typemap(argout) char *& { - swig_result = caml_list_append(swig_result,caml_val_string_len(*$1, strlen(*$1))); +%typemap(in, numinputs=0) type *OUTPUT($*1_ltype temp), type &OUTPUT($*1_ltype temp) "$1 = &temp;" +%typemap(argout) type *OUTPUT, type &OUTPUT { + swig_result = caml_list_append(swig_result, c_to_ocaml(*$1)); } +%typemap(in) type *INOUT = type *INPUT; +%typemap(in) type &INOUT = type &INPUT; -%typemap(in) SWIGTYPE & { - $1 = ($ltype) caml_ptr_val($input,$1_descriptor); -} +%typemap(argout) type *INOUT = type *OUTPUT; +%typemap(argout) type &INOUT = type &OUTPUT; -%typemap(in) SWIGTYPE && { - $1 = ($ltype) caml_ptr_val($input,$1_descriptor); -} - -%typemap(varin) SWIGTYPE & { - $1 = *(($ltype) caml_ptr_val($input,$1_descriptor)); -} - -%typemap(varin) SWIGTYPE && { - $1 = *(($ltype) caml_ptr_val($input,$1_descriptor)); -} - -%typemap(varout) SWIGTYPE &, SWIGTYPE && { - $result = SWIG_Ocaml_ptr_to_val("create_$ntype_from_ptr", (void *)&$1, $1_descriptor); -} - -%typemap(out) SWIGTYPE &, SWIGTYPE && { - $result = SWIG_Ocaml_ptr_to_val("create_$ntype_from_ptr", (void *)$1, $1_descriptor); -} - -#if 0 -%typemap(argout) SWIGTYPE & { - CAML_VALUE *fromval = caml_named_value("create_$ntype_from_ptr"); - if( fromval ) { - swig_result = - caml_list_append(swig_result, - caml_callback(*fromval,caml_val_ptr((void *) $1, - $1_descriptor))); - } else { - swig_result = - caml_list_append(swig_result, - caml_val_ptr ((void *) $1,$1_descriptor)); - } -} -%typemap(argout) SWIGTYPE && { - CAML_VALUE *fromval = caml_named_value("create_$ntype_from_ptr"); - if( fromval ) { - swig_result = - caml_list_append(swig_result, - caml_callback(*fromval,caml_val_ptr((void *) $1, - $1_descriptor))); - } else { - swig_result = - caml_list_append(swig_result, - caml_val_ptr ((void *) $1,$1_descriptor)); - } -} -#endif - -%typemap(in) SWIGTYPE { - $1 = *(($&1_ltype) caml_ptr_val($input,$&1_descriptor)) ; -} - -#ifdef __cplusplus - -%typemap(out) SWIGTYPE { - $&1_ltype temp = new $ltype((const $1_ltype &) $1); - $result = SWIG_Ocaml_ptr_to_val("create_$ntype_from_ptr", (void *)temp, $&1_descriptor); -} - -#else - -%typemap(out) SWIGTYPE { - void *temp = calloc(1,sizeof($ltype)); - memmove(temp, &$1, sizeof($1_type)); - $result = SWIG_Ocaml_ptr_to_val("create_$ntype_from_ptr", temp, $&1_descriptor); -} - -#endif - -%typemap(directorin) SWIGTYPE { - $<ype temp = new $ltype((const $ltype &)$1); - swig_result = SWIG_Ocaml_ptr_to_val("create_$ltype_from_ptr", (void *)temp, $&1_descriptor); - args = caml_list_append(args, swig_result); -} - -%typemap(directorin) SWIGTYPE *, SWIGTYPE [], SWIGTYPE &, SWIGTYPE && { - swig_result = SWIG_Ocaml_ptr_to_val("create_$ltype_from_ptr", (void *)&$1, $&1_descriptor); - args = caml_list_append(args, swig_result); -} - -/* The SIMPLE_MAP macro below defines the whole set of typemaps needed - for simple types. */ - -%define SIMPLE_MAP(C_NAME, C_TO_OCAML, OCAML_TO_C) -/* In */ -%typemap(in) C_NAME { - $1 = OCAML_TO_C($input); -} -%typemap(varin) C_NAME { - $1 = OCAML_TO_C($input); -} -%typemap(in) const C_NAME & ($*1_ltype temp) { - temp = ($*1_ltype) OCAML_TO_C($input); - $1 = &temp; -} -%typemap(varin) const C_NAME & { - $1 = OCAML_TO_C($input); -} -%typemap(directorout) C_NAME { - $1 = OCAML_TO_C($input); -} -%typemap(in) C_NAME *INPUT ($*1_ltype temp) { - temp = ($*1_ltype) OCAML_TO_C($input); - $1 = &temp; -} -%typemap(in,numinputs=0) C_NAME *OUTPUT ($*1_ltype temp) { - $1 = &temp; -} -/* Out */ -%typemap(out) C_NAME { - $result = C_TO_OCAML($1); -} -%typemap(varout) C_NAME { - $result = C_TO_OCAML($1); -} -%typemap(varout) const C_NAME & { - $result = C_TO_OCAML($1); -} -%typemap(argout) C_NAME *OUTPUT { - swig_result = caml_list_append(swig_result, C_TO_OCAML((long)*$1)); -} -%typemap(out) const C_NAME & { - $result = C_TO_OCAML(*$1); -} -%typemap(directorin) C_NAME { - args = caml_list_append(args, C_TO_OCAML($1)); -} +%typemap(typecheck) type *INOUT = type; +%typemap(typecheck) type &INOUT = type; %enddef -SIMPLE_MAP(bool, caml_val_bool, caml_long_val); -SIMPLE_MAP(char, caml_val_char, caml_long_val); -SIMPLE_MAP(signed char, caml_val_char, caml_long_val); -SIMPLE_MAP(unsigned char, caml_val_uchar, caml_long_val); -SIMPLE_MAP(int, caml_val_int, caml_long_val); -SIMPLE_MAP(short, caml_val_short, caml_long_val); -SIMPLE_MAP(wchar_t, caml_val_short, caml_long_val); -SIMPLE_MAP(long, caml_val_long, caml_long_val); -SIMPLE_MAP(ptrdiff_t, caml_val_int, caml_long_val); -SIMPLE_MAP(unsigned int, caml_val_uint, caml_long_val); -SIMPLE_MAP(unsigned short, caml_val_ushort, caml_long_val); -SIMPLE_MAP(unsigned long, caml_val_ulong, caml_long_val); -SIMPLE_MAP(size_t, caml_val_int, caml_long_val); -SIMPLE_MAP(float, caml_val_float, caml_double_val); -SIMPLE_MAP(double, caml_val_double, caml_double_val); -SIMPLE_MAP(long long,caml_val_ulong,caml_long_val); -SIMPLE_MAP(unsigned long long,caml_val_ulong,caml_long_val); - -/* Void */ - -%typemap(out) void "$result = Val_unit;"; - -/* Pass through value */ - -%typemap (in) CAML_VALUE "$1=$input;"; -%typemap (out) CAML_VALUE "$result=$1;"; - -#if 0 -%include -#endif - -/* Handle char arrays as strings */ - -%define %char_ptr_in(how) -%typemap(how) char *, signed char *, unsigned char * { - $1 = ($ltype)caml_string_val($input); -} -/* Again work around the empty array bound bug */ -%typemap(how) char [ANY], signed char [ANY], unsigned char [ANY] { - char *temp = caml_string_val($input); - strcpy((char *)$1,temp); -} -%enddef - -%char_ptr_in(in); -%char_ptr_in(varin); -%char_ptr_in(directorout); - -%define %char_ptr_out(how) -%typemap(how) - char *, signed char *, unsigned char *, - const char *, const signed char *, const unsigned char * { - $result = caml_val_string((char *)$1); -} -/* I'd like to use the length here but can't because it might be empty */ -%typemap(how) - char [ANY], signed char [ANY], unsigned char [ANY], - const char [ANY], const signed char [ANY], const unsigned char [ANY] { - $result = caml_val_string((char *)$1); -} -%enddef - -%char_ptr_out(out); -%char_ptr_out(varout); -%char_ptr_out(directorin); - -%define %swigtype_ptr_in(how) -%typemap(how) SWIGTYPE * { - $1 = ($ltype)caml_ptr_val($input,$1_descriptor); -} -%typemap(how) SWIGTYPE (CLASS::*) { - void *v = caml_ptr_val($input,$1_descriptor); - memcpy(& $1, &v, sizeof(v)); -} -%enddef - -%typemap(out) SWIGTYPE * { - $result = SWIG_Ocaml_ptr_to_val("create_$ntype_from_ptr", (void *)$1, $1_descriptor); -} - -%define %swigtype_ptr_out(how) -%typemap(how) SWIGTYPE (CLASS::*) { - void *v; - memcpy(&v,& $1, sizeof(void *)); - $result = caml_val_ptr (v,$1_descriptor); -} -%enddef - -%swigtype_ptr_in(in); -%swigtype_ptr_in(varin); -%swigtype_ptr_in(directorout); -%swigtype_ptr_out(out); -%swigtype_ptr_out(varout); -%swigtype_ptr_out(directorin); - -%define %swigtype_array_fail(how,msg) -%typemap(how) SWIGTYPE [] { - caml_failwith(msg); -} -%enddef - -%swigtype_array_fail(in,"Array arguments for arbitrary types need a typemap"); -%swigtype_array_fail(varin,"Assignment to global arrays for arbitrary types need a typemap"); -%swigtype_array_fail(out,"Array arguments for arbitrary types need a typemap"); -%swigtype_array_fail(varout,"Array variables need a typemap"); -%swigtype_array_fail(directorin,"Array results with arbitrary types need a typemap"); -%swigtype_array_fail(directorout,"Array arguments with arbitrary types need a typemap"); - -/* C++ References */ - -/* Enums */ -%define %swig_enum_in(how) -%typemap(how) enum SWIGTYPE { - $1 = ($type)caml_long_val_full($input,"$type_marker"); -} -%enddef - -%define %swig_enum_out(how) -%typemap(how) enum SWIGTYPE { - $result = caml_callback2(*caml_named_value(SWIG_MODULE "_int_to_enum"),*caml_named_value("$type_marker"),Val_int((int)$1)); -} -%enddef - -%swig_enum_in(in) -%swig_enum_in(varin) -%swig_enum_in(directorout) -%swig_enum_out(out) -%swig_enum_out(varout) -%swig_enum_out(directorin) - -%typemap(in) (char *STRING, int LENGTH), (char *STRING, size_t LENGTH) { - $1 = ($1_ltype) caml_string_val($input); - $2 = ($2_ltype) caml_string_len($input); -} - -%typemap(out) SWIGTYPE *DYNAMIC, SWIGTYPE &DYNAMIC { - swig_type_info *ty = SWIG_TypeDynamicCast($1_descriptor, (void **)&$1); - $result = SWIG_Ocaml_ptr_to_val("create_$ntype_from_ptr", (void *)$1, ty); -} - -/* Array reference typemaps */ -%apply SWIGTYPE & { SWIGTYPE ((&)[ANY]) } -%apply SWIGTYPE && { SWIGTYPE ((&)[ANY]) } - -/* const pointers */ -%apply SWIGTYPE * { SWIGTYPE *const } -%apply SWIGTYPE (CLASS::*) { SWIGTYPE (CLASS::*const) } -%apply SWIGTYPE & { SWIGTYPE (CLASS::*const&) } - +INPUT_OUTPUT_INOUT_TYPEMAPS(bool, caml_val_bool, caml_long_val); +INPUT_OUTPUT_INOUT_TYPEMAPS(int, caml_val_int, caml_long_val); +INPUT_OUTPUT_INOUT_TYPEMAPS(long, caml_val_long, caml_long_val); +INPUT_OUTPUT_INOUT_TYPEMAPS(short, caml_val_int, caml_long_val); +INPUT_OUTPUT_INOUT_TYPEMAPS(char, caml_val_char, caml_long_val); +INPUT_OUTPUT_INOUT_TYPEMAPS(signed char, caml_val_char, caml_long_val); +INPUT_OUTPUT_INOUT_TYPEMAPS(float, caml_val_float, caml_double_val); +INPUT_OUTPUT_INOUT_TYPEMAPS(double, caml_val_double, caml_double_val); +INPUT_OUTPUT_INOUT_TYPEMAPS(unsigned int, caml_val_uint, caml_long_val); +INPUT_OUTPUT_INOUT_TYPEMAPS(unsigned long, caml_val_ulong, caml_long_val); +INPUT_OUTPUT_INOUT_TYPEMAPS(unsigned short, caml_val_ushort, caml_long_val); +INPUT_OUTPUT_INOUT_TYPEMAPS(unsigned char, caml_val_uchar, caml_long_val); +INPUT_OUTPUT_INOUT_TYPEMAPS(long long, caml_val_long, caml_long_val); +INPUT_OUTPUT_INOUT_TYPEMAPS(unsigned long long, caml_val_ulong, caml_long_val); +#undef INPUT_OUTPUT_INOUT_TYPEMAPS diff --git a/Source/Modules/ocaml.cxx b/Source/Modules/ocaml.cxx index 7e59def7f..ad9c94800 100644 --- a/Source/Modules/ocaml.cxx +++ b/Source/Modules/ocaml.cxx @@ -1866,9 +1866,9 @@ public: } String *runtimeCode() { - String *s = Swig_include_sys("ocaml.swg"); + String *s = Swig_include_sys("ocamlrun.swg"); if (!s) { - Printf(stderr, "*** Unable to open 'ocaml.swg'\n"); + Printf(stderr, "*** Unable to open 'ocamlrun.swg'\n"); s = NewString(""); } return s;