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 I32
  22 do_trans(sv,arg)
  23 SV *sv;
  24 OP *arg;
  25 {
  26     register short *tbl;
  27     register U8 *s;
  28     register U8 *send;
  29     register U8 *d;
  30     register I32 ch;
  31     register I32 matches = 0;
  32     register I32 squash = op->op_private & OPpTRANS_SQUASH;
  33     STRLEN len;
  34
  35     if (SvREADONLY(sv))
  36         croak(no_modify);
  37     tbl = (short*)cPVOP->op_pv;
  38     s = (U8*)SvPV(sv, len);
  39     if (!len)
  40         return 0;
  41     if (!SvPOKp(sv))
  42         s = (U8*)SvPV_force(sv, len);
  43     (void)SvPOK_only(sv);
  44     send = s + len;
  45     if (!tbl || !s)
  46         croak("panic: do_trans");
  47     DEBUG_t( deb("2.TBL\n"));
  48     if (!op->op_private) {
  49         while (s < send) {
  50             if ((ch = tbl[*s]) >= 0) {
  51                 matches++;
  52                 *s = ch;
  53             }
  54             s++;
  55         }
  56     }
  57     else {
  58         d = s;
  59         while (s < send) {
  60             if ((ch = tbl[*s]) >= 0) {
  61                 *d = ch;
  62                 if (matches++ && squash) {
  63                     if (d[-1] == *d)
  64                         matches--;
  65                     else
  66                         d++;
  67                 }
  68                 else
  69                     d++;
  70             }
  71             else if (ch == -1)          /* -1 is unmapped character */
  72                 *d++ = *s;              /* -2 is delete character */
  73             s++;
  74         }
  75         matches += send - d;    /* account for disappeared chars */
  76         *d = '\0';
  77         SvCUR_set(sv, d - (U8*)SvPVX(sv));
  78     }
  79     SvSETMAGIC(sv);
  80     return matches;
  81 }
  82
  83 void
  84 do_join(sv,del,mark,sp)
  85 register SV *sv;
  86 SV *del;
  87 register SV **mark;
  88 register SV **sp;
  89 {
  90     SV **oldmark = mark;
  91     register I32 items = sp - mark;
  92     register STRLEN len;
  93     STRLEN delimlen;
  94     register char *delim = SvPV(del, delimlen);
  95     STRLEN tmplen;
  96
  97     mark++;
  98     len = (items > 0 ? (delimlen * (items - 1) ) : 0);
  99     if (SvTYPE(sv) < SVt_PV)
 100         sv_upgrade(sv, SVt_PV);
 101     if (SvLEN(sv) < len + items) {      /* current length is way too short */
 102         while (items-- > 0) {
 103             if (*mark) {
 104                 SvPV(*mark, tmplen);
 105                 len += tmplen;
 106             }
 107             mark++;
 108         }
 109         SvGROW(sv, len + 1);            /* so try to pre-extend */
 110
 111         mark = oldmark;
 112         items = sp - mark;;
 113         ++mark;
 114     }
 115
 116     if (items-- > 0) {
 117         char *s;
 118
 119         if (*mark) {
 120             s = SvPV(*mark, tmplen);
 121             sv_setpvn(sv, s, tmplen);
 122         }
 123         else
 124             sv_setpv(sv, "");
 125         mark++;
 126     }
 127     else
 128         sv_setpv(sv,"");
 129     len = delimlen;
 130     if (len) {
 131         for (; items > 0; items--,mark++) {
 132             sv_catpvn(sv,delim,len);
 133             sv_catsv(sv,*mark);
 134         }
 135     }
 136     else {
 137         for (; items > 0; items--,mark++)
 138             sv_catsv(sv,*mark);
 139     }
 140     SvSETMAGIC(sv);
 141 }
 142
 143 void
 144 do_sprintf(sv,len,sarg)
 145 register SV *sv;
 146 register I32 len;
 147 register SV **sarg;
 148 {
 149     register char *s;
 150     register char *t;
 151     register char *f;
 152     bool dolong;
 153 #ifdef HAS_QUAD
 154     bool doquad;
 155 #endif /* HAS_QUAD */
 156     char ch;
 157     register char *send;
 158     register SV *arg;
 159     char *xs;
 160     I32 xlen;
 161     I32 pre;
 162     I32 post;
 163     double value;
 164     STRLEN arglen;
 165
 166     sv_setpv(sv,"");
 167     len--;                      /* don't count pattern string */
 168     t = s = SvPV(*sarg, arglen);        /* XXX Don't know t is writeable */
 169     send = s + arglen;
 170     sarg++;
 171     for ( ; ; len--) {
 172
 173         /*SUPPRESS 560*/
 174         if (len <= 0 || !(arg = *sarg++))
 175             arg = &sv_no;
 176
 177         /*SUPPRESS 530*/
 178         for ( ; t < send && *t != '%'; t++) ;
 179         if (t >= send)
 180             break;              /* end of run_format string, ignore extra args */
 181         f = t;
 182         *buf = '\0';
 183         xs = buf;
 184 #ifdef HAS_QUAD
 185         doquad =
 186 #endif /* HAS_QUAD */
 187         dolong = FALSE;
 188         pre = post = 0;
 189         for (t++; t < send; t++) {
 190             switch (*t) {
 191             default:
 192                 ch = *(++t);
 193                 *t = '\0';
 194                 (void)sprintf(xs,f);
 195                 len++, sarg--;
 196                 xlen = strlen(xs);
 197                 break;
 198             case 'n': case '*':
 199                 croak("Use of %c in printf format not supported", *t);
 200
 201             case '0': case '1': case '2': case '3': case '4':
 202             case '5': case '6': case '7': case '8': case '9':
 203             case '.': case '#': case '-': case '+': case ' ':
 204                 continue;
 205             case 'l':
 206 #ifdef HAS_QUAD
 207                 if (dolong) {
 208                     dolong = FALSE;
 209                     doquad = TRUE;
 210                 } else
 211 #endif
 212                 dolong = TRUE;
 213                 continue;
 214             case 'c':
 215                 ch = *(++t);
 216                 *t = '\0';
 217                 xlen = SvIV(arg);
 218                 if (strEQ(f,"%c")) { /* some printfs fail on null chars */
 219                     *xs = xlen;
 220                     xs[1] = '\0';
 221                     xlen = 1;
 222                 }
 223                 else {
 224                     (void)sprintf(xs,f,xlen);
 225                     xlen = strlen(xs);
 226                 }
 227                 break;
 228             case 'D':
 229                 dolong = TRUE;
 230                 /* FALL THROUGH */
 231             case 'd':
 232                 ch = *(++t);
 233                 *t = '\0';
 234 #ifdef HAS_QUAD
 235                 if (doquad)
 236                     (void)sprintf(buf,s,(Quad_t)SvNV(arg));
 237                 else
 238 #endif
 239                 if (dolong)
 240                     (void)sprintf(xs,f,(long)SvNV(arg));
 241                 else
 242                     (void)sprintf(xs,f,SvIV(arg));
 243                 xlen = strlen(xs);
 244                 break;
 245             case 'X': case 'O':
 246                 dolong = TRUE;
 247                 /* FALL THROUGH */
 248             case 'x': case 'o': case 'u':
 249                 ch = *(++t);
 250                 *t = '\0';
 251                 value = SvNV(arg);
 252 #ifdef HAS_QUAD
 253                 if (doquad)
 254                     (void)sprintf(buf,s,(unsigned Quad_t)value);
 255                 else
 256 #endif
 257                 if (dolong)
 258                     (void)sprintf(xs,f,U_L(value));
 259                 else
 260                     (void)sprintf(xs,f,U_I(value));
 261                 xlen = strlen(xs);
 262                 break;
 263             case 'E': case 'e': case 'f': case 'G': case 'g':
 264                 ch = *(++t);
 265                 *t = '\0';
 266                 (void)sprintf(xs,f,SvNV(arg));
 267                 xlen = strlen(xs);
 268 #ifdef LC_NUMERIC
 269                 /*
 270                  * User-defined locales may include arbitrary characters.
 271                  * And, unfortunately, some system may alloc the "C" locale
 272                  * to be overridden by a malicious user.
 273                  */
 274                 if (op->op_type == OP_SPRINTF)
 275                     SvTAINTED_on(sv);
 276 #endif /* LC_NUMERIC */
 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                 PerlIO_puts(PerlIO_stderr(),"panic: sprintf overflow - memory corrupted!\n");
 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 - 1)
 499                     goto nope;
 500                 len -= rslen - 1;
 501                 s -= rslen - 1;
 502                 if (memNE(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;
 532     register char *rc;
 533     register I32 len;
 534     I32 lensave;
 535     char *lsave;
 536     char *rsave;
 537
 538     if (sv == left && !SvOK(sv) && !SvGMAGICAL(sv) && SvTYPE(sv) <= SVt_PVMG)
 539         sv_setpvn(sv, "", 0);   /* avoid warning on &= etc. */
 540     lsave = lc = SvPV(left, leftlen);
 541     rsave = rc = SvPV(right, rightlen);
 542     len = leftlen < rightlen ? leftlen : rightlen;
 543     lensave = len;
 544     if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
 545         dc = SvPV_force(sv, na);
 546         if (SvCUR(sv) < len) {
 547             dc = SvGROW(sv, len + 1);
 548             (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
 549         }
 550     }
 551     else {
 552         I32 needlen = ((optype == OP_BIT_AND)
 553                         ? len : (leftlen > rightlen ? leftlen : rightlen));
 554         Newz(801, dc, needlen + 1, char);
 555         (void)sv_usepvn(sv, dc, needlen);
 556         dc = SvPVX(sv);         /* sv_usepvn() calls Renew() */
 557     }
 558     SvCUR_set(sv, len);
 559     (void)SvPOK_only(sv);
 560 #ifdef LIBERAL
 561     if (len >= sizeof(long)*4 &&
 562         !((long)dc % sizeof(long)) &&
 563         !((long)lc % sizeof(long)) &&
 564         !((long)rc % sizeof(long)))     /* It's almost always aligned... */
 565     {
 566         I32 remainder = len % (sizeof(long)*4);
 567         len /= (sizeof(long)*4);
 568
 569         dl = (long*)dc;
 570         ll = (long*)lc;
 571         rl = (long*)rc;
 572
 573         switch (optype) {
 574         case OP_BIT_AND:
 575             while (len--) {
 576                 *dl++ = *ll++ & *rl++;
 577                 *dl++ = *ll++ & *rl++;
 578                 *dl++ = *ll++ & *rl++;
 579                 *dl++ = *ll++ & *rl++;
 580             }
 581             break;
 582         case OP_BIT_XOR:
 583             while (len--) {
 584                 *dl++ = *ll++ ^ *rl++;
 585                 *dl++ = *ll++ ^ *rl++;
 586                 *dl++ = *ll++ ^ *rl++;
 587                 *dl++ = *ll++ ^ *rl++;
 588             }
 589             break;
 590         case OP_BIT_OR:
 591             while (len--) {
 592                 *dl++ = *ll++ | *rl++;
 593                 *dl++ = *ll++ | *rl++;
 594                 *dl++ = *ll++ | *rl++;
 595                 *dl++ = *ll++ | *rl++;
 596             }
 597         }
 598
 599         dc = (char*)dl;
 600         lc = (char*)ll;
 601         rc = (char*)rl;
 602
 603         len = remainder;
 604     }
 605 #endif
 606     {
 607         switch (optype) {
 608         case OP_BIT_AND:
 609             while (len--)
 610                 *dc++ = *lc++ & *rc++;
 611             break;
 612         case OP_BIT_XOR:
 613             while (len--)
 614                 *dc++ = *lc++ ^ *rc++;
 615             goto mop_up;
 616         case OP_BIT_OR:
 617             while (len--)
 618                 *dc++ = *lc++ | *rc++;
 619           mop_up:
 620             len = lensave;
 621             if (rightlen > len)
 622                 sv_catpvn(sv, rsave + len, rightlen - len);
 623             else if (leftlen > len)
 624                 sv_catpvn(sv, lsave + len, leftlen - len);
 625             else
 626                 *SvEND(sv) = '\0';
 627             break;
 628         }
 629     }
 630 }
 631
 632 OP *
 633 do_kv(ARGS)
 634 dARGS
 635 {
 636     dSP;
 637     HV *hv = (HV*)POPs;
 638     register HE *entry;
 639     SV *tmpstr;
 640     I32 dokeys =   (op->op_type == OP_KEYS);
 641     I32 dovalues = (op->op_type == OP_VALUES);
 642
 643     if (op->op_type == OP_RV2HV || op->op_type == OP_PADHV)
 644         dokeys = dovalues = TRUE;
 645
 646     if (!hv) {
 647         if (op->op_flags & OPf_MOD) {   /* lvalue */
 648             dTARGET;            /* make sure to clear its target here */
 649             if (SvTYPE(TARG) == SVt_PVLV)
 650                 LvTARG(TARG) = Nullsv;
 651             PUSHs(TARG);
 652         }
 653         RETURN;
 654     }
 655
 656     (void)hv_iterinit(hv);      /* always reset iterator regardless */
 657
 658     if (GIMME != G_ARRAY) {
 659         I32 i;
 660         dTARGET;
 661
 662         if (op->op_flags & OPf_MOD) {   /* lvalue */
 663             if (SvTYPE(TARG) < SVt_PVLV) {
 664                 sv_upgrade(TARG, SVt_PVLV);
 665                 sv_magic(TARG, Nullsv, 'k', Nullch, 0);
 666             }
 667             LvTYPE(TARG) = 'k';
 668             LvTARG(TARG) = (SV*)hv;
 669             PUSHs(TARG);
 670             RETURN;
 671         }
 672
 673         if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P'))
 674             i = HvKEYS(hv);
 675         else {
 676             i = 0;
 677             /*SUPPRESS 560*/
 678             while (entry = hv_iternext(hv)) {
 679                 i++;
 680             }
 681         }
 682         PUSHi( i );
 683         RETURN;
 684     }
 685
 686     /* Guess how much room we need.  hv_max may be a few too many.  Oh well. */
 687     EXTEND(sp, HvMAX(hv) * (dokeys + dovalues));
 688
 689     PUTBACK;    /* hv_iternext and hv_iterval might clobber stack_sp */
 690     while (entry = hv_iternext(hv)) {
 691         SPAGAIN;
 692         if (dokeys)
 693             XPUSHs(hv_iterkeysv(entry));        /* won't clobber stack_sp */
 694         if (dovalues) {
 695             tmpstr = NEWSV(45,0);
 696             PUTBACK;
 697             sv_setsv(tmpstr,hv_iterval(hv,entry));
 698             SPAGAIN;
 699             DEBUG_H( {
 700                         sprintf(buf,"%d%%%d=%d\n", HeHASH(entry),
 701                                 HvMAX(hv)+1, HeHASH(entry) & HvMAX(hv));
 702                         sv_setpv(tmpstr,buf);
 703             } )
 704             XPUSHs(sv_2mortal(tmpstr));
 705         }
 706         PUTBACK;
 707     }
 708     return NORMAL;
 709 }
 710