Make Configure recognise glibc 2.1 stdio
[p5sagit/p5-mst-13.2.git] / doop.c
CommitLineData
a0d0e21e 1/* doop.c
79072805 2 *
4eb8286e 3 * Copyright (c) 1991-1999, Larry Wall
79072805 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 8 */
9
10/*
11 * "'So that was the job I felt I had to do when I started,' thought Sam."
79072805 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 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 38 U8 *s;
39 U8 *send;
40 I32 matches = 0;
463ee0b2 41 STRLEN len;
4757a243 42 short *tbl;
43 I32 ch;
79072805 44
4757a243 45 tbl = (short*)cPVOP->op_pv;
46 if (!tbl)
47 croak("panic: do_trans");
a0ed51b3 48
4757a243 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 57 s++;
58 }
59 SvSETMAGIC(sv);
60
61 return matches;
62}
63
942e002e 64STATIC I32
4757a243 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 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 122 else if (ch == -1) /* -1 is unmapped character */
123 *d++ = *s; /* -2 is delete character */
124 s++;
a0ed51b3 125 }
4757a243 126 }
127 else {
128 while (s < send) {
129 if ((ch = tbl[*s]) >= 0) {
130 *d = ch;
131 matches++;
132 d++;
a0ed51b3 133 }
4757a243 134 else if (ch == -1) /* -1 is unmapped character */
135 *d++ = *s; /* -2 is delete character */
136 s++;
5d06d08e 137 }
4757a243 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 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 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 221 }
222
223 return matches;
224}
225
942e002e 226STATIC I32
4757a243 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 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 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 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 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 369 return SvCUR(sv);
370}
a0ed51b3 371
4757a243 372/* latin-1 to utf-8 */
a0ed51b3 373
942e002e 374STATIC I32
4757a243 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 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 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 457 }
458 else {
4757a243 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 488 for (i = UTF8SKIP(s); i; --i)
489 *d++ = *s++;
a0ed51b3 490 }
4757a243 491 else {
492 I32 ulen;
493 *d++ = (U8)utf8_to_uv(s, &ulen);
494 s += ulen;
a0ed51b3 495 }
a0ed51b3 496 }
4757a243 497 else { /* must be to_utf only */
498 d = uv_to_utf8(d, s[-1]);
499 }
500 puv = 0xfeedface;
501 continue;
a0ed51b3 502 }
4757a243 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 520 }
521 else {
4757a243 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 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 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 562 else { /* must be to_utf only */
563 d = uv_to_utf8(d, s[-1]);
564 }
565 continue;
79072805 566 }
4757a243 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 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 597 STRLEN len;
598
599 if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_IDENTICAL))
22c35a8c 600 croak(PL_no_modify);
4757a243 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 642}
643
644void
8ac85365 645do_join(register SV *sv, SV *del, register SV **mark, register SV **sp)
79072805 646{
647 SV **oldmark = mark;
648 register I32 items = sp - mark;
79072805 649 register STRLEN len;
463ee0b2 650 STRLEN delimlen;
651 register char *delim = SvPV(del, delimlen);
652 STRLEN tmplen;
79072805 653
654 mark++;
655 len = (items > 0 ? (delimlen * (items - 1) ) : 0);
07f14f54 656 (void)SvUPGRADE(sv, SVt_PV);
79072805 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 660 SvPV(*mark, tmplen);
661 len += tmplen;
79072805 662 }
663 mark++;
664 }
665 SvGROW(sv, len + 1); /* so try to pre-extend */
666
667 mark = oldmark;
db7c17d7 668 items = sp - mark;
79072805 669 ++mark;
670 }
671
463ee0b2 672 if (items-- > 0) {
8990e307 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 681 mark++;
682 }
79072805 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 710}
711
712void
8ac85365 713do_vecset(SV *sv)
79072805 714{
715 SV *targ = LvTARG(sv);
716 register I32 offset;
717 register I32 size;
8990e307 718 register unsigned char *s;
719 register unsigned long lval;
79072805 720 I32 mask;
a0d0e21e 721 STRLEN targlen;
722 STRLEN len;
79072805 723
8990e307 724 if (!targ)
725 return;
a0d0e21e 726 s = (unsigned char*)SvPV_force(targ, targlen);
8990e307 727 lval = U_L(SvNV(sv));
79072805 728 offset = LvTARGOFF(sv);
729 size = LvTARGLEN(sv);
a0d0e21e 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 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 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 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 778 do_chop(astr, sv);
779 }
780 return;
79072805 781 }
aa854799 782 else if (SvTYPE(sv) == SVt_PVHV) {
a0d0e21e 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 }
aa854799 791 else if (SvREADONLY(sv))
6393042b 792 croak(PL_no_modify);
a0d0e21e 793 s = SvPV(sv, len);
748a9306 794 if (len && !SvPOK(sv))
a0d0e21e 795 s = SvPV_force(sv, len);
a0ed51b3 796 if (IN_UTF8) {
797 if (s && len) {
798 char *send = s + len;
799 char *start = s;
800 s = send - 1;
801 while ((*s & 0xc0) == 0x80)
802 --s;
803 if (UTF8SKIP(s) != send - s)
804 warn("Malformed UTF-8 character");
805 sv_setpvn(astr, s, send - s);
806 *s = '\0';
807 SvCUR_set(sv, s - start);
808 SvNIOK_off(sv);
809 }
810 else
811 sv_setpvn(astr, "", 0);
812 }
813 else
a0d0e21e 814 if (s && len) {
815 s += --len;
816 sv_setpvn(astr, s, 1);
817 *s = '\0';
818 SvCUR_set(sv, len);
819 SvNIOK_off(sv);
79072805 820 }
821 else
a0d0e21e 822 sv_setpvn(astr, "", 0);
823 SvSETMAGIC(sv);
824}
825
826I32
8ac85365 827do_chomp(register SV *sv)
a0d0e21e 828{
aeea060c 829 dTHR;
c07a80fd 830 register I32 count;
a0d0e21e 831 STRLEN len;
832 char *s;
c07a80fd 833
3280af22 834 if (RsSNARF(PL_rs))
c07a80fd 835 return 0;
4c5a6083 836 if (RsRECORD(PL_rs))
837 return 0;
c07a80fd 838 count = 0;
a0d0e21e 839 if (SvTYPE(sv) == SVt_PVAV) {
840 register I32 i;
841 I32 max;
842 AV* av = (AV*)sv;
843 max = AvFILL(av);
844 for (i = 0; i <= max; i++) {
845 sv = (SV*)av_fetch(av, i, FALSE);
3280af22 846 if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
a0d0e21e 847 count += do_chomp(sv);
848 }
849 return count;
850 }
aa854799 851 else if (SvTYPE(sv) == SVt_PVHV) {
a0d0e21e 852 HV* hv = (HV*)sv;
853 HE* entry;
854 (void)hv_iterinit(hv);
855 /*SUPPRESS 560*/
856 while (entry = hv_iternext(hv))
857 count += do_chomp(hv_iterval(hv,entry));
858 return count;
859 }
aa854799 860 else if (SvREADONLY(sv))
6393042b 861 croak(PL_no_modify);
a0d0e21e 862 s = SvPV(sv, len);
863 if (len && !SvPOKp(sv))
864 s = SvPV_force(sv, len);
865 if (s && len) {
866 s += --len;
3280af22 867 if (RsPARA(PL_rs)) {
a0d0e21e 868 if (*s != '\n')
869 goto nope;
870 ++count;
871 while (len && s[-1] == '\n') {
872 --len;
873 --s;
874 ++count;
875 }
876 }
a0d0e21e 877 else {
c07a80fd 878 STRLEN rslen;
3280af22 879 char *rsptr = SvPV(PL_rs, rslen);
c07a80fd 880 if (rslen == 1) {
881 if (*s != *rsptr)
882 goto nope;
883 ++count;
884 }
885 else {
8c2cee6f 886 if (len < rslen - 1)
c07a80fd 887 goto nope;
888 len -= rslen - 1;
889 s -= rslen - 1;
36477c24 890 if (memNE(s, rsptr, rslen))
c07a80fd 891 goto nope;
892 count += rslen;
893 }
a0d0e21e 894 }
a0d0e21e 895 *s = '\0';
896 SvCUR_set(sv, len);
897 SvNIOK_off(sv);
898 }
899 nope:
900 SvSETMAGIC(sv);
901 return count;
902}
79072805 903
904void
8ac85365 905do_vop(I32 optype, SV *sv, SV *left, SV *right)
79072805 906{
aeea060c 907 dTHR; /* just for taint */
79072805 908#ifdef LIBERAL
909 register long *dl;
910 register long *ll;
911 register long *rl;
912#endif
913 register char *dc;
463ee0b2 914 STRLEN leftlen;
915 STRLEN rightlen;
7a4c00b4 916 register char *lc;
917 register char *rc;
79072805 918 register I32 len;
a0d0e21e 919 I32 lensave;
7a4c00b4 920 char *lsave;
921 char *rsave;
79072805 922
1fbd88dc 923 if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
924 sv_setpvn(sv, "", 0); /* avoid undef warning on |= and ^= */
7a4c00b4 925 lsave = lc = SvPV(left, leftlen);
926 rsave = rc = SvPV(right, rightlen);
93a17b20 927 len = leftlen < rightlen ? leftlen : rightlen;
a0d0e21e 928 lensave = len;
7a4c00b4 929 if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
2d8e6c8d 930 STRLEN n_a;
931 dc = SvPV_force(sv, n_a);
ff68c719 932 if (SvCUR(sv) < len) {
933 dc = SvGROW(sv, len + 1);
934 (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
935 }
936 }
937 else {
938 I32 needlen = ((optype == OP_BIT_AND)
939 ? len : (leftlen > rightlen ? leftlen : rightlen));
940 Newz(801, dc, needlen + 1, char);
941 (void)sv_usepvn(sv, dc, needlen);
942 dc = SvPVX(sv); /* sv_usepvn() calls Renew() */
79072805 943 }
a0d0e21e 944 SvCUR_set(sv, len);
945 (void)SvPOK_only(sv);
79072805 946#ifdef LIBERAL
947 if (len >= sizeof(long)*4 &&
948 !((long)dc % sizeof(long)) &&
949 !((long)lc % sizeof(long)) &&
950 !((long)rc % sizeof(long))) /* It's almost always aligned... */
951 {
952 I32 remainder = len % (sizeof(long)*4);
953 len /= (sizeof(long)*4);
954
955 dl = (long*)dc;
956 ll = (long*)lc;
957 rl = (long*)rc;
958
959 switch (optype) {
960 case OP_BIT_AND:
961 while (len--) {
962 *dl++ = *ll++ & *rl++;
963 *dl++ = *ll++ & *rl++;
964 *dl++ = *ll++ & *rl++;
965 *dl++ = *ll++ & *rl++;
966 }
967 break;
a0d0e21e 968 case OP_BIT_XOR:
79072805 969 while (len--) {
970 *dl++ = *ll++ ^ *rl++;
971 *dl++ = *ll++ ^ *rl++;
972 *dl++ = *ll++ ^ *rl++;
973 *dl++ = *ll++ ^ *rl++;
974 }
975 break;
976 case OP_BIT_OR:
977 while (len--) {
978 *dl++ = *ll++ | *rl++;
979 *dl++ = *ll++ | *rl++;
980 *dl++ = *ll++ | *rl++;
981 *dl++ = *ll++ | *rl++;
982 }
983 }
984
985 dc = (char*)dl;
986 lc = (char*)ll;
987 rc = (char*)rl;
988
989 len = remainder;
990 }
991#endif
a0d0e21e 992 {
a0d0e21e 993 switch (optype) {
994 case OP_BIT_AND:
995 while (len--)
996 *dc++ = *lc++ & *rc++;
997 break;
998 case OP_BIT_XOR:
999 while (len--)
1000 *dc++ = *lc++ ^ *rc++;
1001 goto mop_up;
1002 case OP_BIT_OR:
1003 while (len--)
1004 *dc++ = *lc++ | *rc++;
1005 mop_up:
1006 len = lensave;
1007 if (rightlen > len)
1008 sv_catpvn(sv, rsave + len, rightlen - len);
1009 else if (leftlen > len)
1010 sv_catpvn(sv, lsave + len, leftlen - len);
4633a7c4 1011 else
1012 *SvEND(sv) = '\0';
a0d0e21e 1013 break;
1014 }
79072805 1015 }
fb73857a 1016 SvTAINT(sv);
79072805 1017}
463ee0b2 1018
1019OP *
8ac85365 1020do_kv(ARGSproto)
463ee0b2 1021{
4e35701f 1022 djSP;
463ee0b2 1023 HV *hv = (HV*)POPs;
800e9ae0 1024 HV *keys;
463ee0b2 1025 register HE *entry;
463ee0b2 1026 SV *tmpstr;
54310121 1027 I32 gimme = GIMME_V;
533c011a 1028 I32 dokeys = (PL_op->op_type == OP_KEYS);
1029 I32 dovalues = (PL_op->op_type == OP_VALUES);
c750a3ec 1030 I32 realhv = (SvTYPE(hv) == SVt_PVHV);
1031
533c011a 1032 if (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV)
a0d0e21e 1033 dokeys = dovalues = TRUE;
463ee0b2 1034
85581909 1035 if (!hv) {
533c011a 1036 if (PL_op->op_flags & OPf_MOD) { /* lvalue */
85581909 1037 dTARGET; /* make sure to clear its target here */
1038 if (SvTYPE(TARG) == SVt_PVLV)
1039 LvTARG(TARG) = Nullsv;
1040 PUSHs(TARG);
1041 }
463ee0b2 1042 RETURN;
85581909 1043 }
748a9306 1044
800e9ae0 1045 keys = realhv ? hv : avhv_keys((AV*)hv);
1046 (void)hv_iterinit(keys); /* always reset iterator regardless */
748a9306 1047
54310121 1048 if (gimme == G_VOID)
aa689395 1049 RETURN;
1050
54310121 1051 if (gimme == G_SCALAR) {
6ee623d5 1052 IV i;
463ee0b2 1053 dTARGET;
1054
533c011a 1055 if (PL_op->op_flags & OPf_MOD) { /* lvalue */
85581909 1056 if (SvTYPE(TARG) < SVt_PVLV) {
1057 sv_upgrade(TARG, SVt_PVLV);
1058 sv_magic(TARG, Nullsv, 'k', Nullch, 0);
1059 }
1060 LvTYPE(TARG) = 'k';
800e9ae0 1061 if (LvTARG(TARG) != (SV*)keys) {
6ff81951 1062 if (LvTARG(TARG))
1063 SvREFCNT_dec(LvTARG(TARG));
800e9ae0 1064 LvTARG(TARG) = SvREFCNT_inc(keys);
6ff81951 1065 }
85581909 1066 PUSHs(TARG);
1067 RETURN;
1068 }
1069
33c27489 1070 if (! SvTIED_mg((SV*)keys, 'P'))
800e9ae0 1071 i = HvKEYS(keys);
463ee0b2 1072 else {
1073 i = 0;
463ee0b2 1074 /*SUPPRESS 560*/
800e9ae0 1075 while (hv_iternext(keys)) i++;
463ee0b2 1076 }
1077 PUSHi( i );
1078 RETURN;
1079 }
1080
8ed4b672 1081 EXTEND(SP, HvKEYS(keys) * (dokeys + dovalues));
463ee0b2 1082
463ee0b2 1083 PUTBACK; /* hv_iternext and hv_iterval might clobber stack_sp */
800e9ae0 1084 while (entry = hv_iternext(keys)) {
463ee0b2 1085 SPAGAIN;
8c2cee6f 1086 if (dokeys)
1087 XPUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */
463ee0b2 1088 if (dovalues) {
463ee0b2 1089 PUTBACK;
b6429b1b 1090 tmpstr = realhv ?
1091 hv_iterval(hv,entry) : avhv_iterval((AV*)hv,entry);
46fc3d4c 1092 DEBUG_H(sv_setpvf(tmpstr, "%lu%%%d=%lu",
1093 (unsigned long)HeHASH(entry),
800e9ae0 1094 HvMAX(keys)+1,
1095 (unsigned long)(HeHASH(entry) & HvMAX(keys))));
463ee0b2 1096 SPAGAIN;
46fc3d4c 1097 XPUSHs(tmpstr);
463ee0b2 1098 }
1099 PUTBACK;
1100 }
1101 return NORMAL;
1102}
4e35701f 1103