line |
stmt |
bran |
cond |
sub |
time |
code |
1
|
|
|
|
|
|
/* doop.c |
2
|
|
|
|
|
|
* |
3
|
|
|
|
|
|
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, |
4
|
|
|
|
|
|
* 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009 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
|
|
|
|
|
|
* 'So that was the job I felt I had to do when I started,' thought Sam. |
13
|
|
|
|
|
|
* |
14
|
|
|
|
|
|
* [p.934 of _The Lord of the Rings_, VI/iii: "Mount Doom"] |
15
|
|
|
|
|
|
*/ |
16
|
|
|
|
|
|
|
17
|
|
|
|
|
|
/* This file contains some common functions needed to carry out certain |
18
|
|
|
|
|
|
* ops. For example, both pp_sprintf() and pp_prtf() call the function |
19
|
|
|
|
|
|
* do_printf() found in this file. |
20
|
|
|
|
|
|
*/ |
21
|
|
|
|
|
|
|
22
|
|
|
|
|
|
#include "EXTERN.h" |
23
|
|
|
|
|
|
#define PERL_IN_DOOP_C |
24
|
|
|
|
|
|
#include "perl.h" |
25
|
|
|
|
|
|
|
26
|
|
|
|
|
|
#ifndef PERL_MICRO |
27
|
|
|
|
|
|
#include |
28
|
|
|
|
|
|
#endif |
29
|
|
|
|
|
|
|
30
|
|
|
|
|
|
STATIC I32 |
31
|
242064
|
|
|
|
|
S_do_trans_simple(pTHX_ SV * const sv) |
32
|
|
|
|
|
|
{ |
33
|
|
|
|
|
|
dVAR; |
34
|
|
|
|
|
|
I32 matches = 0; |
35
|
|
|
|
|
|
STRLEN len; |
36
|
242064
|
50
|
|
|
|
U8 *s = (U8*)SvPV_nomg(sv,len); |
37
|
242064
|
|
|
|
|
U8 * const send = s+len; |
38
|
242064
|
|
|
|
|
const short * const tbl = (short*)cPVOP->op_pv; |
39
|
|
|
|
|
|
|
40
|
|
|
|
|
|
PERL_ARGS_ASSERT_DO_TRANS_SIMPLE; |
41
|
|
|
|
|
|
|
42
|
242064
|
50
|
|
|
|
if (!tbl) |
43
|
0
|
|
|
|
|
Perl_croak(aTHX_ "panic: do_trans_simple line %d",__LINE__); |
44
|
|
|
|
|
|
|
45
|
|
|
|
|
|
/* First, take care of non-UTF-8 input strings, because they're easy */ |
46
|
242064
|
100
|
|
|
|
if (!SvUTF8(sv)) { |
47
|
2319942
|
100
|
|
|
|
while (s < send) { |
48
|
2078636
|
|
|
|
|
const I32 ch = tbl[*s]; |
49
|
2078636
|
100
|
|
|
|
if (ch >= 0) { |
50
|
911302
|
|
|
|
|
matches++; |
51
|
911302
|
|
|
|
|
*s = (U8)ch; |
52
|
|
|
|
|
|
} |
53
|
2078636
|
|
|
|
|
s++; |
54
|
|
|
|
|
|
} |
55
|
241306
|
100
|
|
|
|
SvSETMAGIC(sv); |
56
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
else { |
58
|
758
|
|
|
|
|
const I32 grows = PL_op->op_private & OPpTRANS_GROWS; |
59
|
|
|
|
|
|
U8 *d; |
60
|
|
|
|
|
|
U8 *dstart; |
61
|
|
|
|
|
|
|
62
|
|
|
|
|
|
/* Allow for expansion: $_="a".chr(400); tr/a/\xFE/, FE needs encoding */ |
63
|
758
|
50
|
|
|
|
if (grows) |
64
|
0
|
|
|
|
|
Newx(d, len*2+1, U8); |
65
|
|
|
|
|
|
else |
66
|
|
|
|
|
|
d = s; |
67
|
|
|
|
|
|
dstart = d; |
68
|
5491
|
100
|
|
|
|
while (s < send) { |
69
|
|
|
|
|
|
STRLEN ulen; |
70
|
|
|
|
|
|
I32 ch; |
71
|
|
|
|
|
|
|
72
|
|
|
|
|
|
/* Need to check this, otherwise 128..255 won't match */ |
73
|
4354
|
100
|
|
|
|
const UV c = utf8n_to_uvchr(s, send - s, &ulen, UTF8_ALLOW_DEFAULT); |
74
|
4354
|
100
|
|
|
|
if (c < 0x100 && (ch = tbl[c]) >= 0) { |
|
|
100
|
|
|
|
|
75
|
96
|
|
|
|
|
matches++; |
76
|
96
|
|
|
|
|
d = uvchr_to_utf8(d, ch); |
77
|
96
|
|
|
|
|
s += ulen; |
78
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
else { /* No match -> copy */ |
80
|
4258
|
|
|
|
|
Move(s, d, ulen, U8); |
81
|
4258
|
|
|
|
|
d += ulen; |
82
|
4306
|
|
|
|
|
s += ulen; |
83
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
} |
85
|
758
|
50
|
|
|
|
if (grows) { |
86
|
0
|
|
|
|
|
sv_setpvn(sv, (char*)dstart, d - dstart); |
87
|
0
|
|
|
|
|
Safefree(dstart); |
88
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
else { |
90
|
758
|
|
|
|
|
*d = '\0'; |
91
|
758
|
|
|
|
|
SvCUR_set(sv, d - dstart); |
92
|
|
|
|
|
|
} |
93
|
758
|
|
|
|
|
SvUTF8_on(sv); |
94
|
758
|
100
|
|
|
|
SvSETMAGIC(sv); |
95
|
|
|
|
|
|
} |
96
|
242064
|
|
|
|
|
return matches; |
97
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
99
|
|
|
|
|
|
STATIC I32 |
100
|
84876
|
|
|
|
|
S_do_trans_count(pTHX_ SV * const sv) |
101
|
|
|
|
|
|
{ |
102
|
|
|
|
|
|
dVAR; |
103
|
|
|
|
|
|
STRLEN len; |
104
|
84876
|
100
|
|
|
|
const U8 *s = (const U8*)SvPV_nomg_const(sv, len); |
105
|
84876
|
|
|
|
|
const U8 * const send = s + len; |
106
|
|
|
|
|
|
I32 matches = 0; |
107
|
84876
|
|
|
|
|
const short * const tbl = (short*)cPVOP->op_pv; |
108
|
|
|
|
|
|
|
109
|
|
|
|
|
|
PERL_ARGS_ASSERT_DO_TRANS_COUNT; |
110
|
|
|
|
|
|
|
111
|
84876
|
50
|
|
|
|
if (!tbl) |
112
|
0
|
|
|
|
|
Perl_croak(aTHX_ "panic: do_trans_count line %d",__LINE__); |
113
|
|
|
|
|
|
|
114
|
84876
|
100
|
|
|
|
if (!SvUTF8(sv)) { |
115
|
2355716
|
100
|
|
|
|
while (s < send) { |
116
|
2271022
|
100
|
|
|
|
if (tbl[*s++] >= 0) |
117
|
1224055
|
|
|
|
|
matches++; |
118
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
else { |
121
|
182
|
|
|
|
|
const I32 complement = PL_op->op_private & OPpTRANS_COMPLEMENT; |
122
|
18457
|
100
|
|
|
|
while (s < send) { |
123
|
|
|
|
|
|
STRLEN ulen; |
124
|
18184
|
100
|
|
|
|
const UV c = utf8n_to_uvchr(s, send - s, &ulen, UTF8_ALLOW_DEFAULT); |
125
|
18184
|
100
|
|
|
|
if (c < 0x100) { |
126
|
16714
|
100
|
|
|
|
if (tbl[c] >= 0) |
127
|
174
|
|
|
|
|
matches++; |
128
|
1470
|
100
|
|
|
|
} else if (complement) |
129
|
98
|
|
|
|
|
matches++; |
130
|
18184
|
|
|
|
|
s += ulen; |
131
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
134
|
84876
|
|
|
|
|
return matches; |
135
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
137
|
|
|
|
|
|
STATIC I32 |
138
|
557670
|
|
|
|
|
S_do_trans_complex(pTHX_ SV * const sv) |
139
|
|
|
|
|
|
{ |
140
|
|
|
|
|
|
dVAR; |
141
|
|
|
|
|
|
STRLEN len; |
142
|
557670
|
50
|
|
|
|
U8 *s = (U8*)SvPV_nomg(sv, len); |
143
|
557670
|
|
|
|
|
U8 * const send = s+len; |
144
|
|
|
|
|
|
I32 matches = 0; |
145
|
557670
|
|
|
|
|
const short * const tbl = (short*)cPVOP->op_pv; |
146
|
|
|
|
|
|
|
147
|
|
|
|
|
|
PERL_ARGS_ASSERT_DO_TRANS_COMPLEX; |
148
|
|
|
|
|
|
|
149
|
557670
|
50
|
|
|
|
if (!tbl) |
150
|
0
|
|
|
|
|
Perl_croak(aTHX_ "panic: do_trans_complex line %d",__LINE__); |
151
|
|
|
|
|
|
|
152
|
557670
|
100
|
|
|
|
if (!SvUTF8(sv)) { |
153
|
|
|
|
|
|
U8 *d = s; |
154
|
|
|
|
|
|
U8 * const dstart = d; |
155
|
|
|
|
|
|
|
156
|
557220
|
100
|
|
|
|
if (PL_op->op_private & OPpTRANS_SQUASH) { |
157
|
|
|
|
|
|
const U8* p = send; |
158
|
81456
|
100
|
|
|
|
while (s < send) { |
159
|
75248
|
|
|
|
|
const I32 ch = tbl[*s]; |
160
|
75248
|
100
|
|
|
|
if (ch >= 0) { |
161
|
2538
|
|
|
|
|
*d = (U8)ch; |
162
|
2538
|
|
|
|
|
matches++; |
163
|
2538
|
100
|
|
|
|
if (p != d - 1 || *p != *d) |
|
|
100
|
|
|
|
|
164
|
1814
|
|
|
|
|
p = d++; |
165
|
|
|
|
|
|
} |
166
|
72710
|
50
|
|
|
|
else if (ch == -1) /* -1 is unmapped character */ |
167
|
72710
|
|
|
|
|
*d++ = *s; |
168
|
0
|
0
|
|
|
|
else if (ch == -2) /* -2 is delete character */ |
169
|
0
|
|
|
|
|
matches++; |
170
|
75248
|
|
|
|
|
s++; |
171
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
else { |
174
|
44192680
|
100
|
|
|
|
while (s < send) { |
175
|
43641668
|
|
|
|
|
const I32 ch = tbl[*s]; |
176
|
43641668
|
100
|
|
|
|
if (ch >= 0) { |
177
|
100
|
|
|
|
|
matches++; |
178
|
100
|
|
|
|
|
*d++ = (U8)ch; |
179
|
|
|
|
|
|
} |
180
|
43641568
|
100
|
|
|
|
else if (ch == -1) /* -1 is unmapped character */ |
181
|
43303062
|
|
|
|
|
*d++ = *s; |
182
|
338506
|
50
|
|
|
|
else if (ch == -2) /* -2 is delete character */ |
183
|
338506
|
|
|
|
|
matches++; |
184
|
43641668
|
|
|
|
|
s++; |
185
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
} |
187
|
557220
|
|
|
|
|
*d = '\0'; |
188
|
557220
|
|
|
|
|
SvCUR_set(sv, d - dstart); |
189
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
else { /* is utf8 */ |
191
|
450
|
|
|
|
|
const I32 complement = PL_op->op_private & OPpTRANS_COMPLEMENT; |
192
|
450
|
|
|
|
|
const I32 grows = PL_op->op_private & OPpTRANS_GROWS; |
193
|
450
|
|
|
|
|
const I32 del = PL_op->op_private & OPpTRANS_DELETE; |
194
|
|
|
|
|
|
U8 *d; |
195
|
|
|
|
|
|
U8 *dstart; |
196
|
|
|
|
|
|
STRLEN rlen = 0; |
197
|
|
|
|
|
|
|
198
|
450
|
50
|
|
|
|
if (grows) |
199
|
0
|
|
|
|
|
Newx(d, len*2+1, U8); |
200
|
|
|
|
|
|
else |
201
|
|
|
|
|
|
d = s; |
202
|
|
|
|
|
|
dstart = d; |
203
|
450
|
100
|
|
|
|
if (complement && !del) |
204
|
10
|
|
|
|
|
rlen = tbl[0x100]; |
205
|
|
|
|
|
|
|
206
|
450
|
100
|
|
|
|
if (PL_op->op_private & OPpTRANS_SQUASH) { |
207
|
|
|
|
|
|
UV pch = 0xfeedface; |
208
|
26
|
100
|
|
|
|
while (s < send) { |
209
|
|
|
|
|
|
STRLEN len; |
210
|
20
|
50
|
|
|
|
const UV comp = utf8n_to_uvchr(s, send - s, &len, |
211
|
|
|
|
|
|
UTF8_ALLOW_DEFAULT); |
212
|
|
|
|
|
|
I32 ch; |
213
|
|
|
|
|
|
|
214
|
20
|
100
|
|
|
|
if (comp > 0xff) { |
215
|
10
|
100
|
|
|
|
if (!complement) { |
216
|
8
|
|
|
|
|
Move(s, d, len, U8); |
217
|
8
|
|
|
|
|
d += len; |
218
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
else { |
220
|
2
|
|
|
|
|
matches++; |
221
|
2
|
50
|
|
|
|
if (!del) { |
222
|
2
|
50
|
|
|
|
ch = (rlen == 0) ? (I32)comp : |
223
|
2
|
|
|
|
|
(comp - 0x100 < rlen) ? |
224
|
2
|
50
|
|
|
|
tbl[comp+1] : tbl[0x100+rlen]; |
225
|
2
|
50
|
|
|
|
if ((UV)ch != pch) { |
226
|
2
|
|
|
|
|
d = uvchr_to_utf8(d, ch); |
227
|
2
|
|
|
|
|
pch = (UV)ch; |
228
|
|
|
|
|
|
} |
229
|
2
|
|
|
|
|
s += len; |
230
|
2
|
|
|
|
|
continue; |
231
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
} |
234
|
10
|
100
|
|
|
|
else if ((ch = tbl[comp]) >= 0) { |
235
|
6
|
|
|
|
|
matches++; |
236
|
6
|
100
|
|
|
|
if ((UV)ch != pch) { |
237
|
4
|
|
|
|
|
d = uvchr_to_utf8(d, ch); |
238
|
4
|
|
|
|
|
pch = (UV)ch; |
239
|
|
|
|
|
|
} |
240
|
6
|
|
|
|
|
s += len; |
241
|
6
|
|
|
|
|
continue; |
242
|
|
|
|
|
|
} |
243
|
4
|
50
|
|
|
|
else if (ch == -1) { /* -1 is unmapped character */ |
244
|
4
|
|
|
|
|
Move(s, d, len, U8); |
245
|
4
|
|
|
|
|
d += len; |
246
|
|
|
|
|
|
} |
247
|
0
|
0
|
|
|
|
else if (ch == -2) /* -2 is delete character */ |
248
|
0
|
|
|
|
|
matches++; |
249
|
16
|
|
|
|
|
s += len; |
250
|
|
|
|
|
|
pch = 0xfeedface; |
251
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
else { |
254
|
5194
|
100
|
|
|
|
while (s < send) { |
255
|
|
|
|
|
|
STRLEN len; |
256
|
4750
|
100
|
|
|
|
const UV comp = utf8n_to_uvchr(s, send - s, &len, |
257
|
|
|
|
|
|
UTF8_ALLOW_DEFAULT); |
258
|
|
|
|
|
|
I32 ch; |
259
|
4750
|
100
|
|
|
|
if (comp > 0xff) { |
260
|
356
|
100
|
|
|
|
if (!complement) { |
261
|
342
|
|
|
|
|
Move(s, d, len, U8); |
262
|
342
|
|
|
|
|
d += len; |
263
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
else { |
265
|
14
|
|
|
|
|
matches++; |
266
|
14
|
50
|
|
|
|
if (!del) { |
267
|
14
|
100
|
|
|
|
if (comp - 0x100 < rlen) |
268
|
10
|
|
|
|
|
d = uvchr_to_utf8(d, tbl[comp+1]); |
269
|
|
|
|
|
|
else |
270
|
4
|
|
|
|
|
d = uvchr_to_utf8(d, tbl[0x100+rlen]); |
271
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
} |
274
|
4394
|
50
|
|
|
|
else if ((ch = tbl[comp]) >= 0) { |
275
|
0
|
|
|
|
|
d = uvchr_to_utf8(d, ch); |
276
|
0
|
|
|
|
|
matches++; |
277
|
|
|
|
|
|
} |
278
|
4394
|
100
|
|
|
|
else if (ch == -1) { /* -1 is unmapped character */ |
279
|
4390
|
|
|
|
|
Move(s, d, len, U8); |
280
|
4390
|
|
|
|
|
d += len; |
281
|
|
|
|
|
|
} |
282
|
4
|
50
|
|
|
|
else if (ch == -2) /* -2 is delete character */ |
283
|
4
|
|
|
|
|
matches++; |
284
|
4750
|
|
|
|
|
s += len; |
285
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
} |
287
|
450
|
50
|
|
|
|
if (grows) { |
288
|
0
|
|
|
|
|
sv_setpvn(sv, (char*)dstart, d - dstart); |
289
|
0
|
|
|
|
|
Safefree(dstart); |
290
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
else { |
292
|
450
|
|
|
|
|
*d = '\0'; |
293
|
450
|
|
|
|
|
SvCUR_set(sv, d - dstart); |
294
|
|
|
|
|
|
} |
295
|
450
|
|
|
|
|
SvUTF8_on(sv); |
296
|
|
|
|
|
|
} |
297
|
557670
|
100
|
|
|
|
SvSETMAGIC(sv); |
298
|
557670
|
|
|
|
|
return matches; |
299
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
301
|
|
|
|
|
|
STATIC I32 |
302
|
82
|
|
|
|
|
S_do_trans_simple_utf8(pTHX_ SV * const sv) |
303
|
|
|
|
|
|
{ |
304
|
|
|
|
|
|
dVAR; |
305
|
|
|
|
|
|
U8 *s; |
306
|
|
|
|
|
|
U8 *send; |
307
|
|
|
|
|
|
U8 *d; |
308
|
|
|
|
|
|
U8 *start; |
309
|
|
|
|
|
|
U8 *dstart, *dend; |
310
|
|
|
|
|
|
I32 matches = 0; |
311
|
82
|
|
|
|
|
const I32 grows = PL_op->op_private & OPpTRANS_GROWS; |
312
|
|
|
|
|
|
STRLEN len; |
313
|
|
|
|
|
|
SV* const rv = |
314
|
|
|
|
|
|
#ifdef USE_ITHREADS |
315
|
|
|
|
|
|
PAD_SVl(cPADOP->op_padix); |
316
|
|
|
|
|
|
#else |
317
|
82
|
|
|
|
|
MUTABLE_SV(cSVOP->op_sv); |
318
|
|
|
|
|
|
#endif |
319
|
82
|
|
|
|
|
HV* const hv = MUTABLE_HV(SvRV(rv)); |
320
|
82
|
|
|
|
|
SV* const * svp = hv_fetchs(hv, "NONE", FALSE); |
321
|
82
|
50
|
|
|
|
const UV none = svp ? SvUV(*svp) : 0x7fffffff; |
|
|
50
|
|
|
|
|
322
|
82
|
|
|
|
|
const UV extra = none + 1; |
323
|
|
|
|
|
|
UV final = 0; |
324
|
|
|
|
|
|
U8 hibit = 0; |
325
|
|
|
|
|
|
|
326
|
|
|
|
|
|
PERL_ARGS_ASSERT_DO_TRANS_SIMPLE_UTF8; |
327
|
|
|
|
|
|
|
328
|
82
|
50
|
|
|
|
s = (U8*)SvPV_nomg(sv, len); |
329
|
82
|
100
|
|
|
|
if (!SvUTF8(sv)) { |
330
|
|
|
|
|
|
const U8 *t = s; |
331
|
8
|
|
|
|
|
const U8 * const e = s + len; |
332
|
30
|
100
|
|
|
|
while (t < e) { |
333
|
20
|
|
|
|
|
const U8 ch = *t++; |
334
|
20
|
|
|
|
|
hibit = !NATIVE_IS_INVARIANT(ch); |
335
|
20
|
100
|
|
|
|
if (hibit) { |
336
|
2
|
|
|
|
|
s = bytes_to_utf8(s, &len); |
337
|
2
|
|
|
|
|
break; |
338
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
} |
341
|
82
|
|
|
|
|
send = s + len; |
342
|
|
|
|
|
|
start = s; |
343
|
|
|
|
|
|
|
344
|
82
|
|
|
|
|
svp = hv_fetchs(hv, "FINAL", FALSE); |
345
|
82
|
100
|
|
|
|
if (svp) |
346
|
4
|
50
|
|
|
|
final = SvUV(*svp); |
347
|
|
|
|
|
|
|
348
|
82
|
100
|
|
|
|
if (grows) { |
349
|
|
|
|
|
|
/* d needs to be bigger than s, in case e.g. upgrading is required */ |
350
|
12
|
|
|
|
|
Newx(d, len * 3 + UTF8_MAXBYTES, U8); |
351
|
47
|
|
|
|
|
dend = d + len * 3; |
352
|
|
|
|
|
|
dstart = d; |
353
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
else { |
355
|
|
|
|
|
|
dstart = d = s; |
356
|
70
|
|
|
|
|
dend = d + len; |
357
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
359
|
3086
|
100
|
|
|
|
while (s < send) { |
360
|
3004
|
|
|
|
|
const UV uv = swash_fetch(rv, s, TRUE); |
361
|
3004
|
100
|
|
|
|
if (uv < none) { |
362
|
2866
|
|
|
|
|
s += UTF8SKIP(s); |
363
|
2866
|
|
|
|
|
matches++; |
364
|
2866
|
|
|
|
|
d = uvchr_to_utf8(d, uv); |
365
|
|
|
|
|
|
} |
366
|
138
|
100
|
|
|
|
else if (uv == none) { |
367
|
132
|
|
|
|
|
const int i = UTF8SKIP(s); |
368
|
132
|
|
|
|
|
Move(s, d, i, U8); |
369
|
132
|
|
|
|
|
d += i; |
370
|
132
|
|
|
|
|
s += i; |
371
|
|
|
|
|
|
} |
372
|
6
|
50
|
|
|
|
else if (uv == extra) { |
373
|
6
|
|
|
|
|
s += UTF8SKIP(s); |
374
|
6
|
|
|
|
|
matches++; |
375
|
6
|
|
|
|
|
d = uvchr_to_utf8(d, final); |
376
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
else |
378
|
0
|
|
|
|
|
s += UTF8SKIP(s); |
379
|
|
|
|
|
|
|
380
|
3004
|
50
|
|
|
|
if (d > dend) { |
381
|
0
|
|
|
|
|
const STRLEN clen = d - dstart; |
382
|
0
|
|
|
|
|
const STRLEN nlen = dend - dstart + len + UTF8_MAXBYTES; |
383
|
0
|
0
|
|
|
|
if (!grows) |
384
|
0
|
|
|
|
|
Perl_croak(aTHX_ "panic: do_trans_simple_utf8 line %d",__LINE__); |
385
|
0
|
|
|
|
|
Renew(dstart, nlen + UTF8_MAXBYTES, U8); |
386
|
0
|
|
|
|
|
d = dstart + clen; |
387
|
1502
|
|
|
|
|
dend = dstart + nlen; |
388
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
} |
390
|
82
|
100
|
|
|
|
if (grows || hibit) { |
391
|
14
|
|
|
|
|
sv_setpvn(sv, (char*)dstart, d - dstart); |
392
|
14
|
|
|
|
|
Safefree(dstart); |
393
|
14
|
50
|
|
|
|
if (grows && hibit) |
394
|
0
|
|
|
|
|
Safefree(start); |
395
|
|
|
|
|
|
} |
396
|
|
|
|
|
|
else { |
397
|
68
|
|
|
|
|
*d = '\0'; |
398
|
68
|
|
|
|
|
SvCUR_set(sv, d - dstart); |
399
|
|
|
|
|
|
} |
400
|
82
|
100
|
|
|
|
SvSETMAGIC(sv); |
401
|
82
|
|
|
|
|
SvUTF8_on(sv); |
402
|
|
|
|
|
|
|
403
|
82
|
|
|
|
|
return matches; |
404
|
|
|
|
|
|
} |
405
|
|
|
|
|
|
|
406
|
|
|
|
|
|
STATIC I32 |
407
|
10
|
|
|
|
|
S_do_trans_count_utf8(pTHX_ SV * const sv) |
408
|
|
|
|
|
|
{ |
409
|
|
|
|
|
|
dVAR; |
410
|
|
|
|
|
|
const U8 *s; |
411
|
|
|
|
|
|
const U8 *start = NULL; |
412
|
|
|
|
|
|
const U8 *send; |
413
|
|
|
|
|
|
I32 matches = 0; |
414
|
|
|
|
|
|
STRLEN len; |
415
|
|
|
|
|
|
SV* const rv = |
416
|
|
|
|
|
|
#ifdef USE_ITHREADS |
417
|
|
|
|
|
|
PAD_SVl(cPADOP->op_padix); |
418
|
|
|
|
|
|
#else |
419
|
10
|
|
|
|
|
MUTABLE_SV(cSVOP->op_sv); |
420
|
|
|
|
|
|
#endif |
421
|
10
|
|
|
|
|
HV* const hv = MUTABLE_HV(SvRV(rv)); |
422
|
10
|
|
|
|
|
SV* const * const svp = hv_fetchs(hv, "NONE", FALSE); |
423
|
10
|
50
|
|
|
|
const UV none = svp ? SvUV(*svp) : 0x7fffffff; |
|
|
50
|
|
|
|
|
424
|
10
|
|
|
|
|
const UV extra = none + 1; |
425
|
|
|
|
|
|
U8 hibit = 0; |
426
|
|
|
|
|
|
|
427
|
|
|
|
|
|
PERL_ARGS_ASSERT_DO_TRANS_COUNT_UTF8; |
428
|
|
|
|
|
|
|
429
|
10
|
50
|
|
|
|
s = (const U8*)SvPV_nomg_const(sv, len); |
430
|
10
|
50
|
|
|
|
if (!SvUTF8(sv)) { |
431
|
|
|
|
|
|
const U8 *t = s; |
432
|
0
|
|
|
|
|
const U8 * const e = s + len; |
433
|
0
|
0
|
|
|
|
while (t < e) { |
434
|
0
|
|
|
|
|
const U8 ch = *t++; |
435
|
0
|
|
|
|
|
hibit = !NATIVE_IS_INVARIANT(ch); |
436
|
0
|
0
|
|
|
|
if (hibit) { |
437
|
0
|
|
|
|
|
start = s = bytes_to_utf8(s, &len); |
438
|
0
|
|
|
|
|
break; |
439
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
} |
441
|
|
|
|
|
|
} |
442
|
10
|
|
|
|
|
send = s + len; |
443
|
|
|
|
|
|
|
444
|
53
|
100
|
|
|
|
while (s < send) { |
445
|
38
|
|
|
|
|
const UV uv = swash_fetch(rv, s, TRUE); |
446
|
38
|
100
|
|
|
|
if (uv < none || uv == extra) |
447
|
12
|
|
|
|
|
matches++; |
448
|
38
|
|
|
|
|
s += UTF8SKIP(s); |
449
|
|
|
|
|
|
} |
450
|
10
|
50
|
|
|
|
if (hibit) |
451
|
0
|
|
|
|
|
Safefree(start); |
452
|
|
|
|
|
|
|
453
|
10
|
|
|
|
|
return matches; |
454
|
|
|
|
|
|
} |
455
|
|
|
|
|
|
|
456
|
|
|
|
|
|
STATIC I32 |
457
|
34
|
|
|
|
|
S_do_trans_complex_utf8(pTHX_ SV * const sv) |
458
|
|
|
|
|
|
{ |
459
|
|
|
|
|
|
dVAR; |
460
|
|
|
|
|
|
U8 *start, *send; |
461
|
|
|
|
|
|
U8 *d; |
462
|
|
|
|
|
|
I32 matches = 0; |
463
|
34
|
|
|
|
|
const I32 squash = PL_op->op_private & OPpTRANS_SQUASH; |
464
|
34
|
|
|
|
|
const I32 del = PL_op->op_private & OPpTRANS_DELETE; |
465
|
34
|
|
|
|
|
const I32 grows = PL_op->op_private & OPpTRANS_GROWS; |
466
|
|
|
|
|
|
SV* const rv = |
467
|
|
|
|
|
|
#ifdef USE_ITHREADS |
468
|
|
|
|
|
|
PAD_SVl(cPADOP->op_padix); |
469
|
|
|
|
|
|
#else |
470
|
34
|
|
|
|
|
MUTABLE_SV(cSVOP->op_sv); |
471
|
|
|
|
|
|
#endif |
472
|
34
|
|
|
|
|
HV * const hv = MUTABLE_HV(SvRV(rv)); |
473
|
34
|
|
|
|
|
SV * const *svp = hv_fetchs(hv, "NONE", FALSE); |
474
|
34
|
50
|
|
|
|
const UV none = svp ? SvUV(*svp) : 0x7fffffff; |
|
|
50
|
|
|
|
|
475
|
34
|
|
|
|
|
const UV extra = none + 1; |
476
|
|
|
|
|
|
UV final = 0; |
477
|
|
|
|
|
|
bool havefinal = FALSE; |
478
|
|
|
|
|
|
STRLEN len; |
479
|
|
|
|
|
|
U8 *dstart, *dend; |
480
|
|
|
|
|
|
U8 hibit = 0; |
481
|
34
|
50
|
|
|
|
U8 *s = (U8*)SvPV_nomg(sv, len); |
482
|
|
|
|
|
|
|
483
|
|
|
|
|
|
PERL_ARGS_ASSERT_DO_TRANS_COMPLEX_UTF8; |
484
|
|
|
|
|
|
|
485
|
34
|
100
|
|
|
|
if (!SvUTF8(sv)) { |
486
|
|
|
|
|
|
const U8 *t = s; |
487
|
4
|
|
|
|
|
const U8 * const e = s + len; |
488
|
34
|
100
|
|
|
|
while (t < e) { |
489
|
28
|
|
|
|
|
const U8 ch = *t++; |
490
|
28
|
|
|
|
|
hibit = !NATIVE_IS_INVARIANT(ch); |
491
|
28
|
50
|
|
|
|
if (hibit) { |
492
|
0
|
|
|
|
|
s = bytes_to_utf8(s, &len); |
493
|
0
|
|
|
|
|
break; |
494
|
|
|
|
|
|
} |
495
|
|
|
|
|
|
} |
496
|
|
|
|
|
|
} |
497
|
34
|
|
|
|
|
send = s + len; |
498
|
|
|
|
|
|
start = s; |
499
|
|
|
|
|
|
|
500
|
34
|
|
|
|
|
svp = hv_fetchs(hv, "FINAL", FALSE); |
501
|
34
|
100
|
|
|
|
if (svp) { |
502
|
18
|
50
|
|
|
|
final = SvUV(*svp); |
503
|
|
|
|
|
|
havefinal = TRUE; |
504
|
|
|
|
|
|
} |
505
|
|
|
|
|
|
|
506
|
34
|
100
|
|
|
|
if (grows) { |
507
|
|
|
|
|
|
/* d needs to be bigger than s, in case e.g. upgrading is required */ |
508
|
8
|
|
|
|
|
Newx(d, len * 3 + UTF8_MAXBYTES, U8); |
509
|
8
|
|
|
|
|
dend = d + len * 3; |
510
|
|
|
|
|
|
dstart = d; |
511
|
|
|
|
|
|
} |
512
|
|
|
|
|
|
else { |
513
|
|
|
|
|
|
dstart = d = s; |
514
|
26
|
|
|
|
|
dend = d + len; |
515
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
517
|
34
|
100
|
|
|
|
if (squash) { |
518
|
|
|
|
|
|
UV puv = 0xfeedface; |
519
|
84
|
100
|
|
|
|
while (s < send) { |
520
|
70
|
|
|
|
|
UV uv = swash_fetch(rv, s, TRUE); |
521
|
|
|
|
|
|
|
522
|
70
|
50
|
|
|
|
if (d > dend) { |
523
|
0
|
|
|
|
|
const STRLEN clen = d - dstart; |
524
|
0
|
|
|
|
|
const STRLEN nlen = dend - dstart + len + UTF8_MAXBYTES; |
525
|
0
|
0
|
|
|
|
if (!grows) |
526
|
0
|
|
|
|
|
Perl_croak(aTHX_ "panic: do_trans_complex_utf8 line %d",__LINE__); |
527
|
0
|
|
|
|
|
Renew(dstart, nlen + UTF8_MAXBYTES, U8); |
528
|
0
|
|
|
|
|
d = dstart + clen; |
529
|
0
|
|
|
|
|
dend = dstart + nlen; |
530
|
|
|
|
|
|
} |
531
|
70
|
100
|
|
|
|
if (uv < none) { |
532
|
32
|
|
|
|
|
matches++; |
533
|
32
|
|
|
|
|
s += UTF8SKIP(s); |
534
|
32
|
100
|
|
|
|
if (uv != puv) { |
535
|
14
|
|
|
|
|
d = uvchr_to_utf8(d, uv); |
536
|
|
|
|
|
|
puv = uv; |
537
|
|
|
|
|
|
} |
538
|
32
|
|
|
|
|
continue; |
539
|
|
|
|
|
|
} |
540
|
38
|
100
|
|
|
|
else if (uv == none) { /* "none" is unmapped character */ |
541
|
26
|
|
|
|
|
const int i = UTF8SKIP(s); |
542
|
26
|
|
|
|
|
Move(s, d, i, U8); |
543
|
26
|
|
|
|
|
d += i; |
544
|
26
|
|
|
|
|
s += i; |
545
|
|
|
|
|
|
puv = 0xfeedface; |
546
|
26
|
|
|
|
|
continue; |
547
|
|
|
|
|
|
} |
548
|
12
|
50
|
|
|
|
else if (uv == extra && !del) { |
549
|
12
|
|
|
|
|
matches++; |
550
|
12
|
100
|
|
|
|
if (havefinal) { |
551
|
8
|
|
|
|
|
s += UTF8SKIP(s); |
552
|
8
|
100
|
|
|
|
if (puv != final) { |
553
|
2
|
|
|
|
|
d = uvchr_to_utf8(d, final); |
554
|
|
|
|
|
|
puv = final; |
555
|
|
|
|
|
|
} |
556
|
|
|
|
|
|
} |
557
|
|
|
|
|
|
else { |
558
|
|
|
|
|
|
STRLEN len; |
559
|
4
|
50
|
|
|
|
uv = utf8n_to_uvchr(s, send - s, &len, UTF8_ALLOW_DEFAULT); |
560
|
4
|
100
|
|
|
|
if (uv != puv) { |
561
|
2
|
|
|
|
|
Move(s, d, len, U8); |
562
|
2
|
|
|
|
|
d += len; |
563
|
|
|
|
|
|
puv = uv; |
564
|
|
|
|
|
|
} |
565
|
4
|
|
|
|
|
s += len; |
566
|
|
|
|
|
|
} |
567
|
12
|
|
|
|
|
continue; |
568
|
|
|
|
|
|
} |
569
|
0
|
|
|
|
|
matches++; /* "none+1" is delete character */ |
570
|
35
|
|
|
|
|
s += UTF8SKIP(s); |
571
|
|
|
|
|
|
} |
572
|
|
|
|
|
|
} |
573
|
|
|
|
|
|
else { |
574
|
98
|
100
|
|
|
|
while (s < send) { |
575
|
78
|
|
|
|
|
const UV uv = swash_fetch(rv, s, TRUE); |
576
|
78
|
50
|
|
|
|
if (d > dend) { |
577
|
0
|
|
|
|
|
const STRLEN clen = d - dstart; |
578
|
0
|
|
|
|
|
const STRLEN nlen = dend - dstart + len + UTF8_MAXBYTES; |
579
|
0
|
0
|
|
|
|
if (!grows) |
580
|
0
|
|
|
|
|
Perl_croak(aTHX_ "panic: do_trans_complex_utf8 line %d",__LINE__); |
581
|
0
|
|
|
|
|
Renew(dstart, nlen + UTF8_MAXBYTES, U8); |
582
|
0
|
|
|
|
|
d = dstart + clen; |
583
|
0
|
|
|
|
|
dend = dstart + nlen; |
584
|
|
|
|
|
|
} |
585
|
78
|
100
|
|
|
|
if (uv < none) { |
586
|
8
|
|
|
|
|
matches++; |
587
|
8
|
|
|
|
|
s += UTF8SKIP(s); |
588
|
8
|
|
|
|
|
d = uvchr_to_utf8(d, uv); |
589
|
8
|
|
|
|
|
continue; |
590
|
|
|
|
|
|
} |
591
|
70
|
100
|
|
|
|
else if (uv == none) { /* "none" is unmapped character */ |
592
|
38
|
|
|
|
|
const int i = UTF8SKIP(s); |
593
|
38
|
|
|
|
|
Move(s, d, i, U8); |
594
|
38
|
|
|
|
|
d += i; |
595
|
38
|
|
|
|
|
s += i; |
596
|
38
|
|
|
|
|
continue; |
597
|
|
|
|
|
|
} |
598
|
32
|
100
|
|
|
|
else if (uv == extra && !del) { |
599
|
26
|
|
|
|
|
matches++; |
600
|
26
|
|
|
|
|
s += UTF8SKIP(s); |
601
|
26
|
|
|
|
|
d = uvchr_to_utf8(d, final); |
602
|
26
|
|
|
|
|
continue; |
603
|
|
|
|
|
|
} |
604
|
6
|
|
|
|
|
matches++; /* "none+1" is delete character */ |
605
|
42
|
|
|
|
|
s += UTF8SKIP(s); |
606
|
|
|
|
|
|
} |
607
|
|
|
|
|
|
} |
608
|
34
|
100
|
|
|
|
if (grows || hibit) { |
609
|
8
|
|
|
|
|
sv_setpvn(sv, (char*)dstart, d - dstart); |
610
|
8
|
|
|
|
|
Safefree(dstart); |
611
|
8
|
50
|
|
|
|
if (grows && hibit) |
612
|
0
|
|
|
|
|
Safefree(start); |
613
|
|
|
|
|
|
} |
614
|
|
|
|
|
|
else { |
615
|
26
|
|
|
|
|
*d = '\0'; |
616
|
26
|
|
|
|
|
SvCUR_set(sv, d - dstart); |
617
|
|
|
|
|
|
} |
618
|
34
|
|
|
|
|
SvUTF8_on(sv); |
619
|
34
|
50
|
|
|
|
SvSETMAGIC(sv); |
620
|
|
|
|
|
|
|
621
|
34
|
|
|
|
|
return matches; |
622
|
|
|
|
|
|
} |
623
|
|
|
|
|
|
|
624
|
|
|
|
|
|
I32 |
625
|
895790
|
|
|
|
|
Perl_do_trans(pTHX_ SV *sv) |
626
|
|
|
|
|
|
{ |
627
|
|
|
|
|
|
dVAR; |
628
|
|
|
|
|
|
STRLEN len; |
629
|
895790
|
|
|
|
|
const I32 hasutf = (PL_op->op_private & |
630
|
|
|
|
|
|
(OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)); |
631
|
|
|
|
|
|
|
632
|
|
|
|
|
|
PERL_ARGS_ASSERT_DO_TRANS; |
633
|
|
|
|
|
|
|
634
|
895790
|
100
|
|
|
|
if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_IDENTICAL)) { |
|
|
100
|
|
|
|
|
635
|
4
|
|
|
|
|
Perl_croak_no_modify(); |
636
|
|
|
|
|
|
} |
637
|
895786
|
100
|
|
|
|
(void)SvPV_const(sv, len); |
638
|
895786
|
100
|
|
|
|
if (!len) |
639
|
|
|
|
|
|
return 0; |
640
|
884736
|
100
|
|
|
|
if (!(PL_op->op_private & OPpTRANS_IDENTICAL)) { |
641
|
799850
|
100
|
|
|
|
if (!SvPOKp(sv) || SvTHINKFIRST(sv)) |
642
|
222842
|
50
|
|
|
|
(void)SvPV_force_nomg(sv, len); |
643
|
799850
|
|
|
|
|
(void)SvPOK_only_UTF8(sv); |
644
|
|
|
|
|
|
} |
645
|
|
|
|
|
|
|
646
|
|
|
|
|
|
DEBUG_t( Perl_deb(aTHX_ "2.TBL\n")); |
647
|
|
|
|
|
|
|
648
|
884736
|
|
|
|
|
switch (PL_op->op_private & ~hasutf & ( |
649
|
|
|
|
|
|
OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF|OPpTRANS_IDENTICAL| |
650
|
|
|
|
|
|
OPpTRANS_SQUASH|OPpTRANS_DELETE|OPpTRANS_COMPLEMENT)) { |
651
|
|
|
|
|
|
case 0: |
652
|
242146
|
100
|
|
|
|
if (hasutf) |
653
|
82
|
|
|
|
|
return do_trans_simple_utf8(sv); |
654
|
|
|
|
|
|
else |
655
|
242064
|
|
|
|
|
return do_trans_simple(sv); |
656
|
|
|
|
|
|
|
657
|
|
|
|
|
|
case OPpTRANS_IDENTICAL: |
658
|
|
|
|
|
|
case OPpTRANS_IDENTICAL|OPpTRANS_COMPLEMENT: |
659
|
84886
|
100
|
|
|
|
if (hasutf) |
660
|
10
|
|
|
|
|
return do_trans_count_utf8(sv); |
661
|
|
|
|
|
|
else |
662
|
84876
|
|
|
|
|
return do_trans_count(sv); |
663
|
|
|
|
|
|
|
664
|
|
|
|
|
|
default: |
665
|
557704
|
100
|
|
|
|
if (hasutf) |
666
|
34
|
|
|
|
|
return do_trans_complex_utf8(sv); |
667
|
|
|
|
|
|
else |
668
|
727268
|
|
|
|
|
return do_trans_complex(sv); |
669
|
|
|
|
|
|
} |
670
|
|
|
|
|
|
} |
671
|
|
|
|
|
|
|
672
|
|
|
|
|
|
void |
673
|
7398223
|
|
|
|
|
Perl_do_join(pTHX_ SV *sv, SV *delim, SV **mark, SV **sp) |
674
|
7398223
|
100
|
|
|
|
{ |
675
|
|
|
|
|
|
dVAR; |
676
|
|
|
|
|
|
SV ** const oldmark = mark; |
677
|
7398223
|
|
|
|
|
I32 items = sp - mark; |
678
|
|
|
|
|
|
STRLEN len; |
679
|
|
|
|
|
|
STRLEN delimlen; |
680
|
|
|
|
|
|
|
681
|
|
|
|
|
|
PERL_ARGS_ASSERT_DO_JOIN; |
682
|
|
|
|
|
|
|
683
|
7398223
|
100
|
|
|
|
(void) SvPV_const(delim, delimlen); /* stringify and get the delimlen */ |
684
|
|
|
|
|
|
/* SvCUR assumes it's SvPOK() and woe betide you if it's not. */ |
685
|
|
|
|
|
|
|
686
|
7398223
|
|
|
|
|
mark++; |
687
|
7398223
|
100
|
|
|
|
len = (items > 0 ? (delimlen * (items - 1) ) : 0); |
688
|
4130337
|
|
|
|
|
SvUPGRADE(sv, SVt_PV); |
689
|
7398223
|
100
|
|
|
|
if (SvLEN(sv) < len + items) { /* current length is way too short */ |
690
|
4528928
|
100
|
|
|
|
while (items-- > 0) { |
691
|
4135285
|
50
|
|
|
|
if (*mark && !SvGAMAGIC(*mark) && SvOK(*mark)) { |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
692
|
|
|
|
|
|
STRLEN tmplen; |
693
|
4132055
|
100
|
|
|
|
SvPV_const(*mark, tmplen); |
694
|
4132055
|
|
|
|
|
len += tmplen; |
695
|
|
|
|
|
|
} |
696
|
4135285
|
|
|
|
|
mark++; |
697
|
|
|
|
|
|
} |
698
|
393643
|
100
|
|
|
|
SvGROW(sv, len + 1); /* so try to pre-extend */ |
|
|
50
|
|
|
|
|
699
|
|
|
|
|
|
|
700
|
|
|
|
|
|
mark = oldmark; |
701
|
393643
|
|
|
|
|
items = sp - mark; |
702
|
393643
|
|
|
|
|
++mark; |
703
|
|
|
|
|
|
} |
704
|
|
|
|
|
|
|
705
|
7398223
|
|
|
|
|
sv_setpvs(sv, ""); |
706
|
|
|
|
|
|
/* sv_setpv retains old UTF8ness [perl #24846] */ |
707
|
7398223
|
|
|
|
|
SvUTF8_off(sv); |
708
|
|
|
|
|
|
|
709
|
7398223
|
100
|
|
|
|
if (TAINTING_get && SvMAGICAL(sv)) |
|
|
100
|
|
|
|
|
710
|
2
|
50
|
|
|
|
SvTAINTED_off(sv); |
711
|
|
|
|
|
|
|
712
|
7398223
|
100
|
|
|
|
if (items-- > 0) { |
713
|
5940879
|
50
|
|
|
|
if (*mark) |
714
|
5940879
|
|
|
|
|
sv_catsv(sv, *mark); |
715
|
5940879
|
|
|
|
|
mark++; |
716
|
|
|
|
|
|
} |
717
|
|
|
|
|
|
|
718
|
7398223
|
100
|
|
|
|
if (delimlen) { |
719
|
7938815
|
100
|
|
|
|
for (; items > 0; items--,mark++) { |
720
|
6116543
|
|
|
|
|
sv_catsv_nomg(sv,delim); |
721
|
6116543
|
|
|
|
|
sv_catsv(sv,*mark); |
722
|
|
|
|
|
|
} |
723
|
|
|
|
|
|
} |
724
|
|
|
|
|
|
else { |
725
|
5379070
|
100
|
|
|
|
for (; items > 0; items--,mark++) |
726
|
3500313
|
|
|
|
|
sv_catsv(sv,*mark); |
727
|
|
|
|
|
|
} |
728
|
7398223
|
100
|
|
|
|
SvSETMAGIC(sv); |
729
|
7398223
|
|
|
|
|
} |
730
|
|
|
|
|
|
|
731
|
|
|
|
|
|
void |
732
|
4968327
|
|
|
|
|
Perl_do_sprintf(pTHX_ SV *sv, I32 len, SV **sarg) |
733
|
|
|
|
|
|
{ |
734
|
|
|
|
|
|
dVAR; |
735
|
|
|
|
|
|
STRLEN patlen; |
736
|
4968327
|
100
|
|
|
|
const char * const pat = SvPV_const(*sarg, patlen); |
737
|
4968327
|
|
|
|
|
bool do_taint = FALSE; |
738
|
|
|
|
|
|
|
739
|
|
|
|
|
|
PERL_ARGS_ASSERT_DO_SPRINTF; |
740
|
|
|
|
|
|
|
741
|
4968327
|
100
|
|
|
|
if (SvTAINTED(*sarg)) |
|
|
50
|
|
|
|
|
742
|
0
|
0
|
|
|
|
TAINT_PROPER( |
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
743
|
|
|
|
|
|
(PL_op && PL_op->op_type < OP_max) |
744
|
|
|
|
|
|
? (PL_op->op_type == OP_PRTF) |
745
|
|
|
|
|
|
? "printf" |
746
|
|
|
|
|
|
: PL_op_name[PL_op->op_type] |
747
|
|
|
|
|
|
: "(unknown)" |
748
|
|
|
|
|
|
); |
749
|
4968327
|
|
|
|
|
SvUTF8_off(sv); |
750
|
4968327
|
100
|
|
|
|
if (DO_UTF8(*sarg)) |
|
|
50
|
|
|
|
|
751
|
56
|
|
|
|
|
SvUTF8_on(sv); |
752
|
4968327
|
|
|
|
|
sv_vsetpvfn(sv, pat, patlen, NULL, sarg + 1, len - 1, &do_taint); |
753
|
4968295
|
100
|
|
|
|
SvSETMAGIC(sv); |
754
|
4968295
|
50
|
|
|
|
if (do_taint) |
755
|
0
|
0
|
|
|
|
SvTAINTED_on(sv); |
756
|
4968295
|
|
|
|
|
} |
757
|
|
|
|
|
|
|
758
|
|
|
|
|
|
/* currently converts input to bytes if possible, but doesn't sweat failure */ |
759
|
|
|
|
|
|
UV |
760
|
5552120
|
|
|
|
|
Perl_do_vecget(pTHX_ SV *sv, SSize_t offset, int size) |
761
|
|
|
|
|
|
{ |
762
|
|
|
|
|
|
dVAR; |
763
|
|
|
|
|
|
STRLEN srclen, len, uoffset, bitoffs = 0; |
764
|
5552120
|
100
|
|
|
|
const unsigned char *s = (const unsigned char *) SvPV_flags_const(sv, srclen, |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
765
|
|
|
|
|
|
SV_GMAGIC | ((PL_op->op_flags & OPf_MOD || LVRET) |
766
|
|
|
|
|
|
? SV_UNDEF_RETURNS_NULL : 0)); |
767
|
|
|
|
|
|
UV retnum = 0; |
768
|
|
|
|
|
|
|
769
|
5552120
|
100
|
|
|
|
if (!s) { |
770
|
|
|
|
|
|
s = (const unsigned char *)""; |
771
|
|
|
|
|
|
} |
772
|
|
|
|
|
|
|
773
|
|
|
|
|
|
PERL_ARGS_ASSERT_DO_VECGET; |
774
|
|
|
|
|
|
|
775
|
5552120
|
100
|
|
|
|
if (offset < 0) |
776
|
|
|
|
|
|
return 0; |
777
|
5552118
|
100
|
|
|
|
if (size < 1 || (size & (size-1))) /* size < 1 or not a power of two */ |
|
|
100
|
|
|
|
|
778
|
10
|
|
|
|
|
Perl_croak(aTHX_ "Illegal number of bits in vec"); |
779
|
|
|
|
|
|
|
780
|
5552108
|
100
|
|
|
|
if (SvUTF8(sv)) |
781
|
8
|
|
|
|
|
(void) Perl_sv_utf8_downgrade(aTHX_ sv, TRUE); |
782
|
|
|
|
|
|
|
783
|
5552108
|
100
|
|
|
|
if (size < 8) { |
784
|
5552052
|
|
|
|
|
bitoffs = ((offset%8)*size)%8; |
785
|
5552052
|
|
|
|
|
uoffset = offset/(8/size); |
786
|
|
|
|
|
|
} |
787
|
56
|
100
|
|
|
|
else if (size > 8) |
788
|
32
|
|
|
|
|
uoffset = offset*(size/8); |
789
|
|
|
|
|
|
else |
790
|
24
|
|
|
|
|
uoffset = offset; |
791
|
|
|
|
|
|
|
792
|
5552108
|
|
|
|
|
len = uoffset + (bitoffs + size + 7)/8; /* required number of bytes */ |
793
|
5552108
|
100
|
|
|
|
if (len > srclen) { |
794
|
495702
|
100
|
|
|
|
if (size <= 8) |
795
|
|
|
|
|
|
retnum = 0; |
796
|
|
|
|
|
|
else { |
797
|
8
|
50
|
|
|
|
if (size == 16) { |
798
|
0
|
0
|
|
|
|
if (uoffset >= srclen) |
799
|
|
|
|
|
|
retnum = 0; |
800
|
|
|
|
|
|
else |
801
|
0
|
|
|
|
|
retnum = (UV) s[uoffset] << 8; |
802
|
|
|
|
|
|
} |
803
|
8
|
100
|
|
|
|
else if (size == 32) { |
804
|
2
|
50
|
|
|
|
if (uoffset >= srclen) |
805
|
|
|
|
|
|
retnum = 0; |
806
|
0
|
0
|
|
|
|
else if (uoffset + 1 >= srclen) |
807
|
0
|
|
|
|
|
retnum = |
808
|
0
|
|
|
|
|
((UV) s[uoffset ] << 24); |
809
|
0
|
0
|
|
|
|
else if (uoffset + 2 >= srclen) |
810
|
0
|
|
|
|
|
retnum = |
811
|
0
|
|
|
|
|
((UV) s[uoffset ] << 24) + |
812
|
0
|
|
|
|
|
((UV) s[uoffset + 1] << 16); |
813
|
|
|
|
|
|
else |
814
|
0
|
|
|
|
|
retnum = |
815
|
0
|
|
|
|
|
((UV) s[uoffset ] << 24) + |
816
|
0
|
|
|
|
|
((UV) s[uoffset + 1] << 16) + |
817
|
0
|
|
|
|
|
( s[uoffset + 2] << 8); |
818
|
|
|
|
|
|
} |
819
|
|
|
|
|
|
#ifdef UV_IS_QUAD |
820
|
6
|
50
|
|
|
|
else if (size == 64) { |
821
|
6
|
|
|
|
|
Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), |
822
|
|
|
|
|
|
"Bit vector size > 32 non-portable"); |
823
|
6
|
50
|
|
|
|
if (uoffset >= srclen) |
824
|
|
|
|
|
|
retnum = 0; |
825
|
0
|
0
|
|
|
|
else if (uoffset + 1 >= srclen) |
826
|
0
|
|
|
|
|
retnum = |
827
|
0
|
|
|
|
|
(UV) s[uoffset ] << 56; |
828
|
0
|
0
|
|
|
|
else if (uoffset + 2 >= srclen) |
829
|
0
|
|
|
|
|
retnum = |
830
|
0
|
|
|
|
|
((UV) s[uoffset ] << 56) + |
831
|
0
|
|
|
|
|
((UV) s[uoffset + 1] << 48); |
832
|
0
|
0
|
|
|
|
else if (uoffset + 3 >= srclen) |
833
|
0
|
|
|
|
|
retnum = |
834
|
0
|
|
|
|
|
((UV) s[uoffset ] << 56) + |
835
|
0
|
|
|
|
|
((UV) s[uoffset + 1] << 48) + |
836
|
0
|
|
|
|
|
((UV) s[uoffset + 2] << 40); |
837
|
0
|
0
|
|
|
|
else if (uoffset + 4 >= srclen) |
838
|
0
|
|
|
|
|
retnum = |
839
|
0
|
|
|
|
|
((UV) s[uoffset ] << 56) + |
840
|
0
|
|
|
|
|
((UV) s[uoffset + 1] << 48) + |
841
|
0
|
|
|
|
|
((UV) s[uoffset + 2] << 40) + |
842
|
0
|
|
|
|
|
((UV) s[uoffset + 3] << 32); |
843
|
0
|
0
|
|
|
|
else if (uoffset + 5 >= srclen) |
844
|
0
|
|
|
|
|
retnum = |
845
|
0
|
|
|
|
|
((UV) s[uoffset ] << 56) + |
846
|
0
|
|
|
|
|
((UV) s[uoffset + 1] << 48) + |
847
|
0
|
|
|
|
|
((UV) s[uoffset + 2] << 40) + |
848
|
0
|
|
|
|
|
((UV) s[uoffset + 3] << 32) + |
849
|
0
|
|
|
|
|
( s[uoffset + 4] << 24); |
850
|
0
|
0
|
|
|
|
else if (uoffset + 6 >= srclen) |
851
|
0
|
|
|
|
|
retnum = |
852
|
0
|
|
|
|
|
((UV) s[uoffset ] << 56) + |
853
|
0
|
|
|
|
|
((UV) s[uoffset + 1] << 48) + |
854
|
0
|
|
|
|
|
((UV) s[uoffset + 2] << 40) + |
855
|
0
|
|
|
|
|
((UV) s[uoffset + 3] << 32) + |
856
|
0
|
|
|
|
|
((UV) s[uoffset + 4] << 24) + |
857
|
0
|
|
|
|
|
((UV) s[uoffset + 5] << 16); |
858
|
|
|
|
|
|
else |
859
|
0
|
|
|
|
|
retnum = |
860
|
0
|
|
|
|
|
((UV) s[uoffset ] << 56) + |
861
|
0
|
|
|
|
|
((UV) s[uoffset + 1] << 48) + |
862
|
0
|
|
|
|
|
((UV) s[uoffset + 2] << 40) + |
863
|
0
|
|
|
|
|
((UV) s[uoffset + 3] << 32) + |
864
|
0
|
|
|
|
|
((UV) s[uoffset + 4] << 24) + |
865
|
0
|
|
|
|
|
((UV) s[uoffset + 5] << 16) + |
866
|
0
|
|
|
|
|
( s[uoffset + 6] << 8); |
867
|
|
|
|
|
|
} |
868
|
|
|
|
|
|
#endif |
869
|
|
|
|
|
|
} |
870
|
|
|
|
|
|
} |
871
|
5056406
|
100
|
|
|
|
else if (size < 8) |
872
|
5056360
|
|
|
|
|
retnum = (s[uoffset] >> bitoffs) & ((1 << size) - 1); |
873
|
|
|
|
|
|
else { |
874
|
46
|
100
|
|
|
|
if (size == 8) |
875
|
22
|
|
|
|
|
retnum = s[uoffset]; |
876
|
24
|
100
|
|
|
|
else if (size == 16) |
877
|
4
|
|
|
|
|
retnum = |
878
|
8
|
|
|
|
|
((UV) s[uoffset] << 8) + |
879
|
4
|
|
|
|
|
s[uoffset + 1]; |
880
|
20
|
100
|
|
|
|
else if (size == 32) |
881
|
6
|
|
|
|
|
retnum = |
882
|
12
|
|
|
|
|
((UV) s[uoffset ] << 24) + |
883
|
12
|
|
|
|
|
((UV) s[uoffset + 1] << 16) + |
884
|
12
|
|
|
|
|
( s[uoffset + 2] << 8) + |
885
|
6
|
|
|
|
|
s[uoffset + 3]; |
886
|
|
|
|
|
|
#ifdef UV_IS_QUAD |
887
|
14
|
50
|
|
|
|
else if (size == 64) { |
888
|
14
|
|
|
|
|
Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), |
889
|
|
|
|
|
|
"Bit vector size > 32 non-portable"); |
890
|
14
|
|
|
|
|
retnum = |
891
|
28
|
|
|
|
|
((UV) s[uoffset ] << 56) + |
892
|
28
|
|
|
|
|
((UV) s[uoffset + 1] << 48) + |
893
|
28
|
|
|
|
|
((UV) s[uoffset + 2] << 40) + |
894
|
28
|
|
|
|
|
((UV) s[uoffset + 3] << 32) + |
895
|
28
|
|
|
|
|
((UV) s[uoffset + 4] << 24) + |
896
|
28
|
|
|
|
|
((UV) s[uoffset + 5] << 16) + |
897
|
28
|
|
|
|
|
( s[uoffset + 6] << 8) + |
898
|
14
|
|
|
|
|
s[uoffset + 7]; |
899
|
|
|
|
|
|
} |
900
|
|
|
|
|
|
#endif |
901
|
|
|
|
|
|
} |
902
|
|
|
|
|
|
|
903
|
5552109
|
|
|
|
|
return retnum; |
904
|
|
|
|
|
|
} |
905
|
|
|
|
|
|
|
906
|
|
|
|
|
|
/* currently converts input to bytes if possible but doesn't sweat failures, |
907
|
|
|
|
|
|
* although it does ensure that the string it clobbers is not marked as |
908
|
|
|
|
|
|
* utf8-valid any more |
909
|
|
|
|
|
|
*/ |
910
|
|
|
|
|
|
void |
911
|
5038378
|
|
|
|
|
Perl_do_vecset(pTHX_ SV *sv) |
912
|
|
|
|
|
|
{ |
913
|
|
|
|
|
|
dVAR; |
914
|
|
|
|
|
|
SSize_t offset, bitoffs = 0; |
915
|
|
|
|
|
|
int size; |
916
|
|
|
|
|
|
unsigned char *s; |
917
|
|
|
|
|
|
UV lval; |
918
|
|
|
|
|
|
I32 mask; |
919
|
|
|
|
|
|
STRLEN targlen; |
920
|
|
|
|
|
|
STRLEN len; |
921
|
5038378
|
|
|
|
|
SV * const targ = LvTARG(sv); |
922
|
|
|
|
|
|
|
923
|
|
|
|
|
|
PERL_ARGS_ASSERT_DO_VECSET; |
924
|
|
|
|
|
|
|
925
|
5038378
|
50
|
|
|
|
if (!targ) |
926
|
5038374
|
|
|
|
|
return; |
927
|
5038378
|
100
|
|
|
|
s = (unsigned char*)SvPV_force_flags(targ, targlen, |
928
|
|
|
|
|
|
SV_GMAGIC | SV_UNDEF_RETURNS_NULL); |
929
|
5038376
|
100
|
|
|
|
if (SvUTF8(targ)) { |
930
|
|
|
|
|
|
/* This is handled by the SvPOK_only below... |
931
|
|
|
|
|
|
if (!Perl_sv_utf8_downgrade(aTHX_ targ, TRUE)) |
932
|
|
|
|
|
|
SvUTF8_off(targ); |
933
|
|
|
|
|
|
*/ |
934
|
2
|
|
|
|
|
(void) Perl_sv_utf8_downgrade(aTHX_ targ, TRUE); |
935
|
|
|
|
|
|
} |
936
|
|
|
|
|
|
|
937
|
5038376
|
|
|
|
|
(void)SvPOK_only(targ); |
938
|
5038376
|
50
|
|
|
|
lval = SvUV(sv); |
939
|
5038376
|
|
|
|
|
offset = LvTARGOFF(sv); |
940
|
5038376
|
100
|
|
|
|
if (offset < 0) |
941
|
2
|
|
|
|
|
Perl_croak(aTHX_ "Negative offset to vec in lvalue context"); |
942
|
5038374
|
|
|
|
|
size = LvTARGLEN(sv); |
943
|
5038374
|
50
|
|
|
|
if (size < 1 || (size & (size-1))) /* size < 1 or not a power of two */ |
|
|
50
|
|
|
|
|
944
|
0
|
|
|
|
|
Perl_croak(aTHX_ "Illegal number of bits in vec"); |
945
|
|
|
|
|
|
|
946
|
5038374
|
100
|
|
|
|
if (size < 8) { |
947
|
5038364
|
|
|
|
|
bitoffs = ((offset%8)*size)%8; |
948
|
5038364
|
|
|
|
|
offset /= 8/size; |
949
|
|
|
|
|
|
} |
950
|
10
|
100
|
|
|
|
else if (size > 8) |
951
|
6
|
|
|
|
|
offset *= size/8; |
952
|
|
|
|
|
|
|
953
|
5038374
|
|
|
|
|
len = offset + (bitoffs + size + 7)/8; /* required number of bytes */ |
954
|
5038374
|
100
|
|
|
|
if (len > targlen) { |
955
|
495666
|
50
|
|
|
|
s = (unsigned char*)SvGROW(targ, len + 1); |
|
|
100
|
|
|
|
|
956
|
495666
|
|
|
|
|
(void)memzero((char *)(s + targlen), len - targlen + 1); |
957
|
495666
|
|
|
|
|
SvCUR_set(targ, len); |
958
|
|
|
|
|
|
} |
959
|
|
|
|
|
|
|
960
|
5038374
|
100
|
|
|
|
if (size < 8) { |
961
|
5038364
|
|
|
|
|
mask = (1 << size) - 1; |
962
|
5038364
|
|
|
|
|
lval &= mask; |
963
|
5038364
|
|
|
|
|
s[offset] &= ~(mask << bitoffs); |
964
|
5038364
|
|
|
|
|
s[offset] |= lval << bitoffs; |
965
|
|
|
|
|
|
} |
966
|
|
|
|
|
|
else { |
967
|
10
|
100
|
|
|
|
if (size == 8) |
968
|
4
|
|
|
|
|
s[offset ] = (U8)( lval & 0xff); |
969
|
6
|
50
|
|
|
|
else if (size == 16) { |
970
|
0
|
|
|
|
|
s[offset ] = (U8)((lval >> 8) & 0xff); |
971
|
0
|
|
|
|
|
s[offset+1] = (U8)( lval & 0xff); |
972
|
|
|
|
|
|
} |
973
|
6
|
100
|
|
|
|
else if (size == 32) { |
974
|
4
|
|
|
|
|
s[offset ] = (U8)((lval >> 24) & 0xff); |
975
|
4
|
|
|
|
|
s[offset+1] = (U8)((lval >> 16) & 0xff); |
976
|
4
|
|
|
|
|
s[offset+2] = (U8)((lval >> 8) & 0xff); |
977
|
4
|
|
|
|
|
s[offset+3] = (U8)( lval & 0xff); |
978
|
|
|
|
|
|
} |
979
|
|
|
|
|
|
#ifdef UV_IS_QUAD |
980
|
2
|
50
|
|
|
|
else if (size == 64) { |
981
|
2
|
|
|
|
|
Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), |
982
|
|
|
|
|
|
"Bit vector size > 32 non-portable"); |
983
|
2
|
|
|
|
|
s[offset ] = (U8)((lval >> 56) & 0xff); |
984
|
2
|
|
|
|
|
s[offset+1] = (U8)((lval >> 48) & 0xff); |
985
|
2
|
|
|
|
|
s[offset+2] = (U8)((lval >> 40) & 0xff); |
986
|
2
|
|
|
|
|
s[offset+3] = (U8)((lval >> 32) & 0xff); |
987
|
2
|
|
|
|
|
s[offset+4] = (U8)((lval >> 24) & 0xff); |
988
|
2
|
|
|
|
|
s[offset+5] = (U8)((lval >> 16) & 0xff); |
989
|
2
|
|
|
|
|
s[offset+6] = (U8)((lval >> 8) & 0xff); |
990
|
2
|
|
|
|
|
s[offset+7] = (U8)( lval & 0xff); |
991
|
|
|
|
|
|
} |
992
|
|
|
|
|
|
#endif |
993
|
|
|
|
|
|
} |
994
|
5038374
|
100
|
|
|
|
SvSETMAGIC(targ); |
995
|
|
|
|
|
|
} |
996
|
|
|
|
|
|
|
997
|
|
|
|
|
|
void |
998
|
1011084
|
|
|
|
|
Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) |
999
|
|
|
|
|
|
{ |
1000
|
|
|
|
|
|
dVAR; |
1001
|
|
|
|
|
|
#ifdef LIBERAL |
1002
|
|
|
|
|
|
long *dl; |
1003
|
|
|
|
|
|
long *ll; |
1004
|
|
|
|
|
|
long *rl; |
1005
|
|
|
|
|
|
#endif |
1006
|
|
|
|
|
|
char *dc; |
1007
|
|
|
|
|
|
STRLEN leftlen; |
1008
|
|
|
|
|
|
STRLEN rightlen; |
1009
|
|
|
|
|
|
const char *lc; |
1010
|
|
|
|
|
|
const char *rc; |
1011
|
|
|
|
|
|
STRLEN len; |
1012
|
|
|
|
|
|
STRLEN lensave; |
1013
|
|
|
|
|
|
const char *lsave; |
1014
|
|
|
|
|
|
const char *rsave; |
1015
|
|
|
|
|
|
bool left_utf; |
1016
|
|
|
|
|
|
bool right_utf; |
1017
|
|
|
|
|
|
STRLEN needlen = 0; |
1018
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
PERL_ARGS_ASSERT_DO_VOP; |
1020
|
|
|
|
|
|
|
1021
|
1011084
|
100
|
|
|
|
if (sv != left || (optype != OP_BIT_AND && !SvOK(sv))) |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
1022
|
727084
|
|
|
|
|
sv_setpvs(sv, ""); /* avoid undef warning on |= and ^= */ |
1023
|
1011084
|
100
|
|
|
|
if (sv == left) { |
1024
|
296902
|
100
|
|
|
|
lsave = lc = SvPV_force_nomg(left, leftlen); |
1025
|
|
|
|
|
|
} |
1026
|
|
|
|
|
|
else { |
1027
|
714182
|
100
|
|
|
|
lsave = lc = SvPV_nomg_const(left, leftlen); |
1028
|
714182
|
50
|
|
|
|
SvPV_force_nomg_nolen(sv); |
1029
|
|
|
|
|
|
} |
1030
|
1011084
|
100
|
|
|
|
rsave = rc = SvPV_nomg_const(right, rightlen); |
1031
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
/* This need to come after SvPV to ensure that string overloading has |
1033
|
|
|
|
|
|
fired off. */ |
1034
|
|
|
|
|
|
|
1035
|
1011084
|
100
|
|
|
|
left_utf = DO_UTF8(left); |
|
|
50
|
|
|
|
|
1036
|
1011084
|
100
|
|
|
|
right_utf = DO_UTF8(right); |
|
|
50
|
|
|
|
|
1037
|
|
|
|
|
|
|
1038
|
1011084
|
100
|
|
|
|
if (left_utf && !right_utf) { |
|
|
100
|
|
|
|
|
1039
|
|
|
|
|
|
/* Avoid triggering overloading again by using temporaries. |
1040
|
|
|
|
|
|
Maybe there should be a variant of sv_utf8_upgrade that takes pvn |
1041
|
|
|
|
|
|
*/ |
1042
|
138
|
|
|
|
|
right = newSVpvn_flags(rsave, rightlen, SVs_TEMP); |
1043
|
138
|
|
|
|
|
sv_utf8_upgrade(right); |
1044
|
138
|
50
|
|
|
|
rsave = rc = SvPV_nomg_const(right, rightlen); |
1045
|
138
|
|
|
|
|
right_utf = TRUE; |
1046
|
|
|
|
|
|
} |
1047
|
1010946
|
100
|
|
|
|
else if (!left_utf && right_utf) { |
|
|
100
|
|
|
|
|
1048
|
136
|
|
|
|
|
left = newSVpvn_flags(lsave, leftlen, SVs_TEMP); |
1049
|
136
|
|
|
|
|
sv_utf8_upgrade(left); |
1050
|
136
|
50
|
|
|
|
lsave = lc = SvPV_nomg_const(left, leftlen); |
1051
|
|
|
|
|
|
left_utf = TRUE; |
1052
|
|
|
|
|
|
} |
1053
|
|
|
|
|
|
|
1054
|
1011084
|
|
|
|
|
len = leftlen < rightlen ? leftlen : rightlen; |
1055
|
|
|
|
|
|
lensave = len; |
1056
|
1011084
|
|
|
|
|
SvCUR_set(sv, len); |
1057
|
1011084
|
|
|
|
|
(void)SvPOK_only(sv); |
1058
|
1011084
|
100
|
|
|
|
if ((left_utf || right_utf) && (sv == left || sv == right)) { |
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
1059
|
72
|
100
|
|
|
|
needlen = optype == OP_BIT_AND ? len : leftlen + rightlen; |
1060
|
72
|
|
|
|
|
Newxz(dc, needlen + 1, char); |
1061
|
|
|
|
|
|
} |
1062
|
1011012
|
50
|
|
|
|
else if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) { |
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
1063
|
1011012
|
100
|
|
|
|
dc = SvPV_force_nomg_nolen(sv); |
1064
|
1011012
|
100
|
|
|
|
if (SvLEN(sv) < len + 1) { |
1065
|
590
|
50
|
|
|
|
dc = SvGROW(sv, len + 1); |
|
|
50
|
|
|
|
|
1066
|
590
|
|
|
|
|
(void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1); |
1067
|
|
|
|
|
|
} |
1068
|
1011012
|
100
|
|
|
|
if (optype != OP_BIT_AND && (left_utf || right_utf)) |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
1069
|
4506
|
50
|
|
|
|
dc = SvGROW(sv, leftlen + rightlen + 1); |
|
|
100
|
|
|
|
|
1070
|
|
|
|
|
|
} |
1071
|
|
|
|
|
|
else { |
1072
|
|
|
|
|
|
needlen = optype == OP_BIT_AND |
1073
|
0
|
0
|
|
|
|
? len : (leftlen > rightlen ? leftlen : rightlen); |
1074
|
0
|
|
|
|
|
Newxz(dc, needlen + 1, char); |
1075
|
0
|
|
|
|
|
sv_usepvn_flags(sv, dc, needlen, SV_HAS_TRAILING_NUL); |
1076
|
0
|
|
|
|
|
dc = SvPVX(sv); /* sv_usepvn() calls Renew() */ |
1077
|
|
|
|
|
|
} |
1078
|
1011084
|
100
|
|
|
|
if (left_utf || right_utf) { |
|
|
50
|
|
|
|
|
1079
|
|
|
|
|
|
UV duc, luc, ruc; |
1080
|
|
|
|
|
|
char *dcorig = dc; |
1081
|
|
|
|
|
|
char *dcsave = NULL; |
1082
|
9008
|
|
|
|
|
STRLEN lulen = leftlen; |
1083
|
9008
|
|
|
|
|
STRLEN rulen = rightlen; |
1084
|
|
|
|
|
|
STRLEN ulen; |
1085
|
|
|
|
|
|
|
1086
|
9008
|
|
|
|
|
switch (optype) { |
1087
|
|
|
|
|
|
case OP_BIT_AND: |
1088
|
10936
|
100
|
|
|
|
while (lulen && rulen) { |
1089
|
6482
|
|
|
|
|
luc = utf8n_to_uvchr((U8*)lc, lulen, &ulen, UTF8_ALLOW_ANYUV); |
1090
|
6482
|
|
|
|
|
lc += ulen; |
1091
|
6482
|
|
|
|
|
lulen -= ulen; |
1092
|
6482
|
|
|
|
|
ruc = utf8n_to_uvchr((U8*)rc, rulen, &ulen, UTF8_ALLOW_ANYUV); |
1093
|
6482
|
|
|
|
|
rc += ulen; |
1094
|
6482
|
|
|
|
|
rulen -= ulen; |
1095
|
6482
|
|
|
|
|
duc = luc & ruc; |
1096
|
6482
|
|
|
|
|
dc = (char*)uvchr_to_utf8((U8*)dc, duc); |
1097
|
|
|
|
|
|
} |
1098
|
4454
|
100
|
|
|
|
if (sv == left || sv == right) |
1099
|
24
|
|
|
|
|
(void)sv_usepvn(sv, dcorig, needlen); |
1100
|
4454
|
|
|
|
|
SvCUR_set(sv, dc - dcorig); |
1101
|
4454
|
|
|
|
|
break; |
1102
|
|
|
|
|
|
case OP_BIT_XOR: |
1103
|
2234
|
100
|
|
|
|
while (lulen && rulen) { |
1104
|
2132
|
|
|
|
|
luc = utf8n_to_uvchr((U8*)lc, lulen, &ulen, UTF8_ALLOW_ANYUV); |
1105
|
2132
|
|
|
|
|
lc += ulen; |
1106
|
2132
|
|
|
|
|
lulen -= ulen; |
1107
|
2132
|
|
|
|
|
ruc = utf8n_to_uvchr((U8*)rc, rulen, &ulen, UTF8_ALLOW_ANYUV); |
1108
|
2132
|
|
|
|
|
rc += ulen; |
1109
|
2132
|
|
|
|
|
rulen -= ulen; |
1110
|
2132
|
|
|
|
|
duc = luc ^ ruc; |
1111
|
2132
|
|
|
|
|
dc = (char*)uvchr_to_utf8((U8*)dc, duc); |
1112
|
|
|
|
|
|
} |
1113
|
|
|
|
|
|
goto mop_up_utf; |
1114
|
|
|
|
|
|
case OP_BIT_OR: |
1115
|
10934
|
100
|
|
|
|
while (lulen && rulen) { |
1116
|
6482
|
|
|
|
|
luc = utf8n_to_uvchr((U8*)lc, lulen, &ulen, UTF8_ALLOW_ANYUV); |
1117
|
6482
|
|
|
|
|
lc += ulen; |
1118
|
6482
|
|
|
|
|
lulen -= ulen; |
1119
|
6482
|
|
|
|
|
ruc = utf8n_to_uvchr((U8*)rc, rulen, &ulen, UTF8_ALLOW_ANYUV); |
1120
|
6482
|
|
|
|
|
rc += ulen; |
1121
|
6482
|
|
|
|
|
rulen -= ulen; |
1122
|
6482
|
|
|
|
|
duc = luc | ruc; |
1123
|
6482
|
|
|
|
|
dc = (char*)uvchr_to_utf8((U8*)dc, duc); |
1124
|
|
|
|
|
|
} |
1125
|
|
|
|
|
|
mop_up_utf: |
1126
|
4554
|
100
|
|
|
|
if (rulen) |
1127
|
82
|
|
|
|
|
dcsave = savepvn(rc, rulen); |
1128
|
4472
|
100
|
|
|
|
else if (lulen) |
1129
|
82
|
|
|
|
|
dcsave = savepvn(lc, lulen); |
1130
|
4554
|
100
|
|
|
|
if (sv == left || sv == right) |
1131
|
48
|
|
|
|
|
(void)sv_usepvn(sv, dcorig, needlen); /* uses Renew(); defaults to nomg */ |
1132
|
4554
|
|
|
|
|
SvCUR_set(sv, dc - dcorig); |
1133
|
4554
|
100
|
|
|
|
if (rulen) |
1134
|
82
|
|
|
|
|
sv_catpvn_nomg(sv, dcsave, rulen); |
1135
|
4472
|
100
|
|
|
|
else if (lulen) |
1136
|
82
|
|
|
|
|
sv_catpvn_nomg(sv, dcsave, lulen); |
1137
|
|
|
|
|
|
else |
1138
|
4390
|
|
|
|
|
*SvEND(sv) = '\0'; |
1139
|
4554
|
|
|
|
|
Safefree(dcsave); |
1140
|
4554
|
|
|
|
|
break; |
1141
|
|
|
|
|
|
default: |
1142
|
0
|
0
|
|
|
|
if (sv == left || sv == right) |
1143
|
0
|
|
|
|
|
Safefree(dcorig); |
1144
|
0
|
|
|
|
|
Perl_croak(aTHX_ "panic: do_vop called for op %u (%s)", |
1145
|
|
|
|
|
|
(unsigned)optype, PL_op_name[optype]); |
1146
|
|
|
|
|
|
} |
1147
|
9008
|
|
|
|
|
SvUTF8_on(sv); |
1148
|
9008
|
|
|
|
|
goto finish; |
1149
|
|
|
|
|
|
} |
1150
|
|
|
|
|
|
else |
1151
|
|
|
|
|
|
#ifdef LIBERAL |
1152
|
1002086
|
100
|
|
|
|
if (len >= sizeof(long)*4 && |
|
|
50
|
|
|
|
|
1153
|
30
|
50
|
|
|
|
!((unsigned long)dc % sizeof(long)) && |
1154
|
30
|
50
|
|
|
|
!((unsigned long)lc % sizeof(long)) && |
1155
|
20
|
|
|
|
|
!((unsigned long)rc % sizeof(long))) /* It's almost always aligned... */ |
1156
|
|
|
|
|
|
{ |
1157
|
20
|
|
|
|
|
const STRLEN remainder = len % (sizeof(long)*4); |
1158
|
20
|
|
|
|
|
len /= (sizeof(long)*4); |
1159
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
dl = (long*)dc; |
1161
|
|
|
|
|
|
ll = (long*)lc; |
1162
|
|
|
|
|
|
rl = (long*)rc; |
1163
|
|
|
|
|
|
|
1164
|
20
|
|
|
|
|
switch (optype) { |
1165
|
|
|
|
|
|
case OP_BIT_AND: |
1166
|
14
|
100
|
|
|
|
while (len--) { |
1167
|
8
|
|
|
|
|
*dl++ = *ll++ & *rl++; |
1168
|
8
|
|
|
|
|
*dl++ = *ll++ & *rl++; |
1169
|
8
|
|
|
|
|
*dl++ = *ll++ & *rl++; |
1170
|
8
|
|
|
|
|
*dl++ = *ll++ & *rl++; |
1171
|
|
|
|
|
|
} |
1172
|
|
|
|
|
|
break; |
1173
|
|
|
|
|
|
case OP_BIT_XOR: |
1174
|
10
|
100
|
|
|
|
while (len--) { |
1175
|
6
|
|
|
|
|
*dl++ = *ll++ ^ *rl++; |
1176
|
6
|
|
|
|
|
*dl++ = *ll++ ^ *rl++; |
1177
|
6
|
|
|
|
|
*dl++ = *ll++ ^ *rl++; |
1178
|
6
|
|
|
|
|
*dl++ = *ll++ ^ *rl++; |
1179
|
|
|
|
|
|
} |
1180
|
|
|
|
|
|
break; |
1181
|
|
|
|
|
|
case OP_BIT_OR: |
1182
|
27
|
100
|
|
|
|
while (len--) { |
1183
|
12
|
|
|
|
|
*dl++ = *ll++ | *rl++; |
1184
|
12
|
|
|
|
|
*dl++ = *ll++ | *rl++; |
1185
|
12
|
|
|
|
|
*dl++ = *ll++ | *rl++; |
1186
|
12
|
|
|
|
|
*dl++ = *ll++ | *rl++; |
1187
|
|
|
|
|
|
} |
1188
|
|
|
|
|
|
} |
1189
|
|
|
|
|
|
|
1190
|
|
|
|
|
|
dc = (char*)dl; |
1191
|
|
|
|
|
|
lc = (char*)ll; |
1192
|
|
|
|
|
|
rc = (char*)rl; |
1193
|
|
|
|
|
|
|
1194
|
|
|
|
|
|
len = remainder; |
1195
|
|
|
|
|
|
} |
1196
|
|
|
|
|
|
#endif |
1197
|
|
|
|
|
|
{ |
1198
|
1002076
|
|
|
|
|
switch (optype) { |
1199
|
|
|
|
|
|
case OP_BIT_AND: |
1200
|
5251968
|
100
|
|
|
|
while (len--) |
1201
|
4924486
|
|
|
|
|
*dc++ = *lc++ & *rc++; |
1202
|
327482
|
|
|
|
|
*dc = '\0'; |
1203
|
327482
|
|
|
|
|
break; |
1204
|
|
|
|
|
|
case OP_BIT_XOR: |
1205
|
542
|
100
|
|
|
|
while (len--) |
1206
|
322
|
|
|
|
|
*dc++ = *lc++ ^ *rc++; |
1207
|
|
|
|
|
|
goto mop_up; |
1208
|
|
|
|
|
|
case OP_BIT_OR: |
1209
|
8359486
|
100
|
|
|
|
while (len--) |
1210
|
7685112
|
|
|
|
|
*dc++ = *lc++ | *rc++; |
1211
|
|
|
|
|
|
mop_up: |
1212
|
|
|
|
|
|
len = lensave; |
1213
|
674594
|
100
|
|
|
|
if (rightlen > len) |
1214
|
17994
|
|
|
|
|
sv_catpvn_nomg(sv, rsave + len, rightlen - len); |
1215
|
656600
|
100
|
|
|
|
else if (leftlen > (STRLEN)len) |
1216
|
176186
|
|
|
|
|
sv_catpvn_nomg(sv, lsave + len, leftlen - len); |
1217
|
|
|
|
|
|
else |
1218
|
480414
|
|
|
|
|
*SvEND(sv) = '\0'; |
1219
|
|
|
|
|
|
break; |
1220
|
|
|
|
|
|
} |
1221
|
|
|
|
|
|
} |
1222
|
|
|
|
|
|
finish: |
1223
|
1011084
|
100
|
|
|
|
SvTAINT(sv); |
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
1224
|
1011084
|
|
|
|
|
} |
1225
|
|
|
|
|
|
|
1226
|
|
|
|
|
|
OP * |
1227
|
8220665
|
|
|
|
|
Perl_do_kv(pTHX) |
1228
|
7422145
|
100
|
|
|
|
{ |
1229
|
|
|
|
|
|
dVAR; |
1230
|
8220665
|
|
|
|
|
dSP; |
1231
|
8220665
|
|
|
|
|
HV * const keys = MUTABLE_HV(POPs); |
1232
|
|
|
|
|
|
HE *entry; |
1233
|
8220665
|
100
|
|
|
|
const I32 gimme = GIMME_V; |
1234
|
8220665
|
|
|
|
|
const I32 dokv = (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV); |
1235
|
|
|
|
|
|
/* op_type is OP_RKEYS/OP_RVALUES if pp_rkeys delegated to here */ |
1236
|
8220665
|
100
|
|
|
|
const I32 dokeys = dokv || (PL_op->op_type == OP_KEYS || PL_op->op_type == OP_RKEYS); |
|
|
100
|
|
|
|
|
1237
|
8220665
|
100
|
|
|
|
const I32 dovalues = dokv || (PL_op->op_type == OP_VALUES || PL_op->op_type == OP_RVALUES); |
|
|
100
|
|
|
|
|
1238
|
|
|
|
|
|
|
1239
|
8220665
|
|
|
|
|
(void)hv_iterinit(keys); /* always reset iterator regardless */ |
1240
|
|
|
|
|
|
|
1241
|
8220665
|
100
|
|
|
|
if (gimme == G_VOID) |
1242
|
1216
|
|
|
|
|
RETURN; |
1243
|
|
|
|
|
|
|
1244
|
8219449
|
100
|
|
|
|
if (gimme == G_SCALAR) { |
1245
|
797490
|
100
|
|
|
|
if (PL_op->op_flags & OPf_MOD || LVRET) { /* lvalue */ |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
1246
|
186
|
|
|
|
|
SV * const ret = sv_2mortal(newSV_type(SVt_PVLV)); /* Not TARG RT#67838 */ |
1247
|
186
|
|
|
|
|
sv_magic(ret, NULL, PERL_MAGIC_nkeys, NULL, 0); |
1248
|
186
|
|
|
|
|
LvTYPE(ret) = 'k'; |
1249
|
372
|
|
|
|
|
LvTARG(ret) = SvREFCNT_inc_simple(keys); |
1250
|
186
|
|
|
|
|
PUSHs(ret); |
1251
|
|
|
|
|
|
} |
1252
|
|
|
|
|
|
else { |
1253
|
|
|
|
|
|
IV i; |
1254
|
797118
|
|
|
|
|
dTARGET; |
1255
|
|
|
|
|
|
|
1256
|
797118
|
100
|
|
|
|
if (! SvTIED_mg((const SV *)keys, PERL_MAGIC_tied) ) { |
|
|
100
|
|
|
|
|
1257
|
797074
|
100
|
|
|
|
i = HvUSEDKEYS(keys); |
1258
|
|
|
|
|
|
} |
1259
|
|
|
|
|
|
else { |
1260
|
|
|
|
|
|
i = 0; |
1261
|
2614
|
100
|
|
|
|
while (hv_iternext(keys)) i++; |
1262
|
|
|
|
|
|
} |
1263
|
797118
|
50
|
|
|
|
PUSHi( i ); |
1264
|
|
|
|
|
|
} |
1265
|
797304
|
|
|
|
|
RETURN; |
1266
|
|
|
|
|
|
} |
1267
|
|
|
|
|
|
|
1268
|
7426923
|
100
|
|
|
|
EXTEND(SP, HvUSEDKEYS(keys) * (dokeys + dovalues)); |
|
|
50
|
|
|
|
|
1269
|
|
|
|
|
|
|
1270
|
7422145
|
|
|
|
|
PUTBACK; /* hv_iternext and hv_iterval might clobber stack_sp */ |
1271
|
69618558
|
100
|
|
|
|
while ((entry = hv_iternext(keys))) { |
1272
|
58505139
|
|
|
|
|
SPAGAIN; |
1273
|
58505139
|
100
|
|
|
|
if (dokeys) { |
1274
|
55195485
|
|
|
|
|
SV* const sv = hv_iterkeysv(entry); |
1275
|
55195485
|
100
|
|
|
|
XPUSHs(sv); /* won't clobber stack_sp */ |
1276
|
|
|
|
|
|
} |
1277
|
58505139
|
100
|
|
|
|
if (dovalues) { |
1278
|
|
|
|
|
|
SV *tmpstr; |
1279
|
7647272
|
|
|
|
|
PUTBACK; |
1280
|
7647272
|
|
|
|
|
tmpstr = hv_iterval(keys,entry); |
1281
|
|
|
|
|
|
DEBUG_H(Perl_sv_setpvf(aTHX_ tmpstr, "%lu%%%d=%lu", |
1282
|
|
|
|
|
|
(unsigned long)HeHASH(entry), |
1283
|
|
|
|
|
|
(int)HvMAX(keys)+1, |
1284
|
|
|
|
|
|
(unsigned long)(HeHASH(entry) & HvMAX(keys)))); |
1285
|
7647272
|
|
|
|
|
SPAGAIN; |
1286
|
7647272
|
100
|
|
|
|
XPUSHs(tmpstr); |
1287
|
|
|
|
|
|
} |
1288
|
58505139
|
|
|
|
|
PUTBACK; |
1289
|
|
|
|
|
|
} |
1290
|
7821403
|
|
|
|
|
return NORMAL; |
1291
|
|
|
|
|
|
} |
1292
|
|
|
|
|
|
|
1293
|
|
|
|
|
|
/* |
1294
|
|
|
|
|
|
* Local variables: |
1295
|
|
|
|
|
|
* c-indentation-style: bsd |
1296
|
|
|
|
|
|
* c-basic-offset: 4 |
1297
|
|
|
|
|
|
* indent-tabs-mode: nil |
1298
|
|
|
|
|
|
* End: |
1299
|
|
|
|
|
|
* |
1300
|
|
|
|
|
|
* ex: set ts=8 sts=4 sw=4 et: |
1301
|
|
|
|
|
|
*/ |