doarg.c

   1 /* $Header: doarg.c,v 3.0.1.5 90/03/27 15:39:03 lwall Locked $
   2  *
   3  *    Copyright (c) 1989, Larry Wall
   4  *
   5  *    You may distribute under the terms of the GNU General Public License
   6  *    as specified in the README file that comes with the perl 3.0 kit.
   7  *
   8  * $Log:        doarg.c,v $
   9  * Revision 3.0.1.5  90/03/27  15:39:03  lwall
  10  * patch16: MSDOS support
  11  * patch16: support for machines that can't cast negative floats to unsigned ints
  12  * patch16: sprintf($s,...,$s,...) didn't work
  13  *
  14  * Revision 3.0.1.4  90/03/12  16:28:42  lwall
  15  * patch13: pack of ascii strings could call str_ncat() with negative length
  16  * patch13: printf("%s", *foo) was busted
  17  *
  18  * Revision 3.0.1.3  90/02/28  16:56:58  lwall
  19  * patch9: split now can split into more than 10000 elements
  20  * patch9: sped up pack and unpack
  21  * patch9: pack of unsigned ints and longs blew up some places
  22  * patch9: sun3 can't cast negative float to unsigned int or long
  23  * patch9: local($.) didn't work
  24  * patch9: grep(s/foo/bar/, @abc = @xyz) modified @xyz rather than @abc
  25  * patch9: syscall returned stack size rather than value of system call
  26  *
  27  * Revision 3.0.1.2  89/12/21  19:52:15  lwall
  28  * patch7: a pattern wouldn't match a null string before the first character
  29  * patch7: certain patterns didn't match correctly at end of string
  30  *
  31  * Revision 3.0.1.1  89/11/11  04:17:20  lwall
  32  * patch2: printf %c, %D, %X and %O didn't work right
  33  * patch2: printf of unsigned vs signed needed separate casts on some machines
  34  *
  35  * Revision 3.0  89/10/18  15:10:41  lwall
  36  * 3.0 baseline
  37  *
  38  */
  39
  40 #include "EXTERN.h"
  41 #include "perl.h"
  42
  43 #include <signal.h>
  44
  45 extern unsigned char fold[];
  46
  47 int wantarray;
  48
  49 #ifdef BUGGY_MSC
  50  #pragma function(memcmp)
  51 #endif /* BUGGY_MSC */
  52
  53 int
  54 do_subst(str,arg,sp)
  55 STR *str;
  56 ARG *arg;
  57 int sp;
  58 {
  59     register SPAT *spat;
  60     SPAT *rspat;
  61     register STR *dstr;
  62     register char *s = str_get(str);
  63     char *strend = s + str->str_cur;
  64     register char *m;
  65     char *c;
  66     register char *d;
  67     int clen;
  68     int iters = 0;
  69     int maxiters = (strend - s) + 10;
  70     register int i;
  71     bool once;
  72     char *orig;
  73     int safebase;
  74
  75     rspat = spat = arg[2].arg_ptr.arg_spat;
  76     if (!spat || !s)
  77         fatal("panic: do_subst");
  78     else if (spat->spat_runtime) {
  79         nointrp = "|)";
  80         (void)eval(spat->spat_runtime,G_SCALAR,sp);
  81         m = str_get(dstr = stack->ary_array[sp+1]);
  82         nointrp = "";
  83         if (spat->spat_regexp)
  84             regfree(spat->spat_regexp);
  85         spat->spat_regexp = regcomp(m,m+dstr->str_cur,
  86             spat->spat_flags & SPAT_FOLD,1);
  87         if (spat->spat_flags & SPAT_KEEP) {
  88             arg_free(spat->spat_runtime);       /* it won't change, so */
  89             spat->spat_runtime = Nullarg;       /* no point compiling again */
  90         }
  91     }
  92 #ifdef DEBUGGING
  93     if (debug & 8) {
  94         deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
  95     }
  96 #endif
  97     safebase = ((!spat->spat_regexp || !spat->spat_regexp->nparens) &&
  98       !sawampersand);
  99     if (!*spat->spat_regexp->precomp && lastspat)
 100         spat = lastspat;
 101     orig = m = s;
 102     if (hint) {
 103         if (hint < s || hint > strend)
 104             fatal("panic: hint in do_match");
 105         s = hint;
 106         hint = Nullch;
 107         if (spat->spat_regexp->regback >= 0) {
 108             s -= spat->spat_regexp->regback;
 109             if (s < m)
 110                 s = m;
 111         }
 112         else
 113             s = m;
 114     }
 115     else if (spat->spat_short) {
 116         if (spat->spat_flags & SPAT_SCANFIRST) {
 117             if (str->str_pok & SP_STUDIED) {
 118                 if (screamfirst[spat->spat_short->str_rare] < 0)
 119                     goto nope;
 120                 else if (!(s = screaminstr(str,spat->spat_short)))
 121                     goto nope;
 122             }
 123 #ifndef lint
 124             else if (!(s = fbminstr((unsigned char*)s, (unsigned char*)strend,
 125               spat->spat_short)))
 126                 goto nope;
 127 #endif
 128             if (s && spat->spat_regexp->regback >= 0) {
 129                 ++spat->spat_short->str_u.str_useful;
 130                 s -= spat->spat_regexp->regback;
 131                 if (s < m)
 132                     s = m;
 133             }
 134             else
 135                 s = m;
 136         }
 137         else if (!multiline && (*spat->spat_short->str_ptr != *s ||
 138           bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
 139             goto nope;
 140         if (--spat->spat_short->str_u.str_useful < 0) {
 141             str_free(spat->spat_short);
 142             spat->spat_short = Nullstr; /* opt is being useless */
 143         }
 144     }
 145     once = ((rspat->spat_flags & SPAT_ONCE) != 0);
 146     if (rspat->spat_flags & SPAT_CONST) {       /* known replacement string? */
 147         if ((rspat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
 148             dstr = rspat->spat_repl[1].arg_ptr.arg_str;
 149         else {                                  /* constant over loop, anyway */
 150             (void)eval(rspat->spat_repl,G_SCALAR,sp);
 151             dstr = stack->ary_array[sp+1];
 152         }
 153         c = str_get(dstr);
 154         clen = dstr->str_cur;
 155         if (clen <= spat->spat_slen + spat->spat_regexp->regback) {
 156                                         /* can do inplace substitution */
 157             if (regexec(spat->spat_regexp, s, strend, orig, 0,
 158               str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
 159                 if (spat->spat_regexp->subbase) /* oops, no we can't */
 160                     goto long_way;
 161                 d = s;
 162                 lastspat = spat;
 163                 str->str_pok = SP_VALID;        /* disable possible screamer */
 164                 if (once) {
 165                     m = spat->spat_regexp->startp[0];
 166                     d = spat->spat_regexp->endp[0];
 167                     s = orig;
 168                     if (m - s > strend - d) {   /* faster to shorten from end */
 169                         if (clen) {
 170                             (void)bcopy(c, m, clen);
 171                             m += clen;
 172                         }
 173                         i = strend - d;
 174                         if (i > 0) {
 175                             (void)bcopy(d, m, i);
 176                             m += i;
 177                         }
 178                         *m = '\0';
 179                         str->str_cur = m - s;
 180                         STABSET(str);
 181                         str_numset(arg->arg_ptr.arg_str, 1.0);
 182                         stack->ary_array[++sp] = arg->arg_ptr.arg_str;
 183                         return sp;
 184                     }
 185                     else if (i = m - s) {       /* faster from front */
 186                         d -= clen;
 187                         m = d;
 188                         str_chop(str,d-i);
 189                         s += i;
 190                         while (i--)
 191                             *--d = *--s;
 192                         if (clen)
 193                             (void)bcopy(c, m, clen);
 194                         STABSET(str);
 195                         str_numset(arg->arg_ptr.arg_str, 1.0);
 196                         stack->ary_array[++sp] = arg->arg_ptr.arg_str;
 197                         return sp;
 198                     }
 199                     else if (clen) {
 200                         d -= clen;
 201                         str_chop(str,d);
 202                         (void)bcopy(c,d,clen);
 203                         STABSET(str);
 204                         str_numset(arg->arg_ptr.arg_str, 1.0);
 205                         stack->ary_array[++sp] = arg->arg_ptr.arg_str;
 206                         return sp;
 207                     }
 208                     else {
 209                         str_chop(str,d);
 210                         STABSET(str);
 211                         str_numset(arg->arg_ptr.arg_str, 1.0);
 212                         stack->ary_array[++sp] = arg->arg_ptr.arg_str;
 213                         return sp;
 214                     }
 215                     /* NOTREACHED */
 216                 }
 217                 do {
 218                     if (iters++ > maxiters)
 219                         fatal("Substitution loop");
 220                     m = spat->spat_regexp->startp[0];
 221                     if (i = m - s) {
 222                         if (s != d)
 223                             (void)bcopy(s,d,i);
 224                         d += i;
 225                     }
 226                     if (clen) {
 227                         (void)bcopy(c,d,clen);
 228                         d += clen;
 229                     }
 230                     s = spat->spat_regexp->endp[0];
 231                 } while (regexec(spat->spat_regexp, s, strend, orig, s == m,
 232                     Nullstr, TRUE));    /* (don't match same null twice) */
 233                 if (s != d) {
 234                     i = strend - s;
 235                     str->str_cur = d - str->str_ptr + i;
 236                     (void)bcopy(s,d,i+1);               /* include the Null */
 237                 }
 238                 STABSET(str);
 239                 str_numset(arg->arg_ptr.arg_str, (double)iters);
 240                 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
 241                 return sp;
 242             }
 243             str_numset(arg->arg_ptr.arg_str, 0.0);
 244             stack->ary_array[++sp] = arg->arg_ptr.arg_str;
 245             return sp;
 246         }
 247     }
 248     else
 249         c = Nullch;
 250     if (regexec(spat->spat_regexp, s, strend, orig, 0,
 251       str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
 252     long_way:
 253         dstr = Str_new(25,str_len(str));
 254         str_nset(dstr,m,s-m);
 255         if (spat->spat_regexp->subbase)
 256             curspat = spat;
 257         lastspat = spat;
 258         do {
 259             if (iters++ > maxiters)
 260                 fatal("Substitution loop");
 261             if (spat->spat_regexp->subbase
 262               && spat->spat_regexp->subbase != orig) {
 263                 m = s;
 264                 s = orig;
 265                 orig = spat->spat_regexp->subbase;
 266                 s = orig + (m - s);
 267                 strend = s + (strend - m);
 268             }
 269             m = spat->spat_regexp->startp[0];
 270             str_ncat(dstr,s,m-s);
 271             s = spat->spat_regexp->endp[0];
 272             if (c) {
 273                 if (clen)
 274                     str_ncat(dstr,c,clen);
 275             }
 276             else {
 277                 (void)eval(rspat->spat_repl,G_SCALAR,sp);
 278                 str_scat(dstr,stack->ary_array[sp+1]);
 279             }
 280             if (once)
 281                 break;
 282         } while (regexec(spat->spat_regexp, s, strend, orig, s == m, Nullstr,
 283             safebase));
 284         str_ncat(dstr,s,strend - s);
 285         str_replace(str,dstr);
 286         STABSET(str);
 287         str_numset(arg->arg_ptr.arg_str, (double)iters);
 288         stack->ary_array[++sp] = arg->arg_ptr.arg_str;
 289         return sp;
 290     }
 291     str_numset(arg->arg_ptr.arg_str, 0.0);
 292     stack->ary_array[++sp] = arg->arg_ptr.arg_str;
 293     return sp;
 294
 295 nope:
 296     ++spat->spat_short->str_u.str_useful;
 297     str_numset(arg->arg_ptr.arg_str, 0.0);
 298     stack->ary_array[++sp] = arg->arg_ptr.arg_str;
 299     return sp;
 300 }
 301 #ifdef BUGGY_MSC
 302  #pragma intrinsic(memcmp)
 303 #endif /* BUGGY_MSC */
 304
 305 int
 306 do_trans(str,arg)
 307 STR *str;
 308 register ARG *arg;
 309 {
 310     register char *tbl;
 311     register char *s;
 312     register int matches = 0;
 313     register int ch;
 314     register char *send;
 315
 316     tbl = arg[2].arg_ptr.arg_cval;
 317     s = str_get(str);
 318     send = s + str->str_cur;
 319     if (!tbl || !s)
 320         fatal("panic: do_trans");
 321 #ifdef DEBUGGING
 322     if (debug & 8) {
 323         deb("2.TBL\n");
 324     }
 325 #endif
 326     while (s < send) {
 327         if (ch = tbl[*s & 0377]) {
 328             matches++;
 329             *s = ch;
 330         }
 331         s++;
 332     }
 333     STABSET(str);
 334     return matches;
 335 }
 336
 337 void
 338 do_join(str,arglast)
 339 register STR *str;
 340 int *arglast;
 341 {
 342     register STR **st = stack->ary_array;
 343     register int sp = arglast[1];
 344     register int items = arglast[2] - sp;
 345     register char *delim = str_get(st[sp]);
 346     int delimlen = st[sp]->str_cur;
 347
 348     st += ++sp;
 349     if (items-- > 0)
 350         str_sset(str,*st++);
 351     else
 352         str_set(str,"");
 353     for (; items > 0; items--,st++) {
 354         str_ncat(str,delim,delimlen);
 355         str_scat(str,*st);
 356     }
 357     STABSET(str);
 358 }
 359
 360 void
 361 do_pack(str,arglast)
 362 register STR *str;
 363 int *arglast;
 364 {
 365     register STR **st = stack->ary_array;
 366     register int sp = arglast[1];
 367     register int items;
 368     register char *pat = str_get(st[sp]);
 369     register char *patend = pat + st[sp]->str_cur;
 370     register int len;
 371     int datumtype;
 372     STR *fromstr;
 373     static char *null10 = "\0\0\0\0\0\0\0\0\0\0";
 374     static char *space10 = "          ";
 375
 376     /* These must not be in registers: */
 377     char achar;
 378     short ashort;
 379     int aint;
 380     unsigned int auint;
 381     long along;
 382     unsigned long aulong;
 383     char *aptr;
 384
 385     items = arglast[2] - sp;
 386     st += ++sp;
 387     str_nset(str,"",0);
 388     while (pat < patend) {
 389 #define NEXTFROM (items-- > 0 ? *st++ : &str_no)
 390         datumtype = *pat++;
 391         if (isdigit(*pat)) {
 392             len = *pat++ - '0';
 393             while (isdigit(*pat))
 394                 len = (len * 10) + (*pat++ - '0');
 395         }
 396         else
 397             len = 1;
 398         switch(datumtype) {
 399         default:
 400             break;
 401         case 'x':
 402             while (len >= 10) {
 403                 str_ncat(str,null10,10);
 404                 len -= 10;
 405             }
 406             str_ncat(str,null10,len);
 407             break;
 408         case 'A':
 409         case 'a':
 410             fromstr = NEXTFROM;
 411             aptr = str_get(fromstr);
 412             if (fromstr->str_cur > len)
 413                 str_ncat(str,aptr,len);
 414             else {
 415                 str_ncat(str,aptr,fromstr->str_cur);
 416                 len -= fromstr->str_cur;
 417                 if (datumtype == 'A') {
 418                     while (len >= 10) {
 419                         str_ncat(str,space10,10);
 420                         len -= 10;
 421                     }
 422                     str_ncat(str,space10,len);
 423                 }
 424                 else {
 425                     while (len >= 10) {
 426                         str_ncat(str,null10,10);
 427                         len -= 10;
 428                     }
 429                     str_ncat(str,null10,len);
 430                 }
 431             }
 432             break;
 433         case 'C':
 434         case 'c':
 435             while (len-- > 0) {
 436                 fromstr = NEXTFROM;
 437                 aint = (int)str_gnum(fromstr);
 438                 achar = aint;
 439                 str_ncat(str,&achar,sizeof(char));
 440             }
 441             break;
 442         case 'n':
 443             while (len-- > 0) {
 444                 fromstr = NEXTFROM;
 445                 ashort = (short)str_gnum(fromstr);
 446 #ifdef HTONS
 447                 ashort = htons(ashort);
 448 #endif
 449                 str_ncat(str,(char*)&ashort,sizeof(short));
 450             }
 451             break;
 452         case 'S':
 453         case 's':
 454             while (len-- > 0) {
 455                 fromstr = NEXTFROM;
 456                 ashort = (short)str_gnum(fromstr);
 457                 str_ncat(str,(char*)&ashort,sizeof(short));
 458             }
 459             break;
 460         case 'I':
 461             while (len-- > 0) {
 462                 fromstr = NEXTFROM;
 463                 auint = U_I(str_gnum(fromstr));
 464                 str_ncat(str,(char*)&auint,sizeof(unsigned int));
 465             }
 466             break;
 467         case 'i':
 468             while (len-- > 0) {
 469                 fromstr = NEXTFROM;
 470                 aint = (int)str_gnum(fromstr);
 471                 str_ncat(str,(char*)&aint,sizeof(int));
 472             }
 473             break;
 474         case 'N':
 475             while (len-- > 0) {
 476                 fromstr = NEXTFROM;
 477                 along = (long)str_gnum(fromstr);
 478 #ifdef HTONL
 479                 along = htonl(along);
 480 #endif
 481                 str_ncat(str,(char*)&along,sizeof(long));
 482             }
 483             break;
 484         case 'L':
 485             while (len-- > 0) {
 486                 fromstr = NEXTFROM;
 487                 aulong = U_L(str_gnum(fromstr));
 488                 str_ncat(str,(char*)&aulong,sizeof(unsigned long));
 489             }
 490             break;
 491         case 'l':
 492             while (len-- > 0) {
 493                 fromstr = NEXTFROM;
 494                 along = (long)str_gnum(fromstr);
 495                 str_ncat(str,(char*)&along,sizeof(long));
 496             }
 497             break;
 498         case 'p':
 499             while (len-- > 0) {
 500                 fromstr = NEXTFROM;
 501                 aptr = str_get(fromstr);
 502                 str_ncat(str,(char*)&aptr,sizeof(char*));
 503             }
 504             break;
 505         }
 506     }
 507     STABSET(str);
 508 }
 509 #undef NEXTFROM
 510
 511 void
 512 do_sprintf(str,len,sarg)
 513 register STR *str;
 514 register int len;
 515 register STR **sarg;
 516 {
 517     register char *s;
 518     register char *t;
 519     bool dolong;
 520     char ch;
 521     static STR *sargnull = &str_no;
 522     register char *send;
 523     char *xs;
 524     int xlen;
 525     double value;
 526     char *origs;
 527
 528     str_set(str,"");
 529     len--;                      /* don't count pattern string */
 530     origs = s = str_get(*sarg);
 531     send = s + (*sarg)->str_cur;
 532     sarg++;
 533     for ( ; s < send; len--) {
 534         if (len <= 0 || !*sarg) {
 535             sarg = &sargnull;
 536             len = 0;
 537         }
 538         dolong = FALSE;
 539         for (t = s; t < send && *t != '%'; t++) ;
 540         if (t >= send)
 541             break;              /* not enough % patterns, oh well */
 542         for (t++; *sarg && t < send && t != s; t++) {
 543             switch (*t) {
 544             default:
 545                 ch = *(++t);
 546                 *t = '\0';
 547                 (void)sprintf(buf,s);
 548                 s = t;
 549                 *(t--) = ch;
 550                 len++;
 551                 break;
 552             case '0': case '1': case '2': case '3': case '4':
 553             case '5': case '6': case '7': case '8': case '9':
 554             case '.': case '#': case '-': case '+':
 555                 break;
 556             case 'l':
 557                 dolong = TRUE;
 558                 break;
 559             case 'c':
 560                 ch = *(++t);
 561                 *t = '\0';
 562                 xlen = (int)str_gnum(*(sarg++));
 563                 if (strEQ(t-2,"%c")) {  /* some printfs fail on null chars */
 564                     *buf = xlen;
 565                     str_ncat(str,s,t - s - 2);
 566                     str_ncat(str,buf,1);  /* so handle simple case */
 567                     *buf = '\0';
 568                 }
 569                 else
 570                     (void)sprintf(buf,s,xlen);
 571                 s = t;
 572                 *(t--) = ch;
 573                 break;
 574             case 'D':
 575                 dolong = TRUE;
 576                 /* FALL THROUGH */
 577             case 'd':
 578                 ch = *(++t);
 579                 *t = '\0';
 580                 if (dolong)
 581                     (void)sprintf(buf,s,(long)str_gnum(*(sarg++)));
 582                 else
 583                     (void)sprintf(buf,s,(int)str_gnum(*(sarg++)));
 584                 s = t;
 585                 *(t--) = ch;
 586                 break;
 587             case 'X': case 'O':
 588                 dolong = TRUE;
 589                 /* FALL THROUGH */
 590             case 'x': case 'o': case 'u':
 591                 ch = *(++t);
 592                 *t = '\0';
 593                 value = str_gnum(*(sarg++));
 594                 if (dolong)
 595                     (void)sprintf(buf,s,U_L(value));
 596                 else
 597                     (void)sprintf(buf,s,U_I(value));
 598                 s = t;
 599                 *(t--) = ch;
 600                 break;
 601             case 'E': case 'e': case 'f': case 'G': case 'g':
 602                 ch = *(++t);
 603                 *t = '\0';
 604                 (void)sprintf(buf,s,str_gnum(*(sarg++)));
 605                 s = t;
 606                 *(t--) = ch;
 607                 break;
 608             case 's':
 609                 ch = *(++t);
 610                 *t = '\0';
 611                 xs = str_get(*sarg);
 612                 xlen = (*sarg)->str_cur;
 613                 if (*xs == 'S' && xs[1] == 't' && xs[2] == 'B'
 614                   && xlen == sizeof(STBP) && strlen(xs) < xlen) {
 615                     xs = stab_name(((STAB*)(*sarg))); /* a stab value! */
 616                     sprintf(tokenbuf,"*%s",xs); /* reformat to non-binary */
 617                     xs = tokenbuf;
 618                     xlen = strlen(tokenbuf);
 619                 }
 620                 if (strEQ(t-2,"%s")) {  /* some printfs fail on >128 chars */
 621                     *buf = '\0';
 622                     str_ncat(str,s,t - s - 2);
 623                     *t = ch;
 624                     str_ncat(str,xs,xlen);  /* so handle simple case */
 625                 }
 626                 else {
 627                     if (origs == xs) {          /* sprintf($s,...$s...) */
 628                         strcpy(tokenbuf+64,s);
 629                         s = tokenbuf+64;
 630                         *t = ch;
 631                     }
 632                     (void)sprintf(buf,s,xs);
 633                 }
 634                 sarg++;
 635                 s = t;
 636                 *(t--) = ch;
 637                 break;
 638             }
 639         }
 640         if (s < t && t >= send) {
 641             str_cat(str,s);
 642             s = t;
 643             break;
 644         }
 645         str_cat(str,buf);
 646     }
 647     if (*s) {
 648         (void)sprintf(buf,s,0,0,0,0);
 649         str_cat(str,buf);
 650     }
 651     STABSET(str);
 652 }
 653
 654 STR *
 655 do_push(ary,arglast)
 656 register ARRAY *ary;
 657 int *arglast;
 658 {
 659     register STR **st = stack->ary_array;
 660     register int sp = arglast[1];
 661     register int items = arglast[2] - sp;
 662     register STR *str = &str_undef;
 663
 664     for (st += ++sp; items > 0; items--,st++) {
 665         str = Str_new(26,0);
 666         if (*st)
 667             str_sset(str,*st);
 668         (void)apush(ary,str);
 669     }
 670     return str;
 671 }
 672
 673 int
 674 do_unshift(ary,arglast)
 675 register ARRAY *ary;
 676 int *arglast;
 677 {
 678     register STR **st = stack->ary_array;
 679     register int sp = arglast[1];
 680     register int items = arglast[2] - sp;
 681     register STR *str;
 682     register int i;
 683
 684     aunshift(ary,items);
 685     i = 0;
 686     for (st += ++sp; i < items; i++,st++) {
 687         str = Str_new(27,0);
 688         str_sset(str,*st);
 689         (void)astore(ary,i,str);
 690     }
 691 }
 692
 693 int
 694 do_subr(arg,gimme,arglast)
 695 register ARG *arg;
 696 int gimme;
 697 int *arglast;
 698 {
 699     register STR **st = stack->ary_array;
 700     register int sp = arglast[1];
 701     register int items = arglast[2] - sp;
 702     register SUBR *sub;
 703     ARRAY *savearray;
 704     STAB *stab;
 705     char *oldfile = filename;
 706     int oldsave = savestack->ary_fill;
 707     int oldtmps_base = tmps_base;
 708
 709     if ((arg[1].arg_type & A_MASK) == A_WORD)
 710         stab = arg[1].arg_ptr.arg_stab;
 711     else {
 712         STR *tmpstr = stab_val(arg[1].arg_ptr.arg_stab);
 713
 714         if (tmpstr)
 715             stab = stabent(str_get(tmpstr),TRUE);
 716         else
 717             stab = Nullstab;
 718     }
 719     if (!stab)
 720         fatal("Undefined subroutine called");
 721     sub = stab_sub(stab);
 722     if (!sub)
 723         fatal("Undefined subroutine \"%s\" called", stab_name(stab));
 724     if ((arg[2].arg_type & A_MASK) != A_NULL) {
 725         savearray = stab_xarray(defstab);
 726         stab_xarray(defstab) = afake(defstab, items, &st[sp+1]);
 727     }
 728     savelong(&sub->depth);
 729     sub->depth++;
 730     saveint(&wantarray);
 731     wantarray = gimme;
 732     if (sub->depth >= 2) {      /* save temporaries on recursion? */
 733         if (sub->depth == 100 && dowarn)
 734             warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
 735         savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
 736     }
 737     filename = sub->filename;
 738     tmps_base = tmps_max;
 739     sp = cmd_exec(sub->cmd,gimme,--sp);         /* so do it already */
 740     st = stack->ary_array;
 741
 742     if ((arg[2].arg_type & A_MASK) != A_NULL) {
 743         afree(stab_xarray(defstab));  /* put back old $_[] */
 744         stab_xarray(defstab) = savearray;
 745     }
 746     filename = oldfile;
 747     tmps_base = oldtmps_base;
 748     if (savestack->ary_fill > oldsave) {
 749         for (items = arglast[0] + 1; items <= sp; items++)
 750             st[items] = str_static(st[items]);
 751                 /* in case restore wipes old str */
 752         restorelist(oldsave);
 753     }
 754     return sp;
 755 }
 756
 757 int
 758 do_dbsubr(arg,gimme,arglast)
 759 register ARG *arg;
 760 int gimme;
 761 int *arglast;
 762 {
 763     register STR **st = stack->ary_array;
 764     register int sp = arglast[1];
 765     register int items = arglast[2] - sp;
 766     register SUBR *sub;
 767     ARRAY *savearray;
 768     STR *str;
 769     STAB *stab;
 770     char *oldfile = filename;
 771     int oldsave = savestack->ary_fill;
 772     int oldtmps_base = tmps_base;
 773
 774     if ((arg[1].arg_type & A_MASK) == A_WORD)
 775         stab = arg[1].arg_ptr.arg_stab;
 776     else {
 777         STR *tmpstr = stab_val(arg[1].arg_ptr.arg_stab);
 778
 779         if (tmpstr)
 780             stab = stabent(str_get(tmpstr),TRUE);
 781         else
 782             stab = Nullstab;
 783     }
 784     if (!stab)
 785         fatal("Undefined subroutine called");
 786     sub = stab_sub(stab);
 787     if (!sub)
 788         fatal("Undefined subroutine \"%s\" called", stab_name(stab));
 789 /* begin differences */
 790     str = stab_val(DBsub);
 791     saveitem(str);
 792     str_set(str,stab_name(stab));
 793     sub = stab_sub(DBsub);
 794     if (!sub)
 795         fatal("No DBsub routine");
 796 /* end differences */
 797     if ((arg[2].arg_type & A_MASK) != A_NULL) {
 798         savearray = stab_xarray(defstab);
 799         stab_xarray(defstab) = afake(defstab, items, &st[sp+1]);
 800     }
 801     savelong(&sub->depth);
 802     sub->depth++;
 803     saveint(&wantarray);
 804     wantarray = gimme;
 805     if (sub->depth >= 2) {      /* save temporaries on recursion? */
 806         if (sub->depth == 100 && dowarn)
 807             warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
 808         savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
 809     }
 810     filename = sub->filename;
 811     tmps_base = tmps_max;
 812     sp = cmd_exec(sub->cmd,gimme, --sp);        /* so do it already */
 813     st = stack->ary_array;
 814
 815     if ((arg[2].arg_type & A_MASK) != A_NULL) {
 816         afree(stab_xarray(defstab));  /* put back old $_[] */
 817         stab_xarray(defstab) = savearray;
 818     }
 819     filename = oldfile;
 820     tmps_base = oldtmps_base;
 821     if (savestack->ary_fill > oldsave) {
 822         for (items = arglast[0] + 1; items <= sp; items++)
 823             st[items] = str_static(st[items]);
 824                 /* in case restore wipes old str */
 825         restorelist(oldsave);
 826     }
 827     return sp;
 828 }
 829
 830 int
 831 do_assign(arg,gimme,arglast)
 832 register ARG *arg;
 833 int gimme;
 834 int *arglast;
 835 {
 836
 837     register STR **st = stack->ary_array;
 838     STR **firstrelem = st + arglast[1] + 1;
 839     STR **firstlelem = st + arglast[0] + 1;
 840     STR **lastrelem = st + arglast[2];
 841     STR **lastlelem = st + arglast[1];
 842     register STR **relem;
 843     register STR **lelem;
 844
 845     register STR *str;
 846     register ARRAY *ary;
 847     register int makelocal;
 848     HASH *hash;
 849     int i;
 850
 851     makelocal = (arg->arg_flags & AF_LOCAL);
 852     localizing = makelocal;
 853     delaymagic = DM_DELAY;              /* catch simultaneous items */
 854
 855     /* If there's a common identifier on both sides we have to take
 856      * special care that assigning the identifier on the left doesn't
 857      * clobber a value on the right that's used later in the list.
 858      */
 859     if (arg->arg_flags & AF_COMMON) {
 860         for (relem = firstrelem; relem <= lastrelem; relem++) {
 861             if (str = *relem)
 862                 *relem = str_static(str);
 863         }
 864     }
 865     relem = firstrelem;
 866     lelem = firstlelem;
 867     ary = Null(ARRAY*);
 868     hash = Null(HASH*);
 869     while (lelem <= lastlelem) {
 870         str = *lelem++;
 871         if (str->str_state >= SS_HASH) {
 872             if (str->str_state == SS_ARY) {
 873                 if (makelocal)
 874                     ary = saveary(str->str_u.str_stab);
 875                 else {
 876                     ary = stab_array(str->str_u.str_stab);
 877                     ary->ary_fill = -1;
 878                 }
 879                 i = 0;
 880                 while (relem <= lastrelem) {    /* gobble up all the rest */
 881                     str = Str_new(28,0);
 882                     if (*relem)
 883                         str_sset(str,*relem);
 884                     *(relem++) = str;
 885                     (void)astore(ary,i++,str);
 886                 }
 887             }
 888             else if (str->str_state == SS_HASH) {
 889                 char *tmps;
 890                 STR *tmpstr;
 891
 892                 if (makelocal)
 893                     hash = savehash(str->str_u.str_stab);
 894                 else {
 895                     hash = stab_hash(str->str_u.str_stab);
 896                     hclear(hash);
 897                 }
 898                 while (relem < lastrelem) {     /* gobble up all the rest */
 899                     if (*relem)
 900                         str = *(relem++);
 901                     else
 902                         str = &str_no, relem++;
 903                     tmps = str_get(str);
 904                     tmpstr = Str_new(29,0);
 905                     if (*relem)
 906                         str_sset(tmpstr,*relem);        /* value */
 907                     *(relem++) = tmpstr;
 908                     (void)hstore(hash,tmps,str->str_cur,tmpstr,0);
 909                 }
 910             }
 911             else
 912                 fatal("panic: do_assign");
 913         }
 914         else {
 915             if (makelocal)
 916                 saveitem(str);
 917             if (relem <= lastrelem) {
 918                 str_sset(str, *relem);
 919                 *(relem++) = str;
 920             }
 921             else {
 922                 str_nset(str, "", 0);
 923                 if (gimme == G_ARRAY) {
 924                     i = ++lastrelem - firstrelem;
 925                     relem++;            /* tacky, I suppose */
 926                     astore(stack,i,str);
 927                     if (st != stack->ary_array) {
 928                         st = stack->ary_array;
 929                         firstrelem = st + arglast[1] + 1;
 930                         firstlelem = st + arglast[0] + 1;
 931                         lastlelem = st + arglast[1];
 932                         lastrelem = st + i;
 933                         relem = lastrelem + 1;
 934                     }
 935                 }
 936             }
 937             STABSET(str);
 938         }
 939     }
 940     if (delaymagic > 1) {
 941 #ifdef SETREUID
 942         if (delaymagic & DM_REUID)
 943             setreuid(uid,euid);
 944 #endif
 945 #ifdef SETREGID
 946         if (delaymagic & DM_REGID)
 947             setregid(gid,egid);
 948 #endif
 949     }
 950     delaymagic = 0;
 951     localizing = FALSE;
 952     if (gimme == G_ARRAY) {
 953         i = lastrelem - firstrelem + 1;
 954         if (ary || hash)
 955             Copy(firstrelem, firstlelem, i, STR*);
 956         return arglast[0] + i;
 957     }
 958     else {
 959         str_numset(arg->arg_ptr.arg_str,(double)(arglast[2] - arglast[1]));
 960         *firstlelem = arg->arg_ptr.arg_str;
 961         return arglast[0] + 1;
 962     }
 963 }
 964
 965 int
 966 do_study(str,arg,gimme,arglast)
 967 STR *str;
 968 ARG *arg;
 969 int gimme;
 970 int *arglast;
 971 {
 972     register unsigned char *s;
 973     register int pos = str->str_cur;
 974     register int ch;
 975     register int *sfirst;
 976     register int *snext;
 977     static int maxscream = -1;
 978     static STR *lastscream = Nullstr;
 979     int retval;
 980     int retarg = arglast[0] + 1;
 981
 982 #ifndef lint
 983     s = (unsigned char*)(str_get(str));
 984 #else
 985     s = Null(unsigned char*);
 986 #endif
 987     if (lastscream)
 988         lastscream->str_pok &= ~SP_STUDIED;
 989     lastscream = str;
 990     if (pos <= 0) {
 991         retval = 0;
 992         goto ret;
 993     }
 994     if (pos > maxscream) {
 995         if (maxscream < 0) {
 996             maxscream = pos + 80;
 997             New(301,screamfirst, 256, int);
 998             New(302,screamnext, maxscream, int);
 999         }
1000         else {
1001             maxscream = pos + pos / 4;
1002             Renew(screamnext, maxscream, int);
1003         }
1004     }
1005
1006     sfirst = screamfirst;
1007     snext = screamnext;
1008
1009     if (!sfirst || !snext)
1010         fatal("do_study: out of memory");
1011
1012     for (ch = 256; ch; --ch)
1013         *sfirst++ = -1;
1014     sfirst -= 256;
1015
1016     while (--pos >= 0) {
1017         ch = s[pos];
1018         if (sfirst[ch] >= 0)
1019             snext[pos] = sfirst[ch] - pos;
1020         else
1021             snext[pos] = -pos;
1022         sfirst[ch] = pos;
1023
1024         /* If there were any case insensitive searches, we must assume they
1025          * all are.  This speeds up insensitive searches much more than
1026          * it slows down sensitive ones.
1027          */
1028         if (sawi)
1029             sfirst[fold[ch]] = pos;
1030     }
1031
1032     str->str_pok |= SP_STUDIED;
1033     retval = 1;
1034   ret:
1035     str_numset(arg->arg_ptr.arg_str,(double)retval);
1036     stack->ary_array[retarg] = arg->arg_ptr.arg_str;
1037     return retarg;
1038 }
1039
1040 int
1041 do_defined(str,arg,gimme,arglast)
1042 STR *str;
1043 register ARG *arg;
1044 int gimme;
1045 int *arglast;
1046 {
1047     register int type;
1048     register int retarg = arglast[0] + 1;
1049     int retval;
1050
1051     if ((arg[1].arg_type & A_MASK) != A_LEXPR)
1052         fatal("Illegal argument to defined()");
1053     arg = arg[1].arg_ptr.arg_arg;
1054     type = arg->arg_type;
1055
1056     if (type == O_ARRAY || type == O_LARRAY)
1057         retval = stab_xarray(arg[1].arg_ptr.arg_stab) != 0;
1058     else if (type == O_HASH || type == O_LHASH)
1059         retval = stab_xhash(arg[1].arg_ptr.arg_stab) != 0;
1060     else if (type == O_SUBR || type == O_DBSUBR)
1061         retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0;
1062     else if (type == O_ASLICE || type == O_LASLICE)
1063         retval = stab_xarray(arg[1].arg_ptr.arg_stab) != 0;
1064     else if (type == O_HSLICE || type == O_LHSLICE)
1065         retval = stab_xhash(arg[1].arg_ptr.arg_stab) != 0;
1066     else
1067         retval = FALSE;
1068     str_numset(str,(double)retval);
1069     stack->ary_array[retarg] = str;
1070     return retarg;
1071 }
1072
1073 int
1074 do_undef(str,arg,gimme,arglast)
1075 STR *str;
1076 register ARG *arg;
1077 int gimme;
1078 int *arglast;
1079 {
1080     register int type;
1081     register STAB *stab;
1082     int retarg = arglast[0] + 1;
1083
1084     if ((arg[1].arg_type & A_MASK) != A_LEXPR)
1085         fatal("Illegal argument to undef()");
1086     arg = arg[1].arg_ptr.arg_arg;
1087     type = arg->arg_type;
1088
1089     if (type == O_ARRAY || type == O_LARRAY) {
1090         stab = arg[1].arg_ptr.arg_stab;
1091         afree(stab_xarray(stab));
1092         stab_xarray(stab) = Null(ARRAY*);
1093     }
1094     else if (type == O_HASH || type == O_LHASH) {
1095         stab = arg[1].arg_ptr.arg_stab;
1096         (void)hfree(stab_xhash(stab));
1097         stab_xhash(stab) = Null(HASH*);
1098     }
1099     else if (type == O_SUBR || type == O_DBSUBR) {
1100         stab = arg[1].arg_ptr.arg_stab;
1101         cmd_free(stab_sub(stab)->cmd);
1102         afree(stab_sub(stab)->tosave);
1103         Safefree(stab_sub(stab));
1104         stab_sub(stab) = Null(SUBR*);
1105     }
1106     else
1107         fatal("Can't undefine that kind of object");
1108     str_numset(str,0.0);
1109     stack->ary_array[retarg] = str;
1110     return retarg;
1111 }
1112
1113 int
1114 do_vec(lvalue,astr,arglast)
1115 int lvalue;
1116 STR *astr;
1117 int *arglast;
1118 {
1119     STR **st = stack->ary_array;
1120     int sp = arglast[0];
1121     register STR *str = st[++sp];
1122     register int offset = (int)str_gnum(st[++sp]);
1123     register int size = (int)str_gnum(st[++sp]);
1124     unsigned char *s = (unsigned char*)str_get(str);
1125     unsigned long retnum;
1126     int len;
1127
1128     sp = arglast[1];
1129     offset *= size;             /* turn into bit offset */
1130     len = (offset + size + 7) / 8;
1131     if (offset < 0 || size < 1)
1132         retnum = 0;
1133     else if (!lvalue && len > str->str_cur)
1134         retnum = 0;
1135     else {
1136         if (len > str->str_cur) {
1137             STR_GROW(str,len);
1138             (void)bzero(str->str_ptr + str->str_cur, len - str->str_cur);
1139             str->str_cur = len;
1140         }
1141         s = (unsigned char*)str_get(str);
1142         if (size < 8)
1143             retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
1144         else {
1145             offset >>= 3;
1146             if (size == 8)
1147                 retnum = s[offset];
1148             else if (size == 16)
1149                 retnum = (s[offset] << 8) + s[offset+1];
1150             else if (size == 32)
1151                 retnum = (s[offset] << 24) + (s[offset + 1] << 16) +
1152                         (s[offset + 2] << 8) + s[offset+3];
1153         }
1154
1155         if (lvalue) {                      /* it's an lvalue! */
1156             struct lstring *lstr = (struct lstring*)astr;
1157
1158             astr->str_magic = str;
1159             st[sp]->str_rare = 'v';
1160             lstr->lstr_offset = offset;
1161             lstr->lstr_len = size;
1162         }
1163     }
1164
1165     str_numset(astr,(double)retnum);
1166     st[sp] = astr;
1167     return sp;
1168 }
1169
1170 void
1171 do_vecset(mstr,str)
1172 STR *mstr;
1173 STR *str;
1174 {
1175     struct lstring *lstr = (struct lstring*)str;
1176     register int offset;
1177     register int size;
1178     register unsigned char *s = (unsigned char*)mstr->str_ptr;
1179     register unsigned long lval = U_L(str_gnum(str));
1180     int mask;
1181
1182     mstr->str_rare = 0;
1183     str->str_magic = Nullstr;
1184     offset = lstr->lstr_offset;
1185     size = lstr->lstr_len;
1186     if (size < 8) {
1187         mask = (1 << size) - 1;
1188         size = offset & 7;
1189         lval &= mask;
1190         offset >>= 3;
1191         s[offset] &= ~(mask << size);
1192         s[offset] |= lval << size;
1193     }
1194     else {
1195         if (size == 8)
1196             s[offset] = lval & 255;
1197         else if (size == 16) {
1198             s[offset] = (lval >> 8) & 255;
1199             s[offset+1] = lval & 255;
1200         }
1201         else if (size == 32) {
1202             s[offset] = (lval >> 24) & 255;
1203             s[offset+1] = (lval >> 16) & 255;
1204             s[offset+2] = (lval >> 8) & 255;
1205             s[offset+3] = lval & 255;
1206         }
1207     }
1208 }
1209
1210 do_chop(astr,str)
1211 register STR *astr;
1212 register STR *str;
1213 {
1214     register char *tmps;
1215     register int i;
1216     ARRAY *ary;
1217     HASH *hash;
1218     HENT *entry;
1219
1220     if (!str)
1221         return;
1222     if (str->str_state == SS_ARY) {
1223         ary = stab_array(str->str_u.str_stab);
1224         for (i = 0; i <= ary->ary_fill; i++)
1225             do_chop(astr,ary->ary_array[i]);
1226         return;
1227     }
1228     if (str->str_state == SS_HASH) {
1229         hash = stab_hash(str->str_u.str_stab);
1230         (void)hiterinit(hash);
1231         while (entry = hiternext(hash))
1232             do_chop(astr,hiterval(hash,entry));
1233         return;
1234     }
1235     tmps = str_get(str);
1236     if (!tmps)
1237         return;
1238     tmps += str->str_cur - (str->str_cur != 0);
1239     str_nset(astr,tmps,1);      /* remember last char */
1240     *tmps = '\0';                               /* wipe it out */
1241     str->str_cur = tmps - str->str_ptr;
1242     str->str_nok = 0;
1243 }
1244
1245 do_vop(optype,str,left,right)
1246 STR *str;
1247 STR *left;
1248 STR *right;
1249 {
1250     register char *s = str_get(str);
1251     register char *l = str_get(left);
1252     register char *r = str_get(right);
1253     register int len;
1254
1255     len = left->str_cur;
1256     if (len > right->str_cur)
1257         len = right->str_cur;
1258     if (str->str_cur > len)
1259         str->str_cur = len;
1260     else if (str->str_cur < len) {
1261         STR_GROW(str,len);
1262         (void)bzero(str->str_ptr + str->str_cur, len - str->str_cur);
1263         str->str_cur = len;
1264         s = str_get(str);
1265     }
1266     switch (optype) {
1267     case O_BIT_AND:
1268         while (len--)
1269             *s++ = *l++ & *r++;
1270         break;
1271     case O_XOR:
1272         while (len--)
1273             *s++ = *l++ ^ *r++;
1274         goto mop_up;
1275     case O_BIT_OR:
1276         while (len--)
1277             *s++ = *l++ | *r++;
1278       mop_up:
1279         len = str->str_cur;
1280         if (right->str_cur > len)
1281             str_ncat(str,right->str_ptr+len,right->str_cur - len);
1282         else if (left->str_cur > len)
1283             str_ncat(str,left->str_ptr+len,left->str_cur - len);
1284         break;
1285     }
1286 }
1287
1288 int
1289 do_syscall(arglast)
1290 int *arglast;
1291 {
1292     register STR **st = stack->ary_array;
1293     register int sp = arglast[1];
1294     register int items = arglast[2] - sp;
1295     long arg[8];
1296     register int i = 0;
1297     int retval = -1;
1298
1299 #ifdef SYSCALL
1300 #ifdef TAINT
1301     for (st += ++sp; items--; st++)
1302         tainted |= (*st)->str_tainted;
1303     st = stack->ary_array;
1304     sp = arglast[1];
1305     items = arglast[2] - sp;
1306 #endif
1307 #ifdef TAINT
1308     taintproper("Insecure dependency in syscall");
1309 #endif
1310     /* This probably won't work on machines where sizeof(long) != sizeof(int)
1311      * or where sizeof(long) != sizeof(char*).  But such machines will
1312      * not likely have syscall implemented either, so who cares?
1313      */
1314     while (items--) {
1315         if (st[++sp]->str_nok || !i)
1316             arg[i++] = (long)str_gnum(st[sp]);
1317 #ifndef lint
1318         else
1319             arg[i++] = (long)st[sp]->str_ptr;
1320 #endif /* lint */
1321     }
1322     sp = arglast[1];
1323     items = arglast[2] - sp;
1324     switch (items) {
1325     case 0:
1326         fatal("Too few args to syscall");
1327     case 1:
1328         retval = syscall(arg[0]);
1329         break;
1330     case 2:
1331         retval = syscall(arg[0],arg[1]);
1332         break;
1333     case 3:
1334         retval = syscall(arg[0],arg[1],arg[2]);
1335         break;
1336     case 4:
1337         retval = syscall(arg[0],arg[1],arg[2],arg[3]);
1338         break;
1339     case 5:
1340         retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4]);
1341         break;
1342     case 6:
1343         retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5]);
1344         break;
1345     case 7:
1346         retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6]);
1347         break;
1348     case 8:
1349         retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
1350           arg[7]);
1351         break;
1352     }
1353     return retval;
1354 #else
1355     fatal("syscall() unimplemented");
1356 #endif
1357 }
1358
1359