doop.c

   1 /*    doop.c
   2  *
   3  *    Copyright (c) 1991-1997, 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     char dotype;
 153     char ch;
 154     register char *send;
 155     register SV *arg;
 156     char *xs;
 157     I32 xlen;
 158     I32 pre;
 159     I32 post;
 160     double value;
 161     STRLEN arglen;
 162
 163     sv_setpv(sv,"");
 164     len--;                      /* don't count pattern string */
 165     t = s = SvPV(*sarg, arglen);        /* XXX Don't know t is writeable */
 166     send = s + arglen;
 167     sarg++;
 168     for ( ; ; len--) {
 169
 170         /*SUPPRESS 560*/
 171         if (len <= 0 || !(arg = *sarg++))
 172             arg = &sv_no;
 173
 174         /*SUPPRESS 530*/
 175         for ( ; t < send && *t != '%'; t++) ;
 176         if (t >= send)
 177             break;              /* end of run_format string, ignore extra args */
 178         f = t;
 179         *buf = '\0';
 180         xs = buf;
 181         dotype = '\0';
 182         pre = post = 0;
 183         for (t++; t < send; t++) {
 184             switch (*t) {
 185             default:
 186                 ch = *(++t);
 187                 *t = '\0';
 188                 (void)sprintf(xs,f);
 189                 len++, sarg--;
 190                 xlen = strlen(xs);
 191                 break;
 192             case 'n': case '*':
 193                 croak("Use of %c in printf format not supported", *t);
 194
 195             case '0': case '1': case '2': case '3': case '4':
 196             case '5': case '6': case '7': case '8': case '9':
 197             case '.': case '#': case '-': case '+': case ' ':
 198                 continue;
 199             case 'l':
 200 #ifdef HAS_QUAD
 201                 if (dotype == 'l')
 202                     dotype = 'q';
 203                 else
 204 #endif
 205                     dotype = 'l';
 206                 continue;
 207             case 'h':
 208                 dotype = 's';
 209                 continue;
 210             case 'c':
 211                 ch = *(++t);
 212                 *t = '\0';
 213                 xlen = SvIV(arg);
 214                 if (strEQ(f,"%c")) { /* some printfs fail on null chars */
 215                     *xs = xlen;
 216                     xs[1] = '\0';
 217                     xlen = 1;
 218                 }
 219                 else {
 220                     (void)sprintf(xs,f,xlen);
 221                     xlen = strlen(xs);
 222                 }
 223                 break;
 224             case 'D':
 225                 dotype = 'l';
 226                 /* FALL THROUGH */
 227             case 'd':
 228             case 'i':
 229                 ch = *(++t);
 230                 *t = '\0';
 231                 switch (dotype) {
 232 #ifdef HAS_QUAD
 233                 case 'q':
 234                     /* perl.h says that if quad is available, IV is quad */
 235                     (void)sprintf(xs,f,(Quad_t)SvIV(arg));
 236                     break;
 237 #endif
 238                 case 'l':
 239                     (void)sprintf(xs,f,(long)SvIV(arg));
 240                     break;
 241                 default:
 242                     (void)sprintf(xs,f,(int)SvIV(arg));
 243                     break;
 244                 case 's':
 245                     (void)sprintf(xs,f,(short)SvIV(arg));
 246                     break;
 247                 }
 248                 xlen = strlen(xs);
 249                 break;
 250             case 'X': case 'O':
 251                 dotype = 'l';
 252                 /* FALL THROUGH */
 253             case 'x': case 'o': case 'u':
 254                 ch = *(++t);
 255                 *t = '\0';
 256                 switch (dotype) {
 257 #ifdef HAS_QUAD
 258                 case 'q':
 259                     /* perl.h says that if quad is available, UV is quad */
 260                     (void)sprintf(xs,f,(unsigned Quad_t)SvUV(arg));
 261                     break;
 262 #endif
 263                 case 'l':
 264                     (void)sprintf(xs,f,(unsigned long)SvUV(arg));
 265                     break;
 266                 default:
 267                     (void)sprintf(xs,f,(unsigned int)SvUV(arg));
 268                     break;
 269                 case 's':
 270                     (void)sprintf(xs,f,(unsigned short)SvUV(arg));
 271                     break;
 272                 }
 273                 xlen = strlen(xs);
 274                 break;
 275             case 'E': case 'e': case 'f': case 'G': case 'g':
 276                 ch = *(++t);
 277                 *t = '\0';
 278                 (void)sprintf(xs,f,SvNV(arg));
 279                 xlen = strlen(xs);
 280 #ifdef LC_NUMERIC
 281                 /*
 282                  * User-defined locales may include arbitrary characters.
 283                  * And, unfortunately, some system may alloc the "C" locale
 284                  * to be overridden by a malicious user.
 285                  */
 286                 if (op->op_type == OP_SPRINTF)
 287                     SvTAINTED_on(sv);
 288 #endif /* LC_NUMERIC */
 289                 break;
 290             case 's':
 291                 ch = *(++t);
 292                 *t = '\0';
 293                 xs = SvPV(arg, arglen);
 294                 xlen = (I32)arglen;
 295                 if (strEQ(f,"%s")) {    /* some printfs fail on >128 chars */
 296                     break;              /* so handle simple cases */
 297                 }
 298                 else if (f[1] == '-') {
 299                     char *mp = strchr(f, '.');
 300                     I32 min = atoi(f+2);
 301
 302                     if (mp) {
 303                         I32 max = atoi(mp+1);
 304
 305                         if (xlen > max)
 306                             xlen = max;
 307                     }
 308                     if (xlen < min)
 309                         post = min - xlen;
 310                     break;
 311                 }
 312                 else if (isDIGIT(f[1])) {
 313                     char *mp = strchr(f, '.');
 314                     I32 min = atoi(f+1);
 315
 316                     if (mp) {
 317                         I32 max = atoi(mp+1);
 318
 319                         if (xlen > max)
 320                             xlen = max;
 321                     }
 322                     if (xlen < min)
 323                         pre = min - xlen;
 324                     break;
 325                 }
 326                 strcpy(tokenbuf+64,f);  /* sprintf($s,...$s...) */
 327                 *t = ch;
 328                 (void)sprintf(buf,tokenbuf+64,xs);
 329                 xs = buf;
 330                 xlen = strlen(xs);
 331                 break;
 332             }
 333             /* end of switch, copy results */
 334             *t = ch;
 335             if (xs == buf && xlen >= sizeof(buf)) {     /* Ooops! */
 336                 PerlIO_puts(PerlIO_stderr(),"panic: sprintf overflow - memory corrupted!\n");
 337                 my_exit(1);
 338             }
 339             SvGROW(sv, SvCUR(sv) + (f - s) + xlen + 1 + pre + post);
 340             sv_catpvn(sv, s, f - s);
 341             if (pre) {
 342                 repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, pre);
 343                 SvCUR(sv) += pre;
 344             }
 345             sv_catpvn(sv, xs, xlen);
 346             if (post) {
 347                 repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, post);
 348                 SvCUR(sv) += post;
 349             }
 350             s = t;
 351             break;              /* break from for loop */
 352         }
 353     }
 354     sv_catpvn(sv, s, t - s);
 355     SvSETMAGIC(sv);
 356 }
 357
 358 void
 359 do_vecset(sv)
 360 SV *sv;
 361 {
 362     SV *targ = LvTARG(sv);
 363     register I32 offset;
 364     register I32 size;
 365     register unsigned char *s;
 366     register unsigned long lval;
 367     I32 mask;
 368     STRLEN targlen;
 369     STRLEN len;
 370
 371     if (!targ)
 372         return;
 373     s = (unsigned char*)SvPV_force(targ, targlen);
 374     lval = U_L(SvNV(sv));
 375     offset = LvTARGOFF(sv);
 376     size = LvTARGLEN(sv);
 377
 378     len = (offset + size + 7) / 8;
 379     if (len > targlen) {
 380         s = (unsigned char*)SvGROW(targ, len + 1);
 381         (void)memzero(s + targlen, len - targlen + 1);
 382         SvCUR_set(targ, len);
 383     }
 384
 385     if (size < 8) {
 386         mask = (1 << size) - 1;
 387         size = offset & 7;
 388         lval &= mask;
 389         offset >>= 3;
 390         s[offset] &= ~(mask << size);
 391         s[offset] |= lval << size;
 392     }
 393     else {
 394         offset >>= 3;
 395         if (size == 8)
 396             s[offset] = lval & 255;
 397         else if (size == 16) {
 398             s[offset] = (lval >> 8) & 255;
 399             s[offset+1] = lval & 255;
 400         }
 401         else if (size == 32) {
 402             s[offset] = (lval >> 24) & 255;
 403             s[offset+1] = (lval >> 16) & 255;
 404             s[offset+2] = (lval >> 8) & 255;
 405             s[offset+3] = lval & 255;
 406         }
 407     }
 408 }
 409
 410 void
 411 do_chop(astr,sv)
 412 register SV *astr;
 413 register SV *sv;
 414 {
 415     STRLEN len;
 416     char *s;
 417
 418     if (SvTYPE(sv) == SVt_PVAV) {
 419         register I32 i;
 420         I32 max;
 421         AV* av = (AV*)sv;
 422         max = AvFILL(av);
 423         for (i = 0; i <= max; i++) {
 424             sv = (SV*)av_fetch(av, i, FALSE);
 425             if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
 426                 do_chop(astr, sv);
 427         }
 428         return;
 429     }
 430     if (SvTYPE(sv) == SVt_PVHV) {
 431         HV* hv = (HV*)sv;
 432         HE* entry;
 433         (void)hv_iterinit(hv);
 434         /*SUPPRESS 560*/
 435         while (entry = hv_iternext(hv))
 436             do_chop(astr,hv_iterval(hv,entry));
 437         return;
 438     }
 439     s = SvPV(sv, len);
 440     if (len && !SvPOK(sv))
 441         s = SvPV_force(sv, len);
 442     if (s && len) {
 443         s += --len;
 444         sv_setpvn(astr, s, 1);
 445         *s = '\0';
 446         SvCUR_set(sv, len);
 447         SvNIOK_off(sv);
 448     }
 449     else
 450         sv_setpvn(astr, "", 0);
 451     SvSETMAGIC(sv);
 452 }
 453
 454 I32
 455 do_chomp(sv)
 456 register SV *sv;
 457 {
 458     register I32 count;
 459     STRLEN len;
 460     char *s;
 461
 462     if (RsSNARF(rs))
 463         return 0;
 464     count = 0;
 465     if (SvTYPE(sv) == SVt_PVAV) {
 466         register I32 i;
 467         I32 max;
 468         AV* av = (AV*)sv;
 469         max = AvFILL(av);
 470         for (i = 0; i <= max; i++) {
 471             sv = (SV*)av_fetch(av, i, FALSE);
 472             if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
 473                 count += do_chomp(sv);
 474         }
 475         return count;
 476     }
 477     if (SvTYPE(sv) == SVt_PVHV) {
 478         HV* hv = (HV*)sv;
 479         HE* entry;
 480         (void)hv_iterinit(hv);
 481         /*SUPPRESS 560*/
 482         while (entry = hv_iternext(hv))
 483             count += do_chomp(hv_iterval(hv,entry));
 484         return count;
 485     }
 486     s = SvPV(sv, len);
 487     if (len && !SvPOKp(sv))
 488         s = SvPV_force(sv, len);
 489     if (s && len) {
 490         s += --len;
 491         if (RsPARA(rs)) {
 492             if (*s != '\n')
 493                 goto nope;
 494             ++count;
 495             while (len && s[-1] == '\n') {
 496                 --len;
 497                 --s;
 498                 ++count;
 499             }
 500         }
 501         else {
 502             STRLEN rslen;
 503             char *rsptr = SvPV(rs, rslen);
 504             if (rslen == 1) {
 505                 if (*s != *rsptr)
 506                     goto nope;
 507                 ++count;
 508             }
 509             else {
 510                 if (len < rslen - 1)
 511                     goto nope;
 512                 len -= rslen - 1;
 513                 s -= rslen - 1;
 514                 if (memNE(s, rsptr, rslen))
 515                     goto nope;
 516                 count += rslen;
 517             }
 518         }
 519         *s = '\0';
 520         SvCUR_set(sv, len);
 521         SvNIOK_off(sv);
 522     }
 523   nope:
 524     SvSETMAGIC(sv);
 525     return count;
 526 }
 527
 528 void
 529 do_vop(optype,sv,left,right)
 530 I32 optype;
 531 SV *sv;
 532 SV *left;
 533 SV *right;
 534 {
 535 #ifdef LIBERAL
 536     register long *dl;
 537     register long *ll;
 538     register long *rl;
 539 #endif
 540     register char *dc;
 541     STRLEN leftlen;
 542     STRLEN rightlen;
 543     register char *lc;
 544     register char *rc;
 545     register I32 len;
 546     I32 lensave;
 547     char *lsave;
 548     char *rsave;
 549
 550     if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
 551         sv_setpvn(sv, "", 0);   /* avoid undef warning on |= and ^= */
 552     lsave = lc = SvPV(left, leftlen);
 553     rsave = rc = SvPV(right, rightlen);
 554     len = leftlen < rightlen ? leftlen : rightlen;
 555     lensave = len;
 556     if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
 557         dc = SvPV_force(sv, na);
 558         if (SvCUR(sv) < len) {
 559             dc = SvGROW(sv, len + 1);
 560             (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
 561         }
 562     }
 563     else {
 564         I32 needlen = ((optype == OP_BIT_AND)
 565                         ? len : (leftlen > rightlen ? leftlen : rightlen));
 566         Newz(801, dc, needlen + 1, char);
 567         (void)sv_usepvn(sv, dc, needlen);
 568         dc = SvPVX(sv);         /* sv_usepvn() calls Renew() */
 569     }
 570     SvCUR_set(sv, len);
 571     (void)SvPOK_only(sv);
 572 #ifdef LIBERAL
 573     if (len >= sizeof(long)*4 &&
 574         !((long)dc % sizeof(long)) &&
 575         !((long)lc % sizeof(long)) &&
 576         !((long)rc % sizeof(long)))     /* It's almost always aligned... */
 577     {
 578         I32 remainder = len % (sizeof(long)*4);
 579         len /= (sizeof(long)*4);
 580
 581         dl = (long*)dc;
 582         ll = (long*)lc;
 583         rl = (long*)rc;
 584
 585         switch (optype) {
 586         case OP_BIT_AND:
 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_XOR:
 595             while (len--) {
 596                 *dl++ = *ll++ ^ *rl++;
 597                 *dl++ = *ll++ ^ *rl++;
 598                 *dl++ = *ll++ ^ *rl++;
 599                 *dl++ = *ll++ ^ *rl++;
 600             }
 601             break;
 602         case OP_BIT_OR:
 603             while (len--) {
 604                 *dl++ = *ll++ | *rl++;
 605                 *dl++ = *ll++ | *rl++;
 606                 *dl++ = *ll++ | *rl++;
 607                 *dl++ = *ll++ | *rl++;
 608             }
 609         }
 610
 611         dc = (char*)dl;
 612         lc = (char*)ll;
 613         rc = (char*)rl;
 614
 615         len = remainder;
 616     }
 617 #endif
 618     {
 619         switch (optype) {
 620         case OP_BIT_AND:
 621             while (len--)
 622                 *dc++ = *lc++ & *rc++;
 623             break;
 624         case OP_BIT_XOR:
 625             while (len--)
 626                 *dc++ = *lc++ ^ *rc++;
 627             goto mop_up;
 628         case OP_BIT_OR:
 629             while (len--)
 630                 *dc++ = *lc++ | *rc++;
 631           mop_up:
 632             len = lensave;
 633             if (rightlen > len)
 634                 sv_catpvn(sv, rsave + len, rightlen - len);
 635             else if (leftlen > len)
 636                 sv_catpvn(sv, lsave + len, leftlen - len);
 637             else
 638                 *SvEND(sv) = '\0';
 639             break;
 640         }
 641     }
 642 }
 643
 644 OP *
 645 do_kv(ARGS)
 646 dARGS
 647 {
 648     dSP;
 649     HV *hv = (HV*)POPs;
 650     register HE *entry;
 651     SV *tmpstr;
 652     I32 gimme = GIMME_V;
 653     I32 dokeys =   (op->op_type == OP_KEYS);
 654     I32 dovalues = (op->op_type == OP_VALUES);
 655
 656     if (op->op_type == OP_RV2HV || op->op_type == OP_PADHV)
 657         dokeys = dovalues = TRUE;
 658
 659     if (!hv) {
 660         if (op->op_flags & OPf_MOD) {   /* lvalue */
 661             dTARGET;            /* make sure to clear its target here */
 662             if (SvTYPE(TARG) == SVt_PVLV)
 663                 LvTARG(TARG) = Nullsv;
 664             PUSHs(TARG);
 665         }
 666         RETURN;
 667     }
 668
 669     (void)hv_iterinit(hv);      /* always reset iterator regardless */
 670
 671     if (gimme == G_VOID)
 672         RETURN;
 673
 674     if (gimme == G_SCALAR) {
 675         I32 i;
 676         dTARGET;
 677
 678         if (op->op_flags & OPf_MOD) {   /* lvalue */
 679             if (SvTYPE(TARG) < SVt_PVLV) {
 680                 sv_upgrade(TARG, SVt_PVLV);
 681                 sv_magic(TARG, Nullsv, 'k', Nullch, 0);
 682             }
 683             LvTYPE(TARG) = 'k';
 684             LvTARG(TARG) = (SV*)hv;
 685             PUSHs(TARG);
 686             RETURN;
 687         }
 688
 689         if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P'))
 690             i = HvKEYS(hv);
 691         else {
 692             i = 0;
 693             /*SUPPRESS 560*/
 694             while (entry = hv_iternext(hv)) {
 695                 i++;
 696             }
 697         }
 698         PUSHi( i );
 699         RETURN;
 700     }
 701
 702     /* Guess how much room we need.  hv_max may be a few too many.  Oh well. */
 703     EXTEND(sp, HvMAX(hv) * (dokeys + dovalues));
 704
 705     PUTBACK;    /* hv_iternext and hv_iterval might clobber stack_sp */
 706     while (entry = hv_iternext(hv)) {
 707         SPAGAIN;
 708         if (dokeys)
 709             XPUSHs(hv_iterkeysv(entry));        /* won't clobber stack_sp */
 710         if (dovalues) {
 711             tmpstr = NEWSV(45,0);
 712             PUTBACK;
 713             sv_setsv(tmpstr,hv_iterval(hv,entry));
 714             SPAGAIN;
 715             DEBUG_H( {
 716                         sprintf(buf,"%lu%%%d=%lu\n",
 717                                 (unsigned long)HeHASH(entry),
 718                                 HvMAX(hv)+1,
 719                                 (unsigned long)(HeHASH(entry) & HvMAX(hv)));
 720                         sv_setpv(tmpstr,buf);
 721             } )
 722             XPUSHs(sv_2mortal(tmpstr));
 723         }
 724         PUTBACK;
 725     }
 726     return NORMAL;
 727 }
 728