This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 5.002beta2 patch: toke.c
[perl5.git] / doop.c
CommitLineData
a0d0e21e 1/* doop.c
79072805 2 *
a0d0e21e 3 * Copyright (c) 1991-1994, 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
21#ifdef BUGGY_MSC
22 #pragma function(memcmp)
23#endif /* BUGGY_MSC */
24
79072805
LW
25#ifdef BUGGY_MSC
26 #pragma intrinsic(memcmp)
27#endif /* BUGGY_MSC */
28
29I32
30do_trans(sv,arg)
31SV *sv;
32OP *arg;
33{
34 register short *tbl;
1476d272
PP
35 register U8 *s;
36 register U8 *send;
37 register U8 *d;
79072805 38 register I32 ch;
1476d272 39 register I32 matches = 0;
79072805 40 register I32 squash = op->op_private & OPpTRANS_SQUASH;
463ee0b2 41 STRLEN len;
79072805 42
a0d0e21e
LW
43 if (SvREADONLY(sv))
44 croak(no_modify);
1476d272
PP
45 tbl = (short*)cPVOP->op_pv;
46 s = (U8*)SvPV(sv, len);
a0d0e21e
LW
47 if (!len)
48 return 0;
49 if (!SvPOKp(sv))
1476d272 50 s = (U8*)SvPV_force(sv, len);
a0d0e21e 51 (void)SvPOK_only(sv);
463ee0b2 52 send = s + len;
79072805 53 if (!tbl || !s)
463ee0b2 54 croak("panic: do_trans");
79072805
LW
55 DEBUG_t( deb("2.TBL\n"));
56 if (!op->op_private) {
57 while (s < send) {
1476d272 58 if ((ch = tbl[*s]) >= 0) {
79072805
LW
59 matches++;
60 *s = ch;
61 }
62 s++;
63 }
64 }
65 else {
66 d = s;
67 while (s < send) {
1476d272 68 if ((ch = tbl[*s]) >= 0) {
79072805
LW
69 *d = ch;
70 if (matches++ && squash) {
71 if (d[-1] == *d)
72 matches--;
73 else
74 d++;
75 }
76 else
77 d++;
78 }
79 else if (ch == -1) /* -1 is unmapped character */
80 *d++ = *s; /* -2 is delete character */
81 s++;
82 }
83 matches += send - d; /* account for disappeared chars */
84 *d = '\0';
1476d272 85 SvCUR_set(sv, d - (U8*)SvPVX(sv));
79072805
LW
86 }
87 SvSETMAGIC(sv);
88 return matches;
89}
90
91void
92do_join(sv,del,mark,sp)
93register SV *sv;
94SV *del;
95register SV **mark;
96register SV **sp;
97{
98 SV **oldmark = mark;
99 register I32 items = sp - mark;
79072805 100 register STRLEN len;
463ee0b2
LW
101 STRLEN delimlen;
102 register char *delim = SvPV(del, delimlen);
103 STRLEN tmplen;
79072805
LW
104
105 mark++;
106 len = (items > 0 ? (delimlen * (items - 1) ) : 0);
107 if (SvTYPE(sv) < SVt_PV)
108 sv_upgrade(sv, SVt_PV);
109 if (SvLEN(sv) < len + items) { /* current length is way too short */
110 while (items-- > 0) {
111 if (*mark) {
463ee0b2
LW
112 SvPV(*mark, tmplen);
113 len += tmplen;
79072805
LW
114 }
115 mark++;
116 }
117 SvGROW(sv, len + 1); /* so try to pre-extend */
118
119 mark = oldmark;
120 items = sp - mark;;
121 ++mark;
122 }
123
463ee0b2 124 if (items-- > 0) {
8990e307
LW
125 char *s;
126
127 if (*mark) {
128 s = SvPV(*mark, tmplen);
129 sv_setpvn(sv, s, tmplen);
130 }
131 else
132 sv_setpv(sv, "");
463ee0b2
LW
133 mark++;
134 }
79072805
LW
135 else
136 sv_setpv(sv,"");
137 len = delimlen;
138 if (len) {
139 for (; items > 0; items--,mark++) {
140 sv_catpvn(sv,delim,len);
141 sv_catsv(sv,*mark);
142 }
143 }
144 else {
145 for (; items > 0; items--,mark++)
146 sv_catsv(sv,*mark);
147 }
148 SvSETMAGIC(sv);
149}
150
151void
152do_sprintf(sv,len,sarg)
153register SV *sv;
154register I32 len;
155register SV **sarg;
156{
157 register char *s;
158 register char *t;
159 register char *f;
160 bool dolong;
ecfc5424 161#ifdef HAS_QUAD
79072805 162 bool doquad;
ecfc5424 163#endif /* HAS_QUAD */
79072805
LW
164 char ch;
165 register char *send;
166 register SV *arg;
167 char *xs;
168 I32 xlen;
169 I32 pre;
170 I32 post;
171 double value;
463ee0b2 172 STRLEN arglen;
79072805
LW
173
174 sv_setpv(sv,"");
175 len--; /* don't count pattern string */
a0d0e21e 176 t = s = SvPV(*sarg, arglen); /* XXX Don't know t is writeable */
463ee0b2 177 send = s + arglen;
79072805
LW
178 sarg++;
179 for ( ; ; len--) {
180
181 /*SUPPRESS 560*/
182 if (len <= 0 || !(arg = *sarg++))
183 arg = &sv_no;
184
185 /*SUPPRESS 530*/
186 for ( ; t < send && *t != '%'; t++) ;
187 if (t >= send)
188 break; /* end of run_format string, ignore extra args */
189 f = t;
190 *buf = '\0';
191 xs = buf;
ecfc5424 192#ifdef HAS_QUAD
79072805 193 doquad =
ecfc5424 194#endif /* HAS_QUAD */
79072805
LW
195 dolong = FALSE;
196 pre = post = 0;
197 for (t++; t < send; t++) {
198 switch (*t) {
199 default:
200 ch = *(++t);
201 *t = '\0';
202 (void)sprintf(xs,f);
203 len++, sarg--;
204 xlen = strlen(xs);
205 break;
748a9306
LW
206 case 'n': case '*':
207 croak("Use of %c in printf format not supported", *t);
208
79072805
LW
209 case '0': case '1': case '2': case '3': case '4':
210 case '5': case '6': case '7': case '8': case '9':
211 case '.': case '#': case '-': case '+': case ' ':
212 continue;
463ee0b2 213 case 'l':
ecfc5424 214#ifdef HAS_QUAD
79072805
LW
215 if (dolong) {
216 dolong = FALSE;
217 doquad = TRUE;
218 } else
219#endif
220 dolong = TRUE;
221 continue;
222 case 'c':
223 ch = *(++t);
224 *t = '\0';
463ee0b2 225 xlen = SvIV(arg);
79072805
LW
226 if (strEQ(f,"%c")) { /* some printfs fail on null chars */
227 *xs = xlen;
228 xs[1] = '\0';
229 xlen = 1;
230 }
231 else {
232 (void)sprintf(xs,f,xlen);
233 xlen = strlen(xs);
234 }
235 break;
236 case 'D':
237 dolong = TRUE;
238 /* FALL THROUGH */
239 case 'd':
240 ch = *(++t);
241 *t = '\0';
ecfc5424 242#ifdef HAS_QUAD
79072805 243 if (doquad)
ecfc5424 244 (void)sprintf(buf,s,(Quad_t)SvNV(arg));
79072805
LW
245 else
246#endif
247 if (dolong)
463ee0b2 248 (void)sprintf(xs,f,(long)SvNV(arg));
79072805 249 else
463ee0b2 250 (void)sprintf(xs,f,SvIV(arg));
79072805
LW
251 xlen = strlen(xs);
252 break;
253 case 'X': case 'O':
254 dolong = TRUE;
255 /* FALL THROUGH */
256 case 'x': case 'o': case 'u':
257 ch = *(++t);
258 *t = '\0';
463ee0b2 259 value = SvNV(arg);
ecfc5424 260#ifdef HAS_QUAD
79072805 261 if (doquad)
ecfc5424 262 (void)sprintf(buf,s,(unsigned Quad_t)value);
79072805
LW
263 else
264#endif
265 if (dolong)
266 (void)sprintf(xs,f,U_L(value));
267 else
268 (void)sprintf(xs,f,U_I(value));
269 xlen = strlen(xs);
270 break;
271 case 'E': case 'e': case 'f': case 'G': case 'g':
272 ch = *(++t);
273 *t = '\0';
463ee0b2 274 (void)sprintf(xs,f,SvNV(arg));
79072805
LW
275 xlen = strlen(xs);
276 break;
277 case 's':
278 ch = *(++t);
279 *t = '\0';
463ee0b2
LW
280 xs = SvPV(arg, arglen);
281 xlen = (I32)arglen;
79072805
LW
282 if (strEQ(f,"%s")) { /* some printfs fail on >128 chars */
283 break; /* so handle simple cases */
284 }
285 else if (f[1] == '-') {
93a17b20 286 char *mp = strchr(f, '.');
79072805
LW
287 I32 min = atoi(f+2);
288
289 if (mp) {
290 I32 max = atoi(mp+1);
291
292 if (xlen > max)
293 xlen = max;
294 }
295 if (xlen < min)
296 post = min - xlen;
297 break;
298 }
299 else if (isDIGIT(f[1])) {
93a17b20 300 char *mp = strchr(f, '.');
79072805
LW
301 I32 min = atoi(f+1);
302
303 if (mp) {
304 I32 max = atoi(mp+1);
305
306 if (xlen > max)
307 xlen = max;
308 }
309 if (xlen < min)
310 pre = min - xlen;
311 break;
312 }
313 strcpy(tokenbuf+64,f); /* sprintf($s,...$s...) */
314 *t = ch;
315 (void)sprintf(buf,tokenbuf+64,xs);
316 xs = buf;
317 xlen = strlen(xs);
318 break;
319 }
320 /* end of switch, copy results */
321 *t = ch;
4633a7c4
LW
322 if (xs == buf && xlen >= sizeof(buf)) { /* Ooops! */
323 fputs("panic: sprintf overflow - memory corrupted!\n",stderr);
324 my_exit(1);
325 }
79072805
LW
326 SvGROW(sv, SvCUR(sv) + (f - s) + xlen + 1 + pre + post);
327 sv_catpvn(sv, s, f - s);
328 if (pre) {
463ee0b2 329 repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, pre);
79072805
LW
330 SvCUR(sv) += pre;
331 }
332 sv_catpvn(sv, xs, xlen);
333 if (post) {
463ee0b2 334 repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, post);
79072805
LW
335 SvCUR(sv) += post;
336 }
337 s = t;
338 break; /* break from for loop */
339 }
340 }
341 sv_catpvn(sv, s, t - s);
342 SvSETMAGIC(sv);
343}
344
345void
346do_vecset(sv)
347SV *sv;
348{
349 SV *targ = LvTARG(sv);
350 register I32 offset;
351 register I32 size;
8990e307
LW
352 register unsigned char *s;
353 register unsigned long lval;
79072805 354 I32 mask;
a0d0e21e
LW
355 STRLEN targlen;
356 STRLEN len;
79072805 357
8990e307
LW
358 if (!targ)
359 return;
a0d0e21e 360 s = (unsigned char*)SvPV_force(targ, targlen);
8990e307 361 lval = U_L(SvNV(sv));
79072805
LW
362 offset = LvTARGOFF(sv);
363 size = LvTARGLEN(sv);
a0d0e21e
LW
364
365 len = (offset + size + 7) / 8;
366 if (len > targlen) {
367 s = (unsigned char*)SvGROW(targ, len + 1);
368 (void)memzero(s + targlen, len - targlen + 1);
369 SvCUR_set(targ, len);
370 }
371
79072805
LW
372 if (size < 8) {
373 mask = (1 << size) - 1;
374 size = offset & 7;
375 lval &= mask;
376 offset >>= 3;
377 s[offset] &= ~(mask << size);
378 s[offset] |= lval << size;
379 }
380 else {
a0d0e21e 381 offset >>= 3;
79072805
LW
382 if (size == 8)
383 s[offset] = lval & 255;
384 else if (size == 16) {
385 s[offset] = (lval >> 8) & 255;
386 s[offset+1] = lval & 255;
387 }
388 else if (size == 32) {
389 s[offset] = (lval >> 24) & 255;
390 s[offset+1] = (lval >> 16) & 255;
391 s[offset+2] = (lval >> 8) & 255;
392 s[offset+3] = lval & 255;
393 }
394 }
395}
396
397void
398do_chop(astr,sv)
399register SV *astr;
400register SV *sv;
401{
463ee0b2 402 STRLEN len;
a0d0e21e
LW
403 char *s;
404
79072805 405 if (SvTYPE(sv) == SVt_PVAV) {
a0d0e21e
LW
406 register I32 i;
407 I32 max;
408 AV* av = (AV*)sv;
409 max = AvFILL(av);
410 for (i = 0; i <= max; i++) {
411 sv = (SV*)av_fetch(av, i, FALSE);
412 if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
413 do_chop(astr, sv);
414 }
415 return;
79072805
LW
416 }
417 if (SvTYPE(sv) == SVt_PVHV) {
a0d0e21e
LW
418 HV* hv = (HV*)sv;
419 HE* entry;
420 (void)hv_iterinit(hv);
421 /*SUPPRESS 560*/
422 while (entry = hv_iternext(hv))
423 do_chop(astr,hv_iterval(hv,entry));
424 return;
79072805 425 }
a0d0e21e 426 s = SvPV(sv, len);
748a9306 427 if (len && !SvPOK(sv))
a0d0e21e
LW
428 s = SvPV_force(sv, len);
429 if (s && len) {
430 s += --len;
431 sv_setpvn(astr, s, 1);
432 *s = '\0';
433 SvCUR_set(sv, len);
434 SvNIOK_off(sv);
79072805
LW
435 }
436 else
a0d0e21e
LW
437 sv_setpvn(astr, "", 0);
438 SvSETMAGIC(sv);
439}
440
441I32
442do_chomp(sv)
443register SV *sv;
444{
445 register I32 count = 0;
446 STRLEN len;
447 char *s;
448
449 if (SvTYPE(sv) == SVt_PVAV) {
450 register I32 i;
451 I32 max;
452 AV* av = (AV*)sv;
453 max = AvFILL(av);
454 for (i = 0; i <= max; i++) {
455 sv = (SV*)av_fetch(av, i, FALSE);
456 if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
457 count += do_chomp(sv);
458 }
459 return count;
460 }
461 if (SvTYPE(sv) == SVt_PVHV) {
462 HV* hv = (HV*)sv;
463 HE* entry;
464 (void)hv_iterinit(hv);
465 /*SUPPRESS 560*/
466 while (entry = hv_iternext(hv))
467 count += do_chomp(hv_iterval(hv,entry));
468 return count;
469 }
470 s = SvPV(sv, len);
471 if (len && !SvPOKp(sv))
472 s = SvPV_force(sv, len);
473 if (s && len) {
474 s += --len;
475 if (rspara) {
476 if (*s != '\n')
477 goto nope;
478 ++count;
479 while (len && s[-1] == '\n') {
480 --len;
481 --s;
482 ++count;
483 }
484 }
485 else if (rslen == 1) {
486 if (*s != rschar)
487 goto nope;
488 ++count;
489 }
490 else {
491 if (len < rslen - 1)
492 goto nope;
493 len -= rslen - 1;
494 s -= rslen - 1;
495 if (bcmp(s, rs, rslen))
496 goto nope;
497 count += rslen;
498 }
499
500 *s = '\0';
501 SvCUR_set(sv, len);
502 SvNIOK_off(sv);
503 }
504 nope:
505 SvSETMAGIC(sv);
506 return count;
507}
79072805
LW
508
509void
510do_vop(optype,sv,left,right)
511I32 optype;
512SV *sv;
513SV *left;
514SV *right;
515{
516#ifdef LIBERAL
517 register long *dl;
518 register long *ll;
519 register long *rl;
520#endif
521 register char *dc;
463ee0b2
LW
522 STRLEN leftlen;
523 STRLEN rightlen;
524 register char *lc = SvPV(left, leftlen);
525 register char *rc = SvPV(right, rightlen);
79072805 526 register I32 len;
a0d0e21e 527 I32 lensave;
79072805 528
a0d0e21e 529 dc = SvPV_force(sv,na);
93a17b20 530 len = leftlen < rightlen ? leftlen : rightlen;
a0d0e21e
LW
531 lensave = len;
532 if (SvCUR(sv) < len) {
533 dc = SvGROW(sv,len + 1);
534 (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
79072805 535 }
a0d0e21e
LW
536 SvCUR_set(sv, len);
537 (void)SvPOK_only(sv);
79072805
LW
538#ifdef LIBERAL
539 if (len >= sizeof(long)*4 &&
540 !((long)dc % sizeof(long)) &&
541 !((long)lc % sizeof(long)) &&
542 !((long)rc % sizeof(long))) /* It's almost always aligned... */
543 {
544 I32 remainder = len % (sizeof(long)*4);
545 len /= (sizeof(long)*4);
546
547 dl = (long*)dc;
548 ll = (long*)lc;
549 rl = (long*)rc;
550
551 switch (optype) {
552 case OP_BIT_AND:
553 while (len--) {
554 *dl++ = *ll++ & *rl++;
555 *dl++ = *ll++ & *rl++;
556 *dl++ = *ll++ & *rl++;
557 *dl++ = *ll++ & *rl++;
558 }
559 break;
a0d0e21e 560 case OP_BIT_XOR:
79072805
LW
561 while (len--) {
562 *dl++ = *ll++ ^ *rl++;
563 *dl++ = *ll++ ^ *rl++;
564 *dl++ = *ll++ ^ *rl++;
565 *dl++ = *ll++ ^ *rl++;
566 }
567 break;
568 case OP_BIT_OR:
569 while (len--) {
570 *dl++ = *ll++ | *rl++;
571 *dl++ = *ll++ | *rl++;
572 *dl++ = *ll++ | *rl++;
573 *dl++ = *ll++ | *rl++;
574 }
575 }
576
577 dc = (char*)dl;
578 lc = (char*)ll;
579 rc = (char*)rl;
580
581 len = remainder;
582 }
583#endif
a0d0e21e
LW
584 {
585 char *lsave = lc;
586 char *rsave = rc;
587
588 switch (optype) {
589 case OP_BIT_AND:
590 while (len--)
591 *dc++ = *lc++ & *rc++;
592 break;
593 case OP_BIT_XOR:
594 while (len--)
595 *dc++ = *lc++ ^ *rc++;
596 goto mop_up;
597 case OP_BIT_OR:
598 while (len--)
599 *dc++ = *lc++ | *rc++;
600 mop_up:
601 len = lensave;
602 if (rightlen > len)
603 sv_catpvn(sv, rsave + len, rightlen - len);
604 else if (leftlen > len)
605 sv_catpvn(sv, lsave + len, leftlen - len);
4633a7c4
LW
606 else
607 *SvEND(sv) = '\0';
a0d0e21e
LW
608 break;
609 }
79072805
LW
610 }
611}
463ee0b2
LW
612
613OP *
614do_kv(ARGS)
615dARGS
616{
617 dSP;
618 HV *hv = (HV*)POPs;
463ee0b2
LW
619 I32 i;
620 register HE *entry;
621 char *tmps;
622 SV *tmpstr;
a0d0e21e
LW
623 I32 dokeys = (op->op_type == OP_KEYS);
624 I32 dovalues = (op->op_type == OP_VALUES);
625
626 if (op->op_type == OP_RV2HV || op->op_type == OP_PADHV)
627 dokeys = dovalues = TRUE;
463ee0b2
LW
628
629 if (!hv)
630 RETURN;
748a9306
LW
631
632 (void)hv_iterinit(hv); /* always reset iterator regardless */
633
463ee0b2
LW
634 if (GIMME != G_ARRAY) {
635 dTARGET;
636
8990e307 637 if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P'))
463ee0b2
LW
638 i = HvKEYS(hv);
639 else {
640 i = 0;
463ee0b2
LW
641 /*SUPPRESS 560*/
642 while (entry = hv_iternext(hv)) {
643 i++;
644 }
645 }
646 PUSHi( i );
647 RETURN;
648 }
649
650 /* Guess how much room we need. hv_max may be a few too many. Oh well. */
651 EXTEND(sp, HvMAX(hv) * (dokeys + dovalues));
652
463ee0b2
LW
653 PUTBACK; /* hv_iternext and hv_iterval might clobber stack_sp */
654 while (entry = hv_iternext(hv)) {
655 SPAGAIN;
656 if (dokeys) {
657 tmps = hv_iterkey(entry,&i); /* won't clobber stack_sp */
658 if (!i)
659 tmps = "";
660 XPUSHs(sv_2mortal(newSVpv(tmps,i)));
661 }
662 if (dovalues) {
663 tmpstr = NEWSV(45,0);
664 PUTBACK;
665 sv_setsv(tmpstr,hv_iterval(hv,entry));
666 SPAGAIN;
667 DEBUG_H( {
668 sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
669 HvMAX(hv)+1,entry->hent_hash & HvMAX(hv));
670 sv_setpv(tmpstr,buf);
671 } )
672 XPUSHs(sv_2mortal(tmpstr));
673 }
674 PUTBACK;
675 }
676 return NORMAL;
677}
678