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