home *** CD-ROM | disk | FTP | other *** search
/ ftp.muug.mb.ca / 2014.06.ftp.muug.mb.ca.tar / ftp.muug.mb.ca / pub / src / perl / doarg.c < prev    next >
C/C++ Source or Header  |  1992-04-11  |  40KB  |  1,734 lines
  1. /* $RCSfile: doarg.c,v $$Revision: 4.0.1.5 $$Date: 91/11/11 16:31:58 $
  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.0.1.5  91/11/11  16:31:58  lwall
  10.  * patch19: added little-endian pack/unpack options
  11.  * 
  12.  * Revision 4.0.1.4  91/11/05  16:35:06  lwall
  13.  * patch11: /$foo/o optimizer could access deallocated data
  14.  * patch11: minimum match length calculation in regexp is now cumulative
  15.  * patch11: added some support for 64-bit integers
  16.  * patch11: prepared for ctype implementations that don't define isascii()
  17.  * patch11: sprintf() now supports any length of s field
  18.  * patch11: indirect subroutine calls through magic vars (e.g. &$1) didn't work
  19.  * patch11: defined(&$foo) and undef(&$foo) didn't work
  20.  * 
  21.  * Revision 4.0.1.3  91/06/10  01:18:41  lwall
  22.  * patch10: pack(hh,1) dumped core
  23.  * 
  24.  * Revision 4.0.1.2  91/06/07  10:42:17  lwall
  25.  * patch4: new copyright notice
  26.  * patch4: // wouldn't use previous pattern if it started with a null character
  27.  * patch4: //o and s///o now optimize themselves fully at runtime
  28.  * patch4: added global modifier for pattern matches
  29.  * patch4: undef @array disabled "@array" interpolation
  30.  * patch4: chop("") was returning "\0" rather than ""
  31.  * patch4: vector logical operations &, | and ^ sometimes returned null string
  32.  * patch4: syscall couldn't pass numbers with most significant bit set on sparcs
  33.  * 
  34.  * Revision 4.0.1.1  91/04/11  17:40:14  lwall
  35.  * patch1: fixed undefined environ problem
  36.  * patch1: fixed debugger coredump on subroutines
  37.  * 
  38.  * Revision 4.0  91/03/20  01:06:42  lwall
  39.  * 4.0 baseline.
  40.  * 
  41.  */
  42.  
  43. #include "EXTERN.h"
  44. #include "perl.h"
  45.  
  46. #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  47. #include <signal.h>
  48. #endif
  49.  
  50. extern unsigned char fold[];
  51.  
  52. #ifdef BUGGY_MSC
  53.  #pragma function(memcmp)
  54. #endif /* BUGGY_MSC */
  55.  
  56. int
  57. do_subst(str,arg,sp)
  58. STR *str;
  59. ARG *arg;
  60. int sp;
  61. {
  62.     register SPAT *spat;
  63.     SPAT *rspat;
  64.     register STR *dstr;
  65.     register char *s = str_get(str);
  66.     char *strend = s + str->str_cur;
  67.     register char *m;
  68.     char *c;
  69.     register char *d;
  70.     int clen;
  71.     int iters = 0;
  72.     int maxiters = (strend - s) + 10;
  73.     register int i;
  74.     bool once;
  75.     char *orig;
  76.     int safebase;
  77.  
  78.     rspat = spat = arg[2].arg_ptr.arg_spat;
  79.     if (!spat || !s)
  80.     fatal("panic: do_subst");
  81.     else if (spat->spat_runtime) {
  82.     nointrp = "|)";
  83.     (void)eval(spat->spat_runtime,G_SCALAR,sp);
  84.     m = str_get(dstr = stack->ary_array[sp+1]);
  85.     nointrp = "";
  86.     if (spat->spat_regexp) {
  87.         regfree(spat->spat_regexp);
  88.         spat->spat_regexp = Null(REGEXP*);    /* required if regcomp pukes */
  89.     }
  90.     spat->spat_regexp = regcomp(m,m+dstr->str_cur,
  91.         spat->spat_flags & SPAT_FOLD);
  92.     if (spat->spat_flags & SPAT_KEEP) {
  93.         scanconst(spat, m, dstr->str_cur);
  94.         arg_free(spat->spat_runtime);    /* it won't change, so */
  95.         spat->spat_runtime = Nullarg;    /* no point compiling again */
  96.         hoistmust(spat);
  97.             if (curcmd->c_expr && (curcmd->c_flags & CF_OPTIMIZE) == CFT_EVAL) {
  98.                 curcmd->c_flags &= ~CF_OPTIMIZE;
  99.                 opt_arg(curcmd, 1, curcmd->c_type == C_EXPR);
  100.             }
  101.     }
  102.     }
  103. #ifdef DEBUGGING
  104.     if (debug & 8) {
  105.     deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
  106.     }
  107. #endif
  108.     safebase = ((!spat->spat_regexp || !spat->spat_regexp->nparens) &&
  109.       !sawampersand);
  110.     if (!spat->spat_regexp->prelen && lastspat)
  111.     spat = lastspat;
  112.     orig = m = s;
  113.     if (hint) {
  114.     if (hint < s || hint > strend)
  115.         fatal("panic: hint in do_match");
  116.     s = hint;
  117.     hint = Nullch;
  118.     if (spat->spat_regexp->regback >= 0) {
  119.         s -= spat->spat_regexp->regback;
  120.         if (s < m)
  121.         s = m;
  122.     }
  123.     else
  124.         s = m;
  125.     }
  126.     else if (spat->spat_short) {
  127.     if (spat->spat_flags & SPAT_SCANFIRST) {
  128.         if (str->str_pok & SP_STUDIED) {
  129.         if (screamfirst[spat->spat_short->str_rare] < 0)
  130.             goto nope;
  131.         else if (!(s = screaminstr(str,spat->spat_short)))
  132.             goto nope;
  133.         }
  134. #ifndef lint
  135.         else if (!(s = fbminstr((unsigned char*)s, (unsigned char*)strend,
  136.           spat->spat_short)))
  137.         goto nope;
  138. #endif
  139.         if (s && spat->spat_regexp->regback >= 0) {
  140.         ++spat->spat_short->str_u.str_useful;
  141.         s -= spat->spat_regexp->regback;
  142.         if (s < m)
  143.             s = m;
  144.         }
  145.         else
  146.         s = m;
  147.     }
  148.     else if (!multiline && (*spat->spat_short->str_ptr != *s ||
  149.       bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
  150.         goto nope;
  151.     if (--spat->spat_short->str_u.str_useful < 0) {
  152.         str_free(spat->spat_short);
  153.         spat->spat_short = Nullstr;    /* opt is being useless */
  154.     }
  155.     }
  156.     once = !(rspat->spat_flags & SPAT_GLOBAL);
  157.     if (rspat->spat_flags & SPAT_CONST) {    /* known replacement string? */
  158.     if ((rspat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
  159.         dstr = rspat->spat_repl[1].arg_ptr.arg_str;
  160.     else {                    /* constant over loop, anyway */
  161.         (void)eval(rspat->spat_repl,G_SCALAR,sp);
  162.         dstr = stack->ary_array[sp+1];
  163.     }
  164.     c = str_get(dstr);
  165.     clen = dstr->str_cur;
  166.     if (clen <= spat->spat_regexp->minlen) {
  167.                     /* can do inplace substitution */
  168.         if (regexec(spat->spat_regexp, s, strend, orig, 0,
  169.           str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
  170.         if (spat->spat_regexp->subbase) /* oops, no we can't */
  171.             goto long_way;
  172.         d = s;
  173.         lastspat = spat;
  174.         str->str_pok = SP_VALID;    /* disable possible screamer */
  175.         if (once) {
  176.             m = spat->spat_regexp->startp[0];
  177.             d = spat->spat_regexp->endp[0];
  178.             s = orig;
  179.             if (m - s > strend - d) {    /* faster to shorten from end */
  180.             if (clen) {
  181.                 (void)bcopy(c, m, clen);
  182.                 m += clen;
  183.             }
  184.             i = strend - d;
  185.             if (i > 0) {
  186.                 (void)bcopy(d, m, i);
  187.                 m += i;
  188.             }
  189.             *m = '\0';
  190.             str->str_cur = m - s;
  191.             STABSET(str);
  192.             str_numset(arg->arg_ptr.arg_str, 1.0);
  193.             stack->ary_array[++sp] = arg->arg_ptr.arg_str;
  194.             return sp;
  195.             }
  196.             /*SUPPRESS 560*/
  197.             else if (i = m - s) {    /* faster from front */
  198.             d -= clen;
  199.             m = d;
  200.             str_chop(str,d-i);
  201.             s += i;
  202.             while (i--)
  203.                 *--d = *--s;
  204.             if (clen)
  205.                 (void)bcopy(c, m, clen);
  206.             STABSET(str);
  207.             str_numset(arg->arg_ptr.arg_str, 1.0);
  208.             stack->ary_array[++sp] = arg->arg_ptr.arg_str;
  209.             return sp;
  210.             }
  211.             else if (clen) {
  212.             d -= clen;
  213.             str_chop(str,d);
  214.             (void)bcopy(c,d,clen);
  215.             STABSET(str);
  216.             str_numset(arg->arg_ptr.arg_str, 1.0);
  217.             stack->ary_array[++sp] = arg->arg_ptr.arg_str;
  218.             return sp;
  219.             }
  220.             else {
  221.             str_chop(str,d);
  222.             STABSET(str);
  223.             str_numset(arg->arg_ptr.arg_str, 1.0);
  224.             stack->ary_array[++sp] = arg->arg_ptr.arg_str;
  225.             return sp;
  226.             }
  227.             /* NOTREACHED */
  228.         }
  229.         do {
  230.             if (iters++ > maxiters)
  231.             fatal("Substitution loop");
  232.             m = spat->spat_regexp->startp[0];
  233.             /*SUPPRESS 560*/
  234.             if (i = m - s) {
  235.             if (s != d)
  236.                 (void)bcopy(s,d,i);
  237.             d += i;
  238.             }
  239.             if (clen) {
  240.             (void)bcopy(c,d,clen);
  241.             d += clen;
  242.             }
  243.             s = spat->spat_regexp->endp[0];
  244.         } while (regexec(spat->spat_regexp, s, strend, orig, s == m,
  245.             Nullstr, TRUE));    /* (don't match same null twice) */
  246.         if (s != d) {
  247.             i = strend - s;
  248.             str->str_cur = d - str->str_ptr + i;
  249.             (void)bcopy(s,d,i+1);        /* include the Null */
  250.         }
  251.         STABSET(str);
  252.         str_numset(arg->arg_ptr.arg_str, (double)iters);
  253.         stack->ary_array[++sp] = arg->arg_ptr.arg_str;
  254.         return sp;
  255.         }
  256.         str_numset(arg->arg_ptr.arg_str, 0.0);
  257.         stack->ary_array[++sp] = arg->arg_ptr.arg_str;
  258.         return sp;
  259.     }
  260.     }
  261.     else
  262.     c = Nullch;
  263.     if (regexec(spat->spat_regexp, s, strend, orig, 0,
  264.       str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
  265.     long_way:
  266.     dstr = Str_new(25,str_len(str));
  267.     str_nset(dstr,m,s-m);
  268.     if (spat->spat_regexp->subbase)
  269.         curspat = spat;
  270.     lastspat = spat;
  271.     do {
  272.         if (iters++ > maxiters)
  273.         fatal("Substitution loop");
  274.         if (spat->spat_regexp->subbase
  275.           && spat->spat_regexp->subbase != orig) {
  276.         m = s;
  277.         s = orig;
  278.         orig = spat->spat_regexp->subbase;
  279.         s = orig + (m - s);
  280.         strend = s + (strend - m);
  281.         }
  282.         m = spat->spat_regexp->startp[0];
  283.         str_ncat(dstr,s,m-s);
  284.         s = spat->spat_regexp->endp[0];
  285.         if (c) {
  286.         if (clen)
  287.             str_ncat(dstr,c,clen);
  288.         }
  289.         else {
  290.         char *mysubbase = spat->spat_regexp->subbase;
  291.  
  292.         spat->spat_regexp->subbase = Nullch;    /* so recursion works */
  293.         (void)eval(rspat->spat_repl,G_SCALAR,sp);
  294.         str_scat(dstr,stack->ary_array[sp+1]);
  295.         if (spat->spat_regexp->subbase)
  296.             Safefree(spat->spat_regexp->subbase);
  297.         spat->spat_regexp->subbase = mysubbase;
  298.         }
  299.         if (once)
  300.         break;
  301.     } while (regexec(spat->spat_regexp, s, strend, orig, s == m, Nullstr,
  302.         safebase));
  303.     str_ncat(dstr,s,strend - s);
  304.     str_replace(str,dstr);
  305.     STABSET(str);
  306.     str_numset(arg->arg_ptr.arg_str, (double)iters);
  307.     stack->ary_array[++sp] = arg->arg_ptr.arg_str;
  308.     return sp;
  309.     }
  310.     str_numset(arg->arg_ptr.arg_str, 0.0);
  311.     stack->ary_array[++sp] = arg->arg_ptr.arg_str;
  312.     return sp;
  313.  
  314. nope:
  315.     ++spat->spat_short->str_u.str_useful;
  316.     str_numset(arg->arg_ptr.arg_str, 0.0);
  317.     stack->ary_array[++sp] = arg->arg_ptr.arg_str;
  318.     return sp;
  319. }
  320. #ifdef BUGGY_MSC
  321.  #pragma intrinsic(memcmp)
  322. #endif /* BUGGY_MSC */
  323.  
  324. int
  325. do_trans(str,arg)
  326. STR *str;
  327. ARG *arg;
  328. {
  329.     register short *tbl;
  330.     register char *s;
  331.     register int matches = 0;
  332.     register int ch;
  333.     register char *send;
  334.     register char *d;
  335.     register int squash = arg[2].arg_len & 1;
  336.  
  337.     tbl = (short*) arg[2].arg_ptr.arg_cval;
  338.     s = str_get(str);
  339.     send = s + str->str_cur;
  340.     if (!tbl || !s)
  341.     fatal("panic: do_trans");
  342. #ifdef DEBUGGING
  343.     if (debug & 8) {
  344.     deb("2.TBL\n");
  345.     }
  346. #endif
  347.     if (!arg[2].arg_len) {
  348.     while (s < send) {
  349.         if ((ch = tbl[*s & 0377]) >= 0) {
  350.         matches++;
  351.         *s = ch;
  352.         }
  353.         s++;
  354.     }
  355.     }
  356.     else {
  357.     d = s;
  358.     while (s < send) {
  359.         if ((ch = tbl[*s & 0377]) >= 0) {
  360.         *d = ch;
  361.         if (matches++ && squash) {
  362.             if (d[-1] == *d)
  363.             matches--;
  364.             else
  365.             d++;
  366.         }
  367.         else
  368.             d++;
  369.         }
  370.         else if (ch == -1)        /* -1 is unmapped character */
  371.         *d++ = *s;        /* -2 is delete character */
  372.         s++;
  373.     }
  374.     matches += send - d;    /* account for disappeared chars */
  375.     *d = '\0';
  376.     str->str_cur = d - str->str_ptr;
  377.     }
  378.     STABSET(str);
  379.     return matches;
  380. }
  381.  
  382. void
  383. do_join(str,arglast)
  384. register STR *str;
  385. int *arglast;
  386. {
  387.     register STR **st = stack->ary_array;
  388.     register int sp = arglast[1];
  389.     register int items = arglast[2] - sp;
  390.     register char *delim = str_get(st[sp]);
  391.     int delimlen = st[sp]->str_cur;
  392.  
  393.     st += ++sp;
  394.     if (items-- > 0)
  395.     str_sset(str, *st++);
  396.     else
  397.     str_set(str,"");
  398.     if (delimlen) {
  399.     for (; items > 0; items--,st++) {
  400.         str_ncat(str,delim,delimlen);
  401.         str_scat(str,*st);
  402.     }
  403.     }
  404.     else {
  405.     for (; items > 0; items--,st++)
  406.         str_scat(str,*st);
  407.     }
  408.     STABSET(str);
  409. }
  410.  
  411. void
  412. do_pack(str,arglast)
  413. register STR *str;
  414. int *arglast;
  415. {
  416.     register STR **st = stack->ary_array;
  417.     register int sp = arglast[1];
  418.     register int items;
  419.     register char *pat = str_get(st[sp]);
  420.     register char *patend = pat + st[sp]->str_cur;
  421.     register int len;
  422.     int datumtype;
  423.     STR *fromstr;
  424.     /*SUPPRESS 442*/
  425.     static char *null10 = "\0\0\0\0\0\0\0\0\0\0";
  426.     static char *space10 = "          ";
  427.  
  428.     /* These must not be in registers: */
  429.     char achar;
  430.     short ashort;
  431.     int aint;
  432.     unsigned int auint;
  433.     long along;
  434.     unsigned long aulong;
  435. #ifdef QUAD
  436.     quad aquad;
  437.     unsigned quad auquad;
  438. #endif
  439.     char *aptr;
  440.     float afloat;
  441.     double adouble;
  442.  
  443.     items = arglast[2] - sp;
  444.     st += ++sp;
  445.     str_nset(str,"",0);
  446.     while (pat < patend) {
  447. #define NEXTFROM (items-- > 0 ? *st++ : &str_no)
  448.     datumtype = *pat++;
  449.     if (*pat == '*') {
  450.         len = index("@Xxu",datumtype) ? 0 : items;
  451.         pat++;
  452.     }
  453.     else if (isDIGIT(*pat)) {
  454.         len = *pat++ - '0';
  455.         while (isDIGIT(*pat))
  456.         len = (len * 10) + (*pat++ - '0');
  457.     }
  458.     else
  459.         len = 1;
  460.     switch(datumtype) {
  461.     default:
  462.         break;
  463.     case '%':
  464.         fatal("% may only be used in unpack");
  465.     case '@':
  466.         len -= str->str_cur;
  467.         if (len > 0)
  468.         goto grow;
  469.         len = -len;
  470.         if (len > 0)
  471.         goto shrink;
  472.         break;
  473.     case 'X':
  474.       shrink:
  475.         if (str->str_cur < len)
  476.         fatal("X outside of string");
  477.         str->str_cur -= len;
  478.         str->str_ptr[str->str_cur] = '\0';
  479.         break;
  480.     case 'x':
  481.       grow:
  482.         while (len >= 10) {
  483.         str_ncat(str,null10,10);
  484.         len -= 10;
  485.         }
  486.         str_ncat(str,null10,len);
  487.         break;
  488.     case 'A':
  489.     case 'a':
  490.         fromstr = NEXTFROM;
  491.         aptr = str_get(fromstr);
  492.         if (pat[-1] == '*')
  493.         len = fromstr->str_cur;
  494.         if (fromstr->str_cur > len)
  495.         str_ncat(str,aptr,len);
  496.         else {
  497.         str_ncat(str,aptr,fromstr->str_cur);
  498.         len -= fromstr->str_cur;
  499.         if (datumtype == 'A') {
  500.             while (len >= 10) {
  501.             str_ncat(str,space10,10);
  502.             len -= 10;
  503.             }
  504.             str_ncat(str,space10,len);
  505.         }
  506.         else {
  507.             while (len >= 10) {
  508.             str_ncat(str,null10,10);
  509.             len -= 10;
  510.             }
  511.             str_ncat(str,null10,len);
  512.         }
  513.         }
  514.         break;
  515.     case 'B':
  516.     case 'b':
  517.         {
  518.         char *savepat = pat;
  519.         int saveitems;
  520.  
  521.         fromstr = NEXTFROM;
  522.         saveitems = items;
  523.         aptr = str_get(fromstr);
  524.         if (pat[-1] == '*')
  525.             len = fromstr->str_cur;
  526.         pat = aptr;
  527.         aint = str->str_cur;
  528.         str->str_cur += (len+7)/8;
  529.         STR_GROW(str, str->str_cur + 1);
  530.         aptr = str->str_ptr + aint;
  531.         if (len > fromstr->str_cur)
  532.             len = fromstr->str_cur;
  533.         aint = len;
  534.         items = 0;
  535.         if (datumtype == 'B') {
  536.             for (len = 0; len++ < aint;) {
  537.             items |= *pat++ & 1;
  538.             if (len & 7)
  539.                 items <<= 1;
  540.             else {
  541.                 *aptr++ = items & 0xff;
  542.                 items = 0;
  543.             }
  544.             }
  545.         }
  546.         else {
  547.             for (len = 0; len++ < aint;) {
  548.             if (*pat++ & 1)
  549.                 items |= 128;
  550.             if (len & 7)
  551.                 items >>= 1;
  552.             else {
  553.                 *aptr++ = items & 0xff;
  554.                 items = 0;
  555.             }
  556.             }
  557.         }
  558.         if (aint & 7) {
  559.             if (datumtype == 'B')
  560.             items <<= 7 - (aint & 7);
  561.             else
  562.             items >>= 7 - (aint & 7);
  563.             *aptr++ = items & 0xff;
  564.         }
  565.         pat = str->str_ptr + str->str_cur;
  566.         while (aptr <= pat)
  567.             *aptr++ = '\0';
  568.  
  569.         pat = savepat;
  570.         items = saveitems;
  571.         }
  572.         break;
  573.     case 'H':
  574.     case 'h':
  575.         {
  576.         char *savepat = pat;
  577.         int saveitems;
  578.  
  579.         fromstr = NEXTFROM;
  580.         saveitems = items;
  581.         aptr = str_get(fromstr);
  582.         if (pat[-1] == '*')
  583.             len = fromstr->str_cur;
  584.         pat = aptr;
  585.         aint = str->str_cur;
  586.         str->str_cur += (len+1)/2;
  587.         STR_GROW(str, str->str_cur + 1);
  588.         aptr = str->str_ptr + aint;
  589.         if (len > fromstr->str_cur)
  590.             len = fromstr->str_cur;
  591.         aint = len;
  592.         items = 0;
  593.         if (datumtype == 'H') {
  594.             for (len = 0; len++ < aint;) {
  595.             if (isALPHA(*pat))
  596.                 items |= ((*pat++ & 15) + 9) & 15;
  597.             else
  598.                 items |= *pat++ & 15;
  599.             if (len & 1)
  600.                 items <<= 4;
  601.             else {
  602.                 *aptr++ = items & 0xff;
  603.                 items = 0;
  604.             }
  605.             }
  606.         }
  607.         else {
  608.             for (len = 0; len++ < aint;) {
  609.             if (isALPHA(*pat))
  610.                 items |= (((*pat++ & 15) + 9) & 15) << 4;
  611.             else
  612.                 items |= (*pat++ & 15) << 4;
  613.             if (len & 1)
  614.                 items >>= 4;
  615.             else {
  616.                 *aptr++ = items & 0xff;
  617.                 items = 0;
  618.             }
  619.             }
  620.         }
  621.         if (aint & 1)
  622.             *aptr++ = items & 0xff;
  623.         pat = str->str_ptr + str->str_cur;
  624.         while (aptr <= pat)
  625.             *aptr++ = '\0';
  626.  
  627.         pat = savepat;
  628.         items = saveitems;
  629.         }
  630.         break;
  631.     case 'C':
  632.     case 'c':
  633.         while (len-- > 0) {
  634.         fromstr = NEXTFROM;
  635.         aint = (int)str_gnum(fromstr);
  636.         achar = aint;
  637.         str_ncat(str,&achar,sizeof(char));
  638.         }
  639.         break;
  640.     /* Float and double added by gnb@melba.bby.oz.au  22/11/89 */
  641.     case 'f':
  642.     case 'F':
  643.         while (len-- > 0) {
  644.         fromstr = NEXTFROM;
  645.         afloat = (float)str_gnum(fromstr);
  646.         str_ncat(str, (char *)&afloat, sizeof (float));
  647.         }
  648.         break;
  649.     case 'd':
  650.     case 'D':
  651.         while (len-- > 0) {
  652.         fromstr = NEXTFROM;
  653.         adouble = (double)str_gnum(fromstr);
  654.         str_ncat(str, (char *)&adouble, sizeof (double));
  655.         }
  656.         break;
  657.     case 'n':
  658.         while (len-- > 0) {
  659.         fromstr = NEXTFROM;
  660.         ashort = (short)str_gnum(fromstr);
  661. #ifdef HAS_HTONS
  662.         ashort = htons(ashort);
  663. #endif
  664.         str_ncat(str,(char*)&ashort,sizeof(short));
  665.         }
  666.         break;
  667.     case 'v':
  668.         while (len-- > 0) {
  669.         fromstr = NEXTFROM;
  670.         ashort = (short)str_gnum(fromstr);
  671. #ifdef HAS_HTOVS
  672.         ashort = htovs(ashort);
  673. #endif
  674.         str_ncat(str,(char*)&ashort,sizeof(short));
  675.         }
  676.         break;
  677.     case 'S':
  678.     case 's':
  679.         while (len-- > 0) {
  680.         fromstr = NEXTFROM;
  681.         ashort = (short)str_gnum(fromstr);
  682.         str_ncat(str,(char*)&ashort,sizeof(short));
  683.         }
  684.         break;
  685.     case 'I':
  686.         while (len-- > 0) {
  687.         fromstr = NEXTFROM;
  688.         auint = U_I(str_gnum(fromstr));
  689.         str_ncat(str,(char*)&auint,sizeof(unsigned int));
  690.         }
  691.         break;
  692.     case 'i':
  693.         while (len-- > 0) {
  694.         fromstr = NEXTFROM;
  695.         aint = (int)str_gnum(fromstr);
  696.         str_ncat(str,(char*)&aint,sizeof(int));
  697.         }
  698.         break;
  699.     case 'N':
  700.         while (len-- > 0) {
  701.         fromstr = NEXTFROM;
  702.         aulong = U_L(str_gnum(fromstr));
  703. #ifdef HAS_HTONL
  704.         aulong = htonl(aulong);
  705. #endif
  706.         str_ncat(str,(char*)&aulong,sizeof(unsigned long));
  707.         }
  708.         break;
  709.     case 'V':
  710.         while (len-- > 0) {
  711.         fromstr = NEXTFROM;
  712.         aulong = U_L(str_gnum(fromstr));
  713. #ifdef HAS_HTOVL
  714.         aulong = htovl(aulong);
  715. #endif
  716.         str_ncat(str,(char*)&aulong,sizeof(unsigned long));
  717.         }
  718.         break;
  719.     case 'L':
  720.         while (len-- > 0) {
  721.         fromstr = NEXTFROM;
  722.         aulong = U_L(str_gnum(fromstr));
  723.         str_ncat(str,(char*)&aulong,sizeof(unsigned long));
  724.         }
  725.         break;
  726.     case 'l':
  727.         while (len-- > 0) {
  728.         fromstr = NEXTFROM;
  729.         along = (long)str_gnum(fromstr);
  730.         str_ncat(str,(char*)&along,sizeof(long));
  731.         }
  732.         break;
  733. #ifdef QUAD
  734.     case 'Q':
  735.         while (len-- > 0) {
  736.         fromstr = NEXTFROM;
  737.         auquad = (unsigned quad)str_gnum(fromstr);
  738.         str_ncat(str,(char*)&auquad,sizeof(unsigned quad));
  739.         }
  740.         break;
  741.     case 'q':
  742.         while (len-- > 0) {
  743.         fromstr = NEXTFROM;
  744.         aquad = (quad)str_gnum(fromstr);
  745.         str_ncat(str,(char*)&aquad,sizeof(quad));
  746.         }
  747.         break;
  748. #endif /* QUAD */
  749.     case 'p':
  750.         while (len-- > 0) {
  751.         fromstr = NEXTFROM;
  752.         aptr = str_get(fromstr);
  753.         str_ncat(str,(char*)&aptr,sizeof(char*));
  754.         }
  755.         break;
  756.     case 'u':
  757.         fromstr = NEXTFROM;
  758.         aptr = str_get(fromstr);
  759.         aint = fromstr->str_cur;
  760.         STR_GROW(str,aint * 4 / 3);
  761.         if (len <= 1)
  762.         len = 45;
  763.         else
  764.         len = len / 3 * 3;
  765.         while (aint > 0) {
  766.         int todo;
  767.  
  768.         if (aint > len)
  769.             todo = len;
  770.         else
  771.             todo = aint;
  772.         doencodes(str, aptr, todo);
  773.         aint -= todo;
  774.         aptr += todo;
  775.         }
  776.         break;
  777.     }
  778.     }
  779.     STABSET(str);
  780. }
  781. #undef NEXTFROM
  782.  
  783. doencodes(str, s, len)
  784. register STR *str;
  785. register char *s;
  786. register int len;
  787. {
  788.     char hunk[5];
  789.  
  790.     *hunk = len + ' ';
  791.     str_ncat(str, hunk, 1);
  792.     hunk[4] = '\0';
  793.     while (len > 0) {
  794.     hunk[0] = ' ' + (077 & (*s >> 2));
  795.     hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
  796.     hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
  797.     hunk[3] = ' ' + (077 & (s[2] & 077));
  798.     str_ncat(str, hunk, 4);
  799.     s += 3;
  800.     len -= 3;
  801.     }
  802.     for (s = str->str_ptr; *s; s++) {
  803.     if (*s == ' ')
  804.         *s = '`';
  805.     }
  806.     str_ncat(str, "\n", 1);
  807. }
  808.  
  809. void
  810. do_sprintf(str,len,sarg)
  811. register STR *str;
  812. register int len;
  813. register STR **sarg;
  814. {
  815.     register char *s;
  816.     register char *t;
  817.     register char *f;
  818.     bool dolong;
  819. #ifdef QUAD
  820.     bool doquad;
  821. #endif /* QUAD */
  822.     char ch;
  823.     static STR *sargnull = &str_no;
  824.     register char *send;
  825.     register STR *arg;
  826.     char *xs;
  827.     int xlen;
  828.     int pre;
  829.     int post;
  830.     double value;
  831.  
  832.     str_set(str,"");
  833.     len--;            /* don't count pattern string */
  834.     t = s = str_get(*sarg);
  835.     send = s + (*sarg)->str_cur;
  836.     sarg++;
  837.     for ( ; ; len--) {
  838.  
  839.     /*SUPPRESS 560*/
  840.     if (len <= 0 || !(arg = *sarg++))
  841.         arg = sargnull;
  842.  
  843.     /*SUPPRESS 530*/
  844.     for ( ; t < send && *t != '%'; t++) ;
  845.     if (t >= send)
  846.         break;        /* end of format string, ignore extra args */
  847.     f = t;
  848.     *buf = '\0';
  849.     xs = buf;
  850. #ifdef QUAD
  851.     doquad =
  852. #endif /* QUAD */
  853.     dolong = FALSE;
  854.     pre = post = 0;
  855.     for (t++; t < send; t++) {
  856.         switch (*t) {
  857.         default:
  858.         ch = *(++t);
  859.         *t = '\0';
  860.         (void)sprintf(xs,f);
  861.         len++, sarg--;
  862.         xlen = strlen(xs);
  863.         break;
  864.         case '0': case '1': case '2': case '3': case '4':
  865.         case '5': case '6': case '7': case '8': case '9': 
  866.         case '.': case '#': case '-': case '+': case ' ':
  867.         continue;
  868.         case 'l':
  869. #ifdef QUAD
  870.         if (dolong) {
  871.             dolong = FALSE;
  872.             doquad = TRUE;
  873.         } else
  874. #endif
  875.         dolong = TRUE;
  876.         continue;
  877.         case 'c':
  878.         ch = *(++t);
  879.         *t = '\0';
  880.         xlen = (int)str_gnum(arg);
  881.         if (strEQ(f,"%c")) { /* some printfs fail on null chars */
  882.             *xs = xlen;
  883.             xs[1] = '\0';
  884.             xlen = 1;
  885.         }
  886.         else {
  887.             (void)sprintf(xs,f,xlen);
  888.             xlen = strlen(xs);
  889.         }
  890.         break;
  891.         case 'D':
  892.         dolong = TRUE;
  893.         /* FALL THROUGH */
  894.         case 'd':
  895.         ch = *(++t);
  896.         *t = '\0';
  897. #ifdef QUAD
  898.         if (doquad)
  899.             (void)sprintf(buf,s,(quad)str_gnum(arg));
  900.         else
  901. #endif
  902.         if (dolong)
  903.             (void)sprintf(xs,f,(long)str_gnum(arg));
  904.         else
  905.             (void)sprintf(xs,f,(int)str_gnum(arg));
  906.         xlen = strlen(xs);
  907.         break;
  908.         case 'X': case 'O':
  909.         dolong = TRUE;
  910.         /* FALL THROUGH */
  911.         case 'x': case 'o': case 'u':
  912.         ch = *(++t);
  913.         *t = '\0';
  914.         value = str_gnum(arg);
  915. #ifdef QUAD
  916.         if (doquad)
  917.             (void)sprintf(buf,s,(unsigned quad)value);
  918.         else
  919. #endif
  920.         if (dolong)
  921.             (void)sprintf(xs,f,U_L(value));
  922.         else
  923.             (void)sprintf(xs,f,U_I(value));
  924.         xlen = strlen(xs);
  925.         break;
  926.         case 'E': case 'e': case 'f': case 'G': case 'g':
  927.         ch = *(++t);
  928.         *t = '\0';
  929.         (void)sprintf(xs,f,str_gnum(arg));
  930.         xlen = strlen(xs);
  931.         break;
  932.         case 's':
  933.         ch = *(++t);
  934.         *t = '\0';
  935.         xs = str_get(arg);
  936.         xlen = arg->str_cur;
  937.         if (*xs == 'S' && xs[1] == 't' && xs[2] == 'B' && xs[3] == '\0'
  938.           && xlen == sizeof(STBP)) {
  939.             STR *tmpstr = Str_new(24,0);
  940.  
  941.             stab_fullname(tmpstr, ((STAB*)arg)); /* a stab value! */
  942.             sprintf(tokenbuf,"*%s",tmpstr->str_ptr);
  943.                     /* reformat to non-binary */
  944.             xs = tokenbuf;
  945.             xlen = strlen(tokenbuf);
  946.             str_free(tmpstr);
  947.         }
  948.         if (strEQ(f,"%s")) {    /* some printfs fail on >128 chars */
  949.             break;        /* so handle simple cases */
  950.         }
  951.         else if (f[1] == '-') {
  952.             char *mp = index(f, '.');
  953.             int min = atoi(f+2);
  954.  
  955.             if (xlen < min)
  956.             post = min - xlen;
  957.             else if (mp) {
  958.             int max = atoi(mp+1);
  959.  
  960.             if (xlen > max)
  961.                 xlen = max;
  962.             }
  963.             break;
  964.         }
  965.         else if (isDIGIT(f[1])) {
  966.             char *mp = index(f, '.');
  967.             int min = atoi(f+1);
  968.  
  969.             if (xlen < min)
  970.             pre = min - xlen;
  971.             else if (mp) {
  972.             int max = atoi(mp+1);
  973.  
  974.             if (xlen > max)
  975.                 xlen = max;
  976.             }
  977.             break;
  978.         }
  979.         strcpy(tokenbuf+64,f);    /* sprintf($s,...$s...) */
  980.         *t = ch;
  981.         (void)sprintf(buf,tokenbuf+64,xs);
  982.         xs = buf;
  983.         xlen = strlen(xs);
  984.         break;
  985.         }
  986.         /* end of switch, copy results */
  987.         *t = ch;
  988.         STR_GROW(str, str->str_cur + (f - s) + xlen + 1 + pre + post);
  989.         str_ncat(str, s, f - s);
  990.         if (pre) {
  991.         repeatcpy(str->str_ptr + str->str_cur, " ", 1, pre);
  992.         str->str_cur += pre;
  993.         }
  994.         str_ncat(str, xs, xlen);
  995.         if (post) {
  996.         repeatcpy(str->str_ptr + str->str_cur, " ", 1, post);
  997.         str->str_cur += post;
  998.         }
  999.         s = t;
  1000.         break;        /* break from for loop */
  1001.     }
  1002.     }
  1003.     str_ncat(str, s, t - s);
  1004.     STABSET(str);
  1005. }
  1006.  
  1007. STR *
  1008. do_push(ary,arglast)
  1009. register ARRAY *ary;
  1010. int *arglast;
  1011. {
  1012.     register STR **st = stack->ary_array;
  1013.     register int sp = arglast[1];
  1014.     register int items = arglast[2] - sp;
  1015.     register STR *str = &str_undef;
  1016.  
  1017.     for (st += ++sp; items > 0; items--,st++) {
  1018.     str = Str_new(26,0);
  1019.     if (*st)
  1020.         str_sset(str,*st);
  1021.     (void)apush(ary,str);
  1022.     }
  1023.     return str;
  1024. }
  1025.  
  1026. void
  1027. do_unshift(ary,arglast)
  1028. register ARRAY *ary;
  1029. int *arglast;
  1030. {
  1031.     register STR **st = stack->ary_array;
  1032.     register int sp = arglast[1];
  1033.     register int items = arglast[2] - sp;
  1034.     register STR *str;
  1035.     register int i;
  1036.  
  1037.     aunshift(ary,items);
  1038.     i = 0;
  1039.     for (st += ++sp; i < items; i++,st++) {
  1040.     str = Str_new(27,0);
  1041.     str_sset(str,*st);
  1042.     (void)astore(ary,i,str);
  1043.     }
  1044. }
  1045.  
  1046. int
  1047. do_subr(arg,gimme,arglast)
  1048. register ARG *arg;
  1049. int gimme;
  1050. int *arglast;
  1051. {
  1052.     register STR **st = stack->ary_array;
  1053.     register int sp = arglast[1];
  1054.     register int items = arglast[2] - sp;
  1055.     register SUBR *sub;
  1056.     STR *str;
  1057.     STAB *stab;
  1058.     int oldsave = savestack->ary_fill;
  1059.     int oldtmps_base = tmps_base;
  1060.     int hasargs = ((arg[2].arg_type & A_MASK) != A_NULL);
  1061.     register CSV *csv;
  1062.  
  1063.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1064.     stab = arg[1].arg_ptr.arg_stab;
  1065.     else {
  1066.     STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
  1067.  
  1068.     if (tmpstr)
  1069.         stab = stabent(str_get(tmpstr),TRUE);
  1070.     else
  1071.         stab = Nullstab;
  1072.     }
  1073.     if (!stab)
  1074.     fatal("Undefined subroutine called");
  1075.     if (!(sub = stab_sub(stab))) {
  1076.     STR *tmpstr = arg[0].arg_ptr.arg_str;
  1077.  
  1078.     stab_fullname(tmpstr, stab);
  1079.     fatal("Undefined subroutine \"%s\" called",tmpstr->str_ptr);
  1080.     }
  1081.     if (arg->arg_type == O_DBSUBR && !sub->usersub) {
  1082.     str = stab_val(DBsub);
  1083.     saveitem(str);
  1084.     stab_fullname(str,stab);
  1085.     sub = stab_sub(DBsub);
  1086.     if (!sub)
  1087.         fatal("No DBsub routine");
  1088.     }
  1089.     str = Str_new(15, sizeof(CSV));
  1090.     str->str_state = SS_SCSV;
  1091.     (void)apush(savestack,str);
  1092.     csv = (CSV*)str->str_ptr;
  1093.     csv->sub = sub;
  1094.     csv->stab = stab;
  1095.     csv->curcsv = curcsv;
  1096.     csv->curcmd = curcmd;
  1097.     csv->depth = sub->depth;
  1098.     csv->wantarray = gimme;
  1099.     csv->hasargs = hasargs;
  1100.     curcsv = csv;
  1101.     if (sub->usersub) {
  1102.     csv->hasargs = 0;
  1103.     csv->savearray = Null(ARRAY*);;
  1104.     csv->argarray = Null(ARRAY*);
  1105.     st[sp] = arg->arg_ptr.arg_str;
  1106.     if (!hasargs)
  1107.         items = 0;
  1108.     return (*sub->usersub)(sub->userindex,sp,items);
  1109.     }
  1110.     if (hasargs) {
  1111.     csv->savearray = stab_xarray(defstab);
  1112.     csv->argarray = afake(defstab, items, &st[sp+1]);
  1113.     stab_xarray(defstab) = csv->argarray;
  1114.     }
  1115.     sub->depth++;
  1116.     if (sub->depth >= 2) {    /* save temporaries on recursion? */
  1117.     if (sub->depth == 100 && dowarn)
  1118.         warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
  1119.     savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
  1120.     }
  1121.     tmps_base = tmps_max;
  1122.     sp = cmd_exec(sub->cmd,gimme, --sp);    /* so do it already */
  1123.     st = stack->ary_array;
  1124.  
  1125.     tmps_base = oldtmps_base;
  1126.     for (items = arglast[0] + 1; items <= sp; items++)
  1127.     st[items] = str_mortal(st[items]);
  1128.         /* in case restore wipes old str */
  1129.     restorelist(oldsave);
  1130.     return sp;
  1131. }
  1132.  
  1133. int
  1134. do_assign(arg,gimme,arglast)
  1135. register ARG *arg;
  1136. int gimme;
  1137. int *arglast;
  1138. {
  1139.  
  1140.     register STR **st = stack->ary_array;
  1141.     STR **firstrelem = st + arglast[1] + 1;
  1142.     STR **firstlelem = st + arglast[0] + 1;
  1143.     STR **lastrelem = st + arglast[2];
  1144.     STR **lastlelem = st + arglast[1];
  1145.     register STR **relem;
  1146.     register STR **lelem;
  1147.  
  1148.     register STR *str;
  1149.     register ARRAY *ary;
  1150.     register int makelocal;
  1151.     HASH *hash;
  1152.     int i;
  1153.  
  1154.     makelocal = (arg->arg_flags & AF_LOCAL) != 0;
  1155.     localizing = makelocal;
  1156.     delaymagic = DM_DELAY;        /* catch simultaneous items */
  1157.  
  1158.     /* If there's a common identifier on both sides we have to take
  1159.      * special care that assigning the identifier on the left doesn't
  1160.      * clobber a value on the right that's used later in the list.
  1161.      */
  1162.     if (arg->arg_flags & AF_COMMON) {
  1163.     for (relem = firstrelem; relem <= lastrelem; relem++) {
  1164.         /*SUPPRESS 560*/
  1165.         if (str = *relem)
  1166.         *relem = str_mortal(str);
  1167.     }
  1168.     }
  1169.     relem = firstrelem;
  1170.     lelem = firstlelem;
  1171.     ary = Null(ARRAY*);
  1172.     hash = Null(HASH*);
  1173.     while (lelem <= lastlelem) {
  1174.     str = *lelem++;
  1175.     if (str->str_state >= SS_HASH) {
  1176.         if (str->str_state == SS_ARY) {
  1177.         if (makelocal)
  1178.             ary = saveary(str->str_u.str_stab);
  1179.         else {
  1180.             ary = stab_array(str->str_u.str_stab);
  1181.             ary->ary_fill = -1;
  1182.         }
  1183.         i = 0;
  1184.         while (relem <= lastrelem) {    /* gobble up all the rest */
  1185.             str = Str_new(28,0);
  1186.             if (*relem)
  1187.             str_sset(str,*relem);
  1188.             *(relem++) = str;
  1189.             (void)astore(ary,i++,str);
  1190.         }
  1191.         }
  1192.         else if (str->str_state == SS_HASH) {
  1193.         char *tmps;
  1194.         STR *tmpstr;
  1195.         int magic = 0;
  1196.         STAB *tmpstab = str->str_u.str_stab;
  1197.  
  1198.         if (makelocal)
  1199.             hash = savehash(str->str_u.str_stab);
  1200.         else {
  1201.             hash = stab_hash(str->str_u.str_stab);
  1202.             if (tmpstab == envstab) {
  1203.             magic = 'E';
  1204.             environ[0] = Nullch;
  1205.             }
  1206.             else if (tmpstab == sigstab) {
  1207.             magic = 'S';
  1208. #ifndef NSIG
  1209. #define NSIG 32
  1210. #endif
  1211.             for (i = 1; i < NSIG; i++)
  1212.                 signal(i, SIG_DFL);    /* crunch, crunch, crunch */
  1213.             }
  1214. #ifdef SOME_DBM
  1215.             else if (hash->tbl_dbm)
  1216.             magic = 'D';
  1217. #endif
  1218.             hclear(hash, magic == 'D');    /* wipe any dbm file too */
  1219.  
  1220.         }
  1221.         while (relem < lastrelem) {    /* gobble up all the rest */
  1222.             if (*relem)
  1223.             str = *(relem++);
  1224.             else
  1225.             str = &str_no, relem++;
  1226.             tmps = str_get(str);
  1227.             tmpstr = Str_new(29,0);
  1228.             if (*relem)
  1229.             str_sset(tmpstr,*relem);    /* value */
  1230.             *(relem++) = tmpstr;
  1231.             (void)hstore(hash,tmps,str->str_cur,tmpstr,0);
  1232.             if (magic) {
  1233.             str_magic(tmpstr, tmpstab, magic, tmps, str->str_cur);
  1234.             stabset(tmpstr->str_magic, tmpstr);
  1235.             }
  1236.         }
  1237.         }
  1238.         else
  1239.         fatal("panic: do_assign");
  1240.     }
  1241.     else {
  1242.         if (makelocal)
  1243.         saveitem(str);
  1244.         if (relem <= lastrelem) {
  1245.         str_sset(str, *relem);
  1246.         *(relem++) = str;
  1247.         }
  1248.         else {
  1249.         str_sset(str, &str_undef);
  1250.         if (gimme == G_ARRAY) {
  1251.             i = ++lastrelem - firstrelem;
  1252.             relem++;        /* tacky, I suppose */
  1253.             astore(stack,i,str);
  1254.             if (st != stack->ary_array) {
  1255.             st = stack->ary_array;
  1256.             firstrelem = st + arglast[1] + 1;
  1257.             firstlelem = st + arglast[0] + 1;
  1258.             lastlelem = st + arglast[1];
  1259.             lastrelem = st + i;
  1260.             relem = lastrelem + 1;
  1261.             }
  1262.         }
  1263.         }
  1264.         STABSET(str);
  1265.     }
  1266.     }
  1267.     if (delaymagic > 1) {
  1268.     if (delaymagic & DM_REUID) {
  1269. #ifdef HAS_SETREUID
  1270.         setreuid(uid,euid);
  1271. #else
  1272.         if (uid != euid || setuid(uid) < 0)
  1273.         fatal("No setreuid available");
  1274. #endif
  1275.     }
  1276.     if (delaymagic & DM_REGID) {
  1277. #ifdef HAS_SETREGID
  1278.         setregid(gid,egid);
  1279. #else
  1280.         if (gid != egid || setgid(gid) < 0)
  1281.         fatal("No setregid available");
  1282. #endif
  1283.     }
  1284.     }
  1285.     delaymagic = 0;
  1286.     localizing = FALSE;
  1287.     if (gimme == G_ARRAY) {
  1288.     i = lastrelem - firstrelem + 1;
  1289.     if (ary || hash)
  1290.         Copy(firstrelem, firstlelem, i, STR*);
  1291.     return arglast[0] + i;
  1292.     }
  1293.     else {
  1294.     str_numset(arg->arg_ptr.arg_str,(double)(arglast[2] - arglast[1]));
  1295.     *firstlelem = arg->arg_ptr.arg_str;
  1296.     return arglast[0] + 1;
  1297.     }
  1298. }
  1299.  
  1300. int                    /*SUPPRESS 590*/
  1301. do_study(str,arg,gimme,arglast)
  1302. STR *str;
  1303. ARG *arg;
  1304. int gimme;
  1305. int *arglast;
  1306. {
  1307.     register unsigned char *s;
  1308.     register int pos = str->str_cur;
  1309.     register int ch;
  1310.     register int *sfirst;
  1311.     register int *snext;
  1312.     static int maxscream = -1;
  1313.     static STR *lastscream = Nullstr;
  1314.     int retval;
  1315.     int retarg = arglast[0] + 1;
  1316.  
  1317. #ifndef lint
  1318.     s = (unsigned char*)(str_get(str));
  1319. #else
  1320.     s = Null(unsigned char*);
  1321. #endif
  1322.     if (lastscream)
  1323.     lastscream->str_pok &= ~SP_STUDIED;
  1324.     lastscream = str;
  1325.     if (pos <= 0) {
  1326.     retval = 0;
  1327.     goto ret;
  1328.     }
  1329.     if (pos > maxscream) {
  1330.     if (maxscream < 0) {
  1331.         maxscream = pos + 80;
  1332.         New(301,screamfirst, 256, int);
  1333.         New(302,screamnext, maxscream, int);
  1334.     }
  1335.     else {
  1336.         maxscream = pos + pos / 4;
  1337.         Renew(screamnext, maxscream, int);
  1338.     }
  1339.     }
  1340.  
  1341.     sfirst = screamfirst;
  1342.     snext = screamnext;
  1343.  
  1344.     if (!sfirst || !snext)
  1345.     fatal("do_study: out of memory");
  1346.  
  1347.     for (ch = 256; ch; --ch)
  1348.     *sfirst++ = -1;
  1349.     sfirst -= 256;
  1350.  
  1351.     while (--pos >= 0) {
  1352.     ch = s[pos];
  1353.     if (sfirst[ch] >= 0)
  1354.         snext[pos] = sfirst[ch] - pos;
  1355.     else
  1356.         snext[pos] = -pos;
  1357.     sfirst[ch] = pos;
  1358.  
  1359.     /* If there were any case insensitive searches, we must assume they
  1360.      * all are.  This speeds up insensitive searches much more than
  1361.      * it slows down sensitive ones.
  1362.      */
  1363.     if (sawi)
  1364.         sfirst[fold[ch]] = pos;
  1365.     }
  1366.  
  1367.     str->str_pok |= SP_STUDIED;
  1368.     retval = 1;
  1369.   ret:
  1370.     str_numset(arg->arg_ptr.arg_str,(double)retval);
  1371.     stack->ary_array[retarg] = arg->arg_ptr.arg_str;
  1372.     return retarg;
  1373. }
  1374.  
  1375. int                    /*SUPPRESS 590*/
  1376. do_defined(str,arg,gimme,arglast)
  1377. STR *str;
  1378. register ARG *arg;
  1379. int gimme;
  1380. int *arglast;
  1381. {
  1382.     register int type;
  1383.     register int retarg = arglast[0] + 1;
  1384.     int retval;
  1385.     ARRAY *ary;
  1386.     HASH *hash;
  1387.  
  1388.     if ((arg[1].arg_type & A_MASK) != A_LEXPR)
  1389.     fatal("Illegal argument to defined()");
  1390.     arg = arg[1].arg_ptr.arg_arg;
  1391.     type = arg->arg_type;
  1392.  
  1393.     if (type == O_SUBR || type == O_DBSUBR) {
  1394.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1395.         retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0;
  1396.     else {
  1397.         STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
  1398.  
  1399.         retval = tmpstr && stab_sub(stabent(str_get(tmpstr),TRUE)) != 0;
  1400.     }
  1401.     }
  1402.     else if (type == O_ARRAY || type == O_LARRAY ||
  1403.          type == O_ASLICE || type == O_LASLICE )
  1404.     retval = ((ary = stab_xarray(arg[1].arg_ptr.arg_stab)) != 0
  1405.         && ary->ary_max >= 0 );
  1406.     else if (type == O_HASH || type == O_LHASH ||
  1407.          type == O_HSLICE || type == O_LHSLICE )
  1408.     retval = ((hash = stab_xhash(arg[1].arg_ptr.arg_stab)) != 0
  1409.         && hash->tbl_array);
  1410.     else
  1411.     retval = FALSE;
  1412.     str_numset(str,(double)retval);
  1413.     stack->ary_array[retarg] = str;
  1414.     return retarg;
  1415. }
  1416.  
  1417. int                        /*SUPPRESS 590*/
  1418. do_undef(str,arg,gimme,arglast)
  1419. STR *str;
  1420. register ARG *arg;
  1421. int gimme;
  1422. int *arglast;
  1423. {
  1424.     register int type;
  1425.     register STAB *stab;
  1426.     int retarg = arglast[0] + 1;
  1427.  
  1428.     if ((arg[1].arg_type & A_MASK) != A_LEXPR)
  1429.     fatal("Illegal argument to undef()");
  1430.     arg = arg[1].arg_ptr.arg_arg;
  1431.     type = arg->arg_type;
  1432.  
  1433.     if (type == O_ARRAY || type == O_LARRAY) {
  1434.     stab = arg[1].arg_ptr.arg_stab;
  1435.     afree(stab_xarray(stab));
  1436.     stab_xarray(stab) = anew(stab);        /* so "@array" still works */
  1437.     }
  1438.     else if (type == O_HASH || type == O_LHASH) {
  1439.     stab = arg[1].arg_ptr.arg_stab;
  1440.     if (stab == envstab)
  1441.         environ[0] = Nullch;
  1442.     else if (stab == sigstab) {
  1443.         int i;
  1444.  
  1445.         for (i = 1; i < NSIG; i++)
  1446.         signal(i, SIG_DFL);    /* munch, munch, munch */
  1447.     }
  1448.     (void)hfree(stab_xhash(stab), TRUE);
  1449.     stab_xhash(stab) = Null(HASH*);
  1450.     }
  1451.     else if (type == O_SUBR || type == O_DBSUBR) {
  1452.     stab = arg[1].arg_ptr.arg_stab;
  1453.     if ((arg[1].arg_type & A_MASK) != A_WORD) {
  1454.         STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
  1455.  
  1456.         if (tmpstr)
  1457.         stab = stabent(str_get(tmpstr),TRUE);
  1458.         else
  1459.         stab = Nullstab;
  1460.     }
  1461.     if (stab && stab_sub(stab)) {
  1462.         cmd_free(stab_sub(stab)->cmd);
  1463.         stab_sub(stab)->cmd = Nullcmd;
  1464.         afree(stab_sub(stab)->tosave);
  1465.         Safefree(stab_sub(stab));
  1466.         stab_sub(stab) = Null(SUBR*);
  1467.     }
  1468.     }
  1469.     else
  1470.     fatal("Can't undefine that kind of object");
  1471.     str_numset(str,0.0);
  1472.     stack->ary_array[retarg] = str;
  1473.     return retarg;
  1474. }
  1475.  
  1476. int
  1477. do_vec(lvalue,astr,arglast)
  1478. int lvalue;
  1479. STR *astr;
  1480. int *arglast;
  1481. {
  1482.     STR **st = stack->ary_array;
  1483.     int sp = arglast[0];
  1484.     register STR *str = st[++sp];
  1485.     register int offset = (int)str_gnum(st[++sp]);
  1486.     register int size = (int)str_gnum(st[++sp]);
  1487.     unsigned char *s = (unsigned char*)str_get(str);
  1488.     unsigned long retnum;
  1489.     int len;
  1490.  
  1491.     sp = arglast[1];
  1492.     offset *= size;        /* turn into bit offset */
  1493.     len = (offset + size + 7) / 8;
  1494.     if (offset < 0 || size < 1)
  1495.     retnum = 0;
  1496.     else if (!lvalue && len > str->str_cur)
  1497.     retnum = 0;
  1498.     else {
  1499.     if (len > str->str_cur) {
  1500.         STR_GROW(str,len);
  1501.         (void)bzero(str->str_ptr + str->str_cur, len - str->str_cur);
  1502.         str->str_cur = len;
  1503.     }
  1504.     s = (unsigned char*)str_get(str);
  1505.     if (size < 8)
  1506.         retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
  1507.     else {
  1508.         offset >>= 3;
  1509.         if (size == 8)
  1510.         retnum = s[offset];
  1511.         else if (size == 16)
  1512.         retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
  1513.         else if (size == 32)
  1514.         retnum = ((unsigned long) s[offset] << 24) +
  1515.             ((unsigned long) s[offset + 1] << 16) +
  1516.             (s[offset + 2] << 8) + s[offset+3];
  1517.     }
  1518.  
  1519.     if (lvalue) {                      /* it's an lvalue! */
  1520.         struct lstring *lstr = (struct lstring*)astr;
  1521.  
  1522.         astr->str_magic = str;
  1523.         st[sp]->str_rare = 'v';
  1524.         lstr->lstr_offset = offset;
  1525.         lstr->lstr_len = size;
  1526.     }
  1527.     }
  1528.  
  1529.     str_numset(astr,(double)retnum);
  1530.     st[sp] = astr;
  1531.     return sp;
  1532. }
  1533.  
  1534. void
  1535. do_vecset(mstr,str)
  1536. STR *mstr;
  1537. STR *str;
  1538. {
  1539.     struct lstring *lstr = (struct lstring*)str;
  1540.     register int offset;
  1541.     register int size;
  1542.     register unsigned char *s = (unsigned char*)mstr->str_ptr;
  1543.     register unsigned long lval = U_L(str_gnum(str));
  1544.     int mask;
  1545.  
  1546.     mstr->str_rare = 0;
  1547.     str->str_magic = Nullstr;
  1548.     offset = lstr->lstr_offset;
  1549.     size = lstr->lstr_len;
  1550.     if (size < 8) {
  1551.     mask = (1 << size) - 1;
  1552.     size = offset & 7;
  1553.     lval &= mask;
  1554.     offset >>= 3;
  1555.     s[offset] &= ~(mask << size);
  1556.     s[offset] |= lval << size;
  1557.     }
  1558.     else {
  1559.     if (size == 8)
  1560.         s[offset] = lval & 255;
  1561.     else if (size == 16) {
  1562.         s[offset] = (lval >> 8) & 255;
  1563.         s[offset+1] = lval & 255;
  1564.     }
  1565.     else if (size == 32) {
  1566.         s[offset] = (lval >> 24) & 255;
  1567.         s[offset+1] = (lval >> 16) & 255;
  1568.         s[offset+2] = (lval >> 8) & 255;
  1569.         s[offset+3] = lval & 255;
  1570.     }
  1571.     }
  1572. }
  1573.  
  1574. do_chop(astr,str)
  1575. register STR *astr;
  1576. register STR *str;
  1577. {
  1578.     register char *tmps;
  1579.     register int i;
  1580.     ARRAY *ary;
  1581.     HASH *hash;
  1582.     HENT *entry;
  1583.  
  1584.     if (!str)
  1585.     return;
  1586.     if (str->str_state == SS_ARY) {
  1587.     ary = stab_array(str->str_u.str_stab);
  1588.     for (i = 0; i <= ary->ary_fill; i++)
  1589.         do_chop(astr,ary->ary_array[i]);
  1590.     return;
  1591.     }
  1592.     if (str->str_state == SS_HASH) {
  1593.     hash = stab_hash(str->str_u.str_stab);
  1594.     (void)hiterinit(hash);
  1595.     /*SUPPRESS 560*/
  1596.     while (entry = hiternext(hash))
  1597.         do_chop(astr,hiterval(hash,entry));
  1598.     return;
  1599.     }
  1600.     tmps = str_get(str);
  1601.     if (tmps && str->str_cur) {
  1602.     tmps += str->str_cur - 1;
  1603.     str_nset(astr,tmps,1);    /* remember last char */
  1604.     *tmps = '\0';                /* wipe it out */
  1605.     str->str_cur = tmps - str->str_ptr;
  1606.     str->str_nok = 0;
  1607.     STABSET(str);
  1608.     }
  1609.     else
  1610.     str_nset(astr,"",0);
  1611. }
  1612.  
  1613. do_vop(optype,str,left,right)
  1614. STR *str;
  1615. STR *left;
  1616. STR *right;
  1617. {
  1618.     register char *s;
  1619.     register char *l = str_get(left);
  1620.     register char *r = str_get(right);
  1621.     register int len;
  1622.  
  1623.     len = left->str_cur;
  1624.     if (len > right->str_cur)
  1625.     len = right->str_cur;
  1626.     if (str->str_cur > len)
  1627.     str->str_cur = len;
  1628.     else if (str->str_cur < len) {
  1629.     STR_GROW(str,len);
  1630.     (void)bzero(str->str_ptr + str->str_cur, len - str->str_cur);
  1631.     str->str_cur = len;
  1632.     }
  1633.     str->str_pok = 1;
  1634.     str->str_nok = 0;
  1635.     s = str->str_ptr;
  1636.     if (!s) {
  1637.     str_nset(str,"",0);
  1638.     s = str->str_ptr;
  1639.     }
  1640.     switch (optype) {
  1641.     case O_BIT_AND:
  1642.     while (len--)
  1643.         *s++ = *l++ & *r++;
  1644.     break;
  1645.     case O_XOR:
  1646.     while (len--)
  1647.         *s++ = *l++ ^ *r++;
  1648.     goto mop_up;
  1649.     case O_BIT_OR:
  1650.     while (len--)
  1651.         *s++ = *l++ | *r++;
  1652.       mop_up:
  1653.     len = str->str_cur;
  1654.     if (right->str_cur > len)
  1655.         str_ncat(str,right->str_ptr+len,right->str_cur - len);
  1656.     else if (left->str_cur > len)
  1657.         str_ncat(str,left->str_ptr+len,left->str_cur - len);
  1658.     break;
  1659.     }
  1660. }
  1661.  
  1662. int
  1663. do_syscall(arglast)
  1664. int *arglast;
  1665. {
  1666.     register STR **st = stack->ary_array;
  1667.     register int sp = arglast[1];
  1668.     register int items = arglast[2] - sp;
  1669.     unsigned long arg[8];
  1670.     register int i = 0;
  1671.     int retval = -1;
  1672.  
  1673. #ifdef HAS_SYSCALL
  1674. #ifdef TAINT
  1675.     for (st += ++sp; items--; st++)
  1676.     tainted |= (*st)->str_tainted;
  1677.     st = stack->ary_array;
  1678.     sp = arglast[1];
  1679.     items = arglast[2] - sp;
  1680. #endif
  1681. #ifdef TAINT
  1682.     taintproper("Insecure dependency in syscall");
  1683. #endif
  1684.     /* This probably won't work on machines where sizeof(long) != sizeof(int)
  1685.      * or where sizeof(long) != sizeof(char*).  But such machines will
  1686.      * not likely have syscall implemented either, so who cares?
  1687.      */
  1688.     while (items--) {
  1689.     if (st[++sp]->str_nok || !i)
  1690.         arg[i++] = (unsigned long)str_gnum(st[sp]);
  1691. #ifndef lint
  1692.     else
  1693.         arg[i++] = (unsigned long)st[sp]->str_ptr;
  1694. #endif /* lint */
  1695.     }
  1696.     sp = arglast[1];
  1697.     items = arglast[2] - sp;
  1698.     switch (items) {
  1699.     case 0:
  1700.     fatal("Too few args to syscall");
  1701.     case 1:
  1702.     retval = syscall(arg[0]);
  1703.     break;
  1704.     case 2:
  1705.     retval = syscall(arg[0],arg[1]);
  1706.     break;
  1707.     case 3:
  1708.     retval = syscall(arg[0],arg[1],arg[2]);
  1709.     break;
  1710.     case 4:
  1711.     retval = syscall(arg[0],arg[1],arg[2],arg[3]);
  1712.     break;
  1713.     case 5:
  1714.     retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4]);
  1715.     break;
  1716.     case 6:
  1717.     retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5]);
  1718.     break;
  1719.     case 7:
  1720.     retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6]);
  1721.     break;
  1722.     case 8:
  1723.     retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
  1724.       arg[7]);
  1725.     break;
  1726.     }
  1727.     return retval;
  1728. #else
  1729.     fatal("syscall() unimplemented");
  1730. #endif
  1731. }
  1732.  
  1733.  
  1734.