Correct typo
[p5sagit/p5-mst-13.2.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     register short *tbl;
35     register U8 *s;
36     register U8 *send;
37     register U8 *d;
38     register I32 ch;
39     register I32 matches = 0;
40     register I32 squash = op->op_private & OPpTRANS_SQUASH;
41     STRLEN len;
42
43     if (SvREADONLY(sv))
44         croak(no_modify);
45     tbl = (short*)cPVOP->op_pv;
46     s = (U8*)SvPV(sv, len);
47     if (!len)
48         return 0;
49     if (!SvPOKp(sv))
50         s = (U8*)SvPV_force(sv, len);
51     (void)SvPOK_only(sv);
52     send = s + len;
53     if (!tbl || !s)
54         croak("panic: do_trans");
55     DEBUG_t( deb("2.TBL\n"));
56     if (!op->op_private) {
57         while (s < send) {
58             if ((ch = tbl[*s]) >= 0) {
59                 matches++;
60                 *s = ch;
61             }
62             s++;
63         }
64     }
65     else {
66         d = s;
67         while (s < send) {
68             if ((ch = tbl[*s]) >= 0) {
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';
85         SvCUR_set(sv, d - (U8*)SvPVX(sv));
86     }
87     SvSETMAGIC(sv);
88     return matches;
89 }
90
91 void
92 do_join(sv,del,mark,sp)
93 register SV *sv;
94 SV *del;
95 register SV **mark;
96 register SV **sp;
97 {
98     SV **oldmark = mark;
99     register I32 items = sp - mark;
100     register STRLEN len;
101     STRLEN delimlen;
102     register char *delim = SvPV(del, delimlen);
103     STRLEN tmplen;
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) {
112                 SvPV(*mark, tmplen);
113                 len += tmplen;
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
124     if (items-- > 0) {
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, "");
133         mark++;
134     }
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
151 void
152 do_sprintf(sv,len,sarg)
153 register SV *sv;
154 register I32 len;
155 register SV **sarg;
156 {
157     register char *s;
158     register char *t;
159     register char *f;
160     bool dolong;
161 #ifdef HAS_QUAD
162     bool doquad;
163 #endif /* HAS_QUAD */
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;
172     STRLEN arglen;
173
174     sv_setpv(sv,"");
175     len--;                      /* don't count pattern string */
176     t = s = SvPV(*sarg, arglen);        /* XXX Don't know t is writeable */
177     send = s + arglen;
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;
192 #ifdef HAS_QUAD
193         doquad =
194 #endif /* HAS_QUAD */
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;
206             case 'n': case '*':
207                 croak("Use of %c in printf format not supported", *t);
208
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;
213             case 'l':
214 #ifdef HAS_QUAD
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';
225                 xlen = SvIV(arg);
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';
242 #ifdef HAS_QUAD
243                 if (doquad)
244                     (void)sprintf(buf,s,(Quad_t)SvNV(arg));
245                 else
246 #endif
247                 if (dolong)
248                     (void)sprintf(xs,f,(long)SvNV(arg));
249                 else
250                     (void)sprintf(xs,f,SvIV(arg));
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';
259                 value = SvNV(arg);
260 #ifdef HAS_QUAD
261                 if (doquad)
262                     (void)sprintf(buf,s,(unsigned Quad_t)value);
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';
274                 (void)sprintf(xs,f,SvNV(arg));
275                 xlen = strlen(xs);
276                 break;
277             case 's':
278                 ch = *(++t);
279                 *t = '\0';
280                 xs = SvPV(arg, arglen);
281                 xlen = (I32)arglen;
282                 if (strEQ(f,"%s")) {    /* some printfs fail on >128 chars */
283                     break;              /* so handle simple cases */
284                 }
285                 else if (f[1] == '-') {
286                     char *mp = strchr(f, '.');
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])) {
300                     char *mp = strchr(f, '.');
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;
322             if (xs == buf && xlen >= sizeof(buf)) {     /* Ooops! */
323                 fputs("panic: sprintf overflow - memory corrupted!\n",stderr);
324                 my_exit(1);
325             }
326             SvGROW(sv, SvCUR(sv) + (f - s) + xlen + 1 + pre + post);
327             sv_catpvn(sv, s, f - s);
328             if (pre) {
329                 repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, pre);
330                 SvCUR(sv) += pre;
331             }
332             sv_catpvn(sv, xs, xlen);
333             if (post) {
334                 repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, post);
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
345 void
346 do_vecset(sv)
347 SV *sv;
348 {
349     SV *targ = LvTARG(sv);
350     register I32 offset;
351     register I32 size;
352     register unsigned char *s;
353     register unsigned long lval;
354     I32 mask;
355     STRLEN targlen;
356     STRLEN len;
357
358     if (!targ)
359         return;
360     s = (unsigned char*)SvPV_force(targ, targlen);
361     lval = U_L(SvNV(sv));
362     offset = LvTARGOFF(sv);
363     size = LvTARGLEN(sv);
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     
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 {
381         offset >>= 3;
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
397 void
398 do_chop(astr,sv)
399 register SV *astr;
400 register SV *sv;
401 {
402     STRLEN len;
403     char *s;
404     
405     if (SvTYPE(sv) == SVt_PVAV) {
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;
416     }
417     if (SvTYPE(sv) == SVt_PVHV) {
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;
425     }
426     s = SvPV(sv, len);
427     if (len && !SvPOK(sv))
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);
435     }
436     else
437         sv_setpvn(astr, "", 0);
438     SvSETMAGIC(sv);
439
440
441 I32
442 do_chomp(sv)
443 register SV *sv;
444 {
445     register I32 count;
446     STRLEN len;
447     char *s;
448
449     if (RsSNARF(rs))
450         return 0;
451     count = 0;
452     if (SvTYPE(sv) == SVt_PVAV) {
453         register I32 i;
454         I32 max;
455         AV* av = (AV*)sv;
456         max = AvFILL(av);
457         for (i = 0; i <= max; i++) {
458             sv = (SV*)av_fetch(av, i, FALSE);
459             if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
460                 count += do_chomp(sv);
461         }
462         return count;
463     }
464     if (SvTYPE(sv) == SVt_PVHV) {
465         HV* hv = (HV*)sv;
466         HE* entry;
467         (void)hv_iterinit(hv);
468         /*SUPPRESS 560*/
469         while (entry = hv_iternext(hv))
470             count += do_chomp(hv_iterval(hv,entry));
471         return count;
472     }
473     s = SvPV(sv, len);
474     if (len && !SvPOKp(sv))
475         s = SvPV_force(sv, len);
476     if (s && len) {
477         s += --len;
478         if (RsPARA(rs)) {
479             if (*s != '\n')
480                 goto nope;
481             ++count;
482             while (len && s[-1] == '\n') {
483                 --len;
484                 --s;
485                 ++count;
486             }
487         }
488         else {
489             STRLEN rslen;
490             char *rsptr = SvPV(rs, rslen);
491             if (rslen == 1) {
492                 if (*s != *rsptr)
493                     goto nope;
494                 ++count;
495             }
496             else {
497                 if (len < rslen - 1)
498                     goto nope;
499                 len -= rslen - 1;
500                 s -= rslen - 1;
501                 if (bcmp(s, rsptr, rslen))
502                     goto nope;
503                 count += rslen;
504             }
505         }
506         *s = '\0';
507         SvCUR_set(sv, len);
508         SvNIOK_off(sv);
509     }
510   nope:
511     SvSETMAGIC(sv);
512     return count;
513
514
515 void
516 do_vop(optype,sv,left,right)
517 I32 optype;
518 SV *sv;
519 SV *left;
520 SV *right;
521 {
522 #ifdef LIBERAL
523     register long *dl;
524     register long *ll;
525     register long *rl;
526 #endif
527     register char *dc;
528     STRLEN leftlen;
529     STRLEN rightlen;
530     register char *lc = SvPV(left, leftlen);
531     register char *rc = SvPV(right, rightlen);
532     register I32 len;
533     I32 lensave;
534
535     dc = SvPV_force(sv,na);
536     len = leftlen < rightlen ? leftlen : rightlen;
537     lensave = len;
538     if (SvCUR(sv) < len) {
539         dc = SvGROW(sv,len + 1);
540         (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
541     }
542     SvCUR_set(sv, len);
543     (void)SvPOK_only(sv);
544 #ifdef LIBERAL
545     if (len >= sizeof(long)*4 &&
546         !((long)dc % sizeof(long)) &&
547         !((long)lc % sizeof(long)) &&
548         !((long)rc % sizeof(long)))     /* It's almost always aligned... */
549     {
550         I32 remainder = len % (sizeof(long)*4);
551         len /= (sizeof(long)*4);
552
553         dl = (long*)dc;
554         ll = (long*)lc;
555         rl = (long*)rc;
556
557         switch (optype) {
558         case OP_BIT_AND:
559             while (len--) {
560                 *dl++ = *ll++ & *rl++;
561                 *dl++ = *ll++ & *rl++;
562                 *dl++ = *ll++ & *rl++;
563                 *dl++ = *ll++ & *rl++;
564             }
565             break;
566         case OP_BIT_XOR:
567             while (len--) {
568                 *dl++ = *ll++ ^ *rl++;
569                 *dl++ = *ll++ ^ *rl++;
570                 *dl++ = *ll++ ^ *rl++;
571                 *dl++ = *ll++ ^ *rl++;
572             }
573             break;
574         case OP_BIT_OR:
575             while (len--) {
576                 *dl++ = *ll++ | *rl++;
577                 *dl++ = *ll++ | *rl++;
578                 *dl++ = *ll++ | *rl++;
579                 *dl++ = *ll++ | *rl++;
580             }
581         }
582
583         dc = (char*)dl;
584         lc = (char*)ll;
585         rc = (char*)rl;
586
587         len = remainder;
588     }
589 #endif
590     {
591         char *lsave = lc;
592         char *rsave = rc;
593         
594         switch (optype) {
595         case OP_BIT_AND:
596             while (len--)
597                 *dc++ = *lc++ & *rc++;
598             break;
599         case OP_BIT_XOR:
600             while (len--)
601                 *dc++ = *lc++ ^ *rc++;
602             goto mop_up;
603         case OP_BIT_OR:
604             while (len--)
605                 *dc++ = *lc++ | *rc++;
606           mop_up:
607             len = lensave;
608             if (rightlen > len)
609                 sv_catpvn(sv, rsave + len, rightlen - len);
610             else if (leftlen > len)
611                 sv_catpvn(sv, lsave + len, leftlen - len);
612             else
613                 *SvEND(sv) = '\0';
614             break;
615         }
616     }
617 }
618
619 OP *
620 do_kv(ARGS)
621 dARGS
622 {
623     dSP;
624     HV *hv = (HV*)POPs;
625     register HE *entry;
626     SV *tmpstr;
627     I32 dokeys =   (op->op_type == OP_KEYS);
628     I32 dovalues = (op->op_type == OP_VALUES);
629
630     if (op->op_type == OP_RV2HV || op->op_type == OP_PADHV) 
631         dokeys = dovalues = TRUE;
632
633     if (!hv)
634         RETURN;
635
636     (void)hv_iterinit(hv);      /* always reset iterator regardless */
637
638     if (GIMME != G_ARRAY) {
639         I32 i;
640         dTARGET;
641
642         if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P'))
643             i = HvKEYS(hv);
644         else {
645             i = 0;
646             /*SUPPRESS 560*/
647             while (entry = hv_iternext(hv)) {
648                 i++;
649             }
650         }
651         PUSHi( i );
652         RETURN;
653     }
654
655     /* Guess how much room we need.  hv_max may be a few too many.  Oh well. */
656     EXTEND(sp, HvMAX(hv) * (dokeys + dovalues));
657
658     PUTBACK;    /* hv_iternext and hv_iterval might clobber stack_sp */
659     while (entry = hv_iternext(hv)) {
660         SPAGAIN;
661         if (dokeys)
662             XPUSHs(hv_iterkeysv(entry));        /* won't clobber stack_sp */
663         if (dovalues) {
664             tmpstr = NEWSV(45,0);
665             PUTBACK;
666             sv_setsv(tmpstr,hv_iterval(hv,entry));
667             SPAGAIN;
668             DEBUG_H( {
669                         sprintf(buf,"%d%%%d=%d\n", HeHASH(entry),
670                                 HvMAX(hv)+1, HeHASH(entry) & HvMAX(hv));
671                         sv_setpv(tmpstr,buf);
672             } )
673             XPUSHs(sv_2mortal(tmpstr));
674         }
675         PUTBACK;
676     }
677     return NORMAL;
678 }
679