perl 5.0 alpha 8
[p5sagit/p5-mst-13.2.git] / ext / typemap
CommitLineData
93a17b20 1# $Header$
2# basic C types
3int T_INT
4unsigned T_U_INT
5unsigned int T_U_INT
6long T_LONG
7unsigned long T_U_LONG
8short T_SHORT
9unsigned short T_U_SHORT
10char T_CHAR
11char * T_STRING
12unsigned char * T_STRING
13caddr_t T_STRING
14unsigned long * T_OPAQUEPTR
15char ** T_PACKED
16void * T_PTR
2304df62 17SV * T_SV
18SV * T_SVOBJ
19AV * T_AVOBJ
20HV * T_HVOBJ
21CV * T_CVOBJ
93a17b20 22
23I32 T_LONG
24I16 T_SHORT
25U32 T_U_LONG
26U16 T_U_SHORT
27Result T_U_CHAR
28Boolean T_U_CHAR
29double T_DOUBLE
2304df62 30SysRet T_SYSRET
93a17b20 31
8990e307 32#############################################################################
33INPUT
2304df62 34T_SV
35 $var = $arg;
36T_SVOBJ
37 if (sv_isa($arg, \"${ntype}\"))
38 $var = (AV*)SvRV($arg);
39 else
40 croak(\"$var is not of type ${ntype}\")
41T_AVOBJ
42 if (sv_isa($arg, \"${ntype}\"))
43 $var = (AV*)SvRV($arg);
44 else
45 croak(\"$var is not of type ${ntype}\")
46T_HVOBJ
47 if (sv_isa($arg, \"${ntype}\"))
48 $var = (HV*)SvRV($arg);
49 else
50 croak(\"$var is not of type ${ntype}\")
51T_CVOBJ
52 if (sv_isa($arg, \"${ntype}\"))
53 $var = (CV*)SvRV($arg);
54 else
55 croak(\"$var is not of type ${ntype}\")
56T_SYSRET
57 $var NOT IMPLEMENTED
8990e307 58T_INT
59 $var = (int)SvIV($arg)
60T_ENUM
61 $var = ($type)SvIV($arg)
62T_U_INT
63 $var = (unsigned int)SvIV($arg)
64T_SHORT
65 $var = (short)SvIV($arg)
66T_U_SHORT
67 $var = (unsigned short)SvIV($arg)
68T_LONG
69 $var = (long)SvIV($arg)
70T_U_LONG
71 $var = (unsigned long)SvIV($arg)
72T_CHAR
73 $var = (char)*SvPV($arg,na)
74T_U_CHAR
75 $var = (unsigned char)SvIV($arg)
76T_FLOAT
77 $var = (float)SvNV($arg)
78T_DOUBLE
79 $var = SvNV($arg)
80T_STRING
81 $var = SvPV($arg,na)
82T_PTR
83 $var = ($type)(unsigned long)SvNV($arg)
84T_PTRREF
85 if (SvROK($arg))
86 $var = ($type)(unsigned long)SvNV((SV*)SvRV($arg));
87 else
88 croak(\"$var is not a reference\")
89T_PTROBJ
90 if (sv_isa($arg, \"${ntype}\"))
91 $var = ($type)(unsigned long)SvNV((SV*)SvRV($arg));
92 else
93 croak(\"$var is not of type ${ntype}\")
94T_PTRDESC
95 if (sv_isa($arg, \"${ntype}\")) {
96 ${type}_desc = (\U${type}_DESC\E*)(unsigned long)SvNV((SV*)SvRV($arg));
97 $var = ${type}_desc->ptr;
98 }
99 else
100 croak(\"$var is not of type ${ntype}\")
101T_REFREF
102 if (SvROK($arg))
103 $var = *($type)(unsigned long)SvNV((SV*)SvRV($arg));
104 else
105 croak(\"$var is not a reference\")
106T_REFOBJ
107 if (sv_isa($arg, \"${ntype}\"))
108 $var = *($type)(unsigned long)SvNV((SV*)SvRV($arg));
109 else
110 croak(\"$var is not of type ${ntype}\")
111T_OPAQUE
112 $var NOT IMPLEMENTED
113T_OPAQUEPTR
114 $var = ($type)SvPV($arg,na)
115T_PACKED
116 $var = XS_unpack_$ntype($arg)
117T_PACKEDARRAY
118 $var = XS_unpack_$ntype($arg)
119T_CALLBACK
120 $var = make_perl_cb_$type($arg)
121T_ARRAY
122 $var = $ntype(items -= $argoff);
123 U32 ix_$var = $argoff;
124 while (items--) {
125 DO_ARRAY_ELEM;
126 }
127#############################################################################
128OUTPUT
2304df62 129T_SV
130 $arg = $var;
131T_SVOBJ
132 $arg = newRV((SV*)$var);
133T_AVOBJ
134 $arg = newRV((SV*)$var);
135T_HVOBJ
136 $arg = newRV((SV*)$var);
137T_CVOBJ
138 $arg = newRV((SV*)$var);
8990e307 139T_INT
140 sv_setiv($arg, (I32)$var);
2304df62 141T_SYSRET
142 if ($var != -1) {
143 if ($var == 0)
144 sv_setpvn($arg, "0 but true", 10);
145 else
146 sv_setiv($arg, (I32)$var);
147 }
8990e307 148T_ENUM
149 sv_setiv($arg, (I32)$var);
150T_U_INT
151 sv_setiv($arg, (I32)$var);
152T_SHORT
153 sv_setiv($arg, (I32)$var);
154T_U_SHORT
155 sv_setiv($arg, (I32)$var);
156T_LONG
157 sv_setiv($arg, (I32)$var);
158T_U_LONG
159 sv_setiv($arg, (I32)$var);
160T_CHAR
161 sv_setpvn($arg, (char *)&$var, 1);
162T_U_CHAR
163 sv_setiv($arg, (I32)$var);
164T_FLOAT
165 sv_setnv($arg, (double)$var);
166T_DOUBLE
167 sv_setnv($arg, $var);
168T_STRING
169 sv_setpv($arg, $var);
170T_PTR
171 sv_setnv($arg, (double)(unsigned long)$var);
172T_PTRREF
173 sv_setptrref($arg, $var);
174T_PTROBJ
175 sv_setptrobj($arg, $var, \"${ntype}\");
176T_PTRDESC
177 sv_setptrobj($arg, (void*)new\U${type}_DESC\E($var), \"${ntype}\");
178T_REFREF
179 sv_setrefref($arg, \"${ntype}\", XS_service_$ntype,
180 ($var ? (void*)new $ntype($var) : 0));
181T_REFOBJ
182 NOT IMPLEMENTED
183T_OPAQUE
184 sv_setpvn($arg, (char *)&$var, sizeof($var));
185T_OPAQUEPTR
186 sv_setpvn($arg, (char *)$var, sizeof(*$var)), XFree((char *)$var);
187T_PACKED
188 XS_pack_$ntype($arg, $var);
189T_PACKEDARRAY
190 XS_pack_$ntype($arg, $var, count_$ntype);
191T_DATAUNIT
192 sv_setpvn($arg, $var.chp(), $var.size());
193T_CALLBACK
194 sv_setpvn($arg, $var.context.value().chp(),
195 $var.context.value().size());
196T_ARRAY
197 ST_EXTEND($var.size);
198 for (U32 ix_$var = 0; ix_$var < $var.size; ix_$var++) {
199 ST(ix_$var) = sv_newmortal();
200 DO_ARRAY_ELEM
201 }
202 sp += $var.size - 1;