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