doarg.c

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