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 '0': case '1': case '2': case '3': case '4':
 207             case '5': case '6': case '7': case '8': case '9':
 208             case '.': case '#': case '-': case '+': case ' ':
 209                 continue;
 210             case 'l':
 211 #ifdef HAS_QUAD
 212                 if (dolong) {
 213                     dolong = FALSE;
 214                     doquad = TRUE;
 215                 } else
 216 #endif
 217                 dolong = TRUE;
 218                 continue;
 219             case 'c':
 220                 ch = *(++t);
 221                 *t = '\0';
 222                 xlen = SvIV(arg);
 223                 if (strEQ(f,"%c")) { /* some printfs fail on null chars */
 224                     *xs = xlen;
 225                     xs[1] = '\0';
 226                     xlen = 1;
 227                 }
 228                 else {
 229                     (void)sprintf(xs,f,xlen);
 230                     xlen = strlen(xs);
 231                 }
 232                 break;
 233             case 'D':
 234                 dolong = TRUE;
 235                 /* FALL THROUGH */
 236             case 'd':
 237                 ch = *(++t);
 238                 *t = '\0';
 239 #ifdef HAS_QUAD
 240                 if (doquad)
 241                     (void)sprintf(buf,s,(Quad_t)SvNV(arg));
 242                 else
 243 #endif
 244                 if (dolong)
 245                     (void)sprintf(xs,f,(long)SvNV(arg));
 246                 else
 247                     (void)sprintf(xs,f,SvIV(arg));
 248                 xlen = strlen(xs);
 249                 break;
 250             case 'X': case 'O':
 251                 dolong = TRUE;
 252                 /* FALL THROUGH */
 253             case 'x': case 'o': case 'u':
 254                 ch = *(++t);
 255                 *t = '\0';
 256                 value = SvNV(arg);
 257 #ifdef HAS_QUAD
 258                 if (doquad)
 259                     (void)sprintf(buf,s,(unsigned Quad_t)value);
 260                 else
 261 #endif
 262                 if (dolong)
 263                     (void)sprintf(xs,f,U_L(value));
 264                 else
 265                     (void)sprintf(xs,f,U_I(value));
 266                 xlen = strlen(xs);
 267                 break;
 268             case 'E': case 'e': case 'f': case 'G': case 'g':
 269                 ch = *(++t);
 270                 *t = '\0';
 271                 (void)sprintf(xs,f,SvNV(arg));
 272                 xlen = strlen(xs);
 273                 break;
 274             case 's':
 275                 ch = *(++t);
 276                 *t = '\0';
 277                 xs = SvPV(arg, arglen);
 278                 xlen = (I32)arglen;
 279                 if (strEQ(f,"%s")) {    /* some printfs fail on >128 chars */
 280                     break;              /* so handle simple cases */
 281                 }
 282                 else if (f[1] == '-') {
 283                     char *mp = strchr(f, '.');
 284                     I32 min = atoi(f+2);
 285
 286                     if (mp) {
 287                         I32 max = atoi(mp+1);
 288
 289                         if (xlen > max)
 290                             xlen = max;
 291                     }
 292                     if (xlen < min)
 293                         post = min - xlen;
 294                     break;
 295                 }
 296                 else if (isDIGIT(f[1])) {
 297                     char *mp = strchr(f, '.');
 298                     I32 min = atoi(f+1);
 299
 300                     if (mp) {
 301                         I32 max = atoi(mp+1);
 302
 303                         if (xlen > max)
 304                             xlen = max;
 305                     }
 306                     if (xlen < min)
 307                         pre = min - xlen;
 308                     break;
 309                 }
 310                 strcpy(tokenbuf+64,f);  /* sprintf($s,...$s...) */
 311                 *t = ch;
 312                 (void)sprintf(buf,tokenbuf+64,xs);
 313                 xs = buf;
 314                 xlen = strlen(xs);
 315                 break;
 316             }
 317             /* end of switch, copy results */
 318             *t = ch;
 319             SvGROW(sv, SvCUR(sv) + (f - s) + xlen + 1 + pre + post);
 320             sv_catpvn(sv, s, f - s);
 321             if (pre) {
 322                 repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, pre);
 323                 SvCUR(sv) += pre;
 324             }
 325             sv_catpvn(sv, xs, xlen);
 326             if (post) {
 327                 repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, post);
 328                 SvCUR(sv) += post;
 329             }
 330             s = t;
 331             break;              /* break from for loop */
 332         }
 333     }
 334     sv_catpvn(sv, s, t - s);
 335     SvSETMAGIC(sv);
 336 }
 337
 338 void
 339 do_vecset(sv)
 340 SV *sv;
 341 {
 342     SV *targ = LvTARG(sv);
 343     register I32 offset;
 344     register I32 size;
 345     register unsigned char *s;
 346     register unsigned long lval;
 347     I32 mask;
 348     STRLEN targlen;
 349     STRLEN len;
 350
 351     if (!targ)
 352         return;
 353     s = (unsigned char*)SvPV_force(targ, targlen);
 354     lval = U_L(SvNV(sv));
 355     offset = LvTARGOFF(sv);
 356     size = LvTARGLEN(sv);
 357
 358     len = (offset + size + 7) / 8;
 359     if (len > targlen) {
 360         s = (unsigned char*)SvGROW(targ, len + 1);
 361         (void)memzero(s + targlen, len - targlen + 1);
 362         SvCUR_set(targ, len);
 363     }
 364
 365     if (size < 8) {
 366         mask = (1 << size) - 1;
 367         size = offset & 7;
 368         lval &= mask;
 369         offset >>= 3;
 370         s[offset] &= ~(mask << size);
 371         s[offset] |= lval << size;
 372     }
 373     else {
 374         offset >>= 3;
 375         if (size == 8)
 376             s[offset] = lval & 255;
 377         else if (size == 16) {
 378             s[offset] = (lval >> 8) & 255;
 379             s[offset+1] = lval & 255;
 380         }
 381         else if (size == 32) {
 382             s[offset] = (lval >> 24) & 255;
 383             s[offset+1] = (lval >> 16) & 255;
 384             s[offset+2] = (lval >> 8) & 255;
 385             s[offset+3] = lval & 255;
 386         }
 387     }
 388 }
 389
 390 void
 391 do_chop(astr,sv)
 392 register SV *astr;
 393 register SV *sv;
 394 {
 395     STRLEN len;
 396     char *s;
 397
 398     if (SvTYPE(sv) == SVt_PVAV) {
 399         register I32 i;
 400         I32 max;
 401         AV* av = (AV*)sv;
 402         max = AvFILL(av);
 403         for (i = 0; i <= max; i++) {
 404             sv = (SV*)av_fetch(av, i, FALSE);
 405             if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
 406                 do_chop(astr, sv);
 407         }
 408         return;
 409     }
 410     if (SvTYPE(sv) == SVt_PVHV) {
 411         HV* hv = (HV*)sv;
 412         HE* entry;
 413         (void)hv_iterinit(hv);
 414         /*SUPPRESS 560*/
 415         while (entry = hv_iternext(hv))
 416             do_chop(astr,hv_iterval(hv,entry));
 417         return;
 418     }
 419     s = SvPV(sv, len);
 420     if (len && !SvPOKp(sv))
 421         s = SvPV_force(sv, len);
 422     if (s && len) {
 423         s += --len;
 424         sv_setpvn(astr, s, 1);
 425         *s = '\0';
 426         SvCUR_set(sv, len);
 427         SvNIOK_off(sv);
 428     }
 429     else
 430         sv_setpvn(astr, "", 0);
 431     SvSETMAGIC(sv);
 432 }
 433
 434 I32
 435 do_chomp(sv)
 436 register SV *sv;
 437 {
 438     register I32 count = 0;
 439     STRLEN len;
 440     char *s;
 441
 442     if (SvTYPE(sv) == SVt_PVAV) {
 443         register I32 i;
 444         I32 max;
 445         AV* av = (AV*)sv;
 446         max = AvFILL(av);
 447         for (i = 0; i <= max; i++) {
 448             sv = (SV*)av_fetch(av, i, FALSE);
 449             if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
 450                 count += do_chomp(sv);
 451         }
 452         return count;
 453     }
 454     if (SvTYPE(sv) == SVt_PVHV) {
 455         HV* hv = (HV*)sv;
 456         HE* entry;
 457         (void)hv_iterinit(hv);
 458         /*SUPPRESS 560*/
 459         while (entry = hv_iternext(hv))
 460             count += do_chomp(hv_iterval(hv,entry));
 461         return count;
 462     }
 463     s = SvPV(sv, len);
 464     if (len && !SvPOKp(sv))
 465         s = SvPV_force(sv, len);
 466     if (s && len) {
 467         s += --len;
 468         if (rspara) {
 469             if (*s != '\n')
 470                 goto nope;
 471             ++count;
 472             while (len && s[-1] == '\n') {
 473                 --len;
 474                 --s;
 475                 ++count;
 476             }
 477         }
 478         else if (rslen == 1) {
 479             if (*s != rschar)
 480                 goto nope;
 481             ++count;
 482         }
 483         else {
 484             if (len < rslen - 1)
 485                 goto nope;
 486             len -= rslen - 1;
 487             s -= rslen - 1;
 488             if (bcmp(s, rs, rslen))
 489                 goto nope;
 490             count += rslen;
 491         }
 492
 493         *s = '\0';
 494         SvCUR_set(sv, len);
 495         SvNIOK_off(sv);
 496     }
 497   nope:
 498     SvSETMAGIC(sv);
 499     return count;
 500 }
 501
 502 void
 503 do_vop(optype,sv,left,right)
 504 I32 optype;
 505 SV *sv;
 506 SV *left;
 507 SV *right;
 508 {
 509 #ifdef LIBERAL
 510     register long *dl;
 511     register long *ll;
 512     register long *rl;
 513 #endif
 514     register char *dc;
 515     STRLEN leftlen;
 516     STRLEN rightlen;
 517     register char *lc = SvPV(left, leftlen);
 518     register char *rc = SvPV(right, rightlen);
 519     register I32 len;
 520     I32 lensave;
 521
 522     dc = SvPV_force(sv,na);
 523     len = leftlen < rightlen ? leftlen : rightlen;
 524     lensave = len;
 525     if (SvCUR(sv) < len) {
 526         dc = SvGROW(sv,len + 1);
 527         (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
 528     }
 529     SvCUR_set(sv, len);
 530     (void)SvPOK_only(sv);
 531 #ifdef LIBERAL
 532     if (len >= sizeof(long)*4 &&
 533         !((long)dc % sizeof(long)) &&
 534         !((long)lc % sizeof(long)) &&
 535         !((long)rc % sizeof(long)))     /* It's almost always aligned... */
 536     {
 537         I32 remainder = len % (sizeof(long)*4);
 538         len /= (sizeof(long)*4);
 539
 540         dl = (long*)dc;
 541         ll = (long*)lc;
 542         rl = (long*)rc;
 543
 544         switch (optype) {
 545         case OP_BIT_AND:
 546             while (len--) {
 547                 *dl++ = *ll++ & *rl++;
 548                 *dl++ = *ll++ & *rl++;
 549                 *dl++ = *ll++ & *rl++;
 550                 *dl++ = *ll++ & *rl++;
 551             }
 552             break;
 553         case OP_BIT_XOR:
 554             while (len--) {
 555                 *dl++ = *ll++ ^ *rl++;
 556                 *dl++ = *ll++ ^ *rl++;
 557                 *dl++ = *ll++ ^ *rl++;
 558                 *dl++ = *ll++ ^ *rl++;
 559             }
 560             break;
 561         case OP_BIT_OR:
 562             while (len--) {
 563                 *dl++ = *ll++ | *rl++;
 564                 *dl++ = *ll++ | *rl++;
 565                 *dl++ = *ll++ | *rl++;
 566                 *dl++ = *ll++ | *rl++;
 567             }
 568         }
 569
 570         dc = (char*)dl;
 571         lc = (char*)ll;
 572         rc = (char*)rl;
 573
 574         len = remainder;
 575     }
 576 #endif
 577     {
 578         char *lsave = lc;
 579         char *rsave = rc;
 580
 581         switch (optype) {
 582         case OP_BIT_AND:
 583             while (len--)
 584                 *dc++ = *lc++ & *rc++;
 585             break;
 586         case OP_BIT_XOR:
 587             while (len--)
 588                 *dc++ = *lc++ ^ *rc++;
 589             goto mop_up;
 590         case OP_BIT_OR:
 591             while (len--)
 592                 *dc++ = *lc++ | *rc++;
 593           mop_up:
 594             len = lensave;
 595             if (rightlen > len)
 596                 sv_catpvn(sv, rsave + len, rightlen - len);
 597             else if (leftlen > len)
 598                 sv_catpvn(sv, lsave + len, leftlen - len);
 599             break;
 600         }
 601     }
 602 }
 603
 604 OP *
 605 do_kv(ARGS)
 606 dARGS
 607 {
 608     dSP;
 609     HV *hv = (HV*)POPs;
 610     I32 i;
 611     register HE *entry;
 612     char *tmps;
 613     SV *tmpstr;
 614     I32 dokeys =   (op->op_type == OP_KEYS);
 615     I32 dovalues = (op->op_type == OP_VALUES);
 616
 617     if (op->op_type == OP_RV2HV || op->op_type == OP_PADHV)
 618         dokeys = dovalues = TRUE;
 619
 620     if (!hv)
 621         RETURN;
 622     if (GIMME != G_ARRAY) {
 623         dTARGET;
 624
 625         if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P'))
 626             i = HvKEYS(hv);
 627         else {
 628             i = 0;
 629             (void)hv_iterinit(hv);
 630             /*SUPPRESS 560*/
 631             while (entry = hv_iternext(hv)) {
 632                 i++;
 633             }
 634         }
 635         PUSHi( i );
 636         RETURN;
 637     }
 638
 639     /* Guess how much room we need.  hv_max may be a few too many.  Oh well. */
 640     EXTEND(sp, HvMAX(hv) * (dokeys + dovalues));
 641
 642     (void)hv_iterinit(hv);
 643
 644     PUTBACK;    /* hv_iternext and hv_iterval might clobber stack_sp */
 645     while (entry = hv_iternext(hv)) {
 646         SPAGAIN;
 647         if (dokeys) {
 648             tmps = hv_iterkey(entry,&i);        /* won't clobber stack_sp */
 649             if (!i)
 650                 tmps = "";
 651             XPUSHs(sv_2mortal(newSVpv(tmps,i)));
 652         }
 653         if (dovalues) {
 654             tmpstr = NEWSV(45,0);
 655             PUTBACK;
 656             sv_setsv(tmpstr,hv_iterval(hv,entry));
 657             SPAGAIN;
 658             DEBUG_H( {
 659                 sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
 660                     HvMAX(hv)+1,entry->hent_hash & HvMAX(hv));
 661                 sv_setpv(tmpstr,buf);
 662             } )
 663             XPUSHs(sv_2mortal(tmpstr));
 664         }
 665         PUTBACK;
 666     }
 667     return NORMAL;
 668 }
 669