Auto-generated from global.sym and interp.sym.
[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     register short *tbl;
35     register char *s;
36     register I32 matches = 0;
37     register I32 ch;
38     register char *send;
39     register char *d;
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 = SvPV(sv, len);
47     if (!len)
48         return 0;
49     if (!SvPOKp(sv))
50         s = 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 & 0377]) >= 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 & 0377]) >= 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 - 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 = 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
508
509 void
510 do_vop(optype,sv,left,right)
511 I32 optype;
512 SV *sv;
513 SV *left;
514 SV *right;
515 {
516 #ifdef LIBERAL
517     register long *dl;
518     register long *ll;
519     register long *rl;
520 #endif
521     register char *dc;
522     STRLEN leftlen;
523     STRLEN rightlen;
524     register char *lc = SvPV(left, leftlen);
525     register char *rc = SvPV(right, rightlen);
526     register I32 len;
527     I32 lensave;
528
529     dc = SvPV_force(sv,na);
530     len = leftlen < rightlen ? leftlen : rightlen;
531     lensave = len;
532     if (SvCUR(sv) < len) {
533         dc = SvGROW(sv,len + 1);
534         (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
535     }
536     SvCUR_set(sv, len);
537     (void)SvPOK_only(sv);
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;
560         case OP_BIT_XOR:
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
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);
606             else
607                 *SvEND(sv) = '\0';
608             break;
609         }
610     }
611 }
612
613 OP *
614 do_kv(ARGS)
615 dARGS
616 {
617     dSP;
618     HV *hv = (HV*)POPs;
619     I32 i;
620     register HE *entry;
621     char *tmps;
622     SV *tmpstr;
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;
628
629     if (!hv)
630         RETURN;
631
632     (void)hv_iterinit(hv);      /* always reset iterator regardless */
633
634     if (GIMME != G_ARRAY) {
635         dTARGET;
636
637         if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P'))
638             i = HvKEYS(hv);
639         else {
640             i = 0;
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
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