Initial commit of OpenSPARC T2 architecture model.
[OpenSPARC-T2-SAM] / sam-t2 / devtools / v8plus / share / swig / 1.3.26 / ocaml / carray.i
CommitLineData
920dae64
AT
1%insert(mli) %{
2type _value = c_obj
3%}
4
5%insert(ml) %{
6type _value = c_obj
7%}
8
9%define %array_tmap_out(type,what,out_f)
10%typemap(type) what [ANY] {
11 int i;
12 /* $*1_type */
13 $result = caml_array_new($1_dim0);
14 for( i = 0; i < $1_dim0; i++ ) {
15 caml_array_set($result,i,out_f($1[i]));
16 }
17}
18%enddef
19
20%define %array_tmap_in(type,what,in_f)
21%typemap(type) what [ANY] {
22 int i;
23 /* $*1_type */
24 $1 = ($*1_type *)malloc( $1_size );
25 for( i = 0; i < $1_dim0 && i < caml_array_len($input); i++ ) {
26 $1[i] = in_f(caml_array_nth($input,i));
27 }
28}
29
30%typemap(free) what [ANY] {
31 free( (void *)$1 );
32}
33%enddef
34
35%define %make_simple_array_typemap(type,out_f,in_f)
36%array_tmap_out(out,type,out_f);
37%array_tmap_out(varout,type,out_f);
38%array_tmap_out(directorin,type,out_f);
39
40%array_tmap_in(in,type,in_f);
41%array_tmap_in(varin,type,in_f);
42%array_tmap_in(directorout,type,in_f);
43%enddef
44
45%make_simple_array_typemap(bool,caml_val_bool,caml_long_val);
46%make_simple_array_typemap(short,caml_val_short,caml_long_val);
47%make_simple_array_typemap(unsigned short,caml_val_ushort,caml_long_val);
48%make_simple_array_typemap(int,caml_val_int,caml_long_val);
49%make_simple_array_typemap(unsigned int,caml_val_uint,caml_long_val);
50%make_simple_array_typemap(long,caml_val_long,caml_long_val);
51%make_simple_array_typemap(unsigned long,caml_val_ulong,caml_long_val);
52%make_simple_array_typemap(size_t,caml_val_int,caml_long_val);
53%make_simple_array_typemap(float,caml_val_float,caml_double_val);
54%make_simple_array_typemap(double,caml_val_double,caml_double_val);
55
56#ifdef __cplusplus
57%typemap(in) SWIGTYPE [] {
58 int i;
59
60 /* $*1_type */
61 $1 = new $*1_type [$1_dim0];
62 for( i = 0; i < $1_dim0 && i < caml_array_len($input); i++ ) {
63 $1[i] = *(($*1_ltype *)
64 caml_ptr_val(caml_array_nth($input,i),
65 $*1_descriptor)) ;
66 }
67}
68#else
69%typemap(in) SWIGTYPE [] {
70 int i;
71
72 /* $*1_type */
73 $1 = ($*1_type *)malloc( $1_size );
74 for( i = 0; i < $1_dim0 && i < caml_array_len($input); i++ ) {
75 $1[i] = *(($*1_ltype)
76 caml_ptr_val(caml_array_nth($input),
77 $*1_descriptor));
78 }
79}
80#endif
81
82%typemap(out) SWIGTYPE [] {
83 int i;
84 CAML_VALUE *fromval = caml_named_value("create_$ntype_from_ptr");
85 $result = caml_array_new($1_dim0);
86
87 for( i = 0; i < $1_dim0; i++ ) {
88 if( fromval ) {
89 caml_array_set
90 ($result,
91 i,
92 callback(*fromval,caml_val_ptr((void *)&$1[i],$*1_descriptor)));
93 } else {
94 caml_array_set
95 ($result,
96 i,
97 caml_val_ptr ((void *)&$1[i],$&1_descriptor));
98 }
99 }
100}
101
102%typemap(in) enum SWIGTYPE [] {
103 int i;
104
105 /* $*1_type */
106 $1 = ($*1_type *)malloc( $1_size );
107 for( i = 0; i < $1_dim0 && i < caml_array_len($input); i++ ) {
108 $1[i] = ($type)
109 caml_long_val_full(caml_array_nth($input),
110 "$type_marker");
111 }
112}
113
114%typemap(out) enum SWIGTYPE [] {
115 int i;
116 $result = caml_array_new($1_dim0);
117
118 for( i = 0; i < $1_dim0; i++ ) {
119 caml_array_set
120 ($result,
121 i,
122 callback2(*caml_named_value(SWIG_MODULE "_int_to_enum"),
123 *caml_named_value("$type_marker"),
124 Val_int($1[i])));
125 }
126}
127
128#ifdef __cplusplus
129%typemap(freearg) SWIGTYPE [ANY] {
130 delete [] $1;
131}
132#else
133%typemap(freearg) SWIGTYPE [ANY] {
134 free( (void *)$1 );
135}
136#endif