doop.c

   1 /* $RCSfile: doarg.c,v $$Revision: 4.1 $$Date: 92/08/07 17:19:37 $
   2  *
   3  *    Copyright (c) 1991, 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  * $Log:        doarg.c,v $
   9  * Revision 4.1  92/08/07  17:19:37  lwall
  10  * Stage 6 Snapshot
  11  *
  12  * Revision 4.0.1.7  92/06/11  21:07:11  lwall
  13  * patch34: join with null list attempted negative allocation
  14  * patch34: sprintf("%6.4s", "abcdefg") didn't print "abcd  "
  15  *
  16  * Revision 4.0.1.6  92/06/08  12:34:30  lwall
  17  * patch20: removed implicit int declarations on funcions
  18  * patch20: pattern modifiers i and o didn't interact right
  19  * patch20: join() now pre-extends target string to avoid excessive copying
  20  * patch20: fixed confusion between a *var's real name and its effective name
  21  * patch20: subroutines didn't localize $`, $&, $', $1 et al correctly
  22  * patch20: usersub routines didn't reclaim temp values soon enough
  23  * patch20: ($<,$>) = ... didn't work on some architectures
  24  * patch20: added Atari ST portability
  25  *
  26  * Revision 4.0.1.5  91/11/11  16:31:58  lwall
  27  * patch19: added little-endian pack/unpack options
  28  *
  29  * Revision 4.0.1.4  91/11/05  16:35:06  lwall
  30  * patch11: /$foo/o optimizer could access deallocated data
  31  * patch11: minimum match length calculation in regexp is now cumulative
  32  * patch11: added some support for 64-bit integers
  33  * patch11: prepared for ctype implementations that don't define isascii()
  34  * patch11: sprintf() now supports any length of s field
  35  * patch11: indirect subroutine calls through magic vars (e.g. &$1) didn't work
  36  * patch11: defined(&$foo) and undef(&$foo) didn't work
  37  *
  38  * Revision 4.0.1.3  91/06/10  01:18:41  lwall
  39  * patch10: pack(hh,1) dumped core
  40  *
  41  * Revision 4.0.1.2  91/06/07  10:42:17  lwall
  42  * patch4: new copyright notice
  43  * patch4: // wouldn't use previous pattern if it started with a null character
  44  * patch4: //o and s///o now optimize themselves fully at runtime
  45  * patch4: added global modifier for pattern matches
  46  * patch4: undef @array disabled "@array" interpolation
  47  * patch4: chop("") was returning "\0" rather than ""
  48  * patch4: vector logical operations &, | and ^ sometimes returned null string
  49  * patch4: syscall couldn't pass numbers with most significant bit set on sparcs
  50  *
  51  * Revision 4.0.1.1  91/04/11  17:40:14  lwall
  52  * patch1: fixed undefined environ problem
  53  * patch1: fixed debugger coredump on subroutines
  54  *
  55  * Revision 4.0  91/03/20  01:06:42  lwall
  56  * 4.0 baseline.
  57  *
  58  */
  59
  60 #include "EXTERN.h"
  61 #include "perl.h"
  62
  63 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  64 #include <signal.h>
  65 #endif
  66
  67 #ifdef BUGGY_MSC
  68  #pragma function(memcmp)
  69 #endif /* BUGGY_MSC */
  70
  71 static void doencodes();
  72
  73 #ifdef BUGGY_MSC
  74  #pragma intrinsic(memcmp)
  75 #endif /* BUGGY_MSC */
  76
  77 I32
  78 do_trans(sv,arg)
  79 SV *sv;
  80 OP *arg;
  81 {
  82     register short *tbl;
  83     register char *s;
  84     register I32 matches = 0;
  85     register I32 ch;
  86     register char *send;
  87     register char *d;
  88     register I32 squash = op->op_private & OPpTRANS_SQUASH;
  89
  90     tbl = (short*) cPVOP->op_pv;
  91     s = SvPVn(sv);
  92     send = s + SvCUROK(sv);
  93     if (!tbl || !s)
  94         fatal("panic: do_trans");
  95     DEBUG_t( deb("2.TBL\n"));
  96     if (!op->op_private) {
  97         while (s < send) {
  98             if ((ch = tbl[*s & 0377]) >= 0) {
  99                 matches++;
 100                 *s = ch;
 101             }
 102             s++;
 103         }
 104     }
 105     else {
 106         d = s;
 107         while (s < send) {
 108             if ((ch = tbl[*s & 0377]) >= 0) {
 109                 *d = ch;
 110                 if (matches++ && squash) {
 111                     if (d[-1] == *d)
 112                         matches--;
 113                     else
 114                         d++;
 115                 }
 116                 else
 117                     d++;
 118             }
 119             else if (ch == -1)          /* -1 is unmapped character */
 120                 *d++ = *s;              /* -2 is delete character */
 121             s++;
 122         }
 123         matches += send - d;    /* account for disappeared chars */
 124         *d = '\0';
 125         SvCUR_set(sv, d - SvPV(sv));
 126     }
 127     SvSETMAGIC(sv);
 128     return matches;
 129 }
 130
 131 void
 132 do_join(sv,del,mark,sp)
 133 register SV *sv;
 134 SV *del;
 135 register SV **mark;
 136 register SV **sp;
 137 {
 138     SV **oldmark = mark;
 139     register I32 items = sp - mark;
 140     register char *delim = SvPVn(del);
 141     register STRLEN len;
 142     I32 delimlen = SvCUROK(del);
 143
 144     mark++;
 145     len = (items > 0 ? (delimlen * (items - 1) ) : 0);
 146     if (SvTYPE(sv) < SVt_PV)
 147         sv_upgrade(sv, SVt_PV);
 148     if (SvLEN(sv) < len + items) {      /* current length is way too short */
 149         while (items-- > 0) {
 150             if (*mark) {
 151                 if (!SvPOK(*mark)) {
 152                     sv_2pv(*mark);
 153                     if (!SvPOK(*mark))
 154                         *mark = &sv_no;
 155                 }
 156                 len += SvCUR((*mark));
 157             }
 158             mark++;
 159         }
 160         SvGROW(sv, len + 1);            /* so try to pre-extend */
 161
 162         mark = oldmark;
 163         items = sp - mark;;
 164         ++mark;
 165     }
 166
 167     if (items-- > 0)
 168         sv_setsv(sv, *mark++);
 169     else
 170         sv_setpv(sv,"");
 171     len = delimlen;
 172     if (len) {
 173         for (; items > 0; items--,mark++) {
 174             sv_catpvn(sv,delim,len);
 175             sv_catsv(sv,*mark);
 176         }
 177     }
 178     else {
 179         for (; items > 0; items--,mark++)
 180             sv_catsv(sv,*mark);
 181     }
 182     SvSETMAGIC(sv);
 183 }
 184
 185 void
 186 do_sprintf(sv,len,sarg)
 187 register SV *sv;
 188 register I32 len;
 189 register SV **sarg;
 190 {
 191     register char *s;
 192     register char *t;
 193     register char *f;
 194     bool dolong;
 195 #ifdef QUAD
 196     bool doquad;
 197 #endif /* QUAD */
 198     char ch;
 199     register char *send;
 200     register SV *arg;
 201     char *xs;
 202     I32 xlen;
 203     I32 pre;
 204     I32 post;
 205     double value;
 206
 207     sv_setpv(sv,"");
 208     len--;                      /* don't count pattern string */
 209     t = s = SvPVn(*sarg);
 210     send = s + SvCUROK(*sarg);
 211     sarg++;
 212     for ( ; ; len--) {
 213
 214         /*SUPPRESS 560*/
 215         if (len <= 0 || !(arg = *sarg++))
 216             arg = &sv_no;
 217
 218         /*SUPPRESS 530*/
 219         for ( ; t < send && *t != '%'; t++) ;
 220         if (t >= send)
 221             break;              /* end of run_format string, ignore extra args */
 222         f = t;
 223         *buf = '\0';
 224         xs = buf;
 225 #ifdef QUAD
 226         doquad =
 227 #endif /* QUAD */
 228         dolong = FALSE;
 229         pre = post = 0;
 230         for (t++; t < send; t++) {
 231             switch (*t) {
 232             default:
 233                 ch = *(++t);
 234                 *t = '\0';
 235                 (void)sprintf(xs,f);
 236                 len++, sarg--;
 237                 xlen = strlen(xs);
 238                 break;
 239             case '0': case '1': case '2': case '3': case '4':
 240             case '5': case '6': case '7': case '8': case '9':
 241             case '.': case '#': case '-': case '+': case ' ':
 242                 continue;
 243             case 'lXXX':
 244 #ifdef QUAD
 245                 if (dolong) {
 246                     dolong = FALSE;
 247                     doquad = TRUE;
 248                 } else
 249 #endif
 250                 dolong = TRUE;
 251                 continue;
 252             case 'c':
 253                 ch = *(++t);
 254                 *t = '\0';
 255                 xlen = SvIVn(arg);
 256                 if (strEQ(f,"%c")) { /* some printfs fail on null chars */
 257                     *xs = xlen;
 258                     xs[1] = '\0';
 259                     xlen = 1;
 260                 }
 261                 else {
 262                     (void)sprintf(xs,f,xlen);
 263                     xlen = strlen(xs);
 264                 }
 265                 break;
 266             case 'D':
 267                 dolong = TRUE;
 268                 /* FALL THROUGH */
 269             case 'd':
 270                 ch = *(++t);
 271                 *t = '\0';
 272 #ifdef QUAD
 273                 if (doquad)
 274                     (void)sprintf(buf,s,(quad)SvNVn(arg));
 275                 else
 276 #endif
 277                 if (dolong)
 278                     (void)sprintf(xs,f,(long)SvNVn(arg));
 279                 else
 280                     (void)sprintf(xs,f,SvIVn(arg));
 281                 xlen = strlen(xs);
 282                 break;
 283             case 'X': case 'O':
 284                 dolong = TRUE;
 285                 /* FALL THROUGH */
 286             case 'x': case 'o': case 'u':
 287                 ch = *(++t);
 288                 *t = '\0';
 289                 value = SvNVn(arg);
 290 #ifdef QUAD
 291                 if (doquad)
 292                     (void)sprintf(buf,s,(unsigned quad)value);
 293                 else
 294 #endif
 295                 if (dolong)
 296                     (void)sprintf(xs,f,U_L(value));
 297                 else
 298                     (void)sprintf(xs,f,U_I(value));
 299                 xlen = strlen(xs);
 300                 break;
 301             case 'E': case 'e': case 'f': case 'G': case 'g':
 302                 ch = *(++t);
 303                 *t = '\0';
 304                 (void)sprintf(xs,f,SvNVn(arg));
 305                 xlen = strlen(xs);
 306                 break;
 307             case 's':
 308                 ch = *(++t);
 309                 *t = '\0';
 310                 xs = SvPVn(arg);
 311                 if (SvPOK(arg))
 312                     xlen = SvCUR(arg);
 313                 else
 314                     xlen = strlen(xs);
 315                 if (strEQ(f,"%s")) {    /* some printfs fail on >128 chars */
 316                     break;              /* so handle simple cases */
 317                 }
 318                 else if (f[1] == '-') {
 319                     char *mp = strchr(f, '.');
 320                     I32 min = atoi(f+2);
 321
 322                     if (mp) {
 323                         I32 max = atoi(mp+1);
 324
 325                         if (xlen > max)
 326                             xlen = max;
 327                     }
 328                     if (xlen < min)
 329                         post = min - xlen;
 330                     break;
 331                 }
 332                 else if (isDIGIT(f[1])) {
 333                     char *mp = strchr(f, '.');
 334                     I32 min = atoi(f+1);
 335
 336                     if (mp) {
 337                         I32 max = atoi(mp+1);
 338
 339                         if (xlen > max)
 340                             xlen = max;
 341                     }
 342                     if (xlen < min)
 343                         pre = min - xlen;
 344                     break;
 345                 }
 346                 strcpy(tokenbuf+64,f);  /* sprintf($s,...$s...) */
 347                 *t = ch;
 348                 (void)sprintf(buf,tokenbuf+64,xs);
 349                 xs = buf;
 350                 xlen = strlen(xs);
 351                 break;
 352             }
 353             /* end of switch, copy results */
 354             *t = ch;
 355             SvGROW(sv, SvCUR(sv) + (f - s) + xlen + 1 + pre + post);
 356             sv_catpvn(sv, s, f - s);
 357             if (pre) {
 358                 repeatcpy(SvPV(sv) + SvCUR(sv), " ", 1, pre);
 359                 SvCUR(sv) += pre;
 360             }
 361             sv_catpvn(sv, xs, xlen);
 362             if (post) {
 363                 repeatcpy(SvPV(sv) + SvCUR(sv), " ", 1, post);
 364                 SvCUR(sv) += post;
 365             }
 366             s = t;
 367             break;              /* break from for loop */
 368         }
 369     }
 370     sv_catpvn(sv, s, t - s);
 371     SvSETMAGIC(sv);
 372 }
 373
 374 void
 375 do_vecset(sv)
 376 SV *sv;
 377 {
 378     SV *targ = LvTARG(sv);
 379     register I32 offset;
 380     register I32 size;
 381     register unsigned char *s = (unsigned char*)SvPV(targ);
 382     register unsigned long lval = U_L(SvNVn(sv));
 383     I32 mask;
 384
 385     offset = LvTARGOFF(sv);
 386     size = LvTARGLEN(sv);
 387     if (size < 8) {
 388         mask = (1 << size) - 1;
 389         size = offset & 7;
 390         lval &= mask;
 391         offset >>= 3;
 392         s[offset] &= ~(mask << size);
 393         s[offset] |= lval << size;
 394     }
 395     else {
 396         if (size == 8)
 397             s[offset] = lval & 255;
 398         else if (size == 16) {
 399             s[offset] = (lval >> 8) & 255;
 400             s[offset+1] = lval & 255;
 401         }
 402         else if (size == 32) {
 403             s[offset] = (lval >> 24) & 255;
 404             s[offset+1] = (lval >> 16) & 255;
 405             s[offset+2] = (lval >> 8) & 255;
 406             s[offset+3] = lval & 255;
 407         }
 408     }
 409 }
 410
 411 void
 412 do_chop(astr,sv)
 413 register SV *astr;
 414 register SV *sv;
 415 {
 416     register char *tmps;
 417     register I32 i;
 418     AV *ary;
 419     HV *hash;
 420     HE *entry;
 421
 422     if (!sv)
 423         return;
 424     if (SvTYPE(sv) == SVt_PVAV) {
 425         I32 max;
 426         SV **array = AvARRAY(sv);
 427         max = AvFILL(sv);
 428         for (i = 0; i <= max; i++)
 429             do_chop(astr,array[i]);
 430         return;
 431     }
 432     if (SvTYPE(sv) == SVt_PVHV) {
 433         hash = (HV*)sv;
 434         (void)hv_iterinit(hash);
 435         /*SUPPRESS 560*/
 436         while (entry = hv_iternext(hash))
 437             do_chop(astr,hv_iterval(hash,entry));
 438         return;
 439     }
 440     tmps = SvPVn(sv);
 441     if (tmps && SvCUROK(sv)) {
 442         tmps += SvCUR(sv) - 1;
 443         sv_setpvn(astr,tmps,1); /* remember last char */
 444         *tmps = '\0';                           /* wipe it out */
 445         SvCUR_set(sv, tmps - SvPV(sv));
 446         SvNOK_off(sv);
 447         SvSETMAGIC(sv);
 448     }
 449     else
 450         sv_setpvn(astr,"",0);
 451 }
 452
 453 void
 454 do_vop(optype,sv,left,right)
 455 I32 optype;
 456 SV *sv;
 457 SV *left;
 458 SV *right;
 459 {
 460 #ifdef LIBERAL
 461     register long *dl;
 462     register long *ll;
 463     register long *rl;
 464 #endif
 465     register char *dc;
 466     register char *lc = SvPVn(left);
 467     register char *rc = SvPVn(right);
 468     register I32 len;
 469     I32 leftlen = SvCUROK(left);
 470     I32 rightlen = SvCUROK(right);
 471
 472     len = leftlen < rightlen ? leftlen : rightlen;
 473     if (SvTYPE(sv) < SVt_PV)
 474         sv_upgrade(sv, SVt_PV);
 475     if (SvCUR(sv) > len)
 476         SvCUR_set(sv, len);
 477     else if (SvCUR(sv) < len) {
 478         SvGROW(sv,len);
 479         (void)memzero(SvPV(sv) + SvCUR(sv), len - SvCUR(sv));
 480         SvCUR_set(sv, len);
 481     }
 482     SvPOK_only(sv);
 483     dc = SvPV(sv);
 484     if (!dc) {
 485         sv_setpvn(sv,"",0);
 486         dc = SvPV(sv);
 487     }
 488 #ifdef LIBERAL
 489     if (len >= sizeof(long)*4 &&
 490         !((long)dc % sizeof(long)) &&
 491         !((long)lc % sizeof(long)) &&
 492         !((long)rc % sizeof(long)))     /* It's almost always aligned... */
 493     {
 494         I32 remainder = len % (sizeof(long)*4);
 495         len /= (sizeof(long)*4);
 496
 497         dl = (long*)dc;
 498         ll = (long*)lc;
 499         rl = (long*)rc;
 500
 501         switch (optype) {
 502         case OP_BIT_AND:
 503             while (len--) {
 504                 *dl++ = *ll++ & *rl++;
 505                 *dl++ = *ll++ & *rl++;
 506                 *dl++ = *ll++ & *rl++;
 507                 *dl++ = *ll++ & *rl++;
 508             }
 509             break;
 510         case OP_XOR:
 511             while (len--) {
 512                 *dl++ = *ll++ ^ *rl++;
 513                 *dl++ = *ll++ ^ *rl++;
 514                 *dl++ = *ll++ ^ *rl++;
 515                 *dl++ = *ll++ ^ *rl++;
 516             }
 517             break;
 518         case OP_BIT_OR:
 519             while (len--) {
 520                 *dl++ = *ll++ | *rl++;
 521                 *dl++ = *ll++ | *rl++;
 522                 *dl++ = *ll++ | *rl++;
 523                 *dl++ = *ll++ | *rl++;
 524             }
 525         }
 526
 527         dc = (char*)dl;
 528         lc = (char*)ll;
 529         rc = (char*)rl;
 530
 531         len = remainder;
 532     }
 533 #endif
 534     switch (optype) {
 535     case OP_BIT_AND:
 536         while (len--)
 537             *dc++ = *lc++ & *rc++;
 538         break;
 539     case OP_XOR:
 540         while (len--)
 541             *dc++ = *lc++ ^ *rc++;
 542         goto mop_up;
 543     case OP_BIT_OR:
 544         while (len--)
 545             *dc++ = *lc++ | *rc++;
 546       mop_up:
 547         len = SvCUR(sv);
 548         if (rightlen > len)
 549             sv_catpvn(sv, SvPV(right) + len, rightlen - len);
 550         else if (leftlen > len)
 551             sv_catpvn(sv, SvPV(left) + len, leftlen - len);
 552         break;
 553     }
 554 }