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