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