This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
flip release & version in win32_uname()
[perl5.git] / doop.c
CommitLineData
a0d0e21e 1/* doop.c
79072805 2 *
4eb8286e 3 * Copyright (c) 1991-1999, Larry Wall
79072805
LW
4 *
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.
7 *
a0d0e21e
LW
8 */
9
10/*
11 * "'So that was the job I felt I had to do when I started,' thought Sam."
79072805
LW
12 */
13
14#include "EXTERN.h"
15#include "perl.h"
16
17#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
18#include <signal.h>
19#endif
20
942e002e
GS
21#ifndef PERL_OBJECT
22static I32 do_trans_CC_simple _((SV *sv));
23static I32 do_trans_CC_count _((SV *sv));
24static I32 do_trans_CC_complex _((SV *sv));
25static I32 do_trans_UU_simple _((SV *sv));
26static I32 do_trans_UU_count _((SV *sv));
27static I32 do_trans_UU_complex _((SV *sv));
28static I32 do_trans_UC_simple _((SV *sv));
29static I32 do_trans_CU_simple _((SV *sv));
30static I32 do_trans_UC_trivial _((SV *sv));
31static I32 do_trans_CU_trivial _((SV *sv));
32#endif
33
34STATIC I32
4757a243 35do_trans_CC_simple(SV *sv)
79072805 36{
11343788 37 dTHR;
4757a243
LW
38 U8 *s;
39 U8 *send;
40 I32 matches = 0;
463ee0b2 41 STRLEN len;
4757a243
LW
42 short *tbl;
43 I32 ch;
79072805 44
4757a243
LW
45 tbl = (short*)cPVOP->op_pv;
46 if (!tbl)
47 croak("panic: do_trans");
a0ed51b3 48
4757a243
LW
49 s = (U8*)SvPV(sv, len);
50 send = s + len;
51
52 while (s < send) {
53 if ((ch = tbl[*s]) >= 0) {
54 matches++;
55 *s = ch;
79072805 56 }
4757a243
LW
57 s++;
58 }
59 SvSETMAGIC(sv);
60
61 return matches;
62}
63
942e002e 64STATIC I32
4757a243
LW
65do_trans_CC_count(SV *sv)
66{
67 dTHR;
68 U8 *s;
69 U8 *send;
70 I32 matches = 0;
71 STRLEN len;
72 short *tbl;
73
74 tbl = (short*)cPVOP->op_pv;
75 if (!tbl)
76 croak("panic: do_trans");
77
78 s = (U8*)SvPV(sv, len);
79 send = s + len;
80
81 while (s < send) {
82 if (tbl[*s] >= 0)
83 matches++;
84 s++;
85 }
86
87 return matches;
88}
89
942e002e 90STATIC I32
4757a243
LW
91do_trans_CC_complex(SV *sv)
92{
93 dTHR;
94 U8 *s;
95 U8 *send;
96 U8 *d;
97 I32 matches = 0;
98 STRLEN len;
99 short *tbl;
100 I32 ch;
101
102 tbl = (short*)cPVOP->op_pv;
103 if (!tbl)
104 croak("panic: do_trans");
105
106 s = (U8*)SvPV(sv, len);
107 send = s + len;
108
109 d = s;
110 if (PL_op->op_private & OPpTRANS_SQUASH) {
111 U8* p = send;
112
113 while (s < send) {
114 if ((ch = tbl[*s]) >= 0) {
115 *d = ch;
116 matches++;
117 if (p == d - 1 && *p == *d)
118 matches--;
a0ed51b3 119 else
4757a243 120 p = d++;
a0ed51b3 121 }
4757a243
LW
122 else if (ch == -1) /* -1 is unmapped character */
123 *d++ = *s; /* -2 is delete character */
124 s++;
a0ed51b3 125 }
4757a243
LW
126 }
127 else {
128 while (s < send) {
129 if ((ch = tbl[*s]) >= 0) {
130 *d = ch;
131 matches++;
132 d++;
a0ed51b3 133 }
4757a243
LW
134 else if (ch == -1) /* -1 is unmapped character */
135 *d++ = *s; /* -2 is delete character */
136 s++;
5d06d08e 137 }
4757a243
LW
138 }
139 matches += send - d; /* account for disappeared chars */
140 *d = '\0';
141 SvCUR_set(sv, d - (U8*)SvPVX(sv));
142 SvSETMAGIC(sv);
143
144 return matches;
145}
146
942e002e 147STATIC I32
4757a243
LW
148do_trans_UU_simple(SV *sv)
149{
150 dTHR;
151 U8 *s;
152 U8 *send;
153 U8 *d;
154 I32 matches = 0;
155 STRLEN len;
156
157 SV* rv = (SV*)cSVOP->op_sv;
158 HV* hv = (HV*)SvRV(rv);
159 SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
160 UV none = svp ? SvUV(*svp) : 0x7fffffff;
161 UV extra = none + 1;
162 UV final;
163 UV uv;
164
165 s = (U8*)SvPV(sv, len);
166 send = s + len;
167
168 svp = hv_fetch(hv, "FINAL", 5, FALSE);
169 if (svp)
170 final = SvUV(*svp);
171
172 d = s;
173 while (s < send) {
174 if ((uv = swash_fetch(rv, s)) < none) {
175 s += UTF8SKIP(s);
176 matches++;
177 d = uv_to_utf8(d, uv);
178 }
179 else if (uv == none) {
180 int i;
181 for (i = UTF8SKIP(s); i; i--)
182 *d++ = *s++;
183 }
184 else if (uv == extra) {
185 s += UTF8SKIP(s);
186 matches++;
187 d = uv_to_utf8(d, final);
188 }
189 else
190 s += UTF8SKIP(s);
191 }
192 *d = '\0';
193 SvCUR_set(sv, d - (U8*)SvPVX(sv));
194 SvSETMAGIC(sv);
195
196 return matches;
197}
198
942e002e 199STATIC I32
4757a243
LW
200do_trans_UU_count(SV *sv)
201{
202 dTHR;
203 U8 *s;
204 U8 *send;
205 I32 matches = 0;
206 STRLEN len;
207
208 SV* rv = (SV*)cSVOP->op_sv;
209 HV* hv = (HV*)SvRV(rv);
210 SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
211 UV none = svp ? SvUV(*svp) : 0x7fffffff;
212 UV uv;
213
214 s = (U8*)SvPV(sv, len);
215 send = s + len;
216
217 while (s < send) {
834a4ddd 218 if ((uv = swash_fetch(rv, s)) < none)
4757a243 219 matches++;
834a4ddd 220 s += UTF8SKIP(s);
4757a243
LW
221 }
222
223 return matches;
224}
225
942e002e 226STATIC I32
4757a243
LW
227do_trans_UC_simple(SV *sv)
228{
229 dTHR;
230 U8 *s;
231 U8 *send;
232 U8 *d;
233 I32 matches = 0;
234 STRLEN len;
235
236 SV* rv = (SV*)cSVOP->op_sv;
237 HV* hv = (HV*)SvRV(rv);
238 SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
239 UV none = svp ? SvUV(*svp) : 0x7fffffff;
240 UV extra = none + 1;
241 UV final;
242 UV uv;
243
244 s = (U8*)SvPV(sv, len);
245 send = s + len;
246
247 svp = hv_fetch(hv, "FINAL", 5, FALSE);
248 if (svp)
249 final = SvUV(*svp);
250
251 d = s;
252 while (s < send) {
253 if ((uv = swash_fetch(rv, s)) < none) {
254 s += UTF8SKIP(s);
255 matches++;
256 *d++ = (U8)uv;
257 }
258 else if (uv == none) {
259 I32 ulen;
260 uv = utf8_to_uv(s, &ulen);
261 s += ulen;
262 *d++ = (U8)uv;
263 }
264 else if (uv == extra) {
265 s += UTF8SKIP(s);
266 matches++;
267 *d++ = (U8)final;
268 }
269 else
270 s += UTF8SKIP(s);
271 }
272 *d = '\0';
273 SvCUR_set(sv, d - (U8*)SvPVX(sv));
274 SvSETMAGIC(sv);
275
276 return matches;
277}
278
942e002e 279STATIC I32
4757a243
LW
280do_trans_CU_simple(SV *sv)
281{
282 dTHR;
283 U8 *s;
284 U8 *send;
285 U8 *d;
286 U8 *dst;
287 I32 matches = 0;
288 STRLEN len;
289
290 SV* rv = (SV*)cSVOP->op_sv;
291 HV* hv = (HV*)SvRV(rv);
292 SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
293 UV none = svp ? SvUV(*svp) : 0x7fffffff;
294 UV extra = none + 1;
295 UV final;
296 UV uv;
297 U8 tmpbuf[10];
298 I32 bits = 16;
299
300 s = (U8*)SvPV(sv, len);
301 send = s + len;
302
303 svp = hv_fetch(hv, "BITS", 4, FALSE);
304 if (svp)
305 bits = (I32)SvIV(*svp);
306
307 svp = hv_fetch(hv, "FINAL", 5, FALSE);
308 if (svp)
309 final = SvUV(*svp);
310
311 Newz(801, d, len * (bits >> 3) + 1, U8);
312 dst = d;
313
314 while (s < send) {
315 uv = *s++;
316 if (uv < 0x80)
317 tmpbuf[0] = uv;
318 else {
319 tmpbuf[0] = (( uv >> 6) | 0xc0);
320 tmpbuf[1] = (( uv & 0x3f) | 0x80);
a0ed51b3 321 }
4757a243
LW
322
323 if ((uv = swash_fetch(rv, tmpbuf)) < none) {
324 matches++;
325 d = uv_to_utf8(d, uv);
326 }
327 else if (uv == none)
328 d = uv_to_utf8(d, s[-1]);
329 else if (uv == extra) {
330 matches++;
331 d = uv_to_utf8(d, final);
332 }
333 }
334 *d = '\0';
335 sv_usepvn_mg(sv, (char*)dst, d - dst);
336
337 return matches;
338}
339
340/* utf-8 to latin-1 */
341
942e002e 342STATIC I32
4757a243
LW
343do_trans_UC_trivial(SV *sv)
344{
345 dTHR;
346 U8 *s;
347 U8 *send;
348 U8 *d;
349 STRLEN len;
350
351 s = (U8*)SvPV(sv, len);
352 send = s + len;
353
354 d = s;
355 while (s < send) {
356 if (*s < 0x80)
357 *d++ = *s++;
a0ed51b3 358 else {
4757a243
LW
359 I32 ulen;
360 UV uv = utf8_to_uv(s, &ulen);
361 s += ulen;
362 *d++ = (U8)uv;
363 }
364 }
365 *d = '\0';
366 SvCUR_set(sv, d - (U8*)SvPVX(sv));
367 SvSETMAGIC(sv);
a0ed51b3 368
4757a243
LW
369 return SvCUR(sv);
370}
a0ed51b3 371
4757a243 372/* latin-1 to utf-8 */
a0ed51b3 373
942e002e 374STATIC I32
4757a243
LW
375do_trans_CU_trivial(SV *sv)
376{
377 dTHR;
378 U8 *s;
379 U8 *send;
380 U8 *d;
381 U8 *dst;
382 I32 matches;
383 STRLEN len;
a0ed51b3 384
4757a243
LW
385 s = (U8*)SvPV(sv, len);
386 send = s + len;
387
388 Newz(801, d, len * 2 + 1, U8);
389 dst = d;
390
391 matches = send - s;
392
393 while (s < send) {
394 if (*s < 0x80)
395 *d++ = *s++;
396 else {
397 UV uv = *s++;
398 *d++ = (( uv >> 6) | 0xc0);
399 *d++ = (( uv & 0x3f) | 0x80);
400 }
401 }
402 *d = '\0';
403 sv_usepvn_mg(sv, (char*)dst, d - dst);
404
405 return matches;
406}
407
942e002e 408STATIC I32
4757a243
LW
409do_trans_UU_complex(SV *sv)
410{
411 dTHR;
412 U8 *s;
413 U8 *send;
414 U8 *d;
415 I32 matches = 0;
416 I32 squash = PL_op->op_private & OPpTRANS_SQUASH;
417 I32 from_utf = PL_op->op_private & OPpTRANS_FROM_UTF;
418 I32 to_utf = PL_op->op_private & OPpTRANS_TO_UTF;
419 I32 del = PL_op->op_private & OPpTRANS_DELETE;
420 SV* rv = (SV*)cSVOP->op_sv;
421 HV* hv = (HV*)SvRV(rv);
422 SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
423 UV none = svp ? SvUV(*svp) : 0x7fffffff;
424 UV extra = none + 1;
425 UV final;
426 UV uv;
427 STRLEN len;
428 U8 *dst;
429
430 s = (U8*)SvPV(sv, len);
431 send = s + len;
432
433 svp = hv_fetch(hv, "FINAL", 5, FALSE);
434 if (svp)
435 final = SvUV(*svp);
436
437 if (PL_op->op_private & OPpTRANS_GROWS) {
438 I32 bits = 16;
439
440 svp = hv_fetch(hv, "BITS", 4, FALSE);
441 if (svp)
442 bits = (I32)SvIV(*svp);
443
444 Newz(801, d, len * (bits >> 3) + 1, U8);
445 dst = d;
446 }
447 else {
448 d = s;
449 dst = 0;
450 }
451
452 if (squash) {
453 UV puv = 0xfeedface;
454 while (s < send) {
455 if (from_utf) {
456 uv = swash_fetch(rv, s);
a0ed51b3
LW
457 }
458 else {
4757a243
LW
459 U8 tmpbuf[2];
460 uv = *s++;
461 if (uv < 0x80)
462 tmpbuf[0] = uv;
463 else {
464 tmpbuf[0] = (( uv >> 6) | 0xc0);
465 tmpbuf[1] = (( uv & 0x3f) | 0x80);
466 }
467 uv = swash_fetch(rv, tmpbuf);
468 }
469 if (uv < none) {
470 matches++;
471 if (uv != puv) {
472 if (uv >= 0x80 && to_utf)
473 d = uv_to_utf8(d, uv);
474 else
475 *d++ = (U8)uv;
476 puv = uv;
477 }
478 if (from_utf)
479 s += UTF8SKIP(s);
480 continue;
481 }
482 else if (uv == none) { /* "none" is unmapped character */
483 if (from_utf) {
484 if (*s < 0x80)
485 *d++ = *s++;
486 else if (to_utf) {
a0ed51b3 487 int i;
4757a243
LW
488 for (i = UTF8SKIP(s); i; --i)
489 *d++ = *s++;
a0ed51b3 490 }
4757a243
LW
491 else {
492 I32 ulen;
493 *d++ = (U8)utf8_to_uv(s, &ulen);
494 s += ulen;
a0ed51b3 495 }
a0ed51b3 496 }
4757a243
LW
497 else { /* must be to_utf only */
498 d = uv_to_utf8(d, s[-1]);
499 }
500 puv = 0xfeedface;
501 continue;
a0ed51b3 502 }
4757a243
LW
503 else if (uv == extra && !del) {
504 matches++;
505 if (uv != puv) {
506 if (final >= 0x80 && to_utf)
507 d = uv_to_utf8(d, final);
508 else
509 *d++ = (U8)final;
510 puv = final;
511 }
512 if (from_utf)
513 s += UTF8SKIP(s);
514 continue;
515 }
516 matches++; /* "none+1" is delete character */
517 if (from_utf)
518 s += UTF8SKIP(s);
a0ed51b3 519 }
79072805
LW
520 }
521 else {
4757a243
LW
522 while (s < send) {
523 if (from_utf) {
524 uv = swash_fetch(rv, s);
525 }
526 else {
527 U8 tmpbuf[2];
528 uv = *s++;
529 if (uv < 0x80)
530 tmpbuf[0] = uv;
531 else {
532 tmpbuf[0] = (( uv >> 6) | 0xc0);
533 tmpbuf[1] = (( uv & 0x3f) | 0x80);
a0ed51b3 534 }
4757a243 535 uv = swash_fetch(rv, tmpbuf);
a0ed51b3 536 }
4757a243
LW
537 if (uv < none) {
538 matches++;
539 if (uv >= 0x80 && to_utf)
540 d = uv_to_utf8(d, uv);
541 else
542 *d++ = (U8)uv;
543 if (from_utf)
544 s += UTF8SKIP(s);
545 continue;
a0ed51b3 546 }
4757a243
LW
547 else if (uv == none) { /* "none" is unmapped character */
548 if (from_utf) {
549 if (*s < 0x80)
550 *d++ = *s++;
551 else if (to_utf) {
552 int i;
553 for (i = UTF8SKIP(s); i; --i)
554 *d++ = *s++;
555 }
556 else {
557 I32 ulen;
558 *d++ = (U8)utf8_to_uv(s, &ulen);
559 s += ulen;
a0ed51b3 560 }
79072805 561 }
4757a243
LW
562 else { /* must be to_utf only */
563 d = uv_to_utf8(d, s[-1]);
564 }
565 continue;
79072805 566 }
4757a243
LW
567 else if (uv == extra && !del) {
568 matches++;
569 if (final >= 0x80 && to_utf)
570 d = uv_to_utf8(d, final);
571 else
572 *d++ = (U8)final;
573 if (from_utf)
574 s += UTF8SKIP(s);
575 continue;
576 }
577 matches++; /* "none+1" is delete character */
578 if (from_utf)
579 s += UTF8SKIP(s);
79072805 580 }
4757a243
LW
581 }
582 if (dst)
583 sv_usepvn(sv, (char*)dst, d - dst);
584 else {
585 *d = '\0';
586 SvCUR_set(sv, d - (U8*)SvPVX(sv));
587 }
588 SvSETMAGIC(sv);
589
590 return matches;
591}
592
593I32
594do_trans(SV *sv)
595{
46124e9e 596 dTHR;
4757a243
LW
597 STRLEN len;
598
599 if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_IDENTICAL))
22c35a8c 600 croak(PL_no_modify);
4757a243
LW
601
602 (void)SvPV(sv, len);
603 if (!len)
604 return 0;
605 if (!SvPOKp(sv))
606 (void)SvPV_force(sv, len);
607 (void)SvPOK_only(sv);
608
609 DEBUG_t( deb("2.TBL\n"));
610
611 switch (PL_op->op_private & 63) {
612 case 0:
613 return do_trans_CC_simple(sv);
614
615 case OPpTRANS_FROM_UTF:
616 return do_trans_UC_simple(sv);
617
618 case OPpTRANS_TO_UTF:
619 return do_trans_CU_simple(sv);
620
621 case OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF:
622 return do_trans_UU_simple(sv);
623
624 case OPpTRANS_IDENTICAL:
625 return do_trans_CC_count(sv);
626
627 case OPpTRANS_FROM_UTF|OPpTRANS_IDENTICAL:
628 return do_trans_UC_trivial(sv);
629
630 case OPpTRANS_TO_UTF|OPpTRANS_IDENTICAL:
631 return do_trans_CU_trivial(sv);
632
633 case OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF|OPpTRANS_IDENTICAL:
634 return do_trans_UU_count(sv);
635
636 default:
637 if (PL_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF))
638 return do_trans_UU_complex(sv); /* could be UC or CU too */
639 else
640 return do_trans_CC_complex(sv);
79072805 641 }
79072805
LW
642}
643
644void
8ac85365 645do_join(register SV *sv, SV *del, register SV **mark, register SV **sp)
79072805
LW
646{
647 SV **oldmark = mark;
648 register I32 items = sp - mark;
79072805 649 register STRLEN len;
463ee0b2
LW
650 STRLEN delimlen;
651 register char *delim = SvPV(del, delimlen);
652 STRLEN tmplen;
79072805
LW
653
654 mark++;
655 len = (items > 0 ? (delimlen * (items - 1) ) : 0);
07f14f54 656 (void)SvUPGRADE(sv, SVt_PV);
79072805
LW
657 if (SvLEN(sv) < len + items) { /* current length is way too short */
658 while (items-- > 0) {
48c036b1 659 if (*mark && !SvGMAGICAL(*mark) && SvOK(*mark)) {
463ee0b2
LW
660 SvPV(*mark, tmplen);
661 len += tmplen;
79072805
LW
662 }
663 mark++;
664 }
665 SvGROW(sv, len + 1); /* so try to pre-extend */
666
667 mark = oldmark;
668 items = sp - mark;;
669 ++mark;
670 }
671
463ee0b2 672 if (items-- > 0) {
8990e307
LW
673 char *s;
674
675 if (*mark) {
676 s = SvPV(*mark, tmplen);
677 sv_setpvn(sv, s, tmplen);
678 }
679 else
680 sv_setpv(sv, "");
463ee0b2
LW
681 mark++;
682 }
79072805
LW
683 else
684 sv_setpv(sv,"");
685 len = delimlen;
686 if (len) {
687 for (; items > 0; items--,mark++) {
688 sv_catpvn(sv,delim,len);
689 sv_catsv(sv,*mark);
690 }
691 }
692 else {
693 for (; items > 0; items--,mark++)
694 sv_catsv(sv,*mark);
695 }
696 SvSETMAGIC(sv);
697}
698
699void
8ac85365 700do_sprintf(SV *sv, I32 len, SV **sarg)
79072805 701{
46fc3d4c 702 STRLEN patlen;
703 char *pat = SvPV(*sarg, patlen);
704 bool do_taint = FALSE;
705
706 sv_vsetpvfn(sv, pat, patlen, Null(va_list*), sarg + 1, len - 1, &do_taint);
79072805 707 SvSETMAGIC(sv);
46fc3d4c 708 if (do_taint)
709 SvTAINTED_on(sv);
79072805
LW
710}
711
712void
8ac85365 713do_vecset(SV *sv)
79072805
LW
714{
715 SV *targ = LvTARG(sv);
716 register I32 offset;
717 register I32 size;
8990e307
LW
718 register unsigned char *s;
719 register unsigned long lval;
79072805 720 I32 mask;
a0d0e21e
LW
721 STRLEN targlen;
722 STRLEN len;
79072805 723
8990e307
LW
724 if (!targ)
725 return;
a0d0e21e 726 s = (unsigned char*)SvPV_force(targ, targlen);
8990e307 727 lval = U_L(SvNV(sv));
79072805
LW
728 offset = LvTARGOFF(sv);
729 size = LvTARGLEN(sv);
a0d0e21e
LW
730
731 len = (offset + size + 7) / 8;
732 if (len > targlen) {
733 s = (unsigned char*)SvGROW(targ, len + 1);
734 (void)memzero(s + targlen, len - targlen + 1);
735 SvCUR_set(targ, len);
736 }
737
79072805
LW
738 if (size < 8) {
739 mask = (1 << size) - 1;
740 size = offset & 7;
741 lval &= mask;
742 offset >>= 3;
743 s[offset] &= ~(mask << size);
744 s[offset] |= lval << size;
745 }
746 else {
a0d0e21e 747 offset >>= 3;
79072805
LW
748 if (size == 8)
749 s[offset] = lval & 255;
750 else if (size == 16) {
751 s[offset] = (lval >> 8) & 255;
752 s[offset+1] = lval & 255;
753 }
754 else if (size == 32) {
755 s[offset] = (lval >> 24) & 255;
756 s[offset+1] = (lval >> 16) & 255;
757 s[offset+2] = (lval >> 8) & 255;
758 s[offset+3] = lval & 255;
759 }
760 }
761}
762
763void
8ac85365 764do_chop(register SV *astr, register SV *sv)
79072805 765{
463ee0b2 766 STRLEN len;
a0d0e21e 767 char *s;
c485e607 768 dTHR;
a0d0e21e 769
79072805 770 if (SvTYPE(sv) == SVt_PVAV) {
a0d0e21e
LW
771 register I32 i;
772 I32 max;
773 AV* av = (AV*)sv;
774 max = AvFILL(av);
775 for (i = 0; i <= max; i++) {
776 sv = (SV*)av_fetch(av, i, FALSE);
3280af22 777 if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
a0d0e21e
LW
778 do_chop(astr, sv);
779 }
780 return;
79072805
LW
781 }
782 if (SvTYPE(sv) == SVt_PVHV) {
a0d0e21e
LW
783 HV* hv = (HV*)sv;
784 HE* entry;
785 (void)hv_iterinit(hv);
786 /*SUPPRESS 560*/
787 while (entry = hv_iternext(hv))
788 do_chop(astr,hv_iterval(hv,entry));
789 return;
79072805 790 }
a0d0e21e 791 s = SvPV(sv, len);
748a9306 792 if (len && !SvPOK(sv))
a0d0e21e 793 s = SvPV_force(sv, len);
a0ed51b3
LW
794 if (IN_UTF8) {
795 if (s && len) {
796 char *send = s + len;
797 char *start = s;
798 s = send - 1;
799 while ((*s & 0xc0) == 0x80)
800 --s;
801 if (UTF8SKIP(s) != send - s)
802 warn("Malformed UTF-8 character");
803 sv_setpvn(astr, s, send - s);
804 *s = '\0';
805 SvCUR_set(sv, s - start);
806 SvNIOK_off(sv);
807 }
808 else
809 sv_setpvn(astr, "", 0);
810 }
811 else
a0d0e21e
LW
812 if (s && len) {
813 s += --len;
814 sv_setpvn(astr, s, 1);
815 *s = '\0';
816 SvCUR_set(sv, len);
817 SvNIOK_off(sv);
79072805
LW
818 }
819 else
a0d0e21e
LW
820 sv_setpvn(astr, "", 0);
821 SvSETMAGIC(sv);
822}
823
824I32
8ac85365 825do_chomp(register SV *sv)
a0d0e21e 826{
aeea060c 827 dTHR;
c07a80fd 828 register I32 count;
a0d0e21e
LW
829 STRLEN len;
830 char *s;
c07a80fd 831
3280af22 832 if (RsSNARF(PL_rs))
c07a80fd 833 return 0;
834 count = 0;
a0d0e21e
LW
835 if (SvTYPE(sv) == SVt_PVAV) {
836 register I32 i;
837 I32 max;
838 AV* av = (AV*)sv;
839 max = AvFILL(av);
840 for (i = 0; i <= max; i++) {
841 sv = (SV*)av_fetch(av, i, FALSE);
3280af22 842 if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
a0d0e21e
LW
843 count += do_chomp(sv);
844 }
845 return count;
846 }
847 if (SvTYPE(sv) == SVt_PVHV) {
848 HV* hv = (HV*)sv;
849 HE* entry;
850 (void)hv_iterinit(hv);
851 /*SUPPRESS 560*/
852 while (entry = hv_iternext(hv))
853 count += do_chomp(hv_iterval(hv,entry));
854 return count;
855 }
856 s = SvPV(sv, len);
857 if (len && !SvPOKp(sv))
858 s = SvPV_force(sv, len);
859 if (s && len) {
860 s += --len;
3280af22 861 if (RsPARA(PL_rs)) {
a0d0e21e
LW
862 if (*s != '\n')
863 goto nope;
864 ++count;
865 while (len && s[-1] == '\n') {
866 --len;
867 --s;
868 ++count;
869 }
870 }
a0d0e21e 871 else {
c07a80fd 872 STRLEN rslen;
3280af22 873 char *rsptr = SvPV(PL_rs, rslen);
c07a80fd 874 if (rslen == 1) {
875 if (*s != *rsptr)
876 goto nope;
877 ++count;
878 }
879 else {
8c2cee6f 880 if (len < rslen - 1)
c07a80fd 881 goto nope;
882 len -= rslen - 1;
883 s -= rslen - 1;
36477c24 884 if (memNE(s, rsptr, rslen))
c07a80fd 885 goto nope;
886 count += rslen;
887 }
a0d0e21e 888 }
a0d0e21e
LW
889 *s = '\0';
890 SvCUR_set(sv, len);
891 SvNIOK_off(sv);
892 }
893 nope:
894 SvSETMAGIC(sv);
895 return count;
896}
79072805
LW
897
898void
8ac85365 899do_vop(I32 optype, SV *sv, SV *left, SV *right)
79072805 900{
aeea060c 901 dTHR; /* just for taint */
79072805
LW
902#ifdef LIBERAL
903 register long *dl;
904 register long *ll;
905 register long *rl;
906#endif
907 register char *dc;
463ee0b2
LW
908 STRLEN leftlen;
909 STRLEN rightlen;
7a4c00b4 910 register char *lc;
911 register char *rc;
79072805 912 register I32 len;
a0d0e21e 913 I32 lensave;
7a4c00b4 914 char *lsave;
915 char *rsave;
79072805 916
1fbd88dc
CS
917 if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
918 sv_setpvn(sv, "", 0); /* avoid undef warning on |= and ^= */
7a4c00b4 919 lsave = lc = SvPV(left, leftlen);
920 rsave = rc = SvPV(right, rightlen);
93a17b20 921 len = leftlen < rightlen ? leftlen : rightlen;
a0d0e21e 922 lensave = len;
7a4c00b4 923 if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
2d8e6c8d
GS
924 STRLEN n_a;
925 dc = SvPV_force(sv, n_a);
ff68c719 926 if (SvCUR(sv) < len) {
927 dc = SvGROW(sv, len + 1);
928 (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
929 }
930 }
931 else {
932 I32 needlen = ((optype == OP_BIT_AND)
933 ? len : (leftlen > rightlen ? leftlen : rightlen));
934 Newz(801, dc, needlen + 1, char);
935 (void)sv_usepvn(sv, dc, needlen);
936 dc = SvPVX(sv); /* sv_usepvn() calls Renew() */
79072805 937 }
a0d0e21e
LW
938 SvCUR_set(sv, len);
939 (void)SvPOK_only(sv);
79072805
LW
940#ifdef LIBERAL
941 if (len >= sizeof(long)*4 &&
942 !((long)dc % sizeof(long)) &&
943 !((long)lc % sizeof(long)) &&
944 !((long)rc % sizeof(long))) /* It's almost always aligned... */
945 {
946 I32 remainder = len % (sizeof(long)*4);
947 len /= (sizeof(long)*4);
948
949 dl = (long*)dc;
950 ll = (long*)lc;
951 rl = (long*)rc;
952
953 switch (optype) {
954 case OP_BIT_AND:
955 while (len--) {
956 *dl++ = *ll++ & *rl++;
957 *dl++ = *ll++ & *rl++;
958 *dl++ = *ll++ & *rl++;
959 *dl++ = *ll++ & *rl++;
960 }
961 break;
a0d0e21e 962 case OP_BIT_XOR:
79072805
LW
963 while (len--) {
964 *dl++ = *ll++ ^ *rl++;
965 *dl++ = *ll++ ^ *rl++;
966 *dl++ = *ll++ ^ *rl++;
967 *dl++ = *ll++ ^ *rl++;
968 }
969 break;
970 case OP_BIT_OR:
971 while (len--) {
972 *dl++ = *ll++ | *rl++;
973 *dl++ = *ll++ | *rl++;
974 *dl++ = *ll++ | *rl++;
975 *dl++ = *ll++ | *rl++;
976 }
977 }
978
979 dc = (char*)dl;
980 lc = (char*)ll;
981 rc = (char*)rl;
982
983 len = remainder;
984 }
985#endif
a0d0e21e 986 {
a0d0e21e
LW
987 switch (optype) {
988 case OP_BIT_AND:
989 while (len--)
990 *dc++ = *lc++ & *rc++;
991 break;
992 case OP_BIT_XOR:
993 while (len--)
994 *dc++ = *lc++ ^ *rc++;
995 goto mop_up;
996 case OP_BIT_OR:
997 while (len--)
998 *dc++ = *lc++ | *rc++;
999 mop_up:
1000 len = lensave;
1001 if (rightlen > len)
1002 sv_catpvn(sv, rsave + len, rightlen - len);
1003 else if (leftlen > len)
1004 sv_catpvn(sv, lsave + len, leftlen - len);
4633a7c4
LW
1005 else
1006 *SvEND(sv) = '\0';
a0d0e21e
LW
1007 break;
1008 }
79072805 1009 }
fb73857a 1010 SvTAINT(sv);
79072805 1011}
463ee0b2
LW
1012
1013OP *
8ac85365 1014do_kv(ARGSproto)
463ee0b2 1015{
4e35701f 1016 djSP;
463ee0b2 1017 HV *hv = (HV*)POPs;
800e9ae0 1018 HV *keys;
463ee0b2 1019 register HE *entry;
463ee0b2 1020 SV *tmpstr;
54310121 1021 I32 gimme = GIMME_V;
533c011a
NIS
1022 I32 dokeys = (PL_op->op_type == OP_KEYS);
1023 I32 dovalues = (PL_op->op_type == OP_VALUES);
c750a3ec
MB
1024 I32 realhv = (SvTYPE(hv) == SVt_PVHV);
1025
533c011a 1026 if (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV)
a0d0e21e 1027 dokeys = dovalues = TRUE;
463ee0b2 1028
85581909 1029 if (!hv) {
533c011a 1030 if (PL_op->op_flags & OPf_MOD) { /* lvalue */
85581909
SB
1031 dTARGET; /* make sure to clear its target here */
1032 if (SvTYPE(TARG) == SVt_PVLV)
1033 LvTARG(TARG) = Nullsv;
1034 PUSHs(TARG);
1035 }
463ee0b2 1036 RETURN;
85581909 1037 }
748a9306 1038
800e9ae0
JP
1039 keys = realhv ? hv : avhv_keys((AV*)hv);
1040 (void)hv_iterinit(keys); /* always reset iterator regardless */
748a9306 1041
54310121 1042 if (gimme == G_VOID)
aa689395 1043 RETURN;
1044
54310121 1045 if (gimme == G_SCALAR) {
6ee623d5 1046 IV i;
463ee0b2
LW
1047 dTARGET;
1048
533c011a 1049 if (PL_op->op_flags & OPf_MOD) { /* lvalue */
85581909
SB
1050 if (SvTYPE(TARG) < SVt_PVLV) {
1051 sv_upgrade(TARG, SVt_PVLV);
1052 sv_magic(TARG, Nullsv, 'k', Nullch, 0);
1053 }
1054 LvTYPE(TARG) = 'k';
800e9ae0 1055 if (LvTARG(TARG) != (SV*)keys) {
6ff81951
GS
1056 if (LvTARG(TARG))
1057 SvREFCNT_dec(LvTARG(TARG));
800e9ae0 1058 LvTARG(TARG) = SvREFCNT_inc(keys);
6ff81951 1059 }
85581909
SB
1060 PUSHs(TARG);
1061 RETURN;
1062 }
1063
33c27489 1064 if (! SvTIED_mg((SV*)keys, 'P'))
800e9ae0 1065 i = HvKEYS(keys);
463ee0b2
LW
1066 else {
1067 i = 0;
463ee0b2 1068 /*SUPPRESS 560*/
800e9ae0 1069 while (hv_iternext(keys)) i++;
463ee0b2
LW
1070 }
1071 PUSHi( i );
1072 RETURN;
1073 }
1074
8ed4b672 1075 EXTEND(SP, HvKEYS(keys) * (dokeys + dovalues));
463ee0b2 1076
463ee0b2 1077 PUTBACK; /* hv_iternext and hv_iterval might clobber stack_sp */
800e9ae0 1078 while (entry = hv_iternext(keys)) {
463ee0b2 1079 SPAGAIN;
8c2cee6f 1080 if (dokeys)
1081 XPUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */
463ee0b2 1082 if (dovalues) {
463ee0b2 1083 PUTBACK;
b6429b1b
GS
1084 tmpstr = realhv ?
1085 hv_iterval(hv,entry) : avhv_iterval((AV*)hv,entry);
46fc3d4c 1086 DEBUG_H(sv_setpvf(tmpstr, "%lu%%%d=%lu",
1087 (unsigned long)HeHASH(entry),
800e9ae0
JP
1088 HvMAX(keys)+1,
1089 (unsigned long)(HeHASH(entry) & HvMAX(keys))));
463ee0b2 1090 SPAGAIN;
46fc3d4c 1091 XPUSHs(tmpstr);
463ee0b2
LW
1092 }
1093 PUTBACK;
1094 }
1095 return NORMAL;
1096}
4e35701f 1097