line |
stmt |
bran |
cond |
sub |
time |
code |
1
|
|
|
|
|
|
/* Copyright (c) 1997-2000 Graham Barr . All rights reserved. |
2
|
|
|
|
|
|
* This program is free software; you can redistribute it and/or |
3
|
|
|
|
|
|
* modify it under the same terms as Perl itself. |
4
|
|
|
|
|
|
*/ |
5
|
|
|
|
|
|
#define PERL_NO_GET_CONTEXT /* we want efficiency */ |
6
|
|
|
|
|
|
#include |
7
|
|
|
|
|
|
#include |
8
|
|
|
|
|
|
#include |
9
|
|
|
|
|
|
|
10
|
|
|
|
|
|
#define NEED_sv_2pv_flags 1 |
11
|
|
|
|
|
|
#include "ppport.h" |
12
|
|
|
|
|
|
|
13
|
|
|
|
|
|
#if PERL_BCDVERSION >= 0x5006000 |
14
|
|
|
|
|
|
# include "multicall.h" |
15
|
|
|
|
|
|
#endif |
16
|
|
|
|
|
|
|
17
|
|
|
|
|
|
#ifndef CvISXSUB |
18
|
|
|
|
|
|
# define CvISXSUB(cv) CvXSUB(cv) |
19
|
|
|
|
|
|
#endif |
20
|
|
|
|
|
|
|
21
|
|
|
|
|
|
/* Some platforms have strict exports. And before 5.7.3 cxinc (or Perl_cxinc) |
22
|
|
|
|
|
|
was not exported. Therefore platforms like win32, VMS etc have problems |
23
|
|
|
|
|
|
so we redefine it here -- GMB |
24
|
|
|
|
|
|
*/ |
25
|
|
|
|
|
|
#if PERL_BCDVERSION < 0x5007000 |
26
|
|
|
|
|
|
/* Not in 5.6.1. */ |
27
|
|
|
|
|
|
# ifdef cxinc |
28
|
|
|
|
|
|
# undef cxinc |
29
|
|
|
|
|
|
# endif |
30
|
|
|
|
|
|
# define cxinc() my_cxinc(aTHX) |
31
|
|
|
|
|
|
static I32 |
32
|
|
|
|
|
|
my_cxinc(pTHX) |
33
|
|
|
|
|
|
{ |
34
|
|
|
|
|
|
cxstack_max = cxstack_max * 3 / 2; |
35
|
|
|
|
|
|
Renew(cxstack, cxstack_max + 1, struct context); /* fencepost bug in older CXINC macros requires +1 here */ |
36
|
|
|
|
|
|
return cxstack_ix + 1; |
37
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
#endif |
39
|
|
|
|
|
|
|
40
|
|
|
|
|
|
#ifndef sv_copypv |
41
|
|
|
|
|
|
#define sv_copypv(a, b) my_sv_copypv(aTHX_ a, b) |
42
|
|
|
|
|
|
static void |
43
|
|
|
|
|
|
my_sv_copypv(pTHX_ SV *const dsv, SV *const ssv) |
44
|
|
|
|
|
|
{ |
45
|
|
|
|
|
|
STRLEN len; |
46
|
|
|
|
|
|
const char * const s = SvPV_const(ssv,len); |
47
|
|
|
|
|
|
sv_setpvn(dsv,s,len); |
48
|
|
|
|
|
|
if (SvUTF8(ssv)) |
49
|
|
|
|
|
|
SvUTF8_on(dsv); |
50
|
|
|
|
|
|
else |
51
|
|
|
|
|
|
SvUTF8_off(dsv); |
52
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
#endif |
54
|
|
|
|
|
|
|
55
|
|
|
|
|
|
#ifdef SVf_IVisUV |
56
|
|
|
|
|
|
# define slu_sv_value(sv) (SvIOK(sv)) ? (SvIOK_UV(sv)) ? (NV)(SvUVX(sv)) : (NV)(SvIVX(sv)) : (SvNV(sv)) |
57
|
|
|
|
|
|
#else |
58
|
|
|
|
|
|
# define slu_sv_value(sv) (SvIOK(sv)) ? (NV)(SvIVX(sv)) : (SvNV(sv)) |
59
|
|
|
|
|
|
#endif |
60
|
|
|
|
|
|
|
61
|
|
|
|
|
|
#if PERL_VERSION < 13 || (PERL_VERSION == 13 && PERL_SUBVERSION < 9) |
62
|
|
|
|
|
|
# define PERL_HAS_BAD_MULTICALL_REFCOUNT |
63
|
|
|
|
|
|
#endif |
64
|
|
|
|
|
|
|
65
|
|
|
|
|
|
MODULE=List::Util PACKAGE=List::Util |
66
|
|
|
|
|
|
|
67
|
|
|
|
|
|
void |
68
|
|
|
|
|
|
min(...) |
69
|
|
|
|
|
|
PROTOTYPE: @ |
70
|
|
|
|
|
|
ALIAS: |
71
|
|
|
|
|
|
min = 0 |
72
|
|
|
|
|
|
max = 1 |
73
|
|
|
|
|
|
CODE: |
74
|
|
|
|
|
|
{ |
75
|
|
|
|
|
|
int index; |
76
|
|
|
|
|
|
NV retval; |
77
|
|
|
|
|
|
SV *retsv; |
78
|
|
|
|
|
|
int magic; |
79
|
122504
|
|
|
|
|
if(!items) { |
80
|
0
|
|
|
|
|
XSRETURN_UNDEF; |
81
|
|
|
|
|
|
} |
82
|
122504
|
|
|
|
|
retsv = ST(0); |
83
|
122504
|
|
|
|
|
magic = SvAMAGIC(retsv); |
84
|
122504
|
|
|
|
|
if (!magic) { |
85
|
122488
|
|
|
|
|
retval = slu_sv_value(retsv); |
86
|
|
|
|
|
|
} |
87
|
122646
|
|
|
|
|
for(index = 1 ; index < items ; index++) { |
88
|
122646
|
|
|
|
|
SV *stacksv = ST(index); |
89
|
|
|
|
|
|
SV *tmpsv; |
90
|
122646
|
|
|
|
|
if ((magic || SvAMAGIC(stacksv)) && (tmpsv = amagic_call(retsv, stacksv, gt_amg, 0))) { |
91
|
38
|
|
|
|
|
if (SvTRUE(tmpsv) ? !ix : ix) { |
92
|
|
|
|
|
|
retsv = stacksv; |
93
|
16
|
|
|
|
|
magic = SvAMAGIC(retsv); |
94
|
16
|
|
|
|
|
if (!magic) { |
95
|
2
|
|
|
|
|
retval = slu_sv_value(retsv); |
96
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
else { |
100
|
122608
|
|
|
|
|
NV val = slu_sv_value(stacksv); |
101
|
122608
|
|
|
|
|
if (magic) { |
102
|
4
|
|
|
|
|
retval = slu_sv_value(retsv); |
103
|
|
|
|
|
|
magic = 0; |
104
|
|
|
|
|
|
} |
105
|
122608
|
|
|
|
|
if(val < retval ? !ix : ix) { |
106
|
|
|
|
|
|
retsv = stacksv; |
107
|
|
|
|
|
|
retval = val; |
108
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
} |
111
|
122504
|
|
|
|
|
ST(0) = retsv; |
112
|
122504
|
|
|
|
|
XSRETURN(1); |
113
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
117
|
|
|
|
|
|
void |
118
|
|
|
|
|
|
sum(...) |
119
|
|
|
|
|
|
PROTOTYPE: @ |
120
|
|
|
|
|
|
CODE: |
121
|
|
|
|
|
|
{ |
122
|
30
|
|
|
|
|
dXSTARG; |
123
|
|
|
|
|
|
SV *sv; |
124
|
|
|
|
|
|
SV *retsv = NULL; |
125
|
|
|
|
|
|
int index; |
126
|
|
|
|
|
|
NV retval = 0; |
127
|
|
|
|
|
|
int magic; |
128
|
30
|
|
|
|
|
if(!items) { |
129
|
2
|
|
|
|
|
XSRETURN_UNDEF; |
130
|
|
|
|
|
|
} |
131
|
28
|
|
|
|
|
sv = ST(0); |
132
|
28
|
|
|
|
|
magic = SvAMAGIC(sv); |
133
|
28
|
|
|
|
|
if (magic) { |
134
|
|
|
|
|
|
retsv = TARG; |
135
|
6
|
|
|
|
|
sv_setsv(retsv, sv); |
136
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
else { |
138
|
22
|
|
|
|
|
retval = slu_sv_value(sv); |
139
|
|
|
|
|
|
} |
140
|
40
|
|
|
|
|
for(index = 1 ; index < items ; index++) { |
141
|
40
|
|
|
|
|
sv = ST(index); |
142
|
40
|
|
|
|
|
if(!magic && SvAMAGIC(sv)){ |
143
|
|
|
|
|
|
magic = TRUE; |
144
|
10
|
|
|
|
|
if (!retsv) |
145
|
|
|
|
|
|
retsv = TARG; |
146
|
10
|
|
|
|
|
sv_setnv(retsv,retval); |
147
|
|
|
|
|
|
} |
148
|
40
|
|
|
|
|
if (magic) { |
149
|
18
|
|
|
|
|
SV* const tmpsv = amagic_call(retsv, sv, add_amg, SvAMAGIC(retsv) ? AMGf_assign : 0); |
150
|
18
|
|
|
|
|
if(tmpsv) { |
151
|
8
|
|
|
|
|
magic = SvAMAGIC(tmpsv); |
152
|
8
|
|
|
|
|
if (!magic) { |
153
|
0
|
|
|
|
|
retval = slu_sv_value(tmpsv); |
154
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
else { |
156
|
|
|
|
|
|
retsv = tmpsv; |
157
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
else { |
160
|
|
|
|
|
|
/* fall back to default */ |
161
|
|
|
|
|
|
magic = FALSE; |
162
|
10
|
|
|
|
|
retval = SvNV(retsv) + SvNV(sv); |
163
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
else { |
166
|
22
|
|
|
|
|
retval += slu_sv_value(sv); |
167
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
} |
169
|
28
|
|
|
|
|
if (!magic) { |
170
|
22
|
|
|
|
|
if (!retsv) |
171
|
|
|
|
|
|
retsv = TARG; |
172
|
22
|
|
|
|
|
sv_setnv(retsv,retval); |
173
|
|
|
|
|
|
} |
174
|
28
|
|
|
|
|
ST(0) = retsv; |
175
|
28
|
|
|
|
|
XSRETURN(1); |
176
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
178
|
|
|
|
|
|
#define SLU_CMP_LARGER 1 |
179
|
|
|
|
|
|
#define SLU_CMP_SMALLER -1 |
180
|
|
|
|
|
|
|
181
|
|
|
|
|
|
void |
182
|
|
|
|
|
|
minstr(...) |
183
|
|
|
|
|
|
PROTOTYPE: @ |
184
|
|
|
|
|
|
ALIAS: |
185
|
|
|
|
|
|
minstr = SLU_CMP_LARGER |
186
|
|
|
|
|
|
maxstr = SLU_CMP_SMALLER |
187
|
|
|
|
|
|
CODE: |
188
|
|
|
|
|
|
{ |
189
|
|
|
|
|
|
SV *left; |
190
|
|
|
|
|
|
int index; |
191
|
18
|
|
|
|
|
if(!items) { |
192
|
0
|
|
|
|
|
XSRETURN_UNDEF; |
193
|
|
|
|
|
|
} |
194
|
18
|
|
|
|
|
left = ST(0); |
195
|
|
|
|
|
|
#ifdef OPpLOCALE |
196
|
|
|
|
|
|
if(MAXARG & OPpLOCALE) { |
197
|
|
|
|
|
|
for(index = 1 ; index < items ; index++) { |
198
|
|
|
|
|
|
SV *right = ST(index); |
199
|
|
|
|
|
|
if(sv_cmp_locale(left, right) == ix) |
200
|
|
|
|
|
|
left = right; |
201
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
else { |
204
|
|
|
|
|
|
#endif |
205
|
136
|
|
|
|
|
for(index = 1 ; index < items ; index++) { |
206
|
118
|
|
|
|
|
SV *right = ST(index); |
207
|
118
|
|
|
|
|
if(sv_cmp(left, right) == ix) |
208
|
|
|
|
|
|
left = right; |
209
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
#ifdef OPpLOCALE |
211
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
#endif |
213
|
18
|
|
|
|
|
ST(0) = left; |
214
|
18
|
|
|
|
|
XSRETURN(1); |
215
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
219
|
|
|
|
|
|
#ifdef dMULTICALL |
220
|
|
|
|
|
|
|
221
|
|
|
|
|
|
void |
222
|
|
|
|
|
|
reduce(block,...) |
223
|
|
|
|
|
|
SV * block |
224
|
|
|
|
|
|
PROTOTYPE: &@ |
225
|
|
|
|
|
|
CODE: |
226
|
|
|
|
|
|
{ |
227
|
62
|
|
|
|
|
SV *ret = sv_newmortal(); |
228
|
|
|
|
|
|
int index; |
229
|
|
|
|
|
|
GV *agv,*bgv,*gv; |
230
|
|
|
|
|
|
HV *stash; |
231
|
62
|
|
|
|
|
SV **args = &PL_stack_base[ax]; |
232
|
62
|
|
|
|
|
CV* cv = sv_2cv(block, &stash, &gv, 0); |
233
|
|
|
|
|
|
|
234
|
56
|
|
|
|
|
if (cv == Nullcv) { |
235
|
8
|
|
|
|
|
croak("Not a subroutine reference"); |
236
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
238
|
48
|
|
|
|
|
if(items <= 1) { |
239
|
2
|
|
|
|
|
XSRETURN_UNDEF; |
240
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
242
|
46
|
|
|
|
|
agv = gv_fetchpv("a", GV_ADD, SVt_PV); |
243
|
46
|
|
|
|
|
bgv = gv_fetchpv("b", GV_ADD, SVt_PV); |
244
|
46
|
|
|
|
|
SAVESPTR(GvSV(agv)); |
245
|
46
|
|
|
|
|
SAVESPTR(GvSV(bgv)); |
246
|
46
|
|
|
|
|
GvSV(agv) = ret; |
247
|
46
|
|
|
|
|
SvSetSV(ret, args[1]); |
248
|
|
|
|
|
|
|
249
|
46
|
|
|
|
|
if(!CvISXSUB(cv)) { |
250
|
|
|
|
|
|
dMULTICALL; |
251
|
|
|
|
|
|
I32 gimme = G_SCALAR; |
252
|
|
|
|
|
|
|
253
|
266
|
|
|
|
|
PUSH_MULTICALL(cv); |
254
|
198
|
|
|
|
|
for(index = 2 ; index < items ; index++) { |
255
|
162
|
|
|
|
|
GvSV(bgv) = args[index]; |
256
|
162
|
|
|
|
|
MULTICALL; |
257
|
154
|
|
|
|
|
SvSetSV(ret, *PL_stack_sp); |
258
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
#ifdef PERL_HAS_BAD_MULTICALL_REFCOUNT |
260
|
|
|
|
|
|
if (CvDEPTH(multicall_cv) > 1) |
261
|
|
|
|
|
|
SvREFCNT_inc_simple_void_NN(multicall_cv); |
262
|
|
|
|
|
|
#endif |
263
|
72
|
|
|
|
|
POP_MULTICALL; |
264
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
else { |
266
|
4
|
|
|
|
|
for(index = 2 ; index < items ; index++) { |
267
|
4
|
|
|
|
|
dSP; |
268
|
4
|
|
|
|
|
GvSV(bgv) = args[index]; |
269
|
|
|
|
|
|
|
270
|
4
|
|
|
|
|
PUSHMARK(SP); |
271
|
4
|
|
|
|
|
call_sv((SV*)cv, G_SCALAR); |
272
|
|
|
|
|
|
|
273
|
4
|
|
|
|
|
SvSetSV(ret, *PL_stack_sp); |
274
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
277
|
38
|
|
|
|
|
ST(0) = ret; |
278
|
38
|
|
|
|
|
XSRETURN(1); |
279
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
281
|
|
|
|
|
|
void |
282
|
|
|
|
|
|
first(block,...) |
283
|
|
|
|
|
|
SV * block |
284
|
|
|
|
|
|
PROTOTYPE: &@ |
285
|
|
|
|
|
|
CODE: |
286
|
|
|
|
|
|
{ |
287
|
|
|
|
|
|
int index; |
288
|
|
|
|
|
|
GV *gv; |
289
|
|
|
|
|
|
HV *stash; |
290
|
50
|
|
|
|
|
SV **args = &PL_stack_base[ax]; |
291
|
50
|
|
|
|
|
CV *cv = sv_2cv(block, &stash, &gv, 0); |
292
|
46
|
|
|
|
|
if (cv == Nullcv) { |
293
|
6
|
|
|
|
|
croak("Not a subroutine reference"); |
294
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
296
|
40
|
|
|
|
|
if(items <= 1) { |
297
|
2
|
|
|
|
|
XSRETURN_UNDEF; |
298
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
300
|
38
|
|
|
|
|
SAVESPTR(GvSV(PL_defgv)); |
301
|
|
|
|
|
|
|
302
|
38
|
|
|
|
|
if(!CvISXSUB(cv)) { |
303
|
|
|
|
|
|
dMULTICALL; |
304
|
|
|
|
|
|
I32 gimme = G_SCALAR; |
305
|
210
|
|
|
|
|
PUSH_MULTICALL(cv); |
306
|
|
|
|
|
|
|
307
|
98
|
|
|
|
|
for(index = 1 ; index < items ; index++) { |
308
|
92
|
|
|
|
|
GvSV(PL_defgv) = args[index]; |
309
|
92
|
|
|
|
|
MULTICALL; |
310
|
84
|
|
|
|
|
if (SvTRUEx(*PL_stack_sp)) { |
311
|
|
|
|
|
|
#ifdef PERL_HAS_BAD_MULTICALL_REFCOUNT |
312
|
|
|
|
|
|
if (CvDEPTH(multicall_cv) > 1) |
313
|
|
|
|
|
|
SvREFCNT_inc_simple_void_NN(multicall_cv); |
314
|
|
|
|
|
|
#endif |
315
|
40
|
|
|
|
|
POP_MULTICALL; |
316
|
20
|
|
|
|
|
ST(0) = ST(index); |
317
|
20
|
|
|
|
|
XSRETURN(1); |
318
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
#ifdef PERL_HAS_BAD_MULTICALL_REFCOUNT |
321
|
|
|
|
|
|
if (CvDEPTH(multicall_cv) > 1) |
322
|
|
|
|
|
|
SvREFCNT_inc_simple_void_NN(multicall_cv); |
323
|
|
|
|
|
|
#endif |
324
|
12
|
|
|
|
|
POP_MULTICALL; |
325
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
else { |
327
|
8
|
|
|
|
|
for(index = 1 ; index < items ; index++) { |
328
|
10
|
|
|
|
|
dSP; |
329
|
10
|
|
|
|
|
GvSV(PL_defgv) = args[index]; |
330
|
|
|
|
|
|
|
331
|
10
|
|
|
|
|
PUSHMARK(SP); |
332
|
10
|
|
|
|
|
call_sv((SV*)cv, G_SCALAR); |
333
|
10
|
|
|
|
|
if (SvTRUEx(*PL_stack_sp)) { |
334
|
2
|
|
|
|
|
ST(0) = ST(index); |
335
|
2
|
|
|
|
|
XSRETURN(1); |
336
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
} |
339
|
8
|
|
|
|
|
XSRETURN_UNDEF; |
340
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
342
|
|
|
|
|
|
#endif |
343
|
|
|
|
|
|
|
344
|
|
|
|
|
|
void |
345
|
|
|
|
|
|
pairfirst(block,...) |
346
|
|
|
|
|
|
SV * block |
347
|
|
|
|
|
|
PROTOTYPE: &@ |
348
|
|
|
|
|
|
PPCODE: |
349
|
|
|
|
|
|
{ |
350
|
|
|
|
|
|
GV *agv,*bgv,*gv; |
351
|
|
|
|
|
|
HV *stash; |
352
|
8
|
|
|
|
|
CV *cv = sv_2cv(block, &stash, &gv, 0); |
353
|
8
|
|
|
|
|
I32 ret_gimme = GIMME_V; |
354
|
|
|
|
|
|
int argi = 1; // "shift" the block |
355
|
|
|
|
|
|
|
356
|
8
|
|
|
|
|
if(!(items % 2) && ckWARN(WARN_MISC)) |
357
|
0
|
|
|
|
|
warn("Odd number of elements in pairfirst"); |
358
|
|
|
|
|
|
|
359
|
8
|
|
|
|
|
agv = gv_fetchpv("a", GV_ADD, SVt_PV); |
360
|
8
|
|
|
|
|
bgv = gv_fetchpv("b", GV_ADD, SVt_PV); |
361
|
8
|
|
|
|
|
SAVESPTR(GvSV(agv)); |
362
|
8
|
|
|
|
|
SAVESPTR(GvSV(bgv)); |
363
|
|
|
|
|
|
#ifdef dMULTICALL |
364
|
8
|
|
|
|
|
if(!CvISXSUB(cv)) { |
365
|
|
|
|
|
|
// Since MULTICALL is about to move it |
366
|
8
|
|
|
|
|
SV **stack = PL_stack_base + ax; |
367
|
|
|
|
|
|
|
368
|
|
|
|
|
|
dMULTICALL; |
369
|
|
|
|
|
|
I32 gimme = G_SCALAR; |
370
|
|
|
|
|
|
|
371
|
48
|
|
|
|
|
PUSH_MULTICALL(cv); |
372
|
56
|
|
|
|
|
for(; argi < items; argi += 2) { |
373
|
24
|
|
|
|
|
SV *a = GvSV(agv) = stack[argi]; |
374
|
24
|
|
|
|
|
SV *b = GvSV(bgv) = argi < items-1 ? stack[argi+1] : &PL_sv_undef; |
375
|
|
|
|
|
|
|
376
|
24
|
|
|
|
|
MULTICALL; |
377
|
|
|
|
|
|
|
378
|
24
|
|
|
|
|
if(!SvTRUEx(*PL_stack_sp)) |
379
|
20
|
|
|
|
|
continue; |
380
|
|
|
|
|
|
|
381
|
8
|
|
|
|
|
POP_MULTICALL; |
382
|
4
|
|
|
|
|
if(ret_gimme == G_ARRAY) { |
383
|
2
|
|
|
|
|
ST(0) = sv_mortalcopy(a); |
384
|
2
|
|
|
|
|
ST(1) = sv_mortalcopy(b); |
385
|
2
|
|
|
|
|
XSRETURN(2); |
386
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
else |
388
|
2
|
|
|
|
|
XSRETURN_YES; |
389
|
|
|
|
|
|
} |
390
|
8
|
|
|
|
|
POP_MULTICALL; |
391
|
4
|
|
|
|
|
XSRETURN(0); |
392
|
|
|
|
|
|
} |
393
|
|
|
|
|
|
else |
394
|
|
|
|
|
|
#endif |
395
|
|
|
|
|
|
{ |
396
|
0
|
|
|
|
|
for(; argi < items; argi += 2) { |
397
|
0
|
|
|
|
|
dSP; |
398
|
0
|
|
|
|
|
SV *a = GvSV(agv) = ST(argi); |
399
|
0
|
|
|
|
|
SV *b = GvSV(bgv) = argi < items-1 ? ST(argi+1) : &PL_sv_undef; |
400
|
|
|
|
|
|
|
401
|
0
|
|
|
|
|
PUSHMARK(SP); |
402
|
0
|
|
|
|
|
call_sv((SV*)cv, G_SCALAR); |
403
|
|
|
|
|
|
|
404
|
|
|
|
|
|
SPAGAIN; |
405
|
|
|
|
|
|
|
406
|
0
|
|
|
|
|
if(!SvTRUEx(*PL_stack_sp)) |
407
|
0
|
|
|
|
|
continue; |
408
|
|
|
|
|
|
|
409
|
0
|
|
|
|
|
if(ret_gimme == G_ARRAY) { |
410
|
0
|
|
|
|
|
ST(0) = sv_mortalcopy(a); |
411
|
0
|
|
|
|
|
ST(1) = sv_mortalcopy(b); |
412
|
0
|
|
|
|
|
XSRETURN(2); |
413
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
else |
415
|
0
|
|
|
|
|
XSRETURN_YES; |
416
|
|
|
|
|
|
} |
417
|
|
|
|
|
|
} |
418
|
|
|
|
|
|
|
419
|
0
|
|
|
|
|
XSRETURN(0); |
420
|
|
|
|
|
|
} |
421
|
|
|
|
|
|
|
422
|
|
|
|
|
|
void |
423
|
|
|
|
|
|
pairgrep(block,...) |
424
|
|
|
|
|
|
SV * block |
425
|
|
|
|
|
|
PROTOTYPE: &@ |
426
|
|
|
|
|
|
PPCODE: |
427
|
|
|
|
|
|
{ |
428
|
|
|
|
|
|
GV *agv,*bgv,*gv; |
429
|
|
|
|
|
|
HV *stash; |
430
|
12
|
|
|
|
|
CV *cv = sv_2cv(block, &stash, &gv, 0); |
431
|
12
|
|
|
|
|
I32 ret_gimme = GIMME_V; |
432
|
|
|
|
|
|
|
433
|
|
|
|
|
|
/* This function never returns more than it consumed in arguments. So we |
434
|
|
|
|
|
|
* can build the results "live", behind the arguments |
435
|
|
|
|
|
|
*/ |
436
|
|
|
|
|
|
int argi = 1; // "shift" the block |
437
|
|
|
|
|
|
int reti = 0; |
438
|
|
|
|
|
|
|
439
|
12
|
|
|
|
|
if(!(items % 2) && ckWARN(WARN_MISC)) |
440
|
2
|
|
|
|
|
warn("Odd number of elements in pairgrep"); |
441
|
|
|
|
|
|
|
442
|
12
|
|
|
|
|
agv = gv_fetchpv("a", GV_ADD, SVt_PV); |
443
|
12
|
|
|
|
|
bgv = gv_fetchpv("b", GV_ADD, SVt_PV); |
444
|
12
|
|
|
|
|
SAVESPTR(GvSV(agv)); |
445
|
12
|
|
|
|
|
SAVESPTR(GvSV(bgv)); |
446
|
|
|
|
|
|
#ifdef dMULTICALL |
447
|
12
|
|
|
|
|
if(!CvISXSUB(cv)) { |
448
|
|
|
|
|
|
// Since MULTICALL is about to move it |
449
|
12
|
|
|
|
|
SV **stack = PL_stack_base + ax; |
450
|
|
|
|
|
|
int i; |
451
|
|
|
|
|
|
|
452
|
|
|
|
|
|
dMULTICALL; |
453
|
|
|
|
|
|
I32 gimme = G_SCALAR; |
454
|
|
|
|
|
|
|
455
|
72
|
|
|
|
|
PUSH_MULTICALL(cv); |
456
|
42
|
|
|
|
|
for(; argi < items; argi += 2) { |
457
|
30
|
|
|
|
|
SV *a = GvSV(agv) = stack[argi]; |
458
|
30
|
|
|
|
|
SV *b = GvSV(bgv) = argi < items-1 ? stack[argi+1] : &PL_sv_undef; |
459
|
|
|
|
|
|
|
460
|
30
|
|
|
|
|
MULTICALL; |
461
|
|
|
|
|
|
|
462
|
30
|
|
|
|
|
if(SvTRUEx(*PL_stack_sp)) { |
463
|
16
|
|
|
|
|
if(ret_gimme == G_ARRAY) { |
464
|
|
|
|
|
|
// We can't mortalise yet or they'd be mortal too early |
465
|
8
|
|
|
|
|
stack[reti++] = newSVsv(a); |
466
|
8
|
|
|
|
|
stack[reti++] = newSVsv(b); |
467
|
|
|
|
|
|
} |
468
|
8
|
|
|
|
|
else if(ret_gimme == G_SCALAR) |
469
|
4
|
|
|
|
|
reti++; |
470
|
|
|
|
|
|
} |
471
|
|
|
|
|
|
} |
472
|
24
|
|
|
|
|
POP_MULTICALL; |
473
|
|
|
|
|
|
|
474
|
12
|
|
|
|
|
if(ret_gimme == G_ARRAY) |
475
|
16
|
|
|
|
|
for(i = 0; i < reti; i++) |
476
|
16
|
|
|
|
|
sv_2mortal(stack[i]); |
477
|
|
|
|
|
|
} |
478
|
|
|
|
|
|
else |
479
|
|
|
|
|
|
#endif |
480
|
|
|
|
|
|
{ |
481
|
0
|
|
|
|
|
for(; argi < items; argi += 2) { |
482
|
0
|
|
|
|
|
dSP; |
483
|
0
|
|
|
|
|
SV *a = GvSV(agv) = ST(argi); |
484
|
0
|
|
|
|
|
SV *b = GvSV(bgv) = argi < items-1 ? ST(argi+1) : &PL_sv_undef; |
485
|
|
|
|
|
|
|
486
|
0
|
|
|
|
|
PUSHMARK(SP); |
487
|
0
|
|
|
|
|
call_sv((SV*)cv, G_SCALAR); |
488
|
|
|
|
|
|
|
489
|
|
|
|
|
|
SPAGAIN; |
490
|
|
|
|
|
|
|
491
|
0
|
|
|
|
|
if(SvTRUEx(*PL_stack_sp)) { |
492
|
0
|
|
|
|
|
if(ret_gimme == G_ARRAY) { |
493
|
0
|
|
|
|
|
ST(reti++) = sv_mortalcopy(a); |
494
|
0
|
|
|
|
|
ST(reti++) = sv_mortalcopy(b); |
495
|
|
|
|
|
|
} |
496
|
0
|
|
|
|
|
else if(ret_gimme == G_SCALAR) |
497
|
0
|
|
|
|
|
reti++; |
498
|
|
|
|
|
|
} |
499
|
|
|
|
|
|
} |
500
|
|
|
|
|
|
} |
501
|
|
|
|
|
|
|
502
|
12
|
|
|
|
|
if(ret_gimme == G_ARRAY) |
503
|
4
|
|
|
|
|
XSRETURN(reti); |
504
|
8
|
|
|
|
|
else if(ret_gimme == G_SCALAR) { |
505
|
2
|
|
|
|
|
ST(0) = newSViv(reti); |
506
|
2
|
|
|
|
|
XSRETURN(1); |
507
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
} |
509
|
|
|
|
|
|
|
510
|
|
|
|
|
|
void |
511
|
|
|
|
|
|
pairmap(block,...) |
512
|
|
|
|
|
|
SV * block |
513
|
|
|
|
|
|
PROTOTYPE: &@ |
514
|
|
|
|
|
|
PPCODE: |
515
|
|
|
|
|
|
{ |
516
|
|
|
|
|
|
GV *agv,*bgv,*gv; |
517
|
|
|
|
|
|
HV *stash; |
518
|
12
|
|
|
|
|
CV *cv = sv_2cv(block, &stash, &gv, 0); |
519
|
|
|
|
|
|
SV **args_copy = NULL; |
520
|
12
|
|
|
|
|
I32 ret_gimme = GIMME_V; |
521
|
|
|
|
|
|
|
522
|
|
|
|
|
|
int argi = 1; // "shift" the block |
523
|
|
|
|
|
|
int reti = 0; |
524
|
|
|
|
|
|
|
525
|
12
|
|
|
|
|
if(!(items % 2) && ckWARN(WARN_MISC)) |
526
|
0
|
|
|
|
|
warn("Odd number of elements in pairmap"); |
527
|
|
|
|
|
|
|
528
|
12
|
|
|
|
|
agv = gv_fetchpv("a", GV_ADD, SVt_PV); |
529
|
12
|
|
|
|
|
bgv = gv_fetchpv("b", GV_ADD, SVt_PV); |
530
|
12
|
|
|
|
|
SAVESPTR(GvSV(agv)); |
531
|
12
|
|
|
|
|
SAVESPTR(GvSV(bgv)); |
532
|
|
|
|
|
|
/* This MULTICALL-based code appears to fail on perl 5.10.0 and 5.8.9 |
533
|
|
|
|
|
|
* Skip it on those versions (RT#87857) |
534
|
|
|
|
|
|
*/ |
535
|
|
|
|
|
|
#if defined(dMULTICALL) && (PERL_BCDVERSION > 0x5010000 || PERL_BCDVERSION < 0x5008009) |
536
|
12
|
|
|
|
|
if(!CvISXSUB(cv)) { |
537
|
|
|
|
|
|
// Since MULTICALL is about to move it |
538
|
12
|
|
|
|
|
SV **stack = PL_stack_base + ax; |
539
|
12
|
|
|
|
|
I32 ret_gimme = GIMME_V; |
540
|
|
|
|
|
|
int i; |
541
|
|
|
|
|
|
|
542
|
|
|
|
|
|
dMULTICALL; |
543
|
|
|
|
|
|
I32 gimme = G_ARRAY; |
544
|
|
|
|
|
|
|
545
|
72
|
|
|
|
|
PUSH_MULTICALL(cv); |
546
|
44
|
|
|
|
|
for(; argi < items; argi += 2) { |
547
|
32
|
|
|
|
|
SV *a = GvSV(agv) = args_copy ? args_copy[argi] : stack[argi]; |
548
|
64
|
|
|
|
|
SV *b = GvSV(bgv) = argi < items-1 ? |
549
|
32
|
|
|
|
|
(args_copy ? args_copy[argi+1] : stack[argi+1]) : |
550
|
|
|
|
|
|
&PL_sv_undef; |
551
|
|
|
|
|
|
int count; |
552
|
|
|
|
|
|
|
553
|
32
|
|
|
|
|
MULTICALL; |
554
|
32
|
|
|
|
|
count = PL_stack_sp - PL_stack_base; |
555
|
|
|
|
|
|
|
556
|
32
|
|
|
|
|
if(count > 2 && !args_copy) { |
557
|
|
|
|
|
|
/* We can't return more than 2 results for a given input pair |
558
|
|
|
|
|
|
* without trashing the remaining argmuents on the stack still |
559
|
|
|
|
|
|
* to be processed. So, we'll copy them out to a temporary |
560
|
|
|
|
|
|
* buffer and work from there instead. |
561
|
|
|
|
|
|
* We didn't do this initially because in the common case, most |
562
|
|
|
|
|
|
* code blocks will return only 1 or 2 items so it won't be |
563
|
|
|
|
|
|
* necessary |
564
|
|
|
|
|
|
*/ |
565
|
4
|
|
|
|
|
int n_args = items - argi; |
566
|
4
|
|
|
|
|
Newx(args_copy, n_args, SV *); |
567
|
4
|
|
|
|
|
SAVEFREEPV(args_copy); |
568
|
|
|
|
|
|
|
569
|
4
|
|
|
|
|
Copy(stack + argi, args_copy, n_args, SV *); |
570
|
|
|
|
|
|
|
571
|
|
|
|
|
|
argi = 0; |
572
|
|
|
|
|
|
items = n_args; |
573
|
|
|
|
|
|
} |
574
|
|
|
|
|
|
|
575
|
96
|
|
|
|
|
for(i = 0; i < count; i++) |
576
|
64
|
|
|
|
|
stack[reti++] = newSVsv(PL_stack_sp[i - count + 1]); |
577
|
|
|
|
|
|
} |
578
|
24
|
|
|
|
|
POP_MULTICALL; |
579
|
|
|
|
|
|
|
580
|
12
|
|
|
|
|
if(ret_gimme == G_ARRAY) |
581
|
48
|
|
|
|
|
for(i = 0; i < reti; i++) |
582
|
48
|
|
|
|
|
sv_2mortal(stack[i]); |
583
|
|
|
|
|
|
} |
584
|
|
|
|
|
|
else |
585
|
|
|
|
|
|
#endif |
586
|
|
|
|
|
|
{ |
587
|
0
|
|
|
|
|
for(; argi < items; argi += 2) { |
588
|
0
|
|
|
|
|
dSP; |
589
|
0
|
|
|
|
|
SV *a = GvSV(agv) = args_copy ? args_copy[argi] : ST(argi); |
590
|
0
|
|
|
|
|
SV *b = GvSV(bgv) = argi < items-1 ? |
591
|
0
|
|
|
|
|
(args_copy ? args_copy[argi+1] : ST(argi+1)) : |
592
|
|
|
|
|
|
&PL_sv_undef; |
593
|
|
|
|
|
|
int count; |
594
|
|
|
|
|
|
int i; |
595
|
|
|
|
|
|
|
596
|
0
|
|
|
|
|
PUSHMARK(SP); |
597
|
0
|
|
|
|
|
count = call_sv((SV*)cv, G_ARRAY); |
598
|
|
|
|
|
|
|
599
|
0
|
|
|
|
|
SPAGAIN; |
600
|
|
|
|
|
|
|
601
|
0
|
|
|
|
|
if(count > 2 && !args_copy && ret_gimme == G_ARRAY) { |
602
|
0
|
|
|
|
|
int n_args = items - argi; |
603
|
0
|
|
|
|
|
Newx(args_copy, n_args, SV *); |
604
|
0
|
|
|
|
|
SAVEFREEPV(args_copy); |
605
|
|
|
|
|
|
|
606
|
0
|
|
|
|
|
Copy(&ST(argi), args_copy, n_args, SV *); |
607
|
|
|
|
|
|
|
608
|
|
|
|
|
|
argi = 0; |
609
|
|
|
|
|
|
items = n_args; |
610
|
|
|
|
|
|
} |
611
|
|
|
|
|
|
|
612
|
0
|
|
|
|
|
if(ret_gimme == G_ARRAY) |
613
|
0
|
|
|
|
|
for(i = 0; i < count; i++) |
614
|
0
|
|
|
|
|
ST(reti++) = sv_mortalcopy(SP[i - count + 1]); |
615
|
|
|
|
|
|
else |
616
|
0
|
|
|
|
|
reti += count; |
617
|
|
|
|
|
|
|
618
|
0
|
|
|
|
|
PUTBACK; |
619
|
|
|
|
|
|
} |
620
|
|
|
|
|
|
} |
621
|
|
|
|
|
|
|
622
|
12
|
|
|
|
|
if(ret_gimme == G_ARRAY) |
623
|
8
|
|
|
|
|
XSRETURN(reti); |
624
|
|
|
|
|
|
|
625
|
4
|
|
|
|
|
ST(0) = sv_2mortal(newSViv(reti)); |
626
|
4
|
|
|
|
|
XSRETURN(1); |
627
|
|
|
|
|
|
} |
628
|
|
|
|
|
|
|
629
|
|
|
|
|
|
void |
630
|
|
|
|
|
|
pairs(...) |
631
|
|
|
|
|
|
PROTOTYPE: @ |
632
|
|
|
|
|
|
PPCODE: |
633
|
|
|
|
|
|
{ |
634
|
|
|
|
|
|
int argi = 0; |
635
|
|
|
|
|
|
int reti = 0; |
636
|
|
|
|
|
|
|
637
|
4
|
|
|
|
|
if(items % 2 && ckWARN(WARN_MISC)) |
638
|
0
|
|
|
|
|
warn("Odd number of elements in pairs"); |
639
|
|
|
|
|
|
|
640
|
|
|
|
|
|
{ |
641
|
10
|
|
|
|
|
for(; argi < items; argi += 2) { |
642
|
10
|
|
|
|
|
SV *a = ST(argi); |
643
|
10
|
|
|
|
|
SV *b = argi < items-1 ? ST(argi+1) : &PL_sv_undef; |
644
|
|
|
|
|
|
|
645
|
10
|
|
|
|
|
AV *av = newAV(); |
646
|
10
|
|
|
|
|
av_push(av, newSVsv(a)); |
647
|
10
|
|
|
|
|
av_push(av, newSVsv(b)); |
648
|
|
|
|
|
|
|
649
|
10
|
|
|
|
|
ST(reti++) = sv_2mortal(newRV_noinc((SV *)av)); |
650
|
|
|
|
|
|
} |
651
|
|
|
|
|
|
} |
652
|
|
|
|
|
|
|
653
|
4
|
|
|
|
|
XSRETURN(reti); |
654
|
|
|
|
|
|
} |
655
|
|
|
|
|
|
|
656
|
|
|
|
|
|
void |
657
|
|
|
|
|
|
pairkeys(...) |
658
|
|
|
|
|
|
PROTOTYPE: @ |
659
|
|
|
|
|
|
PPCODE: |
660
|
|
|
|
|
|
{ |
661
|
|
|
|
|
|
int argi = 0; |
662
|
|
|
|
|
|
int reti = 0; |
663
|
|
|
|
|
|
|
664
|
2
|
|
|
|
|
if(items % 2 && ckWARN(WARN_MISC)) |
665
|
0
|
|
|
|
|
warn("Odd number of elements in pairkeys"); |
666
|
|
|
|
|
|
|
667
|
|
|
|
|
|
{ |
668
|
4
|
|
|
|
|
for(; argi < items; argi += 2) { |
669
|
4
|
|
|
|
|
SV *a = ST(argi); |
670
|
|
|
|
|
|
|
671
|
4
|
|
|
|
|
ST(reti++) = sv_2mortal(newSVsv(a)); |
672
|
|
|
|
|
|
} |
673
|
|
|
|
|
|
} |
674
|
|
|
|
|
|
|
675
|
2
|
|
|
|
|
XSRETURN(reti); |
676
|
|
|
|
|
|
} |
677
|
|
|
|
|
|
|
678
|
|
|
|
|
|
void |
679
|
|
|
|
|
|
pairvalues(...) |
680
|
|
|
|
|
|
PROTOTYPE: @ |
681
|
|
|
|
|
|
PPCODE: |
682
|
|
|
|
|
|
{ |
683
|
|
|
|
|
|
int argi = 0; |
684
|
|
|
|
|
|
int reti = 0; |
685
|
|
|
|
|
|
|
686
|
2
|
|
|
|
|
if(items % 2 && ckWARN(WARN_MISC)) |
687
|
0
|
|
|
|
|
warn("Odd number of elements in pairvalues"); |
688
|
|
|
|
|
|
|
689
|
|
|
|
|
|
{ |
690
|
4
|
|
|
|
|
for(; argi < items; argi += 2) { |
691
|
4
|
|
|
|
|
SV *b = argi < items-1 ? ST(argi+1) : &PL_sv_undef; |
692
|
|
|
|
|
|
|
693
|
4
|
|
|
|
|
ST(reti++) = sv_2mortal(newSVsv(b)); |
694
|
|
|
|
|
|
} |
695
|
|
|
|
|
|
} |
696
|
|
|
|
|
|
|
697
|
2
|
|
|
|
|
XSRETURN(reti); |
698
|
|
|
|
|
|
} |
699
|
|
|
|
|
|
|
700
|
|
|
|
|
|
void |
701
|
|
|
|
|
|
shuffle(...) |
702
|
|
|
|
|
|
PROTOTYPE: @ |
703
|
|
|
|
|
|
CODE: |
704
|
|
|
|
|
|
{ |
705
|
|
|
|
|
|
int index; |
706
|
|
|
|
|
|
#if (PERL_VERSION < 9) |
707
|
|
|
|
|
|
struct op dmy_op; |
708
|
|
|
|
|
|
struct op *old_op = PL_op; |
709
|
|
|
|
|
|
|
710
|
|
|
|
|
|
/* We call pp_rand here so that Drand01 get initialized if rand() |
711
|
|
|
|
|
|
or srand() has not already been called |
712
|
|
|
|
|
|
*/ |
713
|
|
|
|
|
|
memzero((char*)(&dmy_op), sizeof(struct op)); |
714
|
|
|
|
|
|
/* we let pp_rand() borrow the TARG allocated for this XS sub */ |
715
|
|
|
|
|
|
dmy_op.op_targ = PL_op->op_targ; |
716
|
|
|
|
|
|
PL_op = &dmy_op; |
717
|
|
|
|
|
|
(void)*(PL_ppaddr[OP_RAND])(aTHX); |
718
|
|
|
|
|
|
PL_op = old_op; |
719
|
|
|
|
|
|
#else |
720
|
|
|
|
|
|
/* Initialize Drand01 if rand() or srand() has |
721
|
|
|
|
|
|
not already been called |
722
|
|
|
|
|
|
*/ |
723
|
6
|
|
|
|
|
if (!PL_srand_called) { |
724
|
2
|
|
|
|
|
(void)seedDrand01((Rand_seed_t)Perl_seed(aTHX)); |
725
|
2
|
|
|
|
|
PL_srand_called = TRUE; |
726
|
|
|
|
|
|
} |
727
|
|
|
|
|
|
#endif |
728
|
|
|
|
|
|
|
729
|
210
|
|
|
|
|
for (index = items ; index > 1 ; ) { |
730
|
198
|
|
|
|
|
int swap = (int)(Drand01() * (double)(index--)); |
731
|
198
|
|
|
|
|
SV *tmp = ST(swap); |
732
|
198
|
|
|
|
|
ST(swap) = ST(index); |
733
|
198
|
|
|
|
|
ST(index) = tmp; |
734
|
|
|
|
|
|
} |
735
|
6
|
|
|
|
|
XSRETURN(items); |
736
|
|
|
|
|
|
} |
737
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
739
|
|
|
|
|
|
MODULE=List::Util PACKAGE=Scalar::Util |
740
|
|
|
|
|
|
|
741
|
|
|
|
|
|
void |
742
|
|
|
|
|
|
dualvar(num,str) |
743
|
|
|
|
|
|
SV * num |
744
|
|
|
|
|
|
SV * str |
745
|
|
|
|
|
|
PROTOTYPE: $$ |
746
|
|
|
|
|
|
CODE: |
747
|
576
|
|
|
|
|
{ |
748
|
576
|
|
|
|
|
dXSTARG; |
749
|
636
|
|
|
|
|
(void)SvUPGRADE(TARG, SVt_PVNV); |
750
|
576
|
|
|
|
|
sv_copypv(TARG,str); |
751
|
576
|
|
|
|
|
if(SvNOK(num) || SvPOK(num) || SvMAGICAL(num)) { |
752
|
8
|
|
|
|
|
SvNV_set(TARG, SvNV(num)); |
753
|
8
|
|
|
|
|
SvNOK_on(TARG); |
754
|
|
|
|
|
|
} |
755
|
|
|
|
|
|
#ifdef SVf_IVisUV |
756
|
568
|
|
|
|
|
else if (SvUOK(num)) { |
757
|
2
|
|
|
|
|
SvUV_set(TARG, SvUV(num)); |
758
|
2
|
|
|
|
|
SvIOK_on(TARG); |
759
|
2
|
|
|
|
|
SvIsUV_on(TARG); |
760
|
|
|
|
|
|
} |
761
|
|
|
|
|
|
#endif |
762
|
|
|
|
|
|
else { |
763
|
566
|
|
|
|
|
SvIV_set(TARG, SvIV(num)); |
764
|
566
|
|
|
|
|
SvIOK_on(TARG); |
765
|
|
|
|
|
|
} |
766
|
576
|
|
|
|
|
if(PL_tainting && (SvTAINTED(num) || SvTAINTED(str))) |
767
|
0
|
|
|
|
|
SvTAINTED_on(TARG); |
768
|
576
|
|
|
|
|
ST(0) = TARG; |
769
|
576
|
|
|
|
|
XSRETURN(1); |
770
|
|
|
|
|
|
} |
771
|
|
|
|
|
|
|
772
|
|
|
|
|
|
void |
773
|
|
|
|
|
|
isdual(sv) |
774
|
|
|
|
|
|
SV *sv |
775
|
|
|
|
|
|
PROTOTYPE: $ |
776
|
|
|
|
|
|
CODE: |
777
|
16
|
|
|
|
|
if (SvMAGICAL(sv)) |
778
|
0
|
|
|
|
|
mg_get(sv); |
779
|
16
|
|
|
|
|
ST(0) = boolSV((SvPOK(sv) || SvPOKp(sv)) && (SvNIOK(sv) || SvNIOKp(sv))); |
780
|
16
|
|
|
|
|
XSRETURN(1); |
781
|
|
|
|
|
|
|
782
|
|
|
|
|
|
char * |
783
|
|
|
|
|
|
blessed(sv) |
784
|
|
|
|
|
|
SV * sv |
785
|
|
|
|
|
|
PROTOTYPE: $ |
786
|
|
|
|
|
|
CODE: |
787
|
|
|
|
|
|
{ |
788
|
75304
|
|
|
|
|
SvGETMAGIC(sv); |
789
|
75302
|
|
|
|
|
if(!(SvROK(sv) && SvOBJECT(SvRV(sv)))) { |
790
|
61798
|
|
|
|
|
XSRETURN_UNDEF; |
791
|
|
|
|
|
|
} |
792
|
13504
|
|
|
|
|
RETVAL = (char*)sv_reftype(SvRV(sv),TRUE); |
793
|
|
|
|
|
|
} |
794
|
|
|
|
|
|
OUTPUT: |
795
|
|
|
|
|
|
RETVAL |
796
|
|
|
|
|
|
|
797
|
|
|
|
|
|
char * |
798
|
|
|
|
|
|
reftype(sv) |
799
|
|
|
|
|
|
SV * sv |
800
|
|
|
|
|
|
PROTOTYPE: $ |
801
|
|
|
|
|
|
CODE: |
802
|
|
|
|
|
|
{ |
803
|
29284
|
|
|
|
|
SvGETMAGIC(sv); |
804
|
29282
|
|
|
|
|
if(!SvROK(sv)) { |
805
|
24240
|
|
|
|
|
XSRETURN_UNDEF; |
806
|
|
|
|
|
|
} |
807
|
5042
|
|
|
|
|
RETVAL = (char*)sv_reftype(SvRV(sv),FALSE); |
808
|
|
|
|
|
|
} |
809
|
|
|
|
|
|
OUTPUT: |
810
|
|
|
|
|
|
RETVAL |
811
|
|
|
|
|
|
|
812
|
|
|
|
|
|
UV |
813
|
|
|
|
|
|
refaddr(sv) |
814
|
|
|
|
|
|
SV * sv |
815
|
|
|
|
|
|
PROTOTYPE: $ |
816
|
|
|
|
|
|
CODE: |
817
|
|
|
|
|
|
{ |
818
|
23290
|
|
|
|
|
SvGETMAGIC(sv); |
819
|
23284
|
|
|
|
|
if(!SvROK(sv)) { |
820
|
6
|
|
|
|
|
XSRETURN_UNDEF; |
821
|
|
|
|
|
|
} |
822
|
23278
|
|
|
|
|
RETVAL = PTR2UV(SvRV(sv)); |
823
|
|
|
|
|
|
} |
824
|
|
|
|
|
|
OUTPUT: |
825
|
|
|
|
|
|
RETVAL |
826
|
|
|
|
|
|
|
827
|
|
|
|
|
|
void |
828
|
|
|
|
|
|
weaken(sv) |
829
|
|
|
|
|
|
SV *sv |
830
|
|
|
|
|
|
PROTOTYPE: $ |
831
|
|
|
|
|
|
CODE: |
832
|
|
|
|
|
|
#ifdef SvWEAKREF |
833
|
90
|
|
|
|
|
sv_rvweaken(sv); |
834
|
|
|
|
|
|
#else |
835
|
|
|
|
|
|
croak("weak references are not implemented in this release of perl"); |
836
|
|
|
|
|
|
#endif |
837
|
|
|
|
|
|
|
838
|
|
|
|
|
|
void |
839
|
|
|
|
|
|
isweak(sv) |
840
|
|
|
|
|
|
SV *sv |
841
|
|
|
|
|
|
PROTOTYPE: $ |
842
|
|
|
|
|
|
CODE: |
843
|
|
|
|
|
|
#ifdef SvWEAKREF |
844
|
82
|
|
|
|
|
ST(0) = boolSV(SvROK(sv) && SvWEAKREF(sv)); |
845
|
82
|
|
|
|
|
XSRETURN(1); |
846
|
|
|
|
|
|
#else |
847
|
|
|
|
|
|
croak("weak references are not implemented in this release of perl"); |
848
|
|
|
|
|
|
#endif |
849
|
|
|
|
|
|
|
850
|
|
|
|
|
|
int |
851
|
|
|
|
|
|
readonly(sv) |
852
|
|
|
|
|
|
SV *sv |
853
|
|
|
|
|
|
PROTOTYPE: $ |
854
|
|
|
|
|
|
CODE: |
855
|
1164898
|
|
|
|
|
SvGETMAGIC(sv); |
856
|
1163694
|
|
|
|
|
RETVAL = SvREADONLY(sv); |
857
|
|
|
|
|
|
OUTPUT: |
858
|
|
|
|
|
|
RETVAL |
859
|
|
|
|
|
|
|
860
|
|
|
|
|
|
int |
861
|
|
|
|
|
|
tainted(sv) |
862
|
|
|
|
|
|
SV *sv |
863
|
|
|
|
|
|
PROTOTYPE: $ |
864
|
|
|
|
|
|
CODE: |
865
|
6
|
|
|
|
|
SvGETMAGIC(sv); |
866
|
4
|
|
|
|
|
RETVAL = SvTAINTED(sv); |
867
|
|
|
|
|
|
OUTPUT: |
868
|
|
|
|
|
|
RETVAL |
869
|
|
|
|
|
|
|
870
|
|
|
|
|
|
void |
871
|
|
|
|
|
|
isvstring(sv) |
872
|
|
|
|
|
|
SV *sv |
873
|
|
|
|
|
|
PROTOTYPE: $ |
874
|
|
|
|
|
|
CODE: |
875
|
|
|
|
|
|
#ifdef SvVOK |
876
|
4
|
|
|
|
|
SvGETMAGIC(sv); |
877
|
4
|
|
|
|
|
ST(0) = boolSV(SvVOK(sv)); |
878
|
4
|
|
|
|
|
XSRETURN(1); |
879
|
|
|
|
|
|
#else |
880
|
|
|
|
|
|
croak("vstrings are not implemented in this release of perl"); |
881
|
|
|
|
|
|
#endif |
882
|
|
|
|
|
|
|
883
|
|
|
|
|
|
int |
884
|
|
|
|
|
|
looks_like_number(sv) |
885
|
|
|
|
|
|
SV *sv |
886
|
|
|
|
|
|
PROTOTYPE: $ |
887
|
|
|
|
|
|
CODE: |
888
|
|
|
|
|
|
SV *tempsv; |
889
|
112
|
|
|
|
|
SvGETMAGIC(sv); |
890
|
108
|
|
|
|
|
if (SvAMAGIC(sv) && (tempsv = AMG_CALLun(sv, numer))) { |
891
|
|
|
|
|
|
sv = tempsv; |
892
|
|
|
|
|
|
} |
893
|
|
|
|
|
|
#if PERL_BCDVERSION < 0x5008005 |
894
|
|
|
|
|
|
if (SvPOK(sv) || SvPOKp(sv)) { |
895
|
|
|
|
|
|
RETVAL = looks_like_number(sv); |
896
|
|
|
|
|
|
} |
897
|
|
|
|
|
|
else { |
898
|
|
|
|
|
|
RETVAL = SvFLAGS(sv) & (SVf_NOK|SVp_NOK|SVf_IOK|SVp_IOK); |
899
|
|
|
|
|
|
} |
900
|
|
|
|
|
|
#else |
901
|
108
|
|
|
|
|
RETVAL = looks_like_number(sv); |
902
|
|
|
|
|
|
#endif |
903
|
|
|
|
|
|
OUTPUT: |
904
|
|
|
|
|
|
RETVAL |
905
|
|
|
|
|
|
|
906
|
|
|
|
|
|
void |
907
|
|
|
|
|
|
set_prototype(subref, proto) |
908
|
|
|
|
|
|
SV *subref |
909
|
|
|
|
|
|
SV *proto |
910
|
|
|
|
|
|
PROTOTYPE: &$ |
911
|
|
|
|
|
|
CODE: |
912
|
|
|
|
|
|
{ |
913
|
2746
|
|
|
|
|
if (SvROK(subref)) { |
914
|
2744
|
|
|
|
|
SV *sv = SvRV(subref); |
915
|
2744
|
|
|
|
|
if (SvTYPE(sv) != SVt_PVCV) { |
916
|
|
|
|
|
|
/* not a subroutine reference */ |
917
|
2
|
|
|
|
|
croak("set_prototype: not a subroutine reference"); |
918
|
|
|
|
|
|
} |
919
|
2742
|
|
|
|
|
if (SvPOK(proto)) { |
920
|
|
|
|
|
|
/* set the prototype */ |
921
|
2738
|
|
|
|
|
sv_copypv(sv, proto); |
922
|
|
|
|
|
|
} |
923
|
|
|
|
|
|
else { |
924
|
|
|
|
|
|
/* delete the prototype */ |
925
|
4
|
|
|
|
|
SvPOK_off(sv); |
926
|
|
|
|
|
|
} |
927
|
|
|
|
|
|
} |
928
|
|
|
|
|
|
else { |
929
|
2
|
|
|
|
|
croak("set_prototype: not a reference"); |
930
|
|
|
|
|
|
} |
931
|
2742
|
|
|
|
|
XSRETURN(1); |
932
|
|
|
|
|
|
} |
933
|
|
|
|
|
|
|
934
|
|
|
|
|
|
void |
935
|
|
|
|
|
|
openhandle(SV* sv) |
936
|
|
|
|
|
|
PROTOTYPE: $ |
937
|
|
|
|
|
|
CODE: |
938
|
40
|
|
|
|
|
{ |
939
|
|
|
|
|
|
IO* io = NULL; |
940
|
40
|
|
|
|
|
SvGETMAGIC(sv); |
941
|
40
|
|
|
|
|
if(SvROK(sv)){ |
942
|
|
|
|
|
|
/* deref first */ |
943
|
26
|
|
|
|
|
sv = SvRV(sv); |
944
|
|
|
|
|
|
} |
945
|
|
|
|
|
|
|
946
|
|
|
|
|
|
/* must be GLOB or IO */ |
947
|
40
|
|
|
|
|
if(isGV(sv)){ |
948
|
32
|
|
|
|
|
io = GvIO((GV*)sv); |
949
|
|
|
|
|
|
} |
950
|
8
|
|
|
|
|
else if(SvTYPE(sv) == SVt_PVIO){ |
951
|
|
|
|
|
|
io = (IO*)sv; |
952
|
|
|
|
|
|
} |
953
|
|
|
|
|
|
|
954
|
40
|
|
|
|
|
if(io){ |
955
|
|
|
|
|
|
/* real or tied filehandle? */ |
956
|
28
|
|
|
|
|
if(IoIFP(io) || SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)){ |
957
|
22
|
|
|
|
|
XSRETURN(1); |
958
|
|
|
|
|
|
} |
959
|
|
|
|
|
|
} |
960
|
18
|
|
|
|
|
XSRETURN_UNDEF; |
961
|
|
|
|
|
|
} |
962
|
|
|
|
|
|
|
963
|
|
|
|
|
|
BOOT: |
964
|
|
|
|
|
|
{ |
965
|
5956
|
|
|
|
|
HV *lu_stash = gv_stashpvn("List::Util", 10, TRUE); |
966
|
5956
|
|
|
|
|
GV *rmcgv = *(GV**)hv_fetch(lu_stash, "REAL_MULTICALL", 14, TRUE); |
967
|
|
|
|
|
|
SV *rmcsv; |
968
|
|
|
|
|
|
#if !defined(SvWEAKREF) || !defined(SvVOK) |
969
|
|
|
|
|
|
HV *su_stash = gv_stashpvn("Scalar::Util", 12, TRUE); |
970
|
|
|
|
|
|
GV *vargv = *(GV**)hv_fetch(su_stash, "EXPORT_FAIL", 11, TRUE); |
971
|
|
|
|
|
|
AV *varav; |
972
|
|
|
|
|
|
if (SvTYPE(vargv) != SVt_PVGV) |
973
|
|
|
|
|
|
gv_init(vargv, su_stash, "Scalar::Util", 12, TRUE); |
974
|
|
|
|
|
|
varav = GvAVn(vargv); |
975
|
|
|
|
|
|
#endif |
976
|
5956
|
|
|
|
|
if (SvTYPE(rmcgv) != SVt_PVGV) |
977
|
5956
|
|
|
|
|
gv_init(rmcgv, lu_stash, "List::Util", 10, TRUE); |
978
|
5956
|
|
|
|
|
rmcsv = GvSVn(rmcgv); |
979
|
|
|
|
|
|
#ifndef SvWEAKREF |
980
|
|
|
|
|
|
av_push(varav, newSVpv("weaken",6)); |
981
|
|
|
|
|
|
av_push(varav, newSVpv("isweak",6)); |
982
|
|
|
|
|
|
#endif |
983
|
|
|
|
|
|
#ifndef SvVOK |
984
|
|
|
|
|
|
av_push(varav, newSVpv("isvstring",9)); |
985
|
|
|
|
|
|
#endif |
986
|
|
|
|
|
|
#ifdef REAL_MULTICALL |
987
|
5956
|
|
|
|
|
sv_setsv(rmcsv, &PL_sv_yes); |
988
|
|
|
|
|
|
#else |
989
|
|
|
|
|
|
sv_setsv(rmcsv, &PL_sv_no); |
990
|
|
|
|
|
|
#endif |
991
|
|
|
|
|
|
} |