Commit | Line | Data |
---|---|---|
a0d0e21e | 1 | /* pp.c |
79072805 | 2 | * |
4eb8286e | 3 | * Copyright (c) 1991-1999, Larry Wall |
79072805 | 4 | * |
a0d0e21e LW |
5 | * You may distribute under the terms of either the GNU General Public |
6 | * License or the Artistic License, as specified in the README file. | |
79072805 | 7 | * |
a0d0e21e LW |
8 | */ |
9 | ||
10 | /* | |
11 | * "It's a big house this, and very peculiar. Always a bit more to discover, | |
12 | * and no knowing what you'll find around a corner. And Elves, sir!" --Samwise | |
13 | */ | |
79072805 LW |
14 | |
15 | #include "EXTERN.h" | |
864dbfa3 | 16 | #define PERL_IN_PP_C |
79072805 LW |
17 | #include "perl.h" |
18 | ||
36477c24 | 19 | /* |
ef2d312d TH |
20 | * The compiler on Concurrent CX/UX systems has a subtle bug which only |
21 | * seems to show up when compiling pp.c - it generates the wrong double | |
22 | * precision constant value for (double)UV_MAX when used inline in the body | |
23 | * of the code below, so this makes a static variable up front (which the | |
24 | * compiler seems to get correct) and uses it in place of UV_MAX below. | |
25 | */ | |
26 | #ifdef CXUX_BROKEN_CONSTANT_CONVERT | |
27 | static double UV_MAX_cxux = ((double)UV_MAX); | |
8ec5e241 | 28 | #endif |
ef2d312d TH |
29 | |
30 | /* | |
d0ba1bd2 JH |
31 | * Types used in bitwise operations. |
32 | * | |
33 | * Normally we'd just use IV and UV. However, some hardware and | |
34 | * software combinations (e.g. Alpha and current OSF/1) don't have a | |
35 | * floating-point type to use for NV that has adequate bits to fully | |
36 | * hold an IV/UV. (In other words, sizeof(long) == sizeof(double).) | |
37 | * | |
38 | * It just so happens that "int" is the right size almost everywhere. | |
39 | */ | |
40 | typedef int IBW; | |
41 | typedef unsigned UBW; | |
42 | ||
43 | /* | |
44 | * Mask used after bitwise operations. | |
45 | * | |
46 | * There is at least one realm (Cray word machines) that doesn't | |
47 | * have an integral type (except char) small enough to be represented | |
48 | * in a double without loss; that is, it has no 32-bit type. | |
49 | */ | |
c71a9cee | 50 | #if LONGSIZE > 4 && defined(_CRAY) |
d0ba1bd2 JH |
51 | # define BW_BITS 32 |
52 | # define BW_MASK ((1 << BW_BITS) - 1) | |
53 | # define BW_SIGN (1 << (BW_BITS - 1)) | |
54 | # define BWi(i) (((i) & BW_SIGN) ? ((i) | ~BW_MASK) : ((i) & BW_MASK)) | |
55 | # define BWu(u) ((u) & BW_MASK) | |
56 | #else | |
57 | # define BWi(i) (i) | |
58 | # define BWu(u) (u) | |
59 | #endif | |
60 | ||
61 | /* | |
96e4d5b1 | 62 | * Offset for integer pack/unpack. |
63 | * | |
64 | * On architectures where I16 and I32 aren't really 16 and 32 bits, | |
65 | * which for now are all Crays, pack and unpack have to play games. | |
66 | */ | |
67 | ||
68 | /* | |
69 | * These values are required for portability of pack() output. | |
70 | * If they're not right on your machine, then pack() and unpack() | |
71 | * wouldn't work right anyway; you'll need to apply the Cray hack. | |
72 | * (I'd like to check them with #if, but you can't use sizeof() in | |
dc45a647 MB |
73 | * the preprocessor.) --??? |
74 | */ | |
75 | /* | |
76 | The appropriate SHORTSIZE, INTSIZE, LONGSIZE, and LONGLONGSIZE | |
77 | defines are now in config.h. --Andy Dougherty April 1998 | |
96e4d5b1 | 78 | */ |
79 | #define SIZE16 2 | |
80 | #define SIZE32 4 | |
81 | ||
9851f69c JH |
82 | /* CROSSCOMPILE and MULTIARCH are going to affect pp_pack() and pp_unpack(). |
83 | --jhi Feb 1999 */ | |
84 | ||
726ea183 JH |
85 | #if SHORTSIZE != SIZE16 || LONGSIZE != SIZE32 |
86 | # define PERL_NATINT_PACK | |
87 | #endif | |
88 | ||
0f9dfb06 | 89 | #if LONGSIZE > 4 && defined(_CRAY) |
96e4d5b1 | 90 | # if BYTEORDER == 0x12345678 |
91 | # define OFF16(p) (char*)(p) | |
92 | # define OFF32(p) (char*)(p) | |
93 | # else | |
94 | # if BYTEORDER == 0x87654321 | |
95 | # define OFF16(p) ((char*)(p) + (sizeof(U16) - SIZE16)) | |
96 | # define OFF32(p) ((char*)(p) + (sizeof(U32) - SIZE32)) | |
97 | # else | |
98 | }}}} bad cray byte order | |
99 | # endif | |
100 | # endif | |
101 | # define COPY16(s,p) (*(p) = 0, Copy(s, OFF16(p), SIZE16, char)) | |
102 | # define COPY32(s,p) (*(p) = 0, Copy(s, OFF32(p), SIZE32, char)) | |
ef54e1a4 | 103 | # define COPYNN(s,p,n) (*(p) = 0, Copy(s, (char *)(p), n, char)) |
96e4d5b1 | 104 | # define CAT16(sv,p) sv_catpvn(sv, OFF16(p), SIZE16) |
105 | # define CAT32(sv,p) sv_catpvn(sv, OFF32(p), SIZE32) | |
106 | #else | |
107 | # define COPY16(s,p) Copy(s, p, SIZE16, char) | |
108 | # define COPY32(s,p) Copy(s, p, SIZE32, char) | |
ef54e1a4 | 109 | # define COPYNN(s,p,n) Copy(s, (char *)(p), n, char) |
96e4d5b1 | 110 | # define CAT16(sv,p) sv_catpvn(sv, (char*)(p), SIZE16) |
111 | # define CAT32(sv,p) sv_catpvn(sv, (char*)(p), SIZE32) | |
112 | #endif | |
113 | ||
a0d0e21e | 114 | /* variations on pp_null */ |
79072805 | 115 | |
8ac85365 NIS |
116 | #ifdef I_UNISTD |
117 | #include <unistd.h> | |
118 | #endif | |
dfe9444c AD |
119 | |
120 | /* XXX I can't imagine anyone who doesn't have this actually _needs_ | |
121 | it, since pid_t is an integral type. | |
122 | --AD 2/20/1998 | |
123 | */ | |
124 | #ifdef NEED_GETPID_PROTO | |
125 | extern Pid_t getpid (void); | |
8ac85365 NIS |
126 | #endif |
127 | ||
93a17b20 LW |
128 | PP(pp_stub) |
129 | { | |
4e35701f | 130 | djSP; |
54310121 | 131 | if (GIMME_V == G_SCALAR) |
3280af22 | 132 | XPUSHs(&PL_sv_undef); |
93a17b20 LW |
133 | RETURN; |
134 | } | |
135 | ||
79072805 LW |
136 | PP(pp_scalar) |
137 | { | |
138 | return NORMAL; | |
139 | } | |
140 | ||
141 | /* Pushy stuff. */ | |
142 | ||
93a17b20 LW |
143 | PP(pp_padav) |
144 | { | |
4e35701f | 145 | djSP; dTARGET; |
533c011a NIS |
146 | if (PL_op->op_private & OPpLVAL_INTRO) |
147 | SAVECLEARSV(PL_curpad[PL_op->op_targ]); | |
85e6fe83 | 148 | EXTEND(SP, 1); |
533c011a | 149 | if (PL_op->op_flags & OPf_REF) { |
85e6fe83 | 150 | PUSHs(TARG); |
93a17b20 | 151 | RETURN; |
85e6fe83 LW |
152 | } |
153 | if (GIMME == G_ARRAY) { | |
154 | I32 maxarg = AvFILL((AV*)TARG) + 1; | |
155 | EXTEND(SP, maxarg); | |
93965878 NIS |
156 | if (SvMAGICAL(TARG)) { |
157 | U32 i; | |
158 | for (i=0; i < maxarg; i++) { | |
159 | SV **svp = av_fetch((AV*)TARG, i, FALSE); | |
3280af22 | 160 | SP[i+1] = (svp) ? *svp : &PL_sv_undef; |
93965878 NIS |
161 | } |
162 | } | |
163 | else { | |
164 | Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*); | |
165 | } | |
85e6fe83 LW |
166 | SP += maxarg; |
167 | } | |
168 | else { | |
169 | SV* sv = sv_newmortal(); | |
170 | I32 maxarg = AvFILL((AV*)TARG) + 1; | |
171 | sv_setiv(sv, maxarg); | |
172 | PUSHs(sv); | |
173 | } | |
174 | RETURN; | |
93a17b20 LW |
175 | } |
176 | ||
177 | PP(pp_padhv) | |
178 | { | |
4e35701f | 179 | djSP; dTARGET; |
54310121 | 180 | I32 gimme; |
181 | ||
93a17b20 | 182 | XPUSHs(TARG); |
533c011a NIS |
183 | if (PL_op->op_private & OPpLVAL_INTRO) |
184 | SAVECLEARSV(PL_curpad[PL_op->op_targ]); | |
185 | if (PL_op->op_flags & OPf_REF) | |
93a17b20 | 186 | RETURN; |
54310121 | 187 | gimme = GIMME_V; |
188 | if (gimme == G_ARRAY) { | |
cea2e8a9 | 189 | RETURNOP(do_kv()); |
85e6fe83 | 190 | } |
54310121 | 191 | else if (gimme == G_SCALAR) { |
85e6fe83 | 192 | SV* sv = sv_newmortal(); |
46fc3d4c | 193 | if (HvFILL((HV*)TARG)) |
cea2e8a9 | 194 | Perl_sv_setpvf(aTHX_ sv, "%ld/%ld", |
46fc3d4c | 195 | (long)HvFILL((HV*)TARG), (long)HvMAX((HV*)TARG) + 1); |
85e6fe83 LW |
196 | else |
197 | sv_setiv(sv, 0); | |
198 | SETs(sv); | |
85e6fe83 | 199 | } |
54310121 | 200 | RETURN; |
93a17b20 LW |
201 | } |
202 | ||
ed6116ce LW |
203 | PP(pp_padany) |
204 | { | |
cea2e8a9 | 205 | DIE(aTHX_ "NOT IMPL LINE %d",__LINE__); |
ed6116ce LW |
206 | } |
207 | ||
79072805 LW |
208 | /* Translations. */ |
209 | ||
210 | PP(pp_rv2gv) | |
211 | { | |
853846ea | 212 | djSP; dTOPss; |
8ec5e241 | 213 | |
ed6116ce | 214 | if (SvROK(sv)) { |
a0d0e21e | 215 | wasref: |
f5284f61 IZ |
216 | tryAMAGICunDEREF(to_gv); |
217 | ||
ed6116ce | 218 | sv = SvRV(sv); |
b1dadf13 | 219 | if (SvTYPE(sv) == SVt_PVIO) { |
220 | GV *gv = (GV*) sv_newmortal(); | |
221 | gv_init(gv, 0, "", 0, 0); | |
222 | GvIOp(gv) = (IO *)sv; | |
3e3baf6d | 223 | (void)SvREFCNT_inc(sv); |
b1dadf13 | 224 | sv = (SV*) gv; |
ef54e1a4 JH |
225 | } |
226 | else if (SvTYPE(sv) != SVt_PVGV) | |
cea2e8a9 | 227 | DIE(aTHX_ "Not a GLOB reference"); |
79072805 LW |
228 | } |
229 | else { | |
93a17b20 | 230 | if (SvTYPE(sv) != SVt_PVGV) { |
748a9306 | 231 | char *sym; |
2d8e6c8d | 232 | STRLEN n_a; |
748a9306 | 233 | |
a0d0e21e LW |
234 | if (SvGMAGICAL(sv)) { |
235 | mg_get(sv); | |
236 | if (SvROK(sv)) | |
237 | goto wasref; | |
238 | } | |
239 | if (!SvOK(sv)) { | |
853846ea NIS |
240 | /* If this is a 'my' scalar and flag is set then vivify |
241 | * NI-S 1999/05/07 | |
242 | */ | |
1d8d4d2a | 243 | if (PL_op->op_private & OPpDEREF) { |
2c8ac474 GS |
244 | char *name; |
245 | GV *gv; | |
246 | if (cUNOP->op_targ) { | |
247 | STRLEN len; | |
248 | SV *namesv = PL_curpad[cUNOP->op_targ]; | |
249 | name = SvPV(namesv, len); | |
2d6d9f7a | 250 | gv = (GV*)NEWSV(0,0); |
2c8ac474 GS |
251 | gv_init(gv, CopSTASH(PL_curcop), name, len, 0); |
252 | } | |
253 | else { | |
254 | name = CopSTASHPV(PL_curcop); | |
255 | gv = newGVgen(name); | |
1d8d4d2a | 256 | } |
853846ea | 257 | sv_upgrade(sv, SVt_RV); |
2c8ac474 | 258 | SvRV(sv) = (SV*)gv; |
853846ea | 259 | SvROK_on(sv); |
1d8d4d2a | 260 | SvSETMAGIC(sv); |
853846ea | 261 | goto wasref; |
2c8ac474 | 262 | } |
533c011a NIS |
263 | if (PL_op->op_flags & OPf_REF || |
264 | PL_op->op_private & HINT_STRICT_REFS) | |
cea2e8a9 | 265 | DIE(aTHX_ PL_no_usym, "a symbol"); |
599cee73 | 266 | if (ckWARN(WARN_UNINITIALIZED)) |
b89fed5f | 267 | report_uninit(); |
a0d0e21e LW |
268 | RETSETUNDEF; |
269 | } | |
2d8e6c8d | 270 | sym = SvPV(sv, n_a); |
35cd451c GS |
271 | if ((PL_op->op_flags & OPf_SPECIAL) && |
272 | !(PL_op->op_flags & OPf_MOD)) | |
273 | { | |
274 | sv = (SV*)gv_fetchpv(sym, FALSE, SVt_PVGV); | |
275 | if (!sv) | |
276 | RETSETUNDEF; | |
277 | } | |
278 | else { | |
279 | if (PL_op->op_private & HINT_STRICT_REFS) | |
cea2e8a9 | 280 | DIE(aTHX_ PL_no_symref, sym, "a symbol"); |
35cd451c GS |
281 | sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV); |
282 | } | |
93a17b20 | 283 | } |
79072805 | 284 | } |
533c011a NIS |
285 | if (PL_op->op_private & OPpLVAL_INTRO) |
286 | save_gp((GV*)sv, !(PL_op->op_flags & OPf_SPECIAL)); | |
79072805 LW |
287 | SETs(sv); |
288 | RETURN; | |
289 | } | |
290 | ||
79072805 LW |
291 | PP(pp_rv2sv) |
292 | { | |
4e35701f | 293 | djSP; dTOPss; |
79072805 | 294 | |
ed6116ce | 295 | if (SvROK(sv)) { |
a0d0e21e | 296 | wasref: |
f5284f61 IZ |
297 | tryAMAGICunDEREF(to_sv); |
298 | ||
ed6116ce | 299 | sv = SvRV(sv); |
79072805 LW |
300 | switch (SvTYPE(sv)) { |
301 | case SVt_PVAV: | |
302 | case SVt_PVHV: | |
303 | case SVt_PVCV: | |
cea2e8a9 | 304 | DIE(aTHX_ "Not a SCALAR reference"); |
79072805 LW |
305 | } |
306 | } | |
307 | else { | |
f12c7020 | 308 | GV *gv = (GV*)sv; |
748a9306 | 309 | char *sym; |
2d8e6c8d | 310 | STRLEN n_a; |
748a9306 | 311 | |
463ee0b2 | 312 | if (SvTYPE(gv) != SVt_PVGV) { |
a0d0e21e LW |
313 | if (SvGMAGICAL(sv)) { |
314 | mg_get(sv); | |
315 | if (SvROK(sv)) | |
316 | goto wasref; | |
317 | } | |
318 | if (!SvOK(sv)) { | |
533c011a NIS |
319 | if (PL_op->op_flags & OPf_REF || |
320 | PL_op->op_private & HINT_STRICT_REFS) | |
cea2e8a9 | 321 | DIE(aTHX_ PL_no_usym, "a SCALAR"); |
599cee73 | 322 | if (ckWARN(WARN_UNINITIALIZED)) |
b89fed5f | 323 | report_uninit(); |
a0d0e21e LW |
324 | RETSETUNDEF; |
325 | } | |
2d8e6c8d | 326 | sym = SvPV(sv, n_a); |
35cd451c GS |
327 | if ((PL_op->op_flags & OPf_SPECIAL) && |
328 | !(PL_op->op_flags & OPf_MOD)) | |
329 | { | |
330 | gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PV); | |
331 | if (!gv) | |
332 | RETSETUNDEF; | |
333 | } | |
334 | else { | |
335 | if (PL_op->op_private & HINT_STRICT_REFS) | |
cea2e8a9 | 336 | DIE(aTHX_ PL_no_symref, sym, "a SCALAR"); |
35cd451c GS |
337 | gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV); |
338 | } | |
463ee0b2 LW |
339 | } |
340 | sv = GvSV(gv); | |
a0d0e21e | 341 | } |
533c011a NIS |
342 | if (PL_op->op_flags & OPf_MOD) { |
343 | if (PL_op->op_private & OPpLVAL_INTRO) | |
a0d0e21e | 344 | sv = save_scalar((GV*)TOPs); |
533c011a NIS |
345 | else if (PL_op->op_private & OPpDEREF) |
346 | vivify_ref(sv, PL_op->op_private & OPpDEREF); | |
79072805 | 347 | } |
a0d0e21e | 348 | SETs(sv); |
79072805 LW |
349 | RETURN; |
350 | } | |
351 | ||
352 | PP(pp_av2arylen) | |
353 | { | |
4e35701f | 354 | djSP; |
79072805 LW |
355 | AV *av = (AV*)TOPs; |
356 | SV *sv = AvARYLEN(av); | |
357 | if (!sv) { | |
358 | AvARYLEN(av) = sv = NEWSV(0,0); | |
359 | sv_upgrade(sv, SVt_IV); | |
360 | sv_magic(sv, (SV*)av, '#', Nullch, 0); | |
361 | } | |
362 | SETs(sv); | |
363 | RETURN; | |
364 | } | |
365 | ||
a0d0e21e LW |
366 | PP(pp_pos) |
367 | { | |
4e35701f | 368 | djSP; dTARGET; dPOPss; |
8ec5e241 | 369 | |
533c011a | 370 | if (PL_op->op_flags & OPf_MOD) { |
5f05dabc | 371 | if (SvTYPE(TARG) < SVt_PVLV) { |
372 | sv_upgrade(TARG, SVt_PVLV); | |
373 | sv_magic(TARG, Nullsv, '.', Nullch, 0); | |
374 | } | |
375 | ||
376 | LvTYPE(TARG) = '.'; | |
6ff81951 GS |
377 | if (LvTARG(TARG) != sv) { |
378 | if (LvTARG(TARG)) | |
379 | SvREFCNT_dec(LvTARG(TARG)); | |
380 | LvTARG(TARG) = SvREFCNT_inc(sv); | |
381 | } | |
a0d0e21e LW |
382 | PUSHs(TARG); /* no SvSETMAGIC */ |
383 | RETURN; | |
384 | } | |
385 | else { | |
8ec5e241 | 386 | MAGIC* mg; |
a0d0e21e LW |
387 | |
388 | if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { | |
389 | mg = mg_find(sv, 'g'); | |
565764a8 | 390 | if (mg && mg->mg_len >= 0) { |
a0ed51b3 LW |
391 | I32 i = mg->mg_len; |
392 | if (IN_UTF8) | |
393 | sv_pos_b2u(sv, &i); | |
394 | PUSHi(i + PL_curcop->cop_arybase); | |
a0d0e21e LW |
395 | RETURN; |
396 | } | |
397 | } | |
398 | RETPUSHUNDEF; | |
399 | } | |
400 | } | |
401 | ||
79072805 LW |
402 | PP(pp_rv2cv) |
403 | { | |
4e35701f | 404 | djSP; |
79072805 LW |
405 | GV *gv; |
406 | HV *stash; | |
8990e307 | 407 | |
4633a7c4 LW |
408 | /* We usually try to add a non-existent subroutine in case of AUTOLOAD. */ |
409 | /* (But not in defined().) */ | |
533c011a | 410 | CV *cv = sv_2cv(TOPs, &stash, &gv, !(PL_op->op_flags & OPf_SPECIAL)); |
07055b4c CS |
411 | if (cv) { |
412 | if (CvCLONE(cv)) | |
413 | cv = (CV*)sv_2mortal((SV*)cv_clone(cv)); | |
cd06dffe | 414 | if ((PL_op->op_private & OPpLVAL_INTRO) && !CvLVALUE(cv)) |
d470f89e | 415 | DIE(aTHX_ "Can't modify non-lvalue subroutine call"); |
07055b4c CS |
416 | } |
417 | else | |
3280af22 | 418 | cv = (CV*)&PL_sv_undef; |
79072805 LW |
419 | SETs((SV*)cv); |
420 | RETURN; | |
421 | } | |
422 | ||
c07a80fd | 423 | PP(pp_prototype) |
424 | { | |
4e35701f | 425 | djSP; |
c07a80fd | 426 | CV *cv; |
427 | HV *stash; | |
428 | GV *gv; | |
429 | SV *ret; | |
430 | ||
3280af22 | 431 | ret = &PL_sv_undef; |
b6c543e3 IZ |
432 | if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) { |
433 | char *s = SvPVX(TOPs); | |
434 | if (strnEQ(s, "CORE::", 6)) { | |
435 | int code; | |
436 | ||
437 | code = keyword(s + 6, SvCUR(TOPs) - 6); | |
438 | if (code < 0) { /* Overridable. */ | |
439 | #define MAX_ARGS_OP ((sizeof(I32) - 1) * 2) | |
440 | int i = 0, n = 0, seen_question = 0; | |
441 | I32 oa; | |
442 | char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */ | |
443 | ||
444 | while (i < MAXO) { /* The slow way. */ | |
22c35a8c GS |
445 | if (strEQ(s + 6, PL_op_name[i]) |
446 | || strEQ(s + 6, PL_op_desc[i])) | |
447 | { | |
b6c543e3 | 448 | goto found; |
22c35a8c | 449 | } |
b6c543e3 IZ |
450 | i++; |
451 | } | |
452 | goto nonesuch; /* Should not happen... */ | |
453 | found: | |
22c35a8c | 454 | oa = PL_opargs[i] >> OASHIFT; |
b6c543e3 IZ |
455 | while (oa) { |
456 | if (oa & OA_OPTIONAL) { | |
457 | seen_question = 1; | |
458 | str[n++] = ';'; | |
ef54e1a4 JH |
459 | } |
460 | else if (seen_question) | |
b6c543e3 IZ |
461 | goto set; /* XXXX system, exec */ |
462 | if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF | |
463 | && (oa & (OA_OPTIONAL - 1)) <= OA_HVREF) { | |
464 | str[n++] = '\\'; | |
465 | } | |
466 | /* What to do with R ((un)tie, tied, (sys)read, recv)? */ | |
467 | str[n++] = ("?$@@%&*$")[oa & (OA_OPTIONAL - 1)]; | |
468 | oa = oa >> 4; | |
469 | } | |
470 | str[n++] = '\0'; | |
79cb57f6 | 471 | ret = sv_2mortal(newSVpvn(str, n - 1)); |
ef54e1a4 JH |
472 | } |
473 | else if (code) /* Non-Overridable */ | |
b6c543e3 IZ |
474 | goto set; |
475 | else { /* None such */ | |
476 | nonesuch: | |
d470f89e | 477 | DIE(aTHX_ "Can't find an opnumber for \"%s\"", s+6); |
b6c543e3 IZ |
478 | } |
479 | } | |
480 | } | |
c07a80fd | 481 | cv = sv_2cv(TOPs, &stash, &gv, FALSE); |
5f05dabc | 482 | if (cv && SvPOK(cv)) |
79cb57f6 | 483 | ret = sv_2mortal(newSVpvn(SvPVX(cv), SvCUR(cv))); |
b6c543e3 | 484 | set: |
c07a80fd | 485 | SETs(ret); |
486 | RETURN; | |
487 | } | |
488 | ||
a0d0e21e LW |
489 | PP(pp_anoncode) |
490 | { | |
4e35701f | 491 | djSP; |
533c011a | 492 | CV* cv = (CV*)PL_curpad[PL_op->op_targ]; |
a5f75d66 | 493 | if (CvCLONE(cv)) |
b355b4e0 | 494 | cv = (CV*)sv_2mortal((SV*)cv_clone(cv)); |
5f05dabc | 495 | EXTEND(SP,1); |
748a9306 | 496 | PUSHs((SV*)cv); |
a0d0e21e LW |
497 | RETURN; |
498 | } | |
499 | ||
500 | PP(pp_srefgen) | |
79072805 | 501 | { |
4e35701f | 502 | djSP; |
71be2cbc | 503 | *SP = refto(*SP); |
79072805 | 504 | RETURN; |
8ec5e241 | 505 | } |
a0d0e21e LW |
506 | |
507 | PP(pp_refgen) | |
508 | { | |
4e35701f | 509 | djSP; dMARK; |
a0d0e21e | 510 | if (GIMME != G_ARRAY) { |
5f0b1d4e GS |
511 | if (++MARK <= SP) |
512 | *MARK = *SP; | |
513 | else | |
3280af22 | 514 | *MARK = &PL_sv_undef; |
5f0b1d4e GS |
515 | *MARK = refto(*MARK); |
516 | SP = MARK; | |
517 | RETURN; | |
a0d0e21e | 518 | } |
bbce6d69 | 519 | EXTEND_MORTAL(SP - MARK); |
71be2cbc | 520 | while (++MARK <= SP) |
521 | *MARK = refto(*MARK); | |
a0d0e21e | 522 | RETURN; |
79072805 LW |
523 | } |
524 | ||
76e3520e | 525 | STATIC SV* |
cea2e8a9 | 526 | S_refto(pTHX_ SV *sv) |
71be2cbc | 527 | { |
528 | SV* rv; | |
529 | ||
530 | if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y') { | |
531 | if (LvTARGLEN(sv)) | |
68dc0745 | 532 | vivify_defelem(sv); |
533 | if (!(sv = LvTARG(sv))) | |
3280af22 | 534 | sv = &PL_sv_undef; |
0dd88869 | 535 | else |
a6c40364 | 536 | (void)SvREFCNT_inc(sv); |
71be2cbc | 537 | } |
d8b46c1b GS |
538 | else if (SvTYPE(sv) == SVt_PVAV) { |
539 | if (!AvREAL((AV*)sv) && AvREIFY((AV*)sv)) | |
540 | av_reify((AV*)sv); | |
541 | SvTEMP_off(sv); | |
542 | (void)SvREFCNT_inc(sv); | |
543 | } | |
71be2cbc | 544 | else if (SvPADTMP(sv)) |
545 | sv = newSVsv(sv); | |
546 | else { | |
547 | SvTEMP_off(sv); | |
548 | (void)SvREFCNT_inc(sv); | |
549 | } | |
550 | rv = sv_newmortal(); | |
551 | sv_upgrade(rv, SVt_RV); | |
552 | SvRV(rv) = sv; | |
553 | SvROK_on(rv); | |
554 | return rv; | |
555 | } | |
556 | ||
79072805 LW |
557 | PP(pp_ref) |
558 | { | |
4e35701f | 559 | djSP; dTARGET; |
463ee0b2 | 560 | SV *sv; |
79072805 LW |
561 | char *pv; |
562 | ||
a0d0e21e | 563 | sv = POPs; |
f12c7020 | 564 | |
565 | if (sv && SvGMAGICAL(sv)) | |
8ec5e241 | 566 | mg_get(sv); |
f12c7020 | 567 | |
a0d0e21e | 568 | if (!sv || !SvROK(sv)) |
4633a7c4 | 569 | RETPUSHNO; |
79072805 | 570 | |
ed6116ce | 571 | sv = SvRV(sv); |
a0d0e21e | 572 | pv = sv_reftype(sv,TRUE); |
463ee0b2 | 573 | PUSHp(pv, strlen(pv)); |
79072805 LW |
574 | RETURN; |
575 | } | |
576 | ||
577 | PP(pp_bless) | |
578 | { | |
4e35701f | 579 | djSP; |
463ee0b2 | 580 | HV *stash; |
79072805 | 581 | |
463ee0b2 | 582 | if (MAXARG == 1) |
11faa288 | 583 | stash = CopSTASH(PL_curcop); |
7b8d334a GS |
584 | else { |
585 | SV *ssv = POPs; | |
586 | STRLEN len; | |
587 | char *ptr = SvPV(ssv,len); | |
599cee73 | 588 | if (ckWARN(WARN_UNSAFE) && len == 0) |
cea2e8a9 | 589 | Perl_warner(aTHX_ WARN_UNSAFE, |
599cee73 | 590 | "Explicit blessing to '' (assuming package main)"); |
7b8d334a GS |
591 | stash = gv_stashpvn(ptr, len, TRUE); |
592 | } | |
a0d0e21e | 593 | |
5d3fdfeb | 594 | (void)sv_bless(TOPs, stash); |
79072805 LW |
595 | RETURN; |
596 | } | |
597 | ||
fb73857a | 598 | PP(pp_gelem) |
599 | { | |
600 | GV *gv; | |
601 | SV *sv; | |
76e3520e | 602 | SV *tmpRef; |
fb73857a | 603 | char *elem; |
4e35701f | 604 | djSP; |
2d8e6c8d GS |
605 | STRLEN n_a; |
606 | ||
fb73857a | 607 | sv = POPs; |
2d8e6c8d | 608 | elem = SvPV(sv, n_a); |
fb73857a | 609 | gv = (GV*)POPs; |
76e3520e | 610 | tmpRef = Nullsv; |
fb73857a | 611 | sv = Nullsv; |
612 | switch (elem ? *elem : '\0') | |
613 | { | |
614 | case 'A': | |
615 | if (strEQ(elem, "ARRAY")) | |
76e3520e | 616 | tmpRef = (SV*)GvAV(gv); |
fb73857a | 617 | break; |
618 | case 'C': | |
619 | if (strEQ(elem, "CODE")) | |
76e3520e | 620 | tmpRef = (SV*)GvCVu(gv); |
fb73857a | 621 | break; |
622 | case 'F': | |
623 | if (strEQ(elem, "FILEHANDLE")) /* XXX deprecate in 5.005 */ | |
76e3520e | 624 | tmpRef = (SV*)GvIOp(gv); |
fb73857a | 625 | break; |
626 | case 'G': | |
627 | if (strEQ(elem, "GLOB")) | |
76e3520e | 628 | tmpRef = (SV*)gv; |
fb73857a | 629 | break; |
630 | case 'H': | |
631 | if (strEQ(elem, "HASH")) | |
76e3520e | 632 | tmpRef = (SV*)GvHV(gv); |
fb73857a | 633 | break; |
634 | case 'I': | |
635 | if (strEQ(elem, "IO")) | |
76e3520e | 636 | tmpRef = (SV*)GvIOp(gv); |
fb73857a | 637 | break; |
638 | case 'N': | |
639 | if (strEQ(elem, "NAME")) | |
79cb57f6 | 640 | sv = newSVpvn(GvNAME(gv), GvNAMELEN(gv)); |
fb73857a | 641 | break; |
642 | case 'P': | |
643 | if (strEQ(elem, "PACKAGE")) | |
644 | sv = newSVpv(HvNAME(GvSTASH(gv)), 0); | |
645 | break; | |
646 | case 'S': | |
647 | if (strEQ(elem, "SCALAR")) | |
76e3520e | 648 | tmpRef = GvSV(gv); |
fb73857a | 649 | break; |
650 | } | |
76e3520e GS |
651 | if (tmpRef) |
652 | sv = newRV(tmpRef); | |
fb73857a | 653 | if (sv) |
654 | sv_2mortal(sv); | |
655 | else | |
3280af22 | 656 | sv = &PL_sv_undef; |
fb73857a | 657 | XPUSHs(sv); |
658 | RETURN; | |
659 | } | |
660 | ||
a0d0e21e | 661 | /* Pattern matching */ |
79072805 | 662 | |
a0d0e21e | 663 | PP(pp_study) |
79072805 | 664 | { |
4e35701f | 665 | djSP; dPOPss; |
a0d0e21e LW |
666 | register unsigned char *s; |
667 | register I32 pos; | |
668 | register I32 ch; | |
669 | register I32 *sfirst; | |
670 | register I32 *snext; | |
a0d0e21e LW |
671 | STRLEN len; |
672 | ||
3280af22 | 673 | if (sv == PL_lastscream) { |
1e422769 | 674 | if (SvSCREAM(sv)) |
675 | RETPUSHYES; | |
676 | } | |
c07a80fd | 677 | else { |
3280af22 NIS |
678 | if (PL_lastscream) { |
679 | SvSCREAM_off(PL_lastscream); | |
680 | SvREFCNT_dec(PL_lastscream); | |
c07a80fd | 681 | } |
3280af22 | 682 | PL_lastscream = SvREFCNT_inc(sv); |
c07a80fd | 683 | } |
1e422769 | 684 | |
685 | s = (unsigned char*)(SvPV(sv, len)); | |
686 | pos = len; | |
687 | if (pos <= 0) | |
688 | RETPUSHNO; | |
3280af22 NIS |
689 | if (pos > PL_maxscream) { |
690 | if (PL_maxscream < 0) { | |
691 | PL_maxscream = pos + 80; | |
692 | New(301, PL_screamfirst, 256, I32); | |
693 | New(302, PL_screamnext, PL_maxscream, I32); | |
79072805 LW |
694 | } |
695 | else { | |
3280af22 NIS |
696 | PL_maxscream = pos + pos / 4; |
697 | Renew(PL_screamnext, PL_maxscream, I32); | |
79072805 | 698 | } |
79072805 | 699 | } |
a0d0e21e | 700 | |
3280af22 NIS |
701 | sfirst = PL_screamfirst; |
702 | snext = PL_screamnext; | |
a0d0e21e LW |
703 | |
704 | if (!sfirst || !snext) | |
cea2e8a9 | 705 | DIE(aTHX_ "do_study: out of memory"); |
a0d0e21e LW |
706 | |
707 | for (ch = 256; ch; --ch) | |
708 | *sfirst++ = -1; | |
709 | sfirst -= 256; | |
710 | ||
711 | while (--pos >= 0) { | |
712 | ch = s[pos]; | |
713 | if (sfirst[ch] >= 0) | |
714 | snext[pos] = sfirst[ch] - pos; | |
715 | else | |
716 | snext[pos] = -pos; | |
717 | sfirst[ch] = pos; | |
79072805 LW |
718 | } |
719 | ||
c07a80fd | 720 | SvSCREAM_on(sv); |
464e2e8a | 721 | sv_magic(sv, Nullsv, 'g', Nullch, 0); /* piggyback on m//g magic */ |
1e422769 | 722 | RETPUSHYES; |
79072805 LW |
723 | } |
724 | ||
a0d0e21e | 725 | PP(pp_trans) |
79072805 | 726 | { |
4e35701f | 727 | djSP; dTARG; |
a0d0e21e LW |
728 | SV *sv; |
729 | ||
533c011a | 730 | if (PL_op->op_flags & OPf_STACKED) |
a0d0e21e | 731 | sv = POPs; |
79072805 | 732 | else { |
54b9620d | 733 | sv = DEFSV; |
a0d0e21e | 734 | EXTEND(SP,1); |
79072805 | 735 | } |
adbc6bb1 | 736 | TARG = sv_newmortal(); |
4757a243 | 737 | PUSHi(do_trans(sv)); |
a0d0e21e | 738 | RETURN; |
79072805 LW |
739 | } |
740 | ||
a0d0e21e | 741 | /* Lvalue operators. */ |
79072805 | 742 | |
a0d0e21e LW |
743 | PP(pp_schop) |
744 | { | |
4e35701f | 745 | djSP; dTARGET; |
a0d0e21e LW |
746 | do_chop(TARG, TOPs); |
747 | SETTARG; | |
748 | RETURN; | |
79072805 LW |
749 | } |
750 | ||
a0d0e21e | 751 | PP(pp_chop) |
79072805 | 752 | { |
4e35701f | 753 | djSP; dMARK; dTARGET; |
a0d0e21e LW |
754 | while (SP > MARK) |
755 | do_chop(TARG, POPs); | |
756 | PUSHTARG; | |
757 | RETURN; | |
79072805 LW |
758 | } |
759 | ||
a0d0e21e | 760 | PP(pp_schomp) |
79072805 | 761 | { |
4e35701f | 762 | djSP; dTARGET; |
a0d0e21e LW |
763 | SETi(do_chomp(TOPs)); |
764 | RETURN; | |
79072805 LW |
765 | } |
766 | ||
a0d0e21e | 767 | PP(pp_chomp) |
79072805 | 768 | { |
4e35701f | 769 | djSP; dMARK; dTARGET; |
a0d0e21e | 770 | register I32 count = 0; |
8ec5e241 | 771 | |
a0d0e21e LW |
772 | while (SP > MARK) |
773 | count += do_chomp(POPs); | |
774 | PUSHi(count); | |
775 | RETURN; | |
79072805 LW |
776 | } |
777 | ||
a0d0e21e | 778 | PP(pp_defined) |
463ee0b2 | 779 | { |
4e35701f | 780 | djSP; |
a0d0e21e LW |
781 | register SV* sv; |
782 | ||
783 | sv = POPs; | |
784 | if (!sv || !SvANY(sv)) | |
785 | RETPUSHNO; | |
786 | switch (SvTYPE(sv)) { | |
787 | case SVt_PVAV: | |
6051dbdb | 788 | if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P'))) |
a0d0e21e LW |
789 | RETPUSHYES; |
790 | break; | |
791 | case SVt_PVHV: | |
6051dbdb | 792 | if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P'))) |
a0d0e21e LW |
793 | RETPUSHYES; |
794 | break; | |
795 | case SVt_PVCV: | |
796 | if (CvROOT(sv) || CvXSUB(sv)) | |
797 | RETPUSHYES; | |
798 | break; | |
799 | default: | |
800 | if (SvGMAGICAL(sv)) | |
801 | mg_get(sv); | |
802 | if (SvOK(sv)) | |
803 | RETPUSHYES; | |
804 | } | |
805 | RETPUSHNO; | |
463ee0b2 LW |
806 | } |
807 | ||
a0d0e21e LW |
808 | PP(pp_undef) |
809 | { | |
4e35701f | 810 | djSP; |
a0d0e21e LW |
811 | SV *sv; |
812 | ||
533c011a | 813 | if (!PL_op->op_private) { |
774d564b | 814 | EXTEND(SP, 1); |
a0d0e21e | 815 | RETPUSHUNDEF; |
774d564b | 816 | } |
79072805 | 817 | |
a0d0e21e LW |
818 | sv = POPs; |
819 | if (!sv) | |
820 | RETPUSHUNDEF; | |
85e6fe83 | 821 | |
6fc92669 GS |
822 | if (SvTHINKFIRST(sv)) |
823 | sv_force_normal(sv); | |
85e6fe83 | 824 | |
a0d0e21e LW |
825 | switch (SvTYPE(sv)) { |
826 | case SVt_NULL: | |
827 | break; | |
828 | case SVt_PVAV: | |
829 | av_undef((AV*)sv); | |
830 | break; | |
831 | case SVt_PVHV: | |
832 | hv_undef((HV*)sv); | |
833 | break; | |
834 | case SVt_PVCV: | |
599cee73 | 835 | if (ckWARN(WARN_UNSAFE) && cv_const_sv((CV*)sv)) |
cea2e8a9 | 836 | Perl_warner(aTHX_ WARN_UNSAFE, "Constant subroutine %s undefined", |
54310121 | 837 | CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv))); |
9607fc9c | 838 | /* FALL THROUGH */ |
839 | case SVt_PVFM: | |
6fc92669 GS |
840 | { |
841 | /* let user-undef'd sub keep its identity */ | |
842 | GV* gv = (GV*)SvREFCNT_inc(CvGV((CV*)sv)); | |
843 | cv_undef((CV*)sv); | |
844 | CvGV((CV*)sv) = gv; | |
845 | } | |
a0d0e21e | 846 | break; |
8e07c86e | 847 | case SVt_PVGV: |
44a8e56a | 848 | if (SvFAKE(sv)) |
3280af22 | 849 | SvSetMagicSV(sv, &PL_sv_undef); |
20408e3c GS |
850 | else { |
851 | GP *gp; | |
852 | gp_free((GV*)sv); | |
853 | Newz(602, gp, 1, GP); | |
854 | GvGP(sv) = gp_ref(gp); | |
855 | GvSV(sv) = NEWSV(72,0); | |
57843af0 | 856 | GvLINE(sv) = CopLINE(PL_curcop); |
20408e3c GS |
857 | GvEGV(sv) = (GV*)sv; |
858 | GvMULTI_on(sv); | |
859 | } | |
44a8e56a | 860 | break; |
a0d0e21e | 861 | default: |
1e422769 | 862 | if (SvTYPE(sv) >= SVt_PV && SvPVX(sv) && SvLEN(sv)) { |
4633a7c4 LW |
863 | (void)SvOOK_off(sv); |
864 | Safefree(SvPVX(sv)); | |
865 | SvPV_set(sv, Nullch); | |
866 | SvLEN_set(sv, 0); | |
a0d0e21e | 867 | } |
4633a7c4 LW |
868 | (void)SvOK_off(sv); |
869 | SvSETMAGIC(sv); | |
79072805 | 870 | } |
a0d0e21e LW |
871 | |
872 | RETPUSHUNDEF; | |
79072805 LW |
873 | } |
874 | ||
a0d0e21e | 875 | PP(pp_predec) |
79072805 | 876 | { |
4e35701f | 877 | djSP; |
68dc0745 | 878 | if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) |
d470f89e | 879 | DIE(aTHX_ PL_no_modify); |
25da4f38 | 880 | if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && |
55497cff | 881 | SvIVX(TOPs) != IV_MIN) |
882 | { | |
748a9306 | 883 | --SvIVX(TOPs); |
55497cff | 884 | SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK); |
748a9306 LW |
885 | } |
886 | else | |
887 | sv_dec(TOPs); | |
a0d0e21e LW |
888 | SvSETMAGIC(TOPs); |
889 | return NORMAL; | |
890 | } | |
79072805 | 891 | |
a0d0e21e LW |
892 | PP(pp_postinc) |
893 | { | |
4e35701f | 894 | djSP; dTARGET; |
68dc0745 | 895 | if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) |
d470f89e | 896 | DIE(aTHX_ PL_no_modify); |
a0d0e21e | 897 | sv_setsv(TARG, TOPs); |
25da4f38 | 898 | if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && |
55497cff | 899 | SvIVX(TOPs) != IV_MAX) |
900 | { | |
748a9306 | 901 | ++SvIVX(TOPs); |
55497cff | 902 | SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK); |
748a9306 LW |
903 | } |
904 | else | |
905 | sv_inc(TOPs); | |
a0d0e21e LW |
906 | SvSETMAGIC(TOPs); |
907 | if (!SvOK(TARG)) | |
908 | sv_setiv(TARG, 0); | |
909 | SETs(TARG); | |
910 | return NORMAL; | |
911 | } | |
79072805 | 912 | |
a0d0e21e LW |
913 | PP(pp_postdec) |
914 | { | |
4e35701f | 915 | djSP; dTARGET; |
43192e07 | 916 | if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) |
d470f89e | 917 | DIE(aTHX_ PL_no_modify); |
a0d0e21e | 918 | sv_setsv(TARG, TOPs); |
25da4f38 | 919 | if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && |
55497cff | 920 | SvIVX(TOPs) != IV_MIN) |
921 | { | |
748a9306 | 922 | --SvIVX(TOPs); |
55497cff | 923 | SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK); |
748a9306 LW |
924 | } |
925 | else | |
926 | sv_dec(TOPs); | |
a0d0e21e LW |
927 | SvSETMAGIC(TOPs); |
928 | SETs(TARG); | |
929 | return NORMAL; | |
930 | } | |
79072805 | 931 | |
a0d0e21e LW |
932 | /* Ordinary operators. */ |
933 | ||
934 | PP(pp_pow) | |
935 | { | |
8ec5e241 | 936 | djSP; dATARGET; tryAMAGICbin(pow,opASSIGN); |
a0d0e21e LW |
937 | { |
938 | dPOPTOPnnrl; | |
939 | SETn( pow( left, right) ); | |
940 | RETURN; | |
93a17b20 | 941 | } |
a0d0e21e LW |
942 | } |
943 | ||
944 | PP(pp_multiply) | |
945 | { | |
8ec5e241 | 946 | djSP; dATARGET; tryAMAGICbin(mult,opASSIGN); |
a0d0e21e LW |
947 | { |
948 | dPOPTOPnnrl; | |
949 | SETn( left * right ); | |
950 | RETURN; | |
79072805 | 951 | } |
a0d0e21e LW |
952 | } |
953 | ||
954 | PP(pp_divide) | |
955 | { | |
8ec5e241 | 956 | djSP; dATARGET; tryAMAGICbin(div,opASSIGN); |
a0d0e21e | 957 | { |
77676ba1 | 958 | dPOPPOPnnrl; |
65202027 | 959 | NV value; |
7a4c00b4 | 960 | if (right == 0.0) |
cea2e8a9 | 961 | DIE(aTHX_ "Illegal division by zero"); |
a0d0e21e LW |
962 | #ifdef SLOPPYDIVIDE |
963 | /* insure that 20./5. == 4. */ | |
964 | { | |
7a4c00b4 | 965 | IV k; |
65202027 DS |
966 | if ((NV)I_V(left) == left && |
967 | (NV)I_V(right) == right && | |
7a4c00b4 | 968 | (k = I_V(left)/I_V(right))*I_V(right) == I_V(left)) { |
a0d0e21e | 969 | value = k; |
ef54e1a4 JH |
970 | } |
971 | else { | |
7a4c00b4 | 972 | value = left / right; |
79072805 | 973 | } |
a0d0e21e LW |
974 | } |
975 | #else | |
7a4c00b4 | 976 | value = left / right; |
a0d0e21e LW |
977 | #endif |
978 | PUSHn( value ); | |
979 | RETURN; | |
79072805 | 980 | } |
a0d0e21e LW |
981 | } |
982 | ||
983 | PP(pp_modulo) | |
984 | { | |
76e3520e | 985 | djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); |
a0d0e21e | 986 | { |
787eafbd IZ |
987 | UV left; |
988 | UV right; | |
989 | bool left_neg; | |
990 | bool right_neg; | |
991 | bool use_double = 0; | |
65202027 DS |
992 | NV dright; |
993 | NV dleft; | |
787eafbd IZ |
994 | |
995 | if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) { | |
996 | IV i = SvIVX(POPs); | |
997 | right = (right_neg = (i < 0)) ? -i : i; | |
998 | } | |
999 | else { | |
1000 | dright = POPn; | |
1001 | use_double = 1; | |
1002 | right_neg = dright < 0; | |
1003 | if (right_neg) | |
1004 | dright = -dright; | |
1005 | } | |
a0d0e21e | 1006 | |
787eafbd IZ |
1007 | if (!use_double && SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) { |
1008 | IV i = SvIVX(POPs); | |
1009 | left = (left_neg = (i < 0)) ? -i : i; | |
1010 | } | |
1011 | else { | |
1012 | dleft = POPn; | |
1013 | if (!use_double) { | |
a1bd196e GS |
1014 | use_double = 1; |
1015 | dright = right; | |
787eafbd IZ |
1016 | } |
1017 | left_neg = dleft < 0; | |
1018 | if (left_neg) | |
1019 | dleft = -dleft; | |
1020 | } | |
68dc0745 | 1021 | |
787eafbd | 1022 | if (use_double) { |
65202027 | 1023 | NV dans; |
787eafbd IZ |
1024 | |
1025 | #if 1 | |
787eafbd IZ |
1026 | /* Somehow U_V is pessimized even if CASTFLAGS is 0 */ |
1027 | # if CASTFLAGS & 2 | |
1028 | # define CAST_D2UV(d) U_V(d) | |
1029 | # else | |
1030 | # define CAST_D2UV(d) ((UV)(d)) | |
1031 | # endif | |
a1bd196e GS |
1032 | /* Tried to do this only in the case DOUBLESIZE <= UV_SIZE, |
1033 | * or, in other words, precision of UV more than of NV. | |
1034 | * But in fact the approach below turned out to be an | |
1035 | * optimization - floor() may be slow */ | |
787eafbd IZ |
1036 | if (dright <= UV_MAX && dleft <= UV_MAX) { |
1037 | right = CAST_D2UV(dright); | |
1038 | left = CAST_D2UV(dleft); | |
1039 | goto do_uv; | |
1040 | } | |
1041 | #endif | |
1042 | ||
1043 | /* Backward-compatibility clause: */ | |
853846ea NIS |
1044 | dright = floor(dright + 0.5); |
1045 | dleft = floor(dleft + 0.5); | |
787eafbd IZ |
1046 | |
1047 | if (!dright) | |
cea2e8a9 | 1048 | DIE(aTHX_ "Illegal modulus zero"); |
787eafbd | 1049 | |
65202027 | 1050 | dans = Perl_fmod(dleft, dright); |
787eafbd IZ |
1051 | if ((left_neg != right_neg) && dans) |
1052 | dans = dright - dans; | |
1053 | if (right_neg) | |
1054 | dans = -dans; | |
1055 | sv_setnv(TARG, dans); | |
1056 | } | |
1057 | else { | |
1058 | UV ans; | |
1059 | ||
1060 | do_uv: | |
1061 | if (!right) | |
cea2e8a9 | 1062 | DIE(aTHX_ "Illegal modulus zero"); |
787eafbd IZ |
1063 | |
1064 | ans = left % right; | |
1065 | if ((left_neg != right_neg) && ans) | |
1066 | ans = right - ans; | |
1067 | if (right_neg) { | |
1068 | /* XXX may warn: unary minus operator applied to unsigned type */ | |
1069 | /* could change -foo to be (~foo)+1 instead */ | |
1070 | if (ans <= ~((UV)IV_MAX)+1) | |
1071 | sv_setiv(TARG, ~ans+1); | |
1072 | else | |
65202027 | 1073 | sv_setnv(TARG, -(NV)ans); |
787eafbd IZ |
1074 | } |
1075 | else | |
1076 | sv_setuv(TARG, ans); | |
1077 | } | |
1078 | PUSHTARG; | |
1079 | RETURN; | |
79072805 | 1080 | } |
a0d0e21e | 1081 | } |
79072805 | 1082 | |
a0d0e21e LW |
1083 | PP(pp_repeat) |
1084 | { | |
4e35701f | 1085 | djSP; dATARGET; tryAMAGICbin(repeat,opASSIGN); |
748a9306 | 1086 | { |
a0d0e21e | 1087 | register I32 count = POPi; |
533c011a | 1088 | if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) { |
a0d0e21e LW |
1089 | dMARK; |
1090 | I32 items = SP - MARK; | |
1091 | I32 max; | |
79072805 | 1092 | |
a0d0e21e LW |
1093 | max = items * count; |
1094 | MEXTEND(MARK, max); | |
1095 | if (count > 1) { | |
1096 | while (SP > MARK) { | |
1097 | if (*SP) | |
1098 | SvTEMP_off((*SP)); | |
1099 | SP--; | |
79072805 | 1100 | } |
a0d0e21e LW |
1101 | MARK++; |
1102 | repeatcpy((char*)(MARK + items), (char*)MARK, | |
1103 | items * sizeof(SV*), count - 1); | |
1104 | SP += max; | |
79072805 | 1105 | } |
a0d0e21e LW |
1106 | else if (count <= 0) |
1107 | SP -= items; | |
79072805 | 1108 | } |
a0d0e21e LW |
1109 | else { /* Note: mark already snarfed by pp_list */ |
1110 | SV *tmpstr; | |
1111 | STRLEN len; | |
1112 | ||
1113 | tmpstr = POPs; | |
a0d0e21e LW |
1114 | SvSetSV(TARG, tmpstr); |
1115 | SvPV_force(TARG, len); | |
8ebc5c01 | 1116 | if (count != 1) { |
1117 | if (count < 1) | |
1118 | SvCUR_set(TARG, 0); | |
1119 | else { | |
1120 | SvGROW(TARG, (count * len) + 1); | |
a0d0e21e | 1121 | repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1); |
8ebc5c01 | 1122 | SvCUR(TARG) *= count; |
7a4c00b4 | 1123 | } |
a0d0e21e | 1124 | *SvEND(TARG) = '\0'; |
a0d0e21e | 1125 | } |
8ebc5c01 | 1126 | (void)SvPOK_only(TARG); |
a0d0e21e | 1127 | PUSHTARG; |
79072805 | 1128 | } |
a0d0e21e | 1129 | RETURN; |
748a9306 | 1130 | } |
a0d0e21e | 1131 | } |
79072805 | 1132 | |
a0d0e21e LW |
1133 | PP(pp_subtract) |
1134 | { | |
8ec5e241 | 1135 | djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); |
a0d0e21e | 1136 | { |
7a4c00b4 | 1137 | dPOPTOPnnrl_ul; |
a0d0e21e LW |
1138 | SETn( left - right ); |
1139 | RETURN; | |
79072805 | 1140 | } |
a0d0e21e | 1141 | } |
79072805 | 1142 | |
a0d0e21e LW |
1143 | PP(pp_left_shift) |
1144 | { | |
8ec5e241 | 1145 | djSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); |
a0d0e21e | 1146 | { |
d0ba1bd2 JH |
1147 | IBW shift = POPi; |
1148 | if (PL_op->op_private & HINT_INTEGER) { | |
1149 | IBW i = TOPi; | |
1150 | i = BWi(i) << shift; | |
1151 | SETi(BWi(i)); | |
1152 | } | |
1153 | else { | |
1154 | UBW u = TOPu; | |
1155 | u <<= shift; | |
1156 | SETu(BWu(u)); | |
1157 | } | |
55497cff | 1158 | RETURN; |
79072805 | 1159 | } |
a0d0e21e | 1160 | } |
79072805 | 1161 | |
a0d0e21e LW |
1162 | PP(pp_right_shift) |
1163 | { | |
8ec5e241 | 1164 | djSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); |
a0d0e21e | 1165 | { |
d0ba1bd2 JH |
1166 | IBW shift = POPi; |
1167 | if (PL_op->op_private & HINT_INTEGER) { | |
1168 | IBW i = TOPi; | |
1169 | i = BWi(i) >> shift; | |
1170 | SETi(BWi(i)); | |
1171 | } | |
1172 | else { | |
1173 | UBW u = TOPu; | |
1174 | u >>= shift; | |
1175 | SETu(BWu(u)); | |
1176 | } | |
a0d0e21e | 1177 | RETURN; |
93a17b20 | 1178 | } |
79072805 LW |
1179 | } |
1180 | ||
a0d0e21e | 1181 | PP(pp_lt) |
79072805 | 1182 | { |
8ec5e241 | 1183 | djSP; tryAMAGICbinSET(lt,0); |
a0d0e21e LW |
1184 | { |
1185 | dPOPnv; | |
54310121 | 1186 | SETs(boolSV(TOPn < value)); |
a0d0e21e | 1187 | RETURN; |
79072805 | 1188 | } |
a0d0e21e | 1189 | } |
79072805 | 1190 | |
a0d0e21e LW |
1191 | PP(pp_gt) |
1192 | { | |
8ec5e241 | 1193 | djSP; tryAMAGICbinSET(gt,0); |
a0d0e21e LW |
1194 | { |
1195 | dPOPnv; | |
54310121 | 1196 | SETs(boolSV(TOPn > value)); |
a0d0e21e | 1197 | RETURN; |
79072805 | 1198 | } |
a0d0e21e LW |
1199 | } |
1200 | ||
1201 | PP(pp_le) | |
1202 | { | |
8ec5e241 | 1203 | djSP; tryAMAGICbinSET(le,0); |
a0d0e21e LW |
1204 | { |
1205 | dPOPnv; | |
54310121 | 1206 | SETs(boolSV(TOPn <= value)); |
a0d0e21e | 1207 | RETURN; |
79072805 | 1208 | } |
a0d0e21e LW |
1209 | } |
1210 | ||
1211 | PP(pp_ge) | |
1212 | { | |
8ec5e241 | 1213 | djSP; tryAMAGICbinSET(ge,0); |
a0d0e21e LW |
1214 | { |
1215 | dPOPnv; | |
54310121 | 1216 | SETs(boolSV(TOPn >= value)); |
a0d0e21e | 1217 | RETURN; |
79072805 | 1218 | } |
a0d0e21e | 1219 | } |
79072805 | 1220 | |
a0d0e21e LW |
1221 | PP(pp_ne) |
1222 | { | |
8ec5e241 | 1223 | djSP; tryAMAGICbinSET(ne,0); |
a0d0e21e LW |
1224 | { |
1225 | dPOPnv; | |
54310121 | 1226 | SETs(boolSV(TOPn != value)); |
a0d0e21e LW |
1227 | RETURN; |
1228 | } | |
79072805 LW |
1229 | } |
1230 | ||
a0d0e21e | 1231 | PP(pp_ncmp) |
79072805 | 1232 | { |
8ec5e241 | 1233 | djSP; dTARGET; tryAMAGICbin(ncmp,0); |
a0d0e21e LW |
1234 | { |
1235 | dPOPTOPnnrl; | |
1236 | I32 value; | |
79072805 | 1237 | |
ff0cee69 | 1238 | if (left == right) |
a0d0e21e | 1239 | value = 0; |
a0d0e21e LW |
1240 | else if (left < right) |
1241 | value = -1; | |
44a8e56a | 1242 | else if (left > right) |
1243 | value = 1; | |
1244 | else { | |
3280af22 | 1245 | SETs(&PL_sv_undef); |
44a8e56a | 1246 | RETURN; |
1247 | } | |
a0d0e21e LW |
1248 | SETi(value); |
1249 | RETURN; | |
79072805 | 1250 | } |
a0d0e21e | 1251 | } |
79072805 | 1252 | |
a0d0e21e LW |
1253 | PP(pp_slt) |
1254 | { | |
8ec5e241 | 1255 | djSP; tryAMAGICbinSET(slt,0); |
a0d0e21e LW |
1256 | { |
1257 | dPOPTOPssrl; | |
533c011a | 1258 | int cmp = ((PL_op->op_private & OPpLOCALE) |
bbce6d69 | 1259 | ? sv_cmp_locale(left, right) |
1260 | : sv_cmp(left, right)); | |
54310121 | 1261 | SETs(boolSV(cmp < 0)); |
a0d0e21e LW |
1262 | RETURN; |
1263 | } | |
79072805 LW |
1264 | } |
1265 | ||
a0d0e21e | 1266 | PP(pp_sgt) |
79072805 | 1267 | { |
8ec5e241 | 1268 | djSP; tryAMAGICbinSET(sgt,0); |
a0d0e21e LW |
1269 | { |
1270 | dPOPTOPssrl; | |
533c011a | 1271 | int cmp = ((PL_op->op_private & OPpLOCALE) |
bbce6d69 | 1272 | ? sv_cmp_locale(left, right) |
1273 | : sv_cmp(left, right)); | |
54310121 | 1274 | SETs(boolSV(cmp > 0)); |
a0d0e21e LW |
1275 | RETURN; |
1276 | } | |
1277 | } | |
79072805 | 1278 | |
a0d0e21e LW |
1279 | PP(pp_sle) |
1280 | { | |
8ec5e241 | 1281 | djSP; tryAMAGICbinSET(sle,0); |
a0d0e21e LW |
1282 | { |
1283 | dPOPTOPssrl; | |
533c011a | 1284 | int cmp = ((PL_op->op_private & OPpLOCALE) |
bbce6d69 | 1285 | ? sv_cmp_locale(left, right) |
1286 | : sv_cmp(left, right)); | |
54310121 | 1287 | SETs(boolSV(cmp <= 0)); |
a0d0e21e | 1288 | RETURN; |
79072805 | 1289 | } |
79072805 LW |
1290 | } |
1291 | ||
a0d0e21e LW |
1292 | PP(pp_sge) |
1293 | { | |
8ec5e241 | 1294 | djSP; tryAMAGICbinSET(sge,0); |
a0d0e21e LW |
1295 | { |
1296 | dPOPTOPssrl; | |
533c011a | 1297 | int cmp = ((PL_op->op_private & OPpLOCALE) |
bbce6d69 | 1298 | ? sv_cmp_locale(left, right) |
1299 | : sv_cmp(left, right)); | |
54310121 | 1300 | SETs(boolSV(cmp >= 0)); |
a0d0e21e LW |
1301 | RETURN; |
1302 | } | |
1303 | } | |
79072805 | 1304 | |
36477c24 | 1305 | PP(pp_seq) |
1306 | { | |
8ec5e241 | 1307 | djSP; tryAMAGICbinSET(seq,0); |
36477c24 | 1308 | { |
1309 | dPOPTOPssrl; | |
54310121 | 1310 | SETs(boolSV(sv_eq(left, right))); |
a0d0e21e LW |
1311 | RETURN; |
1312 | } | |
1313 | } | |
79072805 | 1314 | |
a0d0e21e | 1315 | PP(pp_sne) |
79072805 | 1316 | { |
8ec5e241 | 1317 | djSP; tryAMAGICbinSET(sne,0); |
a0d0e21e LW |
1318 | { |
1319 | dPOPTOPssrl; | |
54310121 | 1320 | SETs(boolSV(!sv_eq(left, right))); |
a0d0e21e | 1321 | RETURN; |
463ee0b2 | 1322 | } |
79072805 LW |
1323 | } |
1324 | ||
a0d0e21e | 1325 | PP(pp_scmp) |
79072805 | 1326 | { |
4e35701f | 1327 | djSP; dTARGET; tryAMAGICbin(scmp,0); |
a0d0e21e LW |
1328 | { |
1329 | dPOPTOPssrl; | |
533c011a | 1330 | int cmp = ((PL_op->op_private & OPpLOCALE) |
bbce6d69 | 1331 | ? sv_cmp_locale(left, right) |
1332 | : sv_cmp(left, right)); | |
1333 | SETi( cmp ); | |
a0d0e21e LW |
1334 | RETURN; |
1335 | } | |
1336 | } | |
79072805 | 1337 | |
55497cff | 1338 | PP(pp_bit_and) |
1339 | { | |
8ec5e241 | 1340 | djSP; dATARGET; tryAMAGICbin(band,opASSIGN); |
a0d0e21e LW |
1341 | { |
1342 | dPOPTOPssrl; | |
4633a7c4 | 1343 | if (SvNIOKp(left) || SvNIOKp(right)) { |
d0ba1bd2 JH |
1344 | if (PL_op->op_private & HINT_INTEGER) { |
1345 | IBW value = SvIV(left) & SvIV(right); | |
1346 | SETi(BWi(value)); | |
1347 | } | |
1348 | else { | |
1349 | UBW value = SvUV(left) & SvUV(right); | |
1350 | SETu(BWu(value)); | |
1351 | } | |
a0d0e21e LW |
1352 | } |
1353 | else { | |
533c011a | 1354 | do_vop(PL_op->op_type, TARG, left, right); |
a0d0e21e LW |
1355 | SETTARG; |
1356 | } | |
1357 | RETURN; | |
1358 | } | |
1359 | } | |
79072805 | 1360 | |
a0d0e21e LW |
1361 | PP(pp_bit_xor) |
1362 | { | |
8ec5e241 | 1363 | djSP; dATARGET; tryAMAGICbin(bxor,opASSIGN); |
a0d0e21e LW |
1364 | { |
1365 | dPOPTOPssrl; | |
4633a7c4 | 1366 | if (SvNIOKp(left) || SvNIOKp(right)) { |
d0ba1bd2 JH |
1367 | if (PL_op->op_private & HINT_INTEGER) { |
1368 | IBW value = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right); | |
1369 | SETi(BWi(value)); | |
1370 | } | |
1371 | else { | |
1372 | UBW value = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right); | |
1373 | SETu(BWu(value)); | |
1374 | } | |
a0d0e21e LW |
1375 | } |
1376 | else { | |
533c011a | 1377 | do_vop(PL_op->op_type, TARG, left, right); |
a0d0e21e LW |
1378 | SETTARG; |
1379 | } | |
1380 | RETURN; | |
1381 | } | |
1382 | } | |
79072805 | 1383 | |
a0d0e21e LW |
1384 | PP(pp_bit_or) |
1385 | { | |
8ec5e241 | 1386 | djSP; dATARGET; tryAMAGICbin(bor,opASSIGN); |
a0d0e21e LW |
1387 | { |
1388 | dPOPTOPssrl; | |
4633a7c4 | 1389 | if (SvNIOKp(left) || SvNIOKp(right)) { |
d0ba1bd2 JH |
1390 | if (PL_op->op_private & HINT_INTEGER) { |
1391 | IBW value = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right); | |
1392 | SETi(BWi(value)); | |
1393 | } | |
1394 | else { | |
1395 | UBW value = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right); | |
1396 | SETu(BWu(value)); | |
1397 | } | |
a0d0e21e LW |
1398 | } |
1399 | else { | |
533c011a | 1400 | do_vop(PL_op->op_type, TARG, left, right); |
a0d0e21e LW |
1401 | SETTARG; |
1402 | } | |
1403 | RETURN; | |
79072805 | 1404 | } |
a0d0e21e | 1405 | } |
79072805 | 1406 | |
a0d0e21e LW |
1407 | PP(pp_negate) |
1408 | { | |
4e35701f | 1409 | djSP; dTARGET; tryAMAGICun(neg); |
a0d0e21e LW |
1410 | { |
1411 | dTOPss; | |
4633a7c4 LW |
1412 | if (SvGMAGICAL(sv)) |
1413 | mg_get(sv); | |
55497cff | 1414 | if (SvIOKp(sv) && !SvNOKp(sv) && !SvPOKp(sv) && SvIVX(sv) != IV_MIN) |
1415 | SETi(-SvIVX(sv)); | |
1416 | else if (SvNIOKp(sv)) | |
a0d0e21e | 1417 | SETn(-SvNV(sv)); |
4633a7c4 | 1418 | else if (SvPOKp(sv)) { |
a0d0e21e LW |
1419 | STRLEN len; |
1420 | char *s = SvPV(sv, len); | |
bbce6d69 | 1421 | if (isIDFIRST(*s)) { |
a0d0e21e LW |
1422 | sv_setpvn(TARG, "-", 1); |
1423 | sv_catsv(TARG, sv); | |
79072805 | 1424 | } |
a0d0e21e LW |
1425 | else if (*s == '+' || *s == '-') { |
1426 | sv_setsv(TARG, sv); | |
1427 | *SvPV_force(TARG, len) = *s == '-' ? '+' : '-'; | |
79072805 | 1428 | } |
b86a2fa7 | 1429 | else if (IN_UTF8 && *(U8*)s >= 0xc0 && isIDFIRST_utf8((U8*)s)) { |
834a4ddd LW |
1430 | sv_setpvn(TARG, "-", 1); |
1431 | sv_catsv(TARG, sv); | |
1432 | } | |
79072805 | 1433 | else |
a0d0e21e LW |
1434 | sv_setnv(TARG, -SvNV(sv)); |
1435 | SETTARG; | |
79072805 | 1436 | } |
4633a7c4 LW |
1437 | else |
1438 | SETn(-SvNV(sv)); | |
79072805 | 1439 | } |
a0d0e21e | 1440 | RETURN; |
79072805 LW |
1441 | } |
1442 | ||
a0d0e21e | 1443 | PP(pp_not) |
79072805 | 1444 | { |
4e35701f | 1445 | djSP; tryAMAGICunSET(not); |
3280af22 | 1446 | *PL_stack_sp = boolSV(!SvTRUE(*PL_stack_sp)); |
a0d0e21e | 1447 | return NORMAL; |
79072805 LW |
1448 | } |
1449 | ||
a0d0e21e | 1450 | PP(pp_complement) |
79072805 | 1451 | { |
8ec5e241 | 1452 | djSP; dTARGET; tryAMAGICun(compl); |
a0d0e21e LW |
1453 | { |
1454 | dTOPss; | |
4633a7c4 | 1455 | if (SvNIOKp(sv)) { |
d0ba1bd2 JH |
1456 | if (PL_op->op_private & HINT_INTEGER) { |
1457 | IBW value = ~SvIV(sv); | |
1458 | SETi(BWi(value)); | |
1459 | } | |
1460 | else { | |
1461 | UBW value = ~SvUV(sv); | |
1462 | SETu(BWu(value)); | |
1463 | } | |
a0d0e21e LW |
1464 | } |
1465 | else { | |
1466 | register char *tmps; | |
1467 | register long *tmpl; | |
55497cff | 1468 | register I32 anum; |
a0d0e21e LW |
1469 | STRLEN len; |
1470 | ||
1471 | SvSetSV(TARG, sv); | |
1472 | tmps = SvPV_force(TARG, len); | |
1473 | anum = len; | |
1474 | #ifdef LIBERAL | |
1475 | for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++) | |
1476 | *tmps = ~*tmps; | |
1477 | tmpl = (long*)tmps; | |
1478 | for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++) | |
1479 | *tmpl = ~*tmpl; | |
1480 | tmps = (char*)tmpl; | |
1481 | #endif | |
1482 | for ( ; anum > 0; anum--, tmps++) | |
1483 | *tmps = ~*tmps; | |
1484 | ||
1485 | SETs(TARG); | |
1486 | } | |
1487 | RETURN; | |
1488 | } | |
79072805 LW |
1489 | } |
1490 | ||
a0d0e21e LW |
1491 | /* integer versions of some of the above */ |
1492 | ||
a0d0e21e | 1493 | PP(pp_i_multiply) |
79072805 | 1494 | { |
8ec5e241 | 1495 | djSP; dATARGET; tryAMAGICbin(mult,opASSIGN); |
a0d0e21e LW |
1496 | { |
1497 | dPOPTOPiirl; | |
1498 | SETi( left * right ); | |
1499 | RETURN; | |
1500 | } | |
79072805 LW |
1501 | } |
1502 | ||
a0d0e21e | 1503 | PP(pp_i_divide) |
79072805 | 1504 | { |
8ec5e241 | 1505 | djSP; dATARGET; tryAMAGICbin(div,opASSIGN); |
a0d0e21e LW |
1506 | { |
1507 | dPOPiv; | |
1508 | if (value == 0) | |
cea2e8a9 | 1509 | DIE(aTHX_ "Illegal division by zero"); |
a0d0e21e LW |
1510 | value = POPi / value; |
1511 | PUSHi( value ); | |
1512 | RETURN; | |
1513 | } | |
79072805 LW |
1514 | } |
1515 | ||
a0d0e21e | 1516 | PP(pp_i_modulo) |
79072805 | 1517 | { |
76e3520e | 1518 | djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); |
79072805 | 1519 | { |
a0d0e21e | 1520 | dPOPTOPiirl; |
aa306039 | 1521 | if (!right) |
cea2e8a9 | 1522 | DIE(aTHX_ "Illegal modulus zero"); |
a0d0e21e LW |
1523 | SETi( left % right ); |
1524 | RETURN; | |
79072805 | 1525 | } |
79072805 LW |
1526 | } |
1527 | ||
a0d0e21e | 1528 | PP(pp_i_add) |
79072805 | 1529 | { |
8ec5e241 | 1530 | djSP; dATARGET; tryAMAGICbin(add,opASSIGN); |
a0d0e21e LW |
1531 | { |
1532 | dPOPTOPiirl; | |
1533 | SETi( left + right ); | |
1534 | RETURN; | |
79072805 | 1535 | } |
79072805 LW |
1536 | } |
1537 | ||
a0d0e21e | 1538 | PP(pp_i_subtract) |
79072805 | 1539 | { |
8ec5e241 | 1540 | djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); |
a0d0e21e LW |
1541 | { |
1542 | dPOPTOPiirl; | |
1543 | SETi( left - right ); | |
1544 | RETURN; | |
79072805 | 1545 | } |
79072805 LW |
1546 | } |
1547 | ||
a0d0e21e | 1548 | PP(pp_i_lt) |
79072805 | 1549 | { |
8ec5e241 | 1550 | djSP; tryAMAGICbinSET(lt,0); |
a0d0e21e LW |
1551 | { |
1552 | dPOPTOPiirl; | |
54310121 | 1553 | SETs(boolSV(left < right)); |
a0d0e21e LW |
1554 | RETURN; |
1555 | } | |
79072805 LW |
1556 | } |
1557 | ||
a0d0e21e | 1558 | PP(pp_i_gt) |
79072805 | 1559 | { |
8ec5e241 | 1560 | djSP; tryAMAGICbinSET(gt,0); |
a0d0e21e LW |
1561 | { |
1562 | dPOPTOPiirl; | |
54310121 | 1563 | SETs(boolSV(left > right)); |
a0d0e21e LW |
1564 | RETURN; |
1565 | } | |
79072805 LW |
1566 | } |
1567 | ||
a0d0e21e | 1568 | PP(pp_i_le) |
79072805 | 1569 | { |
8ec5e241 | 1570 | djSP; tryAMAGICbinSET(le,0); |
a0d0e21e LW |
1571 | { |
1572 | dPOPTOPiirl; | |
54310121 | 1573 | SETs(boolSV(left <= right)); |
a0d0e21e | 1574 | RETURN; |
85e6fe83 | 1575 | } |
79072805 LW |
1576 | } |
1577 | ||
a0d0e21e | 1578 | PP(pp_i_ge) |
79072805 | 1579 | { |
8ec5e241 | 1580 | djSP; tryAMAGICbinSET(ge,0); |
a0d0e21e LW |
1581 | { |
1582 | dPOPTOPiirl; | |
54310121 | 1583 | SETs(boolSV(left >= right)); |
a0d0e21e LW |
1584 | RETURN; |
1585 | } | |
79072805 LW |
1586 | } |
1587 | ||
a0d0e21e | 1588 | PP(pp_i_eq) |
79072805 | 1589 | { |
8ec5e241 | 1590 | djSP; tryAMAGICbinSET(eq,0); |
a0d0e21e LW |
1591 | { |
1592 | dPOPTOPiirl; | |
54310121 | 1593 | SETs(boolSV(left == right)); |
a0d0e21e LW |
1594 | RETURN; |
1595 | } | |
79072805 LW |
1596 | } |
1597 | ||
a0d0e21e | 1598 | PP(pp_i_ne) |
79072805 | 1599 | { |
8ec5e241 | 1600 | djSP; tryAMAGICbinSET(ne,0); |
a0d0e21e LW |
1601 | { |
1602 | dPOPTOPiirl; | |
54310121 | 1603 | SETs(boolSV(left != right)); |
a0d0e21e LW |
1604 | RETURN; |
1605 | } | |
79072805 LW |
1606 | } |
1607 | ||
a0d0e21e | 1608 | PP(pp_i_ncmp) |
79072805 | 1609 | { |
8ec5e241 | 1610 | djSP; dTARGET; tryAMAGICbin(ncmp,0); |
a0d0e21e LW |
1611 | { |
1612 | dPOPTOPiirl; | |
1613 | I32 value; | |
79072805 | 1614 | |
a0d0e21e | 1615 | if (left > right) |
79072805 | 1616 | value = 1; |
a0d0e21e | 1617 | else if (left < right) |
79072805 | 1618 | value = -1; |
a0d0e21e | 1619 | else |
79072805 | 1620 | value = 0; |
a0d0e21e LW |
1621 | SETi(value); |
1622 | RETURN; | |
79072805 | 1623 | } |
85e6fe83 LW |
1624 | } |
1625 | ||
1626 | PP(pp_i_negate) | |
1627 | { | |
4e35701f | 1628 | djSP; dTARGET; tryAMAGICun(neg); |
85e6fe83 LW |
1629 | SETi(-TOPi); |
1630 | RETURN; | |
1631 | } | |
1632 | ||
79072805 LW |
1633 | /* High falutin' math. */ |
1634 | ||
1635 | PP(pp_atan2) | |
1636 | { | |
8ec5e241 | 1637 | djSP; dTARGET; tryAMAGICbin(atan2,0); |
a0d0e21e LW |
1638 | { |
1639 | dPOPTOPnnrl; | |
65202027 | 1640 | SETn(Perl_atan2(left, right)); |
a0d0e21e LW |
1641 | RETURN; |
1642 | } | |
79072805 LW |
1643 | } |
1644 | ||
1645 | PP(pp_sin) | |
1646 | { | |
4e35701f | 1647 | djSP; dTARGET; tryAMAGICun(sin); |
a0d0e21e | 1648 | { |
65202027 | 1649 | NV value; |
a0d0e21e | 1650 | value = POPn; |
65202027 | 1651 | value = Perl_sin(value); |
a0d0e21e LW |
1652 | XPUSHn(value); |
1653 | RETURN; | |
1654 | } | |
79072805 LW |
1655 | } |
1656 | ||
1657 | PP(pp_cos) | |
1658 | { | |
4e35701f | 1659 | djSP; dTARGET; tryAMAGICun(cos); |
a0d0e21e | 1660 | { |
65202027 | 1661 | NV value; |
a0d0e21e | 1662 | value = POPn; |
65202027 | 1663 | value = Perl_cos(value); |
a0d0e21e LW |
1664 | XPUSHn(value); |
1665 | RETURN; | |
1666 | } | |
79072805 LW |
1667 | } |
1668 | ||
56cb0a1c AD |
1669 | /* Support Configure command-line overrides for rand() functions. |
1670 | After 5.005, perhaps we should replace this by Configure support | |
1671 | for drand48(), random(), or rand(). For 5.005, though, maintain | |
1672 | compatibility by calling rand() but allow the user to override it. | |
1673 | See INSTALL for details. --Andy Dougherty 15 July 1998 | |
1674 | */ | |
85ab1d1d JH |
1675 | /* Now it's after 5.005, and Configure supports drand48() and random(), |
1676 | in addition to rand(). So the overrides should not be needed any more. | |
1677 | --Jarkko Hietaniemi 27 September 1998 | |
1678 | */ | |
1679 | ||
1680 | #ifndef HAS_DRAND48_PROTO | |
20ce7b12 | 1681 | extern double drand48 (void); |
56cb0a1c AD |
1682 | #endif |
1683 | ||
79072805 LW |
1684 | PP(pp_rand) |
1685 | { | |
4e35701f | 1686 | djSP; dTARGET; |
65202027 | 1687 | NV value; |
79072805 LW |
1688 | if (MAXARG < 1) |
1689 | value = 1.0; | |
1690 | else | |
1691 | value = POPn; | |
1692 | if (value == 0.0) | |
1693 | value = 1.0; | |
80252599 | 1694 | if (!PL_srand_called) { |
85ab1d1d | 1695 | (void)seedDrand01((Rand_seed_t)seed()); |
80252599 | 1696 | PL_srand_called = TRUE; |
93dc8474 | 1697 | } |
85ab1d1d | 1698 | value *= Drand01(); |
79072805 LW |
1699 | XPUSHn(value); |
1700 | RETURN; | |
1701 | } | |
1702 | ||
1703 | PP(pp_srand) | |
1704 | { | |
4e35701f | 1705 | djSP; |
93dc8474 CS |
1706 | UV anum; |
1707 | if (MAXARG < 1) | |
1708 | anum = seed(); | |
79072805 | 1709 | else |
93dc8474 | 1710 | anum = POPu; |
85ab1d1d | 1711 | (void)seedDrand01((Rand_seed_t)anum); |
80252599 | 1712 | PL_srand_called = TRUE; |
79072805 LW |
1713 | EXTEND(SP, 1); |
1714 | RETPUSHYES; | |
1715 | } | |
1716 | ||
76e3520e | 1717 | STATIC U32 |
cea2e8a9 | 1718 | S_seed(pTHX) |
93dc8474 | 1719 | { |
54310121 | 1720 | /* |
1721 | * This is really just a quick hack which grabs various garbage | |
1722 | * values. It really should be a real hash algorithm which | |
1723 | * spreads the effect of every input bit onto every output bit, | |
85ab1d1d | 1724 | * if someone who knows about such things would bother to write it. |
54310121 | 1725 | * Might be a good idea to add that function to CORE as well. |
85ab1d1d | 1726 | * No numbers below come from careful analysis or anything here, |
54310121 | 1727 | * except they are primes and SEED_C1 > 1E6 to get a full-width |
1728 | * value from (tv_sec * SEED_C1 + tv_usec). The multipliers should | |
1729 | * probably be bigger too. | |
1730 | */ | |
1731 | #if RANDBITS > 16 | |
1732 | # define SEED_C1 1000003 | |
1733 | #define SEED_C4 73819 | |
1734 | #else | |
1735 | # define SEED_C1 25747 | |
1736 | #define SEED_C4 20639 | |
1737 | #endif | |
1738 | #define SEED_C2 3 | |
1739 | #define SEED_C3 269 | |
1740 | #define SEED_C5 26107 | |
1741 | ||
e858de61 | 1742 | dTHR; |
73c60299 RS |
1743 | #ifndef PERL_NO_DEV_RANDOM |
1744 | int fd; | |
1745 | #endif | |
93dc8474 | 1746 | U32 u; |
f12c7020 | 1747 | #ifdef VMS |
1748 | # include <starlet.h> | |
43c92808 HF |
1749 | /* when[] = (low 32 bits, high 32 bits) of time since epoch |
1750 | * in 100-ns units, typically incremented ever 10 ms. */ | |
93dc8474 | 1751 | unsigned int when[2]; |
73c60299 RS |
1752 | #else |
1753 | # ifdef HAS_GETTIMEOFDAY | |
1754 | struct timeval when; | |
1755 | # else | |
1756 | Time_t when; | |
1757 | # endif | |
1758 | #endif | |
1759 | ||
1760 | /* This test is an escape hatch, this symbol isn't set by Configure. */ | |
1761 | #ifndef PERL_NO_DEV_RANDOM | |
1762 | #ifndef PERL_RANDOM_DEVICE | |
1763 | /* /dev/random isn't used by default because reads from it will block | |
1764 | * if there isn't enough entropy available. You can compile with | |
1765 | * PERL_RANDOM_DEVICE to it if you'd prefer Perl to block until there | |
1766 | * is enough real entropy to fill the seed. */ | |
1767 | # define PERL_RANDOM_DEVICE "/dev/urandom" | |
1768 | #endif | |
1769 | fd = PerlLIO_open(PERL_RANDOM_DEVICE, 0); | |
1770 | if (fd != -1) { | |
1771 | if (PerlLIO_read(fd, &u, sizeof u) != sizeof u) | |
1772 | u = 0; | |
1773 | PerlLIO_close(fd); | |
1774 | if (u) | |
1775 | return u; | |
1776 | } | |
1777 | #endif | |
1778 | ||
1779 | #ifdef VMS | |
93dc8474 | 1780 | _ckvmssts(sys$gettim(when)); |
54310121 | 1781 | u = (U32)SEED_C1 * when[0] + (U32)SEED_C2 * when[1]; |
f12c7020 | 1782 | #else |
5f05dabc | 1783 | # ifdef HAS_GETTIMEOFDAY |
93dc8474 | 1784 | gettimeofday(&when,(struct timezone *) 0); |
54310121 | 1785 | u = (U32)SEED_C1 * when.tv_sec + (U32)SEED_C2 * when.tv_usec; |
f12c7020 | 1786 | # else |
93dc8474 | 1787 | (void)time(&when); |
54310121 | 1788 | u = (U32)SEED_C1 * when; |
f12c7020 | 1789 | # endif |
1790 | #endif | |
7766f137 | 1791 | u += SEED_C3 * (U32)PerlProc_getpid(); |
56431972 | 1792 | u += SEED_C4 * (U32)PTR2UV(PL_stack_sp); |
54310121 | 1793 | #ifndef PLAN9 /* XXX Plan9 assembler chokes on this; fix needed */ |
56431972 | 1794 | u += SEED_C5 * (U32)PTR2UV(&when); |
f12c7020 | 1795 | #endif |
93dc8474 | 1796 | return u; |
79072805 LW |
1797 | } |
1798 | ||
1799 | PP(pp_exp) | |
1800 | { | |
4e35701f | 1801 | djSP; dTARGET; tryAMAGICun(exp); |
a0d0e21e | 1802 | { |
65202027 | 1803 | NV value; |
a0d0e21e | 1804 | value = POPn; |
65202027 | 1805 | value = Perl_exp(value); |
a0d0e21e LW |
1806 | XPUSHn(value); |
1807 | RETURN; | |
1808 | } | |
79072805 LW |
1809 | } |
1810 | ||
1811 | PP(pp_log) | |
1812 | { | |
4e35701f | 1813 | djSP; dTARGET; tryAMAGICun(log); |
a0d0e21e | 1814 | { |
65202027 | 1815 | NV value; |
a0d0e21e | 1816 | value = POPn; |
bbce6d69 | 1817 | if (value <= 0.0) { |
097ee67d | 1818 | RESTORE_NUMERIC_STANDARD(); |
cea2e8a9 | 1819 | DIE(aTHX_ "Can't take log of %g", value); |
bbce6d69 | 1820 | } |
65202027 | 1821 | value = Perl_log(value); |
a0d0e21e LW |
1822 | XPUSHn(value); |
1823 | RETURN; | |
1824 | } | |
79072805 LW |
1825 | } |
1826 | ||
1827 | PP(pp_sqrt) | |
1828 | { | |
4e35701f | 1829 | djSP; dTARGET; tryAMAGICun(sqrt); |
a0d0e21e | 1830 | { |
65202027 | 1831 | NV value; |
a0d0e21e | 1832 | value = POPn; |
bbce6d69 | 1833 | if (value < 0.0) { |
097ee67d | 1834 | RESTORE_NUMERIC_STANDARD(); |
cea2e8a9 | 1835 | DIE(aTHX_ "Can't take sqrt of %g", value); |
bbce6d69 | 1836 | } |
65202027 | 1837 | value = Perl_sqrt(value); |
a0d0e21e LW |
1838 | XPUSHn(value); |
1839 | RETURN; | |
1840 | } | |
79072805 LW |
1841 | } |
1842 | ||
1843 | PP(pp_int) | |
1844 | { | |
4e35701f | 1845 | djSP; dTARGET; |
774d564b | 1846 | { |
65202027 | 1847 | NV value = TOPn; |
774d564b | 1848 | IV iv; |
1849 | ||
1850 | if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs)) { | |
1851 | iv = SvIVX(TOPs); | |
1852 | SETi(iv); | |
1853 | } | |
1854 | else { | |
1855 | if (value >= 0.0) | |
65202027 | 1856 | (void)Perl_modf(value, &value); |
774d564b | 1857 | else { |
65202027 | 1858 | (void)Perl_modf(-value, &value); |
774d564b | 1859 | value = -value; |
1860 | } | |
1861 | iv = I_V(value); | |
1862 | if (iv == value) | |
1863 | SETi(iv); | |
1864 | else | |
1865 | SETn(value); | |
1866 | } | |
79072805 | 1867 | } |
79072805 LW |
1868 | RETURN; |
1869 | } | |
1870 | ||
463ee0b2 LW |
1871 | PP(pp_abs) |
1872 | { | |
4e35701f | 1873 | djSP; dTARGET; tryAMAGICun(abs); |
a0d0e21e | 1874 | { |
65202027 | 1875 | NV value = TOPn; |
774d564b | 1876 | IV iv; |
463ee0b2 | 1877 | |
774d564b | 1878 | if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs) && |
1879 | (iv = SvIVX(TOPs)) != IV_MIN) { | |
1880 | if (iv < 0) | |
1881 | iv = -iv; | |
1882 | SETi(iv); | |
1883 | } | |
1884 | else { | |
1885 | if (value < 0.0) | |
1886 | value = -value; | |
1887 | SETn(value); | |
1888 | } | |
a0d0e21e | 1889 | } |
774d564b | 1890 | RETURN; |
463ee0b2 LW |
1891 | } |
1892 | ||
79072805 LW |
1893 | PP(pp_hex) |
1894 | { | |
4e35701f | 1895 | djSP; dTARGET; |
79072805 LW |
1896 | char *tmps; |
1897 | I32 argtype; | |
2d8e6c8d | 1898 | STRLEN n_a; |
79072805 | 1899 | |
2d8e6c8d | 1900 | tmps = POPpx; |
9e24b6e2 | 1901 | XPUSHn(scan_hex(tmps, 99, &argtype)); |
79072805 LW |
1902 | RETURN; |
1903 | } | |
1904 | ||
1905 | PP(pp_oct) | |
1906 | { | |
4e35701f | 1907 | djSP; dTARGET; |
9e24b6e2 | 1908 | NV value; |
79072805 LW |
1909 | I32 argtype; |
1910 | char *tmps; | |
2d8e6c8d | 1911 | STRLEN n_a; |
79072805 | 1912 | |
2d8e6c8d | 1913 | tmps = POPpx; |
464e2e8a | 1914 | while (*tmps && isSPACE(*tmps)) |
1915 | tmps++; | |
9e24b6e2 JH |
1916 | if (*tmps == '0') |
1917 | tmps++; | |
1918 | if (*tmps == 'x') | |
1919 | value = scan_hex(++tmps, 99, &argtype); | |
1920 | else if (*tmps == 'b') | |
1921 | value = scan_bin(++tmps, 99, &argtype); | |
464e2e8a | 1922 | else |
9e24b6e2 JH |
1923 | value = scan_oct(tmps, 99, &argtype); |
1924 | XPUSHn(value); | |
79072805 LW |
1925 | RETURN; |
1926 | } | |
1927 | ||
1928 | /* String stuff. */ | |
1929 | ||
1930 | PP(pp_length) | |
1931 | { | |
4e35701f | 1932 | djSP; dTARGET; |
a0ed51b3 LW |
1933 | |
1934 | if (IN_UTF8) { | |
1935 | SETi( sv_len_utf8(TOPs) ); | |
1936 | RETURN; | |
1937 | } | |
1938 | ||
a0d0e21e | 1939 | SETi( sv_len(TOPs) ); |
79072805 LW |
1940 | RETURN; |
1941 | } | |
1942 | ||
1943 | PP(pp_substr) | |
1944 | { | |
4e35701f | 1945 | djSP; dTARGET; |
79072805 LW |
1946 | SV *sv; |
1947 | I32 len; | |
463ee0b2 | 1948 | STRLEN curlen; |
a0ed51b3 | 1949 | STRLEN utfcurlen; |
79072805 LW |
1950 | I32 pos; |
1951 | I32 rem; | |
84902520 | 1952 | I32 fail; |
533c011a | 1953 | I32 lvalue = PL_op->op_flags & OPf_MOD; |
79072805 | 1954 | char *tmps; |
3280af22 | 1955 | I32 arybase = PL_curcop->cop_arybase; |
7b8d334a GS |
1956 | char *repl = 0; |
1957 | STRLEN repl_len; | |
79072805 | 1958 | |
20408e3c | 1959 | SvTAINTED_off(TARG); /* decontaminate */ |
5d82c453 GA |
1960 | if (MAXARG > 2) { |
1961 | if (MAXARG > 3) { | |
1962 | sv = POPs; | |
1963 | repl = SvPV(sv, repl_len); | |
7b8d334a | 1964 | } |
79072805 | 1965 | len = POPi; |
5d82c453 | 1966 | } |
84902520 | 1967 | pos = POPi; |
79072805 | 1968 | sv = POPs; |
849ca7ee | 1969 | PUTBACK; |
a0d0e21e | 1970 | tmps = SvPV(sv, curlen); |
a0ed51b3 LW |
1971 | if (IN_UTF8) { |
1972 | utfcurlen = sv_len_utf8(sv); | |
1973 | if (utfcurlen == curlen) | |
1974 | utfcurlen = 0; | |
1975 | else | |
1976 | curlen = utfcurlen; | |
1977 | } | |
d1c2b58a LW |
1978 | else |
1979 | utfcurlen = 0; | |
a0ed51b3 | 1980 | |
84902520 TB |
1981 | if (pos >= arybase) { |
1982 | pos -= arybase; | |
1983 | rem = curlen-pos; | |
1984 | fail = rem; | |
5d82c453 GA |
1985 | if (MAXARG > 2) { |
1986 | if (len < 0) { | |
1987 | rem += len; | |
1988 | if (rem < 0) | |
1989 | rem = 0; | |
1990 | } | |
1991 | else if (rem > len) | |
1992 | rem = len; | |
1993 | } | |
68dc0745 | 1994 | } |
84902520 | 1995 | else { |
5d82c453 GA |
1996 | pos += curlen; |
1997 | if (MAXARG < 3) | |
1998 | rem = curlen; | |
1999 | else if (len >= 0) { | |
2000 | rem = pos+len; | |
2001 | if (rem > (I32)curlen) | |
2002 | rem = curlen; | |
2003 | } | |
2004 | else { | |
2005 | rem = curlen+len; | |
2006 | if (rem < pos) | |
2007 | rem = pos; | |
2008 | } | |
2009 | if (pos < 0) | |
2010 | pos = 0; | |
2011 | fail = rem; | |
2012 | rem -= pos; | |
84902520 TB |
2013 | } |
2014 | if (fail < 0) { | |
599cee73 | 2015 | if (ckWARN(WARN_SUBSTR) || lvalue || repl) |
cea2e8a9 | 2016 | Perl_warner(aTHX_ WARN_SUBSTR, "substr outside of string"); |
2304df62 AD |
2017 | RETPUSHUNDEF; |
2018 | } | |
79072805 | 2019 | else { |
a0ed51b3 LW |
2020 | if (utfcurlen) |
2021 | sv_pos_u2b(sv, &pos, &rem); | |
79072805 | 2022 | tmps += pos; |
79072805 | 2023 | sv_setpvn(TARG, tmps, rem); |
c8faf1c5 GS |
2024 | if (repl) |
2025 | sv_insert(sv, pos, rem, repl, repl_len); | |
2026 | else if (lvalue) { /* it's an lvalue! */ | |
dedeecda | 2027 | if (!SvGMAGICAL(sv)) { |
2028 | if (SvROK(sv)) { | |
2d8e6c8d GS |
2029 | STRLEN n_a; |
2030 | SvPV_force(sv,n_a); | |
599cee73 | 2031 | if (ckWARN(WARN_SUBSTR)) |
cea2e8a9 | 2032 | Perl_warner(aTHX_ WARN_SUBSTR, |
599cee73 | 2033 | "Attempt to use reference as lvalue in substr"); |
dedeecda | 2034 | } |
2035 | if (SvOK(sv)) /* is it defined ? */ | |
2036 | (void)SvPOK_only(sv); | |
2037 | else | |
2038 | sv_setpvn(sv,"",0); /* avoid lexical reincarnation */ | |
2039 | } | |
5f05dabc | 2040 | |
a0d0e21e LW |
2041 | if (SvTYPE(TARG) < SVt_PVLV) { |
2042 | sv_upgrade(TARG, SVt_PVLV); | |
2043 | sv_magic(TARG, Nullsv, 'x', Nullch, 0); | |
ed6116ce | 2044 | } |
a0d0e21e | 2045 | |
5f05dabc | 2046 | LvTYPE(TARG) = 'x'; |
6ff81951 GS |
2047 | if (LvTARG(TARG) != sv) { |
2048 | if (LvTARG(TARG)) | |
2049 | SvREFCNT_dec(LvTARG(TARG)); | |
2050 | LvTARG(TARG) = SvREFCNT_inc(sv); | |
2051 | } | |
a0d0e21e | 2052 | LvTARGOFF(TARG) = pos; |
8ec5e241 | 2053 | LvTARGLEN(TARG) = rem; |
79072805 LW |
2054 | } |
2055 | } | |
849ca7ee | 2056 | SPAGAIN; |
79072805 LW |
2057 | PUSHs(TARG); /* avoid SvSETMAGIC here */ |
2058 | RETURN; | |
2059 | } | |
2060 | ||
2061 | PP(pp_vec) | |
2062 | { | |
4e35701f | 2063 | djSP; dTARGET; |
79072805 LW |
2064 | register I32 size = POPi; |
2065 | register I32 offset = POPi; | |
2066 | register SV *src = POPs; | |
533c011a | 2067 | I32 lvalue = PL_op->op_flags & OPf_MOD; |
a0d0e21e | 2068 | |
81e118e0 JH |
2069 | SvTAINTED_off(TARG); /* decontaminate */ |
2070 | if (lvalue) { /* it's an lvalue! */ | |
2071 | if (SvTYPE(TARG) < SVt_PVLV) { | |
2072 | sv_upgrade(TARG, SVt_PVLV); | |
2073 | sv_magic(TARG, Nullsv, 'v', Nullch, 0); | |
79072805 | 2074 | } |
81e118e0 JH |
2075 | LvTYPE(TARG) = 'v'; |
2076 | if (LvTARG(TARG) != src) { | |
2077 | if (LvTARG(TARG)) | |
2078 | SvREFCNT_dec(LvTARG(TARG)); | |
2079 | LvTARG(TARG) = SvREFCNT_inc(src); | |
79072805 | 2080 | } |
81e118e0 JH |
2081 | LvTARGOFF(TARG) = offset; |
2082 | LvTARGLEN(TARG) = size; | |
79072805 LW |
2083 | } |
2084 | ||
81e118e0 | 2085 | sv_setuv(TARG, do_vecget(src, offset, size)); |
79072805 LW |
2086 | PUSHs(TARG); |
2087 | RETURN; | |
2088 | } | |
2089 | ||
2090 | PP(pp_index) | |
2091 | { | |
4e35701f | 2092 | djSP; dTARGET; |
79072805 LW |
2093 | SV *big; |
2094 | SV *little; | |
2095 | I32 offset; | |
2096 | I32 retval; | |
2097 | char *tmps; | |
2098 | char *tmps2; | |
463ee0b2 | 2099 | STRLEN biglen; |
3280af22 | 2100 | I32 arybase = PL_curcop->cop_arybase; |
79072805 LW |
2101 | |
2102 | if (MAXARG < 3) | |
2103 | offset = 0; | |
2104 | else | |
2105 | offset = POPi - arybase; | |
2106 | little = POPs; | |
2107 | big = POPs; | |
463ee0b2 | 2108 | tmps = SvPV(big, biglen); |
a0ed51b3 LW |
2109 | if (IN_UTF8 && offset > 0) |
2110 | sv_pos_u2b(big, &offset, 0); | |
79072805 LW |
2111 | if (offset < 0) |
2112 | offset = 0; | |
93a17b20 LW |
2113 | else if (offset > biglen) |
2114 | offset = biglen; | |
79072805 | 2115 | if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset, |
411d5715 | 2116 | (unsigned char*)tmps + biglen, little, 0))) |
a0ed51b3 | 2117 | retval = -1; |
79072805 | 2118 | else |
a0ed51b3 LW |
2119 | retval = tmps2 - tmps; |
2120 | if (IN_UTF8 && retval > 0) | |
2121 | sv_pos_b2u(big, &retval); | |
2122 | PUSHi(retval + arybase); | |
79072805 LW |
2123 | RETURN; |
2124 | } | |
2125 | ||
2126 | PP(pp_rindex) | |
2127 | { | |
4e35701f | 2128 | djSP; dTARGET; |
79072805 LW |
2129 | SV *big; |
2130 | SV *little; | |
463ee0b2 LW |
2131 | STRLEN blen; |
2132 | STRLEN llen; | |
79072805 LW |
2133 | I32 offset; |
2134 | I32 retval; | |
2135 | char *tmps; | |
2136 | char *tmps2; | |
3280af22 | 2137 | I32 arybase = PL_curcop->cop_arybase; |
79072805 | 2138 | |
a0d0e21e | 2139 | if (MAXARG >= 3) |
a0ed51b3 | 2140 | offset = POPi; |
79072805 LW |
2141 | little = POPs; |
2142 | big = POPs; | |
463ee0b2 LW |
2143 | tmps2 = SvPV(little, llen); |
2144 | tmps = SvPV(big, blen); | |
79072805 | 2145 | if (MAXARG < 3) |
463ee0b2 | 2146 | offset = blen; |
a0ed51b3 LW |
2147 | else { |
2148 | if (IN_UTF8 && offset > 0) | |
2149 | sv_pos_u2b(big, &offset, 0); | |
2150 | offset = offset - arybase + llen; | |
2151 | } | |
79072805 LW |
2152 | if (offset < 0) |
2153 | offset = 0; | |
463ee0b2 LW |
2154 | else if (offset > blen) |
2155 | offset = blen; | |
79072805 | 2156 | if (!(tmps2 = rninstr(tmps, tmps + offset, |
463ee0b2 | 2157 | tmps2, tmps2 + llen))) |
a0ed51b3 | 2158 | retval = -1; |
79072805 | 2159 | else |
a0ed51b3 LW |
2160 | retval = tmps2 - tmps; |
2161 | if (IN_UTF8 && retval > 0) | |
2162 | sv_pos_b2u(big, &retval); | |
2163 | PUSHi(retval + arybase); | |
79072805 LW |
2164 | RETURN; |
2165 | } | |
2166 | ||
2167 | PP(pp_sprintf) | |
2168 | { | |
4e35701f | 2169 | djSP; dMARK; dORIGMARK; dTARGET; |
79072805 | 2170 | do_sprintf(TARG, SP-MARK, MARK+1); |
bbce6d69 | 2171 | TAINT_IF(SvTAINTED(TARG)); |
79072805 LW |
2172 | SP = ORIGMARK; |
2173 | PUSHTARG; | |
2174 | RETURN; | |
2175 | } | |
2176 | ||
79072805 LW |
2177 | PP(pp_ord) |
2178 | { | |
4e35701f | 2179 | djSP; dTARGET; |
bdeef251 | 2180 | UV value; |
2d8e6c8d GS |
2181 | STRLEN n_a; |
2182 | U8 *tmps = (U8*)POPpx; | |
a0ed51b3 | 2183 | I32 retlen; |
79072805 | 2184 | |
a0ed51b3 | 2185 | if (IN_UTF8 && (*tmps & 0x80)) |
bdeef251 | 2186 | value = utf8_to_uv(tmps, &retlen); |
a0ed51b3 | 2187 | else |
bdeef251 GA |
2188 | value = (UV)(*tmps & 255); |
2189 | XPUSHu(value); | |
79072805 LW |
2190 | RETURN; |
2191 | } | |
2192 | ||
463ee0b2 LW |
2193 | PP(pp_chr) |
2194 | { | |
4e35701f | 2195 | djSP; dTARGET; |
463ee0b2 | 2196 | char *tmps; |
3b9be786 | 2197 | U32 value = POPu; |
463ee0b2 | 2198 | |
748a9306 | 2199 | (void)SvUPGRADE(TARG,SVt_PV); |
a0ed51b3 LW |
2200 | |
2201 | if (IN_UTF8 && value >= 128) { | |
2202 | SvGROW(TARG,8); | |
2203 | tmps = SvPVX(TARG); | |
dfe13c55 | 2204 | tmps = (char*)uv_to_utf8((U8*)tmps, (UV)value); |
a0ed51b3 LW |
2205 | SvCUR_set(TARG, tmps - SvPVX(TARG)); |
2206 | *tmps = '\0'; | |
2207 | (void)SvPOK_only(TARG); | |
2208 | XPUSHs(TARG); | |
2209 | RETURN; | |
2210 | } | |
2211 | ||
748a9306 | 2212 | SvGROW(TARG,2); |
463ee0b2 LW |
2213 | SvCUR_set(TARG, 1); |
2214 | tmps = SvPVX(TARG); | |
a0ed51b3 | 2215 | *tmps++ = value; |
748a9306 | 2216 | *tmps = '\0'; |
a0d0e21e | 2217 | (void)SvPOK_only(TARG); |
463ee0b2 LW |
2218 | XPUSHs(TARG); |
2219 | RETURN; | |
2220 | } | |
2221 | ||
79072805 LW |
2222 | PP(pp_crypt) |
2223 | { | |
4e35701f | 2224 | djSP; dTARGET; dPOPTOPssrl; |
2d8e6c8d | 2225 | STRLEN n_a; |
79072805 | 2226 | #ifdef HAS_CRYPT |
2d8e6c8d | 2227 | char *tmps = SvPV(left, n_a); |
79072805 | 2228 | #ifdef FCRYPT |
2d8e6c8d | 2229 | sv_setpv(TARG, fcrypt(tmps, SvPV(right, n_a))); |
79072805 | 2230 | #else |
2d8e6c8d | 2231 | sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a))); |
79072805 LW |
2232 | #endif |
2233 | #else | |
cea2e8a9 | 2234 | DIE(aTHX_ |
79072805 LW |
2235 | "The crypt() function is unimplemented due to excessive paranoia."); |
2236 | #endif | |
2237 | SETs(TARG); | |
2238 | RETURN; | |
2239 | } | |
2240 | ||
2241 | PP(pp_ucfirst) | |
2242 | { | |
4e35701f | 2243 | djSP; |
79072805 | 2244 | SV *sv = TOPs; |
a0ed51b3 LW |
2245 | register U8 *s; |
2246 | STRLEN slen; | |
2247 | ||
dfe13c55 | 2248 | if (IN_UTF8 && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) { |
a0ed51b3 LW |
2249 | I32 ulen; |
2250 | U8 tmpbuf[10]; | |
2251 | U8 *tend; | |
2252 | UV uv = utf8_to_uv(s, &ulen); | |
2253 | ||
2254 | if (PL_op->op_private & OPpLOCALE) { | |
2255 | TAINT; | |
2256 | SvTAINTED_on(sv); | |
2257 | uv = toTITLE_LC_uni(uv); | |
2258 | } | |
2259 | else | |
2260 | uv = toTITLE_utf8(s); | |
2261 | ||
2262 | tend = uv_to_utf8(tmpbuf, uv); | |
2263 | ||
014822e4 | 2264 | if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) { |
a0ed51b3 | 2265 | dTARGET; |
dfe13c55 GS |
2266 | sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf); |
2267 | sv_catpvn(TARG, (char*)(s + ulen), slen - ulen); | |
a0ed51b3 LW |
2268 | SETs(TARG); |
2269 | } | |
2270 | else { | |
dfe13c55 | 2271 | s = (U8*)SvPV_force(sv, slen); |
a0ed51b3 LW |
2272 | Copy(tmpbuf, s, ulen, U8); |
2273 | } | |
a0ed51b3 | 2274 | } |
626727d5 | 2275 | else { |
014822e4 | 2276 | if (!SvPADTMP(sv) || SvREADONLY(sv)) { |
31351b04 JS |
2277 | dTARGET; |
2278 | sv_setsv(TARG, sv); | |
2279 | sv = TARG; | |
2280 | SETs(sv); | |
2281 | } | |
2282 | s = (U8*)SvPV_force(sv, slen); | |
2283 | if (*s) { | |
2284 | if (PL_op->op_private & OPpLOCALE) { | |
2285 | TAINT; | |
2286 | SvTAINTED_on(sv); | |
2287 | *s = toUPPER_LC(*s); | |
2288 | } | |
2289 | else | |
2290 | *s = toUPPER(*s); | |
bbce6d69 | 2291 | } |
bbce6d69 | 2292 | } |
31351b04 JS |
2293 | if (SvSMAGICAL(sv)) |
2294 | mg_set(sv); | |
79072805 LW |
2295 | RETURN; |
2296 | } | |
2297 | ||
2298 | PP(pp_lcfirst) | |
2299 | { | |
4e35701f | 2300 | djSP; |
79072805 | 2301 | SV *sv = TOPs; |
a0ed51b3 LW |
2302 | register U8 *s; |
2303 | STRLEN slen; | |
2304 | ||
dfe13c55 | 2305 | if (IN_UTF8 && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) { |
a0ed51b3 LW |
2306 | I32 ulen; |
2307 | U8 tmpbuf[10]; | |
2308 | U8 *tend; | |
2309 | UV uv = utf8_to_uv(s, &ulen); | |
2310 | ||
2311 | if (PL_op->op_private & OPpLOCALE) { | |
2312 | TAINT; | |
2313 | SvTAINTED_on(sv); | |
2314 | uv = toLOWER_LC_uni(uv); | |
2315 | } | |
2316 | else | |
2317 | uv = toLOWER_utf8(s); | |
2318 | ||
2319 | tend = uv_to_utf8(tmpbuf, uv); | |
2320 | ||
014822e4 | 2321 | if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) { |
a0ed51b3 | 2322 | dTARGET; |
dfe13c55 GS |
2323 | sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf); |
2324 | sv_catpvn(TARG, (char*)(s + ulen), slen - ulen); | |
a0ed51b3 LW |
2325 | SETs(TARG); |
2326 | } | |
2327 | else { | |
dfe13c55 | 2328 | s = (U8*)SvPV_force(sv, slen); |
a0ed51b3 LW |
2329 | Copy(tmpbuf, s, ulen, U8); |
2330 | } | |
a0ed51b3 | 2331 | } |
626727d5 | 2332 | else { |
014822e4 | 2333 | if (!SvPADTMP(sv) || SvREADONLY(sv)) { |
31351b04 JS |
2334 | dTARGET; |
2335 | sv_setsv(TARG, sv); | |
2336 | sv = TARG; | |
2337 | SETs(sv); | |
2338 | } | |
2339 | s = (U8*)SvPV_force(sv, slen); | |
2340 | if (*s) { | |
2341 | if (PL_op->op_private & OPpLOCALE) { | |
2342 | TAINT; | |
2343 | SvTAINTED_on(sv); | |
2344 | *s = toLOWER_LC(*s); | |
2345 | } | |
2346 | else | |
2347 | *s = toLOWER(*s); | |
bbce6d69 | 2348 | } |
31351b04 | 2349 | SETs(sv); |
bbce6d69 | 2350 | } |
31351b04 JS |
2351 | if (SvSMAGICAL(sv)) |
2352 | mg_set(sv); | |
79072805 LW |
2353 | RETURN; |
2354 | } | |
2355 | ||
2356 | PP(pp_uc) | |
2357 | { | |
4e35701f | 2358 | djSP; |
79072805 | 2359 | SV *sv = TOPs; |
a0ed51b3 | 2360 | register U8 *s; |
463ee0b2 | 2361 | STRLEN len; |
79072805 | 2362 | |
a0ed51b3 LW |
2363 | if (IN_UTF8) { |
2364 | dTARGET; | |
2365 | I32 ulen; | |
2366 | register U8 *d; | |
2367 | U8 *send; | |
2368 | ||
dfe13c55 | 2369 | s = (U8*)SvPV(sv,len); |
a5a20234 LW |
2370 | if (!len) { |
2371 | sv_setpvn(TARG, "", 0); | |
2372 | SETs(TARG); | |
a0ed51b3 LW |
2373 | } |
2374 | else { | |
31351b04 JS |
2375 | (void)SvUPGRADE(TARG, SVt_PV); |
2376 | SvGROW(TARG, (len * 2) + 1); | |
2377 | (void)SvPOK_only(TARG); | |
2378 | d = (U8*)SvPVX(TARG); | |
2379 | send = s + len; | |
2380 | if (PL_op->op_private & OPpLOCALE) { | |
2381 | TAINT; | |
2382 | SvTAINTED_on(TARG); | |
2383 | while (s < send) { | |
2384 | d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv(s, &ulen))); | |
2385 | s += ulen; | |
2386 | } | |
a0ed51b3 | 2387 | } |
31351b04 JS |
2388 | else { |
2389 | while (s < send) { | |
2390 | d = uv_to_utf8(d, toUPPER_utf8( s )); | |
2391 | s += UTF8SKIP(s); | |
2392 | } | |
a0ed51b3 | 2393 | } |
31351b04 JS |
2394 | *d = '\0'; |
2395 | SvCUR_set(TARG, d - (U8*)SvPVX(TARG)); | |
2396 | SETs(TARG); | |
a0ed51b3 | 2397 | } |
a0ed51b3 | 2398 | } |
626727d5 | 2399 | else { |
014822e4 | 2400 | if (!SvPADTMP(sv) || SvREADONLY(sv)) { |
31351b04 JS |
2401 | dTARGET; |
2402 | sv_setsv(TARG, sv); | |
2403 | sv = TARG; | |
2404 | SETs(sv); | |
2405 | } | |
2406 | s = (U8*)SvPV_force(sv, len); | |
2407 | if (len) { | |
2408 | register U8 *send = s + len; | |
2409 | ||
2410 | if (PL_op->op_private & OPpLOCALE) { | |
2411 | TAINT; | |
2412 | SvTAINTED_on(sv); | |
2413 | for (; s < send; s++) | |
2414 | *s = toUPPER_LC(*s); | |
2415 | } | |
2416 | else { | |
2417 | for (; s < send; s++) | |
2418 | *s = toUPPER(*s); | |
2419 | } | |
bbce6d69 | 2420 | } |
79072805 | 2421 | } |
31351b04 JS |
2422 | if (SvSMAGICAL(sv)) |
2423 | mg_set(sv); | |
79072805 LW |
2424 | RETURN; |
2425 | } | |
2426 | ||
2427 | PP(pp_lc) | |
2428 | { | |
4e35701f | 2429 | djSP; |
79072805 | 2430 | SV *sv = TOPs; |
a0ed51b3 | 2431 | register U8 *s; |
463ee0b2 | 2432 | STRLEN len; |
79072805 | 2433 | |
a0ed51b3 LW |
2434 | if (IN_UTF8) { |
2435 | dTARGET; | |
2436 | I32 ulen; | |
2437 | register U8 *d; | |
2438 | U8 *send; | |
2439 | ||
dfe13c55 | 2440 | s = (U8*)SvPV(sv,len); |
a5a20234 LW |
2441 | if (!len) { |
2442 | sv_setpvn(TARG, "", 0); | |
2443 | SETs(TARG); | |
a0ed51b3 LW |
2444 | } |
2445 | else { | |
31351b04 JS |
2446 | (void)SvUPGRADE(TARG, SVt_PV); |
2447 | SvGROW(TARG, (len * 2) + 1); | |
2448 | (void)SvPOK_only(TARG); | |
2449 | d = (U8*)SvPVX(TARG); | |
2450 | send = s + len; | |
2451 | if (PL_op->op_private & OPpLOCALE) { | |
2452 | TAINT; | |
2453 | SvTAINTED_on(TARG); | |
2454 | while (s < send) { | |
2455 | d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv(s, &ulen))); | |
2456 | s += ulen; | |
2457 | } | |
a0ed51b3 | 2458 | } |
31351b04 JS |
2459 | else { |
2460 | while (s < send) { | |
2461 | d = uv_to_utf8(d, toLOWER_utf8(s)); | |
2462 | s += UTF8SKIP(s); | |
2463 | } | |
a0ed51b3 | 2464 | } |
31351b04 JS |
2465 | *d = '\0'; |
2466 | SvCUR_set(TARG, d - (U8*)SvPVX(TARG)); | |
2467 | SETs(TARG); | |
a0ed51b3 | 2468 | } |
79072805 | 2469 | } |
626727d5 | 2470 | else { |
014822e4 | 2471 | if (!SvPADTMP(sv) || SvREADONLY(sv)) { |
31351b04 JS |
2472 | dTARGET; |
2473 | sv_setsv(TARG, sv); | |
2474 | sv = TARG; | |
2475 | SETs(sv); | |
a0ed51b3 | 2476 | } |
bbce6d69 | 2477 | |
31351b04 JS |
2478 | s = (U8*)SvPV_force(sv, len); |
2479 | if (len) { | |
2480 | register U8 *send = s + len; | |
bbce6d69 | 2481 | |
31351b04 JS |
2482 | if (PL_op->op_private & OPpLOCALE) { |
2483 | TAINT; | |
2484 | SvTAINTED_on(sv); | |
2485 | for (; s < send; s++) | |
2486 | *s = toLOWER_LC(*s); | |
2487 | } | |
2488 | else { | |
2489 | for (; s < send; s++) | |
2490 | *s = toLOWER(*s); | |
2491 | } | |
bbce6d69 | 2492 | } |
79072805 | 2493 | } |
31351b04 JS |
2494 | if (SvSMAGICAL(sv)) |
2495 | mg_set(sv); | |
79072805 LW |
2496 | RETURN; |
2497 | } | |
2498 | ||
a0d0e21e | 2499 | PP(pp_quotemeta) |
79072805 | 2500 | { |
4e35701f | 2501 | djSP; dTARGET; |
a0d0e21e LW |
2502 | SV *sv = TOPs; |
2503 | STRLEN len; | |
2504 | register char *s = SvPV(sv,len); | |
2505 | register char *d; | |
79072805 | 2506 | |
a0d0e21e LW |
2507 | if (len) { |
2508 | (void)SvUPGRADE(TARG, SVt_PV); | |
c07a80fd | 2509 | SvGROW(TARG, (len * 2) + 1); |
a0d0e21e | 2510 | d = SvPVX(TARG); |
0dd2cdef LW |
2511 | if (IN_UTF8) { |
2512 | while (len) { | |
2513 | if (*s & 0x80) { | |
2514 | STRLEN ulen = UTF8SKIP(s); | |
2515 | if (ulen > len) | |
2516 | ulen = len; | |
2517 | len -= ulen; | |
2518 | while (ulen--) | |
2519 | *d++ = *s++; | |
2520 | } | |
2521 | else { | |
2522 | if (!isALNUM(*s)) | |
2523 | *d++ = '\\'; | |
2524 | *d++ = *s++; | |
2525 | len--; | |
2526 | } | |
2527 | } | |
2528 | } | |
2529 | else { | |
2530 | while (len--) { | |
2531 | if (!isALNUM(*s)) | |
2532 | *d++ = '\\'; | |
2533 | *d++ = *s++; | |
2534 | } | |
79072805 | 2535 | } |
a0d0e21e LW |
2536 | *d = '\0'; |
2537 | SvCUR_set(TARG, d - SvPVX(TARG)); | |
2538 | (void)SvPOK_only(TARG); | |
79072805 | 2539 | } |
a0d0e21e LW |
2540 | else |
2541 | sv_setpvn(TARG, s, len); | |
2542 | SETs(TARG); | |
31351b04 JS |
2543 | if (SvSMAGICAL(TARG)) |
2544 | mg_set(TARG); | |
79072805 LW |
2545 | RETURN; |
2546 | } | |
2547 | ||
a0d0e21e | 2548 | /* Arrays. */ |
79072805 | 2549 | |
a0d0e21e | 2550 | PP(pp_aslice) |
79072805 | 2551 | { |
4e35701f | 2552 | djSP; dMARK; dORIGMARK; |
a0d0e21e LW |
2553 | register SV** svp; |
2554 | register AV* av = (AV*)POPs; | |
533c011a | 2555 | register I32 lval = PL_op->op_flags & OPf_MOD; |
3280af22 | 2556 | I32 arybase = PL_curcop->cop_arybase; |
748a9306 | 2557 | I32 elem; |
79072805 | 2558 | |
a0d0e21e | 2559 | if (SvTYPE(av) == SVt_PVAV) { |
533c011a | 2560 | if (lval && PL_op->op_private & OPpLVAL_INTRO) { |
748a9306 | 2561 | I32 max = -1; |
924508f0 | 2562 | for (svp = MARK + 1; svp <= SP; svp++) { |
748a9306 LW |
2563 | elem = SvIVx(*svp); |
2564 | if (elem > max) | |
2565 | max = elem; | |
2566 | } | |
2567 | if (max > AvMAX(av)) | |
2568 | av_extend(av, max); | |
2569 | } | |
a0d0e21e | 2570 | while (++MARK <= SP) { |
748a9306 | 2571 | elem = SvIVx(*MARK); |
a0d0e21e | 2572 | |
748a9306 LW |
2573 | if (elem > 0) |
2574 | elem -= arybase; | |
a0d0e21e LW |
2575 | svp = av_fetch(av, elem, lval); |
2576 | if (lval) { | |
3280af22 | 2577 | if (!svp || *svp == &PL_sv_undef) |
cea2e8a9 | 2578 | DIE(aTHX_ PL_no_aelem, elem); |
533c011a | 2579 | if (PL_op->op_private & OPpLVAL_INTRO) |
161b7d16 | 2580 | save_aelem(av, elem, svp); |
79072805 | 2581 | } |
3280af22 | 2582 | *MARK = svp ? *svp : &PL_sv_undef; |
79072805 LW |
2583 | } |
2584 | } | |
748a9306 | 2585 | if (GIMME != G_ARRAY) { |
a0d0e21e LW |
2586 | MARK = ORIGMARK; |
2587 | *++MARK = *SP; | |
2588 | SP = MARK; | |
2589 | } | |
79072805 LW |
2590 | RETURN; |
2591 | } | |
2592 | ||
2593 | /* Associative arrays. */ | |
2594 | ||
2595 | PP(pp_each) | |
2596 | { | |
59af0135 | 2597 | djSP; |
79072805 | 2598 | HV *hash = (HV*)POPs; |
c07a80fd | 2599 | HE *entry; |
54310121 | 2600 | I32 gimme = GIMME_V; |
c750a3ec | 2601 | I32 realhv = (SvTYPE(hash) == SVt_PVHV); |
8ec5e241 | 2602 | |
c07a80fd | 2603 | PUTBACK; |
c750a3ec MB |
2604 | /* might clobber stack_sp */ |
2605 | entry = realhv ? hv_iternext(hash) : avhv_iternext((AV*)hash); | |
c07a80fd | 2606 | SPAGAIN; |
79072805 | 2607 | |
79072805 LW |
2608 | EXTEND(SP, 2); |
2609 | if (entry) { | |
54310121 | 2610 | PUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */ |
2611 | if (gimme == G_ARRAY) { | |
59af0135 | 2612 | SV *val; |
c07a80fd | 2613 | PUTBACK; |
c750a3ec | 2614 | /* might clobber stack_sp */ |
59af0135 GS |
2615 | val = realhv ? |
2616 | hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry); | |
c07a80fd | 2617 | SPAGAIN; |
59af0135 | 2618 | PUSHs(val); |
79072805 | 2619 | } |
79072805 | 2620 | } |
54310121 | 2621 | else if (gimme == G_SCALAR) |
79072805 LW |
2622 | RETPUSHUNDEF; |
2623 | ||
2624 | RETURN; | |
2625 | } | |
2626 | ||
2627 | PP(pp_values) | |
2628 | { | |
cea2e8a9 | 2629 | return do_kv(); |
79072805 LW |
2630 | } |
2631 | ||
2632 | PP(pp_keys) | |
2633 | { | |
cea2e8a9 | 2634 | return do_kv(); |
79072805 LW |
2635 | } |
2636 | ||
2637 | PP(pp_delete) | |
2638 | { | |
4e35701f | 2639 | djSP; |
54310121 | 2640 | I32 gimme = GIMME_V; |
2641 | I32 discard = (gimme == G_VOID) ? G_DISCARD : 0; | |
79072805 | 2642 | SV *sv; |
5f05dabc | 2643 | HV *hv; |
2644 | ||
533c011a | 2645 | if (PL_op->op_private & OPpSLICE) { |
5f05dabc | 2646 | dMARK; dORIGMARK; |
97fcbf96 | 2647 | U32 hvtype; |
5f05dabc | 2648 | hv = (HV*)POPs; |
97fcbf96 | 2649 | hvtype = SvTYPE(hv); |
01020589 GS |
2650 | if (hvtype == SVt_PVHV) { /* hash element */ |
2651 | while (++MARK <= SP) { | |
ae77835f | 2652 | sv = hv_delete_ent(hv, *MARK, discard, 0); |
01020589 GS |
2653 | *MARK = sv ? sv : &PL_sv_undef; |
2654 | } | |
5f05dabc | 2655 | } |
01020589 GS |
2656 | else if (hvtype == SVt_PVAV) { |
2657 | if (PL_op->op_flags & OPf_SPECIAL) { /* array element */ | |
2658 | while (++MARK <= SP) { | |
2659 | sv = av_delete((AV*)hv, SvIV(*MARK), discard); | |
2660 | *MARK = sv ? sv : &PL_sv_undef; | |
2661 | } | |
2662 | } | |
2663 | else { /* pseudo-hash element */ | |
2664 | while (++MARK <= SP) { | |
2665 | sv = avhv_delete_ent((AV*)hv, *MARK, discard, 0); | |
2666 | *MARK = sv ? sv : &PL_sv_undef; | |
2667 | } | |
2668 | } | |
2669 | } | |
2670 | else | |
2671 | DIE(aTHX_ "Not a HASH reference"); | |
54310121 | 2672 | if (discard) |
2673 | SP = ORIGMARK; | |
2674 | else if (gimme == G_SCALAR) { | |
5f05dabc | 2675 | MARK = ORIGMARK; |
2676 | *++MARK = *SP; | |
2677 | SP = MARK; | |
2678 | } | |
2679 | } | |
2680 | else { | |
2681 | SV *keysv = POPs; | |
2682 | hv = (HV*)POPs; | |
97fcbf96 MB |
2683 | if (SvTYPE(hv) == SVt_PVHV) |
2684 | sv = hv_delete_ent(hv, keysv, discard, 0); | |
01020589 GS |
2685 | else if (SvTYPE(hv) == SVt_PVAV) { |
2686 | if (PL_op->op_flags & OPf_SPECIAL) | |
2687 | sv = av_delete((AV*)hv, SvIV(keysv), discard); | |
2688 | else | |
2689 | sv = avhv_delete_ent((AV*)hv, keysv, discard, 0); | |
2690 | } | |
97fcbf96 | 2691 | else |
cea2e8a9 | 2692 | DIE(aTHX_ "Not a HASH reference"); |
5f05dabc | 2693 | if (!sv) |
3280af22 | 2694 | sv = &PL_sv_undef; |
54310121 | 2695 | if (!discard) |
2696 | PUSHs(sv); | |
79072805 | 2697 | } |
79072805 LW |
2698 | RETURN; |
2699 | } | |
2700 | ||
a0d0e21e | 2701 | PP(pp_exists) |
79072805 | 2702 | { |
4e35701f | 2703 | djSP; |
afebc493 GS |
2704 | SV *tmpsv; |
2705 | HV *hv; | |
2706 | ||
2707 | if (PL_op->op_private & OPpEXISTS_SUB) { | |
2708 | GV *gv; | |
2709 | CV *cv; | |
2710 | SV *sv = POPs; | |
2711 | cv = sv_2cv(sv, &hv, &gv, FALSE); | |
2712 | if (cv) | |
2713 | RETPUSHYES; | |
2714 | if (gv && isGV(gv) && GvCV(gv) && !GvCVGEN(gv)) | |
2715 | RETPUSHYES; | |
2716 | RETPUSHNO; | |
2717 | } | |
2718 | tmpsv = POPs; | |
2719 | hv = (HV*)POPs; | |
c750a3ec | 2720 | if (SvTYPE(hv) == SVt_PVHV) { |
ae77835f | 2721 | if (hv_exists_ent(hv, tmpsv, 0)) |
c750a3ec | 2722 | RETPUSHYES; |
ef54e1a4 JH |
2723 | } |
2724 | else if (SvTYPE(hv) == SVt_PVAV) { | |
01020589 GS |
2725 | if (PL_op->op_flags & OPf_SPECIAL) { /* array element */ |
2726 | if (av_exists((AV*)hv, SvIV(tmpsv))) | |
2727 | RETPUSHYES; | |
2728 | } | |
2729 | else if (avhv_exists_ent((AV*)hv, tmpsv, 0)) /* pseudo-hash element */ | |
c750a3ec | 2730 | RETPUSHYES; |
ef54e1a4 JH |
2731 | } |
2732 | else { | |
cea2e8a9 | 2733 | DIE(aTHX_ "Not a HASH reference"); |
a0d0e21e | 2734 | } |
a0d0e21e LW |
2735 | RETPUSHNO; |
2736 | } | |
79072805 | 2737 | |
a0d0e21e LW |
2738 | PP(pp_hslice) |
2739 | { | |
4e35701f | 2740 | djSP; dMARK; dORIGMARK; |
a0d0e21e | 2741 | register HV *hv = (HV*)POPs; |
533c011a | 2742 | register I32 lval = PL_op->op_flags & OPf_MOD; |
c750a3ec | 2743 | I32 realhv = (SvTYPE(hv) == SVt_PVHV); |
79072805 | 2744 | |
0ebe0038 | 2745 | if (!realhv && PL_op->op_private & OPpLVAL_INTRO) |
cea2e8a9 | 2746 | DIE(aTHX_ "Can't localize pseudo-hash element"); |
0ebe0038 | 2747 | |
c750a3ec | 2748 | if (realhv || SvTYPE(hv) == SVt_PVAV) { |
a0d0e21e | 2749 | while (++MARK <= SP) { |
f12c7020 | 2750 | SV *keysv = *MARK; |
ae77835f MB |
2751 | SV **svp; |
2752 | if (realhv) { | |
800e9ae0 | 2753 | HE *he = hv_fetch_ent(hv, keysv, lval, 0); |
ae77835f | 2754 | svp = he ? &HeVAL(he) : 0; |
ef54e1a4 JH |
2755 | } |
2756 | else { | |
97fcbf96 | 2757 | svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0); |
ae77835f | 2758 | } |
a0d0e21e | 2759 | if (lval) { |
2d8e6c8d GS |
2760 | if (!svp || *svp == &PL_sv_undef) { |
2761 | STRLEN n_a; | |
cea2e8a9 | 2762 | DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a)); |
2d8e6c8d | 2763 | } |
533c011a | 2764 | if (PL_op->op_private & OPpLVAL_INTRO) |
800e9ae0 | 2765 | save_helem(hv, keysv, svp); |
93a17b20 | 2766 | } |
3280af22 | 2767 | *MARK = svp ? *svp : &PL_sv_undef; |
79072805 LW |
2768 | } |
2769 | } | |
a0d0e21e LW |
2770 | if (GIMME != G_ARRAY) { |
2771 | MARK = ORIGMARK; | |
2772 | *++MARK = *SP; | |
2773 | SP = MARK; | |
79072805 | 2774 | } |
a0d0e21e LW |
2775 | RETURN; |
2776 | } | |
2777 | ||
2778 | /* List operators. */ | |
2779 | ||
2780 | PP(pp_list) | |
2781 | { | |
4e35701f | 2782 | djSP; dMARK; |
a0d0e21e LW |
2783 | if (GIMME != G_ARRAY) { |
2784 | if (++MARK <= SP) | |
2785 | *MARK = *SP; /* unwanted list, return last item */ | |
8990e307 | 2786 | else |
3280af22 | 2787 | *MARK = &PL_sv_undef; |
a0d0e21e | 2788 | SP = MARK; |
79072805 | 2789 | } |
a0d0e21e | 2790 | RETURN; |
79072805 LW |
2791 | } |
2792 | ||
a0d0e21e | 2793 | PP(pp_lslice) |
79072805 | 2794 | { |
4e35701f | 2795 | djSP; |
3280af22 NIS |
2796 | SV **lastrelem = PL_stack_sp; |
2797 | SV **lastlelem = PL_stack_base + POPMARK; | |
2798 | SV **firstlelem = PL_stack_base + POPMARK + 1; | |
a0d0e21e | 2799 | register SV **firstrelem = lastlelem + 1; |
3280af22 | 2800 | I32 arybase = PL_curcop->cop_arybase; |
533c011a | 2801 | I32 lval = PL_op->op_flags & OPf_MOD; |
4633a7c4 | 2802 | I32 is_something_there = lval; |
79072805 | 2803 | |
a0d0e21e LW |
2804 | register I32 max = lastrelem - lastlelem; |
2805 | register SV **lelem; | |
2806 | register I32 ix; | |
2807 | ||
2808 | if (GIMME != G_ARRAY) { | |
748a9306 LW |
2809 | ix = SvIVx(*lastlelem); |
2810 | if (ix < 0) | |
2811 | ix += max; | |
2812 | else | |
2813 | ix -= arybase; | |
a0d0e21e | 2814 | if (ix < 0 || ix >= max) |
3280af22 | 2815 | *firstlelem = &PL_sv_undef; |
a0d0e21e LW |
2816 | else |
2817 | *firstlelem = firstrelem[ix]; | |
2818 | SP = firstlelem; | |
2819 | RETURN; | |
2820 | } | |
2821 | ||
2822 | if (max == 0) { | |
2823 | SP = firstlelem - 1; | |
2824 | RETURN; | |
2825 | } | |
2826 | ||
2827 | for (lelem = firstlelem; lelem <= lastlelem; lelem++) { | |
748a9306 | 2828 | ix = SvIVx(*lelem); |
c73bf8e3 | 2829 | if (ix < 0) |
a0d0e21e | 2830 | ix += max; |
c73bf8e3 | 2831 | else |
748a9306 | 2832 | ix -= arybase; |
c73bf8e3 HS |
2833 | if (ix < 0 || ix >= max) |
2834 | *lelem = &PL_sv_undef; | |
2835 | else { | |
2836 | is_something_there = TRUE; | |
2837 | if (!(*lelem = firstrelem[ix])) | |
3280af22 | 2838 | *lelem = &PL_sv_undef; |
748a9306 | 2839 | } |
79072805 | 2840 | } |
4633a7c4 LW |
2841 | if (is_something_there) |
2842 | SP = lastlelem; | |
2843 | else | |
2844 | SP = firstlelem - 1; | |
79072805 LW |
2845 | RETURN; |
2846 | } | |
2847 | ||
a0d0e21e LW |
2848 | PP(pp_anonlist) |
2849 | { | |
4e35701f | 2850 | djSP; dMARK; dORIGMARK; |
a0d0e21e | 2851 | I32 items = SP - MARK; |
44a8e56a | 2852 | SV *av = sv_2mortal((SV*)av_make(items, MARK+1)); |
2853 | SP = ORIGMARK; /* av_make() might realloc stack_sp */ | |
2854 | XPUSHs(av); | |
a0d0e21e LW |
2855 | RETURN; |
2856 | } | |
2857 | ||
2858 | PP(pp_anonhash) | |
79072805 | 2859 | { |
4e35701f | 2860 | djSP; dMARK; dORIGMARK; |
a0d0e21e LW |
2861 | HV* hv = (HV*)sv_2mortal((SV*)newHV()); |
2862 | ||
2863 | while (MARK < SP) { | |
2864 | SV* key = *++MARK; | |
a0d0e21e LW |
2865 | SV *val = NEWSV(46, 0); |
2866 | if (MARK < SP) | |
2867 | sv_setsv(val, *++MARK); | |
599cee73 | 2868 | else if (ckWARN(WARN_UNSAFE)) |
cea2e8a9 | 2869 | Perl_warner(aTHX_ WARN_UNSAFE, "Odd number of elements in hash assignment"); |
f12c7020 | 2870 | (void)hv_store_ent(hv,key,val,0); |
79072805 | 2871 | } |
a0d0e21e LW |
2872 | SP = ORIGMARK; |
2873 | XPUSHs((SV*)hv); | |
79072805 LW |
2874 | RETURN; |
2875 | } | |
2876 | ||
a0d0e21e | 2877 | PP(pp_splice) |
79072805 | 2878 | { |
4e35701f | 2879 | djSP; dMARK; dORIGMARK; |
a0d0e21e LW |
2880 | register AV *ary = (AV*)*++MARK; |
2881 | register SV **src; | |
2882 | register SV **dst; | |
2883 | register I32 i; | |
2884 | register I32 offset; | |
2885 | register I32 length; | |
2886 | I32 newlen; | |
2887 | I32 after; | |
2888 | I32 diff; | |
2889 | SV **tmparyval = 0; | |
93965878 NIS |
2890 | MAGIC *mg; |
2891 | ||
33c27489 GS |
2892 | if (mg = SvTIED_mg((SV*)ary, 'P')) { |
2893 | *MARK-- = SvTIED_obj((SV*)ary, mg); | |
93965878 | 2894 | PUSHMARK(MARK); |
8ec5e241 | 2895 | PUTBACK; |
a60c0954 | 2896 | ENTER; |
864dbfa3 | 2897 | call_method("SPLICE",GIMME_V); |
a60c0954 | 2898 | LEAVE; |
93965878 NIS |
2899 | SPAGAIN; |
2900 | RETURN; | |
2901 | } | |
79072805 | 2902 | |
a0d0e21e | 2903 | SP++; |
79072805 | 2904 | |
a0d0e21e | 2905 | if (++MARK < SP) { |
84902520 | 2906 | offset = i = SvIVx(*MARK); |
a0d0e21e | 2907 | if (offset < 0) |
93965878 | 2908 | offset += AvFILLp(ary) + 1; |
a0d0e21e | 2909 | else |
3280af22 | 2910 | offset -= PL_curcop->cop_arybase; |
84902520 | 2911 | if (offset < 0) |
cea2e8a9 | 2912 | DIE(aTHX_ PL_no_aelem, i); |
a0d0e21e LW |
2913 | if (++MARK < SP) { |
2914 | length = SvIVx(*MARK++); | |
48cdf507 GA |
2915 | if (length < 0) { |
2916 | length += AvFILLp(ary) - offset + 1; | |
2917 | if (length < 0) | |
2918 | length = 0; | |
2919 | } | |
79072805 LW |
2920 | } |
2921 | else | |
a0d0e21e | 2922 | length = AvMAX(ary) + 1; /* close enough to infinity */ |
79072805 | 2923 | } |
a0d0e21e LW |
2924 | else { |
2925 | offset = 0; | |
2926 | length = AvMAX(ary) + 1; | |
2927 | } | |
93965878 NIS |
2928 | if (offset > AvFILLp(ary) + 1) |
2929 | offset = AvFILLp(ary) + 1; | |
2930 | after = AvFILLp(ary) + 1 - (offset + length); | |
a0d0e21e LW |
2931 | if (after < 0) { /* not that much array */ |
2932 | length += after; /* offset+length now in array */ | |
2933 | after = 0; | |
2934 | if (!AvALLOC(ary)) | |
2935 | av_extend(ary, 0); | |
2936 | } | |
2937 | ||
2938 | /* At this point, MARK .. SP-1 is our new LIST */ | |
2939 | ||
2940 | newlen = SP - MARK; | |
2941 | diff = newlen - length; | |
13d7cbc1 GS |
2942 | if (newlen && !AvREAL(ary) && AvREIFY(ary)) |
2943 | av_reify(ary); | |
a0d0e21e LW |
2944 | |
2945 | if (diff < 0) { /* shrinking the area */ | |
2946 | if (newlen) { | |
2947 | New(451, tmparyval, newlen, SV*); /* so remember insertion */ | |
2948 | Copy(MARK, tmparyval, newlen, SV*); | |
79072805 | 2949 | } |
a0d0e21e LW |
2950 | |
2951 | MARK = ORIGMARK + 1; | |
2952 | if (GIMME == G_ARRAY) { /* copy return vals to stack */ | |
2953 | MEXTEND(MARK, length); | |
2954 | Copy(AvARRAY(ary)+offset, MARK, length, SV*); | |
2955 | if (AvREAL(ary)) { | |
bbce6d69 | 2956 | EXTEND_MORTAL(length); |
36477c24 | 2957 | for (i = length, dst = MARK; i; i--) { |
d689ffdd | 2958 | sv_2mortal(*dst); /* free them eventualy */ |
36477c24 | 2959 | dst++; |
2960 | } | |
a0d0e21e LW |
2961 | } |
2962 | MARK += length - 1; | |
79072805 | 2963 | } |
a0d0e21e LW |
2964 | else { |
2965 | *MARK = AvARRAY(ary)[offset+length-1]; | |
2966 | if (AvREAL(ary)) { | |
d689ffdd | 2967 | sv_2mortal(*MARK); |
a0d0e21e LW |
2968 | for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--) |
2969 | SvREFCNT_dec(*dst++); /* free them now */ | |
79072805 | 2970 | } |
a0d0e21e | 2971 | } |
93965878 | 2972 | AvFILLp(ary) += diff; |
a0d0e21e LW |
2973 | |
2974 | /* pull up or down? */ | |
2975 | ||
2976 | if (offset < after) { /* easier to pull up */ | |
2977 | if (offset) { /* esp. if nothing to pull */ | |
2978 | src = &AvARRAY(ary)[offset-1]; | |
2979 | dst = src - diff; /* diff is negative */ | |
2980 | for (i = offset; i > 0; i--) /* can't trust Copy */ | |
2981 | *dst-- = *src--; | |
79072805 | 2982 | } |
a0d0e21e LW |
2983 | dst = AvARRAY(ary); |
2984 | SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */ | |
2985 | AvMAX(ary) += diff; | |
2986 | } | |
2987 | else { | |
2988 | if (after) { /* anything to pull down? */ | |
2989 | src = AvARRAY(ary) + offset + length; | |
2990 | dst = src + diff; /* diff is negative */ | |
2991 | Move(src, dst, after, SV*); | |
79072805 | 2992 | } |
93965878 | 2993 | dst = &AvARRAY(ary)[AvFILLp(ary)+1]; |
a0d0e21e LW |
2994 | /* avoid later double free */ |
2995 | } | |
2996 | i = -diff; | |
2997 | while (i) | |
3280af22 | 2998 | dst[--i] = &PL_sv_undef; |
a0d0e21e LW |
2999 | |
3000 | if (newlen) { | |
3001 | for (src = tmparyval, dst = AvARRAY(ary) + offset; | |
3002 | newlen; newlen--) { | |
3003 | *dst = NEWSV(46, 0); | |
3004 | sv_setsv(*dst++, *src++); | |
79072805 | 3005 | } |
a0d0e21e LW |
3006 | Safefree(tmparyval); |
3007 | } | |
3008 | } | |
3009 | else { /* no, expanding (or same) */ | |
3010 | if (length) { | |
3011 | New(452, tmparyval, length, SV*); /* so remember deletion */ | |
3012 | Copy(AvARRAY(ary)+offset, tmparyval, length, SV*); | |
3013 | } | |
3014 | ||
3015 | if (diff > 0) { /* expanding */ | |
3016 | ||
3017 | /* push up or down? */ | |
3018 | ||
3019 | if (offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) { | |
3020 | if (offset) { | |
3021 | src = AvARRAY(ary); | |
3022 | dst = src - diff; | |
3023 | Move(src, dst, offset, SV*); | |
79072805 | 3024 | } |
a0d0e21e LW |
3025 | SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */ |
3026 | AvMAX(ary) += diff; | |
93965878 | 3027 | AvFILLp(ary) += diff; |
79072805 LW |
3028 | } |
3029 | else { | |
93965878 NIS |
3030 | if (AvFILLp(ary) + diff >= AvMAX(ary)) /* oh, well */ |
3031 | av_extend(ary, AvFILLp(ary) + diff); | |
3032 | AvFILLp(ary) += diff; | |
a0d0e21e LW |
3033 | |
3034 | if (after) { | |
93965878 | 3035 | dst = AvARRAY(ary) + AvFILLp(ary); |
a0d0e21e LW |
3036 | src = dst - diff; |
3037 | for (i = after; i; i--) { | |
3038 | *dst-- = *src--; | |
3039 | } | |
79072805 LW |
3040 | } |
3041 | } | |
a0d0e21e LW |
3042 | } |
3043 | ||
3044 | for (src = MARK, dst = AvARRAY(ary) + offset; newlen; newlen--) { | |
3045 | *dst = NEWSV(46, 0); | |
3046 | sv_setsv(*dst++, *src++); | |
3047 | } | |
3048 | MARK = ORIGMARK + 1; | |
3049 | if (GIMME == G_ARRAY) { /* copy return vals to stack */ | |
3050 | if (length) { | |
3051 | Copy(tmparyval, MARK, length, SV*); | |
3052 | if (AvREAL(ary)) { | |
bbce6d69 | 3053 | EXTEND_MORTAL(length); |
36477c24 | 3054 | for (i = length, dst = MARK; i; i--) { |
d689ffdd | 3055 | sv_2mortal(*dst); /* free them eventualy */ |
36477c24 | 3056 | dst++; |
3057 | } | |
79072805 | 3058 | } |
a0d0e21e | 3059 | Safefree(tmparyval); |
79072805 | 3060 | } |
a0d0e21e LW |
3061 | MARK += length - 1; |
3062 | } | |
3063 | else if (length--) { | |
3064 | *MARK = tmparyval[length]; | |
3065 | if (AvREAL(ary)) { | |
d689ffdd | 3066 | sv_2mortal(*MARK); |
a0d0e21e LW |
3067 | while (length-- > 0) |
3068 | SvREFCNT_dec(tmparyval[length]); | |
79072805 | 3069 | } |
a0d0e21e | 3070 | Safefree(tmparyval); |
79072805 | 3071 | } |
a0d0e21e | 3072 | else |
3280af22 | 3073 | *MARK = &PL_sv_undef; |
79072805 | 3074 | } |
a0d0e21e | 3075 | SP = MARK; |
79072805 LW |
3076 | RETURN; |
3077 | } | |
3078 | ||
a0d0e21e | 3079 | PP(pp_push) |
79072805 | 3080 | { |
4e35701f | 3081 | djSP; dMARK; dORIGMARK; dTARGET; |
a0d0e21e | 3082 | register AV *ary = (AV*)*++MARK; |
3280af22 | 3083 | register SV *sv = &PL_sv_undef; |
93965878 | 3084 | MAGIC *mg; |
79072805 | 3085 | |
33c27489 GS |
3086 | if (mg = SvTIED_mg((SV*)ary, 'P')) { |
3087 | *MARK-- = SvTIED_obj((SV*)ary, mg); | |
93965878 NIS |
3088 | PUSHMARK(MARK); |
3089 | PUTBACK; | |
a60c0954 | 3090 | ENTER; |
864dbfa3 | 3091 | call_method("PUSH",G_SCALAR|G_DISCARD); |
a60c0954 | 3092 | LEAVE; |
93965878 | 3093 | SPAGAIN; |
93965878 | 3094 | } |
a60c0954 NIS |
3095 | else { |
3096 | /* Why no pre-extend of ary here ? */ | |
3097 | for (++MARK; MARK <= SP; MARK++) { | |
3098 | sv = NEWSV(51, 0); | |
3099 | if (*MARK) | |
3100 | sv_setsv(sv, *MARK); | |
3101 | av_push(ary, sv); | |
3102 | } | |
79072805 LW |
3103 | } |
3104 | SP = ORIGMARK; | |
a0d0e21e | 3105 | PUSHi( AvFILL(ary) + 1 ); |
79072805 LW |
3106 | RETURN; |
3107 | } | |
3108 | ||
a0d0e21e | 3109 | PP(pp_pop) |
79072805 | 3110 | { |
4e35701f | 3111 | djSP; |
a0d0e21e LW |
3112 | AV *av = (AV*)POPs; |
3113 | SV *sv = av_pop(av); | |
d689ffdd | 3114 | if (AvREAL(av)) |
a0d0e21e LW |
3115 | (void)sv_2mortal(sv); |
3116 | PUSHs(sv); | |
79072805 | 3117 | RETURN; |
79072805 LW |
3118 | } |
3119 | ||
a0d0e21e | 3120 | PP(pp_shift) |
79072805 | 3121 | { |
4e35701f | 3122 | djSP; |
a0d0e21e LW |
3123 | AV *av = (AV*)POPs; |
3124 | SV *sv = av_shift(av); | |
79072805 | 3125 | EXTEND(SP, 1); |
a0d0e21e | 3126 | if (!sv) |
79072805 | 3127 | RETPUSHUNDEF; |
d689ffdd | 3128 | if (AvREAL(av)) |
a0d0e21e LW |
3129 | (void)sv_2mortal(sv); |
3130 | PUSHs(sv); | |
79072805 | 3131 | RETURN; |
79072805 LW |
3132 | } |
3133 | ||
a0d0e21e | 3134 | PP(pp_unshift) |
79072805 | 3135 | { |
4e35701f | 3136 | djSP; dMARK; dORIGMARK; dTARGET; |
a0d0e21e LW |
3137 | register AV *ary = (AV*)*++MARK; |
3138 | register SV *sv; | |
3139 | register I32 i = 0; | |
93965878 NIS |
3140 | MAGIC *mg; |
3141 | ||
33c27489 GS |
3142 | if (mg = SvTIED_mg((SV*)ary, 'P')) { |
3143 | *MARK-- = SvTIED_obj((SV*)ary, mg); | |
7fd66d9d | 3144 | PUSHMARK(MARK); |
93965878 | 3145 | PUTBACK; |
a60c0954 | 3146 | ENTER; |
864dbfa3 | 3147 | call_method("UNSHIFT",G_SCALAR|G_DISCARD); |
a60c0954 | 3148 | LEAVE; |
93965878 | 3149 | SPAGAIN; |
93965878 | 3150 | } |
a60c0954 NIS |
3151 | else { |
3152 | av_unshift(ary, SP - MARK); | |
3153 | while (MARK < SP) { | |
3154 | sv = NEWSV(27, 0); | |
3155 | sv_setsv(sv, *++MARK); | |
3156 | (void)av_store(ary, i++, sv); | |
3157 | } | |
79072805 | 3158 | } |
a0d0e21e LW |
3159 | SP = ORIGMARK; |
3160 | PUSHi( AvFILL(ary) + 1 ); | |
79072805 | 3161 | RETURN; |
79072805 LW |
3162 | } |
3163 | ||
a0d0e21e | 3164 | PP(pp_reverse) |
79072805 | 3165 | { |
4e35701f | 3166 | djSP; dMARK; |
a0d0e21e LW |
3167 | register SV *tmp; |
3168 | SV **oldsp = SP; | |
79072805 | 3169 | |
a0d0e21e LW |
3170 | if (GIMME == G_ARRAY) { |
3171 | MARK++; | |
3172 | while (MARK < SP) { | |
3173 | tmp = *MARK; | |
3174 | *MARK++ = *SP; | |
3175 | *SP-- = tmp; | |
3176 | } | |
dd58a1ab | 3177 | /* safe as long as stack cannot get extended in the above */ |
a0d0e21e | 3178 | SP = oldsp; |
79072805 LW |
3179 | } |
3180 | else { | |
a0d0e21e LW |
3181 | register char *up; |
3182 | register char *down; | |
3183 | register I32 tmp; | |
3184 | dTARGET; | |
3185 | STRLEN len; | |
79072805 | 3186 | |
a0d0e21e | 3187 | if (SP - MARK > 1) |
3280af22 | 3188 | do_join(TARG, &PL_sv_no, MARK, SP); |
a0d0e21e | 3189 | else |
54b9620d | 3190 | sv_setsv(TARG, (SP > MARK) ? *SP : DEFSV); |
a0d0e21e LW |
3191 | up = SvPV_force(TARG, len); |
3192 | if (len > 1) { | |
a0ed51b3 | 3193 | if (IN_UTF8) { /* first reverse each character */ |
dfe13c55 GS |
3194 | U8* s = (U8*)SvPVX(TARG); |
3195 | U8* send = (U8*)(s + len); | |
a0ed51b3 LW |
3196 | while (s < send) { |
3197 | if (*s < 0x80) { | |
3198 | s++; | |
3199 | continue; | |
3200 | } | |
3201 | else { | |
dfe13c55 | 3202 | up = (char*)s; |
a0ed51b3 | 3203 | s += UTF8SKIP(s); |
dfe13c55 | 3204 | down = (char*)(s - 1); |
f248d071 GS |
3205 | if (s > send || !((*down & 0xc0) == 0x80)) { |
3206 | if (ckWARN_d(WARN_UTF8)) | |
3207 | Perl_warner(aTHX_ WARN_UTF8, | |
3208 | "Malformed UTF-8 character"); | |
a0ed51b3 LW |
3209 | break; |
3210 | } | |
3211 | while (down > up) { | |
3212 | tmp = *up; | |
3213 | *up++ = *down; | |
3214 | *down-- = tmp; | |
3215 | } | |
3216 | } | |
3217 | } | |
3218 | up = SvPVX(TARG); | |
3219 | } | |
a0d0e21e LW |
3220 | down = SvPVX(TARG) + len - 1; |
3221 | while (down > up) { | |
3222 | tmp = *up; | |
3223 | *up++ = *down; | |
3224 | *down-- = tmp; | |
3225 | } | |
3226 | (void)SvPOK_only(TARG); | |
79072805 | 3227 | } |
a0d0e21e LW |
3228 | SP = MARK + 1; |
3229 | SETTARG; | |
79072805 | 3230 | } |
a0d0e21e | 3231 | RETURN; |
79072805 LW |
3232 | } |
3233 | ||
864dbfa3 | 3234 | STATIC SV * |
cea2e8a9 | 3235 | S_mul128(pTHX_ SV *sv, U8 m) |
55497cff | 3236 | { |
3237 | STRLEN len; | |
3238 | char *s = SvPV(sv, len); | |
3239 | char *t; | |
3240 | U32 i = 0; | |
3241 | ||
3242 | if (!strnEQ(s, "0000", 4)) { /* need to grow sv */ | |
79cb57f6 | 3243 | SV *tmpNew = newSVpvn("0000000000", 10); |
55497cff | 3244 | |
09b7f37c | 3245 | sv_catsv(tmpNew, sv); |
55497cff | 3246 | SvREFCNT_dec(sv); /* free old sv */ |
09b7f37c | 3247 | sv = tmpNew; |
55497cff | 3248 | s = SvPV(sv, len); |
3249 | } | |
3250 | t = s + len - 1; | |
3251 | while (!*t) /* trailing '\0'? */ | |
3252 | t--; | |
3253 | while (t > s) { | |
3254 | i = ((*t - '0') << 7) + m; | |
3255 | *(t--) = '0' + (i % 10); | |
3256 | m = i / 10; | |
3257 | } | |
3258 | return (sv); | |
3259 | } | |
3260 | ||
a0d0e21e LW |
3261 | /* Explosives and implosives. */ |
3262 | ||
9d116dd7 JH |
3263 | #if 'I' == 73 && 'J' == 74 |
3264 | /* On an ASCII/ISO kind of system */ | |
ba1ac976 | 3265 | #define ISUUCHAR(ch) ((ch) >= ' ' && (ch) < 'a') |
9d116dd7 JH |
3266 | #else |
3267 | /* | |
3268 | Some other sort of character set - use memchr() so we don't match | |
3269 | the null byte. | |
3270 | */ | |
80252599 | 3271 | #define ISUUCHAR(ch) (memchr(PL_uuemap, (ch), sizeof(PL_uuemap)-1) || (ch) == ' ') |
9d116dd7 JH |
3272 | #endif |
3273 | ||
a0d0e21e | 3274 | PP(pp_unpack) |
79072805 | 3275 | { |
4e35701f | 3276 | djSP; |
a0d0e21e | 3277 | dPOPPOPssrl; |
dd58a1ab | 3278 | I32 start_sp_offset = SP - PL_stack_base; |
54310121 | 3279 | I32 gimme = GIMME_V; |
ed6116ce | 3280 | SV *sv; |
a0d0e21e LW |
3281 | STRLEN llen; |
3282 | STRLEN rlen; | |
3283 | register char *pat = SvPV(left, llen); | |
3284 | register char *s = SvPV(right, rlen); | |
3285 | char *strend = s + rlen; | |
3286 | char *strbeg = s; | |
3287 | register char *patend = pat + llen; | |
3288 | I32 datumtype; | |
3289 | register I32 len; | |
3290 | register I32 bits; | |
abdc5761 | 3291 | register char *str; |
79072805 | 3292 | |
a0d0e21e LW |
3293 | /* These must not be in registers: */ |
3294 | I16 ashort; | |
3295 | int aint; | |
3296 | I32 along; | |
6b8eaf93 | 3297 | #ifdef HAS_QUAD |
ecfc5424 | 3298 | Quad_t aquad; |
a0d0e21e LW |
3299 | #endif |
3300 | U16 aushort; | |
3301 | unsigned int auint; | |
3302 | U32 aulong; | |
6b8eaf93 | 3303 | #ifdef HAS_QUAD |
e862df63 | 3304 | Uquad_t auquad; |
a0d0e21e LW |
3305 | #endif |
3306 | char *aptr; | |
3307 | float afloat; | |
3308 | double adouble; | |
3309 | I32 checksum = 0; | |
3310 | register U32 culong; | |
65202027 | 3311 | NV cdouble; |
fb73857a | 3312 | int commas = 0; |
4b5b2118 | 3313 | int star; |
726ea183 | 3314 | #ifdef PERL_NATINT_PACK |
ef54e1a4 JH |
3315 | int natint; /* native integer */ |
3316 | int unatint; /* unsigned native integer */ | |
726ea183 | 3317 | #endif |
79072805 | 3318 | |
54310121 | 3319 | if (gimme != G_ARRAY) { /* arrange to do first one only */ |
a0d0e21e LW |
3320 | /*SUPPRESS 530*/ |
3321 | for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ; | |
5a929a98 | 3322 | if (strchr("aAZbBhHP", *patend) || *pat == '%') { |
a0d0e21e LW |
3323 | patend++; |
3324 | while (isDIGIT(*patend) || *patend == '*') | |
3325 | patend++; | |
3326 | } | |
3327 | else | |
3328 | patend++; | |
79072805 | 3329 | } |
a0d0e21e LW |
3330 | while (pat < patend) { |
3331 | reparse: | |
bbdab043 | 3332 | datumtype = *pat++ & 0xFF; |
726ea183 | 3333 | #ifdef PERL_NATINT_PACK |
ef54e1a4 | 3334 | natint = 0; |
726ea183 | 3335 | #endif |
bbdab043 CS |
3336 | if (isSPACE(datumtype)) |
3337 | continue; | |
17f4a12d IZ |
3338 | if (datumtype == '#') { |
3339 | while (pat < patend && *pat != '\n') | |
3340 | pat++; | |
3341 | continue; | |
3342 | } | |
f61d411c | 3343 | if (*pat == '!') { |
ef54e1a4 JH |
3344 | char *natstr = "sSiIlL"; |
3345 | ||
3346 | if (strchr(natstr, datumtype)) { | |
726ea183 | 3347 | #ifdef PERL_NATINT_PACK |
ef54e1a4 | 3348 | natint = 1; |
726ea183 | 3349 | #endif |
ef54e1a4 JH |
3350 | pat++; |
3351 | } | |
3352 | else | |
d470f89e | 3353 | DIE(aTHX_ "'!' allowed only after types %s", natstr); |
ef54e1a4 | 3354 | } |
4b5b2118 | 3355 | star = 0; |
a0d0e21e LW |
3356 | if (pat >= patend) |
3357 | len = 1; | |
3358 | else if (*pat == '*') { | |
3359 | len = strend - strbeg; /* long enough */ | |
3360 | pat++; | |
4b5b2118 | 3361 | star = 1; |
a0d0e21e LW |
3362 | } |
3363 | else if (isDIGIT(*pat)) { | |
3364 | len = *pat++ - '0'; | |
06387354 | 3365 | while (isDIGIT(*pat)) { |
a0d0e21e | 3366 | len = (len * 10) + (*pat++ - '0'); |
06387354 | 3367 | if (len < 0) |
d470f89e | 3368 | DIE(aTHX_ "Repeat count in unpack overflows"); |
06387354 | 3369 | } |
a0d0e21e LW |
3370 | } |
3371 | else | |
3372 | len = (datumtype != '@'); | |
4b5b2118 | 3373 | redo_switch: |
a0d0e21e LW |
3374 | switch(datumtype) { |
3375 | default: | |
d470f89e | 3376 | DIE(aTHX_ "Invalid type in unpack: '%c'", (int)datumtype); |
fb73857a | 3377 | case ',': /* grandfather in commas but with a warning */ |
599cee73 | 3378 | if (commas++ == 0 && ckWARN(WARN_UNSAFE)) |
d470f89e GS |
3379 | Perl_warner(aTHX_ WARN_UNSAFE, |
3380 | "Invalid type in unpack: '%c'", (int)datumtype); | |
fb73857a | 3381 | break; |
a0d0e21e LW |
3382 | case '%': |
3383 | if (len == 1 && pat[-1] != '1') | |
3384 | len = 16; | |
3385 | checksum = len; | |
3386 | culong = 0; | |
3387 | cdouble = 0; | |
3388 | if (pat < patend) | |
3389 | goto reparse; | |
3390 | break; | |
3391 | case '@': | |
3392 | if (len > strend - strbeg) | |
cea2e8a9 | 3393 | DIE(aTHX_ "@ outside of string"); |
a0d0e21e LW |
3394 | s = strbeg + len; |
3395 | break; | |
3396 | case 'X': | |
3397 | if (len > s - strbeg) | |
cea2e8a9 | 3398 | DIE(aTHX_ "X outside of string"); |
a0d0e21e LW |
3399 | s -= len; |
3400 | break; | |
3401 | case 'x': | |
3402 | if (len > strend - s) | |
cea2e8a9 | 3403 | DIE(aTHX_ "x outside of string"); |
a0d0e21e LW |
3404 | s += len; |
3405 | break; | |
17f4a12d | 3406 | case '/': |
dd58a1ab | 3407 | if (start_sp_offset >= SP - PL_stack_base) |
17f4a12d | 3408 | DIE(aTHX_ "/ must follow a numeric type"); |
43192e07 IP |
3409 | datumtype = *pat++; |
3410 | if (*pat == '*') | |
3411 | pat++; /* ignore '*' for compatibility with pack */ | |
3412 | if (isDIGIT(*pat)) | |
17f4a12d | 3413 | DIE(aTHX_ "/ cannot take a count" ); |
43192e07 | 3414 | len = POPi; |
4b5b2118 GS |
3415 | star = 0; |
3416 | goto redo_switch; | |
a0d0e21e | 3417 | case 'A': |
5a929a98 | 3418 | case 'Z': |
a0d0e21e LW |
3419 | case 'a': |
3420 | if (len > strend - s) | |
3421 | len = strend - s; | |
3422 | if (checksum) | |
3423 | goto uchar_checksum; | |
3424 | sv = NEWSV(35, len); | |
3425 | sv_setpvn(sv, s, len); | |
3426 | s += len; | |
5a929a98 | 3427 | if (datumtype == 'A' || datumtype == 'Z') { |
a0d0e21e | 3428 | aptr = s; /* borrow register */ |
5a929a98 VU |
3429 | if (datumtype == 'Z') { /* 'Z' strips stuff after first null */ |
3430 | s = SvPVX(sv); | |
3431 | while (*s) | |
3432 | s++; | |
3433 | } | |
3434 | else { /* 'A' strips both nulls and spaces */ | |
3435 | s = SvPVX(sv) + len - 1; | |
3436 | while (s >= SvPVX(sv) && (!*s || isSPACE(*s))) | |
3437 | s--; | |
3438 | *++s = '\0'; | |
3439 | } | |
a0d0e21e LW |
3440 | SvCUR_set(sv, s - SvPVX(sv)); |
3441 | s = aptr; /* unborrow register */ | |
3442 | } | |
3443 | XPUSHs(sv_2mortal(sv)); | |
3444 | break; | |
3445 | case 'B': | |
3446 | case 'b': | |
4b5b2118 | 3447 | if (star || len > (strend - s) * 8) |
a0d0e21e LW |
3448 | len = (strend - s) * 8; |
3449 | if (checksum) { | |
80252599 GS |
3450 | if (!PL_bitcount) { |
3451 | Newz(601, PL_bitcount, 256, char); | |
a0d0e21e | 3452 | for (bits = 1; bits < 256; bits++) { |
80252599 GS |
3453 | if (bits & 1) PL_bitcount[bits]++; |
3454 | if (bits & 2) PL_bitcount[bits]++; | |
3455 | if (bits & 4) PL_bitcount[bits]++; | |
3456 | if (bits & 8) PL_bitcount[bits]++; | |
3457 | if (bits & 16) PL_bitcount[bits]++; | |
3458 | if (bits & 32) PL_bitcount[bits]++; | |
3459 | if (bits & 64) PL_bitcount[bits]++; | |
3460 | if (bits & 128) PL_bitcount[bits]++; | |
a0d0e21e LW |
3461 | } |
3462 | } | |
3463 | while (len >= 8) { | |
80252599 | 3464 | culong += PL_bitcount[*(unsigned char*)s++]; |
a0d0e21e LW |
3465 | len -= 8; |
3466 | } | |
3467 | if (len) { | |
3468 | bits = *s; | |
3469 | if (datumtype == 'b') { | |
3470 | while (len-- > 0) { | |
3471 | if (bits & 1) culong++; | |
3472 | bits >>= 1; | |
3473 | } | |
3474 | } | |
3475 | else { | |
3476 | while (len-- > 0) { | |
3477 | if (bits & 128) culong++; | |
3478 | bits <<= 1; | |
3479 | } | |
3480 | } | |
3481 | } | |
79072805 LW |
3482 | break; |
3483 | } | |
a0d0e21e LW |
3484 | sv = NEWSV(35, len + 1); |
3485 | SvCUR_set(sv, len); | |
3486 | SvPOK_on(sv); | |
abdc5761 | 3487 | str = SvPVX(sv); |
a0d0e21e LW |
3488 | if (datumtype == 'b') { |
3489 | aint = len; | |
3490 | for (len = 0; len < aint; len++) { | |
3491 | if (len & 7) /*SUPPRESS 595*/ | |
3492 | bits >>= 1; | |
3493 | else | |
3494 | bits = *s++; | |
abdc5761 | 3495 | *str++ = '0' + (bits & 1); |
a0d0e21e LW |
3496 | } |
3497 | } | |
3498 | else { | |
3499 | aint = len; | |
3500 | for (len = 0; len < aint; len++) { | |
3501 | if (len & 7) | |
3502 | bits <<= 1; | |
3503 | else | |
3504 | bits = *s++; | |
abdc5761 | 3505 | *str++ = '0' + ((bits & 128) != 0); |
a0d0e21e LW |
3506 | } |
3507 | } | |
abdc5761 | 3508 | *str = '\0'; |
a0d0e21e LW |
3509 | XPUSHs(sv_2mortal(sv)); |
3510 | break; | |
3511 | case 'H': | |
3512 | case 'h': | |
4b5b2118 | 3513 | if (star || len > (strend - s) * 2) |
a0d0e21e LW |
3514 | len = (strend - s) * 2; |
3515 | sv = NEWSV(35, len + 1); | |
3516 | SvCUR_set(sv, len); | |
3517 | SvPOK_on(sv); | |
abdc5761 | 3518 | str = SvPVX(sv); |
a0d0e21e LW |
3519 | if (datumtype == 'h') { |
3520 | aint = len; | |
3521 | for (len = 0; len < aint; len++) { | |
3522 | if (len & 1) | |
3523 | bits >>= 4; | |
3524 | else | |
3525 | bits = *s++; | |
abdc5761 | 3526 | *str++ = PL_hexdigit[bits & 15]; |
a0d0e21e LW |
3527 | } |
3528 | } | |
3529 | else { | |
3530 | aint = len; | |
3531 | for (len = 0; len < aint; len++) { | |
3532 | if (len & 1) | |
3533 | bits <<= 4; | |
3534 | else | |
3535 | bits = *s++; | |
abdc5761 | 3536 | *str++ = PL_hexdigit[(bits >> 4) & 15]; |
a0d0e21e LW |
3537 | } |
3538 | } | |
abdc5761 | 3539 | *str = '\0'; |
a0d0e21e LW |
3540 | XPUSHs(sv_2mortal(sv)); |
3541 | break; | |
3542 | case 'c': | |
3543 | if (len > strend - s) | |
3544 | len = strend - s; | |
3545 | if (checksum) { | |
3546 | while (len-- > 0) { | |
3547 | aint = *s++; | |
3548 | if (aint >= 128) /* fake up signed chars */ | |
3549 | aint -= 256; | |
3550 | culong += aint; | |
3551 | } | |
3552 | } | |
3553 | else { | |
3554 | EXTEND(SP, len); | |
bbce6d69 | 3555 | EXTEND_MORTAL(len); |
a0d0e21e LW |
3556 | while (len-- > 0) { |
3557 | aint = *s++; | |
3558 | if (aint >= 128) /* fake up signed chars */ | |
3559 | aint -= 256; | |
3560 | sv = NEWSV(36, 0); | |
1e422769 | 3561 | sv_setiv(sv, (IV)aint); |
a0d0e21e LW |
3562 | PUSHs(sv_2mortal(sv)); |
3563 | } | |
3564 | } | |
3565 | break; | |
3566 | case 'C': | |
3567 | if (len > strend - s) | |
3568 | len = strend - s; | |
3569 | if (checksum) { | |
3570 | uchar_checksum: | |
3571 | while (len-- > 0) { | |
3572 | auint = *s++ & 255; | |
3573 | culong += auint; | |
3574 | } | |
3575 | } | |
3576 | else { | |
3577 | EXTEND(SP, len); | |
bbce6d69 | 3578 | EXTEND_MORTAL(len); |
a0d0e21e LW |
3579 | while (len-- > 0) { |
3580 | auint = *s++ & 255; | |
3581 | sv = NEWSV(37, 0); | |
1e422769 | 3582 | sv_setiv(sv, (IV)auint); |
a0d0e21e LW |
3583 | PUSHs(sv_2mortal(sv)); |
3584 | } | |
3585 | } | |
3586 | break; | |
a0ed51b3 LW |
3587 | case 'U': |
3588 | if (len > strend - s) | |
3589 | len = strend - s; | |
3590 | if (checksum) { | |
3591 | while (len-- > 0 && s < strend) { | |
dfe13c55 | 3592 | auint = utf8_to_uv((U8*)s, &along); |
a0ed51b3 | 3593 | s += along; |
32d8b6e5 | 3594 | if (checksum > 32) |
65202027 | 3595 | cdouble += (NV)auint; |
32d8b6e5 GA |
3596 | else |
3597 | culong += auint; | |
a0ed51b3 LW |
3598 | } |
3599 | } | |
3600 | else { | |
3601 | EXTEND(SP, len); | |
3602 | EXTEND_MORTAL(len); | |
3603 | while (len-- > 0 && s < strend) { | |
dfe13c55 | 3604 | auint = utf8_to_uv((U8*)s, &along); |
a0ed51b3 LW |
3605 | s += along; |
3606 | sv = NEWSV(37, 0); | |
bdeef251 | 3607 | sv_setuv(sv, (UV)auint); |
a0ed51b3 LW |
3608 | PUSHs(sv_2mortal(sv)); |
3609 | } | |
3610 | } | |
3611 | break; | |
a0d0e21e | 3612 | case 's': |
726ea183 JH |
3613 | #if SHORTSIZE == SIZE16 |
3614 | along = (strend - s) / SIZE16; | |
3615 | #else | |
ef54e1a4 | 3616 | along = (strend - s) / (natint ? sizeof(short) : SIZE16); |
726ea183 | 3617 | #endif |
a0d0e21e LW |
3618 | if (len > along) |
3619 | len = along; | |
3620 | if (checksum) { | |
726ea183 | 3621 | #if SHORTSIZE != SIZE16 |
ef54e1a4 | 3622 | if (natint) { |
bf9315bb | 3623 | short ashort; |
ef54e1a4 JH |
3624 | while (len-- > 0) { |
3625 | COPYNN(s, &ashort, sizeof(short)); | |
3626 | s += sizeof(short); | |
3627 | culong += ashort; | |
3628 | ||
3629 | } | |
3630 | } | |
726ea183 JH |
3631 | else |
3632 | #endif | |
3633 | { | |
ef54e1a4 JH |
3634 | while (len-- > 0) { |
3635 | COPY16(s, &ashort); | |
c67712b2 JH |
3636 | #if SHORTSIZE > SIZE16 |
3637 | if (ashort > 32767) | |
3638 | ashort -= 65536; | |
3639 | #endif | |
ef54e1a4 JH |
3640 | s += SIZE16; |
3641 | culong += ashort; | |
3642 | } | |
a0d0e21e LW |
3643 | } |
3644 | } | |
3645 | else { | |
3646 | EXTEND(SP, len); | |
bbce6d69 | 3647 | EXTEND_MORTAL(len); |
726ea183 | 3648 | #if SHORTSIZE != SIZE16 |
ef54e1a4 | 3649 | if (natint) { |
bf9315bb | 3650 | short ashort; |
ef54e1a4 JH |
3651 | while (len-- > 0) { |
3652 | COPYNN(s, &ashort, sizeof(short)); | |
3653 | s += sizeof(short); | |
3654 | sv = NEWSV(38, 0); | |
3655 | sv_setiv(sv, (IV)ashort); | |
3656 | PUSHs(sv_2mortal(sv)); | |
3657 | } | |
3658 | } | |
726ea183 JH |
3659 | else |
3660 | #endif | |
3661 | { | |
ef54e1a4 JH |
3662 | while (len-- > 0) { |
3663 | COPY16(s, &ashort); | |
c67712b2 JH |
3664 | #if SHORTSIZE > SIZE16 |
3665 | if (ashort > 32767) | |
3666 | ashort -= 65536; | |
3667 | #endif | |
ef54e1a4 JH |
3668 | s += SIZE16; |
3669 | sv = NEWSV(38, 0); | |
3670 | sv_setiv(sv, (IV)ashort); | |
3671 | PUSHs(sv_2mortal(sv)); | |
3672 | } | |
a0d0e21e LW |
3673 | } |
3674 | } | |
3675 | break; | |
3676 | case 'v': | |
3677 | case 'n': | |
3678 | case 'S': | |
726ea183 JH |
3679 | #if SHORTSIZE == SIZE16 |
3680 | along = (strend - s) / SIZE16; | |
3681 | #else | |
ef54e1a4 JH |
3682 | unatint = natint && datumtype == 'S'; |
3683 | along = (strend - s) / (unatint ? sizeof(unsigned short) : SIZE16); | |
726ea183 | 3684 | #endif |
a0d0e21e LW |
3685 | if (len > along) |
3686 | len = along; | |
3687 | if (checksum) { | |
726ea183 | 3688 | #if SHORTSIZE != SIZE16 |
ef54e1a4 | 3689 | if (unatint) { |
bf9315bb | 3690 | unsigned short aushort; |
ef54e1a4 JH |
3691 | while (len-- > 0) { |
3692 | COPYNN(s, &aushort, sizeof(unsigned short)); | |
3693 | s += sizeof(unsigned short); | |
3694 | culong += aushort; | |
3695 | } | |
3696 | } | |
726ea183 JH |
3697 | else |
3698 | #endif | |
3699 | { | |
ef54e1a4 JH |
3700 | while (len-- > 0) { |
3701 | COPY16(s, &aushort); | |
3702 | s += SIZE16; | |
a0d0e21e | 3703 | #ifdef HAS_NTOHS |