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