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 *sv, OP *arg)
  23 {
  24     dTHR;
  25     register short *tbl;
  26     register U8 *s;
  27     register U8 *send;
  28     register U8 *d;
  29     register I32 ch;
  30     register I32 matches = 0;
  31     register I32 squash = op->op_private & OPpTRANS_SQUASH;
  32     STRLEN len;
  33
  34     if (SvREADONLY(sv))
  35         croak(no_modify);
  36     tbl = (short*)cPVOP->op_pv;
  37     s = (U8*)SvPV(sv, len);
  38     if (!len)
  39         return 0;
  40     if (!SvPOKp(sv))
  41         s = (U8*)SvPV_force(sv, len);
  42     (void)SvPOK_only(sv);
  43     send = s + len;
  44     if (!tbl || !s)
  45         croak("panic: do_trans");
  46     DEBUG_t( deb("2.TBL\n"));
  47     if (!op->op_private) {
  48         while (s < send) {
  49             if ((ch = tbl[*s]) >= 0) {
  50                 matches++;
  51                 *s = ch;
  52             }
  53             s++;
  54         }
  55     }
  56     else {
  57         d = s;
  58         while (s < send) {
  59             if ((ch = tbl[*s]) >= 0) {
  60                 *d = ch;
  61                 if (matches++ && squash) {
  62                     if (d[-1] == *d)
  63                         matches--;
  64                     else
  65                         d++;
  66                 }
  67                 else
  68                     d++;
  69             }
  70             else if (ch == -1)          /* -1 is unmapped character */
  71                 *d++ = *s;              /* -2 is delete character */
  72             s++;
  73         }
  74         matches += send - d;    /* account for disappeared chars */
  75         *d = '\0';
  76         SvCUR_set(sv, d - (U8*)SvPVX(sv));
  77     }
  78     SvSETMAGIC(sv);
  79     return matches;
  80 }
  81
  82 void
  83 do_join(register SV *sv, SV *del, register SV **mark, register SV **sp)
  84 {
  85     SV **oldmark = mark;
  86     register I32 items = sp - mark;
  87     register STRLEN len;
  88     STRLEN delimlen;
  89     register char *delim = SvPV(del, delimlen);
  90     STRLEN tmplen;
  91
  92     mark++;
  93     len = (items > 0 ? (delimlen * (items - 1) ) : 0);
  94     if (SvTYPE(sv) < SVt_PV)
  95         sv_upgrade(sv, SVt_PV);
  96     if (SvLEN(sv) < len + items) {      /* current length is way too short */
  97         while (items-- > 0) {
  98             if (*mark) {
  99                 SvPV(*mark, tmplen);
 100                 len += tmplen;
 101             }
 102             mark++;
 103         }
 104         SvGROW(sv, len + 1);            /* so try to pre-extend */
 105
 106         mark = oldmark;
 107         items = sp - mark;;
 108         ++mark;
 109     }
 110
 111     if (items-- > 0) {
 112         char *s;
 113
 114         if (*mark) {
 115             s = SvPV(*mark, tmplen);
 116             sv_setpvn(sv, s, tmplen);
 117         }
 118         else
 119             sv_setpv(sv, "");
 120         mark++;
 121     }
 122     else
 123         sv_setpv(sv,"");
 124     len = delimlen;
 125     if (len) {
 126         for (; items > 0; items--,mark++) {
 127             sv_catpvn(sv,delim,len);
 128             sv_catsv(sv,*mark);
 129         }
 130     }
 131     else {
 132         for (; items > 0; items--,mark++)
 133             sv_catsv(sv,*mark);
 134     }
 135     SvSETMAGIC(sv);
 136 }
 137
 138 void
 139 do_sprintf(SV *sv, I32 len, SV **sarg)
 140 {
 141     STRLEN patlen;
 142     char *pat = SvPV(*sarg, patlen);
 143     bool do_taint = FALSE;
 144
 145     sv_vsetpvfn(sv, pat, patlen, Null(va_list*), sarg + 1, len - 1, &do_taint);
 146     SvSETMAGIC(sv);
 147     if (do_taint)
 148         SvTAINTED_on(sv);
 149 }
 150
 151 void
 152 do_vecset(SV *sv)
 153 {
 154     SV *targ = LvTARG(sv);
 155     register I32 offset;
 156     register I32 size;
 157     register unsigned char *s;
 158     register unsigned long lval;
 159     I32 mask;
 160     STRLEN targlen;
 161     STRLEN len;
 162
 163     if (!targ)
 164         return;
 165     s = (unsigned char*)SvPV_force(targ, targlen);
 166     lval = U_L(SvNV(sv));
 167     offset = LvTARGOFF(sv);
 168     size = LvTARGLEN(sv);
 169
 170     len = (offset + size + 7) / 8;
 171     if (len > targlen) {
 172         s = (unsigned char*)SvGROW(targ, len + 1);
 173         (void)memzero(s + targlen, len - targlen + 1);
 174         SvCUR_set(targ, len);
 175     }
 176
 177     if (size < 8) {
 178         mask = (1 << size) - 1;
 179         size = offset & 7;
 180         lval &= mask;
 181         offset >>= 3;
 182         s[offset] &= ~(mask << size);
 183         s[offset] |= lval << size;
 184     }
 185     else {
 186         offset >>= 3;
 187         if (size == 8)
 188             s[offset] = lval & 255;
 189         else if (size == 16) {
 190             s[offset] = (lval >> 8) & 255;
 191             s[offset+1] = lval & 255;
 192         }
 193         else if (size == 32) {
 194             s[offset] = (lval >> 24) & 255;
 195             s[offset+1] = (lval >> 16) & 255;
 196             s[offset+2] = (lval >> 8) & 255;
 197             s[offset+3] = lval & 255;
 198         }
 199     }
 200 }
 201
 202 void
 203 do_chop(register SV *astr, register SV *sv)
 204 {
 205     STRLEN len;
 206     char *s;
 207
 208     if (SvTYPE(sv) == SVt_PVAV) {
 209         register I32 i;
 210         I32 max;
 211         AV* av = (AV*)sv;
 212         max = AvFILL(av);
 213         for (i = 0; i <= max; i++) {
 214             sv = (SV*)av_fetch(av, i, FALSE);
 215             if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
 216                 do_chop(astr, sv);
 217         }
 218         return;
 219     }
 220     if (SvTYPE(sv) == SVt_PVHV) {
 221         HV* hv = (HV*)sv;
 222         HE* entry;
 223         (void)hv_iterinit(hv);
 224         /*SUPPRESS 560*/
 225         while (entry = hv_iternext(hv))
 226             do_chop(astr,hv_iterval(hv,entry));
 227         return;
 228     }
 229     s = SvPV(sv, len);
 230     if (len && !SvPOK(sv))
 231         s = SvPV_force(sv, len);
 232     if (s && len) {
 233         s += --len;
 234         sv_setpvn(astr, s, 1);
 235         *s = '\0';
 236         SvCUR_set(sv, len);
 237         SvNIOK_off(sv);
 238     }
 239     else
 240         sv_setpvn(astr, "", 0);
 241     SvSETMAGIC(sv);
 242 }
 243
 244 I32
 245 do_chomp(register SV *sv)
 246 {
 247     dTHR;
 248     register I32 count;
 249     STRLEN len;
 250     char *s;
 251
 252     if (RsSNARF(rs))
 253         return 0;
 254     count = 0;
 255     if (SvTYPE(sv) == SVt_PVAV) {
 256         register I32 i;
 257         I32 max;
 258         AV* av = (AV*)sv;
 259         max = AvFILL(av);
 260         for (i = 0; i <= max; i++) {
 261             sv = (SV*)av_fetch(av, i, FALSE);
 262             if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
 263                 count += do_chomp(sv);
 264         }
 265         return count;
 266     }
 267     if (SvTYPE(sv) == SVt_PVHV) {
 268         HV* hv = (HV*)sv;
 269         HE* entry;
 270         (void)hv_iterinit(hv);
 271         /*SUPPRESS 560*/
 272         while (entry = hv_iternext(hv))
 273             count += do_chomp(hv_iterval(hv,entry));
 274         return count;
 275     }
 276     s = SvPV(sv, len);
 277     if (len && !SvPOKp(sv))
 278         s = SvPV_force(sv, len);
 279     if (s && len) {
 280         s += --len;
 281         if (RsPARA(rs)) {
 282             if (*s != '\n')
 283                 goto nope;
 284             ++count;
 285             while (len && s[-1] == '\n') {
 286                 --len;
 287                 --s;
 288                 ++count;
 289             }
 290         }
 291         else {
 292             STRLEN rslen;
 293             char *rsptr = SvPV(rs, rslen);
 294             if (rslen == 1) {
 295                 if (*s != *rsptr)
 296                     goto nope;
 297                 ++count;
 298             }
 299             else {
 300                 if (len < rslen - 1)
 301                     goto nope;
 302                 len -= rslen - 1;
 303                 s -= rslen - 1;
 304                 if (memNE(s, rsptr, rslen))
 305                     goto nope;
 306                 count += rslen;
 307             }
 308         }
 309         *s = '\0';
 310         SvCUR_set(sv, len);
 311         SvNIOK_off(sv);
 312     }
 313   nope:
 314     SvSETMAGIC(sv);
 315     return count;
 316 }
 317
 318 void
 319 do_vop(I32 optype, SV *sv, SV *left, SV *right)
 320 {
 321     dTHR;       /* just for taint */
 322 #ifdef LIBERAL
 323     register long *dl;
 324     register long *ll;
 325     register long *rl;
 326 #endif
 327     register char *dc;
 328     STRLEN leftlen;
 329     STRLEN rightlen;
 330     register char *lc;
 331     register char *rc;
 332     register I32 len;
 333     I32 lensave;
 334     char *lsave;
 335     char *rsave;
 336
 337     if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
 338         sv_setpvn(sv, "", 0);   /* avoid undef warning on |= and ^= */
 339     lsave = lc = SvPV(left, leftlen);
 340     rsave = rc = SvPV(right, rightlen);
 341     len = leftlen < rightlen ? leftlen : rightlen;
 342     lensave = len;
 343     if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
 344         dc = SvPV_force(sv, na);
 345         if (SvCUR(sv) < len) {
 346             dc = SvGROW(sv, len + 1);
 347             (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
 348         }
 349     }
 350     else {
 351         I32 needlen = ((optype == OP_BIT_AND)
 352                         ? len : (leftlen > rightlen ? leftlen : rightlen));
 353         Newz(801, dc, needlen + 1, char);
 354         (void)sv_usepvn(sv, dc, needlen);
 355         dc = SvPVX(sv);         /* sv_usepvn() calls Renew() */
 356     }
 357     SvCUR_set(sv, len);
 358     (void)SvPOK_only(sv);
 359 #ifdef LIBERAL
 360     if (len >= sizeof(long)*4 &&
 361         !((long)dc % sizeof(long)) &&
 362         !((long)lc % sizeof(long)) &&
 363         !((long)rc % sizeof(long)))     /* It's almost always aligned... */
 364     {
 365         I32 remainder = len % (sizeof(long)*4);
 366         len /= (sizeof(long)*4);
 367
 368         dl = (long*)dc;
 369         ll = (long*)lc;
 370         rl = (long*)rc;
 371
 372         switch (optype) {
 373         case OP_BIT_AND:
 374             while (len--) {
 375                 *dl++ = *ll++ & *rl++;
 376                 *dl++ = *ll++ & *rl++;
 377                 *dl++ = *ll++ & *rl++;
 378                 *dl++ = *ll++ & *rl++;
 379             }
 380             break;
 381         case OP_BIT_XOR:
 382             while (len--) {
 383                 *dl++ = *ll++ ^ *rl++;
 384                 *dl++ = *ll++ ^ *rl++;
 385                 *dl++ = *ll++ ^ *rl++;
 386                 *dl++ = *ll++ ^ *rl++;
 387             }
 388             break;
 389         case OP_BIT_OR:
 390             while (len--) {
 391                 *dl++ = *ll++ | *rl++;
 392                 *dl++ = *ll++ | *rl++;
 393                 *dl++ = *ll++ | *rl++;
 394                 *dl++ = *ll++ | *rl++;
 395             }
 396         }
 397
 398         dc = (char*)dl;
 399         lc = (char*)ll;
 400         rc = (char*)rl;
 401
 402         len = remainder;
 403     }
 404 #endif
 405     {
 406         switch (optype) {
 407         case OP_BIT_AND:
 408             while (len--)
 409                 *dc++ = *lc++ & *rc++;
 410             break;
 411         case OP_BIT_XOR:
 412             while (len--)
 413                 *dc++ = *lc++ ^ *rc++;
 414             goto mop_up;
 415         case OP_BIT_OR:
 416             while (len--)
 417                 *dc++ = *lc++ | *rc++;
 418           mop_up:
 419             len = lensave;
 420             if (rightlen > len)
 421                 sv_catpvn(sv, rsave + len, rightlen - len);
 422             else if (leftlen > len)
 423                 sv_catpvn(sv, lsave + len, leftlen - len);
 424             else
 425                 *SvEND(sv) = '\0';
 426             break;
 427         }
 428     }
 429     SvTAINT(sv);
 430 }
 431
 432 OP *
 433 do_kv(ARGSproto)
 434 {
 435     djSP;
 436     HV *hv = (HV*)POPs;
 437     register HE *entry;
 438     SV *tmpstr;
 439     I32 gimme = GIMME_V;
 440     I32 dokeys =   (op->op_type == OP_KEYS);
 441     I32 dovalues = (op->op_type == OP_VALUES);
 442     I32 realhv = (SvTYPE(hv) == SVt_PVHV);
 443
 444     if (op->op_type == OP_RV2HV || op->op_type == OP_PADHV)
 445         dokeys = dovalues = TRUE;
 446
 447     if (!hv) {
 448         if (op->op_flags & OPf_MOD) {   /* lvalue */
 449             dTARGET;            /* make sure to clear its target here */
 450             if (SvTYPE(TARG) == SVt_PVLV)
 451                 LvTARG(TARG) = Nullsv;
 452             PUSHs(TARG);
 453         }
 454         RETURN;
 455     }
 456
 457     if (realhv)
 458         (void)hv_iterinit(hv);  /* always reset iterator regardless */
 459     else
 460         (void)avhv_iterinit((AV*)hv);
 461
 462     if (gimme == G_VOID)
 463         RETURN;
 464
 465     if (gimme == G_SCALAR) {
 466         I32 i;
 467         dTARGET;
 468
 469         if (op->op_flags & OPf_MOD) {   /* lvalue */
 470             if (SvTYPE(TARG) < SVt_PVLV) {
 471                 sv_upgrade(TARG, SVt_PVLV);
 472                 sv_magic(TARG, Nullsv, 'k', Nullch, 0);
 473             }
 474             LvTYPE(TARG) = 'k';
 475             LvTARG(TARG) = (SV*)hv;
 476             PUSHs(TARG);
 477             RETURN;
 478         }
 479
 480         if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P'))
 481             i = HvKEYS(hv);
 482         else {
 483             i = 0;
 484             /*SUPPRESS 560*/
 485             while (entry = realhv ? hv_iternext(hv) : avhv_iternext((AV*)hv)) {
 486                 i++;
 487             }
 488         }
 489         PUSHi( i );
 490         RETURN;
 491     }
 492
 493     /* Guess how much room we need.  hv_max may be a few too many.  Oh well. */
 494     EXTEND(sp, HvMAX(hv) * (dokeys + dovalues));
 495
 496     PUTBACK;    /* hv_iternext and hv_iterval might clobber stack_sp */
 497     while (entry = realhv ? hv_iternext(hv) : avhv_iternext((AV*)hv)) {
 498         SPAGAIN;
 499         if (dokeys)
 500             XPUSHs(hv_iterkeysv(entry));        /* won't clobber stack_sp */
 501         if (dovalues) {
 502             tmpstr = sv_newmortal();
 503             PUTBACK;
 504             sv_setsv(tmpstr,realhv ?
 505                      hv_iterval(hv,entry) : avhv_iterval((AV*)hv,entry));
 506             DEBUG_H(sv_setpvf(tmpstr, "%lu%%%d=%lu",
 507                             (unsigned long)HeHASH(entry),
 508                             HvMAX(hv)+1,
 509                             (unsigned long)(HeHASH(entry) & HvMAX(hv))));
 510             SPAGAIN;
 511             XPUSHs(tmpstr);
 512         }
 513         PUTBACK;
 514     }
 515     return NORMAL;
 516 }
 517