line |
stmt |
bran |
cond |
sub |
time |
code |
1
|
|
|
|
|
|
/* pp.c |
2
|
|
|
|
|
|
* |
3
|
|
|
|
|
|
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, |
4
|
|
|
|
|
|
* 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others |
5
|
|
|
|
|
|
* |
6
|
|
|
|
|
|
* You may distribute under the terms of either the GNU General Public |
7
|
|
|
|
|
|
* License or the Artistic License, as specified in the README file. |
8
|
|
|
|
|
|
* |
9
|
|
|
|
|
|
*/ |
10
|
|
|
|
|
|
|
11
|
|
|
|
|
|
/* |
12
|
|
|
|
|
|
* 'It's a big house this, and very peculiar. Always a bit more |
13
|
|
|
|
|
|
* to discover, and no knowing what you'll find round a corner. |
14
|
|
|
|
|
|
* And Elves, sir!' --Samwise Gamgee |
15
|
|
|
|
|
|
* |
16
|
|
|
|
|
|
* [p.225 of _The Lord of the Rings_, II/i: "Many Meetings"] |
17
|
|
|
|
|
|
*/ |
18
|
|
|
|
|
|
|
19
|
|
|
|
|
|
/* This file contains general pp ("push/pop") functions that execute the |
20
|
|
|
|
|
|
* opcodes that make up a perl program. A typical pp function expects to |
21
|
|
|
|
|
|
* find its arguments on the stack, and usually pushes its results onto |
22
|
|
|
|
|
|
* the stack, hence the 'pp' terminology. Each OP structure contains |
23
|
|
|
|
|
|
* a pointer to the relevant pp_foo() function. |
24
|
|
|
|
|
|
*/ |
25
|
|
|
|
|
|
|
26
|
|
|
|
|
|
#include "EXTERN.h" |
27
|
|
|
|
|
|
#define PERL_IN_PP_C |
28
|
|
|
|
|
|
#include "perl.h" |
29
|
|
|
|
|
|
#include "keywords.h" |
30
|
|
|
|
|
|
|
31
|
|
|
|
|
|
#include "reentr.h" |
32
|
|
|
|
|
|
#include "regcharclass.h" |
33
|
|
|
|
|
|
|
34
|
|
|
|
|
|
/* XXX I can't imagine anyone who doesn't have this actually _needs_ |
35
|
|
|
|
|
|
it, since pid_t is an integral type. |
36
|
|
|
|
|
|
--AD 2/20/1998 |
37
|
|
|
|
|
|
*/ |
38
|
|
|
|
|
|
#ifdef NEED_GETPID_PROTO |
39
|
|
|
|
|
|
extern Pid_t getpid (void); |
40
|
|
|
|
|
|
#endif |
41
|
|
|
|
|
|
|
42
|
|
|
|
|
|
/* |
43
|
|
|
|
|
|
* Some BSDs and Cygwin default to POSIX math instead of IEEE. |
44
|
|
|
|
|
|
* This switches them over to IEEE. |
45
|
|
|
|
|
|
*/ |
46
|
|
|
|
|
|
#if defined(LIBM_LIB_VERSION) |
47
|
|
|
|
|
|
_LIB_VERSION_TYPE _LIB_VERSION = _IEEE_; |
48
|
|
|
|
|
|
#endif |
49
|
|
|
|
|
|
|
50
|
|
|
|
|
|
static const STRLEN small_mu_len = sizeof(GREEK_SMALL_LETTER_MU_UTF8) - 1; |
51
|
|
|
|
|
|
static const STRLEN capital_iota_len = sizeof(GREEK_CAPITAL_LETTER_IOTA_UTF8) - 1; |
52
|
|
|
|
|
|
|
53
|
|
|
|
|
|
/* variations on pp_null */ |
54
|
|
|
|
|
|
|
55
|
255711072
|
|
|
|
|
PP(pp_stub) |
56
|
|
|
|
|
|
{ |
57
|
|
|
|
|
|
dVAR; |
58
|
255711072
|
|
|
|
|
dSP; |
59
|
255711072
|
100
|
|
|
|
if (GIMME_V == G_SCALAR) |
|
|
100
|
|
|
|
|
60
|
44276
|
50
|
|
|
|
XPUSHs(&PL_sv_undef); |
61
|
255711072
|
|
|
|
|
RETURN; |
62
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
64
|
|
|
|
|
|
/* Pushy stuff. */ |
65
|
|
|
|
|
|
|
66
|
103353002
|
|
|
|
|
PP(pp_padav) |
67
|
103353002
|
50
|
|
|
|
{ |
68
|
103353002
|
|
|
|
|
dVAR; dSP; dTARGET; |
69
|
|
|
|
|
|
I32 gimme; |
70
|
|
|
|
|
|
assert(SvTYPE(TARG) == SVt_PVAV); |
71
|
103353002
|
100
|
|
|
|
if (UNLIKELY( PL_op->op_private & OPpLVAL_INTRO )) |
72
|
12610620
|
100
|
|
|
|
if (LIKELY( !(PL_op->op_private & OPpPAD_STATE) )) |
73
|
12610616
|
|
|
|
|
SAVECLEARSV(PAD_SVl(PL_op->op_targ)); |
74
|
51610859
|
|
|
|
|
EXTEND(SP, 1); |
75
|
103353002
|
100
|
|
|
|
if (PL_op->op_flags & OPf_REF) { |
76
|
47129536
|
|
|
|
|
PUSHs(TARG); |
77
|
47129536
|
|
|
|
|
RETURN; |
78
|
56223466
|
100
|
|
|
|
} else if (PL_op->op_private & OPpMAYBE_LVSUB) { |
79
|
28
|
|
|
|
|
const I32 flags = is_lvalue_sub(); |
80
|
28
|
50
|
|
|
|
if (flags && !(flags & OPpENTERSUB_INARGS)) { |
|
|
100
|
|
|
|
|
81
|
2
|
50
|
|
|
|
if (GIMME == G_SCALAR) |
|
|
50
|
|
|
|
|
82
|
|
|
|
|
|
/* diag_listed_as: Can't return %s to lvalue scalar context */ |
83
|
0
|
|
|
|
|
Perl_croak(aTHX_ "Can't return array to lvalue scalar context"); |
84
|
2
|
|
|
|
|
PUSHs(TARG); |
85
|
2
|
|
|
|
|
RETURN; |
86
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
} |
88
|
56223464
|
100
|
|
|
|
gimme = GIMME_V; |
89
|
70896673
|
100
|
|
|
|
if (gimme == G_ARRAY) { |
|
|
100
|
|
|
|
|
90
|
|
|
|
|
|
/* XXX see also S_pushav in pp_hot.c */ |
91
|
14673211
|
100
|
|
|
|
const Size_t maxarg = AvFILL(MUTABLE_AV(TARG)) + 1; |
92
|
7318723
|
|
|
|
|
EXTEND(SP, maxarg); |
93
|
14673209
|
100
|
|
|
|
if (SvMAGICAL(TARG)) { |
94
|
|
|
|
|
|
Size_t i; |
95
|
289772
|
100
|
|
|
|
for (i=0; i < maxarg; i++) { |
96
|
275270
|
|
|
|
|
SV * const * const svp = av_fetch(MUTABLE_AV(TARG), i, FALSE); |
97
|
275270
|
50
|
|
|
|
SP[i+1] = (svp) ? *svp : &PL_sv_undef; |
98
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
else { |
101
|
|
|
|
|
|
PADOFFSET i; |
102
|
42918854
|
100
|
|
|
|
for (i=0; i < (PADOFFSET)maxarg; i++) { |
103
|
35578816
|
|
|
|
|
SV * const sv = AvARRAY((const AV *)TARG)[i]; |
104
|
35578816
|
100
|
|
|
|
SP[i+1] = sv ? sv : &PL_sv_undef; |
105
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
} |
107
|
14673209
|
|
|
|
|
SP += maxarg; |
108
|
|
|
|
|
|
} |
109
|
41550253
|
100
|
|
|
|
else if (gimme == G_SCALAR) { |
110
|
29093691
|
|
|
|
|
SV* const sv = sv_newmortal(); |
111
|
29093691
|
100
|
|
|
|
const SSize_t maxarg = AvFILL(MUTABLE_AV(TARG)) + 1; |
112
|
29093691
|
|
|
|
|
sv_setiv(sv, maxarg); |
113
|
29093691
|
|
|
|
|
PUSHs(sv); |
114
|
|
|
|
|
|
} |
115
|
79798480
|
|
|
|
|
RETURN; |
116
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
118
|
116251963
|
|
|
|
|
PP(pp_padhv) |
119
|
|
|
|
|
|
{ |
120
|
116251963
|
|
|
|
|
dVAR; dSP; dTARGET; |
121
|
|
|
|
|
|
I32 gimme; |
122
|
|
|
|
|
|
|
123
|
|
|
|
|
|
assert(SvTYPE(TARG) == SVt_PVHV); |
124
|
116251963
|
50
|
|
|
|
XPUSHs(TARG); |
125
|
116251963
|
100
|
|
|
|
if (UNLIKELY( PL_op->op_private & OPpLVAL_INTRO )) |
126
|
799165
|
100
|
|
|
|
if (LIKELY( !(PL_op->op_private & OPpPAD_STATE) )) |
127
|
798153
|
|
|
|
|
SAVECLEARSV(PAD_SVl(PL_op->op_targ)); |
128
|
116251963
|
100
|
|
|
|
if (PL_op->op_flags & OPf_REF) |
129
|
115120586
|
|
|
|
|
RETURN; |
130
|
1131377
|
100
|
|
|
|
else if (PL_op->op_private & OPpMAYBE_LVSUB) { |
131
|
4
|
|
|
|
|
const I32 flags = is_lvalue_sub(); |
132
|
4
|
50
|
|
|
|
if (flags && !(flags & OPpENTERSUB_INARGS)) { |
|
|
100
|
|
|
|
|
133
|
2
|
50
|
|
|
|
if (GIMME == G_SCALAR) |
|
|
50
|
|
|
|
|
134
|
|
|
|
|
|
/* diag_listed_as: Can't return %s to lvalue scalar context */ |
135
|
0
|
|
|
|
|
Perl_croak(aTHX_ "Can't return hash to lvalue scalar context"); |
136
|
2
|
|
|
|
|
RETURN; |
137
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
} |
139
|
1131375
|
100
|
|
|
|
gimme = GIMME_V; |
140
|
1131375
|
100
|
|
|
|
if (gimme == G_ARRAY) { |
141
|
326156
|
|
|
|
|
RETURNOP(Perl_do_kv(aTHX)); |
142
|
|
|
|
|
|
} |
143
|
805219
|
100
|
|
|
|
else if ((PL_op->op_private & OPpTRUEBOOL |
144
|
801865
|
50
|
|
|
|
|| ( PL_op->op_private & OPpMAYBE_TRUEBOOL |
145
|
0
|
0
|
|
|
|
&& block_gimme() == G_VOID )) |
146
|
3354
|
100
|
|
|
|
&& (!SvRMAGICAL(TARG) || !mg_find(TARG, PERL_MAGIC_tied))) |
|
|
50
|
|
|
|
|
147
|
3344
|
50
|
|
|
|
SETs(HvUSEDKEYS(TARG) ? &PL_sv_yes : sv_2mortal(newSViv(0))); |
|
|
100
|
|
|
|
|
148
|
801875
|
100
|
|
|
|
else if (gimme == G_SCALAR) { |
149
|
2720
|
|
|
|
|
SV* const sv = Perl_hv_scalar(aTHX_ MUTABLE_HV(TARG)); |
150
|
2720
|
|
|
|
|
SETs(sv); |
151
|
|
|
|
|
|
} |
152
|
58873395
|
|
|
|
|
RETURN; |
153
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
155
|
420
|
|
|
|
|
PP(pp_padcv) |
156
|
|
|
|
|
|
{ |
157
|
420
|
|
|
|
|
dVAR; dSP; dTARGET; |
158
|
|
|
|
|
|
assert(SvTYPE(TARG) == SVt_PVCV); |
159
|
420
|
50
|
|
|
|
XPUSHs(TARG); |
160
|
420
|
|
|
|
|
RETURN; |
161
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
163
|
118
|
|
|
|
|
PP(pp_introcv) |
164
|
|
|
|
|
|
{ |
165
|
118
|
|
|
|
|
dVAR; dTARGET; |
166
|
|
|
|
|
|
SvPADSTALE_off(TARG); |
167
|
118
|
|
|
|
|
return NORMAL; |
168
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
170
|
118
|
|
|
|
|
PP(pp_clonecv) |
171
|
|
|
|
|
|
{ |
172
|
118
|
|
|
|
|
dVAR; dTARGET; |
173
|
118
|
|
|
|
|
MAGIC * const mg = |
174
|
118
|
|
|
|
|
mg_find(PadlistNAMESARRAY(CvPADLIST(find_runcv(NULL)))[ARGTARG], |
175
|
|
|
|
|
|
PERL_MAGIC_proto); |
176
|
|
|
|
|
|
assert(SvTYPE(TARG) == SVt_PVCV); |
177
|
|
|
|
|
|
assert(mg); |
178
|
|
|
|
|
|
assert(mg->mg_obj); |
179
|
118
|
100
|
|
|
|
if (CvISXSUB(mg->mg_obj)) { /* constant */ |
180
|
|
|
|
|
|
/* XXX Should we clone it here? */ |
181
|
|
|
|
|
|
/* If this changes to use SAVECLEARSV, we can move the SAVECLEARSV |
182
|
|
|
|
|
|
to introcv and remove the SvPADSTALE_off. */ |
183
|
12
|
|
|
|
|
SAVEPADSVANDMORTALIZE(ARGTARG); |
184
|
12
|
|
|
|
|
PAD_SVl(ARGTARG) = SvREFCNT_inc_simple_NN(mg->mg_obj); |
185
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
else { |
187
|
|
|
|
|
|
if (CvROOT(mg->mg_obj)) { |
188
|
|
|
|
|
|
assert(CvCLONE(mg->mg_obj)); |
189
|
|
|
|
|
|
assert(!CvCLONED(mg->mg_obj)); |
190
|
|
|
|
|
|
} |
191
|
106
|
|
|
|
|
cv_clone_into((CV *)mg->mg_obj,(CV *)TARG); |
192
|
106
|
|
|
|
|
SAVECLEARSV(PAD_SVl(ARGTARG)); |
193
|
|
|
|
|
|
} |
194
|
118
|
|
|
|
|
return NORMAL; |
195
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
197
|
|
|
|
|
|
/* Translations. */ |
198
|
|
|
|
|
|
|
199
|
|
|
|
|
|
static const char S_no_symref_sv[] = |
200
|
|
|
|
|
|
"Can't use string (\"%" SVf32 "\"%s) as %s ref while \"strict refs\" in use"; |
201
|
|
|
|
|
|
|
202
|
|
|
|
|
|
/* In some cases this function inspects PL_op. If this function is called |
203
|
|
|
|
|
|
for new op types, more bool parameters may need to be added in place of |
204
|
|
|
|
|
|
the checks. |
205
|
|
|
|
|
|
|
206
|
|
|
|
|
|
When noinit is true, the absence of a gv will cause a retval of undef. |
207
|
|
|
|
|
|
This is unrelated to the cv-to-gv assignment case. |
208
|
|
|
|
|
|
*/ |
209
|
|
|
|
|
|
|
210
|
|
|
|
|
|
static SV * |
211
|
85232622
|
|
|
|
|
S_rv2gv(pTHX_ SV *sv, const bool vivify_sv, const bool strict, |
212
|
|
|
|
|
|
const bool noinit) |
213
|
|
|
|
|
|
{ |
214
|
|
|
|
|
|
dVAR; |
215
|
85232622
|
100
|
|
|
|
if (!isGV(sv) || SvFAKE(sv)) SvGETMAGIC(sv); |
|
|
100
|
|
|
|
|
216
|
85232622
|
100
|
|
|
|
if (SvROK(sv)) { |
217
|
43091155
|
50
|
|
|
|
if (SvAMAGIC(sv)) { |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
218
|
2452
|
|
|
|
|
sv = amagic_deref_call(sv, to_gv_amg); |
219
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
wasref: |
221
|
45564217
|
|
|
|
|
sv = SvRV(sv); |
222
|
45564217
|
100
|
|
|
|
if (SvTYPE(sv) == SVt_PVIO) { |
223
|
196944
|
|
|
|
|
GV * const gv = MUTABLE_GV(sv_newmortal()); |
224
|
196944
|
|
|
|
|
gv_init(gv, 0, "__ANONIO__", 10, 0); |
225
|
196944
|
|
|
|
|
GvIOp(gv) = MUTABLE_IO(sv); |
226
|
196944
|
|
|
|
|
SvREFCNT_inc_void_NN(sv); |
227
|
|
|
|
|
|
sv = MUTABLE_SV(gv); |
228
|
|
|
|
|
|
} |
229
|
45367273
|
100
|
|
|
|
else if (!isGV_with_GP(sv)) |
|
|
50
|
|
|
|
|
230
|
12
|
|
|
|
|
return (SV *)Perl_die(aTHX_ "Not a GLOB reference"); |
231
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
else { |
233
|
42141467
|
100
|
|
|
|
if (!isGV_with_GP(sv)) { |
|
|
50
|
|
|
|
|
234
|
35642828
|
100
|
|
|
|
if (!SvOK(sv)) { |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
235
|
|
|
|
|
|
/* If this is a 'my' scalar and flag is set then vivify |
236
|
|
|
|
|
|
* NI-S 1999/05/07 |
237
|
|
|
|
|
|
*/ |
238
|
2473108
|
100
|
|
|
|
if (vivify_sv && sv != &PL_sv_undef) { |
|
|
50
|
|
|
|
|
239
|
|
|
|
|
|
GV *gv; |
240
|
2473064
|
50
|
|
|
|
if (SvREADONLY(sv)) |
241
|
0
|
|
|
|
|
Perl_croak_no_modify(); |
242
|
2473064
|
100
|
|
|
|
if (cUNOP->op_targ) { |
243
|
2473036
|
|
|
|
|
SV * const namesv = PAD_SV(cUNOP->op_targ); |
244
|
2473036
|
|
|
|
|
HV *stash = CopSTASH(PL_curcop); |
245
|
2473036
|
100
|
|
|
|
if (SvTYPE(stash) != SVt_PVHV) stash = NULL; |
246
|
2473036
|
|
|
|
|
gv = MUTABLE_GV(newSV(0)); |
247
|
2473036
|
|
|
|
|
gv_init_sv(gv, stash, namesv, 0); |
248
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
else { |
250
|
28
|
50
|
|
|
|
const char * const name = CopSTASHPV(PL_curcop); |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
251
|
28
|
50
|
|
|
|
gv = newGVgen_flags(name, |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
252
|
|
|
|
|
|
HvNAMEUTF8(CopSTASH(PL_curcop)) ? SVf_UTF8 : 0 ); |
253
|
|
|
|
|
|
} |
254
|
2473064
|
100
|
|
|
|
prepare_SV_for_RV(sv); |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
255
|
2473064
|
|
|
|
|
SvRV_set(sv, MUTABLE_SV(gv)); |
256
|
2473064
|
|
|
|
|
SvROK_on(sv); |
257
|
2473064
|
100
|
|
|
|
SvSETMAGIC(sv); |
258
|
|
|
|
|
|
goto wasref; |
259
|
|
|
|
|
|
} |
260
|
44
|
100
|
|
|
|
if (PL_op->op_flags & OPf_REF || strict) |
|
|
100
|
|
|
|
|
261
|
8
|
|
|
|
|
return (SV *)Perl_die(aTHX_ PL_no_usym, "a symbol"); |
262
|
36
|
100
|
|
|
|
if (ckWARN(WARN_UNINITIALIZED)) |
263
|
22
|
|
|
|
|
report_uninit(sv); |
264
|
|
|
|
|
|
return &PL_sv_undef; |
265
|
|
|
|
|
|
} |
266
|
33169720
|
100
|
|
|
|
if (noinit) |
267
|
|
|
|
|
|
{ |
268
|
12212
|
100
|
|
|
|
if (!(sv = MUTABLE_SV(gv_fetchsv_nomg( |
269
|
|
|
|
|
|
sv, GV_ADDMG, SVt_PVGV |
270
|
|
|
|
|
|
)))) |
271
|
|
|
|
|
|
return &PL_sv_undef; |
272
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
else { |
274
|
33157508
|
100
|
|
|
|
if (strict) |
275
|
8
|
|
|
|
|
return |
276
|
8
|
100
|
|
|
|
(SV *)Perl_die(aTHX_ |
277
|
|
|
|
|
|
S_no_symref_sv, |
278
|
|
|
|
|
|
sv, |
279
|
11
|
100
|
|
|
|
(SvPOKp(sv) && SvCUR(sv)>32 ? "..." : ""), |
280
|
|
|
|
|
|
"a symbol" |
281
|
|
|
|
|
|
); |
282
|
33157500
|
100
|
|
|
|
if ((PL_op->op_private & (OPpLVAL_INTRO|OPpDONT_INIT_GV)) |
283
|
|
|
|
|
|
== OPpDONT_INIT_GV) { |
284
|
|
|
|
|
|
/* We are the target of a coderef assignment. Return |
285
|
|
|
|
|
|
the scalar unchanged, and let pp_sasssign deal with |
286
|
|
|
|
|
|
things. */ |
287
|
|
|
|
|
|
return sv; |
288
|
|
|
|
|
|
} |
289
|
31490688
|
|
|
|
|
sv = MUTABLE_SV(gv_fetchsv_nomg(sv, GV_ADD, SVt_PVGV)); |
290
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
/* FAKE globs in the symbol table cause weird bugs (#77810) */ |
292
|
31502566
|
|
|
|
|
SvFAKE_off(sv); |
293
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
} |
295
|
83565410
|
100
|
|
|
|
if (SvFAKE(sv) && !(PL_op->op_private & OPpALLOW_FAKE)) { |
|
|
100
|
|
|
|
|
296
|
166432
|
|
|
|
|
SV *newsv = sv_newmortal(); |
297
|
166432
|
|
|
|
|
sv_setsv_flags(newsv, sv, 0); |
298
|
166432
|
|
|
|
|
SvFAKE_off(newsv); |
299
|
|
|
|
|
|
sv = newsv; |
300
|
|
|
|
|
|
} |
301
|
84405783
|
|
|
|
|
return sv; |
302
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
304
|
85232560
|
|
|
|
|
PP(pp_rv2gv) |
305
|
|
|
|
|
|
{ |
306
|
85232560
|
|
|
|
|
dVAR; dSP; dTOPss; |
307
|
|
|
|
|
|
|
308
|
170383430
|
|
|
|
|
sv = S_rv2gv(aTHX_ |
309
|
85232560
|
|
|
|
|
sv, PL_op->op_private & OPpDEREF, |
310
|
85232560
|
|
|
|
|
PL_op->op_private & HINT_STRICT_REFS, |
311
|
47037193
|
100
|
|
|
|
((PL_op->op_flags & OPf_SPECIAL) && !(PL_op->op_flags & OPf_MOD)) |
312
|
128651537
|
100
|
|
|
|
|| PL_op->op_type == OP_READLINE |
|
|
100
|
|
|
|
|
313
|
|
|
|
|
|
); |
314
|
85232420
|
100
|
|
|
|
if (PL_op->op_private & OPpLVAL_INTRO) |
315
|
2701347
|
|
|
|
|
save_gp(MUTABLE_GV(sv), !(PL_op->op_flags & OPf_SPECIAL)); |
316
|
85232420
|
|
|
|
|
SETs(sv); |
317
|
85232420
|
|
|
|
|
RETURN; |
318
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
320
|
|
|
|
|
|
/* Helper function for pp_rv2sv and pp_rv2av */ |
321
|
|
|
|
|
|
GV * |
322
|
5543774
|
|
|
|
|
Perl_softref2xv(pTHX_ SV *const sv, const char *const what, |
323
|
|
|
|
|
|
const svtype type, SV ***spp) |
324
|
|
|
|
|
|
{ |
325
|
|
|
|
|
|
dVAR; |
326
|
|
|
|
|
|
GV *gv; |
327
|
|
|
|
|
|
|
328
|
|
|
|
|
|
PERL_ARGS_ASSERT_SOFTREF2XV; |
329
|
|
|
|
|
|
|
330
|
5543774
|
100
|
|
|
|
if (PL_op->op_private & HINT_STRICT_REFS) { |
331
|
78
|
100
|
|
|
|
if (SvOK(sv)) |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
332
|
140
|
100
|
|
|
|
Perl_die(aTHX_ S_no_symref_sv, sv, |
333
|
104
|
100
|
|
|
|
(SvPOKp(sv) && SvCUR(sv)>32 ? "..." : ""), what); |
334
|
|
|
|
|
|
else |
335
|
8
|
|
|
|
|
Perl_die(aTHX_ PL_no_usym, what); |
336
|
|
|
|
|
|
} |
337
|
5543696
|
100
|
|
|
|
if (!SvOK(sv)) { |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
338
|
78
|
50
|
|
|
|
if ( |
339
|
78
|
|
|
|
|
PL_op->op_flags & OPf_REF |
340
|
|
|
|
|
|
) |
341
|
0
|
|
|
|
|
Perl_die(aTHX_ PL_no_usym, what); |
342
|
78
|
100
|
|
|
|
if (ckWARN(WARN_UNINITIALIZED)) |
343
|
22
|
|
|
|
|
report_uninit(sv); |
344
|
78
|
100
|
|
|
|
if (type != SVt_PV && GIMME_V == G_ARRAY) { |
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
345
|
16
|
|
|
|
|
(*spp)--; |
346
|
16
|
|
|
|
|
return NULL; |
347
|
|
|
|
|
|
} |
348
|
62
|
|
|
|
|
**spp = &PL_sv_undef; |
349
|
62
|
|
|
|
|
return NULL; |
350
|
|
|
|
|
|
} |
351
|
5583384
|
100
|
|
|
|
if ((PL_op->op_flags & OPf_SPECIAL) && |
|
|
100
|
|
|
|
|
352
|
79532
|
|
|
|
|
!(PL_op->op_flags & OPf_MOD)) |
353
|
|
|
|
|
|
{ |
354
|
58870
|
100
|
|
|
|
if (!(gv = gv_fetchsv_nomg(sv, GV_ADDMG, type))) |
355
|
|
|
|
|
|
{ |
356
|
920
|
|
|
|
|
**spp = &PL_sv_undef; |
357
|
920
|
|
|
|
|
return NULL; |
358
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
} |
360
|
|
|
|
|
|
else { |
361
|
5484748
|
|
|
|
|
gv = gv_fetchsv_nomg(sv, GV_ADD, type); |
362
|
|
|
|
|
|
} |
363
|
5543197
|
|
|
|
|
return gv; |
364
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
366
|
146100059
|
|
|
|
|
PP(pp_rv2sv) |
367
|
146100059
|
100
|
|
|
|
{ |
368
|
146100059
|
|
|
|
|
dVAR; dSP; dTOPss; |
369
|
|
|
|
|
|
GV *gv = NULL; |
370
|
|
|
|
|
|
|
371
|
73040135
|
|
|
|
|
SvGETMAGIC(sv); |
372
|
146100059
|
100
|
|
|
|
if (SvROK(sv)) { |
373
|
134465894
|
50
|
|
|
|
if (SvAMAGIC(sv)) { |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
374
|
222684
|
|
|
|
|
sv = amagic_deref_call(sv, to_sv_amg); |
375
|
|
|
|
|
|
} |
376
|
|
|
|
|
|
|
377
|
134465894
|
|
|
|
|
sv = SvRV(sv); |
378
|
134465894
|
100
|
|
|
|
switch (SvTYPE(sv)) { |
379
|
|
|
|
|
|
case SVt_PVAV: |
380
|
|
|
|
|
|
case SVt_PVHV: |
381
|
|
|
|
|
|
case SVt_PVCV: |
382
|
|
|
|
|
|
case SVt_PVFM: |
383
|
|
|
|
|
|
case SVt_PVIO: |
384
|
4
|
|
|
|
|
DIE(aTHX_ "Not a SCALAR reference"); |
385
|
|
|
|
|
|
default: NOOP; |
386
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
} |
388
|
|
|
|
|
|
else { |
389
|
|
|
|
|
|
gv = MUTABLE_GV(sv); |
390
|
|
|
|
|
|
|
391
|
11634165
|
100
|
|
|
|
if (!isGV_with_GP(gv)) { |
|
|
50
|
|
|
|
|
392
|
2028339
|
|
|
|
|
gv = Perl_softref2xv(aTHX_ sv, "a SCALAR", SVt_PV, &sp); |
393
|
2028281
|
100
|
|
|
|
if (!gv) |
394
|
928
|
|
|
|
|
RETURN; |
395
|
|
|
|
|
|
} |
396
|
11633179
|
100
|
|
|
|
sv = GvSVn(gv); |
397
|
|
|
|
|
|
} |
398
|
146099069
|
100
|
|
|
|
if (PL_op->op_flags & OPf_MOD) { |
399
|
19350959
|
100
|
|
|
|
if (PL_op->op_private & OPpLVAL_INTRO) { |
400
|
24
|
50
|
|
|
|
if (cUNOP->op_first->op_type == OP_NULL) |
401
|
0
|
|
|
|
|
sv = save_scalar(MUTABLE_GV(TOPs)); |
402
|
24
|
100
|
|
|
|
else if (gv) |
403
|
10
|
|
|
|
|
sv = save_scalar(gv); |
404
|
|
|
|
|
|
else |
405
|
14
|
|
|
|
|
Perl_croak(aTHX_ "%s", PL_no_localize_ref); |
406
|
|
|
|
|
|
} |
407
|
19350935
|
100
|
|
|
|
else if (PL_op->op_private & OPpDEREF) |
408
|
9666736
|
|
|
|
|
sv = vivify_ref(sv, PL_op->op_private & OPpDEREF); |
409
|
|
|
|
|
|
} |
410
|
146099055
|
|
|
|
|
SETs(sv); |
411
|
146099519
|
|
|
|
|
RETURN; |
412
|
|
|
|
|
|
} |
413
|
|
|
|
|
|
|
414
|
7504518
|
|
|
|
|
PP(pp_av2arylen) |
415
|
|
|
|
|
|
{ |
416
|
7504518
|
|
|
|
|
dVAR; dSP; |
417
|
7504518
|
|
|
|
|
AV * const av = MUTABLE_AV(TOPs); |
418
|
7504518
|
100
|
|
|
|
const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET; |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
419
|
7504518
|
100
|
|
|
|
if (lvalue) { |
420
|
50398
|
|
|
|
|
SV ** const sv = Perl_av_arylen_p(aTHX_ MUTABLE_AV(av)); |
421
|
50398
|
100
|
|
|
|
if (!*sv) { |
422
|
15484
|
|
|
|
|
*sv = newSV_type(SVt_PVMG); |
423
|
15484
|
|
|
|
|
sv_magic(*sv, MUTABLE_SV(av), PERL_MAGIC_arylen, NULL, 0); |
424
|
|
|
|
|
|
} |
425
|
50398
|
|
|
|
|
SETs(*sv); |
426
|
|
|
|
|
|
} else { |
427
|
7454120
|
100
|
|
|
|
SETs(sv_2mortal(newSViv(AvFILL(MUTABLE_AV(av))))); |
428
|
|
|
|
|
|
} |
429
|
7504518
|
|
|
|
|
RETURN; |
430
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
432
|
2194580
|
|
|
|
|
PP(pp_pos) |
433
|
|
|
|
|
|
{ |
434
|
2194580
|
|
|
|
|
dVAR; dSP; dPOPss; |
435
|
|
|
|
|
|
|
436
|
2194580
|
100
|
|
|
|
if (PL_op->op_flags & OPf_MOD || LVRET) { |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
437
|
78550
|
|
|
|
|
SV * const ret = sv_2mortal(newSV_type(SVt_PVLV));/* Not TARG RT#67838 */ |
438
|
78550
|
|
|
|
|
sv_magic(ret, NULL, PERL_MAGIC_pos, NULL, 0); |
439
|
78550
|
|
|
|
|
LvTYPE(ret) = '.'; |
440
|
157100
|
|
|
|
|
LvTARG(ret) = SvREFCNT_inc_simple(sv); |
441
|
78550
|
|
|
|
|
PUSHs(ret); /* no SvSETMAGIC */ |
442
|
78550
|
|
|
|
|
RETURN; |
443
|
|
|
|
|
|
} |
444
|
|
|
|
|
|
else { |
445
|
2116030
|
|
|
|
|
const MAGIC * const mg = mg_find_mglob(sv); |
446
|
2116030
|
100
|
|
|
|
if (mg && mg->mg_len != -1) { |
|
|
100
|
|
|
|
|
447
|
2115022
|
|
|
|
|
dTARGET; |
448
|
2115022
|
|
|
|
|
STRLEN i = mg->mg_len; |
449
|
2115022
|
100
|
|
|
|
if (mg->mg_flags & MGf_BYTES && DO_UTF8(sv)) |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
450
|
2018474
|
|
|
|
|
i = sv_pos_b2u_flags(sv, i, SV_GMAGIC|SV_CONST_RETURN); |
451
|
2115022
|
50
|
|
|
|
PUSHu(i); |
452
|
2115022
|
|
|
|
|
RETURN; |
453
|
|
|
|
|
|
} |
454
|
1097794
|
|
|
|
|
RETPUSHUNDEF; |
455
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
458
|
4636940
|
|
|
|
|
PP(pp_rv2cv) |
459
|
|
|
|
|
|
{ |
460
|
4636940
|
|
|
|
|
dVAR; dSP; |
461
|
|
|
|
|
|
GV *gv; |
462
|
|
|
|
|
|
HV *stash_unused; |
463
|
4636940
|
|
|
|
|
const I32 flags = (PL_op->op_flags & OPf_SPECIAL) |
464
|
4636940
|
|
|
|
|
? GV_ADDMG |
465
|
4636940
|
100
|
|
|
|
: ((PL_op->op_private & (OPpLVAL_INTRO|OPpMAY_RETURN_CONSTANT)) |
466
|
|
|
|
|
|
== OPpMAY_RETURN_CONSTANT) |
467
|
|
|
|
|
|
? GV_ADD|GV_NOEXPAND |
468
|
3395498
|
100
|
|
|
|
: GV_ADD; |
469
|
|
|
|
|
|
/* We usually try to add a non-existent subroutine in case of AUTOLOAD. */ |
470
|
|
|
|
|
|
/* (But not in defined().) */ |
471
|
|
|
|
|
|
|
472
|
4636940
|
|
|
|
|
CV *cv = sv_2cv(TOPs, &stash_unused, &gv, flags); |
473
|
4636940
|
100
|
|
|
|
if (cv) NOOP; |
474
|
1167494
|
100
|
|
|
|
else if ((flags == (GV_ADD|GV_NOEXPAND)) && gv && SvROK(gv)) { |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
475
|
683758
|
|
|
|
|
cv = MUTABLE_CV(gv); |
476
|
|
|
|
|
|
} |
477
|
|
|
|
|
|
else |
478
|
|
|
|
|
|
cv = MUTABLE_CV(&PL_sv_undef); |
479
|
4636940
|
|
|
|
|
SETs(MUTABLE_SV(cv)); |
480
|
4636940
|
|
|
|
|
RETURN; |
481
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
483
|
1040638
|
|
|
|
|
PP(pp_prototype) |
484
|
|
|
|
|
|
{ |
485
|
1040638
|
|
|
|
|
dVAR; dSP; |
486
|
|
|
|
|
|
CV *cv; |
487
|
|
|
|
|
|
HV *stash; |
488
|
|
|
|
|
|
GV *gv; |
489
|
|
|
|
|
|
SV *ret = &PL_sv_undef; |
490
|
|
|
|
|
|
|
491
|
1040638
|
100
|
|
|
|
if (SvGMAGICAL(TOPs)) SETs(sv_mortalcopy(TOPs)); |
492
|
1040638
|
100
|
|
|
|
if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) { |
|
|
100
|
|
|
|
|
493
|
1038386
|
|
|
|
|
const char * s = SvPVX_const(TOPs); |
494
|
1038386
|
100
|
|
|
|
if (strnEQ(s, "CORE::", 6)) { |
495
|
797824
|
|
|
|
|
const int code = keyword(s + 6, SvCUR(TOPs) - 6, 1); |
496
|
797824
|
100
|
|
|
|
if (!code || code == -KEY_CORE) |
497
|
36
|
|
|
|
|
DIE(aTHX_ "Can't find an opnumber for \"%"UTF8f"\"", |
498
|
36
|
|
|
|
|
UTF8fARG(SvFLAGS(TOPs) & SVf_UTF8, SvCUR(TOPs)-6, s+6)); |
499
|
|
|
|
|
|
{ |
500
|
797806
|
|
|
|
|
SV * const sv = core_prototype(NULL, s + 6, code, NULL); |
501
|
797806
|
100
|
|
|
|
if (sv) ret = sv; |
502
|
|
|
|
|
|
} |
503
|
|
|
|
|
|
goto set; |
504
|
|
|
|
|
|
} |
505
|
|
|
|
|
|
} |
506
|
242814
|
|
|
|
|
cv = sv_2cv(TOPs, &stash, &gv, 0); |
507
|
242814
|
100
|
|
|
|
if (cv && SvPOK(cv)) |
|
|
100
|
|
|
|
|
508
|
103440
|
50
|
|
|
|
ret = newSVpvn_flags( |
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
509
|
|
|
|
|
|
CvPROTO(cv), CvPROTOLEN(cv), SVs_TEMP | SvUTF8(cv) |
510
|
|
|
|
|
|
); |
511
|
|
|
|
|
|
set: |
512
|
1040620
|
|
|
|
|
SETs(ret); |
513
|
1040620
|
|
|
|
|
RETURN; |
514
|
|
|
|
|
|
} |
515
|
|
|
|
|
|
|
516
|
3722334
|
|
|
|
|
PP(pp_anoncode) |
517
|
3722334
|
50
|
|
|
|
{ |
518
|
3722334
|
|
|
|
|
dVAR; dSP; |
519
|
3722334
|
|
|
|
|
CV *cv = MUTABLE_CV(PAD_SV(PL_op->op_targ)); |
520
|
3722334
|
100
|
|
|
|
if (CvCLONE(cv)) |
521
|
3139126
|
|
|
|
|
cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv)))); |
522
|
1850010
|
|
|
|
|
EXTEND(SP,1); |
523
|
3722334
|
|
|
|
|
PUSHs(MUTABLE_SV(cv)); |
524
|
3722334
|
|
|
|
|
RETURN; |
525
|
|
|
|
|
|
} |
526
|
|
|
|
|
|
|
527
|
38173805
|
|
|
|
|
PP(pp_srefgen) |
528
|
|
|
|
|
|
{ |
529
|
38173805
|
|
|
|
|
dVAR; dSP; |
530
|
38173805
|
|
|
|
|
*SP = refto(*SP); |
531
|
38173805
|
|
|
|
|
RETURN; |
532
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
534
|
13149025
|
|
|
|
|
PP(pp_refgen) |
535
|
|
|
|
|
|
{ |
536
|
13149025
|
|
|
|
|
dVAR; dSP; dMARK; |
537
|
13149025
|
100
|
|
|
|
if (GIMME != G_ARRAY) { |
|
|
100
|
|
|
|
|
538
|
6784268
|
100
|
|
|
|
if (++MARK <= SP) |
539
|
6784264
|
|
|
|
|
*MARK = *SP; |
540
|
|
|
|
|
|
else |
541
|
4
|
|
|
|
|
*MARK = &PL_sv_undef; |
542
|
6784268
|
|
|
|
|
*MARK = refto(*MARK); |
543
|
|
|
|
|
|
SP = MARK; |
544
|
6784268
|
|
|
|
|
RETURN; |
545
|
|
|
|
|
|
} |
546
|
6364757
|
100
|
|
|
|
EXTEND_MORTAL(SP - MARK); |
547
|
12729890
|
100
|
|
|
|
while (++MARK <= SP) |
548
|
6365133
|
|
|
|
|
*MARK = refto(*MARK); |
549
|
9803140
|
|
|
|
|
RETURN; |
550
|
|
|
|
|
|
} |
551
|
|
|
|
|
|
|
552
|
|
|
|
|
|
STATIC SV* |
553
|
51323306
|
|
|
|
|
S_refto(pTHX_ SV *sv) |
554
|
|
|
|
|
|
{ |
555
|
|
|
|
|
|
dVAR; |
556
|
|
|
|
|
|
SV* rv; |
557
|
|
|
|
|
|
|
558
|
|
|
|
|
|
PERL_ARGS_ASSERT_REFTO; |
559
|
|
|
|
|
|
|
560
|
51323306
|
100
|
|
|
|
if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y') { |
|
|
100
|
|
|
|
|
561
|
10
|
100
|
|
|
|
if (LvTARGLEN(sv)) |
562
|
8
|
|
|
|
|
vivify_defelem(sv); |
563
|
10
|
50
|
|
|
|
if (!(sv = LvTARG(sv))) |
564
|
|
|
|
|
|
sv = &PL_sv_undef; |
565
|
|
|
|
|
|
else |
566
|
10
|
|
|
|
|
SvREFCNT_inc_void_NN(sv); |
567
|
|
|
|
|
|
} |
568
|
51323296
|
100
|
|
|
|
else if (SvTYPE(sv) == SVt_PVAV) { |
569
|
2622682
|
100
|
|
|
|
if (!AvREAL((const AV *)sv) && AvREIFY((const AV *)sv)) |
|
|
50
|
|
|
|
|
570
|
5358
|
|
|
|
|
av_reify(MUTABLE_AV(sv)); |
571
|
2622682
|
|
|
|
|
SvTEMP_off(sv); |
572
|
2622682
|
|
|
|
|
SvREFCNT_inc_void_NN(sv); |
573
|
|
|
|
|
|
} |
574
|
48700614
|
100
|
|
|
|
else if (SvPADTMP(sv) && !IS_PADGV(sv)) |
575
|
2618
|
|
|
|
|
sv = newSVsv(sv); |
576
|
|
|
|
|
|
else { |
577
|
48697996
|
|
|
|
|
SvTEMP_off(sv); |
578
|
48697996
|
|
|
|
|
SvREFCNT_inc_void_NN(sv); |
579
|
|
|
|
|
|
} |
580
|
51323306
|
|
|
|
|
rv = sv_newmortal(); |
581
|
51323306
|
|
|
|
|
sv_upgrade(rv, SVt_IV); |
582
|
51323306
|
|
|
|
|
SvRV_set(rv, sv); |
583
|
51323306
|
|
|
|
|
SvROK_on(rv); |
584
|
51323306
|
|
|
|
|
return rv; |
585
|
|
|
|
|
|
} |
586
|
|
|
|
|
|
|
587
|
267207972
|
|
|
|
|
PP(pp_ref) |
588
|
267207972
|
100
|
|
|
|
{ |
589
|
267207972
|
|
|
|
|
dVAR; dSP; dTARGET; |
590
|
267207972
|
|
|
|
|
SV * const sv = POPs; |
591
|
|
|
|
|
|
|
592
|
133591075
|
|
|
|
|
SvGETMAGIC(sv); |
593
|
267207972
|
100
|
|
|
|
if (!SvROK(sv)) |
594
|
9893884
|
|
|
|
|
RETPUSHNO; |
595
|
|
|
|
|
|
|
596
|
257314088
|
|
|
|
|
(void)sv_ref(TARG,SvRV(sv),TRUE); |
597
|
257314088
|
50
|
|
|
|
PUSHTARG; |
598
|
262274170
|
|
|
|
|
RETURN; |
599
|
|
|
|
|
|
} |
600
|
|
|
|
|
|
|
601
|
7542645
|
|
|
|
|
PP(pp_bless) |
602
|
|
|
|
|
|
{ |
603
|
7542645
|
|
|
|
|
dVAR; dSP; |
604
|
|
|
|
|
|
HV *stash; |
605
|
|
|
|
|
|
|
606
|
7542645
|
100
|
|
|
|
if (MAXARG == 1) |
607
|
|
|
|
|
|
{ |
608
|
|
|
|
|
|
curstash: |
609
|
510804
|
|
|
|
|
stash = CopSTASH(PL_curcop); |
610
|
510804
|
100
|
|
|
|
if (SvTYPE(stash) != SVt_PVHV) |
611
|
2
|
|
|
|
|
Perl_croak(aTHX_ "Attempt to bless into a freed package"); |
612
|
|
|
|
|
|
} |
613
|
|
|
|
|
|
else { |
614
|
7031843
|
|
|
|
|
SV * const ssv = POPs; |
615
|
|
|
|
|
|
STRLEN len; |
616
|
|
|
|
|
|
const char *ptr; |
617
|
|
|
|
|
|
|
618
|
7031843
|
100
|
|
|
|
if (!ssv) goto curstash; |
619
|
7031841
|
100
|
|
|
|
if (!SvGMAGICAL(ssv) && !SvAMAGIC(ssv) && SvROK(ssv)) |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
620
|
4
|
|
|
|
|
Perl_croak(aTHX_ "Attempt to bless into a reference"); |
621
|
7031837
|
100
|
|
|
|
ptr = SvPV_const(ssv,len); |
622
|
7031837
|
100
|
|
|
|
if (len == 0) |
623
|
16
|
|
|
|
|
Perl_ck_warner(aTHX_ packWARN(WARN_MISC), |
624
|
|
|
|
|
|
"Explicit blessing to '' (assuming package main)"); |
625
|
7031837
|
|
|
|
|
stash = gv_stashpvn(ptr, len, GV_ADD|SvUTF8(ssv)); |
626
|
|
|
|
|
|
} |
627
|
|
|
|
|
|
|
628
|
7542639
|
|
|
|
|
(void)sv_bless(TOPs, stash); |
629
|
7542635
|
|
|
|
|
RETURN; |
630
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
632
|
506946
|
|
|
|
|
PP(pp_gelem) |
633
|
|
|
|
|
|
{ |
634
|
506946
|
|
|
|
|
dVAR; dSP; |
635
|
|
|
|
|
|
|
636
|
506946
|
|
|
|
|
SV *sv = POPs; |
637
|
|
|
|
|
|
STRLEN len; |
638
|
506946
|
100
|
|
|
|
const char * const elem = SvPV_const(sv, len); |
639
|
506946
|
|
|
|
|
GV * const gv = MUTABLE_GV(POPs); |
640
|
|
|
|
|
|
SV * tmpRef = NULL; |
641
|
|
|
|
|
|
|
642
|
|
|
|
|
|
sv = NULL; |
643
|
506946
|
50
|
|
|
|
if (elem) { |
644
|
|
|
|
|
|
/* elem will always be NUL terminated. */ |
645
|
506946
|
|
|
|
|
const char * const second_letter = elem + 1; |
646
|
506946
|
|
|
|
|
switch (*elem) { |
647
|
|
|
|
|
|
case 'A': |
648
|
22090
|
50
|
|
|
|
if (len == 5 && strEQ(second_letter, "RRAY")) |
|
|
50
|
|
|
|
|
649
|
|
|
|
|
|
{ |
650
|
22090
|
|
|
|
|
tmpRef = MUTABLE_SV(GvAV(gv)); |
651
|
22090
|
100
|
|
|
|
if (tmpRef && !AvREAL((const AV *)tmpRef) |
|
|
100
|
|
|
|
|
652
|
6
|
50
|
|
|
|
&& AvREIFY((const AV *)tmpRef)) |
653
|
6
|
|
|
|
|
av_reify(MUTABLE_AV(tmpRef)); |
654
|
|
|
|
|
|
} |
655
|
|
|
|
|
|
break; |
656
|
|
|
|
|
|
case 'C': |
657
|
321154
|
50
|
|
|
|
if (len == 4 && strEQ(second_letter, "ODE")) |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
658
|
321154
|
100
|
|
|
|
tmpRef = MUTABLE_SV(GvCVu(gv)); |
659
|
|
|
|
|
|
break; |
660
|
|
|
|
|
|
case 'F': |
661
|
3608
|
100
|
|
|
|
if (len == 10 && strEQ(second_letter, "ILEHANDLE")) { |
|
|
50
|
|
|
|
|
662
|
|
|
|
|
|
/* finally deprecated in 5.8.0 */ |
663
|
4
|
|
|
|
|
deprecate("*glob{FILEHANDLE}"); |
664
|
4
|
|
|
|
|
tmpRef = MUTABLE_SV(GvIOp(gv)); |
665
|
|
|
|
|
|
} |
666
|
|
|
|
|
|
else |
667
|
3604
|
50
|
|
|
|
if (len == 6 && strEQ(second_letter, "ORMAT")) |
|
|
50
|
|
|
|
|
668
|
3604
|
|
|
|
|
tmpRef = MUTABLE_SV(GvFORM(gv)); |
669
|
|
|
|
|
|
break; |
670
|
|
|
|
|
|
case 'G': |
671
|
4
|
50
|
|
|
|
if (len == 4 && strEQ(second_letter, "LOB")) |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
672
|
|
|
|
|
|
tmpRef = MUTABLE_SV(gv); |
673
|
|
|
|
|
|
break; |
674
|
|
|
|
|
|
case 'H': |
675
|
117450
|
50
|
|
|
|
if (len == 4 && strEQ(second_letter, "ASH")) |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
676
|
117450
|
|
|
|
|
tmpRef = MUTABLE_SV(GvHV(gv)); |
677
|
|
|
|
|
|
break; |
678
|
|
|
|
|
|
case 'I': |
679
|
15100
|
50
|
|
|
|
if (*second_letter == 'O' && !elem[2] && len == 2) |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
680
|
15100
|
|
|
|
|
tmpRef = MUTABLE_SV(GvIOp(gv)); |
681
|
|
|
|
|
|
break; |
682
|
|
|
|
|
|
case 'N': |
683
|
80
|
50
|
|
|
|
if (len == 4 && strEQ(second_letter, "AME")) |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
684
|
80
|
|
|
|
|
sv = newSVhek(GvNAME_HEK(gv)); |
685
|
|
|
|
|
|
break; |
686
|
|
|
|
|
|
case 'P': |
687
|
18
|
50
|
|
|
|
if (len == 7 && strEQ(second_letter, "ACKAGE")) { |
|
|
50
|
|
|
|
|
688
|
18
|
|
|
|
|
const HV * const stash = GvSTASH(gv); |
689
|
18
|
50
|
|
|
|
const HEK * const hek = stash ? HvNAME_HEK(stash) : NULL; |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
690
|
18
|
100
|
|
|
|
sv = hek ? newSVhek(hek) : newSVpvs("__ANON__"); |
691
|
|
|
|
|
|
} |
692
|
|
|
|
|
|
break; |
693
|
|
|
|
|
|
case 'S': |
694
|
27440
|
50
|
|
|
|
if (len == 6 && strEQ(second_letter, "CALAR")) |
|
|
50
|
|
|
|
|
695
|
27440
|
100
|
|
|
|
tmpRef = GvSVn(gv); |
696
|
|
|
|
|
|
break; |
697
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
} |
699
|
506946
|
100
|
|
|
|
if (tmpRef) |
700
|
439066
|
|
|
|
|
sv = newRV(tmpRef); |
701
|
506946
|
100
|
|
|
|
if (sv) |
702
|
439164
|
|
|
|
|
sv_2mortal(sv); |
703
|
|
|
|
|
|
else |
704
|
|
|
|
|
|
sv = &PL_sv_undef; |
705
|
506946
|
50
|
|
|
|
XPUSHs(sv); |
706
|
506946
|
|
|
|
|
RETURN; |
707
|
|
|
|
|
|
} |
708
|
|
|
|
|
|
|
709
|
|
|
|
|
|
/* Pattern matching */ |
710
|
|
|
|
|
|
|
711
|
37170
|
|
|
|
|
PP(pp_study) |
712
|
|
|
|
|
|
{ |
713
|
37170
|
|
|
|
|
dVAR; dSP; dPOPss; |
714
|
|
|
|
|
|
STRLEN len; |
715
|
|
|
|
|
|
|
716
|
37170
|
100
|
|
|
|
(void)SvPV(sv, len); |
717
|
37170
|
100
|
|
|
|
if (len == 0 || len > I32_MAX || !SvPOK(sv) || SvUTF8(sv) || SvVALID(sv)) { |
|
|
100
|
|
|
|
|
718
|
|
|
|
|
|
/* Historically, study was skipped in these cases. */ |
719
|
19594
|
|
|
|
|
RETPUSHNO; |
720
|
|
|
|
|
|
} |
721
|
|
|
|
|
|
|
722
|
|
|
|
|
|
/* Make study a no-op. It's no longer useful and its existence |
723
|
|
|
|
|
|
complicates matters elsewhere. */ |
724
|
27373
|
|
|
|
|
RETPUSHYES; |
725
|
|
|
|
|
|
} |
726
|
|
|
|
|
|
|
727
|
895790
|
|
|
|
|
PP(pp_trans) |
728
|
|
|
|
|
|
{ |
729
|
895790
|
|
|
|
|
dVAR; dSP; dTARG; |
730
|
|
|
|
|
|
SV *sv; |
731
|
|
|
|
|
|
|
732
|
895790
|
100
|
|
|
|
if (PL_op->op_flags & OPf_STACKED) |
733
|
626610
|
|
|
|
|
sv = POPs; |
734
|
538354
|
100
|
|
|
|
else if (PL_op->op_private & OPpTARGET_MY) |
|
|
50
|
|
|
|
|
735
|
6
|
|
|
|
|
sv = GETTARGET; |
736
|
|
|
|
|
|
else { |
737
|
269174
|
50
|
|
|
|
sv = DEFSV; |
738
|
134587
|
|
|
|
|
EXTEND(SP,1); |
739
|
|
|
|
|
|
} |
740
|
895790
|
100
|
|
|
|
if(PL_op->op_type == OP_TRANSR) { |
741
|
|
|
|
|
|
STRLEN len; |
742
|
4204
|
100
|
|
|
|
const char * const pv = SvPV(sv,len); |
743
|
4204
|
|
|
|
|
SV * const newsv = newSVpvn_flags(pv, len, SVs_TEMP|SvUTF8(sv)); |
744
|
4204
|
|
|
|
|
do_trans(newsv); |
745
|
4204
|
|
|
|
|
PUSHs(newsv); |
746
|
|
|
|
|
|
} |
747
|
|
|
|
|
|
else { |
748
|
891586
|
|
|
|
|
TARG = sv_newmortal(); |
749
|
891586
|
50
|
|
|
|
PUSHi(do_trans(sv)); |
750
|
|
|
|
|
|
} |
751
|
895786
|
|
|
|
|
RETURN; |
752
|
|
|
|
|
|
} |
753
|
|
|
|
|
|
|
754
|
|
|
|
|
|
/* Lvalue operators. */ |
755
|
|
|
|
|
|
|
756
|
|
|
|
|
|
static void |
757
|
2042604
|
|
|
|
|
S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping) |
758
|
|
|
|
|
|
{ |
759
|
|
|
|
|
|
dVAR; |
760
|
|
|
|
|
|
STRLEN len; |
761
|
|
|
|
|
|
char *s; |
762
|
|
|
|
|
|
|
763
|
|
|
|
|
|
PERL_ARGS_ASSERT_DO_CHOMP; |
764
|
|
|
|
|
|
|
765
|
2042604
|
100
|
|
|
|
if (chomping && (RsSNARF(PL_rs) || RsRECORD(PL_rs))) |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
766
|
|
|
|
|
|
return; |
767
|
1846646
|
100
|
|
|
|
if (SvTYPE(sv) == SVt_PVAV) { |
768
|
|
|
|
|
|
I32 i; |
769
|
|
|
|
|
|
AV *const av = MUTABLE_AV(sv); |
770
|
654
|
50
|
|
|
|
const I32 max = AvFILL(av); |
771
|
|
|
|
|
|
|
772
|
31878
|
100
|
|
|
|
for (i = 0; i <= max; i++) { |
773
|
31224
|
|
|
|
|
sv = MUTABLE_SV(av_fetch(av, i, FALSE)); |
774
|
31224
|
50
|
|
|
|
if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef)) |
|
|
50
|
|
|
|
|
775
|
31224
|
|
|
|
|
do_chomp(retval, sv, chomping); |
776
|
|
|
|
|
|
} |
777
|
|
|
|
|
|
return; |
778
|
|
|
|
|
|
} |
779
|
1845992
|
50
|
|
|
|
else if (SvTYPE(sv) == SVt_PVHV) { |
780
|
|
|
|
|
|
HV* const hv = MUTABLE_HV(sv); |
781
|
|
|
|
|
|
HE* entry; |
782
|
0
|
|
|
|
|
(void)hv_iterinit(hv); |
783
|
0
|
0
|
|
|
|
while ((entry = hv_iternext(hv))) |
784
|
0
|
|
|
|
|
do_chomp(retval, hv_iterval(hv,entry), chomping); |
785
|
|
|
|
|
|
return; |
786
|
|
|
|
|
|
} |
787
|
1845992
|
100
|
|
|
|
else if (SvREADONLY(sv)) { |
788
|
2
|
|
|
|
|
Perl_croak_no_modify(); |
789
|
|
|
|
|
|
} |
790
|
1845990
|
100
|
|
|
|
else if (SvIsCOW(sv)) { |
791
|
20090
|
|
|
|
|
sv_force_normal_flags(sv, 0); |
792
|
|
|
|
|
|
} |
793
|
|
|
|
|
|
|
794
|
1845990
|
100
|
|
|
|
if (PL_encoding) { |
795
|
420
|
100
|
|
|
|
if (!SvUTF8(sv)) { |
796
|
|
|
|
|
|
/* XXX, here sv is utf8-ized as a side-effect! |
797
|
|
|
|
|
|
If encoding.pm is used properly, almost string-generating |
798
|
|
|
|
|
|
operations, including literal strings, chr(), input data, etc. |
799
|
|
|
|
|
|
should have been utf8-ized already, right? |
800
|
|
|
|
|
|
*/ |
801
|
126
|
|
|
|
|
sv_recode_to_utf8(sv, PL_encoding); |
802
|
|
|
|
|
|
} |
803
|
|
|
|
|
|
} |
804
|
|
|
|
|
|
|
805
|
1845990
|
100
|
|
|
|
s = SvPV(sv, len); |
806
|
1845952
|
100
|
|
|
|
if (chomping) { |
807
|
|
|
|
|
|
char *temp_buffer = NULL; |
808
|
|
|
|
|
|
SV *svrecode = NULL; |
809
|
|
|
|
|
|
|
810
|
1726336
|
50
|
|
|
|
if (s && len) { |
|
|
100
|
|
|
|
|
811
|
1648282
|
|
|
|
|
s += --len; |
812
|
1648282
|
100
|
|
|
|
if (RsPARA(PL_rs)) { |
|
|
100
|
|
|
|
|
813
|
16
|
100
|
|
|
|
if (*s != '\n') |
814
|
|
|
|
|
|
goto nope; |
815
|
14
|
|
|
|
|
++SvIVX(retval); |
816
|
37
|
50
|
|
|
|
while (len && s[-1] == '\n') { |
|
|
100
|
|
|
|
|
817
|
16
|
|
|
|
|
--len; |
818
|
16
|
|
|
|
|
--s; |
819
|
16
|
|
|
|
|
++SvIVX(retval); |
820
|
|
|
|
|
|
} |
821
|
|
|
|
|
|
} |
822
|
|
|
|
|
|
else { |
823
|
|
|
|
|
|
STRLEN rslen, rs_charlen; |
824
|
1648266
|
100
|
|
|
|
const char *rsptr = SvPV_const(PL_rs, rslen); |
825
|
|
|
|
|
|
|
826
|
1648266
|
|
|
|
|
rs_charlen = SvUTF8(PL_rs) |
827
|
596
|
|
|
|
|
? sv_len_utf8(PL_rs) |
828
|
1648564
|
100
|
|
|
|
: rslen; |
829
|
|
|
|
|
|
|
830
|
1648266
|
100
|
|
|
|
if (SvUTF8(PL_rs) != SvUTF8(sv)) { |
831
|
|
|
|
|
|
/* Assumption is that rs is shorter than the scalar. */ |
832
|
248
|
100
|
|
|
|
if (SvUTF8(PL_rs)) { |
833
|
|
|
|
|
|
/* RS is utf8, scalar is 8 bit. */ |
834
|
20
|
|
|
|
|
bool is_utf8 = TRUE; |
835
|
20
|
|
|
|
|
temp_buffer = (char*)bytes_from_utf8((U8*)rsptr, |
836
|
|
|
|
|
|
&rslen, &is_utf8); |
837
|
20
|
100
|
|
|
|
if (is_utf8) { |
838
|
|
|
|
|
|
/* Cannot downgrade, therefore cannot possibly match |
839
|
|
|
|
|
|
*/ |
840
|
|
|
|
|
|
assert (temp_buffer == rsptr); |
841
|
|
|
|
|
|
temp_buffer = NULL; |
842
|
|
|
|
|
|
goto nope; |
843
|
|
|
|
|
|
} |
844
|
|
|
|
|
|
rsptr = temp_buffer; |
845
|
|
|
|
|
|
} |
846
|
228
|
100
|
|
|
|
else if (PL_encoding) { |
847
|
|
|
|
|
|
/* RS is 8 bit, encoding.pm is used. |
848
|
|
|
|
|
|
* Do not recode PL_rs as a side-effect. */ |
849
|
192
|
|
|
|
|
svrecode = newSVpvn(rsptr, rslen); |
850
|
192
|
|
|
|
|
sv_recode_to_utf8(svrecode, PL_encoding); |
851
|
192
|
50
|
|
|
|
rsptr = SvPV_const(svrecode, rslen); |
852
|
192
|
|
|
|
|
rs_charlen = sv_len_utf8(svrecode); |
853
|
|
|
|
|
|
} |
854
|
|
|
|
|
|
else { |
855
|
|
|
|
|
|
/* RS is 8 bit, scalar is utf8. */ |
856
|
36
|
|
|
|
|
temp_buffer = (char*)bytes_to_utf8((U8*)rsptr, &rslen); |
857
|
|
|
|
|
|
rsptr = temp_buffer; |
858
|
|
|
|
|
|
} |
859
|
|
|
|
|
|
} |
860
|
1648252
|
100
|
|
|
|
if (rslen == 1) { |
861
|
1647778
|
100
|
|
|
|
if (*s != *rsptr) |
862
|
|
|
|
|
|
goto nope; |
863
|
1638618
|
|
|
|
|
++SvIVX(retval); |
864
|
|
|
|
|
|
} |
865
|
|
|
|
|
|
else { |
866
|
474
|
100
|
|
|
|
if (len < rslen - 1) |
867
|
|
|
|
|
|
goto nope; |
868
|
450
|
|
|
|
|
len -= rslen - 1; |
869
|
450
|
|
|
|
|
s -= rslen - 1; |
870
|
450
|
100
|
|
|
|
if (memNE(s, rsptr, rslen)) |
871
|
|
|
|
|
|
goto nope; |
872
|
262
|
|
|
|
|
SvIVX(retval) += rs_charlen; |
873
|
|
|
|
|
|
} |
874
|
|
|
|
|
|
} |
875
|
1638894
|
100
|
|
|
|
s = SvPV_force_nomg_nolen(sv); |
876
|
1638894
|
|
|
|
|
SvCUR_set(sv, len); |
877
|
1638894
|
|
|
|
|
*SvEND(sv) = '\0'; |
878
|
1638894
|
|
|
|
|
SvNIOK_off(sv); |
879
|
1638894
|
100
|
|
|
|
SvSETMAGIC(sv); |
880
|
|
|
|
|
|
} |
881
|
|
|
|
|
|
nope: |
882
|
|
|
|
|
|
|
883
|
1726336
|
|
|
|
|
SvREFCNT_dec(svrecode); |
884
|
|
|
|
|
|
|
885
|
1726336
|
|
|
|
|
Safefree(temp_buffer); |
886
|
|
|
|
|
|
} else { |
887
|
119616
|
100
|
|
|
|
if (len && !SvPOK(sv)) |
|
|
100
|
|
|
|
|
888
|
20
|
50
|
|
|
|
s = SvPV_force_nomg(sv, len); |
889
|
119616
|
100
|
|
|
|
if (DO_UTF8(sv)) { |
|
|
50
|
|
|
|
|
890
|
9320
|
50
|
|
|
|
if (s && len) { |
|
|
50
|
|
|
|
|
891
|
9320
|
|
|
|
|
char * const send = s + len; |
892
|
|
|
|
|
|
char * const start = s; |
893
|
9320
|
|
|
|
|
s = send - 1; |
894
|
23454
|
100
|
|
|
|
while (s > start && UTF8_IS_CONTINUATION(*s)) |
|
|
100
|
|
|
|
|
895
|
9474
|
|
|
|
|
s--; |
896
|
9320
|
50
|
|
|
|
if (is_utf8_string((U8*)s, send - s)) { |
897
|
9320
|
|
|
|
|
sv_setpvn(retval, s, send - s); |
898
|
9320
|
|
|
|
|
*s = '\0'; |
899
|
9320
|
|
|
|
|
SvCUR_set(sv, s - start); |
900
|
9320
|
|
|
|
|
SvNIOK_off(sv); |
901
|
9320
|
|
|
|
|
SvUTF8_on(retval); |
902
|
|
|
|
|
|
} |
903
|
|
|
|
|
|
} |
904
|
|
|
|
|
|
else |
905
|
0
|
|
|
|
|
sv_setpvs(retval, ""); |
906
|
|
|
|
|
|
} |
907
|
110296
|
50
|
|
|
|
else if (s && len) { |
|
|
100
|
|
|
|
|
908
|
110050
|
|
|
|
|
s += --len; |
909
|
110050
|
|
|
|
|
sv_setpvn(retval, s, 1); |
910
|
110050
|
|
|
|
|
*s = '\0'; |
911
|
110050
|
|
|
|
|
SvCUR_set(sv, len); |
912
|
110050
|
|
|
|
|
SvUTF8_off(sv); |
913
|
110050
|
|
|
|
|
SvNIOK_off(sv); |
914
|
|
|
|
|
|
} |
915
|
|
|
|
|
|
else |
916
|
246
|
|
|
|
|
sv_setpvs(retval, ""); |
917
|
1081090
|
100
|
|
|
|
SvSETMAGIC(sv); |
918
|
|
|
|
|
|
} |
919
|
|
|
|
|
|
} |
920
|
|
|
|
|
|
|
921
|
2009456
|
|
|
|
|
PP(pp_schop) |
922
|
|
|
|
|
|
{ |
923
|
2009456
|
|
|
|
|
dVAR; dSP; dTARGET; |
924
|
2009456
|
|
|
|
|
const bool chomping = PL_op->op_type == OP_SCHOMP; |
925
|
|
|
|
|
|
|
926
|
2009456
|
100
|
|
|
|
if (chomping) |
927
|
1889956
|
|
|
|
|
sv_setiv(TARG, 0); |
928
|
2009456
|
|
|
|
|
do_chomp(TARG, TOPs, chomping); |
929
|
2009416
|
50
|
|
|
|
SETTARG; |
930
|
2009416
|
|
|
|
|
RETURN; |
931
|
|
|
|
|
|
} |
932
|
|
|
|
|
|
|
933
|
1416
|
|
|
|
|
PP(pp_chop) |
934
|
|
|
|
|
|
{ |
935
|
1416
|
|
|
|
|
dVAR; dSP; dMARK; dTARGET; dORIGMARK; |
936
|
1416
|
|
|
|
|
const bool chomping = PL_op->op_type == OP_CHOMP; |
937
|
|
|
|
|
|
|
938
|
1416
|
100
|
|
|
|
if (chomping) |
939
|
1322
|
|
|
|
|
sv_setiv(TARG, 0); |
940
|
3340
|
100
|
|
|
|
while (MARK < SP) |
941
|
1924
|
|
|
|
|
do_chomp(TARG, *++MARK, chomping); |
942
|
1416
|
|
|
|
|
SP = ORIGMARK; |
943
|
1416
|
50
|
|
|
|
XPUSHTARG; |
|
|
50
|
|
|
|
|
944
|
1416
|
|
|
|
|
RETURN; |
945
|
|
|
|
|
|
} |
946
|
|
|
|
|
|
|
947
|
16660689
|
|
|
|
|
PP(pp_undef) |
948
|
|
|
|
|
|
{ |
949
|
16660689
|
|
|
|
|
dVAR; dSP; |
950
|
|
|
|
|
|
SV *sv; |
951
|
|
|
|
|
|
|
952
|
24905768
|
100
|
|
|
|
if (!PL_op->op_private) { |
|
|
50
|
|
|
|
|
953
|
8245079
|
|
|
|
|
EXTEND(SP, 1); |
954
|
16523996
|
|
|
|
|
RETPUSHUNDEF; |
955
|
|
|
|
|
|
} |
956
|
|
|
|
|
|
|
957
|
136693
|
|
|
|
|
sv = POPs; |
958
|
136693
|
100
|
|
|
|
if (!sv) |
959
|
8
|
|
|
|
|
RETPUSHUNDEF; |
960
|
|
|
|
|
|
|
961
|
136685
|
100
|
|
|
|
SV_CHECK_THINKFIRST_COW_DROP(sv); |
962
|
|
|
|
|
|
|
963
|
136685
|
|
|
|
|
switch (SvTYPE(sv)) { |
964
|
|
|
|
|
|
case SVt_NULL: |
965
|
|
|
|
|
|
break; |
966
|
|
|
|
|
|
case SVt_PVAV: |
967
|
830
|
|
|
|
|
av_undef(MUTABLE_AV(sv)); |
968
|
830
|
|
|
|
|
break; |
969
|
|
|
|
|
|
case SVt_PVHV: |
970
|
3064
|
|
|
|
|
hv_undef(MUTABLE_HV(sv)); |
971
|
3064
|
|
|
|
|
break; |
972
|
|
|
|
|
|
case SVt_PVCV: |
973
|
8741
|
100
|
|
|
|
if (cv_const_sv((const CV *)sv)) |
974
|
28
|
100
|
|
|
|
Perl_ck_warner(aTHX_ packWARN(WARN_MISC), |
975
|
|
|
|
|
|
"Constant subroutine %"SVf" undefined", |
976
|
46
|
100
|
|
|
|
SVfARG(CvANON((const CV *)sv) |
|
|
50
|
|
|
|
|
977
|
|
|
|
|
|
? newSVpvs_flags("(anonymous)", SVs_TEMP) |
978
|
|
|
|
|
|
: sv_2mortal(newSVhek( |
979
|
|
|
|
|
|
CvNAMED(sv) |
980
|
|
|
|
|
|
? CvNAME_HEK((CV *)sv) |
981
|
|
|
|
|
|
: GvENAME_HEK(CvGV((const CV *)sv)) |
982
|
|
|
|
|
|
)) |
983
|
|
|
|
|
|
)); |
984
|
|
|
|
|
|
/* FALLTHROUGH */ |
985
|
|
|
|
|
|
case SVt_PVFM: |
986
|
|
|
|
|
|
{ |
987
|
|
|
|
|
|
/* let user-undef'd sub keep its identity */ |
988
|
|
|
|
|
|
GV* const gv = CvGV((const CV *)sv); |
989
|
|
|
|
|
|
HEK * const hek = CvNAME_HEK((CV *)sv); |
990
|
8739
|
50
|
|
|
|
if (hek) share_hek_hek(hek); |
991
|
8739
|
|
|
|
|
cv_undef(MUTABLE_CV(sv)); |
992
|
8733
|
50
|
|
|
|
if (gv) CvGV_set(MUTABLE_CV(sv), gv); |
993
|
0
|
0
|
|
|
|
else if (hek) { |
994
|
0
|
|
|
|
|
SvANY((CV *)sv)->xcv_gv_u.xcv_hek = hek; |
995
|
0
|
|
|
|
|
CvNAMED_on(sv); |
996
|
|
|
|
|
|
} |
997
|
|
|
|
|
|
} |
998
|
|
|
|
|
|
break; |
999
|
|
|
|
|
|
case SVt_PVGV: |
1000
|
|
|
|
|
|
assert(isGV_with_GP(sv)); |
1001
|
|
|
|
|
|
assert(!SvFAKE(sv)); |
1002
|
|
|
|
|
|
{ |
1003
|
|
|
|
|
|
GP *gp; |
1004
|
|
|
|
|
|
HV *stash; |
1005
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
/* undef *Pkg::meth_name ... */ |
1007
|
1802
|
|
|
|
|
bool method_changed |
1008
|
2703
|
100
|
|
|
|
= GvCVu((const GV *)sv) && (stash = GvSTASH((const GV *)sv)) |
|
|
50
|
|
|
|
|
1009
|
2745
|
50
|
|
|
|
&& HvENAME_get(stash); |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
1010
|
|
|
|
|
|
/* undef *Foo:: */ |
1011
|
1802
|
100
|
|
|
|
if((stash = GvHV((const GV *)sv))) { |
1012
|
32
|
100
|
|
|
|
if(HvENAME_get(stash)) |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
1013
|
14
|
|
|
|
|
SvREFCNT_inc_simple_void_NN(sv_2mortal((SV *)stash)); |
1014
|
|
|
|
|
|
else stash = NULL; |
1015
|
|
|
|
|
|
} |
1016
|
|
|
|
|
|
|
1017
|
1802
|
|
|
|
|
gp_free(MUTABLE_GV(sv)); |
1018
|
1802
|
|
|
|
|
Newxz(gp, 1, GP); |
1019
|
1802
|
|
|
|
|
GvGP_set(sv, gp_ref(gp)); |
1020
|
1802
|
|
|
|
|
GvSV(sv) = newSV(0); |
1021
|
1802
|
|
|
|
|
GvLINE(sv) = CopLINE(PL_curcop); |
1022
|
1802
|
|
|
|
|
GvEGV(sv) = MUTABLE_GV(sv); |
1023
|
1802
|
|
|
|
|
GvMULTI_on(sv); |
1024
|
|
|
|
|
|
|
1025
|
1802
|
100
|
|
|
|
if(stash) |
1026
|
14
|
|
|
|
|
mro_package_moved(NULL, stash, (const GV *)sv, 0); |
1027
|
|
|
|
|
|
stash = NULL; |
1028
|
|
|
|
|
|
/* undef *Foo::ISA */ |
1029
|
1802
|
100
|
|
|
|
if( strEQ(GvNAME((const GV *)sv), "ISA") |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
1030
|
10
|
50
|
|
|
|
&& (stash = GvSTASH((const GV *)sv)) |
1031
|
10
|
50
|
|
|
|
&& (method_changed || HvENAME(stash)) ) |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
1032
|
10
|
|
|
|
|
mro_isa_changed_in(stash); |
1033
|
1792
|
100
|
|
|
|
else if(method_changed) |
1034
|
84
|
|
|
|
|
mro_method_changed_in( |
1035
|
|
|
|
|
|
GvSTASH((const GV *)sv) |
1036
|
|
|
|
|
|
); |
1037
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
break; |
1039
|
|
|
|
|
|
} |
1040
|
|
|
|
|
|
default: |
1041
|
92758
|
100
|
|
|
|
if (SvTYPE(sv) >= SVt_PV && SvPVX_const(sv) && SvLEN(sv)) { |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
1042
|
2962
|
50
|
|
|
|
SvPV_free(sv); |
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
1043
|
2962
|
|
|
|
|
SvPV_set(sv, NULL); |
1044
|
2962
|
|
|
|
|
SvLEN_set(sv, 0); |
1045
|
|
|
|
|
|
} |
1046
|
92758
|
50
|
|
|
|
SvOK_off(sv); |
1047
|
92758
|
100
|
|
|
|
SvSETMAGIC(sv); |
1048
|
|
|
|
|
|
} |
1049
|
|
|
|
|
|
|
1050
|
8415596
|
|
|
|
|
RETPUSHUNDEF; |
1051
|
|
|
|
|
|
} |
1052
|
|
|
|
|
|
|
1053
|
29431892
|
|
|
|
|
PP(pp_postinc) |
1054
|
|
|
|
|
|
{ |
1055
|
29431892
|
|
|
|
|
dVAR; dSP; dTARGET; |
1056
|
29431892
|
|
|
|
|
const bool inc = |
1057
|
29431892
|
|
|
|
|
PL_op->op_type == OP_POSTINC || PL_op->op_type == OP_I_POSTINC; |
1058
|
29431892
|
50
|
|
|
|
if (SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs))) |
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
1059
|
0
|
|
|
|
|
Perl_croak_no_modify(); |
1060
|
29431892
|
100
|
|
|
|
if (SvROK(TOPs)) |
1061
|
4
|
|
|
|
|
TARG = sv_newmortal(); |
1062
|
29431892
|
|
|
|
|
sv_setsv(TARG, TOPs); |
1063
|
29431892
|
100
|
|
|
|
if (!SvREADONLY(TOPs) && !SvGMAGICAL(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) |
1064
|
16080786
|
100
|
|
|
|
&& SvIVX(TOPs) != (inc ? IV_MAX : IV_MIN)) |
|
|
100
|
|
|
|
|
1065
|
|
|
|
|
|
{ |
1066
|
16080774
|
100
|
|
|
|
SvIV_set(TOPs, SvIVX(TOPs) + (inc ? 1 : -1)); |
1067
|
16080774
|
|
|
|
|
SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK); |
1068
|
|
|
|
|
|
} |
1069
|
13351118
|
100
|
|
|
|
else if (inc) |
1070
|
13273942
|
|
|
|
|
sv_inc_nomg(TOPs); |
1071
|
77176
|
|
|
|
|
else sv_dec_nomg(TOPs); |
1072
|
29431892
|
100
|
|
|
|
SvSETMAGIC(TOPs); |
1073
|
|
|
|
|
|
/* special case for undef: see thread at 2003-03/msg00536.html in archive */ |
1074
|
29431892
|
100
|
|
|
|
if (inc && !SvOK(TARG)) |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
1075
|
10668988
|
|
|
|
|
sv_setiv(TARG, 0); |
1076
|
29431892
|
|
|
|
|
SETs(TARG); |
1077
|
29431892
|
|
|
|
|
return NORMAL; |
1078
|
|
|
|
|
|
} |
1079
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
/* Ordinary operators. */ |
1081
|
|
|
|
|
|
|
1082
|
64954
|
|
|
|
|
PP(pp_pow) |
1083
|
|
|
|
|
|
{ |
1084
|
64954
|
100
|
|
|
|
dVAR; dSP; dATARGET; SV *svl, *svr; |
1085
|
|
|
|
|
|
#ifdef PERL_PRESERVE_IVUV |
1086
|
|
|
|
|
|
bool is_int = 0; |
1087
|
|
|
|
|
|
#endif |
1088
|
64954
|
100
|
|
|
|
tryAMAGICbin_MG(pow_amg, AMGf_assign|AMGf_numeric); |
|
|
100
|
|
|
|
|
1089
|
63782
|
|
|
|
|
svr = TOPs; |
1090
|
63782
|
|
|
|
|
svl = TOPm1s; |
1091
|
|
|
|
|
|
#ifdef PERL_PRESERVE_IVUV |
1092
|
|
|
|
|
|
/* For integer to integer power, we do the calculation by hand wherever |
1093
|
|
|
|
|
|
we're sure it is safe; otherwise we call pow() and try to convert to |
1094
|
|
|
|
|
|
integer afterwards. */ |
1095
|
63782
|
100
|
|
|
|
if (SvIV_please_nomg(svr) && SvIV_please_nomg(svl)) { |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
1096
|
|
|
|
|
|
UV power; |
1097
|
|
|
|
|
|
bool baseuok; |
1098
|
|
|
|
|
|
UV baseuv; |
1099
|
|
|
|
|
|
|
1100
|
63450
|
50
|
|
|
|
if (SvUOK(svr)) { |
1101
|
0
|
|
|
|
|
power = SvUVX(svr); |
1102
|
|
|
|
|
|
} else { |
1103
|
63450
|
|
|
|
|
const IV iv = SvIVX(svr); |
1104
|
63450
|
100
|
|
|
|
if (iv >= 0) { |
1105
|
62452
|
|
|
|
|
power = iv; |
1106
|
|
|
|
|
|
} else { |
1107
|
|
|
|
|
|
goto float_it; /* Can't do negative powers this way. */ |
1108
|
|
|
|
|
|
} |
1109
|
|
|
|
|
|
} |
1110
|
|
|
|
|
|
|
1111
|
62452
|
|
|
|
|
baseuok = SvUOK(svl); |
1112
|
62452
|
100
|
|
|
|
if (baseuok) { |
1113
|
2
|
|
|
|
|
baseuv = SvUVX(svl); |
1114
|
|
|
|
|
|
} else { |
1115
|
62450
|
|
|
|
|
const IV iv = SvIVX(svl); |
1116
|
62450
|
100
|
|
|
|
if (iv >= 0) { |
1117
|
62242
|
|
|
|
|
baseuv = iv; |
1118
|
|
|
|
|
|
baseuok = TRUE; /* effectively it's a UV now */ |
1119
|
|
|
|
|
|
} else { |
1120
|
208
|
|
|
|
|
baseuv = -iv; /* abs, baseuok == false records sign */ |
1121
|
|
|
|
|
|
} |
1122
|
|
|
|
|
|
} |
1123
|
|
|
|
|
|
/* now we have integer ** positive integer. */ |
1124
|
|
|
|
|
|
is_int = 1; |
1125
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
/* foo & (foo - 1) is zero only for a power of 2. */ |
1127
|
62452
|
100
|
|
|
|
if (!(baseuv & (baseuv - 1))) { |
1128
|
|
|
|
|
|
/* We are raising power-of-2 to a positive integer. |
1129
|
|
|
|
|
|
The logic here will work for any base (even non-integer |
1130
|
|
|
|
|
|
bases) but it can be less accurate than |
1131
|
|
|
|
|
|
pow (base,power) or exp (power * log (base)) when the |
1132
|
|
|
|
|
|
intermediate values start to spill out of the mantissa. |
1133
|
|
|
|
|
|
With powers of 2 we know this can't happen. |
1134
|
|
|
|
|
|
And powers of 2 are the favourite thing for perl |
1135
|
|
|
|
|
|
programmers to notice ** not doing what they mean. */ |
1136
|
|
|
|
|
|
NV result = 1.0; |
1137
|
43122
|
100
|
|
|
|
NV base = baseuok ? baseuv : -(NV)baseuv; |
1138
|
|
|
|
|
|
|
1139
|
43122
|
100
|
|
|
|
if (power & 1) { |
1140
|
|
|
|
|
|
result *= base; |
1141
|
|
|
|
|
|
} |
1142
|
130382
|
100
|
|
|
|
while (power >>= 1) { |
1143
|
87260
|
|
|
|
|
base *= base; |
1144
|
87260
|
100
|
|
|
|
if (power & 1) { |
1145
|
69761
|
|
|
|
|
result *= base; |
1146
|
|
|
|
|
|
} |
1147
|
|
|
|
|
|
} |
1148
|
43122
|
|
|
|
|
SP--; |
1149
|
43122
|
50
|
|
|
|
SETn( result ); |
1150
|
43122
|
50
|
|
|
|
SvIV_please_nomg(svr); |
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
1151
|
43122
|
|
|
|
|
RETURN; |
1152
|
|
|
|
|
|
} else { |
1153
|
|
|
|
|
|
unsigned int highbit = 8 * sizeof(UV); |
1154
|
|
|
|
|
|
unsigned int diff = 8 * sizeof(UV); |
1155
|
135310
|
100
|
|
|
|
while (diff >>= 1) { |
1156
|
115980
|
|
|
|
|
highbit -= diff; |
1157
|
115980
|
100
|
|
|
|
if (baseuv >> highbit) { |
1158
|
|
|
|
|
|
highbit += diff; |
1159
|
|
|
|
|
|
} |
1160
|
|
|
|
|
|
} |
1161
|
|
|
|
|
|
/* we now have baseuv < 2 ** highbit */ |
1162
|
19330
|
100
|
|
|
|
if (power * highbit <= 8 * sizeof(UV)) { |
1163
|
|
|
|
|
|
/* result will definitely fit in UV, so use UV math |
1164
|
|
|
|
|
|
on same algorithm as above */ |
1165
|
|
|
|
|
|
UV result = 1; |
1166
|
|
|
|
|
|
UV base = baseuv; |
1167
|
9988
|
|
|
|
|
const bool odd_power = cBOOL(power & 1); |
1168
|
9988
|
100
|
|
|
|
if (odd_power) { |
1169
|
|
|
|
|
|
result *= base; |
1170
|
|
|
|
|
|
} |
1171
|
38544
|
100
|
|
|
|
while (power >>= 1) { |
1172
|
28556
|
|
|
|
|
base *= base; |
1173
|
28556
|
100
|
|
|
|
if (power & 1) { |
1174
|
19120
|
|
|
|
|
result *= base; |
1175
|
|
|
|
|
|
} |
1176
|
|
|
|
|
|
} |
1177
|
9988
|
|
|
|
|
SP--; |
1178
|
9988
|
100
|
|
|
|
if (baseuok || !odd_power) |
|
|
100
|
|
|
|
|
1179
|
|
|
|
|
|
/* answer is positive */ |
1180
|
9952
|
50
|
|
|
|
SETu( result ); |
1181
|
36
|
50
|
|
|
|
else if (result <= (UV)IV_MAX) |
1182
|
|
|
|
|
|
/* answer negative, fits in IV */ |
1183
|
36
|
50
|
|
|
|
SETi( -(IV)result ); |
1184
|
0
|
0
|
|
|
|
else if (result == (UV)IV_MIN) |
1185
|
|
|
|
|
|
/* 2's complement assumption: special case IV_MIN */ |
1186
|
0
|
0
|
|
|
|
SETi( IV_MIN ); |
1187
|
|
|
|
|
|
else |
1188
|
|
|
|
|
|
/* answer negative, doesn't fit */ |
1189
|
0
|
0
|
|
|
|
SETn( -(NV)result ); |
1190
|
9988
|
|
|
|
|
RETURN; |
1191
|
|
|
|
|
|
} |
1192
|
|
|
|
|
|
} |
1193
|
|
|
|
|
|
} |
1194
|
|
|
|
|
|
float_it: |
1195
|
|
|
|
|
|
#endif |
1196
|
|
|
|
|
|
{ |
1197
|
10672
|
100
|
|
|
|
NV right = SvNV_nomg(svr); |
1198
|
10672
|
100
|
|
|
|
NV left = SvNV_nomg(svl); |
1199
|
10672
|
|
|
|
|
(void)POPs; |
1200
|
|
|
|
|
|
|
1201
|
|
|
|
|
|
#if defined(USE_LONG_DOUBLE) && defined(HAS_AIX_POWL_NEG_BASE_BUG) |
1202
|
|
|
|
|
|
/* |
1203
|
|
|
|
|
|
We are building perl with long double support and are on an AIX OS |
1204
|
|
|
|
|
|
afflicted with a powl() function that wrongly returns NaNQ for any |
1205
|
|
|
|
|
|
negative base. This was reported to IBM as PMR #23047-379 on |
1206
|
|
|
|
|
|
03/06/2006. The problem exists in at least the following versions |
1207
|
|
|
|
|
|
of AIX and the libm fileset, and no doubt others as well: |
1208
|
|
|
|
|
|
|
1209
|
|
|
|
|
|
AIX 4.3.3-ML10 bos.adt.libm 4.3.3.50 |
1210
|
|
|
|
|
|
AIX 5.1.0-ML04 bos.adt.libm 5.1.0.29 |
1211
|
|
|
|
|
|
AIX 5.2.0 bos.adt.libm 5.2.0.85 |
1212
|
|
|
|
|
|
|
1213
|
|
|
|
|
|
So, until IBM fixes powl(), we provide the following workaround to |
1214
|
|
|
|
|
|
handle the problem ourselves. Our logic is as follows: for |
1215
|
|
|
|
|
|
negative bases (left), we use fmod(right, 2) to check if the |
1216
|
|
|
|
|
|
exponent is an odd or even integer: |
1217
|
|
|
|
|
|
|
1218
|
|
|
|
|
|
- if odd, powl(left, right) == -powl(-left, right) |
1219
|
|
|
|
|
|
- if even, powl(left, right) == powl(-left, right) |
1220
|
|
|
|
|
|
|
1221
|
|
|
|
|
|
If the exponent is not an integer, the result is rightly NaNQ, so |
1222
|
|
|
|
|
|
we just return that (as NV_NAN). |
1223
|
|
|
|
|
|
*/ |
1224
|
|
|
|
|
|
|
1225
|
|
|
|
|
|
if (left < 0.0) { |
1226
|
|
|
|
|
|
NV mod2 = Perl_fmod( right, 2.0 ); |
1227
|
|
|
|
|
|
if (mod2 == 1.0 || mod2 == -1.0) { /* odd integer */ |
1228
|
|
|
|
|
|
SETn( -Perl_pow( -left, right) ); |
1229
|
|
|
|
|
|
} else if (mod2 == 0.0) { /* even integer */ |
1230
|
|
|
|
|
|
SETn( Perl_pow( -left, right) ); |
1231
|
|
|
|
|
|
} else { /* fractional power */ |
1232
|
|
|
|
|
|
SETn( NV_NAN ); |
1233
|
|
|
|
|
|
} |
1234
|
|
|
|
|
|
} else { |
1235
|
|
|
|
|
|
SETn( Perl_pow( left, right) ); |
1236
|
|
|
|
|
|
} |
1237
|
|
|
|
|
|
#else |
1238
|
10672
|
100
|
|
|
|
SETn( Perl_pow( left, right) ); |
1239
|
|
|
|
|
|
#endif /* HAS_AIX_POWL_NEG_BASE_BUG */ |
1240
|
|
|
|
|
|
|
1241
|
|
|
|
|
|
#ifdef PERL_PRESERVE_IVUV |
1242
|
10672
|
100
|
|
|
|
if (is_int) |
1243
|
9342
|
50
|
|
|
|
SvIV_please_nomg(svr); |
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
1244
|
|
|
|
|
|
#endif |
1245
|
38713
|
|
|
|
|
RETURN; |
1246
|
|
|
|
|
|
} |
1247
|
|
|
|
|
|
} |
1248
|
|
|
|
|
|
|
1249
|
1498132
|
|
|
|
|
PP(pp_multiply) |
1250
|
|
|
|
|
|
{ |
1251
|
1498132
|
100
|
|
|
|
dVAR; dSP; dATARGET; SV *svl, *svr; |
1252
|
1498132
|
100
|
|
|
|
tryAMAGICbin_MG(mult_amg, AMGf_assign|AMGf_numeric); |
|
|
100
|
|
|
|
|
1253
|
1476412
|
|
|
|
|
svr = TOPs; |
1254
|
1476412
|
|
|
|
|
svl = TOPm1s; |
1255
|
|
|
|
|
|
#ifdef PERL_PRESERVE_IVUV |
1256
|
1476412
|
100
|
|
|
|
if (SvIV_please_nomg(svr)) { |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
1257
|
|
|
|
|
|
/* Unless the left argument is integer in range we are going to have to |
1258
|
|
|
|
|
|
use NV maths. Hence only attempt to coerce the right argument if |
1259
|
|
|
|
|
|
we know the left is integer. */ |
1260
|
|
|
|
|
|
/* Left operand is defined, so is it IV? */ |
1261
|
1308074
|
100
|
|
|
|
if (SvIV_please_nomg(svl)) { |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
1262
|
1261408
|
|
|
|
|
bool auvok = SvUOK(svl); |
1263
|
1261408
|
|
|
|
|
bool buvok = SvUOK(svr); |
1264
|
|
|
|
|
|
const UV topmask = (~ (UV)0) << (4 * sizeof (UV)); |
1265
|
|
|
|
|
|
const UV botmask = ~((~ (UV)0) << (4 * sizeof (UV))); |
1266
|
|
|
|
|
|
UV alow; |
1267
|
|
|
|
|
|
UV ahigh; |
1268
|
|
|
|
|
|
UV blow; |
1269
|
|
|
|
|
|
UV bhigh; |
1270
|
|
|
|
|
|
|
1271
|
1261408
|
100
|
|
|
|
if (auvok) { |
1272
|
2
|
|
|
|
|
alow = SvUVX(svl); |
1273
|
|
|
|
|
|
} else { |
1274
|
1261406
|
|
|
|
|
const IV aiv = SvIVX(svl); |
1275
|
1261406
|
100
|
|
|
|
if (aiv >= 0) { |
1276
|
1239110
|
|
|
|
|
alow = aiv; |
1277
|
|
|
|
|
|
auvok = TRUE; /* effectively it's a UV now */ |
1278
|
|
|
|
|
|
} else { |
1279
|
22296
|
|
|
|
|
alow = -aiv; /* abs, auvok == false records sign */ |
1280
|
|
|
|
|
|
} |
1281
|
|
|
|
|
|
} |
1282
|
1261408
|
100
|
|
|
|
if (buvok) { |
1283
|
126
|
|
|
|
|
blow = SvUVX(svr); |
1284
|
|
|
|
|
|
} else { |
1285
|
1261282
|
|
|
|
|
const IV biv = SvIVX(svr); |
1286
|
1261282
|
100
|
|
|
|
if (biv >= 0) { |
1287
|
1260148
|
|
|
|
|
blow = biv; |
1288
|
|
|
|
|
|
buvok = TRUE; /* effectively it's a UV now */ |
1289
|
|
|
|
|
|
} else { |
1290
|
1134
|
|
|
|
|
blow = -biv; /* abs, buvok == false records sign */ |
1291
|
|
|
|
|
|
} |
1292
|
|
|
|
|
|
} |
1293
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
/* If this does sign extension on unsigned it's time for plan B */ |
1295
|
1261408
|
|
|
|
|
ahigh = alow >> (4 * sizeof (UV)); |
1296
|
1261408
|
|
|
|
|
alow &= botmask; |
1297
|
1261408
|
|
|
|
|
bhigh = blow >> (4 * sizeof (UV)); |
1298
|
1261408
|
|
|
|
|
blow &= botmask; |
1299
|
1261408
|
100
|
|
|
|
if (ahigh && bhigh) { |
1300
|
|
|
|
|
|
NOOP; |
1301
|
|
|
|
|
|
/* eg 32 bit is at least 0x10000 * 0x10000 == 0x100000000 |
1302
|
|
|
|
|
|
which is overflow. Drop to NVs below. */ |
1303
|
1261232
|
100
|
|
|
|
} else if (!ahigh && !bhigh) { |
1304
|
|
|
|
|
|
/* eg 32 bit is at most 0xFFFF * 0xFFFF == 0xFFFE0001 |
1305
|
|
|
|
|
|
so the unsigned multiply cannot overflow. */ |
1306
|
1241012
|
|
|
|
|
const UV product = alow * blow; |
1307
|
1241012
|
100
|
|
|
|
if (auvok == buvok) { |
1308
|
|
|
|
|
|
/* -ve * -ve or +ve * +ve gives a +ve result. */ |
1309
|
1219228
|
|
|
|
|
SP--; |
1310
|
1219228
|
50
|
|
|
|
SETu( product ); |
1311
|
1219228
|
|
|
|
|
RETURN; |
1312
|
21784
|
50
|
|
|
|
} else if (product <= (UV)IV_MIN) { |
1313
|
|
|
|
|
|
/* 2s complement assumption that (UV)-IV_MIN is correct. */ |
1314
|
|
|
|
|
|
/* -ve result, which could overflow an IV */ |
1315
|
21784
|
|
|
|
|
SP--; |
1316
|
21784
|
50
|
|
|
|
SETi( -(IV)product ); |
1317
|
21784
|
|
|
|
|
RETURN; |
1318
|
|
|
|
|
|
} /* else drop to NVs below. */ |
1319
|
|
|
|
|
|
} else { |
1320
|
|
|
|
|
|
/* One operand is large, 1 small */ |
1321
|
|
|
|
|
|
UV product_middle; |
1322
|
20220
|
100
|
|
|
|
if (bhigh) { |
1323
|
|
|
|
|
|
/* swap the operands */ |
1324
|
|
|
|
|
|
ahigh = bhigh; |
1325
|
|
|
|
|
|
bhigh = blow; /* bhigh now the temp var for the swap */ |
1326
|
|
|
|
|
|
blow = alow; |
1327
|
|
|
|
|
|
alow = bhigh; |
1328
|
|
|
|
|
|
} |
1329
|
|
|
|
|
|
/* now, ((ahigh * blow) << half_UV_len) + (alow * blow) |
1330
|
|
|
|
|
|
multiplies can't overflow. shift can, add can, -ve can. */ |
1331
|
20220
|
|
|
|
|
product_middle = ahigh * blow; |
1332
|
20220
|
100
|
|
|
|
if (!(product_middle & topmask)) { |
1333
|
|
|
|
|
|
/* OK, (ahigh * blow) won't lose bits when we shift it. */ |
1334
|
|
|
|
|
|
UV product_low; |
1335
|
20206
|
|
|
|
|
product_middle <<= (4 * sizeof (UV)); |
1336
|
20206
|
|
|
|
|
product_low = alow * blow; |
1337
|
|
|
|
|
|
|
1338
|
|
|
|
|
|
/* as for pp_add, UV + something mustn't get smaller. |
1339
|
|
|
|
|
|
IIRC ANSI mandates this wrapping *behaviour* for |
1340
|
|
|
|
|
|
unsigned whatever the actual representation*/ |
1341
|
20206
|
|
|
|
|
product_low += product_middle; |
1342
|
20206
|
50
|
|
|
|
if (product_low >= product_middle) { |
1343
|
|
|
|
|
|
/* didn't overflow */ |
1344
|
20206
|
100
|
|
|
|
if (auvok == buvok) { |
1345
|
|
|
|
|
|
/* -ve * -ve or +ve * +ve gives a +ve result. */ |
1346
|
20148
|
|
|
|
|
SP--; |
1347
|
20148
|
50
|
|
|
|
SETu( product_low ); |
1348
|
20148
|
|
|
|
|
RETURN; |
1349
|
58
|
50
|
|
|
|
} else if (product_low <= (UV)IV_MIN) { |
1350
|
|
|
|
|
|
/* 2s complement assumption again */ |
1351
|
|
|
|
|
|
/* -ve result, which could overflow an IV */ |
1352
|
58
|
|
|
|
|
SP--; |
1353
|
58
|
50
|
|
|
|
SETi( -(IV)product_low ); |
1354
|
58
|
|
|
|
|
RETURN; |
1355
|
|
|
|
|
|
} /* else drop to NVs below. */ |
1356
|
|
|
|
|
|
} |
1357
|
|
|
|
|
|
} /* product_middle too large */ |
1358
|
|
|
|
|
|
} /* ahigh && bhigh */ |
1359
|
|
|
|
|
|
} /* SvIOK(svl) */ |
1360
|
|
|
|
|
|
} /* SvIOK(svr) */ |
1361
|
|
|
|
|
|
#endif |
1362
|
|
|
|
|
|
{ |
1363
|
215192
|
100
|
|
|
|
NV right = SvNV_nomg(svr); |
1364
|
215192
|
100
|
|
|
|
NV left = SvNV_nomg(svl); |
1365
|
215192
|
|
|
|
|
(void)POPs; |
1366
|
215192
|
100
|
|
|
|
SETn( left * right ); |
1367
|
856829
|
|
|
|
|
RETURN; |
1368
|
|
|
|
|
|
} |
1369
|
|
|
|
|
|
} |
1370
|
|
|
|
|
|
|
1371
|
1799332
|
|
|
|
|
PP(pp_divide) |
1372
|
|
|
|
|
|
{ |
1373
|
1799332
|
100
|
|
|
|
dVAR; dSP; dATARGET; SV *svl, *svr; |
1374
|
1799332
|
100
|
|
|
|
tryAMAGICbin_MG(div_amg, AMGf_assign|AMGf_numeric); |
|
|
100
|
|
|
|
|
1375
|
1794858
|
|
|
|
|
svr = TOPs; |
1376
|
1794858
|
|
|
|
|
svl = TOPm1s; |
1377
|
|
|
|
|
|
/* Only try to do UV divide first |
1378
|
|
|
|
|
|
if ((SLOPPYDIVIDE is true) or |
1379
|
|
|
|
|
|
(PERL_PRESERVE_IVUV is true and one or both SV is a UV too large |
1380
|
|
|
|
|
|
to preserve)) |
1381
|
|
|
|
|
|
The assumption is that it is better to use floating point divide |
1382
|
|
|
|
|
|
whenever possible, only doing integer divide first if we can't be sure. |
1383
|
|
|
|
|
|
If NV_PRESERVES_UV is true then we know at compile time that no UV |
1384
|
|
|
|
|
|
can be too large to preserve, so don't need to compile the code to |
1385
|
|
|
|
|
|
test the size of UVs. */ |
1386
|
|
|
|
|
|
|
1387
|
|
|
|
|
|
#ifdef SLOPPYDIVIDE |
1388
|
|
|
|
|
|
# define PERL_TRY_UV_DIVIDE |
1389
|
|
|
|
|
|
/* ensure that 20./5. == 4. */ |
1390
|
|
|
|
|
|
#else |
1391
|
|
|
|
|
|
# ifdef PERL_PRESERVE_IVUV |
1392
|
|
|
|
|
|
# ifndef NV_PRESERVES_UV |
1393
|
|
|
|
|
|
# define PERL_TRY_UV_DIVIDE |
1394
|
|
|
|
|
|
# endif |
1395
|
|
|
|
|
|
# endif |
1396
|
|
|
|
|
|
#endif |
1397
|
|
|
|
|
|
|
1398
|
|
|
|
|
|
#ifdef PERL_TRY_UV_DIVIDE |
1399
|
1794858
|
100
|
|
|
|
if (SvIV_please_nomg(svr) && SvIV_please_nomg(svl)) { |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
1400
|
1775548
|
|
|
|
|
bool left_non_neg = SvUOK(svl); |
1401
|
1775548
|
|
|
|
|
bool right_non_neg = SvUOK(svr); |
1402
|
|
|
|
|
|
UV left; |
1403
|
|
|
|
|
|
UV right; |
1404
|
|
|
|
|
|
|
1405
|
1775548
|
100
|
|
|
|
if (right_non_neg) { |
1406
|
120
|
|
|
|
|
right = SvUVX(svr); |
1407
|
|
|
|
|
|
} |
1408
|
|
|
|
|
|
else { |
1409
|
1775428
|
|
|
|
|
const IV biv = SvIVX(svr); |
1410
|
1775428
|
100
|
|
|
|
if (biv >= 0) { |
1411
|
1775306
|
|
|
|
|
right = biv; |
1412
|
|
|
|
|
|
right_non_neg = TRUE; /* effectively it's a UV now */ |
1413
|
|
|
|
|
|
} |
1414
|
|
|
|
|
|
else { |
1415
|
122
|
|
|
|
|
right = -biv; |
1416
|
|
|
|
|
|
} |
1417
|
|
|
|
|
|
} |
1418
|
|
|
|
|
|
/* historically undef()/0 gives a "Use of uninitialized value" |
1419
|
|
|
|
|
|
warning before dieing, hence this test goes here. |
1420
|
|
|
|
|
|
If it were immediately before the second SvIV_please, then |
1421
|
|
|
|
|
|
DIE() would be invoked before left was even inspected, so |
1422
|
|
|
|
|
|
no inspection would give no warning. */ |
1423
|
1775548
|
100
|
|
|
|
if (right == 0) |
1424
|
16
|
|
|
|
|
DIE(aTHX_ "Illegal division by zero"); |
1425
|
|
|
|
|
|
|
1426
|
1775532
|
100
|
|
|
|
if (left_non_neg) { |
1427
|
12
|
|
|
|
|
left = SvUVX(svl); |
1428
|
|
|
|
|
|
} |
1429
|
|
|
|
|
|
else { |
1430
|
1775520
|
|
|
|
|
const IV aiv = SvIVX(svl); |
1431
|
1775520
|
100
|
|
|
|
if (aiv >= 0) { |
1432
|
1774094
|
|
|
|
|
left = aiv; |
1433
|
|
|
|
|
|
left_non_neg = TRUE; /* effectively it's a UV now */ |
1434
|
|
|
|
|
|
} |
1435
|
|
|
|
|
|
else { |
1436
|
1426
|
|
|
|
|
left = -aiv; |
1437
|
|
|
|
|
|
} |
1438
|
|
|
|
|
|
} |
1439
|
|
|
|
|
|
|
1440
|
2663298
|
100
|
|
|
|
if (left >= right |
1441
|
|
|
|
|
|
#ifdef SLOPPYDIVIDE |
1442
|
|
|
|
|
|
/* For sloppy divide we always attempt integer division. */ |
1443
|
|
|
|
|
|
#else |
1444
|
|
|
|
|
|
/* Otherwise we only attempt it if either or both operands |
1445
|
|
|
|
|
|
would not be preserved by an NV. If both fit in NVs |
1446
|
|
|
|
|
|
we fall through to the NV divide code below. However, |
1447
|
|
|
|
|
|
as left >= right to ensure integer result here, we know that |
1448
|
|
|
|
|
|
we can skip the test on the right operand - right big |
1449
|
|
|
|
|
|
enough not to be preserved can't get here unless left is |
1450
|
|
|
|
|
|
also too big. */ |
1451
|
|
|
|
|
|
|
1452
|
1775532
|
|
|
|
|
&& (left > ((UV)1 << NV_PRESERVES_UV_BITS)) |
1453
|
|
|
|
|
|
#endif |
1454
|
|
|
|
|
|
) { |
1455
|
|
|
|
|
|
/* Integer division can't overflow, but it can be imprecise. */ |
1456
|
44
|
|
|
|
|
const UV result = left / right; |
1457
|
44
|
100
|
|
|
|
if (result * right == left) { |
1458
|
38
|
|
|
|
|
SP--; /* result is valid */ |
1459
|
38
|
100
|
|
|
|
if (left_non_neg == right_non_neg) { |
1460
|
|
|
|
|
|
/* signs identical, result is positive. */ |
1461
|
34
|
50
|
|
|
|
SETu( result ); |
1462
|
34
|
|
|
|
|
RETURN; |
1463
|
|
|
|
|
|
} |
1464
|
|
|
|
|
|
/* 2s complement assumption */ |
1465
|
4
|
50
|
|
|
|
if (result <= (UV)IV_MIN) |
1466
|
4
|
50
|
|
|
|
SETi( -(IV)result ); |
1467
|
|
|
|
|
|
else { |
1468
|
|
|
|
|
|
/* It's exact but too negative for IV. */ |
1469
|
0
|
0
|
|
|
|
SETn( -(NV)result ); |
1470
|
|
|
|
|
|
} |
1471
|
4
|
|
|
|
|
RETURN; |
1472
|
|
|
|
|
|
} /* tried integer divide but it was not an integer result */ |
1473
|
|
|
|
|
|
} /* else (PERL_ABS(result) < 1.0) or (both UVs in range for NV) */ |
1474
|
|
|
|
|
|
} /* one operand wasn't SvIOK */ |
1475
|
|
|
|
|
|
#endif /* PERL_TRY_UV_DIVIDE */ |
1476
|
|
|
|
|
|
{ |
1477
|
1794804
|
100
|
|
|
|
NV right = SvNV_nomg(svr); |
1478
|
1794804
|
100
|
|
|
|
NV left = SvNV_nomg(svl); |
1479
|
|
|
|
|
|
(void)POPs;(void)POPs; |
1480
|
|
|
|
|
|
#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) |
1481
|
|
|
|
|
|
if (! Perl_isnan(right) && right == 0.0) |
1482
|
|
|
|
|
|
#else |
1483
|
1794804
|
100
|
|
|
|
if (right == 0.0) |
1484
|
|
|
|
|
|
#endif |
1485
|
4
|
|
|
|
|
DIE(aTHX_ "Illegal division by zero"); |
1486
|
1794800
|
100
|
|
|
|
PUSHn( left / right ); |
1487
|
1797043
|
|
|
|
|
RETURN; |
1488
|
|
|
|
|
|
} |
1489
|
|
|
|
|
|
} |
1490
|
|
|
|
|
|
|
1491
|
1114354
|
|
|
|
|
PP(pp_modulo) |
1492
|
|
|
|
|
|
{ |
1493
|
1114354
|
100
|
|
|
|
dVAR; dSP; dATARGET; |
1494
|
1114354
|
100
|
|
|
|
tryAMAGICbin_MG(modulo_amg, AMGf_assign|AMGf_numeric); |
|
|
100
|
|
|
|
|
1495
|
|
|
|
|
|
{ |
1496
|
|
|
|
|
|
UV left = 0; |
1497
|
|
|
|
|
|
UV right = 0; |
1498
|
|
|
|
|
|
bool left_neg = FALSE; |
1499
|
|
|
|
|
|
bool right_neg = FALSE; |
1500
|
|
|
|
|
|
bool use_double = FALSE; |
1501
|
|
|
|
|
|
bool dright_valid = FALSE; |
1502
|
|
|
|
|
|
NV dright = 0.0; |
1503
|
|
|
|
|
|
NV dleft = 0.0; |
1504
|
1112764
|
|
|
|
|
SV * const svr = TOPs; |
1505
|
1112764
|
|
|
|
|
SV * const svl = TOPm1s; |
1506
|
1112764
|
100
|
|
|
|
if (SvIV_please_nomg(svr)) { |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
1507
|
1112752
|
|
|
|
|
right_neg = !SvUOK(svr); |
1508
|
1112752
|
100
|
|
|
|
if (!right_neg) { |
1509
|
2
|
|
|
|
|
right = SvUVX(svr); |
1510
|
|
|
|
|
|
} else { |
1511
|
1112750
|
|
|
|
|
const IV biv = SvIVX(svr); |
1512
|
1112750
|
100
|
|
|
|
if (biv >= 0) { |
1513
|
1112740
|
|
|
|
|
right = biv; |
1514
|
|
|
|
|
|
right_neg = FALSE; /* effectively it's a UV now */ |
1515
|
|
|
|
|
|
} else { |
1516
|
10
|
|
|
|
|
right = -biv; |
1517
|
|
|
|
|
|
} |
1518
|
|
|
|
|
|
} |
1519
|
|
|
|
|
|
} |
1520
|
|
|
|
|
|
else { |
1521
|
12
|
100
|
|
|
|
dright = SvNV_nomg(svr); |
1522
|
12
|
|
|
|
|
right_neg = dright < 0; |
1523
|
12
|
100
|
|
|
|
if (right_neg) |
1524
|
4
|
|
|
|
|
dright = -dright; |
1525
|
12
|
100
|
|
|
|
if (dright < UV_MAX_P1) { |
1526
|
4
|
|
|
|
|
right = U_V(dright); |
1527
|
|
|
|
|
|
dright_valid = TRUE; /* In case we need to use double below. */ |
1528
|
|
|
|
|
|
} else { |
1529
|
|
|
|
|
|
use_double = TRUE; |
1530
|
|
|
|
|
|
} |
1531
|
|
|
|
|
|
} |
1532
|
|
|
|
|
|
|
1533
|
|
|
|
|
|
/* At this point use_double is only true if right is out of range for |
1534
|
|
|
|
|
|
a UV. In range NV has been rounded down to nearest UV and |
1535
|
|
|
|
|
|
use_double false. */ |
1536
|
1112764
|
100
|
|
|
|
if (!use_double && SvIV_please_nomg(svl)) { |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
1537
|
1112752
|
|
|
|
|
left_neg = !SvUOK(svl); |
1538
|
1112752
|
100
|
|
|
|
if (!left_neg) { |
1539
|
8
|
|
|
|
|
left = SvUVX(svl); |
1540
|
|
|
|
|
|
} else { |
1541
|
1112744
|
|
|
|
|
const IV aiv = SvIVX(svl); |
1542
|
1112744
|
100
|
|
|
|
if (aiv >= 0) { |
1543
|
1112720
|
|
|
|
|
left = aiv; |
1544
|
|
|
|
|
|
left_neg = FALSE; /* effectively it's a UV now */ |
1545
|
|
|
|
|
|
} else { |
1546
|
24
|
|
|
|
|
left = -aiv; |
1547
|
|
|
|
|
|
} |
1548
|
|
|
|
|
|
} |
1549
|
|
|
|
|
|
} |
1550
|
|
|
|
|
|
else { |
1551
|
12
|
100
|
|
|
|
dleft = SvNV_nomg(svl); |
1552
|
12
|
|
|
|
|
left_neg = dleft < 0; |
1553
|
12
|
100
|
|
|
|
if (left_neg) |
1554
|
4
|
|
|
|
|
dleft = -dleft; |
1555
|
|
|
|
|
|
|
1556
|
|
|
|
|
|
/* This should be exactly the 5.6 behaviour - if left and right are |
1557
|
|
|
|
|
|
both in range for UV then use U_V() rather than floor. */ |
1558
|
12
|
100
|
|
|
|
if (!use_double) { |
1559
|
4
|
50
|
|
|
|
if (dleft < UV_MAX_P1) { |
1560
|
|
|
|
|
|
/* right was in range, so is dleft, so use UVs not double. |
1561
|
|
|
|
|
|
*/ |
1562
|
4
|
|
|
|
|
left = U_V(dleft); |
1563
|
|
|
|
|
|
} |
1564
|
|
|
|
|
|
/* left is out of range for UV, right was in range, so promote |
1565
|
|
|
|
|
|
right (back) to double. */ |
1566
|
|
|
|
|
|
else { |
1567
|
|
|
|
|
|
/* The +0.5 is used in 5.6 even though it is not strictly |
1568
|
|
|
|
|
|
consistent with the implicit +0 floor in the U_V() |
1569
|
|
|
|
|
|
inside the #if 1. */ |
1570
|
0
|
|
|
|
|
dleft = Perl_floor(dleft + 0.5); |
1571
|
|
|
|
|
|
use_double = TRUE; |
1572
|
0
|
0
|
|
|
|
if (dright_valid) |
1573
|
0
|
|
|
|
|
dright = Perl_floor(dright + 0.5); |
1574
|
|
|
|
|
|
else |
1575
|
0
|
|
|
|
|
dright = right; |
1576
|
|
|
|
|
|
} |
1577
|
|
|
|
|
|
} |
1578
|
|
|
|
|
|
} |
1579
|
|
|
|
|
|
sp -= 2; |
1580
|
1112764
|
100
|
|
|
|
if (use_double) { |
1581
|
|
|
|
|
|
NV dans; |
1582
|
|
|
|
|
|
|
1583
|
8
|
50
|
|
|
|
if (!dright) |
1584
|
0
|
|
|
|
|
DIE(aTHX_ "Illegal modulus zero"); |
1585
|
|
|
|
|
|
|
1586
|
8
|
|
|
|
|
dans = Perl_fmod(dleft, dright); |
1587
|
8
|
100
|
|
|
|
if ((left_neg != right_neg) && dans) |
|
|
50
|
|
|
|
|
1588
|
4
|
|
|
|
|
dans = dright - dans; |
1589
|
8
|
100
|
|
|
|
if (right_neg) |
1590
|
4
|
|
|
|
|
dans = -dans; |
1591
|
8
|
|
|
|
|
sv_setnv(TARG, dans); |
1592
|
|
|
|
|
|
} |
1593
|
|
|
|
|
|
else { |
1594
|
|
|
|
|
|
UV ans; |
1595
|
|
|
|
|
|
|
1596
|
1112756
|
100
|
|
|
|
if (!right) |
1597
|
4
|
|
|
|
|
DIE(aTHX_ "Illegal modulus zero"); |
1598
|
|
|
|
|
|
|
1599
|
1112752
|
|
|
|
|
ans = left % right; |
1600
|
1112752
|
100
|
|
|
|
if ((left_neg != right_neg) && ans) |
1601
|
20
|
|
|
|
|
ans = right - ans; |
1602
|
1112752
|
100
|
|
|
|
if (right_neg) { |
1603
|
|
|
|
|
|
/* XXX may warn: unary minus operator applied to unsigned type */ |
1604
|
|
|
|
|
|
/* could change -foo to be (~foo)+1 instead */ |
1605
|
10
|
50
|
|
|
|
if (ans <= ~((UV)IV_MAX)+1) |
1606
|
10
|
|
|
|
|
sv_setiv(TARG, ~ans+1); |
1607
|
|
|
|
|
|
else |
1608
|
0
|
|
|
|
|
sv_setnv(TARG, -(NV)ans); |
1609
|
|
|
|
|
|
} |
1610
|
|
|
|
|
|
else |
1611
|
1112742
|
|
|
|
|
sv_setuv(TARG, ans); |
1612
|
|
|
|
|
|
} |
1613
|
1112760
|
50
|
|
|
|
PUSHTARG; |
1614
|
1113555
|
|
|
|
|
RETURN; |
1615
|
|
|
|
|
|
} |
1616
|
|
|
|
|
|
} |
1617
|
|
|
|
|
|
|
1618
|
640621
|
|
|
|
|
PP(pp_repeat) |
1619
|
|
|
|
|
|
{ |
1620
|
640621
|
100
|
|
|
|
dVAR; dSP; dATARGET; |
1621
|
|
|
|
|
|
IV count; |
1622
|
|
|
|
|
|
SV *sv; |
1623
|
|
|
|
|
|
|
1624
|
682435
|
100
|
|
|
|
if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) { |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
1625
|
|
|
|
|
|
/* TODO: think of some way of doing list-repeat overloading ??? */ |
1626
|
83987
|
|
|
|
|
sv = POPs; |
1627
|
41814
|
|
|
|
|
SvGETMAGIC(sv); |
1628
|
|
|
|
|
|
} |
1629
|
|
|
|
|
|
else { |
1630
|
556634
|
100
|
|
|
|
tryAMAGICbin_MG(repeat_amg, AMGf_assign); |
|
|
50
|
|
|
|
|
1631
|
556634
|
|
|
|
|
sv = POPs; |
1632
|
|
|
|
|
|
} |
1633
|
|
|
|
|
|
|
1634
|
640621
|
100
|
|
|
|
if (SvIOKp(sv)) { |
1635
|
601409
|
50
|
|
|
|
if (SvUOK(sv)) { |
1636
|
0
|
0
|
|
|
|
const UV uv = SvUV_nomg(sv); |
1637
|
0
|
0
|
|
|
|
if (uv > IV_MAX) |
1638
|
|
|
|
|
|
count = IV_MAX; /* The best we can do? */ |
1639
|
|
|
|
|
|
else |
1640
|
0
|
|
|
|
|
count = uv; |
1641
|
|
|
|
|
|
} else { |
1642
|
601409
|
100
|
|
|
|
const IV iv = SvIV_nomg(sv); |
1643
|
601409
|
100
|
|
|
|
if (iv < 0) |
1644
|
|
|
|
|
|
count = 0; |
1645
|
|
|
|
|
|
else |
1646
|
|
|
|
|
|
count = iv; |
1647
|
|
|
|
|
|
} |
1648
|
|
|
|
|
|
} |
1649
|
39212
|
100
|
|
|
|
else if (SvNOKp(sv)) { |
1650
|
37856
|
50
|
|
|
|
const NV nv = SvNV_nomg(sv); |
1651
|
37856
|
100
|
|
|
|
if (nv < 0.0) |
1652
|
|
|
|
|
|
count = 0; |
1653
|
|
|
|
|
|
else |
1654
|
37832
|
|
|
|
|
count = (IV)nv; |
1655
|
|
|
|
|
|
} |
1656
|
|
|
|
|
|
else |
1657
|
1356
|
50
|
|
|
|
count = SvIV_nomg(sv); |
1658
|
|
|
|
|
|
|
1659
|
682435
|
100
|
|
|
|
if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) { |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
1660
|
83987
|
|
|
|
|
dMARK; |
1661
|
|
|
|
|
|
static const char* const oom_list_extend = "Out of memory during list extend"; |
1662
|
83987
|
|
|
|
|
const I32 items = SP - MARK; |
1663
|
83987
|
|
|
|
|
const I32 max = items * count; |
1664
|
83987
|
|
|
|
|
const U8 mod = PL_op->op_flags & OPf_MOD; |
1665
|
|
|
|
|
|
|
1666
|
41814
|
|
|
|
|
MEM_WRAP_CHECK_1(max, SV*, oom_list_extend); |
1667
|
|
|
|
|
|
/* Did the max computation overflow? */ |
1668
|
83987
|
100
|
|
|
|
if (items > 0 && max > 0 && (max < items || max < count)) |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
1669
|
0
|
|
|
|
|
Perl_croak(aTHX_ "%s", oom_list_extend); |
1670
|
83987
|
100
|
|
|
|
MEXTEND(MARK, max); |
1671
|
83987
|
100
|
|
|
|
if (count > 1) { |
1672
|
106082
|
100
|
|
|
|
while (SP > MARK) { |
1673
|
|
|
|
|
|
#if 0 |
1674
|
|
|
|
|
|
/* This code was intended to fix 20010809.028: |
1675
|
|
|
|
|
|
|
1676
|
|
|
|
|
|
$x = 'abcd'; |
1677
|
|
|
|
|
|
for (($x =~ /./g) x 2) { |
1678
|
|
|
|
|
|
print chop; # "abcdabcd" expected as output. |
1679
|
|
|
|
|
|
} |
1680
|
|
|
|
|
|
|
1681
|
|
|
|
|
|
* but that change (#11635) broke this code: |
1682
|
|
|
|
|
|
|
1683
|
|
|
|
|
|
$x = [("foo")x2]; # only one "foo" ended up in the anonlist. |
1684
|
|
|
|
|
|
|
1685
|
|
|
|
|
|
* I can't think of a better fix that doesn't introduce |
1686
|
|
|
|
|
|
* an efficiency hit by copying the SVs. The stack isn't |
1687
|
|
|
|
|
|
* refcounted, and mortalisation obviously doesn't |
1688
|
|
|
|
|
|
* Do The Right Thing when the stack has more than |
1689
|
|
|
|
|
|
* one pointer to the same mortal value. |
1690
|
|
|
|
|
|
* .robin. |
1691
|
|
|
|
|
|
*/ |
1692
|
|
|
|
|
|
if (*SP) { |
1693
|
|
|
|
|
|
*SP = sv_2mortal(newSVsv(*SP)); |
1694
|
|
|
|
|
|
SvREADONLY_on(*SP); |
1695
|
|
|
|
|
|
} |
1696
|
|
|
|
|
|
#else |
1697
|
54769
|
50
|
|
|
|
if (*SP) |
1698
|
|
|
|
|
|
{ |
1699
|
54769
|
100
|
|
|
|
if (mod && SvPADTMP(*SP) && !IS_PADGV(*SP)) |
|
|
100
|
|
|
|
|
1700
|
2
|
|
|
|
|
*SP = sv_mortalcopy(*SP); |
1701
|
54769
|
|
|
|
|
SvTEMP_off((*SP)); |
1702
|
|
|
|
|
|
} |
1703
|
|
|
|
|
|
#endif |
1704
|
54769
|
|
|
|
|
SP--; |
1705
|
|
|
|
|
|
} |
1706
|
51313
|
|
|
|
|
MARK++; |
1707
|
51313
|
|
|
|
|
repeatcpy((char*)(MARK + items), (char*)MARK, |
1708
|
|
|
|
|
|
items * sizeof(const SV *), count - 1); |
1709
|
51313
|
|
|
|
|
SP += max; |
1710
|
|
|
|
|
|
} |
1711
|
32674
|
100
|
|
|
|
else if (count <= 0) |
1712
|
16328
|
|
|
|
|
SP -= items; |
1713
|
|
|
|
|
|
} |
1714
|
|
|
|
|
|
else { /* Note: mark already snarfed by pp_list */ |
1715
|
556634
|
|
|
|
|
SV * const tmpstr = POPs; |
1716
|
|
|
|
|
|
STRLEN len; |
1717
|
|
|
|
|
|
bool isutf; |
1718
|
|
|
|
|
|
static const char* const oom_string_extend = |
1719
|
|
|
|
|
|
"Out of memory during string extend"; |
1720
|
|
|
|
|
|
|
1721
|
556634
|
100
|
|
|
|
if (TARG != tmpstr) |
1722
|
556618
|
|
|
|
|
sv_setsv_nomg(TARG, tmpstr); |
1723
|
556634
|
100
|
|
|
|
SvPV_force_nomg(TARG, len); |
1724
|
556634
|
100
|
|
|
|
isutf = DO_UTF8(TARG); |
|
|
50
|
|
|
|
|
1725
|
556634
|
100
|
|
|
|
if (count != 1) { |
1726
|
506516
|
100
|
|
|
|
if (count < 1) |
1727
|
34570
|
|
|
|
|
SvCUR_set(TARG, 0); |
1728
|
|
|
|
|
|
else { |
1729
|
471946
|
|
|
|
|
const STRLEN max = (UV)count * len; |
1730
|
471946
|
50
|
|
|
|
if (len > MEM_SIZE_MAX / count) |
1731
|
0
|
|
|
|
|
Perl_croak(aTHX_ "%s", oom_string_extend); |
1732
|
|
|
|
|
|
MEM_WRAP_CHECK_1(max, char, oom_string_extend); |
1733
|
471946
|
50
|
|
|
|
SvGROW(TARG, max + 1); |
|
|
100
|
|
|
|
|
1734
|
471946
|
|
|
|
|
repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1); |
1735
|
471946
|
|
|
|
|
SvCUR_set(TARG, SvCUR(TARG) * count); |
1736
|
|
|
|
|
|
} |
1737
|
506516
|
|
|
|
|
*SvEND(TARG) = '\0'; |
1738
|
|
|
|
|
|
} |
1739
|
556634
|
100
|
|
|
|
if (isutf) |
1740
|
564
|
|
|
|
|
(void)SvPOK_only_UTF8(TARG); |
1741
|
|
|
|
|
|
else |
1742
|
556070
|
|
|
|
|
(void)SvPOK_only(TARG); |
1743
|
|
|
|
|
|
|
1744
|
556634
|
100
|
|
|
|
if (PL_op->op_private & OPpREPEAT_DOLIST) { |
1745
|
|
|
|
|
|
/* The parser saw this as a list repeat, and there |
1746
|
|
|
|
|
|
are probably several items on the stack. But we're |
1747
|
|
|
|
|
|
in scalar context, and there's no pp_list to save us |
1748
|
|
|
|
|
|
now. So drop the rest of the items -- robin@kitsite.com |
1749
|
|
|
|
|
|
*/ |
1750
|
16
|
|
|
|
|
dMARK; |
1751
|
|
|
|
|
|
SP = MARK; |
1752
|
|
|
|
|
|
} |
1753
|
556634
|
100
|
|
|
|
PUSHTARG; |
1754
|
|
|
|
|
|
} |
1755
|
640621
|
|
|
|
|
RETURN; |
1756
|
|
|
|
|
|
} |
1757
|
|
|
|
|
|
|
1758
|
43791878
|
|
|
|
|
PP(pp_subtract) |
1759
|
|
|
|
|
|
{ |
1760
|
43791878
|
100
|
|
|
|
dVAR; dSP; dATARGET; bool useleft; SV *svl, *svr; |
1761
|
43791878
|
100
|
|
|
|
tryAMAGICbin_MG(subtr_amg, AMGf_assign|AMGf_numeric); |
|
|
100
|
|
|
|
|
1762
|
43787022
|
|
|
|
|
svr = TOPs; |
1763
|
43787022
|
|
|
|
|
svl = TOPm1s; |
1764
|
43787022
|
100
|
|
|
|
useleft = USE_LEFT(svl); |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
1765
|
|
|
|
|
|
#ifdef PERL_PRESERVE_IVUV |
1766
|
|
|
|
|
|
/* See comments in pp_add (in pp_hot.c) about Overflow, and how |
1767
|
|
|
|
|
|
"bad things" happen if you rely on signed integers wrapping. */ |
1768
|
43787022
|
100
|
|
|
|
if (SvIV_please_nomg(svr)) { |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
1769
|
|
|
|
|
|
/* Unless the left argument is integer in range we are going to have to |
1770
|
|
|
|
|
|
use NV maths. Hence only attempt to coerce the right argument if |
1771
|
|
|
|
|
|
we know the left is integer. */ |
1772
|
|
|
|
|
|
UV auv = 0; |
1773
|
|
|
|
|
|
bool auvok = FALSE; |
1774
|
|
|
|
|
|
bool a_valid = 0; |
1775
|
|
|
|
|
|
|
1776
|
37137222
|
100
|
|
|
|
if (!useleft) { |
1777
|
|
|
|
|
|
auv = 0; |
1778
|
|
|
|
|
|
a_valid = auvok = 1; |
1779
|
|
|
|
|
|
/* left operand is undef, treat as zero. */ |
1780
|
|
|
|
|
|
} else { |
1781
|
|
|
|
|
|
/* Left operand is defined, so is it IV? */ |
1782
|
37137206
|
100
|
|
|
|
if (SvIV_please_nomg(svl)) { |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
1783
|
37134208
|
100
|
|
|
|
if ((auvok = SvUOK(svl))) |
1784
|
338
|
|
|
|
|
auv = SvUVX(svl); |
1785
|
|
|
|
|
|
else { |
1786
|
37133870
|
|
|
|
|
const IV aiv = SvIVX(svl); |
1787
|
37133870
|
100
|
|
|
|
if (aiv >= 0) { |
1788
|
37081716
|
|
|
|
|
auv = aiv; |
1789
|
|
|
|
|
|
auvok = 1; /* Now acting as a sign flag. */ |
1790
|
|
|
|
|
|
} else { /* 2s complement assumption for IV_MIN */ |
1791
|
52154
|
|
|
|
|
auv = (UV)-aiv; |
1792
|
|
|
|
|
|
} |
1793
|
|
|
|
|
|
} |
1794
|
|
|
|
|
|
a_valid = 1; |
1795
|
|
|
|
|
|
} |
1796
|
|
|
|
|
|
} |
1797
|
37137222
|
100
|
|
|
|
if (a_valid) { |
1798
|
|
|
|
|
|
bool result_good = 0; |
1799
|
|
|
|
|
|
UV result; |
1800
|
|
|
|
|
|
UV buv; |
1801
|
37134224
|
|
|
|
|
bool buvok = SvUOK(svr); |
1802
|
|
|
|
|
|
|
1803
|
37134224
|
50
|
|
|
|
if (buvok) |
1804
|
0
|
|
|
|
|
buv = SvUVX(svr); |
1805
|
|
|
|
|
|
else { |
1806
|
37134224
|
|
|
|
|
const IV biv = SvIVX(svr); |
1807
|
37134224
|
100
|
|
|
|
if (biv >= 0) { |
1808
|
37123980
|
|
|
|
|
buv = biv; |
1809
|
|
|
|
|
|
buvok = 1; |
1810
|
|
|
|
|
|
} else |
1811
|
10244
|
|
|
|
|
buv = (UV)-biv; |
1812
|
|
|
|
|
|
} |
1813
|
|
|
|
|
|
/* ?uvok if value is >= 0. basically, flagged as UV if it's +ve, |
1814
|
|
|
|
|
|
else "IV" now, independent of how it came in. |
1815
|
|
|
|
|
|
if a, b represents positive, A, B negative, a maps to -A etc |
1816
|
|
|
|
|
|
a - b => (a - b) |
1817
|
|
|
|
|
|
A - b => -(a + b) |
1818
|
|
|
|
|
|
a - B => (a + b) |
1819
|
|
|
|
|
|
A - B => -(a - b) |
1820
|
|
|
|
|
|
all UV maths. negate result if A negative. |
1821
|
|
|
|
|
|
subtract if signs same, add if signs differ. */ |
1822
|
|
|
|
|
|
|
1823
|
37134224
|
100
|
|
|
|
if (auvok ^ buvok) { |
1824
|
|
|
|
|
|
/* Signs differ. */ |
1825
|
46506
|
|
|
|
|
result = auv + buv; |
1826
|
46506
|
50
|
|
|
|
if (result >= auv) |
1827
|
|
|
|
|
|
result_good = 1; |
1828
|
|
|
|
|
|
} else { |
1829
|
|
|
|
|
|
/* Signs same */ |
1830
|
37087718
|
100
|
|
|
|
if (auv >= buv) { |
1831
|
36997092
|
|
|
|
|
result = auv - buv; |
1832
|
|
|
|
|
|
/* Must get smaller */ |
1833
|
36997092
|
50
|
|
|
|
if (result <= auv) |
1834
|
|
|
|
|
|
result_good = 1; |
1835
|
|
|
|
|
|
} else { |
1836
|
90626
|
|
|
|
|
result = buv - auv; |
1837
|
90626
|
50
|
|
|
|
if (result <= buv) { |
1838
|
|
|
|
|
|
/* result really should be -(auv-buv). as its negation |
1839
|
|
|
|
|
|
of true value, need to swap our result flag */ |
1840
|
90626
|
|
|
|
|
auvok = !auvok; |
1841
|
|
|
|
|
|
result_good = 1; |
1842
|
|
|
|
|
|
} |
1843
|
|
|
|
|
|
} |
1844
|
|
|
|
|
|
} |
1845
|
37134224
|
50
|
|
|
|
if (result_good) { |
1846
|
37134224
|
|
|
|
|
SP--; |
1847
|
37134224
|
100
|
|
|
|
if (auvok) |
1848
|
37006076
|
100
|
|
|
|
SETu( result ); |
1849
|
|
|
|
|
|
else { |
1850
|
|
|
|
|
|
/* Negate result */ |
1851
|
128148
|
100
|
|
|
|
if (result <= (UV)IV_MIN) |
1852
|
128136
|
100
|
|
|
|
SETi( -(IV)result ); |
1853
|
|
|
|
|
|
else { |
1854
|
|
|
|
|
|
/* result valid, but out of range for IV. */ |
1855
|
12
|
50
|
|
|
|
SETn( -(NV)result ); |
1856
|
|
|
|
|
|
} |
1857
|
|
|
|
|
|
} |
1858
|
37134224
|
|
|
|
|
RETURN; |
1859
|
|
|
|
|
|
} /* Overflow, drop through to NVs. */ |
1860
|
|
|
|
|
|
} |
1861
|
|
|
|
|
|
} |
1862
|
|
|
|
|
|
#endif |
1863
|
|
|
|
|
|
{ |
1864
|
6652798
|
100
|
|
|
|
NV value = SvNV_nomg(svr); |
1865
|
6652798
|
|
|
|
|
(void)POPs; |
1866
|
|
|
|
|
|
|
1867
|
6652798
|
50
|
|
|
|
if (!useleft) { |
1868
|
|
|
|
|
|
/* left operand is undef, treat as zero - value */ |
1869
|
0
|
0
|
|
|
|
SETn(-value); |
1870
|
0
|
|
|
|
|
RETURN; |
1871
|
|
|
|
|
|
} |
1872
|
6652798
|
100
|
|
|
|
SETn( SvNV_nomg(svl) - value ); |
|
|
50
|
|
|
|
|
1873
|
25222516
|
|
|
|
|
RETURN; |
1874
|
|
|
|
|
|
} |
1875
|
|
|
|
|
|
} |
1876
|
|
|
|
|
|
|
1877
|
114201
|
|
|
|
|
PP(pp_left_shift) |
1878
|
|
|
|
|
|
{ |
1879
|
114201
|
100
|
|
|
|
dVAR; dSP; dATARGET; SV *svl, *svr; |
1880
|
114201
|
100
|
|
|
|
tryAMAGICbin_MG(lshift_amg, AMGf_assign|AMGf_numeric); |
|
|
100
|
|
|
|
|
1881
|
114087
|
|
|
|
|
svr = POPs; |
1882
|
114087
|
|
|
|
|
svl = TOPs; |
1883
|
|
|
|
|
|
{ |
1884
|
114087
|
100
|
|
|
|
const IV shift = SvIV_nomg(svr); |
1885
|
114087
|
100
|
|
|
|
if (PL_op->op_private & HINT_INTEGER) { |
1886
|
782
|
50
|
|
|
|
const IV i = SvIV_nomg(svl); |
1887
|
782
|
50
|
|
|
|
SETi(i << shift); |
1888
|
|
|
|
|
|
} |
1889
|
|
|
|
|
|
else { |
1890
|
113305
|
100
|
|
|
|
const UV u = SvUV_nomg(svl); |
1891
|
113305
|
100
|
|
|
|
SETu(u << shift); |
1892
|
|
|
|
|
|
} |
1893
|
114142
|
|
|
|
|
RETURN; |
1894
|
|
|
|
|
|
} |
1895
|
|
|
|
|
|
} |
1896
|
|
|
|
|
|
|
1897
|
487410
|
|
|
|
|
PP(pp_right_shift) |
1898
|
|
|
|
|
|
{ |
1899
|
487410
|
100
|
|
|
|
dVAR; dSP; dATARGET; SV *svl, *svr; |
1900
|
487410
|
100
|
|
|
|
tryAMAGICbin_MG(rshift_amg, AMGf_assign|AMGf_numeric); |
|
|
100
|
|
|
|
|
1901
|
487288
|
|
|
|
|
svr = POPs; |
1902
|
487288
|
|
|
|
|
svl = TOPs; |
1903
|
|
|
|
|
|
{ |
1904
|
487288
|
50
|
|
|
|
const IV shift = SvIV_nomg(svr); |
1905
|
487288
|
100
|
|
|
|
if (PL_op->op_private & HINT_INTEGER) { |
1906
|
6
|
50
|
|
|
|
const IV i = SvIV_nomg(svl); |
1907
|
6
|
50
|
|
|
|
SETi(i >> shift); |
1908
|
|
|
|
|
|
} |
1909
|
|
|
|
|
|
else { |
1910
|
487282
|
100
|
|
|
|
const UV u = SvUV_nomg(svl); |
1911
|
487282
|
100
|
|
|
|
SETu(u >> shift); |
1912
|
|
|
|
|
|
} |
1913
|
487345
|
|
|
|
|
RETURN; |
1914
|
|
|
|
|
|
} |
1915
|
|
|
|
|
|
} |
1916
|
|
|
|
|
|
|
1917
|
59516739
|
|
|
|
|
PP(pp_lt) |
1918
|
|
|
|
|
|
{ |
1919
|
59516739
|
|
|
|
|
dVAR; dSP; |
1920
|
|
|
|
|
|
SV *left, *right; |
1921
|
|
|
|
|
|
|
1922
|
59516739
|
100
|
|
|
|
tryAMAGICbin_MG(lt_amg, AMGf_set|AMGf_numeric); |
|
|
100
|
|
|
|
|
1923
|
59516067
|
|
|
|
|
right = POPs; |
1924
|
59516067
|
|
|
|
|
left = TOPs; |
1925
|
59516067
|
100
|
|
|
|
SETs(boolSV( |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
1926
|
|
|
|
|
|
(SvIOK_notUV(left) && SvIOK_notUV(right)) |
1927
|
|
|
|
|
|
? (SvIVX(left) < SvIVX(right)) |
1928
|
|
|
|
|
|
: (do_ncmp(left, right) == -1) |
1929
|
|
|
|
|
|
)); |
1930
|
59516393
|
|
|
|
|
RETURN; |
1931
|
|
|
|
|
|
} |
1932
|
|
|
|
|
|
|
1933
|
41955958
|
|
|
|
|
PP(pp_gt) |
1934
|
|
|
|
|
|
{ |
1935
|
41955958
|
|
|
|
|
dVAR; dSP; |
1936
|
|
|
|
|
|
SV *left, *right; |
1937
|
|
|
|
|
|
|
1938
|
41955958
|
100
|
|
|
|
tryAMAGICbin_MG(gt_amg, AMGf_set|AMGf_numeric); |
|
|
100
|
|
|
|
|
1939
|
41952766
|
|
|
|
|
right = POPs; |
1940
|
41952766
|
|
|
|
|
left = TOPs; |
1941
|
41952766
|
100
|
|
|
|
SETs(boolSV( |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
1942
|
|
|
|
|
|
(SvIOK_notUV(left) && SvIOK_notUV(right)) |
1943
|
|
|
|
|
|
? (SvIVX(left) > SvIVX(right)) |
1944
|
|
|
|
|
|
: (do_ncmp(left, right) == 1) |
1945
|
|
|
|
|
|
)); |
1946
|
41954361
|
|
|
|
|
RETURN; |
1947
|
|
|
|
|
|
} |
1948
|
|
|
|
|
|
|
1949
|
12836538
|
|
|
|
|
PP(pp_le) |
1950
|
|
|
|
|
|
{ |
1951
|
12836538
|
|
|
|
|
dVAR; dSP; |
1952
|
|
|
|
|
|
SV *left, *right; |
1953
|
|
|
|
|
|
|
1954
|
12836538
|
100
|
|
|
|
tryAMAGICbin_MG(le_amg, AMGf_set|AMGf_numeric); |
|
|
100
|
|
|
|
|
1955
|
12836378
|
|
|
|
|
right = POPs; |
1956
|
12836378
|
|
|
|
|
left = TOPs; |
1957
|
12836378
|
100
|
|
|
|
SETs(boolSV( |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
1958
|
|
|
|
|
|
(SvIOK_notUV(left) && SvIOK_notUV(right)) |
1959
|
|
|
|
|
|
? (SvIVX(left) <= SvIVX(right)) |
1960
|
|
|
|
|
|
: (do_ncmp(left, right) <= 0) |
1961
|
|
|
|
|
|
)); |
1962
|
12836456
|
|
|
|
|
RETURN; |
1963
|
|
|
|
|
|
} |
1964
|
|
|
|
|
|
|
1965
|
15640982
|
|
|
|
|
PP(pp_ge) |
1966
|
|
|
|
|
|
{ |
1967
|
15640982
|
|
|
|
|
dVAR; dSP; |
1968
|
|
|
|
|
|
SV *left, *right; |
1969
|
|
|
|
|
|
|
1970
|
15640982
|
100
|
|
|
|
tryAMAGICbin_MG(ge_amg, AMGf_set|AMGf_numeric); |
|
|
100
|
|
|
|
|
1971
|
15640110
|
|
|
|
|
right = POPs; |
1972
|
15640110
|
|
|
|
|
left = TOPs; |
1973
|
15640110
|
100
|
|
|
|
SETs(boolSV( |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
1974
|
|
|
|
|
|
(SvIOK_notUV(left) && SvIOK_notUV(right)) |
1975
|
|
|
|
|
|
? (SvIVX(left) >= SvIVX(right)) |
1976
|
|
|
|
|
|
: ( (do_ncmp(left, right) & 2) == 0) |
1977
|
|
|
|
|
|
)); |
1978
|
15640546
|
|
|
|
|
RETURN; |
1979
|
|
|
|
|
|
} |
1980
|
|
|
|
|
|
|
1981
|
11032968
|
|
|
|
|
PP(pp_ne) |
1982
|
|
|
|
|
|
{ |
1983
|
11032968
|
|
|
|
|
dVAR; dSP; |
1984
|
|
|
|
|
|
SV *left, *right; |
1985
|
|
|
|
|
|
|
1986
|
11032968
|
100
|
|
|
|
tryAMAGICbin_MG(ne_amg, AMGf_set|AMGf_numeric); |
|
|
100
|
|
|
|
|
1987
|
10974036
|
|
|
|
|
right = POPs; |
1988
|
10974036
|
|
|
|
|
left = TOPs; |
1989
|
10974036
|
100
|
|
|
|
SETs(boolSV( |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
1990
|
|
|
|
|
|
(SvIOK_notUV(left) && SvIOK_notUV(right)) |
1991
|
|
|
|
|
|
? (SvIVX(left) != SvIVX(right)) |
1992
|
|
|
|
|
|
: (do_ncmp(left, right) != 0) |
1993
|
|
|
|
|
|
)); |
1994
|
11003502
|
|
|
|
|
RETURN; |
1995
|
|
|
|
|
|
} |
1996
|
|
|
|
|
|
|
1997
|
|
|
|
|
|
/* compare left and right SVs. Returns: |
1998
|
|
|
|
|
|
* -1: < |
1999
|
|
|
|
|
|
* 0: == |
2000
|
|
|
|
|
|
* 1: > |
2001
|
|
|
|
|
|
* 2: left or right was a NaN |
2002
|
|
|
|
|
|
*/ |
2003
|
|
|
|
|
|
I32 |
2004
|
26778684
|
|
|
|
|
Perl_do_ncmp(pTHX_ SV* const left, SV * const right) |
2005
|
|
|
|
|
|
{ |
2006
|
|
|
|
|
|
dVAR; |
2007
|
|
|
|
|
|
|
2008
|
|
|
|
|
|
PERL_ARGS_ASSERT_DO_NCMP; |
2009
|
|
|
|
|
|
#ifdef PERL_PRESERVE_IVUV |
2010
|
|
|
|
|
|
/* Fortunately it seems NaN isn't IOK */ |
2011
|
26778684
|
100
|
|
|
|
if (SvIV_please_nomg(right) && SvIV_please_nomg(left)) { |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
2012
|
9313418
|
100
|
|
|
|
if (!SvUOK(left)) { |
2013
|
9312134
|
|
|
|
|
const IV leftiv = SvIVX(left); |
2014
|
9312134
|
100
|
|
|
|
if (!SvUOK(right)) { |
2015
|
|
|
|
|
|
/* ## IV <=> IV ## */ |
2016
|
9307392
|
|
|
|
|
const IV rightiv = SvIVX(right); |
2017
|
9307392
|
|
|
|
|
return (leftiv > rightiv) - (leftiv < rightiv); |
2018
|
|
|
|
|
|
} |
2019
|
|
|
|
|
|
/* ## IV <=> UV ## */ |
2020
|
4742
|
100
|
|
|
|
if (leftiv < 0) |
2021
|
|
|
|
|
|
/* As (b) is a UV, it's >=0, so it must be < */ |
2022
|
|
|
|
|
|
return -1; |
2023
|
|
|
|
|
|
{ |
2024
|
4680
|
|
|
|
|
const UV rightuv = SvUVX(right); |
2025
|
4680
|
|
|
|
|
return ((UV)leftiv > rightuv) - ((UV)leftiv < rightuv); |
2026
|
|
|
|
|
|
} |
2027
|
|
|
|
|
|
} |
2028
|
|
|
|
|
|
|
2029
|
1284
|
100
|
|
|
|
if (SvUOK(right)) { |
2030
|
|
|
|
|
|
/* ## UV <=> UV ## */ |
2031
|
500
|
|
|
|
|
const UV leftuv = SvUVX(left); |
2032
|
500
|
|
|
|
|
const UV rightuv = SvUVX(right); |
2033
|
500
|
|
|
|
|
return (leftuv > rightuv) - (leftuv < rightuv); |
2034
|
|
|
|
|
|
} |
2035
|
|
|
|
|
|
/* ## UV <=> IV ## */ |
2036
|
|
|
|
|
|
{ |
2037
|
784
|
|
|
|
|
const IV rightiv = SvIVX(right); |
2038
|
784
|
100
|
|
|
|
if (rightiv < 0) |
2039
|
|
|
|
|
|
/* As (a) is a UV, it's >=0, so it cannot be < */ |
2040
|
|
|
|
|
|
return 1; |
2041
|
|
|
|
|
|
{ |
2042
|
652
|
|
|
|
|
const UV leftuv = SvUVX(left); |
2043
|
652
|
|
|
|
|
return (leftuv > (UV)rightiv) - (leftuv < (UV)rightiv); |
2044
|
|
|
|
|
|
} |
2045
|
|
|
|
|
|
} |
2046
|
|
|
|
|
|
assert(0); /* NOTREACHED */ |
2047
|
|
|
|
|
|
} |
2048
|
|
|
|
|
|
#endif |
2049
|
|
|
|
|
|
{ |
2050
|
17465266
|
100
|
|
|
|
NV const rnv = SvNV_nomg(right); |
2051
|
17465266
|
100
|
|
|
|
NV const lnv = SvNV_nomg(left); |
2052
|
|
|
|
|
|
|
2053
|
|
|
|
|
|
#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) |
2054
|
|
|
|
|
|
if (Perl_isnan(lnv) || Perl_isnan(rnv)) { |
2055
|
|
|
|
|
|
return 2; |
2056
|
|
|
|
|
|
} |
2057
|
|
|
|
|
|
return (lnv > rnv) - (lnv < rnv); |
2058
|
|
|
|
|
|
#else |
2059
|
17465264
|
100
|
|
|
|
if (lnv < rnv) |
2060
|
|
|
|
|
|
return -1; |
2061
|
10205180
|
100
|
|
|
|
if (lnv > rnv) |
2062
|
|
|
|
|
|
return 1; |
2063
|
485174
|
100
|
|
|
|
if (lnv == rnv) |
2064
|
|
|
|
|
|
return 0; |
2065
|
13440256
|
|
|
|
|
return 2; |
2066
|
|
|
|
|
|
#endif |
2067
|
|
|
|
|
|
} |
2068
|
|
|
|
|
|
} |
2069
|
|
|
|
|
|
|
2070
|
|
|
|
|
|
|
2071
|
6906586
|
|
|
|
|
PP(pp_ncmp) |
2072
|
|
|
|
|
|
{ |
2073
|
6906586
|
|
|
|
|
dVAR; dSP; |
2074
|
|
|
|
|
|
SV *left, *right; |
2075
|
|
|
|
|
|
I32 value; |
2076
|
6906586
|
100
|
|
|
|
tryAMAGICbin_MG(ncmp_amg, AMGf_numeric); |
|
|
100
|
|
|
|
|
2077
|
6906564
|
|
|
|
|
right = POPs; |
2078
|
6906564
|
|
|
|
|
left = TOPs; |
2079
|
6906564
|
|
|
|
|
value = do_ncmp(left, right); |
2080
|
6906564
|
100
|
|
|
|
if (value == 2) { |
2081
|
168
|
|
|
|
|
SETs(&PL_sv_undef); |
2082
|
|
|
|
|
|
} |
2083
|
|
|
|
|
|
else { |
2084
|
6906396
|
|
|
|
|
dTARGET; |
2085
|
6906396
|
50
|
|
|
|
SETi(value); |
2086
|
|
|
|
|
|
} |
2087
|
6906575
|
|
|
|
|
RETURN; |
2088
|
|
|
|
|
|
} |
2089
|
|
|
|
|
|
|
2090
|
976502
|
|
|
|
|
PP(pp_sle) |
2091
|
|
|
|
|
|
{ |
2092
|
976502
|
|
|
|
|
dVAR; dSP; |
2093
|
|
|
|
|
|
|
2094
|
|
|
|
|
|
int amg_type = sle_amg; |
2095
|
|
|
|
|
|
int multiplier = 1; |
2096
|
|
|
|
|
|
int rhs = 1; |
2097
|
|
|
|
|
|
|
2098
|
976502
|
50
|
|
|
|
switch (PL_op->op_type) { |
2099
|
|
|
|
|
|
case OP_SLT: |
2100
|
|
|
|
|
|
amg_type = slt_amg; |
2101
|
|
|
|
|
|
/* cmp < 0 */ |
2102
|
|
|
|
|
|
rhs = 0; |
2103
|
|
|
|
|
|
break; |
2104
|
|
|
|
|
|
case OP_SGT: |
2105
|
|
|
|
|
|
amg_type = sgt_amg; |
2106
|
|
|
|
|
|
/* cmp > 0 */ |
2107
|
|
|
|
|
|
multiplier = -1; |
2108
|
|
|
|
|
|
rhs = 0; |
2109
|
|
|
|
|
|
break; |
2110
|
|
|
|
|
|
case OP_SGE: |
2111
|
|
|
|
|
|
amg_type = sge_amg; |
2112
|
|
|
|
|
|
/* cmp >= 0 */ |
2113
|
|
|
|
|
|
multiplier = -1; |
2114
|
|
|
|
|
|
break; |
2115
|
|
|
|
|
|
} |
2116
|
|
|
|
|
|
|
2117
|
976502
|
100
|
|
|
|
tryAMAGICbin_MG(amg_type, AMGf_set); |
|
|
100
|
|
|
|
|
2118
|
|
|
|
|
|
{ |
2119
|
900422
|
|
|
|
|
dPOPTOPssrl; |
2120
|
900422
|
|
|
|
|
const int cmp = (IN_LOCALE_RUNTIME |
2121
|
|
|
|
|
|
? sv_cmp_locale_flags(left, right, 0) |
2122
|
900422
|
50
|
|
|
|
: sv_cmp_flags(left, right, 0)); |
2123
|
900422
|
100
|
|
|
|
SETs(boolSV(cmp * multiplier < rhs)); |
2124
|
938462
|
|
|
|
|
RETURN; |
2125
|
|
|
|
|
|
} |
2126
|
|
|
|
|
|
} |
2127
|
|
|
|
|
|
|
2128
|
397053330
|
|
|
|
|
PP(pp_seq) |
2129
|
|
|
|
|
|
{ |
2130
|
397053330
|
|
|
|
|
dVAR; dSP; |
2131
|
397053330
|
100
|
|
|
|
tryAMAGICbin_MG(seq_amg, AMGf_set); |
|
|
100
|
|
|
|
|
2132
|
|
|
|
|
|
{ |
2133
|
397015756
|
|
|
|
|
dPOPTOPssrl; |
2134
|
397015756
|
100
|
|
|
|
SETs(boolSV(sv_eq_flags(left, right, 0))); |
2135
|
397034721
|
|
|
|
|
RETURN; |
2136
|
|
|
|
|
|
} |
2137
|
|
|
|
|
|
} |
2138
|
|
|
|
|
|
|
2139
|
11417492
|
|
|
|
|
PP(pp_sne) |
2140
|
|
|
|
|
|
{ |
2141
|
11417492
|
|
|
|
|
dVAR; dSP; |
2142
|
11417492
|
100
|
|
|
|
tryAMAGICbin_MG(sne_amg, AMGf_set); |
|
|
100
|
|
|
|
|
2143
|
|
|
|
|
|
{ |
2144
|
11417468
|
|
|
|
|
dPOPTOPssrl; |
2145
|
11417468
|
100
|
|
|
|
SETs(boolSV(!sv_eq_flags(left, right, 0))); |
2146
|
11417480
|
|
|
|
|
RETURN; |
2147
|
|
|
|
|
|
} |
2148
|
|
|
|
|
|
} |
2149
|
|
|
|
|
|
|
2150
|
5293562
|
|
|
|
|
PP(pp_scmp) |
2151
|
|
|
|
|
|
{ |
2152
|
5293562
|
|
|
|
|
dVAR; dSP; dTARGET; |
2153
|
5293562
|
100
|
|
|
|
tryAMAGICbin_MG(scmp_amg, 0); |
|
|
100
|
|
|
|
|
2154
|
|
|
|
|
|
{ |
2155
|
5293366
|
|
|
|
|
dPOPTOPssrl; |
2156
|
5293366
|
|
|
|
|
const int cmp = (IN_LOCALE_RUNTIME |
2157
|
|
|
|
|
|
? sv_cmp_locale_flags(left, right, 0) |
2158
|
5293366
|
50
|
|
|
|
: sv_cmp_flags(left, right, 0)); |
2159
|
5293366
|
50
|
|
|
|
SETi( cmp ); |
2160
|
5293464
|
|
|
|
|
RETURN; |
2161
|
|
|
|
|
|
} |
2162
|
|
|
|
|
|
} |
2163
|
|
|
|
|
|
|
2164
|
51114500
|
|
|
|
|
PP(pp_bit_and) |
2165
|
|
|
|
|
|
{ |
2166
|
51114500
|
100
|
|
|
|
dVAR; dSP; dATARGET; |
2167
|
51114500
|
100
|
|
|
|
tryAMAGICbin_MG(band_amg, AMGf_assign); |
|
|
100
|
|
|
|
|
2168
|
|
|
|
|
|
{ |
2169
|
51114138
|
|
|
|
|
dPOPTOPssrl; |
2170
|
51114138
|
100
|
|
|
|
if (SvNIOKp(left) || SvNIOKp(right)) { |
|
|
100
|
|
|
|
|
2171
|
50782202
|
|
|
|
|
const bool left_ro_nonnum = !SvNIOKp(left) && SvREADONLY(left); |
2172
|
50782202
|
|
|
|
|
const bool right_ro_nonnum = !SvNIOKp(right) && SvREADONLY(right); |
2173
|
50782202
|
100
|
|
|
|
if (PL_op->op_private & HINT_INTEGER) { |
2174
|
3544
|
100
|
|
|
|
const IV i = SvIV_nomg(left) & SvIV_nomg(right); |
|
|
100
|
|
|
|
|
2175
|
3544
|
100
|
|
|
|
SETi(i); |
2176
|
|
|
|
|
|
} |
2177
|
|
|
|
|
|
else { |
2178
|
50778658
|
100
|
|
|
|
const UV u = SvUV_nomg(left) & SvUV_nomg(right); |
|
|
100
|
|
|
|
|
2179
|
50778656
|
100
|
|
|
|
SETu(u); |
2180
|
|
|
|
|
|
} |
2181
|
50782200
|
50
|
|
|
|
if (left_ro_nonnum && left != TARG) SvNIOK_off(left); |
|
|
0
|
|
|
|
|
2182
|
50782200
|
100
|
|
|
|
if (right_ro_nonnum) SvNIOK_off(right); |
2183
|
|
|
|
|
|
} |
2184
|
|
|
|
|
|
else { |
2185
|
331936
|
|
|
|
|
do_vop(PL_op->op_type, TARG, left, right); |
2186
|
331936
|
100
|
|
|
|
SETTARG; |
2187
|
|
|
|
|
|
} |
2188
|
51114315
|
|
|
|
|
RETURN; |
2189
|
|
|
|
|
|
} |
2190
|
|
|
|
|
|
} |
2191
|
|
|
|
|
|
|
2192
|
5467640
|
|
|
|
|
PP(pp_bit_or) |
2193
|
|
|
|
|
|
{ |
2194
|
5467640
|
100
|
|
|
|
dVAR; dSP; dATARGET; |
2195
|
5467640
|
|
|
|
|
const int op_type = PL_op->op_type; |
2196
|
|
|
|
|
|
|
2197
|
5467640
|
100
|
|
|
|
tryAMAGICbin_MG((op_type == OP_BIT_OR ? bor_amg : bxor_amg), AMGf_assign); |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
2198
|
|
|
|
|
|
{ |
2199
|
5466814
|
|
|
|
|
dPOPTOPssrl; |
2200
|
5466814
|
100
|
|
|
|
if (SvNIOKp(left) || SvNIOKp(right)) { |
|
|
100
|
|
|
|
|
2201
|
4787666
|
|
|
|
|
const bool left_ro_nonnum = !SvNIOKp(left) && SvREADONLY(left); |
2202
|
4787666
|
|
|
|
|
const bool right_ro_nonnum = !SvNIOKp(right) && SvREADONLY(right); |
2203
|
4787666
|
100
|
|
|
|
if (PL_op->op_private & HINT_INTEGER) { |
2204
|
5638
|
100
|
|
|
|
const IV l = (USE_LEFT(left) ? SvIV_nomg(left) : 0); |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
2205
|
5638
|
100
|
|
|
|
const IV r = SvIV_nomg(right); |
2206
|
5638
|
100
|
|
|
|
const IV result = op_type == OP_BIT_OR ? (l | r) : (l ^ r); |
2207
|
5638
|
100
|
|
|
|
SETi(result); |
2208
|
|
|
|
|
|
} |
2209
|
|
|
|
|
|
else { |
2210
|
4782028
|
100
|
|
|
|
const UV l = (USE_LEFT(left) ? SvUV_nomg(left) : 0); |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
2211
|
4782028
|
100
|
|
|
|
const UV r = SvUV_nomg(right); |
2212
|
4782028
|
100
|
|
|
|
const UV result = op_type == OP_BIT_OR ? (l | r) : (l ^ r); |
2213
|
4782028
|
100
|
|
|
|
SETu(result); |
2214
|
|
|
|
|
|
} |
2215
|
4787664
|
50
|
|
|
|
if (left_ro_nonnum && left != TARG) SvNIOK_off(left); |
|
|
0
|
|
|
|
|
2216
|
4787664
|
100
|
|
|
|
if (right_ro_nonnum) SvNIOK_off(right); |
2217
|
|
|
|
|
|
} |
2218
|
|
|
|
|
|
else { |
2219
|
679148
|
|
|
|
|
do_vop(op_type, TARG, left, right); |
2220
|
679148
|
100
|
|
|
|
SETTARG; |
2221
|
|
|
|
|
|
} |
2222
|
5467219
|
|
|
|
|
RETURN; |
2223
|
|
|
|
|
|
} |
2224
|
|
|
|
|
|
} |
2225
|
|
|
|
|
|
|
2226
|
|
|
|
|
|
PERL_STATIC_INLINE bool |
2227
|
4474648
|
|
|
|
|
S_negate_string(pTHX) |
2228
|
|
|
|
|
|
{ |
2229
|
4474648
|
|
|
|
|
dTARGET; dSP; |
2230
|
|
|
|
|
|
STRLEN len; |
2231
|
|
|
|
|
|
const char *s; |
2232
|
4474648
|
|
|
|
|
SV * const sv = TOPs; |
2233
|
4474648
|
100
|
|
|
|
if (!SvPOKp(sv) || SvNIOK(sv) || (!SvPOK(sv) && SvNIOKp(sv))) |
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
2234
|
|
|
|
|
|
return FALSE; |
2235
|
73970
|
100
|
|
|
|
s = SvPV_nomg_const(sv, len); |
2236
|
73970
|
100
|
|
|
|
if (isIDFIRST(*s)) { |
2237
|
73888
|
|
|
|
|
sv_setpvs(TARG, "-"); |
2238
|
73888
|
|
|
|
|
sv_catsv(TARG, sv); |
2239
|
|
|
|
|
|
} |
2240
|
82
|
100
|
|
|
|
else if (*s == '+' || (*s == '-' && !looks_like_number(sv))) { |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
2241
|
16
|
|
|
|
|
sv_setsv_nomg(TARG, sv); |
2242
|
16
|
50
|
|
|
|
*SvPV_force_nomg(TARG, len) = *s == '-' ? '+' : '-'; |
|
|
100
|
|
|
|
|
2243
|
|
|
|
|
|
} |
2244
|
|
|
|
|
|
else return FALSE; |
2245
|
73904
|
50
|
|
|
|
SETTARG; PUTBACK; |
2246
|
2296415
|
|
|
|
|
return TRUE; |
2247
|
|
|
|
|
|
} |
2248
|
|
|
|
|
|
|
2249
|
4407378
|
|
|
|
|
PP(pp_negate) |
2250
|
|
|
|
|
|
{ |
2251
|
4407378
|
|
|
|
|
dVAR; dSP; dTARGET; |
2252
|
4407378
|
100
|
|
|
|
tryAMAGICun_MG(neg_amg, AMGf_numeric); |
|
|
100
|
|
|
|
|
2253
|
4406986
|
100
|
|
|
|
if (S_negate_string(aTHX)) return NORMAL; |
2254
|
|
|
|
|
|
{ |
2255
|
4333098
|
|
|
|
|
SV * const sv = TOPs; |
2256
|
|
|
|
|
|
|
2257
|
4333098
|
100
|
|
|
|
if (SvIOK(sv)) { |
2258
|
|
|
|
|
|
/* It's publicly an integer */ |
2259
|
|
|
|
|
|
oops_its_an_int: |
2260
|
4326244
|
100
|
|
|
|
if (SvIsUV(sv)) { |
2261
|
84
|
100
|
|
|
|
if (SvIVX(sv) == IV_MIN) { |
2262
|
|
|
|
|
|
/* 2s complement assumption. */ |
2263
|
62
|
50
|
|
|
|
SETi(SvIVX(sv)); /* special case: -((UV)IV_MAX+1) == |
2264
|
|
|
|
|
|
IV_MIN */ |
2265
|
62
|
|
|
|
|
RETURN; |
2266
|
|
|
|
|
|
} |
2267
|
22
|
50
|
|
|
|
else if (SvUVX(sv) <= IV_MAX) { |
2268
|
0
|
0
|
|
|
|
SETi(-SvIVX(sv)); |
2269
|
0
|
|
|
|
|
RETURN; |
2270
|
|
|
|
|
|
} |
2271
|
|
|
|
|
|
} |
2272
|
4326160
|
50
|
|
|
|
else if (SvIVX(sv) != IV_MIN) { |
2273
|
4326160
|
50
|
|
|
|
SETi(-SvIVX(sv)); |
2274
|
4326160
|
|
|
|
|
RETURN; |
2275
|
|
|
|
|
|
} |
2276
|
|
|
|
|
|
#ifdef PERL_PRESERVE_IVUV |
2277
|
|
|
|
|
|
else { |
2278
|
0
|
0
|
|
|
|
SETu((UV)IV_MIN); |
2279
|
0
|
|
|
|
|
RETURN; |
2280
|
|
|
|
|
|
} |
2281
|
|
|
|
|
|
#endif |
2282
|
|
|
|
|
|
} |
2283
|
6894
|
100
|
|
|
|
if (SvNIOKp(sv) && (SvNIOK(sv) || !SvPOK(sv))) |
|
|
50
|
|
|
|
|
2284
|
6824
|
100
|
|
|
|
SETn(-SvNV_nomg(sv)); |
|
|
50
|
|
|
|
|
2285
|
70
|
100
|
|
|
|
else if (SvPOKp(sv) && SvIV_please_nomg(sv)) |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
0
|
|
|
|
|
2286
|
|
|
|
|
|
goto oops_its_an_int; |
2287
|
|
|
|
|
|
else |
2288
|
52
|
100
|
|
|
|
SETn(-SvNV_nomg(sv)); |
|
|
50
|
|
|
|
|
2289
|
|
|
|
|
|
} |
2290
|
2212706
|
|
|
|
|
RETURN; |
2291
|
|
|
|
|
|
} |
2292
|
|
|
|
|
|
|
2293
|
70470816
|
|
|
|
|
PP(pp_not) |
2294
|
|
|
|
|
|
{ |
2295
|
70470816
|
|
|
|
|
dVAR; dSP; |
2296
|
70470816
|
100
|
|
|
|
tryAMAGICun_MG(not_amg, AMGf_set); |
|
|
100
|
|
|
|
|
2297
|
70470774
|
50
|
|
|
|
*PL_stack_sp = boolSV(!SvTRUE_nomg(*PL_stack_sp)); |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
2298
|
70470795
|
|
|
|
|
return NORMAL; |
2299
|
|
|
|
|
|
} |
2300
|
|
|
|
|
|
|
2301
|
1194166
|
|
|
|
|
PP(pp_complement) |
2302
|
|
|
|
|
|
{ |
2303
|
1194166
|
|
|
|
|
dVAR; dSP; dTARGET; |
2304
|
1194166
|
100
|
|
|
|
tryAMAGICun_MG(compl_amg, AMGf_numeric); |
|
|
100
|
|
|
|
|
2305
|
|
|
|
|
|
{ |
2306
|
1189610
|
|
|
|
|
dTOPss; |
2307
|
1189610
|
100
|
|
|
|
if (SvNIOKp(sv)) { |
2308
|
973740
|
100
|
|
|
|
if (PL_op->op_private & HINT_INTEGER) { |
2309
|
14
|
50
|
|
|
|
const IV i = ~SvIV_nomg(sv); |
2310
|
14
|
50
|
|
|
|
SETi(i); |
2311
|
|
|
|
|
|
} |
2312
|
|
|
|
|
|
else { |
2313
|
973726
|
100
|
|
|
|
const UV u = ~SvUV_nomg(sv); |
2314
|
973726
|
50
|
|
|
|
SETu(u); |
2315
|
|
|
|
|
|
} |
2316
|
|
|
|
|
|
} |
2317
|
|
|
|
|
|
else { |
2318
|
|
|
|
|
|
U8 *tmps; |
2319
|
|
|
|
|
|
I32 anum; |
2320
|
|
|
|
|
|
STRLEN len; |
2321
|
|
|
|
|
|
|
2322
|
215870
|
|
|
|
|
sv_copypv_nomg(TARG, sv); |
2323
|
215870
|
50
|
|
|
|
tmps = (U8*)SvPV_nomg(TARG, len); |
2324
|
215870
|
|
|
|
|
anum = len; |
2325
|
215870
|
100
|
|
|
|
if (SvUTF8(TARG)) { |
2326
|
|
|
|
|
|
/* Calculate exact length, let's not estimate. */ |
2327
|
|
|
|
|
|
STRLEN targlen = 0; |
2328
|
|
|
|
|
|
STRLEN l; |
2329
|
|
|
|
|
|
UV nchar = 0; |
2330
|
|
|
|
|
|
UV nwide = 0; |
2331
|
50408
|
|
|
|
|
U8 * const send = tmps + len; |
2332
|
|
|
|
|
|
U8 * const origtmps = tmps; |
2333
|
|
|
|
|
|
const UV utf8flags = UTF8_ALLOW_ANYUV; |
2334
|
|
|
|
|
|
|
2335
|
148008
|
100
|
|
|
|
while (tmps < send) { |
2336
|
72396
|
|
|
|
|
const UV c = utf8n_to_uvchr(tmps, send-tmps, &l, utf8flags); |
2337
|
72396
|
|
|
|
|
tmps += l; |
2338
|
72396
|
100
|
|
|
|
targlen += UNISKIP(~c); |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
2339
|
72396
|
|
|
|
|
nchar++; |
2340
|
72396
|
100
|
|
|
|
if (c > 0xff) |
2341
|
67522
|
|
|
|
|
nwide++; |
2342
|
|
|
|
|
|
} |
2343
|
|
|
|
|
|
|
2344
|
|
|
|
|
|
/* Now rewind strings and write them. */ |
2345
|
|
|
|
|
|
tmps = origtmps; |
2346
|
|
|
|
|
|
|
2347
|
50408
|
100
|
|
|
|
if (nwide) { |
2348
|
|
|
|
|
|
U8 *result; |
2349
|
|
|
|
|
|
U8 *p; |
2350
|
|
|
|
|
|
|
2351
|
50402
|
|
|
|
|
Newx(result, targlen + 1, U8); |
2352
|
|
|
|
|
|
p = result; |
2353
|
147989
|
100
|
|
|
|
while (tmps < send) { |
2354
|
72386
|
|
|
|
|
const UV c = utf8n_to_uvchr(tmps, send-tmps, &l, utf8flags); |
2355
|
72386
|
|
|
|
|
tmps += l; |
2356
|
72386
|
|
|
|
|
p = uvchr_to_utf8_flags(p, ~c, UNICODE_ALLOW_ANY); |
2357
|
|
|
|
|
|
} |
2358
|
50402
|
|
|
|
|
*p = '\0'; |
2359
|
50402
|
|
|
|
|
sv_usepvn_flags(TARG, (char*)result, targlen, |
2360
|
|
|
|
|
|
SV_HAS_TRAILING_NUL); |
2361
|
50402
|
|
|
|
|
SvUTF8_on(TARG); |
2362
|
|
|
|
|
|
} |
2363
|
|
|
|
|
|
else { |
2364
|
|
|
|
|
|
U8 *result; |
2365
|
|
|
|
|
|
U8 *p; |
2366
|
|
|
|
|
|
|
2367
|
6
|
|
|
|
|
Newx(result, nchar + 1, U8); |
2368
|
|
|
|
|
|
p = result; |
2369
|
19
|
100
|
|
|
|
while (tmps < send) { |
2370
|
10
|
|
|
|
|
const U8 c = (U8)utf8n_to_uvchr(tmps, send-tmps, &l, utf8flags); |
2371
|
10
|
|
|
|
|
tmps += l; |
2372
|
10
|
|
|
|
|
*p++ = ~c; |
2373
|
|
|
|
|
|
} |
2374
|
6
|
|
|
|
|
*p = '\0'; |
2375
|
6
|
|
|
|
|
sv_usepvn_flags(TARG, (char*)result, nchar, SV_HAS_TRAILING_NUL); |
2376
|
6
|
|
|
|
|
SvUTF8_off(TARG); |
2377
|
|
|
|
|
|
} |
2378
|
50408
|
50
|
|
|
|
SETTARG; |
2379
|
50408
|
|
|
|
|
RETURN; |
2380
|
|
|
|
|
|
} |
2381
|
|
|
|
|
|
#ifdef LIBERAL |
2382
|
|
|
|
|
|
{ |
2383
|
|
|
|
|
|
long *tmpl; |
2384
|
84711
|
100
|
|
|
|
for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++) |
|
|
50
|
|
|
|
|
2385
|
0
|
|
|
|
|
*tmps = ~*tmps; |
2386
|
|
|
|
|
|
tmpl = (long*)tmps; |
2387
|
261919
|
100
|
|
|
|
for ( ; anum >= (I32)sizeof(long); anum -= (I32)sizeof(long), tmpl++) |
2388
|
177208
|
|
|
|
|
*tmpl = ~*tmpl; |
2389
|
|
|
|
|
|
tmps = (U8*)tmpl; |
2390
|
|
|
|
|
|
} |
2391
|
|
|
|
|
|
#endif |
2392
|
1093119
|
100
|
|
|
|
for ( ; anum > 0; anum--, tmps++) |
2393
|
1008408
|
|
|
|
|
*tmps = ~*tmps; |
2394
|
165462
|
50
|
|
|
|
SETTARG; |
2395
|
|
|
|
|
|
} |
2396
|
1166683
|
|
|
|
|
RETURN; |
2397
|
|
|
|
|
|
} |
2398
|
|
|
|
|
|
} |
2399
|
|
|
|
|
|
|
2400
|
|
|
|
|
|
/* integer versions of some of the above */ |
2401
|
|
|
|
|
|
|
2402
|
11359894
|
|
|
|
|
PP(pp_i_multiply) |
2403
|
|
|
|
|
|
{ |
2404
|
11359894
|
100
|
|
|
|
dVAR; dSP; dATARGET; |
2405
|
11359894
|
100
|
|
|
|
tryAMAGICbin_MG(mult_amg, AMGf_assign); |
|
|
50
|
|
|
|
|
2406
|
|
|
|
|
|
{ |
2407
|
11359894
|
100
|
|
|
|
dPOPTOPiirl_nomg; |
|
|
100
|
|
|
|
|
2408
|
11359894
|
100
|
|
|
|
SETi( left * right ); |
2409
|
11359894
|
|
|
|
|
RETURN; |
2410
|
|
|
|
|
|
} |
2411
|
|
|
|
|
|
} |
2412
|
|
|
|
|
|
|
2413
|
6070240
|
|
|
|
|
PP(pp_i_divide) |
2414
|
|
|
|
|
|
{ |
2415
|
|
|
|
|
|
IV num; |
2416
|
6070240
|
100
|
|
|
|
dVAR; dSP; dATARGET; |
2417
|
6070240
|
100
|
|
|
|
tryAMAGICbin_MG(div_amg, AMGf_assign); |
|
|
50
|
|
|
|
|
2418
|
|
|
|
|
|
{ |
2419
|
6070240
|
|
|
|
|
dPOPTOPssrl; |
2420
|
6070240
|
100
|
|
|
|
IV value = SvIV_nomg(right); |
2421
|
6070240
|
100
|
|
|
|
if (value == 0) |
2422
|
2
|
|
|
|
|
DIE(aTHX_ "Illegal division by zero"); |
2423
|
6070238
|
100
|
|
|
|
num = SvIV_nomg(left); |
2424
|
|
|
|
|
|
|
2425
|
|
|
|
|
|
/* avoid FPE_INTOVF on some platforms when num is IV_MIN */ |
2426
|
6070238
|
100
|
|
|
|
if (value == -1) |
2427
|
2
|
|
|
|
|
value = - num; |
2428
|
|
|
|
|
|
else |
2429
|
6070236
|
|
|
|
|
value = num / value; |
2430
|
6070238
|
100
|
|
|
|
SETi(value); |
2431
|
6070238
|
|
|
|
|
RETURN; |
2432
|
|
|
|
|
|
} |
2433
|
|
|
|
|
|
} |
2434
|
|
|
|
|
|
|
2435
|
|
|
|
|
|
#if defined(__GLIBC__) && IVSIZE == 8 && !defined(PERL_DEBUG_READONLY_OPS) |
2436
|
|
|
|
|
|
STATIC |
2437
|
43728
|
|
|
|
|
PP(pp_i_modulo_0) |
2438
|
|
|
|
|
|
#else |
2439
|
|
|
|
|
|
PP(pp_i_modulo) |
2440
|
|
|
|
|
|
#endif |
2441
|
|
|
|
|
|
{ |
2442
|
|
|
|
|
|
/* This is the vanilla old i_modulo. */ |
2443
|
43728
|
50
|
|
|
|
dVAR; dSP; dATARGET; |
2444
|
43728
|
100
|
|
|
|
tryAMAGICbin_MG(modulo_amg, AMGf_assign); |
|
|
50
|
|
|
|
|
2445
|
|
|
|
|
|
{ |
2446
|
43728
|
100
|
|
|
|
dPOPTOPiirl_nomg; |
|
|
100
|
|
|
|
|
2447
|
43728
|
50
|
|
|
|
if (!right) |
2448
|
0
|
|
|
|
|
DIE(aTHX_ "Illegal modulus zero"); |
2449
|
|
|
|
|
|
/* avoid FPE_INTOVF on some platforms when left is IV_MIN */ |
2450
|
43728
|
50
|
|
|
|
if (right == -1) |
2451
|
0
|
0
|
|
|
|
SETi( 0 ); |
2452
|
|
|
|
|
|
else |
2453
|
43728
|
50
|
|
|
|
SETi( left % right ); |
2454
|
43728
|
|
|
|
|
RETURN; |
2455
|
|
|
|
|
|
} |
2456
|
|
|
|
|
|
} |
2457
|
|
|
|
|
|
|
2458
|
|
|
|
|
|
#if defined(__GLIBC__) && IVSIZE == 8 && !defined(PERL_DEBUG_READONLY_OPS) |
2459
|
|
|
|
|
|
STATIC |
2460
|
0
|
|
|
|
|
PP(pp_i_modulo_1) |
2461
|
|
|
|
|
|
|
2462
|
|
|
|
|
|
{ |
2463
|
|
|
|
|
|
/* This is the i_modulo with the workaround for the _moddi3 bug |
2464
|
|
|
|
|
|
* in (at least) glibc 2.2.5 (the PERL_ABS() the workaround). |
2465
|
|
|
|
|
|
* See below for pp_i_modulo. */ |
2466
|
0
|
0
|
|
|
|
dVAR; dSP; dATARGET; |
2467
|
0
|
0
|
|
|
|
tryAMAGICbin_MG(modulo_amg, AMGf_assign); |
|
|
0
|
|
|
|
|
2468
|
|
|
|
|
|
{ |
2469
|
0
|
0
|
|
|
|
dPOPTOPiirl_nomg; |
|
|
0
|
|
|
|
|
2470
|
0
|
0
|
|
|
|
if (!right) |
2471
|
0
|
|
|
|
|
DIE(aTHX_ "Illegal modulus zero"); |
2472
|
|
|
|
|
|
/* avoid FPE_INTOVF on some platforms when left is IV_MIN */ |
2473
|
0
|
0
|
|
|
|
if (right == -1) |
2474
|
0
|
0
|
|
|
|
SETi( 0 ); |
2475
|
|
|
|
|
|
else |
2476
|
0
|
0
|
|
|
|
SETi( left % PERL_ABS(right) ); |
2477
|
0
|
|
|
|
|
RETURN; |
2478
|
|
|
|
|
|
} |
2479
|
|
|
|
|
|
} |
2480
|
|
|
|
|
|
|
2481
|
194
|
|
|
|
|
PP(pp_i_modulo) |
2482
|
|
|
|
|
|
{ |
2483
|
194
|
100
|
|
|
|
dVAR; dSP; dATARGET; |
2484
|
194
|
50
|
|
|
|
tryAMAGICbin_MG(modulo_amg, AMGf_assign); |
|
|
0
|
|
|
|
|
2485
|
|
|
|
|
|
{ |
2486
|
194
|
100
|
|
|
|
dPOPTOPiirl_nomg; |
|
|
100
|
|
|
|
|
2487
|
194
|
100
|
|
|
|
if (!right) |
2488
|
2
|
|
|
|
|
DIE(aTHX_ "Illegal modulus zero"); |
2489
|
|
|
|
|
|
/* The assumption is to use hereafter the old vanilla version... */ |
2490
|
384
|
|
|
|
|
PL_op->op_ppaddr = |
2491
|
192
|
|
|
|
|
PL_ppaddr[OP_I_MODULO] = |
2492
|
|
|
|
|
|
Perl_pp_i_modulo_0; |
2493
|
|
|
|
|
|
/* .. but if we have glibc, we might have a buggy _moddi3 |
2494
|
|
|
|
|
|
* (at least glicb 2.2.5 is known to have this bug), in other |
2495
|
|
|
|
|
|
* words our integer modulus with negative quad as the second |
2496
|
|
|
|
|
|
* argument might be broken. Test for this and re-patch the |
2497
|
|
|
|
|
|
* opcode dispatch table if that is the case, remembering to |
2498
|
|
|
|
|
|
* also apply the workaround so that this first round works |
2499
|
|
|
|
|
|
* right, too. See [perl #9402] for more information. */ |
2500
|
|
|
|
|
|
{ |
2501
|
|
|
|
|
|
IV l = 3; |
2502
|
|
|
|
|
|
IV r = -10; |
2503
|
|
|
|
|
|
/* Cannot do this check with inlined IV constants since |
2504
|
|
|
|
|
|
* that seems to work correctly even with the buggy glibc. */ |
2505
|
|
|
|
|
|
if (l % r == -3) { |
2506
|
|
|
|
|
|
/* Yikes, we have the bug. |
2507
|
|
|
|
|
|
* Patch in the workaround version. */ |
2508
|
|
|
|
|
|
PL_op->op_ppaddr = |
2509
|
|
|
|
|
|
PL_ppaddr[OP_I_MODULO] = |
2510
|
|
|
|
|
|
&Perl_pp_i_modulo_1; |
2511
|
|
|
|
|
|
/* Make certain we work right this time, too. */ |
2512
|
|
|
|
|
|
right = PERL_ABS(right); |
2513
|
|
|
|
|
|
} |
2514
|
|
|
|
|
|
} |
2515
|
|
|
|
|
|
/* avoid FPE_INTOVF on some platforms when left is IV_MIN */ |
2516
|
192
|
100
|
|
|
|
if (right == -1) |
2517
|
2
|
50
|
|
|
|
SETi( 0 ); |
2518
|
|
|
|
|
|
else |
2519
|
190
|
50
|
|
|
|
SETi( left % right ); |
2520
|
192
|
|
|
|
|
RETURN; |
2521
|
|
|
|
|
|
} |
2522
|
|
|
|
|
|
} |
2523
|
|
|
|
|
|
#endif |
2524
|
|
|
|
|
|
|
2525
|
12238222
|
|
|
|
|
PP(pp_i_add) |
2526
|
|
|
|
|
|
{ |
2527
|
12238222
|
100
|
|
|
|
dVAR; dSP; dATARGET; |
2528
|
12238222
|
100
|
|
|
|
tryAMAGICbin_MG(add_amg, AMGf_assign); |
|
|
50
|
|
|
|
|
2529
|
|
|
|
|
|
{ |
2530
|
12238222
|
100
|
|
|
|
dPOPTOPiirl_ul_nomg; |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
2531
|
12238222
|
100
|
|
|
|
SETi( left + right ); |
2532
|
12238222
|
|
|
|
|
RETURN; |
2533
|
|
|
|
|
|
} |
2534
|
|
|
|
|
|
} |
2535
|
|
|
|
|
|
|
2536
|
7237312
|
|
|
|
|
PP(pp_i_subtract) |
2537
|
|
|
|
|
|
{ |
2538
|
7237312
|
100
|
|
|
|
dVAR; dSP; dATARGET; |
2539
|
7237312
|
100
|
|
|
|
tryAMAGICbin_MG(subtr_amg, AMGf_assign); |
|
|
50
|
|
|
|
|
2540
|
|
|
|
|
|
{ |
2541
|
7237312
|
100
|
|
|
|
dPOPTOPiirl_ul_nomg; |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
2542
|
7237312
|
100
|
|
|
|
SETi( left - right ); |
2543
|
7237312
|
|
|
|
|
RETURN; |
2544
|
|
|
|
|
|
} |
2545
|
|
|
|
|
|
} |
2546
|
|
|
|
|
|
|
2547
|
2629724
|
|
|
|
|
PP(pp_i_lt) |
2548
|
|
|
|
|
|
{ |
2549
|
2629724
|
|
|
|
|
dVAR; dSP; |
2550
|
2629724
|
100
|
|
|
|
tryAMAGICbin_MG(lt_amg, AMGf_set); |
|
|
50
|
|
|
|
|
2551
|
|
|
|
|
|
{ |
2552
|
2629724
|
100
|
|
|
|
dPOPTOPiirl_nomg; |
|
|
100
|
|
|
|
|
2553
|
2629724
|
100
|
|
|
|
SETs(boolSV(left < right)); |
2554
|
2629724
|
|
|
|
|
RETURN; |
2555
|
|
|
|
|
|
} |
2556
|
|
|
|
|
|
} |
2557
|
|
|
|
|
|
|
2558
|
513928
|
|
|
|
|
PP(pp_i_gt) |
2559
|
|
|
|
|
|
{ |
2560
|
513928
|
|
|
|
|
dVAR; dSP; |
2561
|
513928
|
100
|
|
|
|
tryAMAGICbin_MG(gt_amg, AMGf_set); |
|
|
50
|
|
|
|
|
2562
|
|
|
|
|
|
{ |
2563
|
513928
|
100
|
|
|
|
dPOPTOPiirl_nomg; |
|
|
100
|
|
|
|
|
2564
|
513928
|
100
|
|
|
|
SETs(boolSV(left > right)); |
2565
|
513928
|
|
|
|
|
RETURN; |
2566
|
|
|
|
|
|
} |
2567
|
|
|
|
|
|
} |
2568
|
|
|
|
|
|
|
2569
|
1763652
|
|
|
|
|
PP(pp_i_le) |
2570
|
|
|
|
|
|
{ |
2571
|
1763652
|
|
|
|
|
dVAR; dSP; |
2572
|
1763652
|
100
|
|
|
|
tryAMAGICbin_MG(le_amg, AMGf_set); |
|
|
50
|
|
|
|
|
2573
|
|
|
|
|
|
{ |
2574
|
1763652
|
100
|
|
|
|
dPOPTOPiirl_nomg; |
|
|
100
|
|
|
|
|
2575
|
1763652
|
100
|
|
|
|
SETs(boolSV(left <= right)); |
2576
|
1763652
|
|
|
|
|
RETURN; |
2577
|
|
|
|
|
|
} |
2578
|
|
|
|
|
|
} |
2579
|
|
|
|
|
|
|
2580
|
583634
|
|
|
|
|
PP(pp_i_ge) |
2581
|
|
|
|
|
|
{ |
2582
|
583634
|
|
|
|
|
dVAR; dSP; |
2583
|
583634
|
100
|
|
|
|
tryAMAGICbin_MG(ge_amg, AMGf_set); |
|
|
50
|
|
|
|
|
2584
|
|
|
|
|
|
{ |
2585
|
583634
|
100
|
|
|
|
dPOPTOPiirl_nomg; |
|
|
100
|
|
|
|
|
2586
|
583634
|
100
|
|
|
|
SETs(boolSV(left >= right)); |
2587
|
583634
|
|
|
|
|
RETURN; |
2588
|
|
|
|
|
|
} |
2589
|
|
|
|
|
|
} |
2590
|
|
|
|
|
|
|
2591
|
2020828
|
|
|
|
|
PP(pp_i_eq) |
2592
|
|
|
|
|
|
{ |
2593
|
2020828
|
|
|
|
|
dVAR; dSP; |
2594
|
2020828
|
100
|
|
|
|
tryAMAGICbin_MG(eq_amg, AMGf_set); |
|
|
50
|
|
|
|
|
2595
|
|
|
|
|
|
{ |
2596
|
2020828
|
100
|
|
|
|
dPOPTOPiirl_nomg; |
|
|
100
|
|
|
|
|
2597
|
2020828
|
100
|
|
|
|
SETs(boolSV(left == right)); |
2598
|
2020828
|
|
|
|
|
RETURN; |
2599
|
|
|
|
|
|
} |
2600
|
|
|
|
|
|
} |
2601
|
|
|
|
|
|
|
2602
|
92002
|
|
|
|
|
PP(pp_i_ne) |
2603
|
|
|
|
|
|
{ |
2604
|
92002
|
|
|
|
|
dVAR; dSP; |
2605
|
92002
|
100
|
|
|
|
tryAMAGICbin_MG(ne_amg, AMGf_set); |
|
|
50
|
|
|
|
|
2606
|
|
|
|
|
|
{ |
2607
|
92002
|
100
|
|
|
|
dPOPTOPiirl_nomg; |
|
|
100
|
|
|
|
|
2608
|
92002
|
100
|
|
|
|
SETs(boolSV(left != right)); |
2609
|
92002
|
|
|
|
|
RETURN; |
2610
|
|
|
|
|
|
} |
2611
|
|
|
|
|
|
} |
2612
|
|
|
|
|
|
|
2613
|
84
|
|
|
|
|
PP(pp_i_ncmp) |
2614
|
|
|
|
|
|
{ |
2615
|
84
|
|
|
|
|
dVAR; dSP; dTARGET; |
2616
|
84
|
100
|
|
|
|
tryAMAGICbin_MG(ncmp_amg, 0); |
|
|
50
|
|
|
|
|
2617
|
|
|
|
|
|
{ |
2618
|
84
|
100
|
|
|
|
dPOPTOPiirl_nomg; |
|
|
100
|
|
|
|
|
2619
|
|
|
|
|
|
I32 value; |
2620
|
|
|
|
|
|
|
2621
|
84
|
100
|
|
|
|
if (left > right) |
2622
|
|
|
|
|
|
value = 1; |
2623
|
46
|
100
|
|
|
|
else if (left < right) |
2624
|
|
|
|
|
|
value = -1; |
2625
|
|
|
|
|
|
else |
2626
|
|
|
|
|
|
value = 0; |
2627
|
84
|
50
|
|
|
|
SETi(value); |
2628
|
84
|
|
|
|
|
RETURN; |
2629
|
|
|
|
|
|
} |
2630
|
|
|
|
|
|
} |
2631
|
|
|
|
|
|
|
2632
|
67662
|
|
|
|
|
PP(pp_i_negate) |
2633
|
|
|
|
|
|
{ |
2634
|
67662
|
|
|
|
|
dVAR; dSP; dTARGET; |
2635
|
67662
|
100
|
|
|
|
tryAMAGICun_MG(neg_amg, 0); |
|
|
50
|
|
|
|
|
2636
|
67662
|
100
|
|
|
|
if (S_negate_string(aTHX)) return NORMAL; |
2637
|
|
|
|
|
|
{ |
2638
|
67646
|
|
|
|
|
SV * const sv = TOPs; |
2639
|
67646
|
100
|
|
|
|
IV const i = SvIV_nomg(sv); |
2640
|
67646
|
50
|
|
|
|
SETi(-i); |
2641
|
67654
|
|
|
|
|
RETURN; |
2642
|
|
|
|
|
|
} |
2643
|
|
|
|
|
|
} |
2644
|
|
|
|
|
|
|
2645
|
|
|
|
|
|
/* High falutin' math. */ |
2646
|
|
|
|
|
|
|
2647
|
2204
|
|
|
|
|
PP(pp_atan2) |
2648
|
|
|
|
|
|
{ |
2649
|
2204
|
|
|
|
|
dVAR; dSP; dTARGET; |
2650
|
2204
|
50
|
|
|
|
tryAMAGICbin_MG(atan2_amg, 0); |
|
|
0
|
|
|
|
|
2651
|
|
|
|
|
|
{ |
2652
|
2204
|
100
|
|
|
|
dPOPTOPnnrl_nomg; |
|
|
100
|
|
|
|
|
2653
|
2204
|
50
|
|
|
|
SETn(Perl_atan2(left, right)); |
2654
|
2204
|
|
|
|
|
RETURN; |
2655
|
|
|
|
|
|
} |
2656
|
|
|
|
|
|
} |
2657
|
|
|
|
|
|
|
2658
|
2603310
|
|
|
|
|
PP(pp_sin) |
2659
|
|
|
|
|
|
{ |
2660
|
2603310
|
|
|
|
|
dVAR; dSP; dTARGET; |
2661
|
|
|
|
|
|
int amg_type = sin_amg; |
2662
|
|
|
|
|
|
const char *neg_report = NULL; |
2663
|
|
|
|
|
|
NV (*func)(NV) = Perl_sin; |
2664
|
2603310
|
|
|
|
|
const int op_type = PL_op->op_type; |
2665
|
|
|
|
|
|
|
2666
|
2603310
|
100
|
|
|
|
switch (op_type) { |
2667
|
|
|
|
|
|
case OP_COS: |
2668
|
|
|
|
|
|
amg_type = cos_amg; |
2669
|
|
|
|
|
|
func = Perl_cos; |
2670
|
|
|
|
|
|
break; |
2671
|
|
|
|
|
|
case OP_EXP: |
2672
|
|
|
|
|
|
amg_type = exp_amg; |
2673
|
|
|
|
|
|
func = Perl_exp; |
2674
|
|
|
|
|
|
break; |
2675
|
|
|
|
|
|
case OP_LOG: |
2676
|
|
|
|
|
|
amg_type = log_amg; |
2677
|
|
|
|
|
|
func = Perl_log; |
2678
|
|
|
|
|
|
neg_report = "log"; |
2679
|
|
|
|
|
|
break; |
2680
|
|
|
|
|
|
case OP_SQRT: |
2681
|
|
|
|
|
|
amg_type = sqrt_amg; |
2682
|
|
|
|
|
|
func = Perl_sqrt; |
2683
|
|
|
|
|
|
neg_report = "sqrt"; |
2684
|
|
|
|
|
|
break; |
2685
|
|
|
|
|
|
} |
2686
|
|
|
|
|
|
|
2687
|
|
|
|
|
|
|
2688
|
2603310
|
100
|
|
|
|
tryAMAGICun_MG(amg_type, 0); |
|
|
100
|
|
|
|
|
2689
|
|
|
|
|
|
{ |
2690
|
2602888
|
|
|
|
|
SV * const arg = POPs; |
2691
|
2602888
|
100
|
|
|
|
const NV value = SvNV_nomg(arg); |
2692
|
2602888
|
100
|
|
|
|
if (neg_report) { |
2693
|
2584900
|
100
|
|
|
|
if (op_type == OP_LOG ? (value <= 0.0) : (value < 0.0)) { |
|
|
100
|
|
|
|
|
2694
|
10
|
|
|
|
|
SET_NUMERIC_STANDARD(); |
2695
|
|
|
|
|
|
/* diag_listed_as: Can't take log of %g */ |
2696
|
10
|
|
|
|
|
DIE(aTHX_ "Can't take %s of %"NVgf, neg_report, value); |
2697
|
|
|
|
|
|
} |
2698
|
|
|
|
|
|
} |
2699
|
2602878
|
50
|
|
|
|
XPUSHn(func(value)); |
|
|
50
|
|
|
|
|
2700
|
2603089
|
|
|
|
|
RETURN; |
2701
|
|
|
|
|
|
} |
2702
|
|
|
|
|
|
} |
2703
|
|
|
|
|
|
|
2704
|
|
|
|
|
|
/* Support Configure command-line overrides for rand() functions. |
2705
|
|
|
|
|
|
After 5.005, perhaps we should replace this by Configure support |
2706
|
|
|
|
|
|
for drand48(), random(), or rand(). For 5.005, though, maintain |
2707
|
|
|
|
|
|
compatibility by calling rand() but allow the user to override it. |
2708
|
|
|
|
|
|
See INSTALL for details. --Andy Dougherty 15 July 1998 |
2709
|
|
|
|
|
|
*/ |
2710
|
|
|
|
|
|
/* Now it's after 5.005, and Configure supports drand48() and random(), |
2711
|
|
|
|
|
|
in addition to rand(). So the overrides should not be needed any more. |
2712
|
|
|
|
|
|
--Jarkko Hietaniemi 27 September 1998 |
2713
|
|
|
|
|
|
*/ |
2714
|
|
|
|
|
|
|
2715
|
|
|
|
|
|
#ifndef HAS_DRAND48_PROTO |
2716
|
|
|
|
|
|
extern double drand48 (void); |
2717
|
|
|
|
|
|
#endif |
2718
|
|
|
|
|
|
|
2719
|
1536619
|
|
|
|
|
PP(pp_rand) |
2720
|
|
|
|
|
|
{ |
2721
|
|
|
|
|
|
dVAR; |
2722
|
1536619
|
100
|
|
|
|
if (!PL_srand_called) { |
2723
|
5081
|
|
|
|
|
(void)seedDrand01((Rand_seed_t)seed()); |
2724
|
5081
|
|
|
|
|
PL_srand_called = TRUE; |
2725
|
|
|
|
|
|
} |
2726
|
1536619
|
50
|
|
|
|
{ |
2727
|
1536619
|
|
|
|
|
dSP; |
2728
|
|
|
|
|
|
NV value; |
2729
|
768130
|
|
|
|
|
EXTEND(SP, 1); |
2730
|
|
|
|
|
|
|
2731
|
1536619
|
100
|
|
|
|
if (MAXARG < 1) |
2732
|
|
|
|
|
|
value = 1.0; |
2733
|
|
|
|
|
|
else { |
2734
|
1329787
|
|
|
|
|
SV * const sv = POPs; |
2735
|
1329787
|
100
|
|
|
|
if(!sv) |
2736
|
|
|
|
|
|
value = 1.0; |
2737
|
|
|
|
|
|
else |
2738
|
1329783
|
100
|
|
|
|
value = SvNV(sv); |
2739
|
|
|
|
|
|
} |
2740
|
|
|
|
|
|
/* 1 of 2 things can be carried through SvNV, SP or TARG, SP was carried */ |
2741
|
1536619
|
100
|
|
|
|
if (value == 0.0) |
2742
|
|
|
|
|
|
value = 1.0; |
2743
|
|
|
|
|
|
{ |
2744
|
1536619
|
|
|
|
|
dTARGET; |
2745
|
1536619
|
|
|
|
|
PUSHs(TARG); |
2746
|
1536619
|
|
|
|
|
PUTBACK; |
2747
|
1536619
|
|
|
|
|
value *= Drand01(); |
2748
|
1536619
|
|
|
|
|
sv_setnv_mg(TARG, value); |
2749
|
|
|
|
|
|
} |
2750
|
|
|
|
|
|
} |
2751
|
1536619
|
|
|
|
|
return NORMAL; |
2752
|
|
|
|
|
|
} |
2753
|
|
|
|
|
|
|
2754
|
60
|
|
|
|
|
PP(pp_srand) |
2755
|
|
|
|
|
|
{ |
2756
|
60
|
|
|
|
|
dVAR; dSP; dTARGET; |
2757
|
|
|
|
|
|
UV anum; |
2758
|
|
|
|
|
|
|
2759
|
60
|
100
|
|
|
|
if (MAXARG >= 1 && (TOPs || POPs)) { |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
2760
|
|
|
|
|
|
SV *top; |
2761
|
|
|
|
|
|
char *pv; |
2762
|
|
|
|
|
|
STRLEN len; |
2763
|
|
|
|
|
|
int flags; |
2764
|
|
|
|
|
|
|
2765
|
44
|
|
|
|
|
top = POPs; |
2766
|
44
|
100
|
|
|
|
pv = SvPV(top, len); |
2767
|
44
|
|
|
|
|
flags = grok_number(pv, len, &anum); |
2768
|
|
|
|
|
|
|
2769
|
44
|
100
|
|
|
|
if (!(flags & IS_NUMBER_IN_UV)) { |
2770
|
4
|
|
|
|
|
Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW), |
2771
|
|
|
|
|
|
"Integer overflow in srand"); |
2772
|
4
|
|
|
|
|
anum = UV_MAX; |
2773
|
|
|
|
|
|
} |
2774
|
|
|
|
|
|
} |
2775
|
|
|
|
|
|
else { |
2776
|
16
|
|
|
|
|
anum = seed(); |
2777
|
|
|
|
|
|
} |
2778
|
|
|
|
|
|
|
2779
|
60
|
|
|
|
|
(void)seedDrand01((Rand_seed_t)anum); |
2780
|
60
|
|
|
|
|
PL_srand_called = TRUE; |
2781
|
60
|
100
|
|
|
|
if (anum) |
2782
|
54
|
50
|
|
|
|
XPUSHu(anum); |
|
|
50
|
|
|
|
|
2783
|
|
|
|
|
|
else { |
2784
|
|
|
|
|
|
/* Historically srand always returned true. We can avoid breaking |
2785
|
|
|
|
|
|
that like this: */ |
2786
|
6
|
|
|
|
|
sv_setpvs(TARG, "0 but true"); |
2787
|
6
|
50
|
|
|
|
XPUSHTARG; |
|
|
50
|
|
|
|
|
2788
|
|
|
|
|
|
} |
2789
|
60
|
|
|
|
|
RETURN; |
2790
|
|
|
|
|
|
} |
2791
|
|
|
|
|
|
|
2792
|
3798464
|
|
|
|
|
PP(pp_int) |
2793
|
|
|
|
|
|
{ |
2794
|
3798464
|
|
|
|
|
dVAR; dSP; dTARGET; |
2795
|
3798464
|
100
|
|
|
|
tryAMAGICun_MG(int_amg, AMGf_numeric); |
|
|
100
|
|
|
|
|
2796
|
|
|
|
|
|
{ |
2797
|
3798364
|
|
|
|
|
SV * const sv = TOPs; |
2798
|
3798364
|
100
|
|
|
|
const IV iv = SvIV_nomg(sv); |
2799
|
|
|
|
|
|
/* XXX it's arguable that compiler casting to IV might be subtly |
2800
|
|
|
|
|
|
different from modf (for numbers inside (IV_MIN,UV_MAX)) in which |
2801
|
|
|
|
|
|
else preferring IV has introduced a subtle behaviour change bug. OTOH |
2802
|
|
|
|
|
|
relying on floating point to be accurate is a bug. */ |
2803
|
|
|
|
|
|
|
2804
|
3798364
|
100
|
|
|
|
if (!SvOK(sv)) { |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
2805
|
2
|
50
|
|
|
|
SETu(0); |
2806
|
|
|
|
|
|
} |
2807
|
3798362
|
100
|
|
|
|
else if (SvIOK(sv)) { |
2808
|
2800364
|
50
|
|
|
|
if (SvIsUV(sv)) |
2809
|
0
|
0
|
|
|
|
SETu(SvUV_nomg(sv)); |
|
|
0
|
|
|
|
|
2810
|
|
|
|
|
|
else |
2811
|
2800364
|
50
|
|
|
|
SETi(iv); |
2812
|
|
|
|
|
|
} |
2813
|
|
|
|
|
|
else { |
2814
|
997998
|
100
|
|
|
|
const NV value = SvNV_nomg(sv); |
2815
|
997998
|
100
|
|
|
|
if (value >= 0.0) { |
2816
|
997112
|
100
|
|
|
|
if (value < (NV)UV_MAX + 0.5) { |
2817
|
996982
|
50
|
|
|
|
SETu(U_V(value)); |
2818
|
|
|
|
|
|
} else { |
2819
|
130
|
50
|
|
|
|
SETn(Perl_floor(value)); |
2820
|
|
|
|
|
|
} |
2821
|
|
|
|
|
|
} |
2822
|
|
|
|
|
|
else { |
2823
|
886
|
50
|
|
|
|
if (value > (NV)IV_MIN - 0.5) { |
2824
|
886
|
50
|
|
|
|
SETi(I_V(value)); |
2825
|
|
|
|
|
|
} else { |
2826
|
0
|
0
|
|
|
|
SETn(Perl_ceil(value)); |
2827
|
|
|
|
|
|
} |
2828
|
|
|
|
|
|
} |
2829
|
|
|
|
|
|
} |
2830
|
|
|
|
|
|
} |
2831
|
3798414
|
|
|
|
|
RETURN; |
2832
|
|
|
|
|
|
} |
2833
|
|
|
|
|
|
|
2834
|
56210
|
|
|
|
|
PP(pp_abs) |
2835
|
|
|
|
|
|
{ |
2836
|
56210
|
|
|
|
|
dVAR; dSP; dTARGET; |
2837
|
56210
|
100
|
|
|
|
tryAMAGICun_MG(abs_amg, AMGf_numeric); |
|
|
100
|
|
|
|
|
2838
|
|
|
|
|
|
{ |
2839
|
54562
|
|
|
|
|
SV * const sv = TOPs; |
2840
|
|
|
|
|
|
/* This will cache the NV value if string isn't actually integer */ |
2841
|
54562
|
100
|
|
|
|
const IV iv = SvIV_nomg(sv); |
2842
|
|
|
|
|
|
|
2843
|
54562
|
100
|
|
|
|
if (!SvOK(sv)) { |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
2844
|
4
|
50
|
|
|
|
SETu(0); |
2845
|
|
|
|
|
|
} |
2846
|
54558
|
100
|
|
|
|
else if (SvIOK(sv)) { |
2847
|
|
|
|
|
|
/* IVX is precise */ |
2848
|
24366
|
100
|
|
|
|
if (SvIsUV(sv)) { |
2849
|
54
|
50
|
|
|
|
SETu(SvUV_nomg(sv)); /* force it to be numeric only */ |
|
|
50
|
|
|
|
|
2850
|
|
|
|
|
|
} else { |
2851
|
24312
|
100
|
|
|
|
if (iv >= 0) { |
2852
|
19510
|
50
|
|
|
|
SETi(iv); |
2853
|
|
|
|
|
|
} else { |
2854
|
4802
|
50
|
|
|
|
if (iv != IV_MIN) { |
2855
|
4802
|
50
|
|
|
|
SETi(-iv); |
2856
|
|
|
|
|
|
} else { |
2857
|
|
|
|
|
|
/* 2s complement assumption. Also, not really needed as |
2858
|
|
|
|
|
|
IV_MIN and -IV_MIN should both be %100...00 and NV-able */ |
2859
|
0
|
0
|
|
|
|
SETu(IV_MIN); |
2860
|
|
|
|
|
|
} |
2861
|
|
|
|
|
|
} |
2862
|
|
|
|
|
|
} |
2863
|
|
|
|
|
|
} else{ |
2864
|
30192
|
100
|
|
|
|
const NV value = SvNV_nomg(sv); |
2865
|
30192
|
100
|
|
|
|
if (value < 0.0) |
2866
|
18564
|
50
|
|
|
|
SETn(-value); |
2867
|
|
|
|
|
|
else |
2868
|
11628
|
50
|
|
|
|
SETn(value); |
2869
|
|
|
|
|
|
} |
2870
|
|
|
|
|
|
} |
2871
|
55375
|
|
|
|
|
RETURN; |
2872
|
|
|
|
|
|
} |
2873
|
|
|
|
|
|
|
2874
|
5307920
|
|
|
|
|
PP(pp_oct) |
2875
|
|
|
|
|
|
{ |
2876
|
5307920
|
|
|
|
|
dVAR; dSP; dTARGET; |
2877
|
|
|
|
|
|
const char *tmps; |
2878
|
5307920
|
|
|
|
|
I32 flags = PERL_SCAN_ALLOW_UNDERSCORES; |
2879
|
|
|
|
|
|
STRLEN len; |
2880
|
|
|
|
|
|
NV result_nv; |
2881
|
|
|
|
|
|
UV result_uv; |
2882
|
5307920
|
|
|
|
|
SV* const sv = POPs; |
2883
|
|
|
|
|
|
|
2884
|
5307920
|
100
|
|
|
|
tmps = (SvPV_const(sv, len)); |
2885
|
5307920
|
100
|
|
|
|
if (DO_UTF8(sv)) { |
|
|
50
|
|
|
|
|
2886
|
|
|
|
|
|
/* If Unicode, try to downgrade |
2887
|
|
|
|
|
|
* If not possible, croak. */ |
2888
|
4922
|
|
|
|
|
SV* const tsv = sv_2mortal(newSVsv(sv)); |
2889
|
|
|
|
|
|
|
2890
|
4922
|
|
|
|
|
SvUTF8_on(tsv); |
2891
|
4922
|
|
|
|
|
sv_utf8_downgrade(tsv, FALSE); |
2892
|
4914
|
50
|
|
|
|
tmps = SvPV_const(tsv, len); |
2893
|
|
|
|
|
|
} |
2894
|
5307912
|
100
|
|
|
|
if (PL_op->op_type == OP_HEX) |
2895
|
|
|
|
|
|
goto hex; |
2896
|
|
|
|
|
|
|
2897
|
19834
|
100
|
|
|
|
while (*tmps && len && isSPACE(*tmps)) |
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
2898
|
1832
|
|
|
|
|
tmps++, len--; |
2899
|
18002
|
100
|
|
|
|
if (*tmps == '0') |
2900
|
11084
|
|
|
|
|
tmps++, len--; |
2901
|
18002
|
100
|
|
|
|
if (*tmps == 'x' || *tmps == 'X') { |
2902
|
|
|
|
|
|
hex: |
2903
|
5289982
|
|
|
|
|
result_uv = grok_hex (tmps, &len, &flags, &result_nv); |
2904
|
|
|
|
|
|
} |
2905
|
17930
|
100
|
|
|
|
else if (*tmps == 'b' || *tmps == 'B') |
2906
|
7998
|
|
|
|
|
result_uv = grok_bin (tmps, &len, &flags, &result_nv); |
2907
|
|
|
|
|
|
else |
2908
|
9932
|
|
|
|
|
result_uv = grok_oct (tmps, &len, &flags, &result_nv); |
2909
|
|
|
|
|
|
|
2910
|
5307878
|
100
|
|
|
|
if (flags & PERL_SCAN_GREATER_THAN_UV_MAX) { |
2911
|
42
|
50
|
|
|
|
XPUSHn(result_nv); |
|
|
50
|
|
|
|
|
2912
|
|
|
|
|
|
} |
2913
|
|
|
|
|
|
else { |
2914
|
5307836
|
100
|
|
|
|
XPUSHu(result_uv); |
|
|
50
|
|
|
|
|
2915
|
|
|
|
|
|
} |
2916
|
5307878
|
|
|
|
|
RETURN; |
2917
|
|
|
|
|
|
} |
2918
|
|
|
|
|
|
|
2919
|
|
|
|
|
|
/* String stuff. */ |
2920
|
|
|
|
|
|
|
2921
|
32707653
|
|
|
|
|
PP(pp_length) |
2922
|
32707653
|
100
|
|
|
|
{ |
2923
|
32707653
|
|
|
|
|
dVAR; dSP; dTARGET; |
2924
|
32707653
|
|
|
|
|
SV * const sv = TOPs; |
2925
|
|
|
|
|
|
|
2926
|
16482506
|
|
|
|
|
SvGETMAGIC(sv); |
2927
|
32707653
|
100
|
|
|
|
if (SvOK(sv)) { |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
2928
|
32707485
|
100
|
|
|
|
if (!IN_BYTES) |
2929
|
30269781
|
100
|
|
|
|
SETi(sv_len_utf8_nomg(sv)); |
2930
|
|
|
|
|
|
else |
2931
|
|
|
|
|
|
{ |
2932
|
|
|
|
|
|
STRLEN len; |
2933
|
2437704
|
100
|
|
|
|
(void)SvPV_nomg_const(sv,len); |
2934
|
2437704
|
50
|
|
|
|
SETi(len); |
2935
|
|
|
|
|
|
} |
2936
|
|
|
|
|
|
} else { |
2937
|
168
|
100
|
|
|
|
if (!SvPADTMP(TARG)) { |
2938
|
6
|
|
|
|
|
sv_setsv_nomg(TARG, &PL_sv_undef); |
2939
|
6
|
50
|
|
|
|
SETTARG; |
2940
|
|
|
|
|
|
} |
2941
|
168
|
|
|
|
|
SETs(&PL_sv_undef); |
2942
|
|
|
|
|
|
} |
2943
|
32707653
|
|
|
|
|
RETURN; |
2944
|
|
|
|
|
|
} |
2945
|
|
|
|
|
|
|
2946
|
|
|
|
|
|
/* Returns false if substring is completely outside original string. |
2947
|
|
|
|
|
|
No length is indicated by len_iv = 0 and len_is_uv = 0. len_is_uv must |
2948
|
|
|
|
|
|
always be true for an explicit 0. |
2949
|
|
|
|
|
|
*/ |
2950
|
|
|
|
|
|
bool |
2951
|
23225328
|
|
|
|
|
Perl_translate_substr_offsets(pTHX_ STRLEN curlen, IV pos1_iv, |
2952
|
|
|
|
|
|
bool pos1_is_uv, IV len_iv, |
2953
|
|
|
|
|
|
bool len_is_uv, STRLEN *posp, |
2954
|
|
|
|
|
|
STRLEN *lenp) |
2955
|
|
|
|
|
|
{ |
2956
|
|
|
|
|
|
IV pos2_iv; |
2957
|
|
|
|
|
|
int pos2_is_uv; |
2958
|
|
|
|
|
|
|
2959
|
|
|
|
|
|
PERL_ARGS_ASSERT_TRANSLATE_SUBSTR_OFFSETS; |
2960
|
|
|
|
|
|
|
2961
|
23225328
|
100
|
|
|
|
if (!pos1_is_uv && pos1_iv < 0 && curlen) { |
|
|
100
|
|
|
|
|
2962
|
4387374
|
|
|
|
|
pos1_is_uv = curlen-1 > ~(UV)pos1_iv; |
2963
|
4387374
|
|
|
|
|
pos1_iv += curlen; |
2964
|
|
|
|
|
|
} |
2965
|
23225328
|
100
|
|
|
|
if ((pos1_is_uv || pos1_iv > 0) && (UV)pos1_iv > curlen) |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
2966
|
|
|
|
|
|
return FALSE; |
2967
|
|
|
|
|
|
|
2968
|
23225258
|
100
|
|
|
|
if (len_iv || len_is_uv) { |
|
|
100
|
|
|
|
|
2969
|
17178360
|
100
|
|
|
|
if (!len_is_uv && len_iv < 0) { |
|
|
100
|
|
|
|
|
2970
|
996
|
|
|
|
|
pos2_iv = curlen + len_iv; |
2971
|
996
|
100
|
|
|
|
if (curlen) |
2972
|
982
|
|
|
|
|
pos2_is_uv = curlen-1 > ~(UV)len_iv; |
2973
|
|
|
|
|
|
else |
2974
|
|
|
|
|
|
pos2_is_uv = 0; |
2975
|
|
|
|
|
|
} else { /* len_iv >= 0 */ |
2976
|
17177364
|
100
|
|
|
|
if (!pos1_is_uv && pos1_iv < 0) { |
|
|
100
|
|
|
|
|
2977
|
2178
|
|
|
|
|
pos2_iv = pos1_iv + len_iv; |
2978
|
2178
|
|
|
|
|
pos2_is_uv = (UV)len_iv > (UV)IV_MAX; |
2979
|
|
|
|
|
|
} else { |
2980
|
17175186
|
100
|
|
|
|
if ((UV)len_iv > curlen-(UV)pos1_iv) |
2981
|
129954
|
|
|
|
|
pos2_iv = curlen; |
2982
|
|
|
|
|
|
else |
2983
|
17045232
|
|
|
|
|
pos2_iv = pos1_iv+len_iv; |
2984
|
|
|
|
|
|
pos2_is_uv = 1; |
2985
|
|
|
|
|
|
} |
2986
|
|
|
|
|
|
} |
2987
|
|
|
|
|
|
} |
2988
|
|
|
|
|
|
else { |
2989
|
6046898
|
|
|
|
|
pos2_iv = curlen; |
2990
|
|
|
|
|
|
pos2_is_uv = 1; |
2991
|
|
|
|
|
|
} |
2992
|
|
|
|
|
|
|
2993
|
23225258
|
100
|
|
|
|
if (!pos2_is_uv && pos2_iv < 0) { |
2994
|
40
|
100
|
|
|
|
if (!pos1_is_uv && pos1_iv < 0) |
|
|
100
|
|
|
|
|
2995
|
|
|
|
|
|
return FALSE; |
2996
|
|
|
|
|
|
pos2_iv = 0; |
2997
|
|
|
|
|
|
} |
2998
|
23225218
|
100
|
|
|
|
else if (!pos1_is_uv && pos1_iv < 0) |
|
|
100
|
|
|
|
|
2999
|
|
|
|
|
|
pos1_iv = 0; |
3000
|
|
|
|
|
|
|
3001
|
23225228
|
100
|
|
|
|
if ((UV)pos2_iv < (UV)pos1_iv) |
3002
|
|
|
|
|
|
pos2_iv = pos1_iv; |
3003
|
23225228
|
100
|
|
|
|
if ((UV)pos2_iv > curlen) |
3004
|
4
|
|
|
|
|
pos2_iv = curlen; |
3005
|
|
|
|
|
|
|
3006
|
|
|
|
|
|
/* pos1_iv and pos2_iv both in 0..curlen, so the cast is safe */ |
3007
|
23225228
|
|
|
|
|
*posp = (STRLEN)( (UV)pos1_iv ); |
3008
|
23225228
|
|
|
|
|
*lenp = (STRLEN)( (UV)pos2_iv - (UV)pos1_iv ); |
3009
|
|
|
|
|
|
|
3010
|
23225278
|
|
|
|
|
return TRUE; |
3011
|
|
|
|
|
|
} |
3012
|
|
|
|
|
|
|
3013
|
23214320
|
|
|
|
|
PP(pp_substr) |
3014
|
|
|
|
|
|
{ |
3015
|
23214320
|
|
|
|
|
dVAR; dSP; dTARGET; |
3016
|
|
|
|
|
|
SV *sv; |
3017
|
|
|
|
|
|
STRLEN curlen; |
3018
|
|
|
|
|
|
STRLEN utf8_curlen; |
3019
|
|
|
|
|
|
SV * pos_sv; |
3020
|
|
|
|
|
|
IV pos1_iv; |
3021
|
|
|
|
|
|
int pos1_is_uv; |
3022
|
|
|
|
|
|
SV * len_sv; |
3023
|
|
|
|
|
|
IV len_iv = 0; |
3024
|
|
|
|
|
|
int len_is_uv = 0; |
3025
|
23214320
|
100
|
|
|
|
I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET; |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
3026
|
23214320
|
50
|
|
|
|
const bool rvalue = (GIMME_V != G_VOID); |
3027
|
|
|
|
|
|
const char *tmps; |
3028
|
|
|
|
|
|
SV *repl_sv = NULL; |
3029
|
|
|
|
|
|
const char *repl = NULL; |
3030
|
|
|
|
|
|
STRLEN repl_len; |
3031
|
23214320
|
|
|
|
|
int num_args = PL_op->op_private & 7; |
3032
|
|
|
|
|
|
bool repl_need_utf8_upgrade = FALSE; |
3033
|
|
|
|
|
|
|
3034
|
23214320
|
100
|
|
|
|
if (num_args > 2) { |
3035
|
17175918
|
100
|
|
|
|
if (num_args > 3) { |
3036
|
22722
|
|
|
|
|
if(!(repl_sv = POPs)) num_args--; |
3037
|
|
|
|
|
|
} |
3038
|
17175918
|
100
|
|
|
|
if ((len_sv = POPs)) { |
3039
|
17175914
|
100
|
|
|
|
len_iv = SvIV(len_sv); |
3040
|
17175914
|
100
|
|
|
|
len_is_uv = len_iv ? SvIOK_UV(len_sv) : 1; |
|
|
50
|
|
|
|
|
3041
|
|
|
|
|
|
} |
3042
|
|
|
|
|
|
else num_args--; |
3043
|
|
|
|
|
|
} |
3044
|
23214320
|
|
|
|
|
pos_sv = POPs; |
3045
|
23214320
|
100
|
|
|
|
pos1_iv = SvIV(pos_sv); |
3046
|
23214320
|
|
|
|
|
pos1_is_uv = SvIOK_UV(pos_sv); |
3047
|
23214320
|
|
|
|
|
sv = POPs; |
3048
|
23214320
|
100
|
|
|
|
if (PL_op->op_private & OPpSUBSTR_REPL_FIRST) { |
3049
|
|
|
|
|
|
assert(!repl_sv); |
3050
|
2790112
|
|
|
|
|
repl_sv = POPs; |
3051
|
|
|
|
|
|
} |
3052
|
23214320
|
|
|
|
|
PUTBACK; |
3053
|
23214320
|
100
|
|
|
|
if (lvalue && !repl_sv) { |
3054
|
|
|
|
|
|
SV * ret; |
3055
|
58176
|
|
|
|
|
ret = sv_2mortal(newSV_type(SVt_PVLV)); /* Not TARG RT#67838 */ |
3056
|
58176
|
|
|
|
|
sv_magic(ret, NULL, PERL_MAGIC_substr, NULL, 0); |
3057
|
58176
|
|
|
|
|
LvTYPE(ret) = 'x'; |
3058
|
116352
|
|
|
|
|
LvTARG(ret) = SvREFCNT_inc_simple(sv); |
3059
|
116352
|
|
|
|
|
LvTARGOFF(ret) = |
3060
|
58176
|
|
|
|
|
pos1_is_uv || pos1_iv >= 0 |
3061
|
|
|
|
|
|
? (STRLEN)(UV)pos1_iv |
3062
|
58176
|
100
|
|
|
|
: (LvFLAGS(ret) |= 1, (STRLEN)(UV)-pos1_iv); |
3063
|
116352
|
|
|
|
|
LvTARGLEN(ret) = |
3064
|
58176
|
|
|
|
|
len_is_uv || len_iv > 0 |
3065
|
|
|
|
|
|
? (STRLEN)(UV)len_iv |
3066
|
58176
|
100
|
|
|
|
: (LvFLAGS(ret) |= 2, (STRLEN)(UV)-len_iv); |
3067
|
|
|
|
|
|
|
3068
|
58176
|
|
|
|
|
SPAGAIN; |
3069
|
58176
|
|
|
|
|
PUSHs(ret); /* avoid SvSETMAGIC here */ |
3070
|
58176
|
|
|
|
|
RETURN; |
3071
|
|
|
|
|
|
} |
3072
|
25968972
|
100
|
|
|
|
if (repl_sv) { |
|
|
100
|
|
|
|
|
3073
|
2812828
|
100
|
|
|
|
repl = SvPV_const(repl_sv, repl_len); |
3074
|
1407620
|
|
|
|
|
SvGETMAGIC(sv); |
3075
|
2812828
|
100
|
|
|
|
if (SvROK(sv)) |
3076
|
16
|
|
|
|
|
Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), |
3077
|
|
|
|
|
|
"Attempt to use reference as lvalue in substr" |
3078
|
|
|
|
|
|
); |
3079
|
2812828
|
100
|
|
|
|
tmps = SvPV_force_nomg(sv, curlen); |
3080
|
2812828
|
100
|
|
|
|
if (DO_UTF8(repl_sv) && repl_len) { |
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
3081
|
600
|
100
|
|
|
|
if (!DO_UTF8(sv)) { |
|
|
50
|
|
|
|
|
3082
|
242
|
|
|
|
|
sv_utf8_upgrade_nomg(sv); |
3083
|
242
|
|
|
|
|
curlen = SvCUR(sv); |
3084
|
|
|
|
|
|
} |
3085
|
|
|
|
|
|
} |
3086
|
2812228
|
100
|
|
|
|
else if (DO_UTF8(sv)) |
|
|
50
|
|
|
|
|
3087
|
|
|
|
|
|
repl_need_utf8_upgrade = TRUE; |
3088
|
|
|
|
|
|
} |
3089
|
20343316
|
100
|
|
|
|
else tmps = SvPV_const(sv, curlen); |
3090
|
23156144
|
100
|
|
|
|
if (DO_UTF8(sv)) { |
|
|
100
|
|
|
|
|
3091
|
1166528
|
100
|
|
|
|
utf8_curlen = sv_or_pv_len_utf8(sv, tmps, curlen); |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
3092
|
1166528
|
100
|
|
|
|
if (utf8_curlen == curlen) |
3093
|
|
|
|
|
|
utf8_curlen = 0; |
3094
|
|
|
|
|
|
else |
3095
|
147768
|
|
|
|
|
curlen = utf8_curlen; |
3096
|
|
|
|
|
|
} |
3097
|
|
|
|
|
|
else |
3098
|
|
|
|
|
|
utf8_curlen = 0; |
3099
|
|
|
|
|
|
|
3100
|
|
|
|
|
|
{ |
3101
|
|
|
|
|
|
STRLEN pos, len, byte_len, byte_pos; |
3102
|
|
|
|
|
|
|
3103
|
23156144
|
100
|
|
|
|
if (!translate_substr_offsets( |
3104
|
|
|
|
|
|
curlen, pos1_iv, pos1_is_uv, len_iv, len_is_uv, &pos, &len |
3105
|
|
|
|
|
|
)) goto bound_fail; |
3106
|
|
|
|
|
|
|
3107
|
23156046
|
|
|
|
|
byte_len = len; |
3108
|
|
|
|
|
|
byte_pos = utf8_curlen |
3109
|
34660005
|
100
|
|
|
|
? sv_or_pv_pos_u2b(sv, tmps, pos, &byte_len) : pos; |
3110
|
|
|
|
|
|
|
3111
|
23156046
|
|
|
|
|
tmps += byte_pos; |
3112
|
|
|
|
|
|
|
3113
|
23156046
|
100
|
|
|
|
if (rvalue) { |
3114
|
20356252
|
100
|
|
|
|
SvTAINTED_off(TARG); /* decontaminate */ |
3115
|
20356252
|
|
|
|
|
SvUTF8_off(TARG); /* decontaminate */ |
3116
|
20356252
|
|
|
|
|
sv_setpvn(TARG, tmps, byte_len); |
3117
|
|
|
|
|
|
#ifdef USE_LOCALE_COLLATE |
3118
|
20356252
|
|
|
|
|
sv_unmagic(TARG, PERL_MAGIC_collxfrm); |
3119
|
|
|
|
|
|
#endif |
3120
|
20356252
|
100
|
|
|
|
if (utf8_curlen) |
3121
|
145374
|
|
|
|
|
SvUTF8_on(TARG); |
3122
|
|
|
|
|
|
} |
3123
|
|
|
|
|
|
|
3124
|
23156046
|
100
|
|
|
|
if (repl) { |
3125
|
|
|
|
|
|
SV* repl_sv_copy = NULL; |
3126
|
|
|
|
|
|
|
3127
|
2812782
|
100
|
|
|
|
if (repl_need_utf8_upgrade) { |
3128
|
4288
|
|
|
|
|
repl_sv_copy = newSVsv(repl_sv); |
3129
|
4288
|
|
|
|
|
sv_utf8_upgrade(repl_sv_copy); |
3130
|
4288
|
50
|
|
|
|
repl = SvPV_const(repl_sv_copy, repl_len); |
3131
|
|
|
|
|
|
} |
3132
|
2812782
|
50
|
|
|
|
if (!SvOK(sv)) |
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
3133
|
0
|
|
|
|
|
sv_setpvs(sv, ""); |
3134
|
2812782
|
|
|
|
|
sv_insert_flags(sv, byte_pos, byte_len, repl, repl_len, 0); |
3135
|
2812782
|
|
|
|
|
SvREFCNT_dec(repl_sv_copy); |
3136
|
|
|
|
|
|
} |
3137
|
|
|
|
|
|
} |
3138
|
23156046
|
|
|
|
|
SPAGAIN; |
3139
|
23156046
|
100
|
|
|
|
if (rvalue) { |
3140
|
20356252
|
100
|
|
|
|
SvSETMAGIC(TARG); |
3141
|
20356252
|
|
|
|
|
PUSHs(TARG); |
3142
|
|
|
|
|
|
} |
3143
|
23156046
|
|
|
|
|
RETURN; |
3144
|
|
|
|
|
|
|
3145
|
|
|
|
|
|
bound_fail: |
3146
|
98
|
100
|
|
|
|
if (repl) |
3147
|
46
|
|
|
|
|
Perl_croak(aTHX_ "substr outside of string"); |
3148
|
52
|
|
|
|
|
Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), "substr outside of string"); |
3149
|
11607343
|
|
|
|
|
RETPUSHUNDEF; |
3150
|
|
|
|
|
|
} |
3151
|
|
|
|
|
|
|
3152
|
5552080
|
|
|
|
|
PP(pp_vec) |
3153
|
|
|
|
|
|
{ |
3154
|
5552080
|
|
|
|
|
dVAR; dSP; |
3155
|
5552080
|
100
|
|
|
|
const IV size = POPi; |
3156
|
5552080
|
100
|
|
|
|
const IV offset = POPi; |
3157
|
5552080
|
|
|
|
|
SV * const src = POPs; |
3158
|
5552080
|
100
|
|
|
|
const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET; |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
3159
|
|
|
|
|
|
SV * ret; |
3160
|
|
|
|
|
|
|
3161
|
5552080
|
100
|
|
|
|
if (lvalue) { /* it's an lvalue! */ |
3162
|
5038420
|
|
|
|
|
ret = sv_2mortal(newSV_type(SVt_PVLV)); /* Not TARG RT#67838 */ |
3163
|
5038420
|
|
|
|
|
sv_magic(ret, NULL, PERL_MAGIC_vec, NULL, 0); |
3164
|
5038420
|
|
|
|
|
LvTYPE(ret) = 'v'; |
3165
|
10076840
|
|
|
|
|
LvTARG(ret) = SvREFCNT_inc_simple(src); |
3166
|
5038420
|
|
|
|
|
LvTARGOFF(ret) = offset; |
3167
|
5038420
|
|
|
|
|
LvTARGLEN(ret) = size; |
3168
|
|
|
|
|
|
} |
3169
|
|
|
|
|
|
else { |
3170
|
513660
|
|
|
|
|
dTARGET; |
3171
|
513660
|
100
|
|
|
|
SvTAINTED_off(TARG); /* decontaminate */ |
3172
|
|
|
|
|
|
ret = TARG; |
3173
|
|
|
|
|
|
} |
3174
|
|
|
|
|
|
|
3175
|
5552080
|
|
|
|
|
sv_setuv(ret, do_vecget(src, offset, size)); |
3176
|
5552070
|
|
|
|
|
PUSHs(ret); |
3177
|
5552070
|
|
|
|
|
RETURN; |
3178
|
|
|
|
|
|
} |
3179
|
|
|
|
|
|
|
3180
|
5104836
|
|
|
|
|
PP(pp_index) |
3181
|
|
|
|
|
|
{ |
3182
|
5104836
|
|
|
|
|
dVAR; dSP; dTARGET; |
3183
|
|
|
|
|
|
SV *big; |
3184
|
|
|
|
|
|
SV *little; |
3185
|
|
|
|
|
|
SV *temp = NULL; |
3186
|
|
|
|
|
|
STRLEN biglen; |
3187
|
5104836
|
|
|
|
|
STRLEN llen = 0; |
3188
|
|
|
|
|
|
I32 offset; |
3189
|
|
|
|
|
|
I32 retval; |
3190
|
|
|
|
|
|
const char *big_p; |
3191
|
|
|
|
|
|
const char *little_p; |
3192
|
|
|
|
|
|
bool big_utf8; |
3193
|
|
|
|
|
|
bool little_utf8; |
3194
|
5104836
|
|
|
|
|
const bool is_index = PL_op->op_type == OP_INDEX; |
3195
|
5104836
|
100
|
|
|
|
const bool threeargs = MAXARG >= 3 && (TOPs || ((void)POPs,0)); |
|
|
100
|
|
|
|
|
3196
|
|
|
|
|
|
|
3197
|
5104836
|
100
|
|
|
|
if (threeargs) |
3198
|
3149648
|
100
|
|
|
|
offset = POPi; |
3199
|
5104836
|
|
|
|
|
little = POPs; |
3200
|
5104836
|
|
|
|
|
big = POPs; |
3201
|
5104836
|
100
|
|
|
|
big_p = SvPV_const(big, biglen); |
3202
|
5104836
|
100
|
|
|
|
little_p = SvPV_const(little, llen); |
3203
|
|
|
|
|
|
|
3204
|
5104836
|
100
|
|
|
|
big_utf8 = DO_UTF8(big); |
|
|
100
|
|
|
|
|
3205
|
5104836
|
100
|
|
|
|
little_utf8 = DO_UTF8(little); |
|
|
50
|
|
|
|
|
3206
|
5104836
|
100
|
|
|
|
if (big_utf8 ^ little_utf8) { |
3207
|
|
|
|
|
|
/* One needs to be upgraded. */ |
3208
|
52266
|
100
|
|
|
|
if (little_utf8 && !PL_encoding) { |
|
|
50
|
|
|
|
|
3209
|
|
|
|
|
|
/* Well, maybe instead we might be able to downgrade the small |
3210
|
|
|
|
|
|
string? */ |
3211
|
44
|
|
|
|
|
char * const pv = (char*)bytes_from_utf8((U8 *)little_p, &llen, |
3212
|
|
|
|
|
|
&little_utf8); |
3213
|
44
|
50
|
|
|
|
if (little_utf8) { |
3214
|
|
|
|
|
|
/* If the large string is ISO-8859-1, and it's not possible to |
3215
|
|
|
|
|
|
convert the small string to ISO-8859-1, then there is no |
3216
|
|
|
|
|
|
way that it could be found anywhere by index. */ |
3217
|
0
|
|
|
|
|
retval = -1; |
3218
|
0
|
|
|
|
|
goto fail; |
3219
|
|
|
|
|
|
} |
3220
|
|
|
|
|
|
|
3221
|
|
|
|
|
|
/* At this point, pv is a malloc()ed string. So donate it to temp |
3222
|
|
|
|
|
|
to ensure it will get free()d */ |
3223
|
44
|
|
|
|
|
little = temp = newSV(0); |
3224
|
44
|
|
|
|
|
sv_usepvn(temp, pv, llen); |
3225
|
44
|
|
|
|
|
little_p = SvPVX(little); |
3226
|
|
|
|
|
|
} else { |
3227
|
|
|
|
|
|
temp = little_utf8 |
3228
|
52178
|
50
|
|
|
|
? newSVpvn(big_p, biglen) : newSVpvn(little_p, llen); |
3229
|
|
|
|
|
|
|
3230
|
52178
|
100
|
|
|
|
if (PL_encoding) { |
3231
|
1710
|
|
|
|
|
sv_recode_to_utf8(temp, PL_encoding); |
3232
|
|
|
|
|
|
} else { |
3233
|
50468
|
|
|
|
|
sv_utf8_upgrade(temp); |
3234
|
|
|
|
|
|
} |
3235
|
52178
|
50
|
|
|
|
if (little_utf8) { |
3236
|
|
|
|
|
|
big = temp; |
3237
|
|
|
|
|
|
big_utf8 = TRUE; |
3238
|
0
|
0
|
|
|
|
big_p = SvPV_const(big, biglen); |
3239
|
|
|
|
|
|
} else { |
3240
|
|
|
|
|
|
little = temp; |
3241
|
52178
|
50
|
|
|
|
little_p = SvPV_const(little, llen); |
3242
|
|
|
|
|
|
} |
3243
|
|
|
|
|
|
} |
3244
|
|
|
|
|
|
} |
3245
|
5104836
|
100
|
|
|
|
if (SvGAMAGIC(big)) { |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
3246
|
|
|
|
|
|
/* Life just becomes a lot easier if I use a temporary here. |
3247
|
|
|
|
|
|
Otherwise I need to avoid calls to sv_pos_u2b(), which (dangerously) |
3248
|
|
|
|
|
|
will trigger magic and overloading again, as will fbm_instr() |
3249
|
|
|
|
|
|
*/ |
3250
|
529992
|
100
|
|
|
|
big = newSVpvn_flags(big_p, biglen, |
3251
|
|
|
|
|
|
SVs_TEMP | (big_utf8 ? SVf_UTF8 : 0)); |
3252
|
529992
|
|
|
|
|
big_p = SvPVX(big); |
3253
|
|
|
|
|
|
} |
3254
|
5104836
|
100
|
|
|
|
if (SvGAMAGIC(little) || (is_index && !SvOK(little))) { |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
3255
|
|
|
|
|
|
/* index && SvOK() is a hack. fbm_instr() calls SvPV_const, which will |
3256
|
|
|
|
|
|
warn on undef, and we've already triggered a warning with the |
3257
|
|
|
|
|
|
SvPV_const some lines above. We can't remove that, as we need to |
3258
|
|
|
|
|
|
call some SvPV to trigger overloading early and find out if the |
3259
|
|
|
|
|
|
string is UTF-8. |
3260
|
|
|
|
|
|
This is all getting to messy. The API isn't quite clean enough, |
3261
|
|
|
|
|
|
because data access has side effects. |
3262
|
|
|
|
|
|
*/ |
3263
|
13324
|
100
|
|
|
|
little = newSVpvn_flags(little_p, llen, |
3264
|
|
|
|
|
|
SVs_TEMP | (little_utf8 ? SVf_UTF8 : 0)); |
3265
|
13324
|
|
|
|
|
little_p = SvPVX(little); |
3266
|
|
|
|
|
|
} |
3267
|
|
|
|
|
|
|
3268
|
5104836
|
100
|
|
|
|
if (!threeargs) |
3269
|
1955188
|
100
|
|
|
|
offset = is_index ? 0 : biglen; |
3270
|
|
|
|
|
|
else { |
3271
|
3149648
|
100
|
|
|
|
if (big_utf8 && offset > 0) |
|
|
50
|
|
|
|
|
3272
|
58
|
|
|
|
|
sv_pos_u2b(big, &offset, 0); |
3273
|
3149648
|
100
|
|
|
|
if (!is_index) |
3274
|
1794
|
|
|
|
|
offset += llen; |
3275
|
|
|
|
|
|
} |
3276
|
5104836
|
100
|
|
|
|
if (offset < 0) |
3277
|
6
|
|
|
|
|
offset = 0; |
3278
|
5104830
|
100
|
|
|
|
else if (offset > (I32)biglen) |
3279
|
14
|
|
|
|
|
offset = biglen; |
3280
|
7657074
|
100
|
|
|
|
if (!(little_p = is_index |
|
|
100
|
|
|
|
|
3281
|
5101772
|
|
|
|
|
? fbm_instr((unsigned char*)big_p + offset, |
3282
|
|
|
|
|
|
(unsigned char*)big_p + biglen, little, 0) |
3283
|
3064
|
|
|
|
|
: rninstr(big_p, big_p + offset, |
3284
|
|
|
|
|
|
little_p, little_p + llen))) |
3285
|
1734156
|
|
|
|
|
retval = -1; |
3286
|
|
|
|
|
|
else { |
3287
|
3370680
|
|
|
|
|
retval = little_p - big_p; |
3288
|
3370680
|
100
|
|
|
|
if (retval > 0 && big_utf8) |
|
|
100
|
|
|
|
|
3289
|
254
|
|
|
|
|
sv_pos_b2u(big, &retval); |
3290
|
|
|
|
|
|
} |
3291
|
5104836
|
|
|
|
|
SvREFCNT_dec(temp); |
3292
|
|
|
|
|
|
fail: |
3293
|
5104836
|
50
|
|
|
|
PUSHi(retval); |
3294
|
5104836
|
|
|
|
|
RETURN; |
3295
|
|
|
|
|
|
} |
3296
|
|
|
|
|
|
|
3297
|
4517283
|
|
|
|
|
PP(pp_sprintf) |
3298
|
|
|
|
|
|
{ |
3299
|
4517283
|
|
|
|
|
dVAR; dSP; dMARK; dORIGMARK; dTARGET; |
3300
|
4517283
|
100
|
|
|
|
SvTAINTED_off(TARG); |
3301
|
4517283
|
|
|
|
|
do_sprintf(TARG, SP-MARK, MARK+1); |
3302
|
4517257
|
100
|
|
|
|
TAINT_IF(SvTAINTED(TARG)); |
|
|
50
|
|
|
|
|
3303
|
4517257
|
|
|
|
|
SP = ORIGMARK; |
3304
|
4517257
|
100
|
|
|
|
PUSHTARG; |
3305
|
4517257
|
|
|
|
|
RETURN; |
3306
|
|
|
|
|
|
} |
3307
|
|
|
|
|
|
|
3308
|
14464826
|
|
|
|
|
PP(pp_ord) |
3309
|
|
|
|
|
|
{ |
3310
|
14464826
|
|
|
|
|
dVAR; dSP; dTARGET; |
3311
|
|
|
|
|
|
|
3312
|
14464826
|
|
|
|
|
SV *argsv = POPs; |
3313
|
|
|
|
|
|
STRLEN len; |
3314
|
14464826
|
100
|
|
|
|
const U8 *s = (U8*)SvPV_const(argsv, len); |
3315
|
|
|
|
|
|
|
3316
|
14464826
|
100
|
|
|
|
if (PL_encoding && SvPOK(argsv) && !DO_UTF8(argsv)) { |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
3317
|
96644
|
|
|
|
|
SV * const tmpsv = sv_2mortal(newSVsv(argsv)); |
3318
|
96644
|
|
|
|
|
s = (U8*)sv_recode_to_utf8(tmpsv, PL_encoding); |
3319
|
|
|
|
|
|
argsv = tmpsv; |
3320
|
|
|
|
|
|
} |
3321
|
|
|
|
|
|
|
3322
|
14464826
|
100
|
|
|
|
XPUSHu(DO_UTF8(argsv) |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
3323
|
|
|
|
|
|
? utf8n_to_uvchr(s, UTF8_MAXBYTES, 0, UTF8_ALLOW_ANYUV) |
3324
|
|
|
|
|
|
: (UV)(*s & 0xff)); |
3325
|
|
|
|
|
|
|
3326
|
14464826
|
|
|
|
|
RETURN; |
3327
|
|
|
|
|
|
} |
3328
|
|
|
|
|
|
|
3329
|
6049936
|
|
|
|
|
PP(pp_chr) |
3330
|
12099870
|
100
|
|
|
|
{ |
|
|
100
|
|
|
|
|
3331
|
6049936
|
|
|
|
|
dVAR; dSP; dTARGET; |
3332
|
|
|
|
|
|
char *tmps; |
3333
|
|
|
|
|
|
UV value; |
3334
|
6049936
|
|
|
|
|
SV *top = POPs; |
3335
|
|
|
|
|
|
|
3336
|
2960904
|
|
|
|
|
SvGETMAGIC(top); |
3337
|
17302402
|
100
|
|
|
|
if (!IN_BYTES /* under bytes, chr(-1) eq chr(0xff), etc. */ |
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
3338
|
11282146
|
100
|
|
|
|
&& ((SvIOKp(top) && !SvIsUV(top) && SvIV_nomg(top) < 0) |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
0
|
|
|
|
|
3339
|
5696824
|
100
|
|
|
|
|| |
3340
|
8379626
|
100
|
|
|
|
((SvNOKp(top) || (SvOK(top) && !SvIsUV(top))) |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
3341
|
5717929
|
100
|
|
|
|
&& SvNV_nomg(top) < 0.0))) { |
|
|
100
|
|
|
|
|
3342
|
44
|
100
|
|
|
|
if (ckWARN(WARN_UTF8)) { |
3343
|
4
|
50
|
|
|
|
if (SvGMAGICAL(top)) { |
3344
|
0
|
|
|
|
|
SV *top2 = sv_newmortal(); |
3345
|
0
|
|
|
|
|
sv_setsv_nomg(top2, top); |
3346
|
|
|
|
|
|
top = top2; |
3347
|
|
|
|
|
|
} |
3348
|
4
|
|
|
|
|
Perl_warner(aTHX_ packWARN(WARN_UTF8), |
3349
|
|
|
|
|
|
"Invalid negative number (%"SVf") in chr", top); |
3350
|
|
|
|
|
|
} |
3351
|
|
|
|
|
|
value = UNICODE_REPLACEMENT; |
3352
|
|
|
|
|
|
} else { |
3353
|
6049892
|
100
|
|
|
|
value = SvUV_nomg(top); |
3354
|
|
|
|
|
|
} |
3355
|
|
|
|
|
|
|
3356
|
2974151
|
|
|
|
|
SvUPGRADE(TARG,SVt_PV); |
3357
|
|
|
|
|
|
|
3358
|
6049934
|
100
|
|
|
|
if (value > 255 && !IN_BYTES) { |
|
|
100
|
|
|
|
|
3359
|
1129056
|
100
|
|
|
|
SvGROW(TARG, (STRLEN)UNISKIP(value)+1); |
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
3360
|
1129056
|
|
|
|
|
tmps = (char*)uvchr_to_utf8_flags((U8*)SvPVX(TARG), value, 0); |
3361
|
1129056
|
|
|
|
|
SvCUR_set(TARG, tmps - SvPVX_const(TARG)); |
3362
|
1129056
|
|
|
|
|
*tmps = '\0'; |
3363
|
1129056
|
|
|
|
|
(void)SvPOK_only(TARG); |
3364
|
1129056
|
|
|
|
|
SvUTF8_on(TARG); |
3365
|
1129056
|
50
|
|
|
|
XPUSHs(TARG); |
3366
|
1129056
|
|
|
|
|
RETURN; |
3367
|
|
|
|
|
|
} |
3368
|
|
|
|
|
|
|
3369
|
4920878
|
100
|
|
|
|
SvGROW(TARG,2); |
|
|
100
|
|
|
|
|
3370
|
4920878
|
|
|
|
|
SvCUR_set(TARG, 1); |
3371
|
4920878
|
|
|
|
|
tmps = SvPVX(TARG); |
3372
|
4920878
|
|
|
|
|
*tmps++ = (char)value; |
3373
|
4920878
|
|
|
|
|
*tmps = '\0'; |
3374
|
4920878
|
|
|
|
|
(void)SvPOK_only(TARG); |
3375
|
|
|
|
|
|
|
3376
|
4920878
|
100
|
|
|
|
if (PL_encoding && !IN_BYTES) { |
|
|
50
|
|
|
|
|
3377
|
2772
|
|
|
|
|
sv_recode_to_utf8(TARG, PL_encoding); |
3378
|
2772
|
|
|
|
|
tmps = SvPVX(TARG); |
3379
|
2772
|
50
|
|
|
|
if (SvCUR(TARG) == 0 |
3380
|
2772
|
50
|
|
|
|
|| ! is_utf8_string((U8*)tmps, SvCUR(TARG)) |
3381
|
2772
|
100
|
|
|
|
|| UTF8_IS_REPLACEMENT((U8*) tmps, (U8*) tmps + SvCUR(TARG))) |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
3382
|
|
|
|
|
|
{ |
3383
|
66
|
50
|
|
|
|
SvGROW(TARG, 2); |
|
|
50
|
|
|
|
|
3384
|
66
|
|
|
|
|
tmps = SvPVX(TARG); |
3385
|
66
|
|
|
|
|
SvCUR_set(TARG, 1); |
3386
|
66
|
|
|
|
|
*tmps++ = (char)value; |
3387
|
66
|
|
|
|
|
*tmps = '\0'; |
3388
|
66
|
|
|
|
|
SvUTF8_off(TARG); |
3389
|
|
|
|
|
|
} |
3390
|
|
|
|
|
|
} |
3391
|
|
|
|
|
|
|
3392
|
4920878
|
50
|
|
|
|
XPUSHs(TARG); |
3393
|
5512766
|
|
|
|
|
RETURN; |
3394
|
|
|
|
|
|
} |
3395
|
|
|
|
|
|
|
3396
|
16
|
|
|
|
|
PP(pp_crypt) |
3397
|
|
|
|
|
|
{ |
3398
|
|
|
|
|
|
#ifdef HAS_CRYPT |
3399
|
16
|
|
|
|
|
dVAR; dSP; dTARGET; |
3400
|
16
|
|
|
|
|
dPOPTOPssrl; |
3401
|
|
|
|
|
|
STRLEN len; |
3402
|
16
|
100
|
|
|
|
const char *tmps = SvPV_const(left, len); |
3403
|
|
|
|
|
|
|
3404
|
16
|
100
|
|
|
|
if (DO_UTF8(left)) { |
|
|
50
|
|
|
|
|
3405
|
|
|
|
|
|
/* If Unicode, try to downgrade. |
3406
|
|
|
|
|
|
* If not possible, croak. |
3407
|
|
|
|
|
|
* Yes, we made this up. */ |
3408
|
4
|
|
|
|
|
SV* const tsv = sv_2mortal(newSVsv(left)); |
3409
|
|
|
|
|
|
|
3410
|
4
|
|
|
|
|
SvUTF8_on(tsv); |
3411
|
4
|
|
|
|
|
sv_utf8_downgrade(tsv, FALSE); |
3412
|
2
|
50
|
|
|
|
tmps = SvPV_const(tsv, len); |
3413
|
|
|
|
|
|
} |
3414
|
|
|
|
|
|
# ifdef USE_ITHREADS |
3415
|
|
|
|
|
|
# ifdef HAS_CRYPT_R |
3416
|
|
|
|
|
|
if (!PL_reentrant_buffer->_crypt_struct_buffer) { |
3417
|
|
|
|
|
|
/* This should be threadsafe because in ithreads there is only |
3418
|
|
|
|
|
|
* one thread per interpreter. If this would not be true, |
3419
|
|
|
|
|
|
* we would need a mutex to protect this malloc. */ |
3420
|
|
|
|
|
|
PL_reentrant_buffer->_crypt_struct_buffer = |
3421
|
|
|
|
|
|
(struct crypt_data *)safemalloc(sizeof(struct crypt_data)); |
3422
|
|
|
|
|
|
#if defined(__GLIBC__) || defined(__EMX__) |
3423
|
|
|
|
|
|
if (PL_reentrant_buffer->_crypt_struct_buffer) { |
3424
|
|
|
|
|
|
PL_reentrant_buffer->_crypt_struct_buffer->initialized = 0; |
3425
|
|
|
|
|
|
/* work around glibc-2.2.5 bug */ |
3426
|
|
|
|
|
|
PL_reentrant_buffer->_crypt_struct_buffer->current_saltbits = 0; |
3427
|
|
|
|
|
|
} |
3428
|
|
|
|
|
|
#endif |
3429
|
|
|
|
|
|
} |
3430
|
|
|
|
|
|
# endif /* HAS_CRYPT_R */ |
3431
|
|
|
|
|
|
# endif /* USE_ITHREADS */ |
3432
|
|
|
|
|
|
# ifdef FCRYPT |
3433
|
|
|
|
|
|
sv_setpv(TARG, fcrypt(tmps, SvPV_nolen_const(right))); |
3434
|
|
|
|
|
|
# else |
3435
|
14
|
100
|
|
|
|
sv_setpv(TARG, PerlProc_crypt(tmps, SvPV_nolen_const(right))); |
3436
|
|
|
|
|
|
# endif |
3437
|
14
|
50
|
|
|
|
SETTARG; |
3438
|
14
|
|
|
|
|
RETURN; |
3439
|
|
|
|
|
|
#else |
3440
|
|
|
|
|
|
DIE(aTHX_ |
3441
|
|
|
|
|
|
"The crypt() function is unimplemented due to excessive paranoia."); |
3442
|
|
|
|
|
|
#endif |
3443
|
|
|
|
|
|
} |
3444
|
|
|
|
|
|
|
3445
|
|
|
|
|
|
/* Generally UTF-8 and UTF-EBCDIC are indistinguishable at this level. So |
3446
|
|
|
|
|
|
* most comments below say UTF-8, when in fact they mean UTF-EBCDIC as well */ |
3447
|
|
|
|
|
|
|
3448
|
403454
|
|
|
|
|
PP(pp_ucfirst) |
3449
|
403454
|
100
|
|
|
|
{ |
3450
|
|
|
|
|
|
/* Actually is both lcfirst() and ucfirst(). Only the first character |
3451
|
|
|
|
|
|
* changes. This means that possibly we can change in-place, ie., just |
3452
|
|
|
|
|
|
* take the source and change that one character and store it back, but not |
3453
|
|
|
|
|
|
* if read-only etc, or if the length changes */ |
3454
|
|
|
|
|
|
|
3455
|
|
|
|
|
|
dVAR; |
3456
|
403454
|
|
|
|
|
dSP; |
3457
|
403454
|
|
|
|
|
SV *source = TOPs; |
3458
|
|
|
|
|
|
STRLEN slen; /* slen is the byte length of the whole SV. */ |
3459
|
|
|
|
|
|
STRLEN need; |
3460
|
|
|
|
|
|
SV *dest; |
3461
|
|
|
|
|
|
bool inplace; /* ? Convert first char only, in-place */ |
3462
|
|
|
|
|
|
bool doing_utf8 = FALSE; /* ? using utf8 */ |
3463
|
|
|
|
|
|
bool convert_source_to_utf8 = FALSE; /* ? need to convert */ |
3464
|
403454
|
|
|
|
|
const int op_type = PL_op->op_type; |
3465
|
|
|
|
|
|
const U8 *s; |
3466
|
|
|
|
|
|
U8 *d; |
3467
|
|
|
|
|
|
U8 tmpbuf[UTF8_MAXBYTES_CASE+1]; |
3468
|
|
|
|
|
|
STRLEN ulen; /* ulen is the byte length of the original Unicode character |
3469
|
|
|
|
|
|
* stored as UTF-8 at s. */ |
3470
|
|
|
|
|
|
STRLEN tculen; /* tculen is the byte length of the freshly titlecased (or |
3471
|
|
|
|
|
|
* lowercased) character stored in tmpbuf. May be either |
3472
|
|
|
|
|
|
* UTF-8 or not, but in either case is the number of bytes */ |
3473
|
403454
|
|
|
|
|
bool tainted = FALSE; |
3474
|
|
|
|
|
|
|
3475
|
259193
|
|
|
|
|
SvGETMAGIC(source); |
3476
|
403454
|
100
|
|
|
|
if (SvOK(source)) { |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
3477
|
403442
|
100
|
|
|
|
s = (const U8*)SvPV_nomg_const(source, slen); |
3478
|
|
|
|
|
|
} else { |
3479
|
12
|
100
|
|
|
|
if (ckWARN(WARN_UNINITIALIZED)) |
3480
|
8
|
|
|
|
|
report_uninit(source); |
3481
|
|
|
|
|
|
s = (const U8*)""; |
3482
|
12
|
|
|
|
|
slen = 0; |
3483
|
|
|
|
|
|
} |
3484
|
|
|
|
|
|
|
3485
|
|
|
|
|
|
/* We may be able to get away with changing only the first character, in |
3486
|
|
|
|
|
|
* place, but not if read-only, etc. Later we may discover more reasons to |
3487
|
|
|
|
|
|
* not convert in-place. */ |
3488
|
403454
|
|
|
|
|
inplace = SvPADTMP(source) && !SvREADONLY(source) && SvTEMP(source); |
3489
|
|
|
|
|
|
|
3490
|
|
|
|
|
|
/* First calculate what the changed first character should be. This affects |
3491
|
|
|
|
|
|
* whether we can just swap it out, leaving the rest of the string unchanged, |
3492
|
|
|
|
|
|
* or even if have to convert the dest to UTF-8 when the source isn't */ |
3493
|
|
|
|
|
|
|
3494
|
403454
|
100
|
|
|
|
if (! slen) { /* If empty */ |
3495
|
|
|
|
|
|
need = 1; /* still need a trailing NUL */ |
3496
|
|
|
|
|
|
ulen = 0; |
3497
|
|
|
|
|
|
} |
3498
|
397298
|
100
|
|
|
|
else if (DO_UTF8(source)) { /* Is the source utf8? */ |
|
|
100
|
|
|
|
|
3499
|
|
|
|
|
|
doing_utf8 = TRUE; |
3500
|
18778
|
|
|
|
|
ulen = UTF8SKIP(s); |
3501
|
18778
|
100
|
|
|
|
if (op_type == OP_UCFIRST) { |
3502
|
9650
|
|
|
|
|
_to_utf8_title_flags(s, tmpbuf, &tculen, |
3503
|
|
|
|
|
|
cBOOL(IN_LOCALE_RUNTIME), &tainted); |
3504
|
|
|
|
|
|
} |
3505
|
|
|
|
|
|
else { |
3506
|
9128
|
|
|
|
|
_to_utf8_lower_flags(s, tmpbuf, &tculen, |
3507
|
|
|
|
|
|
cBOOL(IN_LOCALE_RUNTIME), &tainted); |
3508
|
|
|
|
|
|
} |
3509
|
|
|
|
|
|
|
3510
|
|
|
|
|
|
/* we can't do in-place if the length changes. */ |
3511
|
18772
|
100
|
|
|
|
if (ulen != tculen) inplace = FALSE; |
3512
|
18772
|
|
|
|
|
need = slen + 1 - ulen + tculen; |
3513
|
|
|
|
|
|
} |
3514
|
|
|
|
|
|
else { /* Non-zero length, non-UTF-8, Need to consider locale and if |
3515
|
|
|
|
|
|
* latin1 is treated as caseless. Note that a locale takes |
3516
|
|
|
|
|
|
* precedence */ |
3517
|
|
|
|
|
|
ulen = 1; /* Original character is 1 byte */ |
3518
|
378520
|
|
|
|
|
tculen = 1; /* Most characters will require one byte, but this will |
3519
|
|
|
|
|
|
* need to be overridden for the tricky ones */ |
3520
|
378520
|
|
|
|
|
need = slen + 1; |
3521
|
|
|
|
|
|
|
3522
|
378520
|
100
|
|
|
|
if (op_type == OP_LCFIRST) { |
3523
|
|
|
|
|
|
|
3524
|
|
|
|
|
|
/* lower case the first letter: no trickiness for any character */ |
3525
|
7086
|
100
|
|
|
|
*tmpbuf = (IN_LOCALE_RUNTIME) ? toLOWER_LC(*s) : |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
3526
|
4023
|
100
|
|
|
|
((IN_UNI_8_BIT) ? toLOWER_LATIN1(*s) : toLOWER(*s)); |
3527
|
|
|
|
|
|
} |
3528
|
|
|
|
|
|
/* is ucfirst() */ |
3529
|
375456
|
100
|
|
|
|
else if (IN_LOCALE_RUNTIME) { |
3530
|
6
|
|
|
|
|
*tmpbuf = toUPPER_LC(*s); /* This would be a bug if any locales |
3531
|
|
|
|
|
|
* have upper and title case different |
3532
|
|
|
|
|
|
*/ |
3533
|
|
|
|
|
|
} |
3534
|
375450
|
100
|
|
|
|
else if (! IN_UNI_8_BIT) { |
|
|
100
|
|
|
|
|
3535
|
373914
|
100
|
|
|
|
*tmpbuf = toUPPER(*s); /* Returns caseless for non-ascii, or |
3536
|
|
|
|
|
|
* on EBCDIC machines whatever the |
3537
|
|
|
|
|
|
* native function does */ |
3538
|
|
|
|
|
|
} |
3539
|
|
|
|
|
|
else { /* is ucfirst non-UTF-8, not in locale, and cased latin1 */ |
3540
|
1536
|
|
|
|
|
UV title_ord = _to_upper_title_latin1(*s, tmpbuf, &tculen, 's'); |
3541
|
1536
|
100
|
|
|
|
if (tculen > 1) { |
3542
|
|
|
|
|
|
assert(tculen == 2); |
3543
|
|
|
|
|
|
|
3544
|
|
|
|
|
|
/* If the result is an upper Latin1-range character, it can |
3545
|
|
|
|
|
|
* still be represented in one byte, which is its ordinal */ |
3546
|
768
|
100
|
|
|
|
if (UTF8_IS_DOWNGRADEABLE_START(*tmpbuf)) { |
3547
|
750
|
|
|
|
|
*tmpbuf = (U8) title_ord; |
3548
|
750
|
|
|
|
|
tculen = 1; |
3549
|
|
|
|
|
|
} |
3550
|
|
|
|
|
|
else { |
3551
|
|
|
|
|
|
/* Otherwise it became more than one ASCII character (in |
3552
|
|
|
|
|
|
* the case of LATIN_SMALL_LETTER_SHARP_S) or changed to |
3553
|
|
|
|
|
|
* beyond Latin1, so the number of bytes changed, so can't |
3554
|
|
|
|
|
|
* replace just the first character in place. */ |
3555
|
|
|
|
|
|
inplace = FALSE; |
3556
|
|
|
|
|
|
|
3557
|
|
|
|
|
|
/* If the result won't fit in a byte, the entire result |
3558
|
|
|
|
|
|
* will have to be in UTF-8. Assume worst case sizing in |
3559
|
|
|
|
|
|
* conversion. (all latin1 characters occupy at most two |
3560
|
|
|
|
|
|
* bytes in utf8) */ |
3561
|
18
|
100
|
|
|
|
if (title_ord > 255) { |
3562
|
|
|
|
|
|
doing_utf8 = TRUE; |
3563
|
|
|
|
|
|
convert_source_to_utf8 = TRUE; |
3564
|
12
|
|
|
|
|
need = slen * 2 + 1; |
3565
|
|
|
|
|
|
|
3566
|
|
|
|
|
|
/* The (converted) UTF-8 and UTF-EBCDIC lengths of all |
3567
|
|
|
|
|
|
* (both) characters whose title case is above 255 is |
3568
|
|
|
|
|
|
* 2. */ |
3569
|
|
|
|
|
|
ulen = 2; |
3570
|
|
|
|
|
|
} |
3571
|
|
|
|
|
|
else { /* LATIN_SMALL_LETTER_SHARP_S expands by 1 byte */ |
3572
|
6
|
|
|
|
|
need = slen + 1 + 1; |
3573
|
|
|
|
|
|
} |
3574
|
|
|
|
|
|
} |
3575
|
|
|
|
|
|
} |
3576
|
|
|
|
|
|
} /* End of use Unicode (Latin1) semantics */ |
3577
|
|
|
|
|
|
} /* End of changing the case of the first character */ |
3578
|
|
|
|
|
|
|
3579
|
|
|
|
|
|
/* Here, have the first character's changed case stored in tmpbuf. Ready to |
3580
|
|
|
|
|
|
* generate the result */ |
3581
|
403448
|
50
|
|
|
|
if (inplace) { |
3582
|
|
|
|
|
|
|
3583
|
|
|
|
|
|
/* We can convert in place. This means we change just the first |
3584
|
|
|
|
|
|
* character without disturbing the rest; no need to grow */ |
3585
|
|
|
|
|
|
dest = source; |
3586
|
0
|
0
|
|
|
|
s = d = (U8*)SvPV_force_nomg(source, slen); |
3587
|
403448
|
100
|
|
|
|
} else { |
3588
|
403448
|
|
|
|
|
dTARGET; |
3589
|
|
|
|
|
|
|
3590
|
|
|
|
|
|
dest = TARG; |
3591
|
|
|
|
|
|
|
3592
|
|
|
|
|
|
/* Here, we can't convert in place; we earlier calculated how much |
3593
|
|
|
|
|
|
* space we will need, so grow to accommodate that */ |
3594
|
202010
|
|
|
|
|
SvUPGRADE(dest, SVt_PV); |
3595
|
403448
|
100
|
|
|
|
d = (U8*)SvGROW(dest, need); |
|
|
100
|
|
|
|
|
3596
|
403448
|
|
|
|
|
(void)SvPOK_only(dest); |
3597
|
|
|
|
|
|
|
3598
|
403448
|
|
|
|
|
SETs(dest); |
3599
|
|
|
|
|
|
} |
3600
|
|
|
|
|
|
|
3601
|
403448
|
100
|
|
|
|
if (doing_utf8) { |
3602
|
18784
|
50
|
|
|
|
if (! inplace) { |
3603
|
18784
|
100
|
|
|
|
if (! convert_source_to_utf8) { |
3604
|
|
|
|
|
|
|
3605
|
|
|
|
|
|
/* Here both source and dest are in UTF-8, but have to create |
3606
|
|
|
|
|
|
* the entire output. We initialize the result to be the |
3607
|
|
|
|
|
|
* title/lower cased first character, and then append the rest |
3608
|
|
|
|
|
|
* of the string. */ |
3609
|
18772
|
|
|
|
|
sv_setpvn(dest, (char*)tmpbuf, tculen); |
3610
|
18772
|
100
|
|
|
|
if (slen > ulen) { |
3611
|
9880
|
|
|
|
|
sv_catpvn(dest, (char*)(s + ulen), slen - ulen); |
3612
|
|
|
|
|
|
} |
3613
|
|
|
|
|
|
} |
3614
|
|
|
|
|
|
else { |
3615
|
12
|
|
|
|
|
const U8 *const send = s + slen; |
3616
|
|
|
|
|
|
|
3617
|
|
|
|
|
|
/* Here the dest needs to be in UTF-8, but the source isn't, |
3618
|
|
|
|
|
|
* except we earlier UTF-8'd the first character of the source |
3619
|
|
|
|
|
|
* into tmpbuf. First put that into dest, and then append the |
3620
|
|
|
|
|
|
* rest of the source, converting it to UTF-8 as we go. */ |
3621
|
|
|
|
|
|
|
3622
|
|
|
|
|
|
/* Assert tculen is 2 here because the only two characters that |
3623
|
|
|
|
|
|
* get to this part of the code have 2-byte UTF-8 equivalents */ |
3624
|
12
|
|
|
|
|
*d++ = *tmpbuf; |
3625
|
12
|
|
|
|
|
*d++ = *(tmpbuf + 1); |
3626
|
12
|
|
|
|
|
s++; /* We have just processed the 1st char */ |
3627
|
|
|
|
|
|
|
3628
|
212
|
100
|
|
|
|
for (; s < send; s++) { |
3629
|
200
|
|
|
|
|
d = uvchr_to_utf8(d, *s); |
3630
|
|
|
|
|
|
} |
3631
|
12
|
|
|
|
|
*d = '\0'; |
3632
|
12
|
|
|
|
|
SvCUR_set(dest, d - (U8*)SvPVX_const(dest)); |
3633
|
|
|
|
|
|
} |
3634
|
18784
|
|
|
|
|
SvUTF8_on(dest); |
3635
|
|
|
|
|
|
} |
3636
|
|
|
|
|
|
else { /* in-place UTF-8. Just overwrite the first character */ |
3637
|
0
|
|
|
|
|
Copy(tmpbuf, d, tculen, U8); |
3638
|
0
|
|
|
|
|
SvCUR_set(dest, need - 1); |
3639
|
|
|
|
|
|
} |
3640
|
|
|
|
|
|
|
3641
|
18784
|
100
|
|
|
|
if (tainted) { |
3642
|
4
|
|
|
|
|
TAINT; |
3643
|
4
|
50
|
|
|
|
SvTAINTED_on(dest); |
3644
|
|
|
|
|
|
} |
3645
|
|
|
|
|
|
} |
3646
|
|
|
|
|
|
else { /* Neither source nor dest are in or need to be UTF-8 */ |
3647
|
384664
|
100
|
|
|
|
if (slen) { |
3648
|
378508
|
100
|
|
|
|
if (IN_LOCALE_RUNTIME) { |
3649
|
12
|
|
|
|
|
TAINT; |
3650
|
12
|
50
|
|
|
|
SvTAINTED_on(dest); |
3651
|
|
|
|
|
|
} |
3652
|
378508
|
50
|
|
|
|
if (inplace) { /* in-place, only need to change the 1st char */ |
3653
|
0
|
|
|
|
|
*d = *tmpbuf; |
3654
|
|
|
|
|
|
} |
3655
|
|
|
|
|
|
else { /* Not in-place */ |
3656
|
|
|
|
|
|
|
3657
|
|
|
|
|
|
/* Copy the case-changed character(s) from tmpbuf */ |
3658
|
378508
|
|
|
|
|
Copy(tmpbuf, d, tculen, U8); |
3659
|
378508
|
|
|
|
|
d += tculen - 1; /* Code below expects d to point to final |
3660
|
|
|
|
|
|
* character stored */ |
3661
|
|
|
|
|
|
} |
3662
|
|
|
|
|
|
} |
3663
|
|
|
|
|
|
else { /* empty source */ |
3664
|
|
|
|
|
|
/* See bug #39028: Don't taint if empty */ |
3665
|
6156
|
|
|
|
|
*d = *s; |
3666
|
|
|
|
|
|
} |
3667
|
|
|
|
|
|
|
3668
|
|
|
|
|
|
/* In a "use bytes" we don't treat the source as UTF-8, but, still want |
3669
|
|
|
|
|
|
* the destination to retain that flag */ |
3670
|
384664
|
100
|
|
|
|
if (SvUTF8(source) && ! IN_BYTES) |
|
|
100
|
|
|
|
|
3671
|
4
|
|
|
|
|
SvUTF8_on(dest); |
3672
|
|
|
|
|
|
|
3673
|
384664
|
50
|
|
|
|
if (!inplace) { /* Finish the rest of the string, unchanged */ |
3674
|
|
|
|
|
|
/* This will copy the trailing NUL */ |
3675
|
384664
|
|
|
|
|
Copy(s + 1, d + 1, slen, U8); |
3676
|
384664
|
|
|
|
|
SvCUR_set(dest, need - 1); |
3677
|
|
|
|
|
|
} |
3678
|
|
|
|
|
|
} |
3679
|
403448
|
50
|
|
|
|
if (dest != source && SvTAINTED(source)) |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
3680
|
0
|
0
|
|
|
|
SvTAINT(dest); |
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
3681
|
403448
|
100
|
|
|
|
SvSETMAGIC(dest); |
3682
|
403448
|
|
|
|
|
RETURN; |
3683
|
|
|
|
|
|
} |
3684
|
|
|
|
|
|
|
3685
|
|
|
|
|
|
/* There's so much setup/teardown code common between uc and lc, I wonder if |
3686
|
|
|
|
|
|
it would be worth merging the two, and just having a switch outside each |
3687
|
|
|
|
|
|
of the three tight loops. There is less and less commonality though */ |
3688
|
481026
|
|
|
|
|
PP(pp_uc) |
3689
|
481026
|
100
|
|
|
|
{ |
3690
|
|
|
|
|
|
dVAR; |
3691
|
481026
|
|
|
|
|
dSP; |
3692
|
481026
|
|
|
|
|
SV *source = TOPs; |
3693
|
|
|
|
|
|
STRLEN len; |
3694
|
|
|
|
|
|
STRLEN min; |
3695
|
|
|
|
|
|
SV *dest; |
3696
|
|
|
|
|
|
const U8 *s; |
3697
|
|
|
|
|
|
U8 *d; |
3698
|
|
|
|
|
|
|
3699
|
237507
|
|
|
|
|
SvGETMAGIC(source); |
3700
|
|
|
|
|
|
|
3701
|
481026
|
100
|
|
|
|
if (SvPADTMP(source) && !SvREADONLY(source) && !SvAMAGIC(source) |
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
3702
|
36778
|
50
|
|
|
|
&& SvTEMP(source) && !DO_UTF8(source) |
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
3703
|
0
|
0
|
|
|
|
&& (IN_LOCALE_RUNTIME || ! IN_UNI_8_BIT)) { |
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
3704
|
|
|
|
|
|
|
3705
|
|
|
|
|
|
/* We can convert in place. The reason we can't if in UNI_8_BIT is to |
3706
|
|
|
|
|
|
* make the loop tight, so we overwrite the source with the dest before |
3707
|
|
|
|
|
|
* looking at it, and we need to look at the original source |
3708
|
|
|
|
|
|
* afterwards. There would also need to be code added to handle |
3709
|
|
|
|
|
|
* switching to not in-place in midstream if we run into characters |
3710
|
|
|
|
|
|
* that change the length. |
3711
|
|
|
|
|
|
*/ |
3712
|
|
|
|
|
|
dest = source; |
3713
|
0
|
0
|
|
|
|
s = d = (U8*)SvPV_force_nomg(source, len); |
3714
|
0
|
|
|
|
|
min = len + 1; |
3715
|
481026
|
100
|
|
|
|
} else { |
3716
|
481026
|
|
|
|
|
dTARGET; |
3717
|
|
|
|
|
|
|
3718
|
|
|
|
|
|
dest = TARG; |
3719
|
|
|
|
|
|
|
3720
|
|
|
|
|
|
/* The old implementation would copy source into TARG at this point. |
3721
|
|
|
|
|
|
This had the side effect that if source was undef, TARG was now |
3722
|
|
|
|
|
|
an undefined SV with PADTMP set, and they don't warn inside |
3723
|
|
|
|
|
|
sv_2pv_flags(). However, we're now getting the PV direct from |
3724
|
|
|
|
|
|
source, which doesn't have PADTMP set, so it would warn. Hence the |
3725
|
|
|
|
|
|
little games. */ |
3726
|
|
|
|
|
|
|
3727
|
481026
|
100
|
|
|
|
if (SvOK(source)) { |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
3728
|
480926
|
100
|
|
|
|
s = (const U8*)SvPV_nomg_const(source, len); |
3729
|
|
|
|
|
|
} else { |
3730
|
100
|
100
|
|
|
|
if (ckWARN(WARN_UNINITIALIZED)) |
3731
|
4
|
|
|
|
|
report_uninit(source); |
3732
|
|
|
|
|
|
s = (const U8*)""; |
3733
|
100
|
|
|
|
|
len = 0; |
3734
|
|
|
|
|
|
} |
3735
|
481026
|
|
|
|
|
min = len + 1; |
3736
|
|
|
|
|
|
|
3737
|
256209
|
|
|
|
|
SvUPGRADE(dest, SVt_PV); |
3738
|
481026
|
100
|
|
|
|
d = (U8*)SvGROW(dest, min); |
|
|
100
|
|
|
|
|
3739
|
481026
|
|
|
|
|
(void)SvPOK_only(dest); |
3740
|
|
|
|
|
|
|
3741
|
481026
|
|
|
|
|
SETs(dest); |
3742
|
|
|
|
|
|
} |
3743
|
|
|
|
|
|
|
3744
|
|
|
|
|
|
/* Overloaded values may have toggled the UTF-8 flag on source, so we need |
3745
|
|
|
|
|
|
to check DO_UTF8 again here. */ |
3746
|
|
|
|
|
|
|
3747
|
481026
|
100
|
|
|
|
if (DO_UTF8(source)) { |
|
|
100
|
|
|
|
|
3748
|
13466
|
|
|
|
|
const U8 *const send = s + len; |
3749
|
|
|
|
|
|
U8 tmpbuf[UTF8_MAXBYTES_CASE+1]; |
3750
|
13466
|
|
|
|
|
bool tainted = FALSE; |
3751
|
|
|
|
|
|
|
3752
|
|
|
|
|
|
/* All occurrences of these are to be moved to follow any other marks. |
3753
|
|
|
|
|
|
* This is context-dependent. We may not be passed enough context to |
3754
|
|
|
|
|
|
* move the iota subscript beyond all of them, but we do the best we can |
3755
|
|
|
|
|
|
* with what we're given. The result is always better than if we |
3756
|
|
|
|
|
|
* hadn't done this. And, the problem would only arise if we are |
3757
|
|
|
|
|
|
* passed a character without all its combining marks, which would be |
3758
|
|
|
|
|
|
* the caller's mistake. The information this is based on comes from a |
3759
|
|
|
|
|
|
* comment in Unicode SpecialCasing.txt, (and the Standard's text |
3760
|
|
|
|
|
|
* itself) and so can't be checked properly to see if it ever gets |
3761
|
|
|
|
|
|
* revised. But the likelihood of it changing is remote */ |
3762
|
|
|
|
|
|
bool in_iota_subscript = FALSE; |
3763
|
|
|
|
|
|
|
3764
|
203405
|
100
|
|
|
|
while (s < send) { |
3765
|
|
|
|
|
|
STRLEN u; |
3766
|
|
|
|
|
|
STRLEN ulen; |
3767
|
|
|
|
|
|
UV uv; |
3768
|
183226
|
100
|
|
|
|
if (in_iota_subscript && ! _is_utf8_mark(s)) { |
|
|
100
|
|
|
|
|
3769
|
|
|
|
|
|
|
3770
|
|
|
|
|
|
/* A non-mark. Time to output the iota subscript */ |
3771
|
12
|
|
|
|
|
Copy(GREEK_CAPITAL_LETTER_IOTA_UTF8, d, capital_iota_len, U8); |
3772
|
12
|
|
|
|
|
d += capital_iota_len; |
3773
|
|
|
|
|
|
in_iota_subscript = FALSE; |
3774
|
|
|
|
|
|
} |
3775
|
|
|
|
|
|
|
3776
|
|
|
|
|
|
/* Then handle the current character. Get the changed case value |
3777
|
|
|
|
|
|
* and copy it to the output buffer */ |
3778
|
|
|
|
|
|
|
3779
|
183226
|
|
|
|
|
u = UTF8SKIP(s); |
3780
|
183226
|
|
|
|
|
uv = _to_utf8_upper_flags(s, tmpbuf, &ulen, |
3781
|
|
|
|
|
|
cBOOL(IN_LOCALE_RUNTIME), &tainted); |
3782
|
|
|
|
|
|
#define GREEK_CAPITAL_LETTER_IOTA 0x0399 |
3783
|
|
|
|
|
|
#define COMBINING_GREEK_YPOGEGRAMMENI 0x0345 |
3784
|
183206
|
100
|
|
|
|
if (uv == GREEK_CAPITAL_LETTER_IOTA |
3785
|
158
|
50
|
|
|
|
&& utf8_to_uvchr_buf(s, send, 0) == COMBINING_GREEK_YPOGEGRAMMENI) |
|
|
100
|
|
|
|
|
3786
|
|
|
|
|
|
{ |
3787
|
|
|
|
|
|
in_iota_subscript = TRUE; |
3788
|
|
|
|
|
|
} |
3789
|
|
|
|
|
|
else { |
3790
|
183168
|
100
|
|
|
|
if (ulen > u && (SvLEN(dest) < (min += ulen - u))) { |
|
|
100
|
|
|
|
|
3791
|
|
|
|
|
|
/* If the eventually required minimum size outgrows the |
3792
|
|
|
|
|
|
* available space, we need to grow. */ |
3793
|
24
|
|
|
|
|
const UV o = d - (U8*)SvPVX_const(dest); |
3794
|
|
|
|
|
|
|
3795
|
|
|
|
|
|
/* If someone uppercases one million U+03B0s we SvGROW() |
3796
|
|
|
|
|
|
* one million times. Or we could try guessing how much to |
3797
|
|
|
|
|
|
* allocate without allocating too much. Such is life. |
3798
|
|
|
|
|
|
* See corresponding comment in lc code for another option |
3799
|
|
|
|
|
|
* */ |
3800
|
24
|
50
|
|
|
|
SvGROW(dest, min); |
|
|
50
|
|
|
|
|
3801
|
24
|
|
|
|
|
d = (U8*)SvPVX(dest) + o; |
3802
|
|
|
|
|
|
} |
3803
|
183168
|
|
|
|
|
Copy(tmpbuf, d, ulen, U8); |
3804
|
183168
|
|
|
|
|
d += ulen; |
3805
|
|
|
|
|
|
} |
3806
|
183206
|
|
|
|
|
s += u; |
3807
|
|
|
|
|
|
} |
3808
|
13446
|
100
|
|
|
|
if (in_iota_subscript) { |
3809
|
26
|
|
|
|
|
Copy(GREEK_CAPITAL_LETTER_IOTA_UTF8, d, capital_iota_len, U8); |
3810
|
26
|
|
|
|
|
d += capital_iota_len; |
3811
|
|
|
|
|
|
} |
3812
|
13446
|
|
|
|
|
SvUTF8_on(dest); |
3813
|
13446
|
|
|
|
|
*d = '\0'; |
3814
|
|
|
|
|
|
|
3815
|
13446
|
|
|
|
|
SvCUR_set(dest, d - (U8*)SvPVX_const(dest)); |
3816
|
13446
|
100
|
|
|
|
if (tainted) { |
3817
|
2
|
|
|
|
|
TAINT; |
3818
|
2
|
50
|
|
|
|
SvTAINTED_on(dest); |
3819
|
|
|
|
|
|
} |
3820
|
|
|
|
|
|
} |
3821
|
|
|
|
|
|
else { /* Not UTF-8 */ |
3822
|
467560
|
100
|
|
|
|
if (len) { |
3823
|
466944
|
|
|
|
|
const U8 *const send = s + len; |
3824
|
|
|
|
|
|
|
3825
|
|
|
|
|
|
/* Use locale casing if in locale; regular style if not treating |
3826
|
|
|
|
|
|
* latin1 as having case; otherwise the latin1 casing. Do the |
3827
|
|
|
|
|
|
* whole thing in a tight loop, for speed, */ |
3828
|
466944
|
100
|
|
|
|
if (IN_LOCALE_RUNTIME) { |
3829
|
6
|
|
|
|
|
TAINT; |
3830
|
6
|
50
|
|
|
|
SvTAINTED_on(dest); |
3831
|
53
|
100
|
|
|
|
for (; s < send; d++, s++) |
3832
|
50
|
|
|
|
|
*d = toUPPER_LC(*s); |
3833
|
|
|
|
|
|
} |
3834
|
466938
|
100
|
|
|
|
else if (! IN_UNI_8_BIT) { |
|
|
100
|
|
|
|
|
3835
|
5444354
|
100
|
|
|
|
for (; s < send; d++, s++) { |
3836
|
5209802
|
100
|
|
|
|
*d = toUPPER(*s); |
3837
|
|
|
|
|
|
} |
3838
|
|
|
|
|
|
} |
3839
|
|
|
|
|
|
else { |
3840
|
160039
|
100
|
|
|
|
for (; s < send; d++, s++) { |
3841
|
157742
|
|
|
|
|
*d = toUPPER_LATIN1_MOD(*s); |
3842
|
157742
|
100
|
|
|
|
if (LIKELY(*d != LATIN_SMALL_LETTER_Y_WITH_DIAERESIS)) { |
3843
|
157684
|
|
|
|
|
continue; |
3844
|
|
|
|
|
|
} |
3845
|
|
|
|
|
|
|
3846
|
|
|
|
|
|
/* The mainstream case is the tight loop above. To avoid |
3847
|
|
|
|
|
|
* extra tests in that, all three characters that require |
3848
|
|
|
|
|
|
* special handling are mapped by the MOD to the one tested |
3849
|
|
|
|
|
|
* just above. |
3850
|
|
|
|
|
|
* Use the source to distinguish between the three cases */ |
3851
|
|
|
|
|
|
|
3852
|
58
|
100
|
|
|
|
if (*s == LATIN_SMALL_LETTER_SHARP_S) { |
3853
|
|
|
|
|
|
|
3854
|
|
|
|
|
|
/* uc() of this requires 2 characters, but they are |
3855
|
|
|
|
|
|
* ASCII. If not enough room, grow the string */ |
3856
|
18
|
50
|
|
|
|
if (SvLEN(dest) < ++min) { |
3857
|
0
|
|
|
|
|
const UV o = d - (U8*)SvPVX_const(dest); |
3858
|
0
|
0
|
|
|
|
SvGROW(dest, min); |
|
|
0
|
|
|
|
|
3859
|
0
|
|
|
|
|
d = (U8*)SvPVX(dest) + o; |
3860
|
|
|
|
|
|
} |
3861
|
18
|
|
|
|
|
*d++ = 'S'; *d = 'S'; /* upper case is 'SS' */ |
3862
|
18
|
|
|
|
|
continue; /* Back to the tight loop; still in ASCII */ |
3863
|
|
|
|
|
|
} |
3864
|
|
|
|
|
|
|
3865
|
|
|
|
|
|
/* The other two special handling characters have their |
3866
|
|
|
|
|
|
* upper cases outside the latin1 range, hence need to be |
3867
|
|
|
|
|
|
* in UTF-8, so the whole result needs to be in UTF-8. So, |
3868
|
|
|
|
|
|
* here we are somewhere in the middle of processing a |
3869
|
|
|
|
|
|
* non-UTF-8 string, and realize that we will have to convert |
3870
|
|
|
|
|
|
* the whole thing to UTF-8. What to do? There are |
3871
|
|
|
|
|
|
* several possibilities. The simplest to code is to |
3872
|
|
|
|
|
|
* convert what we have so far, set a flag, and continue on |
3873
|
|
|
|
|
|
* in the loop. The flag would be tested each time through |
3874
|
|
|
|
|
|
* the loop, and if set, the next character would be |
3875
|
|
|
|
|
|
* converted to UTF-8 and stored. But, I (khw) didn't want |
3876
|
|
|
|
|
|
* to slow down the mainstream case at all for this fairly |
3877
|
|
|
|
|
|
* rare case, so I didn't want to add a test that didn't |
3878
|
|
|
|
|
|
* absolutely have to be there in the loop, besides the |
3879
|
|
|
|
|
|
* possibility that it would get too complicated for |
3880
|
|
|
|
|
|
* optimizers to deal with. Another possibility is to just |
3881
|
|
|
|
|
|
* give up, convert the source to UTF-8, and restart the |
3882
|
|
|
|
|
|
* function that way. Another possibility is to convert |
3883
|
|
|
|
|
|
* both what has already been processed and what is yet to |
3884
|
|
|
|
|
|
* come separately to UTF-8, then jump into the loop that |
3885
|
|
|
|
|
|
* handles UTF-8. But the most efficient time-wise of the |
3886
|
|
|
|
|
|
* ones I could think of is what follows, and turned out to |
3887
|
|
|
|
|
|
* not require much extra code. */ |
3888
|
|
|
|
|
|
|
3889
|
|
|
|
|
|
/* Convert what we have so far into UTF-8, telling the |
3890
|
|
|
|
|
|
* function that we know it should be converted, and to |
3891
|
|
|
|
|
|
* allow extra space for what we haven't processed yet. |
3892
|
|
|
|
|
|
* Assume the worst case space requirements for converting |
3893
|
|
|
|
|
|
* what we haven't processed so far: that it will require |
3894
|
|
|
|
|
|
* two bytes for each remaining source character, plus the |
3895
|
|
|
|
|
|
* NUL at the end. This may cause the string pointer to |
3896
|
|
|
|
|
|
* move, so re-find it. */ |
3897
|
|
|
|
|
|
|
3898
|
40
|
|
|
|
|
len = d - (U8*)SvPVX_const(dest); |
3899
|
40
|
|
|
|
|
SvCUR_set(dest, len); |
3900
|
40
|
|
|
|
|
len = sv_utf8_upgrade_flags_grow(dest, |
3901
|
|
|
|
|
|
SV_GMAGIC|SV_FORCE_UTF8_UPGRADE, |
3902
|
|
|
|
|
|
(send -s) * 2 + 1); |
3903
|
40
|
|
|
|
|
d = (U8*)SvPVX(dest) + len; |
3904
|
|
|
|
|
|
|
3905
|
|
|
|
|
|
/* Now process the remainder of the source, converting to |
3906
|
|
|
|
|
|
* upper and UTF-8. If a resulting byte is invariant in |
3907
|
|
|
|
|
|
* UTF-8, output it as-is, otherwise convert to UTF-8 and |
3908
|
|
|
|
|
|
* append it to the output. */ |
3909
|
680
|
100
|
|
|
|
for (; s < send; s++) { |
3910
|
640
|
|
|
|
|
(void) _to_upper_title_latin1(*s, d, &len, 'S'); |
3911
|
640
|
|
|
|
|
d += len; |
3912
|
|
|
|
|
|
} |
3913
|
|
|
|
|
|
|
3914
|
|
|
|
|
|
/* Here have processed the whole source; no need to continue |
3915
|
|
|
|
|
|
* with the outer loop. Each character has been converted |
3916
|
|
|
|
|
|
* to upper case and converted to UTF-8 */ |
3917
|
|
|
|
|
|
|
3918
|
|
|
|
|
|
break; |
3919
|
|
|
|
|
|
} /* End of processing all latin1-style chars */ |
3920
|
|
|
|
|
|
} /* End of processing all chars */ |
3921
|
|
|
|
|
|
} /* End of source is not empty */ |
3922
|
|
|
|
|
|
|
3923
|
467560
|
50
|
|
|
|
if (source != dest) { |
3924
|
467560
|
|
|
|
|
*d = '\0'; /* Here d points to 1 after last char, add NUL */ |
3925
|
467560
|
|
|
|
|
SvCUR_set(dest, d - (U8*)SvPVX_const(dest)); |
3926
|
|
|
|
|
|
} |
3927
|
|
|
|
|
|
} /* End of isn't utf8 */ |
3928
|
481006
|
50
|
|
|
|
if (dest != source && SvTAINTED(source)) |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
3929
|
0
|
0
|
|
|
|
SvTAINT(dest); |
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
3930
|
481006
|
100
|
|
|
|
SvSETMAGIC(dest); |
3931
|
481006
|
|
|
|
|
RETURN; |
3932
|
|
|
|
|
|
} |
3933
|
|
|
|
|
|
|
3934
|
4993920
|
|
|
|
|
PP(pp_lc) |
3935
|
4993920
|
100
|
|
|
|
{ |
3936
|
|
|
|
|
|
dVAR; |
3937
|
4993920
|
|
|
|
|
dSP; |
3938
|
4993920
|
|
|
|
|
SV *source = TOPs; |
3939
|
|
|
|
|
|
STRLEN len; |
3940
|
|
|
|
|
|
STRLEN min; |
3941
|
|
|
|
|
|
SV *dest; |
3942
|
|
|
|
|
|
const U8 *s; |
3943
|
|
|
|
|
|
U8 *d; |
3944
|
|
|
|
|
|
|
3945
|
2498702
|
|
|
|
|
SvGETMAGIC(source); |
3946
|
|
|
|
|
|
|
3947
|
4993920
|
100
|
|
|
|
if (SvPADTMP(source) && !SvREADONLY(source) && !SvAMAGIC(source) |
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
3948
|
12044
|
50
|
|
|
|
&& SvTEMP(source) && !DO_UTF8(source)) { |
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
3949
|
|
|
|
|
|
|
3950
|
|
|
|
|
|
/* We can convert in place, as lowercasing anything in the latin1 range |
3951
|
|
|
|
|
|
* (or else DO_UTF8 would have been on) doesn't lengthen it */ |
3952
|
|
|
|
|
|
dest = source; |
3953
|
0
|
0
|
|
|
|
s = d = (U8*)SvPV_force_nomg(source, len); |
3954
|
0
|
|
|
|
|
min = len + 1; |
3955
|
4993920
|
100
|
|
|
|
} else { |
3956
|
4993920
|
|
|
|
|
dTARGET; |
3957
|
|
|
|
|
|
|
3958
|
|
|
|
|
|
dest = TARG; |
3959
|
|
|
|
|
|
|
3960
|
|
|
|
|
|
/* The old implementation would copy source into TARG at this point. |
3961
|
|
|
|
|
|
This had the side effect that if source was undef, TARG was now |
3962
|
|
|
|
|
|
an undefined SV with PADTMP set, and they don't warn inside |
3963
|
|
|
|
|
|
sv_2pv_flags(). However, we're now getting the PV direct from |
3964
|
|
|
|
|
|
source, which doesn't have PADTMP set, so it would warn. Hence the |
3965
|
|
|
|
|
|
little games. */ |
3966
|
|
|
|
|
|
|
3967
|
4993920
|
100
|
|
|
|
if (SvOK(source)) { |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
3968
|
4993914
|
100
|
|
|
|
s = (const U8*)SvPV_nomg_const(source, len); |
3969
|
|
|
|
|
|
} else { |
3970
|
6
|
100
|
|
|
|
if (ckWARN(WARN_UNINITIALIZED)) |
3971
|
4
|
|
|
|
|
report_uninit(source); |
3972
|
|
|
|
|
|
s = (const U8*)""; |
3973
|
6
|
|
|
|
|
len = 0; |
3974
|
|
|
|
|
|
} |
3975
|
4993920
|
|
|
|
|
min = len + 1; |
3976
|
|
|
|
|
|
|
3977
|
2511710
|
|
|
|
|
SvUPGRADE(dest, SVt_PV); |
3978
|
4993920
|
100
|
|
|
|
d = (U8*)SvGROW(dest, min); |
|
|
100
|
|
|
|
|
3979
|
4993920
|
|
|
|
|
(void)SvPOK_only(dest); |
3980
|
|
|
|
|
|
|
3981
|
4993920
|
|
|
|
|
SETs(dest); |
3982
|
|
|
|
|
|
} |
3983
|
|
|
|
|
|
|
3984
|
|
|
|
|
|
/* Overloaded values may have toggled the UTF-8 flag on source, so we need |
3985
|
|
|
|
|
|
to check DO_UTF8 again here. */ |
3986
|
|
|
|
|
|
|
3987
|
4993920
|
100
|
|
|
|
if (DO_UTF8(source)) { |
|
|
100
|
|
|
|
|
3988
|
13364
|
|
|
|
|
const U8 *const send = s + len; |
3989
|
|
|
|
|
|
U8 tmpbuf[UTF8_MAXBYTES_CASE+1]; |
3990
|
13364
|
|
|
|
|
bool tainted = FALSE; |
3991
|
|
|
|
|
|
|
3992
|
202838
|
100
|
|
|
|
while (s < send) { |
3993
|
182798
|
|
|
|
|
const STRLEN u = UTF8SKIP(s); |
3994
|
|
|
|
|
|
STRLEN ulen; |
3995
|
|
|
|
|
|
|
3996
|
182798
|
|
|
|
|
_to_utf8_lower_flags(s, tmpbuf, &ulen, |
3997
|
|
|
|
|
|
cBOOL(IN_LOCALE_RUNTIME), &tainted); |
3998
|
|
|
|
|
|
|
3999
|
|
|
|
|
|
/* Here is where we would do context-sensitive actions. See the |
4000
|
|
|
|
|
|
* commit message for this comment for why there isn't any */ |
4001
|
|
|
|
|
|
|
4002
|
182792
|
100
|
|
|
|
if (ulen > u && (SvLEN(dest) < (min += ulen - u))) { |
|
|
100
|
|
|
|
|
4003
|
|
|
|
|
|
|
4004
|
|
|
|
|
|
/* If the eventually required minimum size outgrows the |
4005
|
|
|
|
|
|
* available space, we need to grow. */ |
4006
|
6
|
|
|
|
|
const UV o = d - (U8*)SvPVX_const(dest); |
4007
|
|
|
|
|
|
|
4008
|
|
|
|
|
|
/* If someone lowercases one million U+0130s we SvGROW() one |
4009
|
|
|
|
|
|
* million times. Or we could try guessing how much to |
4010
|
|
|
|
|
|
* allocate without allocating too much. Such is life. |
4011
|
|
|
|
|
|
* Another option would be to grow an extra byte or two more |
4012
|
|
|
|
|
|
* each time we need to grow, which would cut down the million |
4013
|
|
|
|
|
|
* to 500K, with little waste */ |
4014
|
6
|
50
|
|
|
|
SvGROW(dest, min); |
|
|
50
|
|
|
|
|
4015
|
6
|
|
|
|
|
d = (U8*)SvPVX(dest) + o; |
4016
|
|
|
|
|
|
} |
4017
|
|
|
|
|
|
|
4018
|
|
|
|
|
|
/* Copy the newly lowercased letter to the output buffer we're |
4019
|
|
|
|
|
|
* building */ |
4020
|
182792
|
|
|
|
|
Copy(tmpbuf, d, ulen, U8); |
4021
|
182792
|
|
|
|
|
d += ulen; |
4022
|
182792
|
|
|
|
|
s += u; |
4023
|
|
|
|
|
|
} /* End of looping through the source string */ |
4024
|
13358
|
|
|
|
|
SvUTF8_on(dest); |
4025
|
13358
|
|
|
|
|
*d = '\0'; |
4026
|
13358
|
|
|
|
|
SvCUR_set(dest, d - (U8*)SvPVX_const(dest)); |
4027
|
13358
|
100
|
|
|
|
if (tainted) { |
4028
|
514
|
|
|
|
|
TAINT; |
4029
|
514
|
50
|
|
|
|
SvTAINTED_on(dest); |
4030
|
|
|
|
|
|
} |
4031
|
|
|
|
|
|
} else { /* Not utf8 */ |
4032
|
4980556
|
100
|
|
|
|
if (len) { |
4033
|
4973922
|
|
|
|
|
const U8 *const send = s + len; |
4034
|
|
|
|
|
|
|
4035
|
|
|
|
|
|
/* Use locale casing if in locale; regular style if not treating |
4036
|
|
|
|
|
|
* latin1 as having case; otherwise the latin1 casing. Do the |
4037
|
|
|
|
|
|
* whole thing in a tight loop, for speed, */ |
4038
|
4973922
|
100
|
|
|
|
if (IN_LOCALE_RUNTIME) { |
4039
|
542
|
|
|
|
|
TAINT; |
4040
|
542
|
50
|
|
|
|
SvTAINTED_on(dest); |
4041
|
1155
|
100
|
|
|
|
for (; s < send; d++, s++) |
4042
|
884
|
|
|
|
|
*d = toLOWER_LC(*s); |
4043
|
|
|
|
|
|
} |
4044
|
4973380
|
100
|
|
|
|
else if (! IN_UNI_8_BIT) { |
|
|
100
|
|
|
|
|
4045
|
73783468
|
100
|
|
|
|
for (; s < send; d++, s++) { |
4046
|
71297022
|
100
|
|
|
|
*d = toLOWER(*s); |
4047
|
|
|
|
|
|
} |
4048
|
|
|
|
|
|
} |
4049
|
|
|
|
|
|
else { |
4050
|
161766
|
100
|
|
|
|
for (; s < send; d++, s++) { |
4051
|
159362
|
|
|
|
|
*d = toLOWER_LATIN1(*s); |
4052
|
|
|
|
|
|
} |
4053
|
|
|
|
|
|
} |
4054
|
|
|
|
|
|
} |
4055
|
4980556
|
50
|
|
|
|
if (source != dest) { |
4056
|
4980556
|
|
|
|
|
*d = '\0'; |
4057
|
4980556
|
|
|
|
|
SvCUR_set(dest, d - (U8*)SvPVX_const(dest)); |
4058
|
|
|
|
|
|
} |
4059
|
|
|
|
|
|
} |
4060
|
4993914
|
50
|
|
|
|
if (dest != source && SvTAINTED(source)) |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
4061
|
0
|
0
|
|
|
|
SvTAINT(dest); |
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
4062
|
4993914
|
100
|
|
|
|
SvSETMAGIC(dest); |
4063
|
4993914
|
|
|
|
|
RETURN; |
4064
|
|
|
|
|
|
} |
4065
|
|
|
|
|
|
|
4066
|
649042
|
|
|
|
|
PP(pp_quotemeta) |
4067
|
|
|
|
|
|
{ |
4068
|
649042
|
|
|
|
|
dVAR; dSP; dTARGET; |
4069
|
649042
|
|
|
|
|
SV * const sv = TOPs; |
4070
|
|
|
|
|
|
STRLEN len; |
4071
|
649042
|
100
|
|
|
|
const char *s = SvPV_const(sv,len); |
4072
|
|
|
|
|
|
|
4073
|
649042
|
|
|
|
|
SvUTF8_off(TARG); /* decontaminate */ |
4074
|
972082
|
100
|
|
|
|
if (len) { |
|
|
100
|
|
|
|
|
4075
|
|
|
|
|
|
char *d; |
4076
|
378158
|
|
|
|
|
SvUPGRADE(TARG, SVt_PV); |
4077
|
647160
|
100
|
|
|
|
SvGROW(TARG, (len * 2) + 1); |
|
|
100
|
|
|
|
|
4078
|
647160
|
|
|
|
|
d = SvPVX(TARG); |
4079
|
647160
|
100
|
|
|
|
if (DO_UTF8(sv)) { |
|
|
50
|
|
|
|
|
4080
|
6230
|
100
|
|
|
|
while (len) { |
4081
|
3930
|
|
|
|
|
STRLEN ulen = UTF8SKIP(s); |
4082
|
|
|
|
|
|
bool to_quote = FALSE; |
4083
|
|
|
|
|
|
|
4084
|
3930
|
100
|
|
|
|
if (UTF8_IS_INVARIANT(*s)) { |
4085
|
2720
|
100
|
|
|
|
if (_isQUOTEMETA(*s)) { |
4086
|
|
|
|
|
|
to_quote = TRUE; |
4087
|
|
|
|
|
|
} |
4088
|
|
|
|
|
|
} |
4089
|
1210
|
100
|
|
|
|
else if (UTF8_IS_DOWNGRADEABLE_START(*s)) { |
4090
|
|
|
|
|
|
|
4091
|
|
|
|
|
|
/* In locale, we quote all non-ASCII Latin1 chars. |
4092
|
|
|
|
|
|
* Otherwise use the quoting rules */ |
4093
|
1040
|
100
|
|
|
|
if (IN_LOCALE_RUNTIME |
4094
|
1036
|
50
|
|
|
|
|| _isQUOTEMETA(TWO_BYTE_UTF8_TO_NATIVE(*s, *(s + 1)))) |
|
|
100
|
|
|
|
|
4095
|
|
|
|
|
|
{ |
4096
|
|
|
|
|
|
to_quote = TRUE; |
4097
|
|
|
|
|
|
} |
4098
|
|
|
|
|
|
} |
4099
|
170
|
50
|
|
|
|
else if (is_QUOTEMETA_high(s)) { |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
100
|
|
|
|
|
4100
|
|
|
|
|
|
to_quote = TRUE; |
4101
|
|
|
|
|
|
} |
4102
|
|
|
|
|
|
|
4103
|
3930
|
100
|
|
|
|
if (to_quote) { |
4104
|
1390
|
|
|
|
|
*d++ = '\\'; |
4105
|
|
|
|
|
|
} |
4106
|
3930
|
50
|
|
|
|
if (ulen > len) |
4107
|
0
|
|
|
|
|
ulen = len; |
4108
|
3930
|
|
|
|
|
len -= ulen; |
4109
|
12325
|
100
|
|
|
|
while (ulen--) |
4110
|
5280
|
|
|
|
|
*d++ = *s++; |
4111
|
|
|
|
|
|
} |
4112
|
2300
|
|
|
|
|
SvUTF8_on(TARG); |
4113
|
|
|
|
|
|
} |
4114
|
644860
|
100
|
|
|
|
else if (IN_UNI_8_BIT) { |
|
|
50
|
|
|
|
|
4115
|
1308290
|
100
|
|
|
|
while (len--) { |
4116
|
1247266
|
100
|
|
|
|
if (_isQUOTEMETA(*s)) |
4117
|
203232
|
|
|
|
|
*d++ = '\\'; |
4118
|
1247266
|
|
|
|
|
*d++ = *s++; |
4119
|
|
|
|
|
|
} |
4120
|
|
|
|
|
|
} |
4121
|
|
|
|
|
|
else { |
4122
|
|
|
|
|
|
/* For non UNI_8_BIT (and hence in locale) just quote all \W |
4123
|
|
|
|
|
|
* including everything above ASCII */ |
4124
|
26894936
|
100
|
|
|
|
while (len--) { |
4125
|
26311100
|
100
|
|
|
|
if (!isWORDCHAR_A(*s)) |
4126
|
5152050
|
|
|
|
|
*d++ = '\\'; |
4127
|
26311100
|
|
|
|
|
*d++ = *s++; |
4128
|
|
|
|
|
|
} |
4129
|
|
|
|
|
|
} |
4130
|
647160
|
|
|
|
|
*d = '\0'; |
4131
|
647160
|
|
|
|
|
SvCUR_set(TARG, d - SvPVX_const(TARG)); |
4132
|
647160
|
|
|
|
|
(void)SvPOK_only_UTF8(TARG); |
4133
|
|
|
|
|
|
} |
4134
|
|
|
|
|
|
else |
4135
|
1882
|
|
|
|
|
sv_setpvn(TARG, s, len); |
4136
|
649042
|
50
|
|
|
|
SETTARG; |
4137
|
649042
|
|
|
|
|
RETURN; |
4138
|
|
|
|
|
|
} |
4139
|
|
|
|
|
|
|
4140
|
10016
|
|
|
|
|
PP(pp_fc) |
4141
|
20032
|
100
|
|
|
|
{ |
|
|
100
|
|
|
|
|
4142
|
|
|
|
|
|
dVAR; |
4143
|
10016
|
|
|
|
|
dTARGET; |
4144
|
10016
|
|
|
|
|
dSP; |
4145
|
10016
|
|
|
|
|
SV *source = TOPs; |
4146
|
|
|
|
|
|
STRLEN len; |
4147
|
|
|
|
|
|
STRLEN min; |
4148
|
|
|
|
|
|
SV *dest; |
4149
|
|
|
|
|
|
const U8 *s; |
4150
|
|
|
|
|
|
const U8 *send; |
4151
|
|
|
|
|
|
U8 *d; |
4152
|
|
|
|
|
|
U8 tmpbuf[UTF8_MAXBYTES_CASE + 1]; |
4153
|
|
|
|
|
|
const bool full_folding = TRUE; |
4154
|
10016
|
100
|
|
|
|
const U8 flags = ( full_folding ? FOLD_FLAGS_FULL : 0 ) |
4155
|
10016
|
|
|
|
|
| ( IN_LOCALE_RUNTIME ? FOLD_FLAGS_LOCALE : 0 ); |
4156
|
|
|
|
|
|
|
4157
|
|
|
|
|
|
/* This is a facsimile of pp_lc, but with a thousand bugs thanks to me. |
4158
|
|
|
|
|
|
* You are welcome(?) -Hugmeir |
4159
|
|
|
|
|
|
*/ |
4160
|
|
|
|
|
|
|
4161
|
5014
|
|
|
|
|
SvGETMAGIC(source); |
4162
|
|
|
|
|
|
|
4163
|
|
|
|
|
|
dest = TARG; |
4164
|
|
|
|
|
|
|
4165
|
10016
|
100
|
|
|
|
if (SvOK(source)) { |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
4166
|
10012
|
100
|
|
|
|
s = (const U8*)SvPV_nomg_const(source, len); |
4167
|
|
|
|
|
|
} else { |
4168
|
4
|
100
|
|
|
|
if (ckWARN(WARN_UNINITIALIZED)) |
4169
|
2
|
|
|
|
|
report_uninit(source); |
4170
|
|
|
|
|
|
s = (const U8*)""; |
4171
|
4
|
|
|
|
|
len = 0; |
4172
|
|
|
|
|
|
} |
4173
|
|
|
|
|
|
|
4174
|
10016
|
|
|
|
|
min = len + 1; |
4175
|
|
|
|
|
|
|
4176
|
5140
|
|
|
|
|
SvUPGRADE(dest, SVt_PV); |
4177
|
10016
|
100
|
|
|
|
d = (U8*)SvGROW(dest, min); |
|
|
100
|
|
|
|
|
4178
|
10016
|
|
|
|
|
(void)SvPOK_only(dest); |
4179
|
|
|
|
|
|
|
4180
|
10016
|
|
|
|
|
SETs(dest); |
4181
|
|
|
|
|
|
|
4182
|
10016
|
|
|
|
|
send = s + len; |
4183
|
10016
|
100
|
|
|
|
if (DO_UTF8(source)) { /* UTF-8 flagged string. */ |
|
|
100
|
|
|
|
|
4184
|
6154
|
|
|
|
|
bool tainted = FALSE; |
4185
|
17773
|
100
|
|
|
|
while (s < send) { |
4186
|
8542
|
|
|
|
|
const STRLEN u = UTF8SKIP(s); |
4187
|
|
|
|
|
|
STRLEN ulen; |
4188
|
|
|
|
|
|
|
4189
|
8542
|
|
|
|
|
_to_utf8_fold_flags(s, tmpbuf, &ulen, flags, &tainted); |
4190
|
|
|
|
|
|
|
4191
|
8542
|
100
|
|
|
|
if (ulen > u && (SvLEN(dest) < (min += ulen - u))) { |
|
|
100
|
|
|
|
|
4192
|
24
|
|
|
|
|
const UV o = d - (U8*)SvPVX_const(dest); |
4193
|
24
|
50
|
|
|
|
SvGROW(dest, min); |
|
|
50
|
|
|
|
|
4194
|
24
|
|
|
|
|
d = (U8*)SvPVX(dest) + o; |
4195
|
|
|
|
|
|
} |
4196
|
|
|
|
|
|
|
4197
|
8542
|
|
|
|
|
Copy(tmpbuf, d, ulen, U8); |
4198
|
8542
|
|
|
|
|
d += ulen; |
4199
|
8542
|
|
|
|
|
s += u; |
4200
|
|
|
|
|
|
} |
4201
|
6154
|
|
|
|
|
SvUTF8_on(dest); |
4202
|
6154
|
100
|
|
|
|
if (tainted) { |
4203
|
512
|
|
|
|
|
TAINT; |
4204
|
512
|
50
|
|
|
|
SvTAINTED_on(dest); |
4205
|
|
|
|
|
|
} |
4206
|
|
|
|
|
|
} /* Unflagged string */ |
4207
|
3862
|
100
|
|
|
|
else if (len) { |
4208
|
3854
|
100
|
|
|
|
if ( IN_LOCALE_RUNTIME ) { /* Under locale */ |
4209
|
512
|
|
|
|
|
TAINT; |
4210
|
512
|
50
|
|
|
|
SvTAINTED_on(dest); |
4211
|
768
|
100
|
|
|
|
for (; s < send; d++, s++) |
4212
|
512
|
|
|
|
|
*d = toFOLD_LC(*s); |
4213
|
|
|
|
|
|
} |
4214
|
3342
|
100
|
|
|
|
else if ( !IN_UNI_8_BIT ) { /* Under nothing, or bytes */ |
|
|
100
|
|
|
|
|
4215
|
7962
|
100
|
|
|
|
for (; s < send; d++, s++) |
4216
|
6562
|
100
|
|
|
|
*d = toFOLD(*s); |
4217
|
|
|
|
|
|
} |
4218
|
|
|
|
|
|
else { |
4219
|
|
|
|
|
|
/* For ASCII and the Latin-1 range, there's only two troublesome |
4220
|
|
|
|
|
|
* folds, \x{DF} (\N{LATIN SMALL LETTER SHARP S}), which under full |
4221
|
|
|
|
|
|
* casefolding becomes 'ss'; and \x{B5} (\N{MICRO SIGN}), which |
4222
|
|
|
|
|
|
* under any fold becomes \x{3BC} (\N{GREEK SMALL LETTER MU}) -- |
4223
|
|
|
|
|
|
* For the rest, the casefold is their lowercase. */ |
4224
|
961
|
100
|
|
|
|
for (; s < send; d++, s++) { |
4225
|
696
|
100
|
|
|
|
if (*s == MICRO_SIGN) { |
4226
|
|
|
|
|
|
/* \N{MICRO SIGN}'s casefold is \N{GREEK SMALL LETTER MU}, |
4227
|
|
|
|
|
|
* which is outside of the latin-1 range. There's a couple |
4228
|
|
|
|
|
|
* of ways to deal with this -- khw discusses them in |
4229
|
|
|
|
|
|
* pp_lc/uc, so go there :) What we do here is upgrade what |
4230
|
|
|
|
|
|
* we had already casefolded, then enter an inner loop that |
4231
|
|
|
|
|
|
* appends the rest of the characters as UTF-8. */ |
4232
|
6
|
|
|
|
|
len = d - (U8*)SvPVX_const(dest); |
4233
|
6
|
|
|
|
|
SvCUR_set(dest, len); |
4234
|
6
|
|
|
|
|
len = sv_utf8_upgrade_flags_grow(dest, |
4235
|
|
|
|
|
|
SV_GMAGIC|SV_FORCE_UTF8_UPGRADE, |
4236
|
|
|
|
|
|
/* The max expansion for latin1 |
4237
|
|
|
|
|
|
* chars is 1 byte becomes 2 */ |
4238
|
|
|
|
|
|
(send -s) * 2 + 1); |
4239
|
6
|
|
|
|
|
d = (U8*)SvPVX(dest) + len; |
4240
|
|
|
|
|
|
|
4241
|
6
|
|
|
|
|
Copy(GREEK_SMALL_LETTER_MU_UTF8, d, small_mu_len, U8); |
4242
|
6
|
|
|
|
|
d += small_mu_len; |
4243
|
6
|
|
|
|
|
s++; |
4244
|
14
|
100
|
|
|
|
for (; s < send; s++) { |
4245
|
|
|
|
|
|
STRLEN ulen; |
4246
|
8
|
|
|
|
|
UV fc = _to_uni_fold_flags(*s, tmpbuf, &ulen, flags); |
4247
|
8
|
100
|
|
|
|
if NATIVE_IS_INVARIANT(fc) { |
4248
|
6
|
50
|
|
|
|
if (full_folding |
4249
|
6
|
|
|
|
|
&& *s == LATIN_SMALL_LETTER_SHARP_S) |
4250
|
|
|
|
|
|
{ |
4251
|
0
|
|
|
|
|
*d++ = 's'; |
4252
|
0
|
|
|
|
|
*d++ = 's'; |
4253
|
|
|
|
|
|
} |
4254
|
|
|
|
|
|
else |
4255
|
6
|
|
|
|
|
*d++ = (U8)fc; |
4256
|
|
|
|
|
|
} |
4257
|
|
|
|
|
|
else { |
4258
|
2
|
|
|
|
|
Copy(tmpbuf, d, ulen, U8); |
4259
|
2
|
|
|
|
|
d += ulen; |
4260
|
|
|
|
|
|
} |
4261
|
|
|
|
|
|
} |
4262
|
|
|
|
|
|
break; |
4263
|
|
|
|
|
|
} |
4264
|
690
|
100
|
|
|
|
else if (full_folding && *s == LATIN_SMALL_LETTER_SHARP_S) { |
4265
|
|
|
|
|
|
/* Under full casefolding, LATIN SMALL LETTER SHARP S |
4266
|
|
|
|
|
|
* becomes "ss", which may require growing the SV. */ |
4267
|
36
|
100
|
|
|
|
if (SvLEN(dest) < ++min) { |
4268
|
2
|
|
|
|
|
const UV o = d - (U8*)SvPVX_const(dest); |
4269
|
2
|
50
|
|
|
|
SvGROW(dest, min); |
|
|
50
|
|
|
|
|
4270
|
2
|
|
|
|
|
d = (U8*)SvPVX(dest) + o; |
4271
|
|
|
|
|
|
} |
4272
|
36
|
|
|
|
|
*(d)++ = 's'; |
4273
|
36
|
|
|
|
|
*d = 's'; |
4274
|
|
|
|
|
|
} |
4275
|
|
|
|
|
|
else { /* If it's not one of those two, the fold is their lower |
4276
|
|
|
|
|
|
case */ |
4277
|
654
|
|
|
|
|
*d = toLOWER_LATIN1(*s); |
4278
|
|
|
|
|
|
} |
4279
|
|
|
|
|
|
} |
4280
|
|
|
|
|
|
} |
4281
|
|
|
|
|
|
} |
4282
|
10016
|
|
|
|
|
*d = '\0'; |
4283
|
10016
|
|
|
|
|
SvCUR_set(dest, d - (U8*)SvPVX_const(dest)); |
4284
|
|
|
|
|
|
|
4285
|
10016
|
100
|
|
|
|
if (SvTAINTED(source)) |
|
|
50
|
|
|
|
|
4286
|
0
|
0
|
|
|
|
SvTAINT(dest); |
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
4287
|
10016
|
100
|
|
|
|
SvSETMAGIC(dest); |
4288
|
10016
|
|
|
|
|
RETURN; |
4289
|
|
|
|
|
|
} |
4290
|
|
|
|
|
|
|
4291
|
|
|
|
|
|
/* Arrays. */ |
4292
|
|
|
|
|
|
|
4293
|
687912
|
|
|
|
|
PP(pp_aslice) |
4294
|
|
|
|
|
|
{ |
4295
|
687912
|
|
|
|
|
dVAR; dSP; dMARK; dORIGMARK; |
4296
|
687912
|
|
|
|
|
AV *const av = MUTABLE_AV(POPs); |
4297
|
687912
|
100
|
|
|
|
const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET); |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
4298
|
|
|
|
|
|
|
4299
|
687912
|
50
|
|
|
|
if (SvTYPE(av) == SVt_PVAV) { |
4300
|
687912
|
|
|
|
|
const bool localizing = PL_op->op_private & OPpLVAL_INTRO; |
4301
|
|
|
|
|
|
bool can_preserve = FALSE; |
4302
|
|
|
|
|
|
|
4303
|
687912
|
100
|
|
|
|
if (localizing) { |
4304
|
|
|
|
|
|
MAGIC *mg; |
4305
|
|
|
|
|
|
HV *stash; |
4306
|
|
|
|
|
|
|
4307
|
12
|
100
|
|
|
|
can_preserve = SvCANEXISTDELETE(av); |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
4308
|
|
|
|
|
|
} |
4309
|
|
|
|
|
|
|
4310
|
687912
|
100
|
|
|
|
if (lval && localizing) { |
|
|
100
|
|
|
|
|
4311
|
|
|
|
|
|
SV **svp; |
4312
|
|
|
|
|
|
SSize_t max = -1; |
4313
|
36
|
100
|
|
|
|
for (svp = MARK + 1; svp <= SP; svp++) { |
4314
|
24
|
50
|
|
|
|
const SSize_t elem = SvIV(*svp); |
4315
|
24
|
50
|
|
|
|
if (elem > max) |
4316
|
|
|
|
|
|
max = elem; |
4317
|
|
|
|
|
|
} |
4318
|
12
|
100
|
|
|
|
if (max > AvMAX(av)) |
4319
|
343958
|
|
|
|
|
av_extend(av, max); |
4320
|
|
|
|
|
|
} |
4321
|
|
|
|
|
|
|
4322
|
2696648
|
100
|
|
|
|
while (++MARK <= SP) { |
4323
|
|
|
|
|
|
SV **svp; |
4324
|
2008736
|
100
|
|
|
|
SSize_t elem = SvIV(*MARK); |
4325
|
|
|
|
|
|
bool preeminent = TRUE; |
4326
|
|
|
|
|
|
|
4327
|
2008736
|
100
|
|
|
|
if (localizing && can_preserve) { |
|
|
50
|
|
|
|
|
4328
|
|
|
|
|
|
/* If we can determine whether the element exist, |
4329
|
|
|
|
|
|
* Try to preserve the existenceness of a tied array |
4330
|
|
|
|
|
|
* element by using EXISTS and DELETE if possible. |
4331
|
|
|
|
|
|
* Fallback to FETCH and STORE otherwise. */ |
4332
|
24
|
|
|
|
|
preeminent = av_exists(av, elem); |
4333
|
|
|
|
|
|
} |
4334
|
|
|
|
|
|
|
4335
|
2008736
|
|
|
|
|
svp = av_fetch(av, elem, lval); |
4336
|
2008736
|
100
|
|
|
|
if (lval) { |
4337
|
944722
|
50
|
|
|
|
if (!svp || !*svp) |
|
|
50
|
|
|
|
|
4338
|
0
|
|
|
|
|
DIE(aTHX_ PL_no_aelem, elem); |
4339
|
944722
|
100
|
|
|
|
if (localizing) { |
4340
|
24
|
50
|
|
|
|
if (preeminent) |
4341
|
0
|
|
|
|
|
save_aelem(av, elem, svp); |
4342
|
|
|
|
|
|
else |
4343
|
24
|
|
|
|
|
SAVEADELETE(av, elem); |
4344
|
|
|
|
|
|
} |
4345
|
|
|
|
|
|
} |
4346
|
2008736
|
100
|
|
|
|
*MARK = svp ? *svp : &PL_sv_undef; |
4347
|
|
|
|
|
|
} |
4348
|
|
|
|
|
|
} |
4349
|
687912
|
100
|
|
|
|
if (GIMME != G_ARRAY) { |
|
|
100
|
|
|
|
|
4350
|
176358
|
|
|
|
|
MARK = ORIGMARK; |
4351
|
176358
|
100
|
|
|
|
*++MARK = SP > ORIGMARK ? *SP : &PL_sv_undef; |
4352
|
|
|
|
|
|
SP = MARK; |
4353
|
|
|
|
|
|
} |
4354
|
687912
|
|
|
|
|
RETURN; |
4355
|
|
|
|
|
|
} |
4356
|
|
|
|
|
|
|
4357
|
|
|
|
|
|
/* Smart dereferencing for keys, values and each */ |
4358
|
2016
|
|
|
|
|
PP(pp_rkeys) |
4359
|
2016
|
50
|
|
|
|
{ |
4360
|
|
|
|
|
|
dVAR; |
4361
|
2016
|
|
|
|
|
dSP; |
4362
|
2016
|
|
|
|
|
dPOPss; |
4363
|
|
|
|
|
|
|
4364
|
1008
|
|
|
|
|
SvGETMAGIC(sv); |
4365
|
|
|
|
|
|
|
4366
|
2016
|
100
|
|
|
|
if ( |
4367
|
2016
|
|
|
|
|
!SvROK(sv) |
4368
|
4992
|
100
|
|
|
|
|| (sv = SvRV(sv), |
|
|
100
|
|
|
|
|
4369
|
1998
|
|
|
|
|
(SvTYPE(sv) != SVt_PVHV && SvTYPE(sv) != SVt_PVAV) |
4370
|
1992
|
100
|
|
|
|
|| SvOBJECT(sv) |
4371
|
|
|
|
|
|
) |
4372
|
|
|
|
|
|
) { |
4373
|
34
|
|
|
|
|
DIE(aTHX_ |
4374
|
|
|
|
|
|
"Type of argument to %s must be unblessed hashref or arrayref", |
4375
|
34
|
|
|
|
|
PL_op_desc[PL_op->op_type] ); |
4376
|
|
|
|
|
|
} |
4377
|
|
|
|
|
|
|
4378
|
1982
|
100
|
|
|
|
if (PL_op->op_flags & OPf_SPECIAL && SvTYPE(sv) == SVt_PVAV) |
|
|
100
|
|
|
|
|
4379
|
3
|
|
|
|
|
DIE(aTHX_ |
4380
|
|
|
|
|
|
"Can't modify %s in %s", |
4381
|
4
|
|
|
|
|
PL_op_desc[PL_op->op_type], PL_op_desc[PL_op->op_next->op_type] |
4382
|
|
|
|
|
|
); |
4383
|
|
|
|
|
|
|
4384
|
|
|
|
|
|
/* Delegate to correct function for op type */ |
4385
|
1980
|
|
|
|
|
PUSHs(sv); |
4386
|
1980
|
100
|
|
|
|
if (PL_op->op_type == OP_RKEYS || PL_op->op_type == OP_RVALUES) { |
4387
|
1728
|
100
|
|
|
|
return (SvTYPE(sv) == SVt_PVHV) ? Perl_do_kv(aTHX) : Perl_pp_akeys(aTHX); |
4388
|
|
|
|
|
|
} |
4389
|
|
|
|
|
|
else { |
4390
|
1242
|
|
|
|
|
return (SvTYPE(sv) == SVt_PVHV) |
4391
|
|
|
|
|
|
? Perl_pp_each(aTHX) |
4392
|
252
|
100
|
|
|
|
: Perl_pp_aeach(aTHX); |
4393
|
|
|
|
|
|
} |
4394
|
|
|
|
|
|
} |
4395
|
|
|
|
|
|
|
4396
|
270
|
|
|
|
|
PP(pp_aeach) |
4397
|
206
|
50
|
|
|
|
{ |
4398
|
|
|
|
|
|
dVAR; |
4399
|
270
|
|
|
|
|
dSP; |
4400
|
270
|
|
|
|
|
AV *array = MUTABLE_AV(POPs); |
4401
|
270
|
50
|
|
|
|
const I32 gimme = GIMME_V; |
4402
|
270
|
|
|
|
|
IV *iterp = Perl_av_iter_p(aTHX_ array); |
4403
|
270
|
|
|
|
|
const IV current = (*iterp)++; |
4404
|
|
|
|
|
|
|
4405
|
270
|
100
|
|
|
|
if (current > av_len(array)) { |
4406
|
64
|
|
|
|
|
*iterp = 0; |
4407
|
64
|
100
|
|
|
|
if (gimme == G_SCALAR) |
4408
|
32
|
|
|
|
|
RETPUSHUNDEF; |
4409
|
|
|
|
|
|
else |
4410
|
32
|
|
|
|
|
RETURN; |
4411
|
|
|
|
|
|
} |
4412
|
|
|
|
|
|
|
4413
|
103
|
|
|
|
|
EXTEND(SP, 2); |
4414
|
206
|
|
|
|
|
mPUSHi(current); |
4415
|
206
|
100
|
|
|
|
if (gimme == G_ARRAY) { |
4416
|
116
|
|
|
|
|
SV **const element = av_fetch(array, current, 0); |
4417
|
116
|
50
|
|
|
|
PUSHs(element ? *element : &PL_sv_undef); |
4418
|
|
|
|
|
|
} |
4419
|
238
|
|
|
|
|
RETURN; |
4420
|
|
|
|
|
|
} |
4421
|
|
|
|
|
|
|
4422
|
172
|
|
|
|
|
PP(pp_akeys) |
4423
|
|
|
|
|
|
{ |
4424
|
|
|
|
|
|
dVAR; |
4425
|
172
|
|
|
|
|
dSP; |
4426
|
172
|
|
|
|
|
AV *array = MUTABLE_AV(POPs); |
4427
|
172
|
50
|
|
|
|
const I32 gimme = GIMME_V; |
4428
|
|
|
|
|
|
|
4429
|
172
|
|
|
|
|
*Perl_av_iter_p(aTHX_ array) = 0; |
4430
|
|
|
|
|
|
|
4431
|
172
|
100
|
|
|
|
if (gimme == G_SCALAR) { |
4432
|
36
|
|
|
|
|
dTARGET; |
4433
|
36
|
50
|
|
|
|
PUSHi(av_len(array) + 1); |
4434
|
|
|
|
|
|
} |
4435
|
230
|
|
|
|
|
else if (gimme == G_ARRAY) { |
4436
|
94
|
|
|
|
|
IV n = Perl_av_len(aTHX_ array); |
4437
|
|
|
|
|
|
IV i; |
4438
|
|
|
|
|
|
|
4439
|
47
|
|
|
|
|
EXTEND(SP, n + 1); |
4440
|
|
|
|
|
|
|
4441
|
94
|
100
|
|
|
|
if (PL_op->op_type == OP_AKEYS || PL_op->op_type == OP_RKEYS) { |
4442
|
203
|
100
|
|
|
|
for (i = 0; i <= n; i++) { |
4443
|
174
|
|
|
|
|
mPUSHi(i); |
4444
|
|
|
|
|
|
} |
4445
|
|
|
|
|
|
} |
4446
|
|
|
|
|
|
else { |
4447
|
126
|
100
|
|
|
|
for (i = 0; i <= n; i++) { |
4448
|
108
|
|
|
|
|
SV *const *const elem = Perl_av_fetch(aTHX_ array, i, 0); |
4449
|
108
|
50
|
|
|
|
PUSHs(elem ? *elem : &PL_sv_undef); |
4450
|
|
|
|
|
|
} |
4451
|
|
|
|
|
|
} |
4452
|
|
|
|
|
|
} |
4453
|
172
|
|
|
|
|
RETURN; |
4454
|
|
|
|
|
|
} |
4455
|
|
|
|
|
|
|
4456
|
|
|
|
|
|
/* Associative arrays. */ |
4457
|
|
|
|
|
|
|
4458
|
2056792
|
|
|
|
|
PP(pp_each) |
4459
|
2056792
|
50
|
|
|
|
{ |
4460
|
|
|
|
|
|
dVAR; |
4461
|
2056792
|
|
|
|
|
dSP; |
4462
|
2056792
|
|
|
|
|
HV * hash = MUTABLE_HV(POPs); |
4463
|
|
|
|
|
|
HE *entry; |
4464
|
2056792
|
100
|
|
|
|
const I32 gimme = GIMME_V; |
4465
|
|
|
|
|
|
|
4466
|
2056792
|
|
|
|
|
PUTBACK; |
4467
|
|
|
|
|
|
/* might clobber stack_sp */ |
4468
|
2056792
|
|
|
|
|
entry = hv_iternext(hash); |
4469
|
2056792
|
|
|
|
|
SPAGAIN; |
4470
|
|
|
|
|
|
|
4471
|
943076
|
|
|
|
|
EXTEND(SP, 2); |
4472
|
2056792
|
100
|
|
|
|
if (entry) { |
4473
|
1996110
|
|
|
|
|
SV* const sv = hv_iterkeysv(entry); |
4474
|
1996110
|
|
|
|
|
PUSHs(sv); /* won't clobber stack_sp */ |
4475
|
1996110
|
100
|
|
|
|
if (gimme == G_ARRAY) { |
4476
|
|
|
|
|
|
SV *val; |
4477
|
1550566
|
|
|
|
|
PUTBACK; |
4478
|
|
|
|
|
|
/* might clobber stack_sp */ |
4479
|
1550566
|
|
|
|
|
val = hv_iterval(hash, entry); |
4480
|
1550566
|
|
|
|
|
SPAGAIN; |
4481
|
1550566
|
|
|
|
|
PUSHs(val); |
4482
|
|
|
|
|
|
} |
4483
|
|
|
|
|
|
} |
4484
|
60682
|
100
|
|
|
|
else if (gimme == G_SCALAR) |
4485
|
958
|
|
|
|
|
RETPUSHUNDEF; |
4486
|
|
|
|
|
|
|
4487
|
2056313
|
|
|
|
|
RETURN; |
4488
|
|
|
|
|
|
} |
4489
|
|
|
|
|
|
|
4490
|
|
|
|
|
|
STATIC OP * |
4491
|
50
|
|
|
|
|
S_do_delete_local(pTHX) |
4492
|
|
|
|
|
|
{ |
4493
|
|
|
|
|
|
dVAR; |
4494
|
50
|
|
|
|
|
dSP; |
4495
|
50
|
100
|
|
|
|
const I32 gimme = GIMME_V; |
4496
|
|
|
|
|
|
const MAGIC *mg; |
4497
|
|
|
|
|
|
HV *stash; |
4498
|
50
|
|
|
|
|
const bool sliced = !!(PL_op->op_private & OPpSLICE); |
4499
|
50
|
100
|
|
|
|
SV *unsliced_keysv = sliced ? NULL : POPs; |
4500
|
50
|
|
|
|
|
SV * const osv = POPs; |
4501
|
50
|
100
|
|
|
|
SV **mark = sliced ? PL_stack_base + POPMARK : &unsliced_keysv-1; |
4502
|
50
|
|
|
|
|
dORIGMARK; |
4503
|
100
|
|
|
|
|
const bool tied = SvRMAGICAL(osv) |
4504
|
50
|
100
|
|
|
|
&& mg_find((const SV *)osv, PERL_MAGIC_tied); |
|
|
100
|
|
|
|
|
4505
|
50
|
100
|
|
|
|
const bool can_preserve = SvCANEXISTDELETE(osv); |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
4506
|
50
|
|
|
|
|
const U32 type = SvTYPE(osv); |
4507
|
50
|
100
|
|
|
|
SV ** const end = sliced ? SP : &unsliced_keysv; |
4508
|
|
|
|
|
|
|
4509
|
50
|
100
|
|
|
|
if (type == SVt_PVHV) { /* hash element */ |
4510
|
|
|
|
|
|
HV * const hv = MUTABLE_HV(osv); |
4511
|
66
|
100
|
|
|
|
while (++MARK <= end) { |
4512
|
36
|
|
|
|
|
SV * const keysv = *MARK; |
4513
|
36
|
|
|
|
|
SV *sv = NULL; |
4514
|
|
|
|
|
|
bool preeminent = TRUE; |
4515
|
36
|
50
|
|
|
|
if (can_preserve) |
4516
|
36
|
|
|
|
|
preeminent = hv_exists_ent(hv, keysv, 0); |
4517
|
36
|
100
|
|
|
|
if (tied) { |
4518
|
10
|
|
|
|
|
HE *he = hv_fetch_ent(hv, keysv, 1, 0); |
4519
|
10
|
50
|
|
|
|
if (he) |
4520
|
10
|
|
|
|
|
sv = HeVAL(he); |
4521
|
|
|
|
|
|
else |
4522
|
|
|
|
|
|
preeminent = FALSE; |
4523
|
|
|
|
|
|
} |
4524
|
|
|
|
|
|
else { |
4525
|
26
|
|
|
|
|
sv = hv_delete_ent(hv, keysv, 0, 0); |
4526
|
26
|
100
|
|
|
|
if (preeminent) |
4527
|
10
|
50
|
|
|
|
SvREFCNT_inc_simple_void(sv); /* De-mortalize */ |
4528
|
|
|
|
|
|
} |
4529
|
36
|
100
|
|
|
|
if (preeminent) { |
4530
|
16
|
50
|
|
|
|
if (!sv) DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv)); |
4531
|
16
|
|
|
|
|
save_helem_flags(hv, keysv, &sv, SAVEf_KEEPOLDELEM); |
4532
|
16
|
100
|
|
|
|
if (tied) { |
4533
|
6
|
|
|
|
|
*MARK = sv_mortalcopy(sv); |
4534
|
6
|
|
|
|
|
mg_clear(sv); |
4535
|
|
|
|
|
|
} else |
4536
|
10
|
|
|
|
|
*MARK = sv; |
4537
|
|
|
|
|
|
} |
4538
|
|
|
|
|
|
else { |
4539
|
20
|
|
|
|
|
SAVEHDELETE(hv, keysv); |
4540
|
28
|
|
|
|
|
*MARK = &PL_sv_undef; |
4541
|
|
|
|
|
|
} |
4542
|
|
|
|
|
|
} |
4543
|
|
|
|
|
|
} |
4544
|
20
|
50
|
|
|
|
else if (type == SVt_PVAV) { /* array element */ |
4545
|
20
|
50
|
|
|
|
if (PL_op->op_flags & OPf_SPECIAL) { |
4546
|
|
|
|
|
|
AV * const av = MUTABLE_AV(osv); |
4547
|
62
|
100
|
|
|
|
while (++MARK <= end) { |
4548
|
42
|
50
|
|
|
|
SSize_t idx = SvIV(*MARK); |
4549
|
42
|
|
|
|
|
SV *sv = NULL; |
4550
|
|
|
|
|
|
bool preeminent = TRUE; |
4551
|
42
|
50
|
|
|
|
if (can_preserve) |
4552
|
42
|
|
|
|
|
preeminent = av_exists(av, idx); |
4553
|
42
|
100
|
|
|
|
if (tied) { |
4554
|
10
|
|
|
|
|
SV **svp = av_fetch(av, idx, 1); |
4555
|
10
|
50
|
|
|
|
if (svp) |
4556
|
10
|
|
|
|
|
sv = *svp; |
4557
|
|
|
|
|
|
else |
4558
|
|
|
|
|
|
preeminent = FALSE; |
4559
|
|
|
|
|
|
} |
4560
|
|
|
|
|
|
else { |
4561
|
32
|
|
|
|
|
sv = av_delete(av, idx, 0); |
4562
|
32
|
100
|
|
|
|
if (preeminent) |
4563
|
6
|
50
|
|
|
|
SvREFCNT_inc_simple_void(sv); /* De-mortalize */ |
4564
|
|
|
|
|
|
} |
4565
|
42
|
100
|
|
|
|
if (preeminent) { |
4566
|
12
|
|
|
|
|
save_aelem_flags(av, idx, &sv, SAVEf_KEEPOLDELEM); |
4567
|
12
|
100
|
|
|
|
if (tied) { |
4568
|
6
|
|
|
|
|
*MARK = sv_mortalcopy(sv); |
4569
|
6
|
|
|
|
|
mg_clear(sv); |
4570
|
|
|
|
|
|
} else |
4571
|
6
|
|
|
|
|
*MARK = sv; |
4572
|
|
|
|
|
|
} |
4573
|
|
|
|
|
|
else { |
4574
|
30
|
|
|
|
|
SAVEADELETE(av, idx); |
4575
|
36
|
|
|
|
|
*MARK = &PL_sv_undef; |
4576
|
|
|
|
|
|
} |
4577
|
|
|
|
|
|
} |
4578
|
|
|
|
|
|
} |
4579
|
|
|
|
|
|
else |
4580
|
0
|
|
|
|
|
DIE(aTHX_ "panic: avhv_delete no longer supported"); |
4581
|
|
|
|
|
|
} |
4582
|
|
|
|
|
|
else |
4583
|
0
|
|
|
|
|
DIE(aTHX_ "Not a HASH reference"); |
4584
|
50
|
100
|
|
|
|
if (sliced) { |
4585
|
12
|
100
|
|
|
|
if (gimme == G_VOID) |
4586
|
4
|
|
|
|
|
SP = ORIGMARK; |
4587
|
8
|
50
|
|
|
|
else if (gimme == G_SCALAR) { |
4588
|
0
|
|
|
|
|
MARK = ORIGMARK; |
4589
|
0
|
0
|
|
|
|
if (SP > MARK) |
4590
|
0
|
|
|
|
|
*++MARK = *SP; |
4591
|
|
|
|
|
|
else |
4592
|
0
|
|
|
|
|
*++MARK = &PL_sv_undef; |
4593
|
|
|
|
|
|
SP = MARK; |
4594
|
|
|
|
|
|
} |
4595
|
|
|
|
|
|
} |
4596
|
38
|
100
|
|
|
|
else if (gimme != G_VOID) |
4597
|
12
|
|
|
|
|
PUSHs(unsliced_keysv); |
4598
|
|
|
|
|
|
|
4599
|
50
|
|
|
|
|
RETURN; |
4600
|
|
|
|
|
|
} |
4601
|
|
|
|
|
|
|
4602
|
11475060
|
|
|
|
|
PP(pp_delete) |
4603
|
|
|
|
|
|
{ |
4604
|
|
|
|
|
|
dVAR; |
4605
|
11475060
|
|
|
|
|
dSP; |
4606
|
|
|
|
|
|
I32 gimme; |
4607
|
|
|
|
|
|
I32 discard; |
4608
|
|
|
|
|
|
|
4609
|
11475060
|
100
|
|
|
|
if (PL_op->op_private & OPpLVAL_INTRO) |
4610
|
50
|
|
|
|
|
return do_delete_local(); |
4611
|
|
|
|
|
|
|
4612
|
11475010
|
100
|
|
|
|
gimme = GIMME_V; |
4613
|
11475010
|
100
|
|
|
|
discard = (gimme == G_VOID) ? G_DISCARD : 0; |
4614
|
|
|
|
|
|
|
4615
|
11475010
|
100
|
|
|
|
if (PL_op->op_private & OPpSLICE) { |
4616
|
20278
|
|
|
|
|
dMARK; dORIGMARK; |
4617
|
20278
|
|
|
|
|
HV * const hv = MUTABLE_HV(POPs); |
4618
|
20278
|
|
|
|
|
const U32 hvtype = SvTYPE(hv); |
4619
|
20278
|
100
|
|
|
|
if (hvtype == SVt_PVHV) { /* hash element */ |
4620
|
85922
|
100
|
|
|
|
while (++MARK <= SP) { |
4621
|
65648
|
|
|
|
|
SV * const sv = hv_delete_ent(hv, *MARK, discard, 0); |
4622
|
65648
|
100
|
|
|
|
*MARK = sv ? sv : &PL_sv_undef; |
4623
|
|
|
|
|
|
} |
4624
|
|
|
|
|
|
} |
4625
|
4
|
50
|
|
|
|
else if (hvtype == SVt_PVAV) { /* array element */ |
4626
|
4
|
50
|
|
|
|
if (PL_op->op_flags & OPf_SPECIAL) { |
4627
|
12
|
100
|
|
|
|
while (++MARK <= SP) { |
4628
|
8
|
100
|
|
|
|
SV * const sv = av_delete(MUTABLE_AV(hv), SvIV(*MARK), discard); |
4629
|
8
|
100
|
|
|
|
*MARK = sv ? sv : &PL_sv_undef; |
4630
|
|
|
|
|
|
} |
4631
|
|
|
|
|
|
} |
4632
|
|
|
|
|
|
} |
4633
|
|
|
|
|
|
else |
4634
|
0
|
|
|
|
|
DIE(aTHX_ "Not a HASH reference"); |
4635
|
20278
|
100
|
|
|
|
if (discard) |
4636
|
19136
|
|
|
|
|
SP = ORIGMARK; |
4637
|
1142
|
100
|
|
|
|
else if (gimme == G_SCALAR) { |
4638
|
2
|
|
|
|
|
MARK = ORIGMARK; |
4639
|
2
|
50
|
|
|
|
if (SP > MARK) |
4640
|
0
|
|
|
|
|
*++MARK = *SP; |
4641
|
|
|
|
|
|
else |
4642
|
2
|
|
|
|
|
*++MARK = &PL_sv_undef; |
4643
|
|
|
|
|
|
SP = MARK; |
4644
|
|
|
|
|
|
} |
4645
|
|
|
|
|
|
} |
4646
|
|
|
|
|
|
else { |
4647
|
11454732
|
|
|
|
|
SV *keysv = POPs; |
4648
|
11454732
|
|
|
|
|
HV * const hv = MUTABLE_HV(POPs); |
4649
|
|
|
|
|
|
SV *sv = NULL; |
4650
|
11454732
|
100
|
|
|
|
if (SvTYPE(hv) == SVt_PVHV) |
4651
|
11454626
|
|
|
|
|
sv = hv_delete_ent(hv, keysv, discard, 0); |
4652
|
106
|
50
|
|
|
|
else if (SvTYPE(hv) == SVt_PVAV) { |
4653
|
106
|
50
|
|
|
|
if (PL_op->op_flags & OPf_SPECIAL) |
4654
|
106
|
100
|
|
|
|
sv = av_delete(MUTABLE_AV(hv), SvIV(keysv), discard); |
4655
|
|
|
|
|
|
else |
4656
|
0
|
|
|
|
|
DIE(aTHX_ "panic: avhv_delete no longer supported"); |
4657
|
|
|
|
|
|
} |
4658
|
|
|
|
|
|
else |
4659
|
0
|
|
|
|
|
DIE(aTHX_ "Not a HASH reference"); |
4660
|
11454722
|
100
|
|
|
|
if (!sv) |
4661
|
|
|
|
|
|
sv = &PL_sv_undef; |
4662
|
11454722
|
100
|
|
|
|
if (!discard) |
4663
|
3918434
|
|
|
|
|
PUSHs(sv); |
4664
|
|
|
|
|
|
} |
4665
|
11475025
|
|
|
|
|
RETURN; |
4666
|
|
|
|
|
|
} |
4667
|
|
|
|
|
|
|
4668
|
44576605
|
|
|
|
|
PP(pp_exists) |
4669
|
|
|
|
|
|
{ |
4670
|
|
|
|
|
|
dVAR; |
4671
|
44576605
|
|
|
|
|
dSP; |
4672
|
|
|
|
|
|
SV *tmpsv; |
4673
|
|
|
|
|
|
HV *hv; |
4674
|
|
|
|
|
|
|
4675
|
44576605
|
100
|
|
|
|
if (UNLIKELY( PL_op->op_private & OPpEXISTS_SUB )) { |
4676
|
|
|
|
|
|
GV *gv; |
4677
|
247536
|
|
|
|
|
SV * const sv = POPs; |
4678
|
247536
|
|
|
|
|
CV * const cv = sv_2cv(sv, &hv, &gv, 0); |
4679
|
247536
|
100
|
|
|
|
if (cv) |
4680
|
9156
|
|
|
|
|
RETPUSHYES; |
4681
|
238380
|
100
|
|
|
|
if (gv && isGV(gv) && GvCV(gv) && !GvCVGEN(gv)) |
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
4682
|
0
|
|
|
|
|
RETPUSHYES; |
4683
|
238380
|
|
|
|
|
RETPUSHNO; |
4684
|
|
|
|
|
|
} |
4685
|
44329069
|
|
|
|
|
tmpsv = POPs; |
4686
|
44329069
|
|
|
|
|
hv = MUTABLE_HV(POPs); |
4687
|
44329069
|
100
|
|
|
|
if (LIKELY( SvTYPE(hv) == SVt_PVHV )) { |
4688
|
43885775
|
100
|
|
|
|
if (hv_exists_ent(hv, tmpsv, 0)) |
4689
|
32478562
|
|
|
|
|
RETPUSHYES; |
4690
|
|
|
|
|
|
} |
4691
|
443294
|
50
|
|
|
|
else if (SvTYPE(hv) == SVt_PVAV) { |
4692
|
443294
|
50
|
|
|
|
if (PL_op->op_flags & OPf_SPECIAL) { /* array element */ |
4693
|
443294
|
100
|
|
|
|
if (av_exists(MUTABLE_AV(hv), SvIV(tmpsv))) |
|
|
100
|
|
|
|
|
4694
|
73890
|
|
|
|
|
RETPUSHYES; |
4695
|
|
|
|
|
|
} |
4696
|
|
|
|
|
|
} |
4697
|
|
|
|
|
|
else { |
4698
|
0
|
|
|
|
|
DIE(aTHX_ "Not a HASH reference"); |
4699
|
|
|
|
|
|
} |
4700
|
28209544
|
|
|
|
|
RETPUSHNO; |
4701
|
|
|
|
|
|
} |
4702
|
|
|
|
|
|
|
4703
|
2291829
|
|
|
|
|
PP(pp_hslice) |
4704
|
|
|
|
|
|
{ |
4705
|
2291829
|
|
|
|
|
dVAR; dSP; dMARK; dORIGMARK; |
4706
|
2291829
|
|
|
|
|
HV * const hv = MUTABLE_HV(POPs); |
4707
|
2291829
|
100
|
|
|
|
const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET); |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
4708
|
2291829
|
|
|
|
|
const bool localizing = PL_op->op_private & OPpLVAL_INTRO; |
4709
|
|
|
|
|
|
bool can_preserve = FALSE; |
4710
|
|
|
|
|
|
|
4711
|
2291829
|
100
|
|
|
|
if (localizing) { |
4712
|
|
|
|
|
|
MAGIC *mg; |
4713
|
|
|
|
|
|
HV *stash; |
4714
|
|
|
|
|
|
|
4715
|
1363839
|
100
|
|
|
|
if (SvCANEXISTDELETE(hv)) |
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
4716
|
|
|
|
|
|
can_preserve = TRUE; |
4717
|
|
|
|
|
|
} |
4718
|
|
|
|
|
|
|
4719
|
16912221
|
100
|
|
|
|
while (++MARK <= SP) { |
4720
|
14620392
|
|
|
|
|
SV * const keysv = *MARK; |
4721
|
|
|
|
|
|
SV **svp; |
4722
|
|
|
|
|
|
HE *he; |
4723
|
|
|
|
|
|
bool preeminent = TRUE; |
4724
|
|
|
|
|
|
|
4725
|
14620392
|
100
|
|
|
|
if (localizing && can_preserve) { |
|
|
50
|
|
|
|
|
4726
|
|
|
|
|
|
/* If we can determine whether the element exist, |
4727
|
|
|
|
|
|
* try to preserve the existenceness of a tied hash |
4728
|
|
|
|
|
|
* element by using EXISTS and DELETE if possible. |
4729
|
|
|
|
|
|
* Fallback to FETCH and STORE otherwise. */ |
4730
|
1719084
|
|
|
|
|
preeminent = hv_exists_ent(hv, keysv, 0); |
4731
|
|
|
|
|
|
} |
4732
|
|
|
|
|
|
|
4733
|
14620392
|
100
|
|
|
|
he = hv_fetch_ent(hv, keysv, lval, 0); |
4734
|
14620392
|
100
|
|
|
|
svp = he ? &HeVAL(he) : NULL; |
4735
|
|
|
|
|
|
|
4736
|
14620392
|
100
|
|
|
|
if (lval) { |
4737
|
12578912
|
50
|
|
|
|
if (!svp || !*svp || *svp == &PL_sv_undef) { |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
4738
|
0
|
|
|
|
|
DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv)); |
4739
|
|
|
|
|
|
} |
4740
|
12578912
|
100
|
|
|
|
if (localizing) { |
4741
|
1719084
|
100
|
|
|
|
if (HvNAME_get(hv) && isGV(*svp)) |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
4742
|
4
|
|
|
|
|
save_gp(MUTABLE_GV(*svp), !(PL_op->op_flags & OPf_SPECIAL)); |
4743
|
1719080
|
100
|
|
|
|
else if (preeminent) |
4744
|
1709870
|
|
|
|
|
save_helem_flags(hv, keysv, svp, |
4745
|
|
|
|
|
|
(PL_op->op_flags & OPf_SPECIAL) ? 0 : SAVEf_SETMAGIC); |
4746
|
|
|
|
|
|
else |
4747
|
9210
|
|
|
|
|
SAVEHDELETE(hv, keysv); |
4748
|
|
|
|
|
|
} |
4749
|
|
|
|
|
|
} |
4750
|
14620392
|
100
|
|
|
|
*MARK = svp && *svp ? *svp : &PL_sv_undef; |
|
|
50
|
|
|
|
|
4751
|
|
|
|
|
|
} |
4752
|
2291829
|
100
|
|
|
|
if (GIMME != G_ARRAY) { |
|
|
100
|
|
|
|
|
4753
|
7272
|
|
|
|
|
MARK = ORIGMARK; |
4754
|
7272
|
100
|
|
|
|
*++MARK = SP > ORIGMARK ? *SP : &PL_sv_undef; |
4755
|
|
|
|
|
|
SP = MARK; |
4756
|
|
|
|
|
|
} |
4757
|
2291829
|
|
|
|
|
RETURN; |
4758
|
|
|
|
|
|
} |
4759
|
|
|
|
|
|
|
4760
|
|
|
|
|
|
/* List operators. */ |
4761
|
|
|
|
|
|
|
4762
|
32271180
|
|
|
|
|
PP(pp_list) |
4763
|
|
|
|
|
|
{ |
4764
|
32271180
|
|
|
|
|
dVAR; dSP; dMARK; |
4765
|
32271180
|
100
|
|
|
|
if (GIMME != G_ARRAY) { |
|
|
100
|
|
|
|
|
4766
|
21206548
|
100
|
|
|
|
if (++MARK <= SP) |
4767
|
21206530
|
|
|
|
|
*MARK = *SP; /* unwanted list, return last item */ |
4768
|
|
|
|
|
|
else |
4769
|
10639569
|
|
|
|
|
*MARK = &PL_sv_undef; |
4770
|
|
|
|
|
|
SP = MARK; |
4771
|
|
|
|
|
|
} |
4772
|
32271180
|
|
|
|
|
RETURN; |
4773
|
|
|
|
|
|
} |
4774
|
|
|
|
|
|
|
4775
|
1975811
|
|
|
|
|
PP(pp_lslice) |
4776
|
|
|
|
|
|
{ |
4777
|
|
|
|
|
|
dVAR; |
4778
|
|
|
|
|
|
dSP; |
4779
|
1975811
|
|
|
|
|
SV ** const lastrelem = PL_stack_sp; |
4780
|
1975811
|
|
|
|
|
SV ** const lastlelem = PL_stack_base + POPMARK; |
4781
|
1975811
|
|
|
|
|
SV ** const firstlelem = PL_stack_base + POPMARK + 1; |
4782
|
1975811
|
|
|
|
|
SV ** const firstrelem = lastlelem + 1; |
4783
|
|
|
|
|
|
I32 is_something_there = FALSE; |
4784
|
1975811
|
|
|
|
|
const U8 mod = PL_op->op_flags & OPf_MOD; |
4785
|
|
|
|
|
|
|
4786
|
1975811
|
|
|
|
|
const I32 max = lastrelem - lastlelem; |
4787
|
|
|
|
|
|
SV **lelem; |
4788
|
|
|
|
|
|
|
4789
|
1975811
|
100
|
|
|
|
if (GIMME != G_ARRAY) { |
|
|
100
|
|
|
|
|
4790
|
1938461
|
100
|
|
|
|
I32 ix = SvIV(*lastlelem); |
4791
|
1938461
|
100
|
|
|
|
if (ix < 0) |
4792
|
4704
|
|
|
|
|
ix += max; |
4793
|
1938461
|
100
|
|
|
|
if (ix < 0 || ix >= max) |
4794
|
1252
|
|
|
|
|
*firstlelem = &PL_sv_undef; |
4795
|
|
|
|
|
|
else |
4796
|
1937209
|
|
|
|
|
*firstlelem = firstrelem[ix]; |
4797
|
|
|
|
|
|
SP = firstlelem; |
4798
|
1938461
|
|
|
|
|
RETURN; |
4799
|
|
|
|
|
|
} |
4800
|
|
|
|
|
|
|
4801
|
37350
|
100
|
|
|
|
if (max == 0) { |
4802
|
224
|
|
|
|
|
SP = firstlelem - 1; |
4803
|
224
|
|
|
|
|
RETURN; |
4804
|
|
|
|
|
|
} |
4805
|
|
|
|
|
|
|
4806
|
102019
|
100
|
|
|
|
for (lelem = firstlelem; lelem <= lastlelem; lelem++) { |
4807
|
83456
|
100
|
|
|
|
I32 ix = SvIV(*lelem); |
4808
|
83456
|
100
|
|
|
|
if (ix < 0) |
4809
|
8
|
|
|
|
|
ix += max; |
4810
|
83456
|
100
|
|
|
|
if (ix < 0 || ix >= max) |
4811
|
36
|
|
|
|
|
*lelem = &PL_sv_undef; |
4812
|
|
|
|
|
|
else { |
4813
|
|
|
|
|
|
is_something_there = TRUE; |
4814
|
83420
|
50
|
|
|
|
if (!(*lelem = firstrelem[ix])) |
4815
|
0
|
|
|
|
|
*lelem = &PL_sv_undef; |
4816
|
83420
|
100
|
|
|
|
else if (mod && SvPADTMP(*lelem) && !IS_PADGV(*lelem)) |
|
|
100
|
|
|
|
|
4817
|
2384
|
|
|
|
|
*lelem = firstrelem[ix] = sv_mortalcopy(*lelem); |
4818
|
|
|
|
|
|
} |
4819
|
|
|
|
|
|
} |
4820
|
37126
|
100
|
|
|
|
if (is_something_there) |
4821
|
|
|
|
|
|
SP = lastlelem; |
4822
|
|
|
|
|
|
else |
4823
|
16
|
|
|
|
|
SP = firstlelem - 1; |
4824
|
1008567
|
|
|
|
|
RETURN; |
4825
|
|
|
|
|
|
} |
4826
|
|
|
|
|
|
|
4827
|
10282641
|
|
|
|
|
PP(pp_anonlist) |
4828
|
|
|
|
|
|
{ |
4829
|
10282641
|
|
|
|
|
dVAR; dSP; dMARK; |
4830
|
10282641
|
|
|
|
|
const I32 items = SP - MARK; |
4831
|
10282641
|
|
|
|
|
SV * const av = MUTABLE_SV(av_make(items, MARK+1)); |
4832
|
|
|
|
|
|
SP = MARK; |
4833
|
10282637
|
50
|
|
|
|
mXPUSHs((PL_op->op_flags & OPf_SPECIAL) |
|
|
100
|
|
|
|
|
4834
|
|
|
|
|
|
? newRV_noinc(av) : av); |
4835
|
10282637
|
|
|
|
|
RETURN; |
4836
|
|
|
|
|
|
} |
4837
|
|
|
|
|
|
|
4838
|
12556088
|
|
|
|
|
PP(pp_anonhash) |
4839
|
|
|
|
|
|
{ |
4840
|
12556088
|
|
|
|
|
dVAR; dSP; dMARK; dORIGMARK; |
4841
|
12556088
|
|
|
|
|
HV* const hv = newHV(); |
4842
|
12556088
|
50
|
|
|
|
SV* const retval = sv_2mortal( PL_op->op_flags & OPf_SPECIAL |
4843
|
|
|
|
|
|
? newRV_noinc(MUTABLE_SV(hv)) |
4844
|
|
|
|
|
|
: MUTABLE_SV(hv) ); |
4845
|
|
|
|
|
|
|
4846
|
30970021
|
100
|
|
|
|
while (MARK < SP) { |
4847
|
|
|
|
|
|
SV * const key = |
4848
|
12142188
|
50
|
|
|
|
(MARK++, SvGMAGICAL(*MARK) ? sv_mortalcopy(*MARK) : *MARK); |
4849
|
|
|
|
|
|
SV *val; |
4850
|
18199243
|
100
|
|
|
|
if (MARK < SP) |
|
|
100
|
|
|
|
|
4851
|
|
|
|
|
|
{ |
4852
|
12142178
|
|
|
|
|
MARK++; |
4853
|
6207111
|
|
|
|
|
SvGETMAGIC(*MARK); |
4854
|
12142174
|
|
|
|
|
val = newSV(0); |
4855
|
12142174
|
|
|
|
|
sv_setsv(val, *MARK); |
4856
|
|
|
|
|
|
} |
4857
|
|
|
|
|
|
else |
4858
|
|
|
|
|
|
{ |
4859
|
10
|
|
|
|
|
Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Odd number of elements in anonymous hash"); |
4860
|
10
|
|
|
|
|
val = newSV(0); |
4861
|
|
|
|
|
|
} |
4862
|
12142184
|
|
|
|
|
(void)hv_store_ent(hv,key,val,0); |
4863
|
|
|
|
|
|
} |
4864
|
12556084
|
|
|
|
|
SP = ORIGMARK; |
4865
|
12556084
|
50
|
|
|
|
XPUSHs(retval); |
4866
|
12556084
|
|
|
|
|
RETURN; |
4867
|
|
|
|
|
|
} |
4868
|
|
|
|
|
|
|
4869
|
|
|
|
|
|
static AV * |
4870
|
136
|
|
|
|
|
S_deref_plain_array(pTHX_ AV *ary) |
4871
|
136
|
50
|
|
|
|
{ |
4872
|
136
|
50
|
|
|
|
if (SvTYPE(ary) == SVt_PVAV) return ary; |
4873
|
68
|
|
|
|
|
SvGETMAGIC((SV *)ary); |
4874
|
136
|
100
|
|
|
|
if (!SvROK(ary) || SvTYPE(SvRV(ary)) != SVt_PVAV) |
|
|
100
|
|
|
|
|
4875
|
16
|
|
|
|
|
Perl_die(aTHX_ "Not an ARRAY reference"); |
4876
|
120
|
100
|
|
|
|
else if (SvOBJECT(SvRV(ary))) |
4877
|
6
|
|
|
|
|
Perl_die(aTHX_ "Not an unblessed ARRAY reference"); |
4878
|
114
|
|
|
|
|
return (AV *)SvRV(ary); |
4879
|
|
|
|
|
|
} |
4880
|
|
|
|
|
|
|
4881
|
|
|
|
|
|
#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) |
4882
|
|
|
|
|
|
# define DEREF_PLAIN_ARRAY(ary) \ |
4883
|
|
|
|
|
|
({ \ |
4884
|
|
|
|
|
|
AV *aRrRay = ary; \ |
4885
|
|
|
|
|
|
SvTYPE(aRrRay) == SVt_PVAV \ |
4886
|
|
|
|
|
|
? aRrRay \ |
4887
|
|
|
|
|
|
: S_deref_plain_array(aTHX_ aRrRay); \ |
4888
|
|
|
|
|
|
}) |
4889
|
|
|
|
|
|
#else |
4890
|
|
|
|
|
|
# define DEREF_PLAIN_ARRAY(ary) \ |
4891
|
|
|
|
|
|
( \ |
4892
|
|
|
|
|
|
PL_Sv = (SV *)(ary), \ |
4893
|
|
|
|
|
|
SvTYPE(PL_Sv) == SVt_PVAV \ |
4894
|
|
|
|
|
|
? (AV *)PL_Sv \ |
4895
|
|
|
|
|
|
: S_deref_plain_array(aTHX_ (AV *)PL_Sv) \ |
4896
|
|
|
|
|
|
) |
4897
|
|
|
|
|
|
#endif |
4898
|
|
|
|
|
|
|
4899
|
651486
|
|
|
|
|
PP(pp_splice) |
4900
|
|
|
|
|
|
{ |
4901
|
651486
|
|
|
|
|
dVAR; dSP; dMARK; dORIGMARK; |
4902
|
651486
|
|
|
|
|
int num_args = (SP - MARK); |
4903
|
651486
|
100
|
|
|
|
AV *ary = DEREF_PLAIN_ARRAY(MUTABLE_AV(*++MARK)); |
4904
|
|
|
|
|
|
SV **src; |
4905
|
|
|
|
|
|
SV **dst; |
4906
|
|
|
|
|
|
SSize_t i; |
4907
|
|
|
|
|
|
SSize_t offset; |
4908
|
|
|
|
|
|
SSize_t length; |
4909
|
|
|
|
|
|
SSize_t newlen; |
4910
|
|
|
|
|
|
SSize_t after; |
4911
|
|
|
|
|
|
SSize_t diff; |
4912
|
651482
|
100
|
|
|
|
const MAGIC * const mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied); |
4913
|
|
|
|
|
|
|
4914
|
651482
|
100
|
|
|
|
if (mg) { |
4915
|
1672
|
50
|
|
|
|
return Perl_tied_method(aTHX_ SV_CONST(SPLICE), mark - 1, MUTABLE_SV(ary), mg, |
|
|
100
|
|
|
|
|
4916
|
836
|
|
|
|
|
GIMME_V | TIED_METHOD_ARGUMENTS_ON_STACK, |
4917
|
836
|
|
|
|
|
sp - mark); |
4918
|
|
|
|
|
|
} |
4919
|
|
|
|
|
|
|
4920
|
650646
|
|
|
|
|
SP++; |
4921
|
|
|
|
|
|
|
4922
|
650646
|
100
|
|
|
|
if (++MARK < SP) { |
4923
|
635682
|
100
|
|
|
|
offset = i = SvIV(*MARK); |
4924
|
635682
|
100
|
|
|
|
if (offset < 0) |
4925
|
152914
|
|
|
|
|
offset += AvFILLp(ary) + 1; |
4926
|
635682
|
50
|
|
|
|
if (offset < 0) |
4927
|
0
|
|
|
|
|
DIE(aTHX_ PL_no_aelem, i); |
4928
|
635682
|
100
|
|
|
|
if (++MARK < SP) { |
4929
|
519478
|
100
|
|
|
|
length = SvIVx(*MARK++); |
4930
|
519478
|
100
|
|
|
|
if (length < 0) { |
4931
|
4
|
|
|
|
|
length += AvFILLp(ary) - offset + 1; |
4932
|
4
|
50
|
|
|
|
if (length < 0) |
4933
|
|
|
|
|
|
length = 0; |
4934
|
|
|
|
|
|
} |
4935
|
|
|
|
|
|
} |
4936
|
|
|
|
|
|
else |
4937
|
116204
|
|
|
|
|
length = AvMAX(ary) + 1; /* close enough to infinity */ |
4938
|
|
|
|
|
|
} |
4939
|
|
|
|
|
|
else { |
4940
|
|
|
|
|
|
offset = 0; |
4941
|
14964
|
|
|
|
|
length = AvMAX(ary) + 1; |
4942
|
|
|
|
|
|
} |
4943
|
650646
|
100
|
|
|
|
if (offset > AvFILLp(ary) + 1) { |
4944
|
12
|
100
|
|
|
|
if (num_args > 2) |
4945
|
8
|
|
|
|
|
Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "splice() offset past end of array" ); |
4946
|
12
|
|
|
|
|
offset = AvFILLp(ary) + 1; |
4947
|
|
|
|
|
|
} |
4948
|
650646
|
|
|
|
|
after = AvFILLp(ary) + 1 - (offset + length); |
4949
|
650646
|
100
|
|
|
|
if (after < 0) { /* not that much array */ |
4950
|
143056
|
|
|
|
|
length += after; /* offset+length now in array */ |
4951
|
|
|
|
|
|
after = 0; |
4952
|
143056
|
50
|
|
|
|
if (!AvALLOC(ary)) |
4953
|
0
|
|
|
|
|
av_extend(ary, 0); |
4954
|
|
|
|
|
|
} |
4955
|
|
|
|
|
|
|
4956
|
|
|
|
|
|
/* At this point, MARK .. SP-1 is our new LIST */ |
4957
|
|
|
|
|
|
|
4958
|
650646
|
|
|
|
|
newlen = SP - MARK; |
4959
|
650646
|
|
|
|
|
diff = newlen - length; |
4960
|
650646
|
100
|
|
|
|
if (newlen && !AvREAL(ary) && AvREIFY(ary)) |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
4961
|
244
|
|
|
|
|
av_reify(ary); |
4962
|
|
|
|
|
|
|
4963
|
|
|
|
|
|
/* make new elements SVs now: avoid problems if they're from the array */ |
4964
|
816752
|
100
|
|
|
|
for (dst = MARK, i = newlen; i; i--) { |
4965
|
166106
|
|
|
|
|
SV * const h = *dst; |
4966
|
166106
|
|
|
|
|
*dst++ = newSVsv(h); |
4967
|
|
|
|
|
|
} |
4968
|
|
|
|
|
|
|
4969
|
650646
|
100
|
|
|
|
if (diff < 0) { /* shrinking the area */ |
4970
|
|
|
|
|
|
SV **tmparyval = NULL; |
4971
|
472572
|
100
|
|
|
|
if (newlen) { |
4972
|
5544
|
50
|
|
|
|
Newx(tmparyval, newlen, SV*); /* so remember insertion */ |
4973
|
5544
|
50
|
|
|
|
Copy(MARK, tmparyval, newlen, SV*); |
4974
|
|
|
|
|
|
} |
4975
|
|
|
|
|
|
|
4976
|
472572
|
|
|
|
|
MARK = ORIGMARK + 1; |
4977
|
472572
|
100
|
|
|
|
if (GIMME == G_ARRAY) { /* copy return vals to stack */ |
|
|
100
|
|
|
|
|
4978
|
184256
|
50
|
|
|
|
MEXTEND(MARK, length); |
4979
|
184256
|
50
|
|
|
|
Copy(AvARRAY(ary)+offset, MARK, length, SV*); |
4980
|
184256
|
100
|
|
|
|
if (AvREAL(ary)) { |
4981
|
80834
|
50
|
|
|
|
EXTEND_MORTAL(length); |
4982
|
264206
|
100
|
|
|
|
for (i = length, dst = MARK; i; i--) { |
4983
|
183372
|
|
|
|
|
sv_2mortal(*dst); /* free them eventually */ |
4984
|
183372
|
|
|
|
|
dst++; |
4985
|
|
|
|
|
|
} |
4986
|
|
|
|
|
|
} |
4987
|
184256
|
|
|
|
|
MARK += length - 1; |
4988
|
|
|
|
|
|
} |
4989
|
|
|
|
|
|
else { |
4990
|
288316
|
|
|
|
|
*MARK = AvARRAY(ary)[offset+length-1]; |
4991
|
288316
|
50
|
|
|
|
if (AvREAL(ary)) { |
4992
|
288316
|
|
|
|
|
sv_2mortal(*MARK); |
4993
|
831182
|
100
|
|
|
|
for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--) |
4994
|
542866
|
|
|
|
|
SvREFCNT_dec(*dst++); /* free them now */ |
4995
|
|
|
|
|
|
} |
4996
|
|
|
|
|
|
} |
4997
|
472572
|
|
|
|
|
AvFILLp(ary) += diff; |
4998
|
|
|
|
|
|
|
4999
|
|
|
|
|
|
/* pull up or down? */ |
5000
|
|
|
|
|
|
|
5001
|
472572
|
100
|
|
|
|
if (offset < after) { /* easier to pull up */ |
5002
|
152918
|
100
|
|
|
|
if (offset) { /* esp. if nothing to pull */ |
5003
|
7336
|
|
|
|
|
src = &AvARRAY(ary)[offset-1]; |
5004
|
7336
|
|
|
|
|
dst = src - diff; /* diff is negative */ |
5005
|
582422
|
100
|
|
|
|
for (i = offset; i > 0; i--) /* can't trust Copy */ |
5006
|
575086
|
|
|
|
|
*dst-- = *src--; |
5007
|
|
|
|
|
|
} |
5008
|
152918
|
|
|
|
|
dst = AvARRAY(ary); |
5009
|
152918
|
|
|
|
|
AvARRAY(ary) = AvARRAY(ary) - diff; /* diff is negative */ |
5010
|
152918
|
|
|
|
|
AvMAX(ary) += diff; |
5011
|
|
|
|
|
|
} |
5012
|
|
|
|
|
|
else { |
5013
|
319654
|
100
|
|
|
|
if (after) { /* anything to pull down? */ |
5014
|
3858
|
|
|
|
|
src = AvARRAY(ary) + offset + length; |
5015
|
3858
|
|
|
|
|
dst = src + diff; /* diff is negative */ |
5016
|
3858
|
50
|
|
|
|
Move(src, dst, after, SV*); |
5017
|
|
|
|
|
|
} |
5018
|
319654
|
|
|
|
|
dst = &AvARRAY(ary)[AvFILLp(ary)+1]; |
5019
|
|
|
|
|
|
/* avoid later double free */ |
5020
|
|
|
|
|
|
} |
5021
|
472572
|
|
|
|
|
i = -diff; |
5022
|
1925982
|
100
|
|
|
|
while (i) |
5023
|
1226844
|
|
|
|
|
dst[--i] = NULL; |
5024
|
|
|
|
|
|
|
5025
|
472572
|
100
|
|
|
|
if (newlen) { |
5026
|
5544
|
50
|
|
|
|
Copy( tmparyval, AvARRAY(ary) + offset, newlen, SV* ); |
5027
|
5544
|
|
|
|
|
Safefree(tmparyval); |
5028
|
|
|
|
|
|
} |
5029
|
|
|
|
|
|
} |
5030
|
|
|
|
|
|
else { /* no, expanding (or same) */ |
5031
|
|
|
|
|
|
SV** tmparyval = NULL; |
5032
|
178074
|
100
|
|
|
|
if (length) { |
5033
|
4732
|
50
|
|
|
|
Newx(tmparyval, length, SV*); /* so remember deletion */ |
5034
|
4732
|
50
|
|
|
|
Copy(AvARRAY(ary)+offset, tmparyval, length, SV*); |
5035
|
|
|
|
|
|
} |
5036
|
|
|
|
|
|
|
5037
|
178074
|
100
|
|
|
|
if (diff > 0) { /* expanding */ |
5038
|
|
|
|
|
|
/* push up or down? */ |
5039
|
153858
|
100
|
|
|
|
if (offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) { |
|
|
100
|
|
|
|
|
5040
|
200
|
100
|
|
|
|
if (offset) { |
5041
|
194
|
|
|
|
|
src = AvARRAY(ary); |
5042
|
194
|
|
|
|
|
dst = src - diff; |
5043
|
194
|
50
|
|
|
|
Move(src, dst, offset, SV*); |
5044
|
|
|
|
|
|
} |
5045
|
200
|
|
|
|
|
AvARRAY(ary) = AvARRAY(ary) - diff;/* diff is positive */ |
5046
|
200
|
|
|
|
|
AvMAX(ary) += diff; |
5047
|
200
|
|
|
|
|
AvFILLp(ary) += diff; |
5048
|
|
|
|
|
|
} |
5049
|
|
|
|
|
|
else { |
5050
|
153658
|
100
|
|
|
|
if (AvFILLp(ary) + diff >= AvMAX(ary)) /* oh, well */ |
5051
|
8448
|
|
|
|
|
av_extend(ary, AvFILLp(ary) + diff); |
5052
|
153658
|
|
|
|
|
AvFILLp(ary) += diff; |
5053
|
|
|
|
|
|
|
5054
|
153658
|
100
|
|
|
|
if (after) { |
5055
|
133188
|
|
|
|
|
dst = AvARRAY(ary) + AvFILLp(ary); |
5056
|
133188
|
|
|
|
|
src = dst - diff; |
5057
|
163809128
|
100
|
|
|
|
for (i = after; i; i--) { |
5058
|
163675940
|
|
|
|
|
*dst-- = *src--; |
5059
|
|
|
|
|
|
} |
5060
|
|
|
|
|
|
} |
5061
|
|
|
|
|
|
} |
5062
|
|
|
|
|
|
} |
5063
|
|
|
|
|
|
|
5064
|
178074
|
100
|
|
|
|
if (newlen) { |
5065
|
158038
|
50
|
|
|
|
Copy( MARK, AvARRAY(ary) + offset, newlen, SV* ); |
5066
|
|
|
|
|
|
} |
5067
|
|
|
|
|
|
|
5068
|
178074
|
|
|
|
|
MARK = ORIGMARK + 1; |
5069
|
178074
|
100
|
|
|
|
if (GIMME == G_ARRAY) { /* copy return vals to stack */ |
|
|
100
|
|
|
|
|
5070
|
53532
|
100
|
|
|
|
if (length) { |
5071
|
822
|
50
|
|
|
|
Copy(tmparyval, MARK, length, SV*); |
5072
|
822
|
50
|
|
|
|
if (AvREAL(ary)) { |
5073
|
822
|
50
|
|
|
|
EXTEND_MORTAL(length); |
5074
|
1718
|
100
|
|
|
|
for (i = length, dst = MARK; i; i--) { |
5075
|
896
|
|
|
|
|
sv_2mortal(*dst); /* free them eventually */ |
5076
|
896
|
|
|
|
|
dst++; |
5077
|
|
|
|
|
|
} |
5078
|
|
|
|
|
|
} |
5079
|
|
|
|
|
|
} |
5080
|
53532
|
|
|
|
|
MARK += length - 1; |
5081
|
|
|
|
|
|
} |
5082
|
124542
|
100
|
|
|
|
else if (length--) { |
5083
|
3910
|
|
|
|
|
*MARK = tmparyval[length]; |
5084
|
3910
|
50
|
|
|
|
if (AvREAL(ary)) { |
5085
|
3910
|
|
|
|
|
sv_2mortal(*MARK); |
5086
|
6809
|
100
|
|
|
|
while (length-- > 0) |
5087
|
944
|
|
|
|
|
SvREFCNT_dec(tmparyval[length]); |
5088
|
|
|
|
|
|
} |
5089
|
|
|
|
|
|
} |
5090
|
|
|
|
|
|
else |
5091
|
120632
|
|
|
|
|
*MARK = &PL_sv_undef; |
5092
|
178074
|
|
|
|
|
Safefree(tmparyval); |
5093
|
|
|
|
|
|
} |
5094
|
|
|
|
|
|
|
5095
|
650646
|
100
|
|
|
|
if (SvMAGICAL(ary)) |
5096
|
32
|
|
|
|
|
mg_set(MUTABLE_SV(ary)); |
5097
|
|
|
|
|
|
|
5098
|
|
|
|
|
|
SP = MARK; |
5099
|
651061
|
|
|
|
|
RETURN; |
5100
|
|
|
|
|
|
} |
5101
|
|
|
|
|
|
|
5102
|
23315781
|
|
|
|
|
PP(pp_push) |
5103
|
|
|
|
|
|
{ |
5104
|
23315781
|
|
|
|
|
dVAR; dSP; dMARK; dORIGMARK; dTARGET; |
5105
|
23315781
|
100
|
|
|
|
AV * const ary = DEREF_PLAIN_ARRAY(MUTABLE_AV(*++MARK)); |
5106
|
23315763
|
100
|
|
|
|
const MAGIC * const mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied); |
5107
|
|
|
|
|
|
|
5108
|
23315763
|
100
|
|
|
|
if (mg) { |
5109
|
62
|
50
|
|
|
|
*MARK-- = SvTIED_obj(MUTABLE_SV(ary), mg); |
5110
|
62
|
50
|
|
|
|
PUSHMARK(MARK); |
5111
|
62
|
|
|
|
|
PUTBACK; |
5112
|
62
|
|
|
|
|
ENTER_with_name("call_PUSH"); |
5113
|
62
|
100
|
|
|
|
call_sv(SV_CONST(PUSH),G_SCALAR|G_DISCARD|G_METHOD_NAMED); |
5114
|
62
|
|
|
|
|
LEAVE_with_name("call_PUSH"); |
5115
|
|
|
|
|
|
SPAGAIN; |
5116
|
|
|
|
|
|
} |
5117
|
|
|
|
|
|
else { |
5118
|
23315701
|
100
|
|
|
|
if (SvREADONLY(ary) && MARK < SP) Perl_croak_no_modify(); |
5119
|
23315697
|
|
|
|
|
PL_delaymagic = DM_DELAY; |
5120
|
47784166
|
100
|
|
|
|
for (++MARK; MARK <= SP; MARK++) { |
5121
|
|
|
|
|
|
SV *sv; |
5122
|
24468473
|
50
|
|
|
|
if (*MARK) SvGETMAGIC(*MARK); |
|
|
100
|
|
|
|
|
5123
|
24468469
|
|
|
|
|
sv = newSV(0); |
5124
|
24468469
|
50
|
|
|
|
if (*MARK) |
5125
|
24468469
|
|
|
|
|
sv_setsv_nomg(sv, *MARK); |
5126
|
24468469
|
|
|
|
|
av_store(ary, AvFILLp(ary)+1, sv); |
5127
|
|
|
|
|
|
} |
5128
|
23315693
|
100
|
|
|
|
if (PL_delaymagic & DM_ARRAY_ISA) |
5129
|
77440
|
|
|
|
|
mg_set(MUTABLE_SV(ary)); |
5130
|
|
|
|
|
|
|
5131
|
23315685
|
|
|
|
|
PL_delaymagic = 0; |
5132
|
|
|
|
|
|
} |
5133
|
23315747
|
|
|
|
|
SP = ORIGMARK; |
5134
|
23315747
|
100
|
|
|
|
if (OP_GIMME(PL_op, 0) != G_VOID) { |
5135
|
1723163
|
100
|
|
|
|
PUSHi( AvFILL(ary) + 1 ); |
|
|
50
|
|
|
|
|
5136
|
|
|
|
|
|
} |
5137
|
23315747
|
|
|
|
|
RETURN; |
5138
|
|
|
|
|
|
} |
5139
|
|
|
|
|
|
|
5140
|
220768739
|
|
|
|
|
PP(pp_shift) |
5141
|
220768739
|
50
|
|
|
|
{ |
5142
|
|
|
|
|
|
dVAR; |
5143
|
220768739
|
|
|
|
|
dSP; |
5144
|
220768739
|
|
|
|
|
AV * const av = PL_op->op_flags & OPf_SPECIAL |
5145
|
220768739
|
100
|
|
|
|
? MUTABLE_AV(GvAV(PL_defgv)) : DEREF_PLAIN_ARRAY(MUTABLE_AV(POPs)); |
|
|
100
|
|
|
|
|
5146
|
220768739
|
100
|
|
|
|
SV * const sv = PL_op->op_type == OP_SHIFT ? av_shift(av) : av_pop(av); |
5147
|
110238690
|
|
|
|
|
EXTEND(SP, 1); |
5148
|
|
|
|
|
|
assert (sv); |
5149
|
220768739
|
100
|
|
|
|
if (AvREAL(av)) |
5150
|
7684562
|
|
|
|
|
(void)sv_2mortal(sv); |
5151
|
220768739
|
|
|
|
|
PUSHs(sv); |
5152
|
220768739
|
|
|
|
|
RETURN; |
5153
|
|
|
|
|
|
} |
5154
|
|
|
|
|
|
|
5155
|
3819867
|
|
|
|
|
PP(pp_unshift) |
5156
|
|
|
|
|
|
{ |
5157
|
3819867
|
|
|
|
|
dVAR; dSP; dMARK; dORIGMARK; dTARGET; |
5158
|
3819867
|
100
|
|
|
|
AV *ary = DEREF_PLAIN_ARRAY(MUTABLE_AV(*++MARK)); |
5159
|
3819867
|
100
|
|
|
|
const MAGIC * const mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied); |
5160
|
|
|
|
|
|
|
5161
|
3819867
|
100
|
|
|
|
if (mg) { |
5162
|
20
|
50
|
|
|
|
*MARK-- = SvTIED_obj(MUTABLE_SV(ary), mg); |
5163
|
20
|
50
|
|
|
|
PUSHMARK(MARK); |
5164
|
20
|
|
|
|
|
PUTBACK; |
5165
|
20
|
|
|
|
|
ENTER_with_name("call_UNSHIFT"); |
5166
|
20
|
100
|
|
|
|
call_sv(SV_CONST(UNSHIFT),G_SCALAR|G_DISCARD|G_METHOD_NAMED); |
5167
|
20
|
|
|
|
|
LEAVE_with_name("call_UNSHIFT"); |
5168
|
|
|
|
|
|
SPAGAIN; |
5169
|
|
|
|
|
|
} |
5170
|
|
|
|
|
|
else { |
5171
|
|
|
|
|
|
SSize_t i = 0; |
5172
|
3819847
|
|
|
|
|
av_unshift(ary, SP - MARK); |
5173
|
9690149
|
100
|
|
|
|
while (MARK < SP) { |
5174
|
3970907
|
|
|
|
|
SV * const sv = newSVsv(*++MARK); |
5175
|
3970907
|
|
|
|
|
(void)av_store(ary, i++, sv); |
5176
|
|
|
|
|
|
} |
5177
|
|
|
|
|
|
} |
5178
|
3819867
|
|
|
|
|
SP = ORIGMARK; |
5179
|
3819867
|
100
|
|
|
|
if (OP_GIMME(PL_op, 0) != G_VOID) { |
5180
|
4502
|
100
|
|
|
|
PUSHi( AvFILL(ary) + 1 ); |
|
|
100
|
|
|
|
|
5181
|
|
|
|
|
|
} |
5182
|
3819867
|
|
|
|
|
RETURN; |
5183
|
|
|
|
|
|
} |
5184
|
|
|
|
|
|
|
5185
|
207184
|
|
|
|
|
PP(pp_reverse) |
5186
|
|
|
|
|
|
{ |
5187
|
207184
|
|
|
|
|
dVAR; dSP; dMARK; |
5188
|
|
|
|
|
|
|
5189
|
207184
|
100
|
|
|
|
if (GIMME == G_ARRAY) { |
|
|
100
|
|
|
|
|
5190
|
37642
|
100
|
|
|
|
if (PL_op->op_private & OPpREVERSE_INPLACE) { |
5191
|
|
|
|
|
|
AV *av; |
5192
|
|
|
|
|
|
|
5193
|
|
|
|
|
|
/* See pp_sort() */ |
5194
|
|
|
|
|
|
assert( MARK+1 == SP && *SP && SvTYPE(*SP) == SVt_PVAV); |
5195
|
36
|
|
|
|
|
(void)POPMARK; /* remove mark associated with ex-OP_AASSIGN */ |
5196
|
36
|
|
|
|
|
av = MUTABLE_AV((*SP)); |
5197
|
|
|
|
|
|
/* In-place reversing only happens in void context for the array |
5198
|
|
|
|
|
|
* assignment. We don't need to push anything on the stack. */ |
5199
|
|
|
|
|
|
SP = MARK; |
5200
|
|
|
|
|
|
|
5201
|
36
|
100
|
|
|
|
if (SvMAGICAL(av)) { |
5202
|
|
|
|
|
|
SSize_t i, j; |
5203
|
16
|
|
|
|
|
SV *tmp = sv_newmortal(); |
5204
|
|
|
|
|
|
/* For SvCANEXISTDELETE */ |
5205
|
|
|
|
|
|
HV *stash; |
5206
|
|
|
|
|
|
const MAGIC *mg; |
5207
|
16
|
50
|
|
|
|
bool can_preserve = SvCANEXISTDELETE(av); |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
5208
|
|
|
|
|
|
|
5209
|
40
|
100
|
|
|
|
for (i = 0, j = av_len(av); i < j; ++i, --j) { |
5210
|
|
|
|
|
|
SV *begin, *end; |
5211
|
|
|
|
|
|
|
5212
|
24
|
50
|
|
|
|
if (can_preserve) { |
5213
|
24
|
100
|
|
|
|
if (!av_exists(av, i)) { |
5214
|
4
|
50
|
|
|
|
if (av_exists(av, j)) { |
5215
|
4
|
|
|
|
|
SV *sv = av_delete(av, j, 0); |
5216
|
4
|
|
|
|
|
begin = *av_fetch(av, i, TRUE); |
5217
|
4
|
|
|
|
|
sv_setsv_mg(begin, sv); |
5218
|
|
|
|
|
|
} |
5219
|
4
|
|
|
|
|
continue; |
5220
|
|
|
|
|
|
} |
5221
|
20
|
100
|
|
|
|
else if (!av_exists(av, j)) { |
5222
|
2
|
|
|
|
|
SV *sv = av_delete(av, i, 0); |
5223
|
2
|
|
|
|
|
end = *av_fetch(av, j, TRUE); |
5224
|
2
|
|
|
|
|
sv_setsv_mg(end, sv); |
5225
|
2
|
|
|
|
|
continue; |
5226
|
|
|
|
|
|
} |
5227
|
|
|
|
|
|
} |
5228
|
|
|
|
|
|
|
5229
|
18
|
|
|
|
|
begin = *av_fetch(av, i, TRUE); |
5230
|
18
|
|
|
|
|
end = *av_fetch(av, j, TRUE); |
5231
|
18
|
|
|
|
|
sv_setsv(tmp, begin); |
5232
|
18
|
|
|
|
|
sv_setsv_mg(begin, end); |
5233
|
18
|
|
|
|
|
sv_setsv_mg(end, tmp); |
5234
|
|
|
|
|
|
} |
5235
|
|
|
|
|
|
} |
5236
|
|
|
|
|
|
else { |
5237
|
20
|
|
|
|
|
SV **begin = AvARRAY(av); |
5238
|
|
|
|
|
|
|
5239
|
20
|
100
|
|
|
|
if (begin) { |
5240
|
18
|
|
|
|
|
SV **end = begin + AvFILLp(av); |
5241
|
|
|
|
|
|
|
5242
|
53
|
100
|
|
|
|
while (begin < end) { |
5243
|
26
|
|
|
|
|
SV * const tmp = *begin; |
5244
|
26
|
|
|
|
|
*begin++ = *end; |
5245
|
26
|
|
|
|
|
*end-- = tmp; |
5246
|
|
|
|
|
|
} |
5247
|
|
|
|
|
|
} |
5248
|
|
|
|
|
|
} |
5249
|
|
|
|
|
|
} |
5250
|
|
|
|
|
|
else { |
5251
|
|
|
|
|
|
SV **oldsp = SP; |
5252
|
37606
|
|
|
|
|
MARK++; |
5253
|
289471
|
100
|
|
|
|
while (MARK < SP) { |
5254
|
233062
|
|
|
|
|
SV * const tmp = *MARK; |
5255
|
233062
|
|
|
|
|
*MARK++ = *SP; |
5256
|
233062
|
|
|
|
|
*SP-- = tmp; |
5257
|
|
|
|
|
|
} |
5258
|
|
|
|
|
|
/* safe as long as stack cannot get extended in the above */ |
5259
|
|
|
|
|
|
SP = oldsp; |
5260
|
|
|
|
|
|
} |
5261
|
|
|
|
|
|
} |
5262
|
|
|
|
|
|
else { |
5263
|
|
|
|
|
|
char *up; |
5264
|
|
|
|
|
|
char *down; |
5265
|
|
|
|
|
|
I32 tmp; |
5266
|
169542
|
|
|
|
|
dTARGET; |
5267
|
|
|
|
|
|
STRLEN len; |
5268
|
|
|
|
|
|
|
5269
|
169542
|
|
|
|
|
SvUTF8_off(TARG); /* decontaminate */ |
5270
|
169542
|
100
|
|
|
|
if (SP - MARK > 1) |
5271
|
46
|
|
|
|
|
do_join(TARG, &PL_sv_no, MARK, SP); |
5272
|
|
|
|
|
|
else { |
5273
|
169496
|
100
|
|
|
|
sv_setsv(TARG, SP > MARK ? *SP : find_rundefsv()); |
5274
|
|
|
|
|
|
} |
5275
|
|
|
|
|
|
|
5276
|
169542
|
100
|
|
|
|
up = SvPV_force(TARG, len); |
5277
|
169542
|
100
|
|
|
|
if (len > 1) { |
5278
|
106790
|
100
|
|
|
|
if (DO_UTF8(TARG)) { /* first reverse each character */ |
|
|
50
|
|
|
|
|
5279
|
14
|
|
|
|
|
U8* s = (U8*)SvPVX(TARG); |
5280
|
14
|
|
|
|
|
const U8* send = (U8*)(s + len); |
5281
|
103
|
100
|
|
|
|
while (s < send) { |
5282
|
82
|
100
|
|
|
|
if (UTF8_IS_INVARIANT(*s)) { |
5283
|
58
|
|
|
|
|
s++; |
5284
|
58
|
|
|
|
|
continue; |
5285
|
|
|
|
|
|
} |
5286
|
|
|
|
|
|
else { |
5287
|
24
|
50
|
|
|
|
if (!utf8_to_uvchr_buf(s, send, 0)) |
|
|
50
|
|
|
|
|
5288
|
|
|
|
|
|
break; |
5289
|
|
|
|
|
|
up = (char*)s; |
5290
|
24
|
|
|
|
|
s += UTF8SKIP(s); |
5291
|
24
|
|
|
|
|
down = (char*)(s - 1); |
5292
|
|
|
|
|
|
/* reverse this character */ |
5293
|
89
|
100
|
|
|
|
while (down > up) { |
5294
|
24
|
|
|
|
|
tmp = *up; |
5295
|
24
|
|
|
|
|
*up++ = *down; |
5296
|
24
|
|
|
|
|
*down-- = (char)tmp; |
5297
|
|
|
|
|
|
} |
5298
|
|
|
|
|
|
} |
5299
|
|
|
|
|
|
} |
5300
|
14
|
|
|
|
|
up = SvPVX(TARG); |
5301
|
|
|
|
|
|
} |
5302
|
106790
|
|
|
|
|
down = SvPVX(TARG) + len - 1; |
5303
|
269397
|
100
|
|
|
|
while (down > up) { |
5304
|
109212
|
|
|
|
|
tmp = *up; |
5305
|
109212
|
|
|
|
|
*up++ = *down; |
5306
|
109212
|
|
|
|
|
*down-- = (char)tmp; |
5307
|
|
|
|
|
|
} |
5308
|
106790
|
|
|
|
|
(void)SvPOK_only_UTF8(TARG); |
5309
|
|
|
|
|
|
} |
5310
|
169542
|
|
|
|
|
SP = MARK + 1; |
5311
|
169542
|
50
|
|
|
|
SETTARG; |
5312
|
|
|
|
|
|
} |
5313
|
207184
|
|
|
|
|
RETURN; |
5314
|
|
|
|
|
|
} |
5315
|
|
|
|
|
|
|
5316
|
4476822
|
|
|
|
|
PP(pp_split) |
5317
|
|
|
|
|
|
{ |
5318
|
4476822
|
|
|
|
|
dVAR; dSP; dTARG; |
5319
|
|
|
|
|
|
AV *ary; |
5320
|
4476822
|
100
|
|
|
|
IV limit = POPi; /* note, negative is forever */ |
5321
|
4476822
|
|
|
|
|
SV * const sv = POPs; |
5322
|
|
|
|
|
|
STRLEN len; |
5323
|
4476822
|
100
|
|
|
|
const char *s = SvPV_const(sv, len); |
5324
|
4476822
|
100
|
|
|
|
const bool do_utf8 = DO_UTF8(sv); |
|
|
50
|
|
|
|
|
5325
|
4476822
|
|
|
|
|
const char *strend = s + len; |
5326
|
|
|
|
|
|
PMOP *pm; |
5327
|
|
|
|
|
|
REGEXP *rx; |
5328
|
|
|
|
|
|
SV *dstr; |
5329
|
|
|
|
|
|
const char *m; |
5330
|
|
|
|
|
|
SSize_t iters = 0; |
5331
|
|
|
|
|
|
const STRLEN slen = do_utf8 |
5332
|
|
|
|
|
|
? utf8_length((U8*)s, (U8*)strend) |
5333
|
4476822
|
100
|
|
|
|
: (STRLEN)(strend - s); |
5334
|
4476822
|
|
|
|
|
SSize_t maxiters = slen + 10; |
5335
|
|
|
|
|
|
I32 trailing_empty = 0; |
5336
|
|
|
|
|
|
const char *orig; |
5337
|
4476822
|
|
|
|
|
const I32 origlimit = limit; |
5338
|
|
|
|
|
|
I32 realarray = 0; |
5339
|
|
|
|
|
|
I32 base; |
5340
|
4476822
|
100
|
|
|
|
const I32 gimme = GIMME_V; |
5341
|
|
|
|
|
|
bool gimme_scalar; |
5342
|
4476822
|
|
|
|
|
const I32 oldsave = PL_savestack_ix; |
5343
|
|
|
|
|
|
U32 make_mortal = SVs_TEMP; |
5344
|
|
|
|
|
|
bool multiline = 0; |
5345
|
|
|
|
|
|
MAGIC *mg = NULL; |
5346
|
|
|
|
|
|
|
5347
|
|
|
|
|
|
#ifdef DEBUGGING |
5348
|
|
|
|
|
|
Copy(&LvTARGOFF(POPs), &pm, 1, PMOP*); |
5349
|
|
|
|
|
|
#else |
5350
|
4476822
|
|
|
|
|
pm = (PMOP*)POPs; |
5351
|
|
|
|
|
|
#endif |
5352
|
4476822
|
50
|
|
|
|
if (!pm || !s) |
5353
|
0
|
|
|
|
|
DIE(aTHX_ "panic: pp_split, pm=%p, s=%p", pm, s); |
5354
|
4476822
|
|
|
|
|
rx = PM_GETRE(pm); |
5355
|
|
|
|
|
|
|
5356
|
6709937
|
100
|
|
|
|
TAINT_IF(get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET && |
|
|
50
|
|
|
|
|
5357
|
|
|
|
|
|
(RX_EXTFLAGS(rx) & (RXf_WHITE | RXf_SKIPWHITE))); |
5358
|
|
|
|
|
|
|
5359
|
|
|
|
|
|
#ifdef USE_ITHREADS |
5360
|
|
|
|
|
|
if (pm->op_pmreplrootu.op_pmtargetoff) { |
5361
|
|
|
|
|
|
ary = GvAVn(MUTABLE_GV(PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff))); |
5362
|
|
|
|
|
|
} |
5363
|
|
|
|
|
|
#else |
5364
|
4476822
|
100
|
|
|
|
if (pm->op_pmreplrootu.op_pmtargetgv) { |
5365
|
572
|
50
|
|
|
|
ary = GvAVn(pm->op_pmreplrootu.op_pmtargetgv); |
5366
|
|
|
|
|
|
} |
5367
|
|
|
|
|
|
#endif |
5368
|
|
|
|
|
|
else |
5369
|
|
|
|
|
|
ary = NULL; |
5370
|
4476822
|
100
|
|
|
|
if (ary) { |
5371
|
|
|
|
|
|
realarray = 1; |
5372
|
572
|
|
|
|
|
PUTBACK; |
5373
|
572
|
|
|
|
|
av_extend(ary,0); |
5374
|
572
|
|
|
|
|
av_clear(ary); |
5375
|
572
|
|
|
|
|
SPAGAIN; |
5376
|
572
|
100
|
|
|
|
if ((mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied))) { |
|
|
100
|
|
|
|
|
5377
|
2
|
50
|
|
|
|
PUSHMARK(SP); |
5378
|
2
|
50
|
|
|
|
XPUSHs(SvTIED_obj(MUTABLE_SV(ary), mg)); |
|
|
50
|
|
|
|
|
5379
|
|
|
|
|
|
} |
5380
|
|
|
|
|
|
else { |
5381
|
570
|
50
|
|
|
|
if (!AvREAL(ary)) { |
5382
|
|
|
|
|
|
I32 i; |
5383
|
0
|
|
|
|
|
AvREAL_on(ary); |
5384
|
0
|
|
|
|
|
AvREIFY_off(ary); |
5385
|
0
|
0
|
|
|
|
for (i = AvFILLp(ary); i >= 0; i--) |
5386
|
0
|
|
|
|
|
AvARRAY(ary)[i] = &PL_sv_undef; /* don't free mere refs */ |
5387
|
|
|
|
|
|
} |
5388
|
|
|
|
|
|
/* temporarily switch stacks */ |
5389
|
570
|
|
|
|
|
SAVESWITCHSTACK(PL_curstack, ary); |
5390
|
|
|
|
|
|
make_mortal = 0; |
5391
|
|
|
|
|
|
} |
5392
|
|
|
|
|
|
} |
5393
|
4476822
|
|
|
|
|
base = SP - PL_stack_base; |
5394
|
|
|
|
|
|
orig = s; |
5395
|
4476822
|
100
|
|
|
|
if (RX_EXTFLAGS(rx) & RXf_SKIPWHITE) { |
5396
|
182528
|
100
|
|
|
|
if (do_utf8) { |
5397
|
308
|
100
|
|
|
|
while (isSPACE_utf8(s)) |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
5398
|
200
|
|
|
|
|
s += UTF8SKIP(s); |
5399
|
|
|
|
|
|
} |
5400
|
273630
|
50
|
|
|
|
else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET) { |
5401
|
0
|
0
|
|
|
|
while (isSPACE_LC(*s)) |
5402
|
0
|
|
|
|
|
s++; |
5403
|
|
|
|
|
|
} |
5404
|
|
|
|
|
|
else { |
5405
|
196874
|
100
|
|
|
|
while (isSPACE(*s)) |
5406
|
14454
|
|
|
|
|
s++; |
5407
|
|
|
|
|
|
} |
5408
|
|
|
|
|
|
} |
5409
|
4476822
|
100
|
|
|
|
if (RX_EXTFLAGS(rx) & RXf_PMf_MULTILINE) { |
5410
|
|
|
|
|
|
multiline = 1; |
5411
|
|
|
|
|
|
} |
5412
|
|
|
|
|
|
|
5413
|
4476822
|
|
|
|
|
gimme_scalar = gimme == G_SCALAR && !ary; |
5414
|
|
|
|
|
|
|
5415
|
4476822
|
100
|
|
|
|
if (!limit) |
5416
|
1882612
|
|
|
|
|
limit = maxiters + 2; |
5417
|
4476822
|
100
|
|
|
|
if (RX_EXTFLAGS(rx) & RXf_WHITE) { |
5418
|
1845070
|
100
|
|
|
|
while (--limit) { |
5419
|
|
|
|
|
|
m = s; |
5420
|
|
|
|
|
|
/* this one uses 'm' and is a negative test */ |
5421
|
1844422
|
100
|
|
|
|
if (do_utf8) { |
5422
|
2156
|
100
|
|
|
|
while (m < strend && ! isSPACE_utf8(m) ) { |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
5423
|
1440
|
|
|
|
|
const int t = UTF8SKIP(m); |
5424
|
|
|
|
|
|
/* isSPACE_utf8 returns FALSE for malform utf8 */ |
5425
|
1440
|
50
|
|
|
|
if (strend - m < t) |
5426
|
|
|
|
|
|
m = strend; |
5427
|
|
|
|
|
|
else |
5428
|
1440
|
|
|
|
|
m += t; |
5429
|
|
|
|
|
|
} |
5430
|
|
|
|
|
|
} |
5431
|
2753319
|
50
|
|
|
|
else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET) |
5432
|
|
|
|
|
|
{ |
5433
|
0
|
0
|
|
|
|
while (m < strend && !isSPACE_LC(*m)) |
|
|
0
|
|
|
|
|
5434
|
0
|
|
|
|
|
++m; |
5435
|
|
|
|
|
|
} else { |
5436
|
8632722
|
100
|
|
|
|
while (m < strend && !isSPACE(*m)) |
|
|
100
|
|
|
|
|
5437
|
6789016
|
|
|
|
|
++m; |
5438
|
|
|
|
|
|
} |
5439
|
1844422
|
100
|
|
|
|
if (m >= strend) |
5440
|
|
|
|
|
|
break; |
5441
|
|
|
|
|
|
|
5442
|
1484416
|
100
|
|
|
|
if (gimme_scalar) { |
5443
|
218
|
|
|
|
|
iters++; |
5444
|
218
|
100
|
|
|
|
if (m-s == 0) |
5445
|
50
|
|
|
|
|
trailing_empty++; |
5446
|
|
|
|
|
|
else |
5447
|
|
|
|
|
|
trailing_empty = 0; |
5448
|
|
|
|
|
|
} else { |
5449
|
1484198
|
100
|
|
|
|
dstr = newSVpvn_flags(s, m-s, |
5450
|
|
|
|
|
|
(do_utf8 ? SVf_UTF8 : 0) | make_mortal); |
5451
|
1484198
|
50
|
|
|
|
XPUSHs(dstr); |
5452
|
|
|
|
|
|
} |
5453
|
|
|
|
|
|
|
5454
|
|
|
|
|
|
/* skip the whitespace found last */ |
5455
|
1484416
|
100
|
|
|
|
if (do_utf8) |
5456
|
416
|
|
|
|
|
s = m + UTF8SKIP(m); |
5457
|
|
|
|
|
|
else |
5458
|
1484000
|
|
|
|
|
s = m + 1; |
5459
|
|
|
|
|
|
|
5460
|
|
|
|
|
|
/* this one uses 's' and is a positive test */ |
5461
|
1484416
|
100
|
|
|
|
if (do_utf8) { |
5462
|
716
|
100
|
|
|
|
while (s < strend && isSPACE_utf8(s) ) |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
5463
|
300
|
|
|
|
|
s += UTF8SKIP(s); |
5464
|
|
|
|
|
|
} |
5465
|
2216460
|
50
|
|
|
|
else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET) |
5466
|
|
|
|
|
|
{ |
5467
|
0
|
0
|
|
|
|
while (s < strend && isSPACE_LC(*s)) |
|
|
0
|
|
|
|
|
5468
|
0
|
|
|
|
|
++s; |
5469
|
|
|
|
|
|
} else { |
5470
|
1510710
|
100
|
|
|
|
while (s < strend && isSPACE(*s)) |
|
|
100
|
|
|
|
|
5471
|
26502
|
|
|
|
|
++s; |
5472
|
|
|
|
|
|
} |
5473
|
|
|
|
|
|
} |
5474
|
|
|
|
|
|
} |
5475
|
4116168
|
100
|
|
|
|
else if (RX_EXTFLAGS(rx) & RXf_START_ONLY) { |
5476
|
235860
|
50
|
|
|
|
while (--limit) { |
5477
|
5341012
|
100
|
|
|
|
for (m = s; m < strend && *m != '\n'; m++) |
|
|
100
|
|
|
|
|
5478
|
|
|
|
|
|
; |
5479
|
235860
|
|
|
|
|
m++; |
5480
|
235860
|
100
|
|
|
|
if (m >= strend) |
5481
|
|
|
|
|
|
break; |
5482
|
|
|
|
|
|
|
5483
|
66438
|
50
|
|
|
|
if (gimme_scalar) { |
5484
|
0
|
|
|
|
|
iters++; |
5485
|
0
|
0
|
|
|
|
if (m-s == 0) |
5486
|
0
|
|
|
|
|
trailing_empty++; |
5487
|
|
|
|
|
|
else |
5488
|
|
|
|
|
|
trailing_empty = 0; |
5489
|
|
|
|
|
|
} else { |
5490
|
66438
|
100
|
|
|
|
dstr = newSVpvn_flags(s, m-s, |
5491
|
|
|
|
|
|
(do_utf8 ? SVf_UTF8 : 0) | make_mortal); |
5492
|
66438
|
100
|
|
|
|
XPUSHs(dstr); |
5493
|
|
|
|
|
|
} |
5494
|
|
|
|
|
|
s = m; |
5495
|
|
|
|
|
|
} |
5496
|
|
|
|
|
|
} |
5497
|
3946746
|
100
|
|
|
|
else if (RX_EXTFLAGS(rx) & RXf_NULL && !(s >= strend)) { |
|
|
100
|
|
|
|
|
5498
|
|
|
|
|
|
/* |
5499
|
|
|
|
|
|
Pre-extend the stack, either the number of bytes or |
5500
|
|
|
|
|
|
characters in the string or a limited amount, triggered by: |
5501
|
|
|
|
|
|
|
5502
|
|
|
|
|
|
my ($x, $y) = split //, $str; |
5503
|
|
|
|
|
|
or |
5504
|
|
|
|
|
|
split //, $str, $i; |
5505
|
|
|
|
|
|
*/ |
5506
|
502832
|
100
|
|
|
|
if (!gimme_scalar) { |
5507
|
502810
|
|
|
|
|
const U32 items = limit - 1; |
5508
|
754215
|
100
|
|
|
|
if (items < slen) |
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
5509
|
1
|
|
|
|
|
EXTEND(SP, items); |
5510
|
|
|
|
|
|
else |
5511
|
251426
|
|
|
|
|
EXTEND(SP, slen); |
5512
|
|
|
|
|
|
} |
5513
|
|
|
|
|
|
|
5514
|
502832
|
100
|
|
|
|
if (do_utf8) { |
5515
|
84472
|
50
|
|
|
|
while (--limit) { |
5516
|
|
|
|
|
|
/* keep track of how many bytes we skip over */ |
5517
|
|
|
|
|
|
m = s; |
5518
|
84472
|
|
|
|
|
s += UTF8SKIP(s); |
5519
|
84472
|
100
|
|
|
|
if (gimme_scalar) { |
5520
|
42
|
|
|
|
|
iters++; |
5521
|
42
|
50
|
|
|
|
if (s-m == 0) |
5522
|
0
|
|
|
|
|
trailing_empty++; |
5523
|
|
|
|
|
|
else |
5524
|
|
|
|
|
|
trailing_empty = 0; |
5525
|
|
|
|
|
|
} else { |
5526
|
84430
|
|
|
|
|
dstr = newSVpvn_flags(m, s-m, SVf_UTF8 | make_mortal); |
5527
|
|
|
|
|
|
|
5528
|
84430
|
|
|
|
|
PUSHs(dstr); |
5529
|
|
|
|
|
|
} |
5530
|
|
|
|
|
|
|
5531
|
117192
|
100
|
|
|
|
if (s >= strend) |
5532
|
|
|
|
|
|
break; |
5533
|
|
|
|
|
|
} |
5534
|
|
|
|
|
|
} else { |
5535
|
3738038
|
100
|
|
|
|
while (--limit) { |
5536
|
3738036
|
100
|
|
|
|
if (gimme_scalar) { |
5537
|
44
|
|
|
|
|
iters++; |
5538
|
|
|
|
|
|
} else { |
5539
|
3737992
|
|
|
|
|
dstr = newSVpvn(s, 1); |
5540
|
|
|
|
|
|
|
5541
|
|
|
|
|
|
|
5542
|
3737992
|
50
|
|
|
|
if (make_mortal) |
5543
|
3737992
|
|
|
|
|
sv_2mortal(dstr); |
5544
|
|
|
|
|
|
|
5545
|
3737992
|
|
|
|
|
PUSHs(dstr); |
5546
|
|
|
|
|
|
} |
5547
|
|
|
|
|
|
|
5548
|
3738036
|
|
|
|
|
s++; |
5549
|
|
|
|
|
|
|
5550
|
3956732
|
100
|
|
|
|
if (s >= strend) |
5551
|
|
|
|
|
|
break; |
5552
|
|
|
|
|
|
} |
5553
|
|
|
|
|
|
} |
5554
|
|
|
|
|
|
} |
5555
|
5160541
|
100
|
|
|
|
else if (do_utf8 == (RX_UTF8(rx) != 0) && |
|
|
100
|
|
|
|
|
5556
|
4699595
|
100
|
|
|
|
(RX_EXTFLAGS(rx) & RXf_USE_INTUIT) && !RX_NPARENS(rx) |
5557
|
2982684
|
100
|
|
|
|
&& (RX_EXTFLAGS(rx) & RXf_CHECK_ALL) |
5558
|
2532792
|
50
|
|
|
|
&& !(RX_EXTFLAGS(rx) & RXf_ANCH)) { |
5559
|
2532792
|
|
|
|
|
const int tail = (RX_EXTFLAGS(rx) & RXf_INTUIT_TAIL); |
5560
|
2532792
|
|
|
|
|
SV * const csv = CALLREG_INTUIT_STRING(rx); |
5561
|
|
|
|
|
|
|
5562
|
2532792
|
|
|
|
|
len = RX_MINLENRET(rx); |
5563
|
2532792
|
100
|
|
|
|
if (len == 1 && !RX_UTF8(rx) && !tail) { |
|
|
100
|
|
|
|
|
5564
|
2436098
|
50
|
|
|
|
const char c = *SvPV_nolen_const(csv); |
5565
|
7469568
|
100
|
|
|
|
while (--limit) { |
5566
|
69120382
|
100
|
|
|
|
for (m = s; m < strend && *m != c; m++) |
|
|
100
|
|
|
|
|
5567
|
|
|
|
|
|
; |
5568
|
6202304
|
100
|
|
|
|
if (m >= strend) |
5569
|
|
|
|
|
|
break; |
5570
|
3816620
|
100
|
|
|
|
if (gimme_scalar) { |
5571
|
80
|
|
|
|
|
iters++; |
5572
|
80
|
100
|
|
|
|
if (m-s == 0) |
5573
|
16
|
|
|
|
|
trailing_empty++; |
5574
|
|
|
|
|
|
else |
5575
|
|
|
|
|
|
trailing_empty = 0; |
5576
|
|
|
|
|
|
} else { |
5577
|
3816540
|
50
|
|
|
|
dstr = newSVpvn_flags(s, m-s, |
5578
|
|
|
|
|
|
(do_utf8 ? SVf_UTF8 : 0) | make_mortal); |
5579
|
3816540
|
100
|
|
|
|
XPUSHs(dstr); |
5580
|
|
|
|
|
|
} |
5581
|
|
|
|
|
|
/* The rx->minlen is in characters but we want to step |
5582
|
|
|
|
|
|
* s ahead by bytes. */ |
5583
|
3816620
|
50
|
|
|
|
if (do_utf8) |
5584
|
0
|
|
|
|
|
s = (char*)utf8_hop((U8*)m, len); |
5585
|
|
|
|
|
|
else |
5586
|
3816620
|
|
|
|
|
s = m + len; /* Fake \n at the end */ |
5587
|
|
|
|
|
|
} |
5588
|
|
|
|
|
|
} |
5589
|
|
|
|
|
|
else { |
5590
|
228131
|
100
|
|
|
|
while (s < strend && --limit && |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
5591
|
135640
|
|
|
|
|
(m = fbm_instr((unsigned char*)s, (unsigned char*)strend, |
5592
|
|
|
|
|
|
csv, multiline ? FBMrf_MULTILINE : 0)) ) |
5593
|
|
|
|
|
|
{ |
5594
|
65596
|
100
|
|
|
|
if (gimme_scalar) { |
5595
|
10
|
|
|
|
|
iters++; |
5596
|
10
|
50
|
|
|
|
if (m-s == 0) |
5597
|
0
|
|
|
|
|
trailing_empty++; |
5598
|
|
|
|
|
|
else |
5599
|
|
|
|
|
|
trailing_empty = 0; |
5600
|
|
|
|
|
|
} else { |
5601
|
65586
|
100
|
|
|
|
dstr = newSVpvn_flags(s, m-s, |
5602
|
|
|
|
|
|
(do_utf8 ? SVf_UTF8 : 0) | make_mortal); |
5603
|
65586
|
100
|
|
|
|
XPUSHs(dstr); |
5604
|
|
|
|
|
|
} |
5605
|
|
|
|
|
|
/* The rx->minlen is in characters but we want to step |
5606
|
|
|
|
|
|
* s ahead by bytes. */ |
5607
|
65596
|
100
|
|
|
|
if (do_utf8) |
5608
|
4
|
|
|
|
|
s = (char*)utf8_hop((U8*)m, len); |
5609
|
|
|
|
|
|
else |
5610
|
65594
|
|
|
|
|
s = m + len; /* Fake \n at the end */ |
5611
|
|
|
|
|
|
} |
5612
|
|
|
|
|
|
} |
5613
|
|
|
|
|
|
} |
5614
|
|
|
|
|
|
else { |
5615
|
911122
|
|
|
|
|
maxiters += slen * RX_NPARENS(rx); |
5616
|
3564289
|
100
|
|
|
|
while (s < strend && --limit) |
|
|
100
|
|
|
|
|
5617
|
|
|
|
|
|
{ |
5618
|
|
|
|
|
|
I32 rex_return; |
5619
|
2912460
|
|
|
|
|
PUTBACK; |
5620
|
2912460
|
|
|
|
|
rex_return = CALLREGEXEC(rx, (char*)s, (char*)strend, (char*)orig, 1, |
5621
|
|
|
|
|
|
sv, NULL, 0); |
5622
|
2912460
|
|
|
|
|
SPAGAIN; |
5623
|
2912460
|
100
|
|
|
|
if (rex_return == 0) |
5624
|
|
|
|
|
|
break; |
5625
|
2197606
|
50
|
|
|
|
TAINT_IF(RX_MATCH_TAINTED(rx)); |
5626
|
|
|
|
|
|
/* we never pass the REXEC_COPY_STR flag, so it should |
5627
|
|
|
|
|
|
* never get copied */ |
5628
|
|
|
|
|
|
assert(!RX_MATCH_COPIED(rx)); |
5629
|
2197606
|
|
|
|
|
m = RX_OFFS(rx)[0].start + orig; |
5630
|
|
|
|
|
|
|
5631
|
2197606
|
100
|
|
|
|
if (gimme_scalar) { |
5632
|
92
|
|
|
|
|
iters++; |
5633
|
92
|
100
|
|
|
|
if (m-s == 0) |
5634
|
12
|
|
|
|
|
trailing_empty++; |
5635
|
|
|
|
|
|
else |
5636
|
|
|
|
|
|
trailing_empty = 0; |
5637
|
|
|
|
|
|
} else { |
5638
|
2197514
|
100
|
|
|
|
dstr = newSVpvn_flags(s, m-s, |
5639
|
|
|
|
|
|
(do_utf8 ? SVf_UTF8 : 0) | make_mortal); |
5640
|
2197514
|
100
|
|
|
|
XPUSHs(dstr); |
5641
|
|
|
|
|
|
} |
5642
|
2197606
|
100
|
|
|
|
if (RX_NPARENS(rx)) { |
5643
|
|
|
|
|
|
I32 i; |
5644
|
582110
|
100
|
|
|
|
for (i = 1; i <= (I32)RX_NPARENS(rx); i++) { |
5645
|
232844
|
|
|
|
|
s = RX_OFFS(rx)[i].start + orig; |
5646
|
232844
|
|
|
|
|
m = RX_OFFS(rx)[i].end + orig; |
5647
|
|
|
|
|
|
|
5648
|
|
|
|
|
|
/* japhy (07/27/01) -- the (m && s) test doesn't catch |
5649
|
|
|
|
|
|
parens that didn't match -- they should be set to |
5650
|
|
|
|
|
|
undef, not the empty string */ |
5651
|
232844
|
100
|
|
|
|
if (gimme_scalar) { |
5652
|
24
|
|
|
|
|
iters++; |
5653
|
24
|
100
|
|
|
|
if (m-s == 0) |
5654
|
18
|
|
|
|
|
trailing_empty++; |
5655
|
|
|
|
|
|
else |
5656
|
|
|
|
|
|
trailing_empty = 0; |
5657
|
|
|
|
|
|
} else { |
5658
|
232820
|
100
|
|
|
|
if (m >= orig && s >= orig) { |
5659
|
232786
|
100
|
|
|
|
dstr = newSVpvn_flags(s, m-s, |
5660
|
|
|
|
|
|
(do_utf8 ? SVf_UTF8 : 0) |
5661
|
|
|
|
|
|
| make_mortal); |
5662
|
|
|
|
|
|
} |
5663
|
|
|
|
|
|
else |
5664
|
|
|
|
|
|
dstr = &PL_sv_undef; /* undef, not "" */ |
5665
|
232820
|
50
|
|
|
|
XPUSHs(dstr); |
5666
|
|
|
|
|
|
} |
5667
|
|
|
|
|
|
|
5668
|
|
|
|
|
|
} |
5669
|
|
|
|
|
|
} |
5670
|
2197606
|
|
|
|
|
s = RX_OFFS(rx)[0].end + orig; |
5671
|
|
|
|
|
|
} |
5672
|
|
|
|
|
|
} |
5673
|
|
|
|
|
|
|
5674
|
4476822
|
100
|
|
|
|
if (!gimme_scalar) { |
5675
|
4476570
|
|
|
|
|
iters = (SP - PL_stack_base) - base; |
5676
|
|
|
|
|
|
} |
5677
|
4476822
|
50
|
|
|
|
if (iters > maxiters) |
5678
|
0
|
|
|
|
|
DIE(aTHX_ "Split loop"); |
5679
|
|
|
|
|
|
|
5680
|
|
|
|
|
|
/* keep field after final delim? */ |
5681
|
4476822
|
100
|
|
|
|
if (s < strend || (iters && origlimit)) { |
|
|
100
|
|
|
|
|
5682
|
3563724
|
100
|
|
|
|
if (!gimme_scalar) { |
5683
|
3563516
|
|
|
|
|
const STRLEN l = strend - s; |
5684
|
3563516
|
100
|
|
|
|
dstr = newSVpvn_flags(s, l, (do_utf8 ? SVf_UTF8 : 0) | make_mortal); |
5685
|
3563516
|
50
|
|
|
|
XPUSHs(dstr); |
5686
|
|
|
|
|
|
} |
5687
|
3563724
|
|
|
|
|
iters++; |
5688
|
|
|
|
|
|
} |
5689
|
913098
|
100
|
|
|
|
else if (!origlimit) { |
5690
|
817802
|
100
|
|
|
|
if (gimme_scalar) { |
5691
|
36
|
|
|
|
|
iters -= trailing_empty; |
5692
|
|
|
|
|
|
} else { |
5693
|
918288
|
100
|
|
|
|
while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0)) { |
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
5694
|
100522
|
100
|
|
|
|
if (TOPs && !make_mortal) |
5695
|
20
|
|
|
|
|
sv_2mortal(TOPs); |
5696
|
100522
|
|
|
|
|
*SP-- = &PL_sv_undef; |
5697
|
100522
|
|
|
|
|
iters--; |
5698
|
|
|
|
|
|
} |
5699
|
|
|
|
|
|
} |
5700
|
|
|
|
|
|
} |
5701
|
|
|
|
|
|
|
5702
|
4476822
|
|
|
|
|
PUTBACK; |
5703
|
4476822
|
100
|
|
|
|
LEAVE_SCOPE(oldsave); /* may undo an earlier SWITCHSTACK */ |
5704
|
4476822
|
|
|
|
|
SPAGAIN; |
5705
|
4476822
|
100
|
|
|
|
if (realarray) { |
5706
|
572
|
100
|
|
|
|
if (!mg) { |
5707
|
570
|
50
|
|
|
|
if (SvSMAGICAL(ary)) { |
5708
|
0
|
|
|
|
|
PUTBACK; |
5709
|
0
|
|
|
|
|
mg_set(MUTABLE_SV(ary)); |
5710
|
0
|
|
|
|
|
SPAGAIN; |
5711
|
|
|
|
|
|
} |
5712
|
571
|
100
|
|
|
|
if (gimme == G_ARRAY) { |
|
|
50
|
|
|
|
|
5713
|
1
|
|
|
|
|
EXTEND(SP, iters); |
5714
|
2
|
50
|
|
|
|
Copy(AvARRAY(ary), SP + 1, iters, SV*); |
5715
|
2
|
|
|
|
|
SP += iters; |
5716
|
2
|
|
|
|
|
RETURN; |
5717
|
|
|
|
|
|
} |
5718
|
|
|
|
|
|
} |
5719
|
|
|
|
|
|
else { |
5720
|
2
|
|
|
|
|
PUTBACK; |
5721
|
2
|
|
|
|
|
ENTER_with_name("call_PUSH"); |
5722
|
2
|
50
|
|
|
|
call_sv(SV_CONST(PUSH),G_SCALAR|G_DISCARD|G_METHOD_NAMED); |
5723
|
2
|
|
|
|
|
LEAVE_with_name("call_PUSH"); |
5724
|
2
|
|
|
|
|
SPAGAIN; |
5725
|
2
|
50
|
|
|
|
if (gimme == G_ARRAY) { |
|
|
0
|
|
|
|
|
5726
|
|
|
|
|
|
SSize_t i; |
5727
|
|
|
|
|
|
/* EXTEND should not be needed - we just popped them */ |
5728
|
0
|
|
|
|
|
EXTEND(SP, iters); |
5729
|
0
|
0
|
|
|
|
for (i=0; i < iters; i++) { |
5730
|
0
|
|
|
|
|
SV **svp = av_fetch(ary, i, FALSE); |
5731
|
0
|
0
|
|
|
|
PUSHs((svp) ? *svp : &PL_sv_undef); |
5732
|
|
|
|
|
|
} |
5733
|
0
|
|
|
|
|
RETURN; |
5734
|
|
|
|
|
|
} |
5735
|
|
|
|
|
|
} |
5736
|
|
|
|
|
|
} |
5737
|
|
|
|
|
|
else { |
5738
|
4476250
|
100
|
|
|
|
if (gimme == G_ARRAY) |
5739
|
4475990
|
|
|
|
|
RETURN; |
5740
|
|
|
|
|
|
} |
5741
|
|
|
|
|
|
|
5742
|
830
|
|
|
|
|
GETTARGET; |
5743
|
830
|
50
|
|
|
|
PUSHi(iters); |
5744
|
2244164
|
|
|
|
|
RETURN; |
5745
|
|
|
|
|
|
} |
5746
|
|
|
|
|
|
|
5747
|
550
|
|
|
|
|
PP(pp_once) |
5748
|
|
|
|
|
|
{ |
5749
|
550
|
|
|
|
|
dSP; |
5750
|
550
|
|
|
|
|
SV *const sv = PAD_SVl(PL_op->op_targ); |
5751
|
|
|
|
|
|
|
5752
|
550
|
100
|
|
|
|
if (SvPADSTALE(sv)) { |
5753
|
|
|
|
|
|
/* First time. */ |
5754
|
|
|
|
|
|
SvPADSTALE_off(sv); |
5755
|
64
|
|
|
|
|
RETURNOP(cLOGOP->op_other); |
5756
|
|
|
|
|
|
} |
5757
|
518
|
|
|
|
|
RETURNOP(cLOGOP->op_next); |
5758
|
|
|
|
|
|
} |
5759
|
|
|
|
|
|
|
5760
|
33568
|
|
|
|
|
PP(pp_lock) |
5761
|
|
|
|
|
|
{ |
5762
|
|
|
|
|
|
dVAR; |
5763
|
33568
|
|
|
|
|
dSP; |
5764
|
33568
|
|
|
|
|
dTOPss; |
5765
|
|
|
|
|
|
SV *retsv = sv; |
5766
|
33568
|
|
|
|
|
SvLOCK(sv); |
5767
|
50352
|
100
|
|
|
|
if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV |
5768
|
33568
|
|
|
|
|
|| SvTYPE(retsv) == SVt_PVCV) { |
5769
|
100
|
|
|
|
|
retsv = refto(retsv); |
5770
|
|
|
|
|
|
} |
5771
|
33568
|
|
|
|
|
SETs(retsv); |
5772
|
33568
|
|
|
|
|
RETURN; |
5773
|
|
|
|
|
|
} |
5774
|
|
|
|
|
|
|
5775
|
|
|
|
|
|
|
5776
|
0
|
|
|
|
|
PP(unimplemented_op) |
5777
|
|
|
|
|
|
{ |
5778
|
|
|
|
|
|
dVAR; |
5779
|
0
|
|
|
|
|
const Optype op_type = PL_op->op_type; |
5780
|
|
|
|
|
|
/* Using OP_NAME() isn't going to be helpful here. Firstly, it doesn't cope |
5781
|
|
|
|
|
|
with out of range op numbers - it only "special" cases op_custom. |
5782
|
|
|
|
|
|
Secondly, as the three ops we "panic" on are padmy, mapstart and custom, |
5783
|
|
|
|
|
|
if we get here for a custom op then that means that the custom op didn't |
5784
|
|
|
|
|
|
have an implementation. Given that OP_NAME() looks up the custom op |
5785
|
|
|
|
|
|
by its pp_addr, likely it will return NULL, unless someone (unhelpfully) |
5786
|
|
|
|
|
|
registers &PL_unimplemented_op as the address of their custom op. |
5787
|
|
|
|
|
|
NULL doesn't generate a useful error message. "custom" does. */ |
5788
|
|
|
|
|
|
const char *const name = op_type >= OP_max |
5789
|
0
|
0
|
|
|
|
? "[out of range]" : PL_op_name[PL_op->op_type]; |
5790
|
0
|
0
|
|
|
|
if(OP_IS_SOCKET(op_type)) |
5791
|
0
|
|
|
|
|
DIE(aTHX_ PL_no_sock_func, name); |
5792
|
0
|
|
|
|
|
DIE(aTHX_ "panic: unimplemented op %s (#%d) called", name, op_type); |
5793
|
|
|
|
|
|
} |
5794
|
|
|
|
|
|
|
5795
|
|
|
|
|
|
/* For sorting out arguments passed to a &CORE:: subroutine */ |
5796
|
1066
|
|
|
|
|
PP(pp_coreargs) |
5797
|
1138
|
50
|
|
|
|
{ |
|
|
100
|
|
|
|
|
5798
|
|
|
|
|
|
dSP; |
5799
|
1066
|
100
|
|
|
|
int opnum = SvIOK(cSVOP_sv) ? (int)SvUV(cSVOP_sv) : 0; |
|
|
50
|
|
|
|
|
5800
|
1066
|
|
|
|
|
int defgv = PL_opargs[opnum] & OA_DEFGV ||opnum==OP_GLOB, whicharg = 0; |
5801
|
1066
|
|
|
|
|
AV * const at_ = GvAV(PL_defgv); |
5802
|
1066
|
100
|
|
|
|
SV **svp = at_ ? AvARRAY(at_) : NULL; |
5803
|
1066
|
100
|
|
|
|
I32 minargs = 0, maxargs = 0, numargs = at_ ? AvFILLp(at_)+1 : 0; |
5804
|
1066
|
100
|
|
|
|
I32 oa = opnum ? PL_opargs[opnum] >> OASHIFT : 0; |
5805
|
|
|
|
|
|
bool seen_question = 0; |
5806
|
|
|
|
|
|
const char *err = NULL; |
5807
|
1066
|
|
|
|
|
const bool pushmark = PL_op->op_private & OPpCOREARGS_PUSHMARK; |
5808
|
|
|
|
|
|
|
5809
|
|
|
|
|
|
/* Count how many args there are first, to get some idea how far to |
5810
|
|
|
|
|
|
extend the stack. */ |
5811
|
3191
|
100
|
|
|
|
while (oa) { |
5812
|
1668
|
100
|
|
|
|
if ((oa & 7) == OA_LIST) { maxargs = I32_MAX; break; } |
5813
|
1592
|
|
|
|
|
maxargs++; |
5814
|
1592
|
100
|
|
|
|
if (oa & OA_OPTIONAL) seen_question = 1; |
5815
|
1592
|
100
|
|
|
|
if (!seen_question) minargs++; |
5816
|
1592
|
|
|
|
|
oa >>= 4; |
5817
|
|
|
|
|
|
} |
5818
|
|
|
|
|
|
|
5819
|
1066
|
100
|
|
|
|
if(numargs < minargs) err = "Not enough"; |
5820
|
888
|
100
|
|
|
|
else if(numargs > maxargs) err = "Too many"; |
5821
|
1066
|
100
|
|
|
|
if (err) |
5822
|
|
|
|
|
|
/* diag_listed_as: Too many arguments for %s */ |
5823
|
494
|
100
|
|
|
|
Perl_croak(aTHX_ |
|
|
50
|
|
|
|
|
5824
|
|
|
|
|
|
"%s arguments for %s", err, |
5825
|
12
|
|
|
|
|
opnum ? PL_op_desc[opnum] : SvPV_nolen_const(cSVOP_sv) |
5826
|
|
|
|
|
|
); |
5827
|
|
|
|
|
|
|
5828
|
|
|
|
|
|
/* Reset the stack pointer. Without this, we end up returning our own |
5829
|
|
|
|
|
|
arguments in list context, in addition to the values we are supposed |
5830
|
|
|
|
|
|
to return. nextstate usually does this on sub entry, but we need |
5831
|
|
|
|
|
|
to run the next op with the caller's hints, so we cannot have a |
5832
|
|
|
|
|
|
nextstate. */ |
5833
|
578
|
|
|
|
|
SP = PL_stack_base + cxstack[cxstack_ix].blk_oldsp; |
5834
|
|
|
|
|
|
|
5835
|
578
|
100
|
|
|
|
if(!maxargs) RETURN; |
5836
|
|
|
|
|
|
|
5837
|
|
|
|
|
|
/* We do this here, rather than with a separate pushmark op, as it has |
5838
|
|
|
|
|
|
to come in between two things this function does (stack reset and |
5839
|
|
|
|
|
|
arg pushing). This seems the easiest way to do it. */ |
5840
|
536
|
100
|
|
|
|
if (pushmark) { |
5841
|
90
|
|
|
|
|
PUTBACK; |
5842
|
90
|
|
|
|
|
(void)Perl_pp_pushmark(aTHX); |
5843
|
|
|
|
|
|
} |
5844
|
|
|
|
|
|
|
5845
|
536
|
100
|
|
|
|
EXTEND(SP, maxargs == I32_MAX ? numargs : maxargs); |
|
|
0
|
|
|
|
|
5846
|
536
|
|
|
|
|
PUTBACK; /* The code below can die in various places. */ |
5847
|
|
|
|
|
|
|
5848
|
536
|
|
|
|
|
oa = PL_opargs[opnum] >> OASHIFT; |
5849
|
1040
|
100
|
|
|
|
for (; oa&&(numargs||!pushmark); (void)(numargs&&(++svp,--numargs))) { |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
5850
|
714
|
|
|
|
|
whicharg++; |
5851
|
714
|
|
|
|
|
switch (oa & 7) { |
5852
|
|
|
|
|
|
case OA_SCALAR: |
5853
|
|
|
|
|
|
try_defsv: |
5854
|
448
|
100
|
|
|
|
if (!numargs && defgv && whicharg == minargs + 1) { |
|
|
100
|
|
|
|
|
5855
|
122
|
|
|
|
|
PUSHs(find_rundefsv2( |
5856
|
|
|
|
|
|
find_runcv_where(FIND_RUNCV_level_eq, 1, NULL), |
5857
|
|
|
|
|
|
cxstack[cxstack_ix].blk_oldcop->cop_seq |
5858
|
|
|
|
|
|
)); |
5859
|
|
|
|
|
|
} |
5860
|
326
|
100
|
|
|
|
else PUSHs(numargs ? svp && *svp ? *svp : &PL_sv_undef : NULL); |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
5861
|
|
|
|
|
|
break; |
5862
|
|
|
|
|
|
case OA_LIST: |
5863
|
100
|
100
|
|
|
|
while (numargs--) { |
5864
|
60
|
50
|
|
|
|
PUSHs(svp && *svp ? *svp : &PL_sv_undef); |
|
|
50
|
|
|
|
|
5865
|
60
|
|
|
|
|
svp++; |
5866
|
|
|
|
|
|
} |
5867
|
40
|
|
|
|
|
RETURN; |
5868
|
|
|
|
|
|
case OA_HVREF: |
5869
|
16
|
50
|
|
|
|
if (!svp || !*svp || !SvROK(*svp) |
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
5870
|
12
|
100
|
|
|
|
|| SvTYPE(SvRV(*svp)) != SVt_PVHV) |
5871
|
18
|
50
|
|
|
|
DIE(aTHX_ |
5872
|
|
|
|
|
|
/* diag_listed_as: Type of arg %d to &CORE::%s must be %s*/ |
5873
|
|
|
|
|
|
"Type of arg %d to &CORE::%s must be hash reference", |
5874
|
6
|
0
|
|
|
|
whicharg, OP_DESC(PL_op->op_next) |
5875
|
|
|
|
|
|
); |
5876
|
4
|
|
|
|
|
PUSHs(SvRV(*svp)); |
5877
|
4
|
|
|
|
|
break; |
5878
|
|
|
|
|
|
case OA_FILEREF: |
5879
|
104
|
100
|
|
|
|
if (!numargs) PUSHs(NULL); |
5880
|
90
|
50
|
|
|
|
else if(svp && *svp && SvROK(*svp) && isGV_with_GP(SvRV(*svp))) |
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
5881
|
|
|
|
|
|
/* no magic here, as the prototype will have added an extra |
5882
|
|
|
|
|
|
refgen and we just want what was there before that */ |
5883
|
28
|
|
|
|
|
PUSHs(SvRV(*svp)); |
5884
|
|
|
|
|
|
else { |
5885
|
62
|
|
|
|
|
const bool constr = PL_op->op_private & whicharg; |
5886
|
62
|
50
|
|
|
|
PUSHs(S_rv2gv(aTHX_ |
|
|
50
|
|
|
|
|
5887
|
|
|
|
|
|
svp && *svp ? *svp : &PL_sv_undef, |
5888
|
|
|
|
|
|
constr, CopHINTS_get(PL_curcop) & HINT_STRICT_REFS, |
5889
|
|
|
|
|
|
!constr |
5890
|
|
|
|
|
|
)); |
5891
|
|
|
|
|
|
} |
5892
|
|
|
|
|
|
break; |
5893
|
|
|
|
|
|
case OA_SCALARREF: |
5894
|
118
|
100
|
|
|
|
if (!numargs) goto try_defsv; |
5895
|
|
|
|
|
|
else { |
5896
|
106
|
|
|
|
|
const bool wantscalar = |
5897
|
106
|
|
|
|
|
PL_op->op_private & OPpCOREARGS_SCALARMOD; |
5898
|
106
|
50
|
|
|
|
if (!svp || !*svp || !SvROK(*svp) |
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
5899
|
|
|
|
|
|
/* We have to permit globrefs even for the \$ proto, as |
5900
|
|
|
|
|
|
*foo is indistinguishable from ${\*foo}, and the proto- |
5901
|
|
|
|
|
|
type permits the latter. */ |
5902
|
117
|
100
|
|
|
|
|| SvTYPE(SvRV(*svp)) > ( |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
5903
|
|
|
|
|
|
wantscalar ? SVt_PVLV |
5904
|
58
|
|
|
|
|
: opnum == OP_LOCK || opnum == OP_UNDEF |
5905
|
|
|
|
|
|
? SVt_PVCV |
5906
|
|
|
|
|
|
: SVt_PVHV |
5907
|
|
|
|
|
|
) |
5908
|
|
|
|
|
|
) |
5909
|
108
|
100
|
|
|
|
DIE(aTHX_ |
5910
|
|
|
|
|
|
/* diag_listed_as: Type of arg %d to &CORE::%s must be %s*/ |
5911
|
|
|
|
|
|
"Type of arg %d to &CORE::%s must be %s", |
5912
|
|
|
|
|
|
whicharg, PL_op_name[opnum], |
5913
|
|
|
|
|
|
wantscalar |
5914
|
|
|
|
|
|
? "scalar reference" |
5915
|
36
|
|
|
|
|
: opnum == OP_LOCK || opnum == OP_UNDEF |
5916
|
|
|
|
|
|
? "reference to one of [$@%&*]" |
5917
|
36
|
100
|
|
|
|
: "reference to one of [$@%*]" |
5918
|
|
|
|
|
|
); |
5919
|
46
|
|
|
|
|
PUSHs(SvRV(*svp)); |
5920
|
46
|
100
|
|
|
|
if (opnum == OP_UNDEF && SvRV(*svp) == (SV *)PL_defgv |
|
|
100
|
|
|
|
|
5921
|
4
|
100
|
|
|
|
&& cxstack[cxstack_ix].cx_type & CXp_HASARGS) { |
5922
|
|
|
|
|
|
/* Undo @_ localisation, so that sub exit does not undo |
5923
|
|
|
|
|
|
part of our undeffing. */ |
5924
|
2
|
|
|
|
|
PERL_CONTEXT *cx = &cxstack[cxstack_ix]; |
5925
|
2
|
|
|
|
|
POP_SAVEARRAY(); |
5926
|
2
|
|
|
|
|
cx->cx_type &= ~ CXp_HASARGS; |
5927
|
|
|
|
|
|
assert(!AvREAL(cx->blk_sub.argarray)); |
5928
|
|
|
|
|
|
} |
5929
|
|
|
|
|
|
} |
5930
|
|
|
|
|
|
break; |
5931
|
|
|
|
|
|
default: |
5932
|
0
|
|
|
|
|
DIE(aTHX_ "panic: unknown OA_*: %x", (unsigned)(oa&7)); |
5933
|
|
|
|
|
|
} |
5934
|
602
|
|
|
|
|
oa = oa >> 4; |
5935
|
|
|
|
|
|
} |
5936
|
|
|
|
|
|
|
5937
|
465
|
|
|
|
|
RETURN; |
5938
|
|
|
|
|
|
} |
5939
|
|
|
|
|
|
|
5940
|
26
|
|
|
|
|
PP(pp_runcv) |
5941
|
|
|
|
|
|
{ |
5942
|
26
|
|
|
|
|
dSP; |
5943
|
|
|
|
|
|
CV *cv; |
5944
|
26
|
100
|
|
|
|
if (PL_op->op_private & OPpOFFBYONE) { |
5945
|
8
|
|
|
|
|
cv = find_runcv_where(FIND_RUNCV_level_eq, 1, NULL); |
5946
|
|
|
|
|
|
} |
5947
|
18
|
|
|
|
|
else cv = find_runcv(NULL); |
5948
|
26
|
50
|
|
|
|
XPUSHs(CvEVAL(cv) ? &PL_sv_undef : sv_2mortal(newRV((SV *)cv))); |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
5949
|
26
|
|
|
|
|
RETURN; |
5950
|
62578644
|
|
|
|
|
} |
5951
|
|
|
|
|
|
|
5952
|
|
|
|
|
|
|
5953
|
|
|
|
|
|
/* |
5954
|
|
|
|
|
|
* Local variables: |
5955
|
|
|
|
|
|
* c-indentation-style: bsd |
5956
|
|
|
|
|
|
* c-basic-offset: 4 |
5957
|
|
|
|
|
|
* indent-tabs-mode: nil |
5958
|
|
|
|
|
|
* End: |
5959
|
|
|
|
|
|
* |
5960
|
|
|
|
|
|
* ex: set ts=8 sts=4 sw=4 et: |
5961
|
|
|
|
|
|
*/ |