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 #ifdef LC_NUMERIC
 277                 /*
 278                  * User-defined locales may include arbitrary characters.
 279                  * And, unfortunately, some system may alloc the "C" locale
 280                  * to be overridden by a malicious user.
 281                  */
 282                 if (op->op_type == OP_SPRINTF)
 283                     SvTAINTED_on(sv);
 284 #endif /* LC_NUMERIC */
 285                 break;
 286             case 's':
 287                 ch = *(++t);
 288                 *t = '\0';
 289                 xs = SvPV(arg, arglen);
 290                 xlen = (I32)arglen;
 291                 if (strEQ(f,"%s")) {    /* some printfs fail on >128 chars */
 292                     break;              /* so handle simple cases */
 293                 }
 294                 else if (f[1] == '-') {
 295                     char *mp = strchr(f, '.');
 296                     I32 min = atoi(f+2);
 297
 298                     if (mp) {
 299                         I32 max = atoi(mp+1);
 300
 301                         if (xlen > max)
 302                             xlen = max;
 303                     }
 304                     if (xlen < min)
 305                         post = min - xlen;
 306                     break;
 307                 }
 308                 else if (isDIGIT(f[1])) {
 309                     char *mp = strchr(f, '.');
 310                     I32 min = atoi(f+1);
 311
 312                     if (mp) {
 313                         I32 max = atoi(mp+1);
 314
 315                         if (xlen > max)
 316                             xlen = max;
 317                     }
 318                     if (xlen < min)
 319                         pre = min - xlen;
 320                     break;
 321                 }
 322                 strcpy(tokenbuf+64,f);  /* sprintf($s,...$s...) */
 323                 *t = ch;
 324                 (void)sprintf(buf,tokenbuf+64,xs);
 325                 xs = buf;
 326                 xlen = strlen(xs);
 327                 break;
 328             }
 329             /* end of switch, copy results */
 330             *t = ch;
 331             if (xs == buf && xlen >= sizeof(buf)) {     /* Ooops! */
 332                 PerlIO_puts(PerlIO_stderr(),"panic: sprintf overflow - memory corrupted!\n");
 333                 my_exit(1);
 334             }
 335             SvGROW(sv, SvCUR(sv) + (f - s) + xlen + 1 + pre + post);
 336             sv_catpvn(sv, s, f - s);
 337             if (pre) {
 338                 repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, pre);
 339                 SvCUR(sv) += pre;
 340             }
 341             sv_catpvn(sv, xs, xlen);
 342             if (post) {
 343                 repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, post);
 344                 SvCUR(sv) += post;
 345             }
 346             s = t;
 347             break;              /* break from for loop */
 348         }
 349     }
 350     sv_catpvn(sv, s, t - s);
 351     SvSETMAGIC(sv);
 352 }
 353
 354 void
 355 do_vecset(sv)
 356 SV *sv;
 357 {
 358     SV *targ = LvTARG(sv);
 359     register I32 offset;
 360     register I32 size;
 361     register unsigned char *s;
 362     register unsigned long lval;
 363     I32 mask;
 364     STRLEN targlen;
 365     STRLEN len;
 366
 367     if (!targ)
 368         return;
 369     s = (unsigned char*)SvPV_force(targ, targlen);
 370     lval = U_L(SvNV(sv));
 371     offset = LvTARGOFF(sv);
 372     size = LvTARGLEN(sv);
 373
 374     len = (offset + size + 7) / 8;
 375     if (len > targlen) {
 376         s = (unsigned char*)SvGROW(targ, len + 1);
 377         (void)memzero(s + targlen, len - targlen + 1);
 378         SvCUR_set(targ, len);
 379     }
 380
 381     if (size < 8) {
 382         mask = (1 << size) - 1;
 383         size = offset & 7;
 384         lval &= mask;
 385         offset >>= 3;
 386         s[offset] &= ~(mask << size);
 387         s[offset] |= lval << size;
 388     }
 389     else {
 390         offset >>= 3;
 391         if (size == 8)
 392             s[offset] = lval & 255;
 393         else if (size == 16) {
 394             s[offset] = (lval >> 8) & 255;
 395             s[offset+1] = lval & 255;
 396         }
 397         else if (size == 32) {
 398             s[offset] = (lval >> 24) & 255;
 399             s[offset+1] = (lval >> 16) & 255;
 400             s[offset+2] = (lval >> 8) & 255;
 401             s[offset+3] = lval & 255;
 402         }
 403     }
 404 }
 405
 406 void
 407 do_chop(astr,sv)
 408 register SV *astr;
 409 register SV *sv;
 410 {
 411     STRLEN len;
 412     char *s;
 413
 414     if (SvTYPE(sv) == SVt_PVAV) {
 415         register I32 i;
 416         I32 max;
 417         AV* av = (AV*)sv;
 418         max = AvFILL(av);
 419         for (i = 0; i <= max; i++) {
 420             sv = (SV*)av_fetch(av, i, FALSE);
 421             if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
 422                 do_chop(astr, sv);
 423         }
 424         return;
 425     }
 426     if (SvTYPE(sv) == SVt_PVHV) {
 427         HV* hv = (HV*)sv;
 428         HE* entry;
 429         (void)hv_iterinit(hv);
 430         /*SUPPRESS 560*/
 431         while (entry = hv_iternext(hv))
 432             do_chop(astr,hv_iterval(hv,entry));
 433         return;
 434     }
 435     s = SvPV(sv, len);
 436     if (len && !SvPOK(sv))
 437         s = SvPV_force(sv, len);
 438     if (s && len) {
 439         s += --len;
 440         sv_setpvn(astr, s, 1);
 441         *s = '\0';
 442         SvCUR_set(sv, len);
 443         SvNIOK_off(sv);
 444     }
 445     else
 446         sv_setpvn(astr, "", 0);
 447     SvSETMAGIC(sv);
 448 }
 449
 450 I32
 451 do_chomp(sv)
 452 register SV *sv;
 453 {
 454     register I32 count;
 455     STRLEN len;
 456     char *s;
 457
 458     if (RsSNARF(rs))
 459         return 0;
 460     count = 0;
 461     if (SvTYPE(sv) == SVt_PVAV) {
 462         register I32 i;
 463         I32 max;
 464         AV* av = (AV*)sv;
 465         max = AvFILL(av);
 466         for (i = 0; i <= max; i++) {
 467             sv = (SV*)av_fetch(av, i, FALSE);
 468             if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
 469                 count += do_chomp(sv);
 470         }
 471         return count;
 472     }
 473     if (SvTYPE(sv) == SVt_PVHV) {
 474         HV* hv = (HV*)sv;
 475         HE* entry;
 476         (void)hv_iterinit(hv);
 477         /*SUPPRESS 560*/
 478         while (entry = hv_iternext(hv))
 479             count += do_chomp(hv_iterval(hv,entry));
 480         return count;
 481     }
 482     s = SvPV(sv, len);
 483     if (len && !SvPOKp(sv))
 484         s = SvPV_force(sv, len);
 485     if (s && len) {
 486         s += --len;
 487         if (RsPARA(rs)) {
 488             if (*s != '\n')
 489                 goto nope;
 490             ++count;
 491             while (len && s[-1] == '\n') {
 492                 --len;
 493                 --s;
 494                 ++count;
 495             }
 496         }
 497         else {
 498             STRLEN rslen;
 499             char *rsptr = SvPV(rs, rslen);
 500             if (rslen == 1) {
 501                 if (*s != *rsptr)
 502                     goto nope;
 503                 ++count;
 504             }
 505             else {
 506                 if (len < rslen - 1)
 507                     goto nope;
 508                 len -= rslen - 1;
 509                 s -= rslen - 1;
 510                 if (memcmp(s, rsptr, rslen))
 511                     goto nope;
 512                 count += rslen;
 513             }
 514         }
 515         *s = '\0';
 516         SvCUR_set(sv, len);
 517         SvNIOK_off(sv);
 518     }
 519   nope:
 520     SvSETMAGIC(sv);
 521     return count;
 522 }
 523
 524 void
 525 do_vop(optype,sv,left,right)
 526 I32 optype;
 527 SV *sv;
 528 SV *left;
 529 SV *right;
 530 {
 531 #ifdef LIBERAL
 532     register long *dl;
 533     register long *ll;
 534     register long *rl;
 535 #endif
 536     register char *dc;
 537     STRLEN leftlen;
 538     STRLEN rightlen;
 539     register char *lc = SvPV(left, leftlen);
 540     register char *rc = SvPV(right, rightlen);
 541     register I32 len;
 542     I32 lensave;
 543     char *lsave = lc;
 544     char *rsave = rc;
 545
 546     len = leftlen < rightlen ? leftlen : rightlen;
 547     lensave = len;
 548     if (SvOK(sv)) {
 549         dc = SvPV_force(sv, na);
 550         if (SvCUR(sv) < len) {
 551             dc = SvGROW(sv, len + 1);
 552             (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
 553         }
 554     }
 555     else {
 556         I32 needlen = ((optype == OP_BIT_AND)
 557                         ? len : (leftlen > rightlen ? leftlen : rightlen));
 558         Newz(801, dc, needlen + 1, char);
 559         (void)sv_usepvn(sv, dc, needlen);
 560         dc = SvPVX(sv);         /* sv_usepvn() calls Renew() */
 561     }
 562     SvCUR_set(sv, len);
 563     (void)SvPOK_only(sv);
 564 #ifdef LIBERAL
 565     if (len >= sizeof(long)*4 &&
 566         !((long)dc % sizeof(long)) &&
 567         !((long)lc % sizeof(long)) &&
 568         !((long)rc % sizeof(long)))     /* It's almost always aligned... */
 569     {
 570         I32 remainder = len % (sizeof(long)*4);
 571         len /= (sizeof(long)*4);
 572
 573         dl = (long*)dc;
 574         ll = (long*)lc;
 575         rl = (long*)rc;
 576
 577         switch (optype) {
 578         case OP_BIT_AND:
 579             while (len--) {
 580                 *dl++ = *ll++ & *rl++;
 581                 *dl++ = *ll++ & *rl++;
 582                 *dl++ = *ll++ & *rl++;
 583                 *dl++ = *ll++ & *rl++;
 584             }
 585             break;
 586         case OP_BIT_XOR:
 587             while (len--) {
 588                 *dl++ = *ll++ ^ *rl++;
 589                 *dl++ = *ll++ ^ *rl++;
 590                 *dl++ = *ll++ ^ *rl++;
 591                 *dl++ = *ll++ ^ *rl++;
 592             }
 593             break;
 594         case OP_BIT_OR:
 595             while (len--) {
 596                 *dl++ = *ll++ | *rl++;
 597                 *dl++ = *ll++ | *rl++;
 598                 *dl++ = *ll++ | *rl++;
 599                 *dl++ = *ll++ | *rl++;
 600             }
 601         }
 602
 603         dc = (char*)dl;
 604         lc = (char*)ll;
 605         rc = (char*)rl;
 606
 607         len = remainder;
 608     }
 609 #endif
 610     {
 611         switch (optype) {
 612         case OP_BIT_AND:
 613             while (len--)
 614                 *dc++ = *lc++ & *rc++;
 615             break;
 616         case OP_BIT_XOR:
 617             while (len--)
 618                 *dc++ = *lc++ ^ *rc++;
 619             goto mop_up;
 620         case OP_BIT_OR:
 621             while (len--)
 622                 *dc++ = *lc++ | *rc++;
 623           mop_up:
 624             len = lensave;
 625             if (rightlen > len)
 626                 sv_catpvn(sv, rsave + len, rightlen - len);
 627             else if (leftlen > len)
 628                 sv_catpvn(sv, lsave + len, leftlen - len);
 629             else
 630                 *SvEND(sv) = '\0';
 631             break;
 632         }
 633     }
 634 }
 635
 636 OP *
 637 do_kv(ARGS)
 638 dARGS
 639 {
 640     dSP;
 641     HV *hv = (HV*)POPs;
 642     register HE *entry;
 643     SV *tmpstr;
 644     I32 dokeys =   (op->op_type == OP_KEYS);
 645     I32 dovalues = (op->op_type == OP_VALUES);
 646
 647     if (op->op_type == OP_RV2HV || op->op_type == OP_PADHV)
 648         dokeys = dovalues = TRUE;
 649
 650     if (!hv) {
 651         if (op->op_flags & OPf_MOD) {   /* lvalue */
 652             dTARGET;            /* make sure to clear its target here */
 653             if (SvTYPE(TARG) == SVt_PVLV)
 654                 LvTARG(TARG) = Nullsv;
 655             PUSHs(TARG);
 656         }
 657         RETURN;
 658     }
 659
 660     (void)hv_iterinit(hv);      /* always reset iterator regardless */
 661
 662     if (GIMME != G_ARRAY) {
 663         I32 i;
 664         dTARGET;
 665
 666         if (op->op_flags & OPf_MOD) {   /* lvalue */
 667             if (SvTYPE(TARG) < SVt_PVLV) {
 668                 sv_upgrade(TARG, SVt_PVLV);
 669                 sv_magic(TARG, Nullsv, 'k', Nullch, 0);
 670             }
 671             LvTYPE(TARG) = 'k';
 672             LvTARG(TARG) = (SV*)hv;
 673             PUSHs(TARG);
 674             RETURN;
 675         }
 676
 677         if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P'))
 678             i = HvKEYS(hv);
 679         else {
 680             i = 0;
 681             /*SUPPRESS 560*/
 682             while (entry = hv_iternext(hv)) {
 683                 i++;
 684             }
 685         }
 686         PUSHi( i );
 687         RETURN;
 688     }
 689
 690     /* Guess how much room we need.  hv_max may be a few too many.  Oh well. */
 691     EXTEND(sp, HvMAX(hv) * (dokeys + dovalues));
 692
 693     PUTBACK;    /* hv_iternext and hv_iterval might clobber stack_sp */
 694     while (entry = hv_iternext(hv)) {
 695         SPAGAIN;
 696         if (dokeys)
 697             XPUSHs(hv_iterkeysv(entry));        /* won't clobber stack_sp */
 698         if (dovalues) {
 699             tmpstr = NEWSV(45,0);
 700             PUTBACK;
 701             sv_setsv(tmpstr,hv_iterval(hv,entry));
 702             SPAGAIN;
 703             DEBUG_H( {
 704                         sprintf(buf,"%d%%%d=%d\n", HeHASH(entry),
 705                                 HvMAX(hv)+1, HeHASH(entry) & HvMAX(hv));
 706                         sv_setpv(tmpstr,buf);
 707             } )
 708             XPUSHs(sv_2mortal(tmpstr));
 709         }
 710         PUTBACK;
 711     }
 712     return NORMAL;
 713 }
 714