home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / PERL4036.ZIP / eval.c < prev    next >
C/C++ Source or Header  |  1993-02-26  |  75KB  |  3,020 lines
  1. /* $RCSfile: eval.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 13:20:20 $
  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:    eval.c,v $
  9.  * Revision 4.0.1.4  92/06/08  13:20:20  lwall
  10.  * patch20: added explicit time_t support
  11.  * patch20: fixed confusion between a *var's real name and its effective name
  12.  * patch20: added Atari ST portability
  13.  * patch20: new warning for use of x with non-numeric right operand
  14.  * patch20: modulus with highest bit in left operand set didn't always work
  15.  * patch20: dbmclose(%array) didn't work
  16.  * patch20: added ... as variant on ..
  17.  * patch20: O_PIPE conflicted with Atari
  18.  * 
  19.  * Revision 4.0.1.3  91/11/05  17:15:21  lwall
  20.  * patch11: prepared for ctype implementations that don't define isascii()
  21.  * patch11: various portability fixes
  22.  * patch11: added sort {} LIST
  23.  * patch11: added eval {}
  24.  * patch11: sysread() in socket was substituting recv()
  25.  * patch11: a last statement outside any block caused occasional core dumps
  26.  * patch11: missing arguments caused core dump in -D8 code
  27.  * patch11: eval 'stuff' now optimized to eval {stuff}
  28.  * 
  29.  * Revision 4.0.1.2  91/06/07  11:07:23  lwall
  30.  * patch4: new copyright notice
  31.  * patch4: length($`), length($&), length($') now optimized to avoid string copy
  32.  * patch4: assignment wasn't correctly de-tainting the assigned variable.
  33.  * patch4: default top-of-form format is now FILEHANDLE_TOP
  34.  * patch4: added $^P variable to control calling of perldb routines
  35.  * patch4: taintchecks could improperly modify parent in vfork()
  36.  * patch4: many, many itty-bitty portability fixes
  37.  * 
  38.  * Revision 4.0.1.1  91/04/11  17:43:48  lwall
  39.  * patch1: fixed failed fork to return undef as documented
  40.  * patch1: reduced maximum branch distance in eval.c
  41.  * 
  42.  * Revision 4.0  91/03/20  01:16:48  lwall
  43.  * 4.0 baseline.
  44.  * 
  45.  */
  46.  
  47. #include "EXTERN.h"
  48. #include "perl.h"
  49.  
  50. #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  51. #include <signal.h>
  52. #endif
  53.  
  54. #ifdef I_FCNTL
  55. #include <fcntl.h>
  56. #endif
  57. #ifdef DOSISH
  58. /* I_FCNTL *MUST* not be defined for MS-DOS
  59.    but fcntl.h is required for O_BINARY */
  60. #include <fcntl.h>
  61. #endif
  62. #ifdef I_SYS_FILE
  63. #include <sys/file.h>
  64. #endif
  65. #ifdef I_VFORK
  66. #   include <vfork.h>
  67. #endif
  68.  
  69. #ifdef VOIDSIG
  70. static void (*ihand)();
  71. static void (*qhand)();
  72. #else
  73. static int (*ihand)();
  74. static int (*qhand)();
  75. #endif
  76.  
  77. ARG *debarg;
  78. STR str_args;
  79. static STAB *stab2;
  80. static STIO *stio;
  81. static struct lstring *lstr;
  82. static int old_rschar;
  83. static int old_rslen;
  84.  
  85. double sin(), cos(), atan2(), pow();
  86.  
  87. char *getlogin();
  88.  
  89. int
  90. eval(arg,gimme,sp)
  91. register ARG *arg;
  92. int gimme;
  93. register int sp;
  94. {
  95.     register STR *str;
  96.     register int anum;
  97.     register int optype;
  98.     register STR **st;
  99.     int maxarg;
  100.     double value;
  101.     register char *tmps;
  102.     char *tmps2;
  103.     int argflags;
  104.     int argtype;
  105.     union argptr argptr;
  106.     int arglast[8];    /* highest sp for arg--valid only for non-O_LIST args */
  107.     unsigned long tmpulong;
  108.     long tmplong;
  109.     time_t when;
  110.     STRLEN tmplen;
  111.     FILE *fp;
  112.     STR *tmpstr;
  113.     FCMD *form;
  114.     STAB *stab;
  115.     ARRAY *ary;
  116.     bool assigning = FALSE;
  117.     double exp(), log(), sqrt(), modf();
  118.     char *crypt(), *getenv();
  119.     extern void grow_dlevel();
  120.  
  121.     if (!arg)
  122.     goto say_undef;
  123.     optype = arg->arg_type;
  124.     maxarg = arg->arg_len;
  125.     arglast[0] = sp;
  126.     str = arg->arg_ptr.arg_str;
  127.     if (sp + maxarg > stack->ary_max)
  128.     astore(stack, sp + maxarg, Nullstr);
  129.     st = stack->ary_array;
  130.  
  131. #ifdef DEBUGGING
  132.     if (debug) {
  133.     if (debug & 8) {
  134.         deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg);
  135.     }
  136.     debname[dlevel] = opname[optype][0];
  137.     debdelim[dlevel] = ':';
  138.     if (++dlevel >= dlmax)
  139.         grow_dlevel();
  140.     }
  141. #endif
  142.  
  143.     for (anum = 1; anum <= maxarg; anum++) {
  144.     argflags = arg[anum].arg_flags;
  145.     argtype = arg[anum].arg_type;
  146.     argptr = arg[anum].arg_ptr;
  147.       re_eval:
  148.     switch (argtype) {
  149.     default:
  150.         st[++sp] = &str_undef;
  151. #ifdef DEBUGGING
  152.         tmps = "NULL";
  153. #endif
  154.         break;
  155.     case A_EXPR:
  156. #ifdef DEBUGGING
  157.         if (debug & 8) {
  158.         tmps = "EXPR";
  159.         deb("%d.EXPR =>\n",anum);
  160.         }
  161. #endif
  162.         sp = eval(argptr.arg_arg,
  163.         (argflags & AF_ARYOK) ? G_ARRAY : G_SCALAR, sp);
  164.         if (sp + (maxarg - anum) > stack->ary_max)
  165.         astore(stack, sp + (maxarg - anum), Nullstr);
  166.         st = stack->ary_array;    /* possibly reallocated */
  167.         break;
  168.     case A_CMD:
  169. #ifdef DEBUGGING
  170.         if (debug & 8) {
  171.         tmps = "CMD";
  172.         deb("%d.CMD (%lx) =>\n",anum,argptr.arg_cmd);
  173.         }
  174. #endif
  175.         sp = cmd_exec(argptr.arg_cmd, gimme, sp);
  176.         if (sp + (maxarg - anum) > stack->ary_max)
  177.         astore(stack, sp + (maxarg - anum), Nullstr);
  178.         st = stack->ary_array;    /* possibly reallocated */
  179.         break;
  180.     case A_LARYSTAB:
  181.         ++sp;
  182.         switch (optype) {
  183.         case O_ITEM2: argtype = 2; break;
  184.         case O_ITEM3: argtype = 3; break;
  185.         default:      argtype = anum; break;
  186.         }
  187.         str = afetch(stab_array(argptr.arg_stab),
  188.         arg[argtype].arg_len - arybase, TRUE);
  189. #ifdef DEBUGGING
  190.         if (debug & 8) {
  191.         (void)sprintf(buf,"LARYSTAB $%s[%d]",stab_name(argptr.arg_stab),
  192.             arg[argtype].arg_len);
  193.         tmps = buf;
  194.         }
  195. #endif
  196.         goto do_crement;
  197.     case A_ARYSTAB:
  198.         switch (optype) {
  199.         case O_ITEM2: argtype = 2; break;
  200.         case O_ITEM3: argtype = 3; break;
  201.         default:      argtype = anum; break;
  202.         }
  203.         st[++sp] = afetch(stab_array(argptr.arg_stab),
  204.         arg[argtype].arg_len - arybase, FALSE);
  205. #ifdef DEBUGGING
  206.         if (debug & 8) {
  207.         (void)sprintf(buf,"ARYSTAB $%s[%d]",stab_name(argptr.arg_stab),
  208.             arg[argtype].arg_len);
  209.         tmps = buf;
  210.         }
  211. #endif
  212.         break;
  213.     case A_STAR:
  214.         stab = argptr.arg_stab;
  215.         st[++sp] = (STR*)stab;
  216.         if (!stab_xarray(stab))
  217.         aadd(stab);
  218.         if (!stab_xhash(stab))
  219.         hadd(stab);
  220.         if (!stab_io(stab))
  221.         stab_io(stab) = stio_new();
  222. #ifdef DEBUGGING
  223.         if (debug & 8) {
  224.         (void)sprintf(buf,"STAR *%s -> *%s",
  225.             stab_name(argptr.arg_stab), stab_ename(argptr.arg_stab));
  226.         tmps = buf;
  227.         }
  228. #endif
  229.         break;
  230.     case A_LSTAR:
  231.         str = st[++sp] = (STR*)argptr.arg_stab;
  232. #ifdef DEBUGGING
  233.         if (debug & 8) {
  234.         (void)sprintf(buf,"LSTAR *%s -> *%s",
  235.         stab_name(argptr.arg_stab), stab_ename(argptr.arg_stab));
  236.         tmps = buf;
  237.         }
  238. #endif
  239.         break;
  240.     case A_STAB:
  241.         st[++sp] = STAB_STR(argptr.arg_stab);
  242. #ifdef DEBUGGING
  243.         if (debug & 8) {
  244.         (void)sprintf(buf,"STAB $%s",stab_name(argptr.arg_stab));
  245.         tmps = buf;
  246.         }
  247. #endif
  248.         break;
  249.     case A_LENSTAB:
  250.         str_numset(str, (double)STAB_LEN(argptr.arg_stab));
  251.         st[++sp] = str;
  252. #ifdef DEBUGGING
  253.         if (debug & 8) {
  254.         (void)sprintf(buf,"LENSTAB $%s",stab_name(argptr.arg_stab));
  255.         tmps = buf;
  256.         }
  257. #endif
  258.         break;
  259.     case A_LEXPR:
  260. #ifdef DEBUGGING
  261.         if (debug & 8) {
  262.         tmps = "LEXPR";
  263.         deb("%d.LEXPR =>\n",anum);
  264.         }
  265. #endif
  266.         if (argflags & AF_ARYOK) {
  267.         sp = eval(argptr.arg_arg, G_ARRAY, sp);
  268.         if (sp + (maxarg - anum) > stack->ary_max)
  269.             astore(stack, sp + (maxarg - anum), Nullstr);
  270.         st = stack->ary_array;    /* possibly reallocated */
  271.         }
  272.         else {
  273.         sp = eval(argptr.arg_arg, G_SCALAR, sp);
  274.         st = stack->ary_array;    /* possibly reallocated */
  275.         str = st[sp];
  276.         goto do_crement;
  277.         }
  278.         break;
  279.     case A_LVAL:
  280. #ifdef DEBUGGING
  281.         if (debug & 8) {
  282.         (void)sprintf(buf,"LVAL $%s",stab_name(argptr.arg_stab));
  283.         tmps = buf;
  284.         }
  285. #endif
  286.         ++sp;
  287.         str = STAB_STR(argptr.arg_stab);
  288.         if (!str)
  289.         fatal("panic: A_LVAL");
  290.       do_crement:
  291.         assigning = TRUE;
  292.         if (argflags & AF_PRE) {
  293.         if (argflags & AF_UP)
  294.             str_inc(str);
  295.         else
  296.             str_dec(str);
  297.         STABSET(str);
  298.         st[sp] = str;
  299.         str = arg->arg_ptr.arg_str;
  300.         }
  301.         else if (argflags & AF_POST) {
  302.         st[sp] = str_mortal(str);
  303.         if (argflags & AF_UP)
  304.             str_inc(str);
  305.         else
  306.             str_dec(str);
  307.         STABSET(str);
  308.         str = arg->arg_ptr.arg_str;
  309.         }
  310.         else
  311.         st[sp] = str;
  312.         break;
  313.     case A_LARYLEN:
  314.         ++sp;
  315.         stab = argptr.arg_stab;
  316.         str = stab_array(argptr.arg_stab)->ary_magic;
  317.         if (optype != O_SASSIGN || argflags & (AF_PRE|AF_POST))
  318.         str_numset(str,(double)(stab_array(stab)->ary_fill+arybase));
  319. #ifdef DEBUGGING
  320.         tmps = "LARYLEN";
  321. #endif
  322.         if (!str)
  323.         fatal("panic: A_LEXPR");
  324.         goto do_crement;
  325.     case A_ARYLEN:
  326.         stab = argptr.arg_stab;
  327.         st[++sp] = stab_array(stab)->ary_magic;
  328.         str_numset(st[sp],(double)(stab_array(stab)->ary_fill+arybase));
  329. #ifdef DEBUGGING
  330.         tmps = "ARYLEN";
  331. #endif
  332.         break;
  333.     case A_SINGLE:
  334.         st[++sp] = argptr.arg_str;
  335. #ifdef DEBUGGING
  336.         tmps = "SINGLE";
  337. #endif
  338.         break;
  339.     case A_DOUBLE:
  340.         (void) interp(str,argptr.arg_str,sp);
  341.         st = stack->ary_array;
  342.         st[++sp] = str;
  343. #ifdef DEBUGGING
  344.         tmps = "DOUBLE";
  345. #endif
  346.         break;
  347.     case A_BACKTICK:
  348.         tmps = str_get(interp(str,argptr.arg_str,sp));
  349.         st = stack->ary_array;
  350. #ifdef TAINT
  351.         taintproper("Insecure dependency in ``");
  352. #endif
  353.         fp = mypopen(tmps,"r");
  354.         str_set(str,"");
  355.         if (fp) {
  356.         if (gimme == G_SCALAR) {
  357.             while (str_gets(str,fp,str->str_cur) != Nullch)
  358.             /*SUPPRESS 530*/
  359.             ;
  360.         }
  361.         else {
  362.             for (;;) {
  363.             if (++sp > stack->ary_max) {
  364.                 astore(stack, sp, Nullstr);
  365.                 st = stack->ary_array;
  366.             }
  367.             str = st[sp] = Str_new(56,80);
  368.             if (str_gets(str,fp,0) == Nullch) {
  369.                 sp--;
  370.                 break;
  371.             }
  372.             if (str->str_len - str->str_cur > 20) {
  373.                 str->str_len = str->str_cur+1;
  374.                 Renew(str->str_ptr, str->str_len, char);
  375.             }
  376.             str_2mortal(str);
  377.             }
  378.         }
  379.         statusvalue = mypclose(fp);
  380.         }
  381.         else
  382.         statusvalue = -1;
  383.  
  384.         if (gimme == G_SCALAR)
  385.         st[++sp] = str;
  386. #ifdef DEBUGGING
  387.         tmps = "BACK";
  388. #endif
  389.         break;
  390.     case A_WANTARRAY:
  391.         {
  392.         if (curcsv->wantarray == G_ARRAY)
  393.             st[++sp] = &str_yes;
  394.         else
  395.             st[++sp] = &str_no;
  396.         }
  397. #ifdef DEBUGGING
  398.         tmps = "WANTARRAY";
  399. #endif
  400.         break;
  401.     case A_INDREAD:
  402.         last_in_stab = stabent(str_get(STAB_STR(argptr.arg_stab)),TRUE);
  403.         old_rschar = rschar;
  404.         old_rslen = rslen;
  405.         goto do_read;
  406.     case A_GLOB:
  407.         argflags |= AF_POST;    /* enable newline chopping */
  408.         last_in_stab = argptr.arg_stab;
  409.         old_rschar = rschar;
  410.         old_rslen = rslen;
  411.         rslen = 1;
  412. #ifdef DOSISH
  413.         rschar = 0;
  414. #else
  415. #ifdef CSH
  416.         rschar = 0;
  417. #else
  418.         rschar = '\n';
  419. #endif    /* !CSH */
  420. #endif    /* !MSDOS */
  421.         goto do_read;
  422.     case A_READ:
  423.         last_in_stab = argptr.arg_stab;
  424.         old_rschar = rschar;
  425.         old_rslen = rslen;
  426.       do_read:
  427.         if (anum > 1)        /* assign to scalar */
  428.         gimme = G_SCALAR;    /* force context to scalar */
  429.         if (gimme == G_ARRAY)
  430.         str = Str_new(57,0);
  431.         ++sp;
  432.         fp = Nullfp;
  433.         if (stab_io(last_in_stab)) {
  434.         fp = stab_io(last_in_stab)->ifp;
  435.         if (!fp) {
  436.             if (stab_io(last_in_stab)->flags & IOF_ARGV) {
  437.             if (stab_io(last_in_stab)->flags & IOF_START) {
  438.                 stab_io(last_in_stab)->flags &= ~IOF_START;
  439.                 stab_io(last_in_stab)->lines = 0;
  440.                 if (alen(stab_array(last_in_stab)) < 0) {
  441.                 tmpstr = str_make("-",1); /* assume stdin */
  442.                 (void)apush(stab_array(last_in_stab), tmpstr);
  443.                 }
  444.             }
  445.             fp = nextargv(last_in_stab);
  446.             if (!fp) { /* Note: fp != stab_io(last_in_stab)->ifp */
  447.                 (void)do_close(last_in_stab,FALSE); /* now it does*/
  448.                 stab_io(last_in_stab)->flags |= IOF_START;
  449.             }
  450.             }
  451.             else if (argtype == A_GLOB) {
  452.             (void) interp(str,stab_val(last_in_stab),sp);
  453.             st = stack->ary_array;
  454.             tmpstr = Str_new(55,0);
  455. #ifdef DOSISH
  456.             str_set(tmpstr, "perlglob ");
  457.             str_scat(tmpstr,str);
  458.             str_cat(tmpstr," |");
  459. #else
  460. #ifdef CSH
  461.             str_nset(tmpstr,cshname,cshlen);
  462.             str_cat(tmpstr," -cf 'set nonomatch; glob ");
  463.             str_scat(tmpstr,str);
  464.             str_cat(tmpstr,"'|");
  465. #else
  466.             str_set(tmpstr, "echo ");
  467.             str_scat(tmpstr,str);
  468.             str_cat(tmpstr,
  469.               "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
  470. #endif /* !CSH */
  471. #endif /* !MSDOS */
  472.             (void)do_open(last_in_stab,tmpstr->str_ptr,
  473.               tmpstr->str_cur);
  474.             fp = stab_io(last_in_stab)->ifp;
  475.             str_free(tmpstr);
  476.             }
  477.         }
  478.         }
  479.         if (!fp && dowarn)
  480.         warn("Read on closed filehandle <%s>",stab_ename(last_in_stab));
  481.         tmplen = str->str_len;    /* remember if already alloced */
  482.         if (!tmplen)
  483.         Str_Grow(str,80);    /* try short-buffering it */
  484.       keepgoing:
  485.         if (!fp)
  486.         st[sp] = &str_undef;
  487.         else if (!str_gets(str,fp, optype == O_RCAT ? str->str_cur : 0)) {
  488.         clearerr(fp);
  489.         if (stab_io(last_in_stab)->flags & IOF_ARGV) {
  490.             fp = nextargv(last_in_stab);
  491.             if (fp)
  492.             goto keepgoing;
  493.             (void)do_close(last_in_stab,FALSE);
  494.             stab_io(last_in_stab)->flags |= IOF_START;
  495.         }
  496.         else if (argflags & AF_POST) {
  497.             (void)do_close(last_in_stab,FALSE);
  498.         }
  499.         st[sp] = &str_undef;
  500.         rschar = old_rschar;
  501.         rslen = old_rslen;
  502.         if (gimme == G_ARRAY) {
  503.             --sp;
  504.             str_2mortal(str);
  505.             goto array_return;
  506.         }
  507.         break;
  508.         }
  509.         else {
  510.         stab_io(last_in_stab)->lines++;
  511.         st[sp] = str;
  512. #ifdef TAINT
  513.         str->str_tainted = 1; /* Anything from the outside world...*/
  514. #endif
  515.         if (argflags & AF_POST) {
  516.             if (str->str_cur > 0)
  517.             str->str_cur--;
  518.             if (str->str_ptr[str->str_cur] == rschar)
  519.             str->str_ptr[str->str_cur] = '\0';
  520.             else
  521.             str->str_cur++;
  522.             for (tmps = str->str_ptr; *tmps; tmps++)
  523.             if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
  524.                 index("$&*(){}[]'\";\\|?<>~`",*tmps))
  525.                 break;
  526.             if (*tmps && stat(str->str_ptr,&statbuf) < 0)
  527.             goto keepgoing;        /* unmatched wildcard? */
  528.         }
  529.         if (gimme == G_ARRAY) {
  530.             if (str->str_len - str->str_cur > 20) {
  531.             str->str_len = str->str_cur+1;
  532.             Renew(str->str_ptr, str->str_len, char);
  533.             }
  534.             str_2mortal(str);
  535.             if (++sp > stack->ary_max) {
  536.             astore(stack, sp, Nullstr);
  537.             st = stack->ary_array;
  538.             }
  539.             str = Str_new(58,80);
  540.             goto keepgoing;
  541.         }
  542.         else if (!tmplen && str->str_len - str->str_cur > 80) {
  543.             /* try to reclaim a bit of scalar space on 1st alloc */
  544.             if (str->str_cur < 60)
  545.             str->str_len = 80;
  546.             else
  547.             str->str_len = str->str_cur+40;    /* allow some slop */
  548.             Renew(str->str_ptr, str->str_len, char);
  549.         }
  550.         }
  551.         rschar = old_rschar;
  552.         rslen = old_rslen;
  553. #ifdef DEBUGGING
  554.         tmps = "READ";
  555. #endif
  556.         break;
  557.     }
  558. #ifdef DEBUGGING
  559.     if (debug & 8)
  560.         deb("%d.%s = '%s'\n",anum,tmps,str_peek(st[sp]));
  561. #endif
  562.     if (anum < 8)
  563.         arglast[anum] = sp;
  564.     }
  565.  
  566.     st += arglast[0];
  567. #ifdef SMALLSWITCHES
  568.     if (optype < O_CHOWN)
  569. #endif
  570.     switch (optype) {
  571.     case O_RCAT:
  572.     STABSET(str);
  573.     break;
  574.     case O_ITEM:
  575.     if (gimme == G_ARRAY)
  576.         goto array_return;
  577.     /* FALL THROUGH */
  578.     case O_SCALAR:
  579.     STR_SSET(str,st[1]);
  580.     STABSET(str);
  581.     break;
  582.     case O_ITEM2:
  583.     if (gimme == G_ARRAY)
  584.         goto array_return;
  585.     --anum;
  586.     STR_SSET(str,st[arglast[anum]-arglast[0]]);
  587.     STABSET(str);
  588.     break;
  589.     case O_ITEM3:
  590.     if (gimme == G_ARRAY)
  591.     goto array_return;
  592.     --anum;
  593.     STR_SSET(str,st[arglast[anum]-arglast[0]]);
  594.     STABSET(str);
  595.     break;
  596.     case O_CONCAT:
  597.     STR_SSET(str,st[1]);
  598.     str_scat(str,st[2]);
  599.     STABSET(str);
  600.     break;
  601.     case O_REPEAT:
  602.     if (gimme == G_ARRAY && arg[1].arg_flags & AF_ARYOK) {
  603.         sp = do_repeatary(arglast);
  604.         goto array_return;
  605.     }
  606.     STR_SSET(str,st[1]);
  607.     anum = (int)str_gnum(st[2]);
  608.     if (anum >= 1) {
  609.         tmpstr = Str_new(50, 0);
  610.         tmps = str_get(str);
  611.         str_nset(tmpstr,tmps,str->str_cur);
  612.         tmps = str_get(tmpstr);    /* force to be string */
  613.         STR_GROW(str, (anum * str->str_cur) + 1);
  614.         repeatcpy(str->str_ptr, tmps, tmpstr->str_cur, anum);
  615.         str->str_cur *= anum;
  616.         str->str_ptr[str->str_cur] = '\0';
  617.         str->str_nok = 0;
  618.         str_free(tmpstr);
  619.     }
  620.     else {
  621.         if (dowarn && st[2]->str_pok && !looks_like_number(st[2]))
  622.         warn("Right operand of x is not numeric");
  623.         str_sset(str,&str_no);
  624.     }
  625.     STABSET(str);
  626.     break;
  627.     case O_MATCH:
  628.     sp = do_match(str,arg,
  629.       gimme,arglast);
  630.     if (gimme == G_ARRAY)
  631.         goto array_return;
  632.     STABSET(str);
  633.     break;
  634.     case O_NMATCH:
  635.     sp = do_match(str,arg,
  636.       G_SCALAR,arglast);
  637.     str_sset(str, str_true(str) ? &str_no : &str_yes);
  638.     STABSET(str);
  639.     break;
  640.     case O_SUBST:
  641.     sp = do_subst(str,arg,arglast[0]);
  642.     goto array_return;
  643.     case O_NSUBST:
  644.     sp = do_subst(str,arg,arglast[0]);
  645.     str = arg->arg_ptr.arg_str;
  646.     str_set(str, str_true(str) ? No : Yes);
  647.     goto array_return;
  648.     case O_ASSIGN:
  649.     if (arg[1].arg_flags & AF_ARYOK) {
  650.         if (arg->arg_len == 1) {
  651.         arg->arg_type = O_LOCAL;
  652.         goto local;
  653.         }
  654.         else {
  655.         arg->arg_type = O_AASSIGN;
  656.         goto aassign;
  657.         }
  658.     }
  659.     else {
  660.         arg->arg_type = O_SASSIGN;
  661.         goto sassign;
  662.     }
  663.     case O_LOCAL:
  664.       local:
  665.     arglast[2] = arglast[1];    /* push a null array */
  666.     /* FALL THROUGH */
  667.     case O_AASSIGN:
  668.       aassign:
  669.     sp = do_assign(arg,
  670.       gimme,arglast);
  671.     goto array_return;
  672.     case O_SASSIGN:
  673.       sassign:
  674. #ifdef TAINT
  675.     if (tainted && !st[2]->str_tainted)
  676.         tainted = 0;
  677. #endif
  678.     STR_SSET(str, st[2]);
  679.     STABSET(str);
  680.     break;
  681.     case O_CHOP:
  682.     st -= arglast[0];
  683.     str = arg->arg_ptr.arg_str;
  684.     for (sp = arglast[0] + 1; sp <= arglast[1]; sp++)
  685.         do_chop(str,st[sp]);
  686.     st += arglast[0];
  687.     break;
  688.     case O_DEFINED:
  689.     if (arg[1].arg_type & A_DONT) {
  690.         sp = do_defined(str,arg,
  691.           gimme,arglast);
  692.         goto array_return;
  693.     }
  694.     else if (str->str_pok || str->str_nok)
  695.         goto say_yes;
  696.     goto say_no;
  697.     case O_UNDEF:
  698.     if (arg[1].arg_type & A_DONT) {
  699.         sp = do_undef(str,arg,
  700.           gimme,arglast);
  701.         goto array_return;
  702.     }
  703.     else if (str != stab_val(defstab)) {
  704.         if (str->str_len) {
  705.         if (str->str_state == SS_INCR)
  706.             Str_Grow(str,0);
  707.         Safefree(str->str_ptr);
  708.         str->str_ptr = Nullch;
  709.         str->str_len = 0;
  710.         }
  711.         str->str_pok = str->str_nok = 0;
  712.         STABSET(str);
  713.     }
  714.     goto say_undef;
  715.     case O_STUDY:
  716.     sp = do_study(str,arg,
  717.       gimme,arglast);
  718.     goto array_return;
  719.     case O_POW:
  720.     value = str_gnum(st[1]);
  721.     value = pow(value,str_gnum(st[2]));
  722.     goto donumset;
  723.     case O_MULTIPLY:
  724.     value = str_gnum(st[1]);
  725.     value *= str_gnum(st[2]);
  726.     goto donumset;
  727.     case O_DIVIDE:
  728.     if ((value = str_gnum(st[2])) == 0.0)
  729.         fatal("Illegal division by zero");
  730. #ifdef SLOPPYDIVIDE
  731.     /* insure that 20./5. == 4. */
  732.     {
  733.         double x;
  734.         int    k;
  735.         x =  str_gnum(st[1]);
  736.         if ((double)(int)x     == x &&
  737.         (double)(int)value == value &&
  738.         (k = (int)x/(int)value)*(int)value == (int)x) {
  739.         value = k;
  740.         } else {
  741.         value = x/value;
  742.         }
  743.     }
  744. #else
  745.     value = str_gnum(st[1]) / value;
  746. #endif
  747.     goto donumset;
  748.     case O_MODULO:
  749.     tmpulong = (unsigned long) str_gnum(st[2]);
  750.         if (tmpulong == 0L)
  751.             fatal("Illegal modulus zero");
  752. #ifndef lint
  753.     value = str_gnum(st[1]);
  754.     if (value >= 0.0)
  755.         value = (double)(((unsigned long)value) % tmpulong);
  756.     else {
  757.         tmplong = (long)value;
  758.         value = (double)(tmpulong - ((-tmplong - 1) % tmpulong)) - 1;
  759.     }
  760. #endif
  761.     goto donumset;
  762.     case O_ADD:
  763.     value = str_gnum(st[1]);
  764.     value += str_gnum(st[2]);
  765.     goto donumset;
  766.     case O_SUBTRACT:
  767.     value = str_gnum(st[1]);
  768.     value -= str_gnum(st[2]);
  769.     goto donumset;
  770.     case O_LEFT_SHIFT:
  771.     value = str_gnum(st[1]);
  772.     anum = (int)str_gnum(st[2]);
  773. #ifndef lint
  774.     value = (double)(U_L(value) << anum);
  775. #endif
  776.     goto donumset;
  777.     case O_RIGHT_SHIFT:
  778.     value = str_gnum(st[1]);
  779.     anum = (int)str_gnum(st[2]);
  780. #ifndef lint
  781.     value = (double)(U_L(value) >> anum);
  782. #endif
  783.     goto donumset;
  784.     case O_LT:
  785.     value = str_gnum(st[1]);
  786.     value = (value < str_gnum(st[2])) ? 1.0 : 0.0;
  787.     goto donumset;
  788.     case O_GT:
  789.     value = str_gnum(st[1]);
  790.     value = (value > str_gnum(st[2])) ? 1.0 : 0.0;
  791.     goto donumset;
  792.     case O_LE:
  793.     value = str_gnum(st[1]);
  794.     value = (value <= str_gnum(st[2])) ? 1.0 : 0.0;
  795.     goto donumset;
  796.     case O_GE:
  797.     value = str_gnum(st[1]);
  798.     value = (value >= str_gnum(st[2])) ? 1.0 : 0.0;
  799.     goto donumset;
  800.     case O_EQ:
  801.     if (dowarn) {
  802.         if ((!st[1]->str_nok && !looks_like_number(st[1])) ||
  803.         (!st[2]->str_nok && !looks_like_number(st[2])) )
  804.         warn("Possible use of == on string value");
  805.     }
  806.     value = str_gnum(st[1]);
  807.     value = (value == str_gnum(st[2])) ? 1.0 : 0.0;
  808.     goto donumset;
  809.     case O_NE:
  810.     value = str_gnum(st[1]);
  811.     value = (value != str_gnum(st[2])) ? 1.0 : 0.0;
  812.     goto donumset;
  813.     case O_NCMP:
  814.     value = str_gnum(st[1]);
  815.     value -= str_gnum(st[2]);
  816.     if (value > 0.0)
  817.         value = 1.0;
  818.     else if (value < 0.0)
  819.         value = -1.0;
  820.     goto donumset;
  821.     case O_BIT_AND:
  822.     if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
  823.         value = str_gnum(st[1]);
  824. #ifndef lint
  825.         value = (double)(U_L(value) & U_L(str_gnum(st[2])));
  826. #endif
  827.         goto donumset;
  828.     }
  829.     else
  830.         do_vop(optype,str,st[1],st[2]);
  831.     break;
  832.     case O_XOR:
  833.     if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
  834.         value = str_gnum(st[1]);
  835. #ifndef lint
  836.         value = (double)(U_L(value) ^ U_L(str_gnum(st[2])));
  837. #endif
  838.         goto donumset;
  839.     }
  840.     else
  841.         do_vop(optype,str,st[1],st[2]);
  842.     break;
  843.     case O_BIT_OR:
  844.     if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
  845.         value = str_gnum(st[1]);
  846. #ifndef lint
  847.         value = (double)(U_L(value) | U_L(str_gnum(st[2])));
  848. #endif
  849.         goto donumset;
  850.     }
  851.     else
  852.         do_vop(optype,str,st[1],st[2]);
  853.     break;
  854. /* use register in evaluating str_true() */
  855.     case O_AND:
  856.     if (str_true(st[1])) {
  857.         anum = 2;
  858.         optype = O_ITEM2;
  859.         argflags = arg[anum].arg_flags;
  860.         if (gimme == G_ARRAY)
  861.         argflags |= AF_ARYOK;
  862.         argtype = arg[anum].arg_type & A_MASK;
  863.         argptr = arg[anum].arg_ptr;
  864.         maxarg = anum = 1;
  865.         sp = arglast[0];
  866.         st -= sp;
  867.         goto re_eval;
  868.     }
  869.     else {
  870.         if (assigning) {
  871.         str_sset(str, st[1]);
  872.         STABSET(str);
  873.         }
  874.         else
  875.         str = st[1];
  876.         break;
  877.     }
  878.     case O_OR:
  879.     if (str_true(st[1])) {
  880.         if (assigning) {
  881.         str_sset(str, st[1]);
  882.         STABSET(str);
  883.         }
  884.         else
  885.         str = st[1];
  886.         break;
  887.     }
  888.     else {
  889.         anum = 2;
  890.         optype = O_ITEM2;
  891.         argflags = arg[anum].arg_flags;
  892.         if (gimme == G_ARRAY)
  893.         argflags |= AF_ARYOK;
  894.         argtype = arg[anum].arg_type & A_MASK;
  895.         argptr = arg[anum].arg_ptr;
  896.         maxarg = anum = 1;
  897.         sp = arglast[0];
  898.         st -= sp;
  899.         goto re_eval;
  900.     }
  901.     case O_COND_EXPR:
  902.     anum = (str_true(st[1]) ? 2 : 3);
  903.     optype = (anum == 2 ? O_ITEM2 : O_ITEM3);
  904.     argflags = arg[anum].arg_flags;
  905.     if (gimme == G_ARRAY)
  906.         argflags |= AF_ARYOK;
  907.     argtype = arg[anum].arg_type & A_MASK;
  908.     argptr = arg[anum].arg_ptr;
  909.     maxarg = anum = 1;
  910.     sp = arglast[0];
  911.     st -= sp;
  912.     goto re_eval;
  913.     case O_COMMA:
  914.     if (gimme == G_ARRAY)
  915.         goto array_return;
  916.     str = st[2];
  917.     break;
  918.     case O_NEGATE:
  919.     value = -str_gnum(st[1]);
  920.     goto donumset;
  921.     case O_NOT:
  922. #ifdef NOTNOT
  923.     { char xxx = str_true(st[1]); value = (double) !xxx; }
  924. #else
  925.     value = (double) !str_true(st[1]);
  926. #endif
  927.     goto donumset;
  928.     case O_COMPLEMENT:
  929.     if (!sawvec || st[1]->str_nok) {
  930. #ifndef lint
  931.         value = (double) ~U_L(str_gnum(st[1]));
  932. #endif
  933.         goto donumset;
  934.     }
  935.     else {
  936.         STR_SSET(str,st[1]);
  937.         tmps = str_get(str);
  938.         for (anum = str->str_cur; anum; anum--, tmps++)
  939.         *tmps = ~*tmps;
  940.     }
  941.     break;
  942.     case O_SELECT:
  943.     stab_efullname(str,defoutstab);
  944.     if (maxarg > 0) {
  945.         if ((arg[1].arg_type & A_MASK) == A_WORD)
  946.         defoutstab = arg[1].arg_ptr.arg_stab;
  947.         else
  948.         defoutstab = stabent(str_get(st[1]),TRUE);
  949.         if (!stab_io(defoutstab))
  950.         stab_io(defoutstab) = stio_new();
  951.         curoutstab = defoutstab;
  952.     }
  953.     STABSET(str);
  954.     break;
  955.     case O_WRITE:
  956.     if (maxarg == 0)
  957.         stab = defoutstab;
  958.     else if ((arg[1].arg_type & A_MASK) == A_WORD) {
  959.         if (!(stab = arg[1].arg_ptr.arg_stab))
  960.         stab = defoutstab;
  961.     }
  962.     else
  963.         stab = stabent(str_get(st[1]),TRUE);
  964.     if (!stab_io(stab)) {
  965.         str_set(str, No);
  966.         STABSET(str);
  967.         break;
  968.     }
  969.     curoutstab = stab;
  970.     fp = stab_io(stab)->ofp;
  971.     debarg = arg;
  972.     if (stab_io(stab)->fmt_stab)
  973.         form = stab_form(stab_io(stab)->fmt_stab);
  974.     else
  975.         form = stab_form(stab);
  976.     if (!form || !fp) {
  977.         if (dowarn) {
  978.         if (form)
  979.             warn("No format for filehandle");
  980.         else {
  981.             if (stab_io(stab)->ifp)
  982.             warn("Filehandle only opened for input");
  983.             else
  984.             warn("Write on closed filehandle");
  985.         }
  986.         }
  987.         str_set(str, No);
  988.         STABSET(str);
  989.         break;
  990.     }
  991.     format(&outrec,form,sp);
  992.     do_write(&outrec,stab,sp);
  993.     if (stab_io(stab)->flags & IOF_FLUSH)
  994.         (void)fflush(fp);
  995.     str_set(str, Yes);
  996.     STABSET(str);
  997.     break;
  998.     case O_DBMOPEN:
  999. #ifdef SOME_DBM
  1000.     anum = arg[1].arg_type & A_MASK;
  1001.     if (anum == A_WORD || anum == A_STAB)
  1002.         stab = arg[1].arg_ptr.arg_stab;
  1003.     else
  1004.         stab = stabent(str_get(st[1]),TRUE);
  1005.     if (st[3]->str_nok || st[3]->str_pok)
  1006.         anum = (int)str_gnum(st[3]);
  1007.     else
  1008.         anum = -1;
  1009.     value = (double)hdbmopen(stab_hash(stab),str_get(st[2]),anum);
  1010.     goto donumset;
  1011. #else
  1012.     fatal("No dbm or ndbm on this machine");
  1013. #endif
  1014.     case O_DBMCLOSE:
  1015. #ifdef SOME_DBM
  1016.     anum = arg[1].arg_type & A_MASK;
  1017.     if (anum == A_WORD || anum == A_STAB)
  1018.         stab = arg[1].arg_ptr.arg_stab;
  1019.     else
  1020.         stab = stabent(str_get(st[1]),TRUE);
  1021.     hdbmclose(stab_hash(stab));
  1022.     goto say_yes;
  1023. #else
  1024.     fatal("No dbm or ndbm on this machine");
  1025. #endif
  1026.     case O_OPEN:
  1027.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1028.         stab = arg[1].arg_ptr.arg_stab;
  1029.     else
  1030.         stab = stabent(str_get(st[1]),TRUE);
  1031.     tmps = str_get(st[2]);
  1032.     if (do_open(stab,tmps,st[2]->str_cur)) {
  1033.         value = (double)forkprocess;
  1034.         stab_io(stab)->lines = 0;
  1035.         goto donumset;
  1036.     }
  1037.     else if (forkprocess == 0)        /* we are a new child */
  1038.         goto say_zero;
  1039.     else
  1040.         goto say_undef;
  1041.     /* break; */
  1042.     case O_TRANS:
  1043.     value = (double) do_trans(str,arg);
  1044.     str = arg->arg_ptr.arg_str;
  1045.     goto donumset;
  1046.     case O_NTRANS:
  1047.     str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No);
  1048.     str = arg->arg_ptr.arg_str;
  1049.     break;
  1050.     case O_CLOSE:
  1051.     if (maxarg == 0)
  1052.         stab = defoutstab;
  1053.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  1054.         stab = arg[1].arg_ptr.arg_stab;
  1055.     else
  1056.         stab = stabent(str_get(st[1]),TRUE);
  1057.     str_set(str, do_close(stab,TRUE) ? Yes : No );
  1058.     STABSET(str);
  1059.     break;
  1060.     case O_EACH:
  1061.     sp = do_each(str,stab_hash(arg[1].arg_ptr.arg_stab),
  1062.       gimme,arglast);
  1063.     goto array_return;
  1064.     case O_VALUES:
  1065.     case O_KEYS:
  1066.     sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
  1067.       gimme,arglast);
  1068.     goto array_return;
  1069.     case O_LARRAY:
  1070.     str->str_nok = str->str_pok = 0;
  1071.     str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
  1072.     str->str_state = SS_ARY;
  1073.     break;
  1074.     case O_ARRAY:
  1075.     ary = stab_array(arg[1].arg_ptr.arg_stab);
  1076.     maxarg = ary->ary_fill + 1;
  1077.     if (gimme == G_ARRAY) { /* array wanted */
  1078.         sp = arglast[0];
  1079.         st -= sp;
  1080.         if (maxarg > 0 && sp + maxarg > stack->ary_max) {
  1081.         astore(stack,sp + maxarg, Nullstr);
  1082.         st = stack->ary_array;
  1083.         }
  1084.         st += sp;
  1085.         Copy(ary->ary_array, &st[1], maxarg, STR*);
  1086.         sp += maxarg;
  1087.         goto array_return;
  1088.     }
  1089.     else {
  1090.         value = (double)maxarg;
  1091.         goto donumset;
  1092.     }
  1093.     case O_AELEM:
  1094.     anum = ((int)str_gnum(st[2])) - arybase;
  1095.     str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE);
  1096.     break;
  1097.     case O_DELETE:
  1098.     tmpstab = arg[1].arg_ptr.arg_stab;
  1099.     tmps = str_get(st[2]);
  1100.     str = hdelete(stab_hash(tmpstab),tmps,st[2]->str_cur);
  1101.     if (tmpstab == envstab)
  1102.         my_setenv(tmps,Nullch);
  1103.     if (!str)
  1104.         goto say_undef;
  1105.     break;
  1106.     case O_LHASH:
  1107.     str->str_nok = str->str_pok = 0;
  1108.     str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
  1109.     str->str_state = SS_HASH;
  1110.     break;
  1111.     case O_HASH:
  1112.     if (gimme == G_ARRAY) { /* array wanted */
  1113.         sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
  1114.         gimme,arglast);
  1115.         goto array_return;
  1116.     }
  1117.     else {
  1118.         tmpstab = arg[1].arg_ptr.arg_stab;
  1119.         if (!stab_hash(tmpstab)->tbl_fill)
  1120.         goto say_zero;
  1121.         sprintf(buf,"%d/%d",stab_hash(tmpstab)->tbl_fill,
  1122.         stab_hash(tmpstab)->tbl_max+1);
  1123.         str_set(str,buf);
  1124.     }
  1125.     break;
  1126.     case O_HELEM:
  1127.     tmpstab = arg[1].arg_ptr.arg_stab;
  1128.     tmps = str_get(st[2]);
  1129.     str = hfetch(stab_hash(tmpstab),tmps,st[2]->str_cur,FALSE);
  1130.     break;
  1131.     case O_LAELEM:
  1132.     anum = ((int)str_gnum(st[2])) - arybase;
  1133.     str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,TRUE);
  1134.     if (!str || str == &str_undef)
  1135.         fatal("Assignment to non-creatable value, subscript %d",anum);
  1136.     break;
  1137.     case O_LHELEM:
  1138.     tmpstab = arg[1].arg_ptr.arg_stab;
  1139.     tmps = str_get(st[2]);
  1140.     anum = st[2]->str_cur;
  1141.     str = hfetch(stab_hash(tmpstab),tmps,anum,TRUE);
  1142.     if (!str || str == &str_undef)
  1143.         fatal("Assignment to non-creatable value, subscript \"%s\"",tmps);
  1144.     if (tmpstab == envstab)        /* heavy wizardry going on here */
  1145.         str_magic(str, tmpstab, 'E', tmps, anum);    /* str is now magic */
  1146.                     /* he threw the brick up into the air */
  1147.     else if (tmpstab == sigstab)
  1148.         str_magic(str, tmpstab, 'S', tmps, anum);
  1149. #ifdef SOME_DBM
  1150.     else if (stab_hash(tmpstab)->tbl_dbm)
  1151.         str_magic(str, tmpstab, 'D', tmps, anum);
  1152. #endif
  1153.     else if (tmpstab == DBline)
  1154.         str_magic(str, tmpstab, 'L', tmps, anum);
  1155.     break;
  1156.     case O_LSLICE:
  1157.     anum = 2;
  1158.     argtype = FALSE;
  1159.     goto do_slice_already;
  1160.     case O_ASLICE:
  1161.     anum = 1;
  1162.     argtype = FALSE;
  1163.     goto do_slice_already;
  1164.     case O_HSLICE:
  1165.     anum = 0;
  1166.     argtype = FALSE;
  1167.     goto do_slice_already;
  1168.     case O_LASLICE:
  1169.     anum = 1;
  1170.     argtype = TRUE;
  1171.     goto do_slice_already;
  1172.     case O_LHSLICE:
  1173.     anum = 0;
  1174.     argtype = TRUE;
  1175.       do_slice_already:
  1176.     sp = do_slice(arg[1].arg_ptr.arg_stab,str,anum,argtype,
  1177.         gimme,arglast);
  1178.     goto array_return;
  1179.     case O_SPLICE:
  1180.     sp = do_splice(stab_array(arg[1].arg_ptr.arg_stab),gimme,arglast);
  1181.     goto array_return;
  1182.     case O_PUSH:
  1183.     if (arglast[2] - arglast[1] != 1)
  1184.         str = do_push(stab_array(arg[1].arg_ptr.arg_stab),arglast);
  1185.     else {
  1186.         str = Str_new(51,0);        /* must copy the STR */
  1187.         str_sset(str,st[2]);
  1188.         (void)apush(stab_array(arg[1].arg_ptr.arg_stab),str);
  1189.     }
  1190.     break;
  1191.     case O_POP:
  1192.     str = apop(ary = stab_array(arg[1].arg_ptr.arg_stab));
  1193.     goto staticalization;
  1194.     case O_SHIFT:
  1195.     str = ashift(ary = stab_array(arg[1].arg_ptr.arg_stab));
  1196.       staticalization:
  1197.     if (!str)
  1198.         goto say_undef;
  1199.     if (ary->ary_flags & ARF_REAL)
  1200.         (void)str_2mortal(str);
  1201.     break;
  1202.     case O_UNPACK:
  1203.     sp = do_unpack(str,gimme,arglast);
  1204.     goto array_return;
  1205.     case O_SPLIT:
  1206.     value = str_gnum(st[3]);
  1207.     sp = do_split(str, arg[2].arg_ptr.arg_spat, (int)value,
  1208.       gimme,arglast);
  1209.     goto array_return;
  1210.     case O_LENGTH:
  1211.     if (maxarg < 1)
  1212.         value = (double)str_len(stab_val(defstab));
  1213.     else
  1214.         value = (double)str_len(st[1]);
  1215.     goto donumset;
  1216.     case O_SPRINTF:
  1217.     do_sprintf(str, sp-arglast[0], st+1);
  1218.     break;
  1219.     case O_SUBSTR:
  1220.     anum = ((int)str_gnum(st[2])) - arybase;    /* anum=where to start*/
  1221.     tmps = str_get(st[1]);        /* force conversion to string */
  1222.     /*SUPPRESS 560*/
  1223.     if (argtype = (str == st[1]))
  1224.         str = arg->arg_ptr.arg_str;
  1225.     if (anum < 0)
  1226.         anum += st[1]->str_cur + arybase;
  1227.     if (anum < 0 || anum > st[1]->str_cur)
  1228.         str_nset(str,"",0);
  1229.     else {
  1230.         optype = maxarg < 3 ? st[1]->str_cur : (int)str_gnum(st[3]);
  1231.         if (optype < 0)
  1232.         optype = 0;
  1233.         tmps += anum;
  1234.         anum = st[1]->str_cur - anum;    /* anum=how many bytes left*/
  1235.         if (anum > optype)
  1236.         anum = optype;
  1237.         str_nset(str, tmps, anum);
  1238.         if (argtype) {            /* it's an lvalue! */
  1239.         lstr = (struct lstring*)str;
  1240.         str->str_magic = st[1];
  1241.         st[1]->str_rare = 's';
  1242.         lstr->lstr_offset = tmps - str_get(st[1]); 
  1243.         lstr->lstr_len = anum; 
  1244.         }
  1245.     }
  1246.     break;
  1247.     case O_PACK:
  1248.     /*SUPPRESS 701*/
  1249.     (void)do_pack(str,arglast);
  1250.     break;
  1251.     case O_GREP:
  1252.     sp = do_grep(arg,str,gimme,arglast);
  1253.     goto array_return;
  1254.     case O_JOIN:
  1255.     do_join(str,arglast);
  1256.     break;
  1257.     case O_SLT:
  1258.     tmps = str_get(st[1]);
  1259.     value = (double) (str_cmp(st[1],st[2]) < 0);
  1260.     goto donumset;
  1261.     case O_SGT:
  1262.     tmps = str_get(st[1]);
  1263.     value = (double) (str_cmp(st[1],st[2]) > 0);
  1264.     goto donumset;
  1265.     case O_SLE:
  1266.     tmps = str_get(st[1]);
  1267.     value = (double) (str_cmp(st[1],st[2]) <= 0);
  1268.     goto donumset;
  1269.     case O_SGE:
  1270.     tmps = str_get(st[1]);
  1271.     value = (double) (str_cmp(st[1],st[2]) >= 0);
  1272.     goto donumset;
  1273.     case O_SEQ:
  1274.     tmps = str_get(st[1]);
  1275.     value = (double) str_eq(st[1],st[2]);
  1276.     goto donumset;
  1277.     case O_SNE:
  1278.     tmps = str_get(st[1]);
  1279.     value = (double) !str_eq(st[1],st[2]);
  1280.     goto donumset;
  1281.     case O_SCMP:
  1282.     tmps = str_get(st[1]);
  1283.     value = (double) str_cmp(st[1],st[2]);
  1284.     goto donumset;
  1285.     case O_SUBR:
  1286.     sp = do_subr(arg,gimme,arglast);
  1287.     st = stack->ary_array + arglast[0];        /* maybe realloced */
  1288.     goto array_return;
  1289.     case O_DBSUBR:
  1290.     sp = do_subr(arg,gimme,arglast);
  1291.     st = stack->ary_array + arglast[0];        /* maybe realloced */
  1292.     goto array_return;
  1293.     case O_CALLER:
  1294.     sp = do_caller(arg,maxarg,gimme,arglast);
  1295.     st = stack->ary_array + arglast[0];        /* maybe realloced */
  1296.     goto array_return;
  1297.     case O_SORT:
  1298.     sp = do_sort(str,arg,
  1299.       gimme,arglast);
  1300.     goto array_return;
  1301.     case O_REVERSE:
  1302.     if (gimme == G_ARRAY)
  1303.         sp = do_reverse(arglast);
  1304.     else
  1305.         sp = do_sreverse(str, arglast);
  1306.     goto array_return;
  1307.     case O_WARN:
  1308.     if (arglast[2] - arglast[1] != 1) {
  1309.         do_join(str,arglast);
  1310.         tmps = str_get(str);
  1311.     }
  1312.     else {
  1313.         str = st[2];
  1314.         tmps = str_get(st[2]);
  1315.     }
  1316.     if (!tmps || !*tmps)
  1317.         tmps = "Warning: something's wrong";
  1318.     warn("%s",tmps);
  1319.     goto say_yes;
  1320.     case O_DIE:
  1321.     if (arglast[2] - arglast[1] != 1) {
  1322.         do_join(str,arglast);
  1323.         tmps = str_get(str);
  1324.     }
  1325.     else {
  1326.         str = st[2];
  1327.         tmps = str_get(st[2]);
  1328.     }
  1329.     if (!tmps || !*tmps)
  1330.         tmps = "Died";
  1331.     fatal("%s",tmps);
  1332.     goto say_zero;
  1333.     case O_PRTF:
  1334.     case O_PRINT:
  1335.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1336.         stab = arg[1].arg_ptr.arg_stab;
  1337.     else
  1338.         stab = stabent(str_get(st[1]),TRUE);
  1339.     if (!stab)
  1340.         stab = defoutstab;
  1341.     if (!stab_io(stab)) {
  1342.         if (dowarn)
  1343.         warn("Filehandle never opened");
  1344.         goto say_zero;
  1345.     }
  1346.     if (!(fp = stab_io(stab)->ofp)) {
  1347.         if (dowarn)  {
  1348.         if (stab_io(stab)->ifp)
  1349.             warn("Filehandle opened only for input");
  1350.         else
  1351.             warn("Print on closed filehandle");
  1352.         }
  1353.         goto say_zero;
  1354.     }
  1355.     else {
  1356.         if (optype == O_PRTF || arglast[2] - arglast[1] != 1)
  1357.         value = (double)do_aprint(arg,fp,arglast);
  1358.         else {
  1359.         value = (double)do_print(st[2],fp);
  1360.         if (orslen && optype == O_PRINT)
  1361.             if (fwrite(ors, 1, orslen, fp) == 0)
  1362.             goto say_zero;
  1363.         }
  1364.         if (stab_io(stab)->flags & IOF_FLUSH)
  1365.         if (fflush(fp) == EOF)
  1366.             goto say_zero;
  1367.     }
  1368.     goto donumset;
  1369.     case O_CHDIR:
  1370.     if (maxarg < 1)
  1371.         tmps = Nullch;
  1372.     else
  1373.         tmps = str_get(st[1]);
  1374.     if (!tmps || !*tmps) {
  1375.         tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE);
  1376.         tmps = str_get(tmpstr);
  1377.     }
  1378.     if (!tmps || !*tmps) {
  1379.         tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE);
  1380.         tmps = str_get(tmpstr);
  1381.     }
  1382. #ifdef TAINT
  1383.     taintproper("Insecure dependency in chdir");
  1384. #endif
  1385.     value = (double)(chdir(tmps) >= 0);
  1386.     goto donumset;
  1387.     case O_EXIT:
  1388.     if (maxarg < 1)
  1389.         anum = 0;
  1390.     else
  1391.         anum = (int)str_gnum(st[1]);
  1392.     exit(anum);
  1393.     goto say_zero;
  1394.     case O_RESET:
  1395.     if (maxarg < 1)
  1396.         tmps = "";
  1397.     else
  1398.         tmps = str_get(st[1]);
  1399.     str_reset(tmps,curcmd->c_stash);
  1400.     value = 1.0;
  1401.     goto donumset;
  1402.     case O_LIST:
  1403.     if (gimme == G_ARRAY)
  1404.         goto array_return;
  1405.     if (maxarg > 0)
  1406.         str = st[sp - arglast[0]];    /* unwanted list, return last item */
  1407.     else
  1408.         str = &str_undef;
  1409.     break;
  1410.     case O_EOF:
  1411.     if (maxarg <= 0)
  1412.         stab = last_in_stab;
  1413.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  1414.         stab = arg[1].arg_ptr.arg_stab;
  1415.     else
  1416.         stab = stabent(str_get(st[1]),TRUE);
  1417.     str_set(str, do_eof(stab) ? Yes : No);
  1418.     STABSET(str);
  1419.     break;
  1420.     case O_GETC:
  1421.     if (maxarg <= 0)
  1422.         stab = stdinstab;
  1423.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  1424.         stab = arg[1].arg_ptr.arg_stab;
  1425.     else
  1426.         stab = stabent(str_get(st[1]),TRUE);
  1427.     if (!stab)
  1428.         stab = argvstab;
  1429.     if (!stab || do_eof(stab)) /* make sure we have fp with something */
  1430.         goto say_undef;
  1431.     else {
  1432. #ifdef TAINT
  1433.         tainted = 1;
  1434. #endif
  1435.         str_set(str," ");
  1436.         *str->str_ptr = getc(stab_io(stab)->ifp); /* should never be EOF */
  1437.     }
  1438.     STABSET(str);
  1439.     break;
  1440.     case O_TELL:
  1441.     if (maxarg <= 0)
  1442.         stab = last_in_stab;
  1443.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  1444.         stab = arg[1].arg_ptr.arg_stab;
  1445.     else
  1446.         stab = stabent(str_get(st[1]),TRUE);
  1447. #ifndef lint
  1448.     value = (double)do_tell(stab);
  1449. #else
  1450.     (void)do_tell(stab);
  1451. #endif
  1452.     goto donumset;
  1453.     case O_RECV:
  1454.     case O_READ:
  1455.     case O_SYSREAD:
  1456.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1457.         stab = arg[1].arg_ptr.arg_stab;
  1458.     else
  1459.         stab = stabent(str_get(st[1]),TRUE);
  1460.     tmps = str_get(st[2]);
  1461.     anum = (int)str_gnum(st[3]);
  1462.     errno = 0;
  1463.     maxarg = sp - arglast[0];
  1464.     if (maxarg > 4)
  1465.         warn("Too many args on read");
  1466.     if (maxarg == 4)
  1467.         maxarg = (int)str_gnum(st[4]);
  1468.     else
  1469.         maxarg = 0;
  1470.     if (!stab_io(stab) || !stab_io(stab)->ifp)
  1471.         goto say_undef;
  1472. #ifdef HAS_SOCKET
  1473.     if (optype == O_RECV) {
  1474.         argtype = sizeof buf;
  1475.         STR_GROW(st[2], anum+1), (tmps = str_get(st[2]));  /* sneaky */
  1476.         anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, maxarg,
  1477.         buf, &argtype);
  1478.         if (anum >= 0) {
  1479.         st[2]->str_cur = anum;
  1480.         st[2]->str_ptr[anum] = '\0';
  1481.         str_nset(str,buf,argtype);
  1482.         }
  1483.         else
  1484.         str_sset(str,&str_undef);
  1485.         break;
  1486.     }
  1487. #else
  1488.     if (optype == O_RECV)
  1489.         goto badsock;
  1490. #endif
  1491.     STR_GROW(st[2], anum+maxarg+1), (tmps = str_get(st[2]));  /* sneaky */
  1492.     if (optype == O_SYSREAD) {
  1493.         anum = read(fileno(stab_io(stab)->ifp), tmps+maxarg, anum);
  1494.     }
  1495.     else
  1496. #ifdef HAS_SOCKET
  1497.     if (stab_io(stab)->type == 's') {
  1498.         argtype = sizeof buf;
  1499.         anum = recvfrom(fileno(stab_io(stab)->ifp), tmps+maxarg, anum, 0,
  1500.         buf, &argtype);
  1501.     }
  1502.     else
  1503. #endif
  1504.         anum = fread(tmps+maxarg, 1, anum, stab_io(stab)->ifp);
  1505.     if (anum < 0)
  1506.         goto say_undef;
  1507.     st[2]->str_cur = anum+maxarg;
  1508.     st[2]->str_ptr[anum+maxarg] = '\0';
  1509.     value = (double)anum;
  1510.     goto donumset;
  1511.     case O_SYSWRITE:
  1512.     case O_SEND:
  1513.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1514.         stab = arg[1].arg_ptr.arg_stab;
  1515.     else
  1516.         stab = stabent(str_get(st[1]),TRUE);
  1517.     tmps = str_get(st[2]);
  1518.     anum = (int)str_gnum(st[3]);
  1519.     errno = 0;
  1520.     stio = stab_io(stab);
  1521.     maxarg = sp - arglast[0];
  1522.     if (!stio || !stio->ifp) {
  1523.         anum = -1;
  1524.         if (dowarn) {
  1525.         if (optype == O_SYSWRITE)
  1526.             warn("Syswrite on closed filehandle");
  1527.         else
  1528.             warn("Send on closed socket");
  1529.         }
  1530.     }
  1531.     else if (optype == O_SYSWRITE) {
  1532.         if (maxarg > 4)
  1533.         warn("Too many args on syswrite");
  1534.         if (maxarg == 4)
  1535.         optype = (int)str_gnum(st[4]);
  1536.         else
  1537.         optype = 0;
  1538.         anum = write(fileno(stab_io(stab)->ifp), tmps+optype, anum);
  1539.     }
  1540. #ifdef HAS_SOCKET
  1541.     else if (maxarg >= 4) {
  1542.         if (maxarg > 4)
  1543.         warn("Too many args on send");
  1544.         tmps2 = str_get(st[4]);
  1545.         anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur,
  1546.           anum, tmps2, st[4]->str_cur);
  1547.     }
  1548.     else
  1549.         anum = send(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum);
  1550. #else
  1551.     else
  1552.         goto badsock;
  1553. #endif
  1554.     if (anum < 0)
  1555.         goto say_undef;
  1556.     value = (double)anum;
  1557.     goto donumset;
  1558.     case O_SEEK:
  1559.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1560.         stab = arg[1].arg_ptr.arg_stab;
  1561.     else
  1562.         stab = stabent(str_get(st[1]),TRUE);
  1563.     value = str_gnum(st[2]);
  1564.     str_set(str, do_seek(stab,
  1565.       (long)value, (int)str_gnum(st[3]) ) ? Yes : No);
  1566.     STABSET(str);
  1567.     break;
  1568.     case O_RETURN:
  1569.     tmps = "_SUB_";        /* just fake up a "last _SUB_" */
  1570.     optype = O_LAST;
  1571.     if (curcsv && curcsv->wantarray == G_ARRAY) {
  1572.         lastretstr = Nullstr;
  1573.         lastspbase = arglast[1];
  1574.         lastsize = arglast[2] - arglast[1];
  1575.     }
  1576.     else
  1577.         lastretstr = str_mortal(st[arglast[2] - arglast[0]]);
  1578.     goto dopop;
  1579.     case O_REDO:
  1580.     case O_NEXT:
  1581.     case O_LAST:
  1582.     tmps = Nullch;
  1583.     if (maxarg > 0) {
  1584.         tmps = str_get(arg[1].arg_ptr.arg_str);
  1585.       dopop:
  1586.         while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
  1587.           strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
  1588. #ifdef DEBUGGING
  1589.         if (debug & 4) {
  1590.             deb("(Skipping label #%d %s)\n",loop_ptr,
  1591.             loop_stack[loop_ptr].loop_label);
  1592.         }
  1593. #endif
  1594.         loop_ptr--;
  1595.         }
  1596. #ifdef DEBUGGING
  1597.         if (debug & 4) {
  1598.         deb("(Found label #%d %s)\n",loop_ptr,
  1599.             loop_stack[loop_ptr].loop_label);
  1600.         }
  1601. #endif
  1602.     }
  1603.     if (loop_ptr < 0) {
  1604.         if (tmps && strEQ(tmps, "_SUB_"))
  1605.         fatal("Can't return outside a subroutine");
  1606.         fatal("Bad label: %s", maxarg > 0 ? tmps : "<null>");
  1607.     }
  1608.     if (!lastretstr && optype == O_LAST && lastsize) {
  1609.         st -= arglast[0];
  1610.         st += lastspbase + 1;
  1611.         optype = loop_stack[loop_ptr].loop_sp - lastspbase; /* negative */
  1612.         if (optype) {
  1613.         for (anum = lastsize; anum > 0; anum--,st++)
  1614.             st[optype] = str_mortal(st[0]);
  1615.         }
  1616.         longjmp(loop_stack[loop_ptr].loop_env, O_LAST);
  1617.     }
  1618.     longjmp(loop_stack[loop_ptr].loop_env, optype);
  1619.     case O_DUMP:
  1620.     case O_GOTO:/* shudder */
  1621.     goto_targ = str_get(arg[1].arg_ptr.arg_str);
  1622.     if (!*goto_targ)
  1623.         goto_targ = Nullch;        /* just restart from top */
  1624.     if (optype == O_DUMP) {
  1625.         do_undump = 1;
  1626.         my_unexec();
  1627.     }
  1628.     longjmp(top_env, 1);
  1629.     case O_INDEX:
  1630.     tmps = str_get(st[1]);
  1631.     if (maxarg < 3)
  1632.         anum = 0;
  1633.     else {
  1634.         anum = (int) str_gnum(st[3]) - arybase;
  1635.         if (anum < 0)
  1636.         anum = 0;
  1637.         else if (anum > st[1]->str_cur)
  1638.         anum = st[1]->str_cur;
  1639.     }
  1640. #ifndef lint
  1641.     if (!(tmps2 = fbminstr((unsigned char*)tmps + anum,
  1642.       (unsigned char*)tmps + st[1]->str_cur, st[2])))
  1643. #else
  1644.     if (tmps2 = fbminstr(Null(unsigned char*),Null(unsigned char*),Nullstr))
  1645. #endif
  1646.         value = (double)(-1 + arybase);
  1647.     else
  1648.         value = (double)(tmps2 - tmps + arybase);
  1649.     goto donumset;
  1650.     case O_RINDEX:
  1651.     tmps = str_get(st[1]);
  1652.     tmps2 = str_get(st[2]);
  1653.     if (maxarg < 3)
  1654.         anum = st[1]->str_cur;
  1655.     else {
  1656.         anum = (int) str_gnum(st[3]) - arybase + st[2]->str_cur;
  1657.         if (anum < 0)
  1658.         anum = 0;
  1659.         else if (anum > st[1]->str_cur)
  1660.         anum = st[1]->str_cur;
  1661.     }
  1662. #ifndef lint
  1663.     if (!(tmps2 = rninstr(tmps,  tmps  + anum,
  1664.                   tmps2, tmps2 + st[2]->str_cur)))
  1665. #else
  1666.     if (tmps2 = rninstr(Nullch,Nullch,Nullch,Nullch))
  1667. #endif
  1668.         value = (double)(-1 + arybase);
  1669.     else
  1670.         value = (double)(tmps2 - tmps + arybase);
  1671.     goto donumset;
  1672.     case O_TIME:
  1673. #ifndef lint
  1674.     value = (double) time(Null(long*));
  1675. #endif
  1676.     goto donumset;
  1677.     case O_TMS:
  1678.     sp = do_tms(str,gimme,arglast);
  1679.     goto array_return;
  1680.     case O_LOCALTIME:
  1681.     if (maxarg < 1)
  1682.         (void)time(&when);
  1683.     else
  1684.         when = (time_t)str_gnum(st[1]);
  1685.     sp = do_time(str,localtime(&when),
  1686.       gimme,arglast);
  1687.     goto array_return;
  1688.     case O_GMTIME:
  1689.     if (maxarg < 1)
  1690.         (void)time(&when);
  1691.     else
  1692.         when = (time_t)str_gnum(st[1]);
  1693.     sp = do_time(str,gmtime(&when),
  1694.       gimme,arglast);
  1695.     goto array_return;
  1696.     case O_TRUNCATE:
  1697.     sp = do_truncate(str,arg,
  1698.       gimme,arglast);
  1699.     goto array_return;
  1700.     case O_LSTAT:
  1701.     case O_STAT:
  1702.     sp = do_stat(str,arg,
  1703.       gimme,arglast);
  1704.     goto array_return;
  1705.     case O_CRYPT:
  1706. #ifdef HAS_CRYPT
  1707.     tmps = str_get(st[1]);
  1708. #ifdef FCRYPT
  1709.     str_set(str,fcrypt(tmps,str_get(st[2])));
  1710. #else
  1711.     str_set(str,crypt(tmps,str_get(st[2])));
  1712. #endif
  1713. #else
  1714.     fatal(
  1715.       "The crypt() function is unimplemented due to excessive paranoia.");
  1716. #endif
  1717.     break;
  1718.     case O_ATAN2:
  1719.     value = str_gnum(st[1]);
  1720.     value = atan2(value,str_gnum(st[2]));
  1721.     goto donumset;
  1722.     case O_SIN:
  1723.     if (maxarg < 1)
  1724.         value = str_gnum(stab_val(defstab));
  1725.     else
  1726.         value = str_gnum(st[1]);
  1727.     value = sin(value);
  1728.     goto donumset;
  1729.     case O_COS:
  1730.     if (maxarg < 1)
  1731.         value = str_gnum(stab_val(defstab));
  1732.     else
  1733.         value = str_gnum(st[1]);
  1734.     value = cos(value);
  1735.     goto donumset;
  1736.     case O_RAND:
  1737.     if (maxarg < 1)
  1738.         value = 1.0;
  1739.     else
  1740.         value = str_gnum(st[1]);
  1741.     if (value == 0.0)
  1742.         value = 1.0;
  1743. #if RANDBITS == 31
  1744.     value = rand() * value / 2147483648.0;
  1745. #else
  1746. #if RANDBITS == 16
  1747.     value = rand() * value / 65536.0;
  1748. #else
  1749. #if RANDBITS == 15
  1750.     value = rand() * value / 32768.0;
  1751. #else
  1752.     value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
  1753. #endif
  1754. #endif
  1755. #endif
  1756.     goto donumset;
  1757.     case O_SRAND:
  1758.     if (maxarg < 1) {
  1759.         (void)time(&when);
  1760.         anum = when;
  1761.     }
  1762.     else
  1763.         anum = (int)str_gnum(st[1]);
  1764.     (void)srand(anum);
  1765.     goto say_yes;
  1766.     case O_EXP:
  1767.     if (maxarg < 1)
  1768.         value = str_gnum(stab_val(defstab));
  1769.     else
  1770.         value = str_gnum(st[1]);
  1771.     value = exp(value);
  1772.     goto donumset;
  1773.     case O_LOG:
  1774.     if (maxarg < 1)
  1775.         value = str_gnum(stab_val(defstab));
  1776.     else
  1777.         value = str_gnum(st[1]);
  1778.     if (value <= 0.0)
  1779.         fatal("Can't take log of %g\n", value);
  1780.     value = log(value);
  1781.     goto donumset;
  1782.     case O_SQRT:
  1783.     if (maxarg < 1)
  1784.         value = str_gnum(stab_val(defstab));
  1785.     else
  1786.         value = str_gnum(st[1]);
  1787.     if (value < 0.0)
  1788.         fatal("Can't take sqrt of %g\n", value);
  1789.     value = sqrt(value);
  1790.     goto donumset;
  1791.     case O_INT:
  1792.     if (maxarg < 1)
  1793.         value = str_gnum(stab_val(defstab));
  1794.     else
  1795.         value = str_gnum(st[1]);
  1796.     if (value >= 0.0)
  1797.         (void)modf(value,&value);
  1798.     else {
  1799.         (void)modf(-value,&value);
  1800.         value = -value;
  1801.     }
  1802.     goto donumset;
  1803.     case O_ORD:
  1804.     if (maxarg < 1)
  1805.         tmps = str_get(stab_val(defstab));
  1806.     else
  1807.         tmps = str_get(st[1]);
  1808. #ifndef I286
  1809.     value = (double) (*tmps & 255);
  1810. #else
  1811.     anum = (int) *tmps;
  1812.     value = (double) (anum & 255);
  1813. #endif
  1814.     goto donumset;
  1815.     case O_ALARM:
  1816. #ifdef HAS_ALARM
  1817.     if (maxarg < 1)
  1818.         tmps = str_get(stab_val(defstab));
  1819.     else
  1820.         tmps = str_get(st[1]);
  1821.     if (!tmps)
  1822.         tmps = "0";
  1823.     anum = alarm((unsigned int)atoi(tmps));
  1824.     if (anum < 0)
  1825.         goto say_undef;
  1826.     value = (double)anum;
  1827.     goto donumset;
  1828. #else
  1829.     fatal("Unsupported function alarm");
  1830.     break;
  1831. #endif
  1832.     case O_SLEEP:
  1833.     if (maxarg < 1)
  1834.         tmps = Nullch;
  1835.     else
  1836.         tmps = str_get(st[1]);
  1837.     (void)time(&when);
  1838.     if (!tmps || !*tmps)
  1839.         sleep((32767<<16)+32767);
  1840.     else
  1841.         sleep((unsigned int)atoi(tmps));
  1842. #ifndef lint
  1843.     value = (double)when;
  1844.     (void)time(&when);
  1845.     value = ((double)when) - value;
  1846. #endif
  1847.     goto donumset;
  1848.     case O_RANGE:
  1849.     sp = do_range(gimme,arglast);
  1850.     goto array_return;
  1851.     case O_F_OR_R:
  1852.     if (gimme == G_ARRAY) {        /* it's a range */
  1853.         /* can we optimize to constant array? */
  1854.         if ((arg[1].arg_type & A_MASK) == A_SINGLE &&
  1855.           (arg[2].arg_type & A_MASK) == A_SINGLE) {
  1856.         st[2] = arg[2].arg_ptr.arg_str;
  1857.         sp = do_range(gimme,arglast);
  1858.         st = stack->ary_array;
  1859.         maxarg = sp - arglast[0];
  1860.         str_free(arg[1].arg_ptr.arg_str);
  1861.         arg[1].arg_ptr.arg_str = Nullstr;
  1862.         str_free(arg[2].arg_ptr.arg_str);
  1863.         arg[2].arg_ptr.arg_str = Nullstr;
  1864.         arg->arg_type = O_ARRAY;
  1865.         arg[1].arg_type = A_STAB|A_DONT;
  1866.         arg->arg_len = 1;
  1867.         stab = arg[1].arg_ptr.arg_stab = aadd(genstab());
  1868.         ary = stab_array(stab);
  1869.         afill(ary,maxarg - 1);
  1870.         anum = maxarg;
  1871.         st += arglast[0]+1;
  1872.         while (maxarg-- > 0)
  1873.             ary->ary_array[maxarg] = str_smake(st[maxarg]);
  1874.         st -= arglast[0]+1;
  1875.         goto array_return;
  1876.         }
  1877.         arg->arg_type = optype = O_RANGE;
  1878.         maxarg = arg->arg_len = 2;
  1879.         anum = 2;
  1880.         arg[anum].arg_flags &= ~AF_ARYOK;
  1881.         argflags = arg[anum].arg_flags;
  1882.         argtype = arg[anum].arg_type & A_MASK;
  1883.         arg[anum].arg_type = argtype;
  1884.         argptr = arg[anum].arg_ptr;
  1885.         sp = arglast[0];
  1886.         st -= sp;
  1887.         sp++;
  1888.         goto re_eval;
  1889.     }
  1890.     arg->arg_type = O_FLIP;
  1891.     /* FALL THROUGH */
  1892.     case O_FLIP:
  1893.     if ((arg[1].arg_type & A_MASK) == A_SINGLE ?
  1894.       last_in_stab && (int)str_gnum(st[1]) == stab_io(last_in_stab)->lines
  1895.       :
  1896.       str_true(st[1]) ) {
  1897.         arg[2].arg_type &= ~A_DONT;
  1898.         arg[1].arg_type |= A_DONT;
  1899.         arg->arg_type = optype = O_FLOP;
  1900.         if (arg->arg_flags & AF_COMMON) {
  1901.         str_numset(str,0.0);
  1902.         anum = 2;
  1903.         argflags = arg[2].arg_flags;
  1904.         argtype = arg[2].arg_type & A_MASK;
  1905.         argptr = arg[2].arg_ptr;
  1906.         sp = arglast[0];
  1907.         st -= sp++;
  1908.         goto re_eval;
  1909.         }
  1910.         else {
  1911.         str_numset(str,1.0);
  1912.         break;
  1913.         }
  1914.     }
  1915.     str_set(str,"");
  1916.     break;
  1917.     case O_FLOP:
  1918.     str_inc(str);
  1919.     if ((arg[2].arg_type & A_MASK) == A_SINGLE ?
  1920.       last_in_stab && (int)str_gnum(st[2]) == stab_io(last_in_stab)->lines
  1921.       :
  1922.       str_true(st[2]) ) {
  1923.         arg->arg_type = O_FLIP;
  1924.         arg[1].arg_type &= ~A_DONT;
  1925.         arg[2].arg_type |= A_DONT;
  1926.         str_cat(str,"E0");
  1927.     }
  1928.     break;
  1929.     case O_FORK:
  1930. #ifdef HAS_FORK
  1931.     anum = fork();
  1932.     if (anum < 0)
  1933.         goto say_undef;
  1934.     if (!anum) {
  1935.         /*SUPPRESS 560*/
  1936.         if (tmpstab = stabent("$",allstabs))
  1937.         str_numset(STAB_STR(tmpstab),(double)getpid());
  1938.         hclear(pidstatus, FALSE);    /* no kids, so don't wait for 'em */
  1939.     }
  1940.     value = (double)anum;
  1941.     goto donumset;
  1942. #else
  1943.     fatal("Unsupported function fork");
  1944.     break;
  1945. #endif
  1946.     case O_WAIT:
  1947. #ifdef HAS_WAIT
  1948. #ifndef lint
  1949.     anum = wait(&argflags);
  1950.     if (anum > 0)
  1951.         pidgone(anum,argflags);
  1952.     value = (double)anum;
  1953. #endif
  1954.     statusvalue = (unsigned short)argflags;
  1955.     goto donumset;
  1956. #else
  1957.     fatal("Unsupported function wait");
  1958.     break;
  1959. #endif
  1960.     case O_WAITPID:
  1961. #ifdef HAS_WAIT
  1962. #ifndef lint
  1963.     anum = (int)str_gnum(st[1]);
  1964.     optype = (int)str_gnum(st[2]);
  1965.     anum = wait4pid(anum, &argflags,optype);
  1966.     value = (double)anum;
  1967. #endif
  1968.     statusvalue = (unsigned short)argflags;
  1969.     goto donumset;
  1970. #else
  1971.     fatal("Unsupported function wait");
  1972.     break;
  1973. #endif
  1974.     case O_SYSTEM:
  1975. #ifdef OS2
  1976. #ifdef HAS_FORK
  1977. #undef HAS_FORK
  1978. #endif
  1979. #endif
  1980. #ifdef HAS_FORK
  1981. #ifdef TAINT
  1982.     if (arglast[2] - arglast[1] == 1) {
  1983.         taintenv();
  1984.         tainted |= st[2]->str_tainted;
  1985.         taintproper("Insecure dependency in system");
  1986.     }
  1987. #endif
  1988.     while ((anum = vfork()) == -1) {
  1989.         if (errno != EAGAIN) {
  1990.         value = -1.0;
  1991.         goto donumset;
  1992.         }
  1993.         sleep(5);
  1994.     }
  1995.     if (anum > 0) {
  1996. #ifndef lint
  1997.         ihand = signal(SIGINT, SIG_IGN);
  1998.         qhand = signal(SIGQUIT, SIG_IGN);
  1999.         argtype = wait4pid(anum, &argflags, 0);
  2000. #else
  2001.         ihand = qhand = 0;
  2002. #endif
  2003.         (void)signal(SIGINT, ihand);
  2004.         (void)signal(SIGQUIT, qhand);
  2005.         statusvalue = (unsigned short)argflags;
  2006.         if (argtype < 0)
  2007.         value = -1.0;
  2008.         else {
  2009.         value = (double)((unsigned int)argflags & 0xffff);
  2010.         }
  2011.         do_execfree();    /* free any memory child malloced on vfork */
  2012.         goto donumset;
  2013.     }
  2014.     if ((arg[1].arg_type & A_MASK) == A_STAB)
  2015.         value = (double)do_aexec(st[1],arglast);
  2016.     else if (arglast[2] - arglast[1] != 1)
  2017.         value = (double)do_aexec(Nullstr,arglast);
  2018.     else {
  2019.         value = (double)do_exec(str_get(str_mortal(st[2])));
  2020.     }
  2021.     _exit(-1);
  2022. #else /* ! FORK */
  2023.     if ((arg[1].arg_type & A_MASK) == A_STAB)
  2024.         value = (double)do_aspawn(st[1],arglast);
  2025.     else if (arglast[2] - arglast[1] != 1)
  2026.         value = (double)do_aspawn(Nullstr,arglast);
  2027.     else {
  2028.         value = (double)do_spawn(str_get(str_mortal(st[2])));
  2029.     }
  2030.     goto donumset;
  2031. #endif /* FORK */
  2032.     case O_EXEC_OP:
  2033.     if ((arg[1].arg_type & A_MASK) == A_STAB)
  2034.         value = (double)do_aexec(st[1],arglast);
  2035.     else if (arglast[2] - arglast[1] != 1)
  2036.         value = (double)do_aexec(Nullstr,arglast);
  2037.     else {
  2038. #ifdef TAINT
  2039.         taintenv();
  2040.         tainted |= st[2]->str_tainted;
  2041.         taintproper("Insecure dependency in exec");
  2042. #endif
  2043.         value = (double)do_exec(str_get(str_mortal(st[2])));
  2044.     }
  2045.     goto donumset;
  2046.     case O_HEX:
  2047.     if (maxarg < 1)
  2048.         tmps = str_get(stab_val(defstab));
  2049.     else
  2050.         tmps = str_get(st[1]);
  2051.     value = (double)scanhex(tmps, 99, &argtype);
  2052.     goto donumset;
  2053.  
  2054.     case O_OCT:
  2055.     if (maxarg < 1)
  2056.         tmps = str_get(stab_val(defstab));
  2057.     else
  2058.         tmps = str_get(st[1]);
  2059.     while (*tmps && (isSPACE(*tmps) || *tmps == '0'))
  2060.         tmps++;
  2061.     if (*tmps == 'x')
  2062.         value = (double)scanhex(++tmps, 99, &argtype);
  2063.     else
  2064.         value = (double)scanoct(tmps, 99, &argtype);
  2065.     goto donumset;
  2066.  
  2067. /* These common exits are hidden here in the middle of the switches for the
  2068.    benefit of those machines with limited branch addressing.  Sigh.  */
  2069.  
  2070. array_return:
  2071. #ifdef DEBUGGING
  2072.     if (debug) {
  2073.     dlevel--;
  2074.     if (debug & 8) {
  2075.         anum = sp - arglast[0];
  2076.         switch (anum) {
  2077.         case 0:
  2078.         deb("%s RETURNS ()\n",opname[optype]);
  2079.         break;
  2080.         case 1:
  2081.         deb("%s RETURNS (\"%s\")\n",opname[optype],
  2082.             st[1] ? str_get(st[1]) : "");
  2083.         break;
  2084.         default:
  2085.         tmps = st[1] ? str_get(st[1]) : "";
  2086.         deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\")\n",opname[optype],
  2087.           anum,tmps,anum==2?"":"...,",
  2088.             st[anum] ? str_get(st[anum]) : "");
  2089.         break;
  2090.         }
  2091.     }
  2092.     }
  2093. #endif
  2094.     return sp;
  2095.  
  2096. say_yes:
  2097.     str = &str_yes;
  2098.     goto normal_return;
  2099.  
  2100. say_no:
  2101.     str = &str_no;
  2102.     goto normal_return;
  2103.  
  2104. say_undef:
  2105.     str = &str_undef;
  2106.     goto normal_return;
  2107.  
  2108. say_zero:
  2109.     value = 0.0;
  2110.     /* FALL THROUGH */
  2111.  
  2112. donumset:
  2113.     str_numset(str,value);
  2114.     STABSET(str);
  2115.     st[1] = str;
  2116. #ifdef DEBUGGING
  2117.     if (debug) {
  2118.     dlevel--;
  2119.     if (debug & 8)
  2120.         deb("%s RETURNS \"%f\"\n",opname[optype],value);
  2121.     }
  2122. #endif
  2123.     return arglast[0] + 1;
  2124. #ifdef SMALLSWITCHES
  2125.     }
  2126.     else
  2127.     switch (optype) {
  2128. #endif
  2129.     case O_CHOWN:
  2130. #ifdef HAS_CHOWN
  2131.     value = (double)apply(optype,arglast);
  2132.     goto donumset;
  2133. #else
  2134.     fatal("Unsupported function chown");
  2135.     break;
  2136. #endif
  2137.     case O_KILL:
  2138. #ifdef HAS_KILL
  2139.     value = (double)apply(optype,arglast);
  2140.     goto donumset;
  2141. #else
  2142.     fatal("Unsupported function kill");
  2143.     break;
  2144. #endif
  2145.     case O_UNLINK:
  2146.     case O_CHMOD:
  2147.     case O_UTIME:
  2148.     value = (double)apply(optype,arglast);
  2149.     goto donumset;
  2150.     case O_UMASK:
  2151. #ifdef HAS_UMASK
  2152.     if (maxarg < 1) {
  2153.         anum = umask(0);
  2154.         (void)umask(anum);
  2155.     }
  2156.     else
  2157.         anum = umask((int)str_gnum(st[1]));
  2158.     value = (double)anum;
  2159. #ifdef TAINT
  2160.     taintproper("Insecure dependency in umask");
  2161. #endif
  2162.     goto donumset;
  2163. #else
  2164.     fatal("Unsupported function umask");
  2165.     break;
  2166. #endif
  2167. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  2168.     case O_MSGGET:
  2169.     case O_SHMGET:
  2170.     case O_SEMGET:
  2171.     if ((anum = do_ipcget(optype, arglast)) == -1)
  2172.         goto say_undef;
  2173.     value = (double)anum;
  2174.     goto donumset;
  2175.     case O_MSGCTL:
  2176.     case O_SHMCTL:
  2177.     case O_SEMCTL:
  2178.     anum = do_ipcctl(optype, arglast);
  2179.     if (anum == -1)
  2180.         goto say_undef;
  2181.     if (anum != 0) {
  2182.         value = (double)anum;
  2183.         goto donumset;
  2184.     }
  2185.     str_set(str,"0 but true");
  2186.     STABSET(str);
  2187.     break;
  2188.     case O_MSGSND:
  2189.     value = (double)(do_msgsnd(arglast) >= 0);
  2190.     goto donumset;
  2191.     case O_MSGRCV:
  2192.     value = (double)(do_msgrcv(arglast) >= 0);
  2193.     goto donumset;
  2194.     case O_SEMOP:
  2195.     value = (double)(do_semop(arglast) >= 0);
  2196.     goto donumset;
  2197.     case O_SHMREAD:
  2198.     case O_SHMWRITE:
  2199.     value = (double)(do_shmio(optype, arglast) >= 0);
  2200.     goto donumset;
  2201. #else /* not SYSVIPC */
  2202.     case O_MSGGET:
  2203.     case O_MSGCTL:
  2204.     case O_MSGSND:
  2205.     case O_MSGRCV:
  2206.     case O_SEMGET:
  2207.     case O_SEMCTL:
  2208.     case O_SEMOP:
  2209.     case O_SHMGET:
  2210.     case O_SHMCTL:
  2211.     case O_SHMREAD:
  2212.     case O_SHMWRITE:
  2213.     fatal("System V IPC is not implemented on this machine");
  2214. #endif /* not SYSVIPC */
  2215.     case O_RENAME:
  2216.     tmps = str_get(st[1]);
  2217.     tmps2 = str_get(st[2]);
  2218. #ifdef TAINT
  2219.     taintproper("Insecure dependency in rename");
  2220. #endif
  2221. #ifdef HAS_RENAME
  2222.     value = (double)(rename(tmps,tmps2) >= 0);
  2223. #else
  2224.     if (same_dirent(tmps2, tmps))    /* can always rename to same name */
  2225.         anum = 1;
  2226.     else {
  2227.         if (euid || stat(tmps2,&statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
  2228.         (void)UNLINK(tmps2);
  2229.         if (!(anum = link(tmps,tmps2)))
  2230.         anum = UNLINK(tmps);
  2231.     }
  2232.     value = (double)(anum >= 0);
  2233. #endif
  2234.     goto donumset;
  2235.     case O_LINK:
  2236. #ifdef HAS_LINK
  2237.     tmps = str_get(st[1]);
  2238.     tmps2 = str_get(st[2]);
  2239. #ifdef TAINT
  2240.     taintproper("Insecure dependency in link");
  2241. #endif
  2242.     value = (double)(link(tmps,tmps2) >= 0);
  2243.     goto donumset;
  2244. #else
  2245.     fatal("Unsupported function link");
  2246.     break;
  2247. #endif
  2248.     case O_MKDIR:
  2249.     tmps = str_get(st[1]);
  2250.     anum = (int)str_gnum(st[2]);
  2251. #ifdef TAINT
  2252.     taintproper("Insecure dependency in mkdir");
  2253. #endif
  2254. #ifdef HAS_MKDIR
  2255. #if defined(MSDOS) || defined(atarist) /* but not OS2 */
  2256.     value = (double)(mkdir(tmps) >= 0);
  2257. #else
  2258.     value = (double)(mkdir(tmps,anum) >= 0);
  2259. #endif
  2260.     goto donumset;
  2261. #else
  2262.     (void)strcpy(buf,"mkdir ");
  2263. #endif
  2264. #if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
  2265.       one_liner:
  2266.     for (tmps2 = buf+6; *tmps; ) {
  2267.         *tmps2++ = '\\';
  2268.         *tmps2++ = *tmps++;
  2269.     }
  2270.     (void)strcpy(tmps2," 2>&1");
  2271.     rsfp = mypopen(buf,"r");
  2272.     if (rsfp) {
  2273.         *buf = '\0';
  2274.         tmps2 = fgets(buf,sizeof buf,rsfp);
  2275.         (void)mypclose(rsfp);
  2276.         if (tmps2 != Nullch) {
  2277.         for (errno = 1; errno < sys_nerr; errno++) {
  2278.             if (instr(buf,sys_errlist[errno]))    /* you don't see this */
  2279.             goto say_zero;
  2280.         }
  2281.         errno = 0;
  2282. #ifndef EACCES
  2283. #define EACCES EPERM
  2284. #endif
  2285.         if (instr(buf,"cannot make"))
  2286.             errno = EEXIST;
  2287.         else if (instr(buf,"existing file"))
  2288.             errno = EEXIST;
  2289.         else if (instr(buf,"ile exists"))
  2290.             errno = EEXIST;
  2291.         else if (instr(buf,"non-exist"))
  2292.             errno = ENOENT;
  2293.         else if (instr(buf,"does not exist"))
  2294.             errno = ENOENT;
  2295.         else if (instr(buf,"not empty"))
  2296.             errno = EBUSY;
  2297.         else if (instr(buf,"cannot access"))
  2298.             errno = EACCES;
  2299.         else
  2300.             errno = EPERM;
  2301.         goto say_zero;
  2302.         }
  2303.         else {    /* some mkdirs return no failure indication */
  2304.         tmps = str_get(st[1]);
  2305.         anum = (stat(tmps,&statbuf) >= 0);
  2306.         if (optype == O_RMDIR)
  2307.             anum = !anum;
  2308.         if (anum)
  2309.             errno = 0;
  2310.         else
  2311.             errno = EACCES;    /* a guess */
  2312.         value = (double)anum;
  2313.         }
  2314.         goto donumset;
  2315.     }
  2316.     else
  2317.         goto say_zero;
  2318. #endif
  2319.     case O_RMDIR:
  2320.     if (maxarg < 1)
  2321.         tmps = str_get(stab_val(defstab));
  2322.     else
  2323.         tmps = str_get(st[1]);
  2324. #ifdef TAINT
  2325.     taintproper("Insecure dependency in rmdir");
  2326. #endif
  2327. #ifdef HAS_RMDIR
  2328.     value = (double)(rmdir(tmps) >= 0);
  2329.     goto donumset;
  2330. #else
  2331.     (void)strcpy(buf,"rmdir ");
  2332.     goto one_liner;        /* see above in HAS_MKDIR */
  2333. #endif
  2334.     case O_GETPPID:
  2335. #ifdef HAS_GETPPID
  2336.     value = (double)getppid();
  2337.     goto donumset;
  2338. #else
  2339.     fatal("Unsupported function getppid");
  2340.     break;
  2341. #endif
  2342.     case O_GETPGRP:
  2343. #ifdef HAS_GETPGRP
  2344.     if (maxarg < 1)
  2345.         anum = 0;
  2346.     else
  2347.         anum = (int)str_gnum(st[1]);
  2348. #ifdef _POSIX_SOURCE
  2349.     if (anum != 0)
  2350.         fatal("POSIX getpgrp can't take an argument");
  2351.     value = (double)getpgrp();
  2352. #else
  2353.     value = (double)getpgrp(anum);
  2354. #endif
  2355.     goto donumset;
  2356. #else
  2357.     fatal("The getpgrp() function is unimplemented on this machine");
  2358.     break;
  2359. #endif
  2360.     case O_SETPGRP:
  2361. #ifdef HAS_SETPGRP
  2362.     argtype = (int)str_gnum(st[1]);
  2363.     anum = (int)str_gnum(st[2]);
  2364. #ifdef TAINT
  2365.     taintproper("Insecure dependency in setpgrp");
  2366. #endif
  2367.     value = (double)(setpgrp(argtype,anum) >= 0);
  2368.     goto donumset;
  2369. #else
  2370.     fatal("The setpgrp() function is unimplemented on this machine");
  2371.     break;
  2372. #endif
  2373.     case O_GETPRIORITY:
  2374. #ifdef HAS_GETPRIORITY
  2375.     argtype = (int)str_gnum(st[1]);
  2376.     anum = (int)str_gnum(st[2]);
  2377.     value = (double)getpriority(argtype,anum);
  2378.     goto donumset;
  2379. #else
  2380.     fatal("The getpriority() function is unimplemented on this machine");
  2381.     break;
  2382. #endif
  2383.     case O_SETPRIORITY:
  2384. #ifdef HAS_SETPRIORITY
  2385.     argtype = (int)str_gnum(st[1]);
  2386.     anum = (int)str_gnum(st[2]);
  2387.     optype = (int)str_gnum(st[3]);
  2388. #ifdef TAINT
  2389.     taintproper("Insecure dependency in setpriority");
  2390. #endif
  2391.     value = (double)(setpriority(argtype,anum,optype) >= 0);
  2392.     goto donumset;
  2393. #else
  2394.     fatal("The setpriority() function is unimplemented on this machine");
  2395.     break;
  2396. #endif
  2397.     case O_CHROOT:
  2398. #ifdef HAS_CHROOT
  2399.     if (maxarg < 1)
  2400.         tmps = str_get(stab_val(defstab));
  2401.     else
  2402.         tmps = str_get(st[1]);
  2403. #ifdef TAINT
  2404.     taintproper("Insecure dependency in chroot");
  2405. #endif
  2406.     value = (double)(chroot(tmps) >= 0);
  2407.     goto donumset;
  2408. #else
  2409.     fatal("Unsupported function chroot");
  2410.     break;
  2411. #endif
  2412.     case O_FCNTL:
  2413.     case O_IOCTL:
  2414.     if (maxarg <= 0)
  2415.         stab = last_in_stab;
  2416.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  2417.         stab = arg[1].arg_ptr.arg_stab;
  2418.     else
  2419.         stab = stabent(str_get(st[1]),TRUE);
  2420.     argtype = U_I(str_gnum(st[2]));
  2421. #ifdef TAINT
  2422.     taintproper("Insecure dependency in ioctl");
  2423. #endif
  2424.     anum = do_ctl(optype,stab,argtype,st[3]);
  2425.     if (anum == -1)
  2426.         goto say_undef;
  2427.     if (anum != 0) {
  2428.         value = (double)anum;
  2429.         goto donumset;
  2430.     }
  2431.     str_set(str,"0 but true");
  2432.     STABSET(str);
  2433.     break;
  2434.     case O_FLOCK:
  2435. #ifdef HAS_FLOCK
  2436.     if (maxarg <= 0)
  2437.         stab = last_in_stab;
  2438.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  2439.         stab = arg[1].arg_ptr.arg_stab;
  2440.     else
  2441.         stab = stabent(str_get(st[1]),TRUE);
  2442.     if (stab && stab_io(stab))
  2443.         fp = stab_io(stab)->ifp;
  2444.     else
  2445.         fp = Nullfp;
  2446.     if (fp) {
  2447.         argtype = (int)str_gnum(st[2]);
  2448.         value = (double)(flock(fileno(fp),argtype) >= 0);
  2449.     }
  2450.     else
  2451.         value = 0;
  2452.     goto donumset;
  2453. #else
  2454.     fatal("The flock() function is unimplemented on this machine");
  2455.     break;
  2456. #endif
  2457.     case O_UNSHIFT:
  2458.     ary = stab_array(arg[1].arg_ptr.arg_stab);
  2459.     if (arglast[2] - arglast[1] != 1)
  2460.         do_unshift(ary,arglast);
  2461.     else {
  2462.         STR *tmpstr = Str_new(52,0);    /* must copy the STR */
  2463.         str_sset(tmpstr,st[2]);
  2464.         aunshift(ary,1);
  2465.         (void)astore(ary,0,tmpstr);
  2466.     }
  2467.     value = (double)(ary->ary_fill + 1);
  2468.     goto donumset;
  2469.  
  2470.     case O_TRY:
  2471.     sp = do_try(arg[1].arg_ptr.arg_cmd,
  2472.         gimme,arglast);
  2473.     goto array_return;
  2474.  
  2475.     case O_EVALONCE:
  2476.     sp = do_eval(st[1], O_EVAL, curcmd->c_stash, TRUE,
  2477.         gimme,arglast);
  2478.     if (eval_root) {
  2479.         str_free(arg[1].arg_ptr.arg_str);
  2480.         arg[1].arg_ptr.arg_cmd = eval_root;
  2481.         arg[1].arg_type = (A_CMD|A_DONT);
  2482.         arg[0].arg_type = O_TRY;
  2483.     }
  2484.     goto array_return;
  2485.  
  2486.     case O_REQUIRE:
  2487.     case O_DOFILE:
  2488.     case O_EVAL:
  2489.     if (maxarg < 1)
  2490.         tmpstr = stab_val(defstab);
  2491.     else
  2492.         tmpstr =
  2493.           (arg[1].arg_type & A_MASK) != A_NULL ? st[1] : stab_val(defstab);
  2494. #ifdef TAINT
  2495.     tainted |= tmpstr->str_tainted;
  2496.     taintproper("Insecure dependency in eval");
  2497. #endif
  2498.     sp = do_eval(tmpstr, optype, curcmd->c_stash, FALSE,
  2499.         gimme,arglast);
  2500.     goto array_return;
  2501.  
  2502.     case O_FTRREAD:
  2503.     argtype = 0;
  2504.     anum = S_IRUSR;
  2505.     goto check_perm;
  2506.     case O_FTRWRITE:
  2507.     argtype = 0;
  2508.     anum = S_IWUSR;
  2509.     goto check_perm;
  2510.     case O_FTREXEC:
  2511.     argtype = 0;
  2512.     anum = S_IXUSR;
  2513.     goto check_perm;
  2514.     case O_FTEREAD:
  2515.     argtype = 1;
  2516.     anum = S_IRUSR;
  2517.     goto check_perm;
  2518.     case O_FTEWRITE:
  2519.     argtype = 1;
  2520.     anum = S_IWUSR;
  2521.     goto check_perm;
  2522.     case O_FTEEXEC:
  2523.     argtype = 1;
  2524.     anum = S_IXUSR;
  2525.       check_perm:
  2526.     if (mystat(arg,st[1]) < 0)
  2527.         goto say_undef;
  2528.     if (cando(anum,argtype,&statcache))
  2529.         goto say_yes;
  2530.     goto say_no;
  2531.  
  2532.     case O_FTIS:
  2533.     if (mystat(arg,st[1]) < 0)
  2534.         goto say_undef;
  2535.     goto say_yes;
  2536.     case O_FTEOWNED:
  2537.     case O_FTROWNED:
  2538.     if (mystat(arg,st[1]) < 0)
  2539.         goto say_undef;
  2540.     if (statcache.st_uid == (optype == O_FTEOWNED ? euid : uid) )
  2541.         goto say_yes;
  2542.     goto say_no;
  2543.     case O_FTZERO:
  2544.     if (mystat(arg,st[1]) < 0)
  2545.         goto say_undef;
  2546.     if (!statcache.st_size)
  2547.         goto say_yes;
  2548.     goto say_no;
  2549.     case O_FTSIZE:
  2550.     if (mystat(arg,st[1]) < 0)
  2551.         goto say_undef;
  2552.     value = (double)statcache.st_size;
  2553.     goto donumset;
  2554.  
  2555.     case O_FTMTIME:
  2556.     if (mystat(arg,st[1]) < 0)
  2557.         goto say_undef;
  2558.     value = (double)(basetime - statcache.st_mtime) / 86400.0;
  2559.     goto donumset;
  2560.     case O_FTATIME:
  2561.     if (mystat(arg,st[1]) < 0)
  2562.         goto say_undef;
  2563.     value = (double)(basetime - statcache.st_atime) / 86400.0;
  2564.     goto donumset;
  2565.     case O_FTCTIME:
  2566.     if (mystat(arg,st[1]) < 0)
  2567.         goto say_undef;
  2568.     value = (double)(basetime - statcache.st_ctime) / 86400.0;
  2569.     goto donumset;
  2570.  
  2571.     case O_FTSOCK:
  2572.     if (mystat(arg,st[1]) < 0)
  2573.         goto say_undef;
  2574.     if (S_ISSOCK(statcache.st_mode))
  2575.         goto say_yes;
  2576.     goto say_no;
  2577.     case O_FTCHR:
  2578.     if (mystat(arg,st[1]) < 0)
  2579.         goto say_undef;
  2580.     if (S_ISCHR(statcache.st_mode))
  2581.         goto say_yes;
  2582.     goto say_no;
  2583.     case O_FTBLK:
  2584.     if (mystat(arg,st[1]) < 0)
  2585.         goto say_undef;
  2586.     if (S_ISBLK(statcache.st_mode))
  2587.         goto say_yes;
  2588.     goto say_no;
  2589.     case O_FTFILE:
  2590.     if (mystat(arg,st[1]) < 0)
  2591.         goto say_undef;
  2592.     if (S_ISREG(statcache.st_mode))
  2593.         goto say_yes;
  2594.     goto say_no;
  2595.     case O_FTDIR:
  2596.     if (mystat(arg,st[1]) < 0)
  2597.         goto say_undef;
  2598.     if (S_ISDIR(statcache.st_mode))
  2599.         goto say_yes;
  2600.     goto say_no;
  2601.     case O_FTPIPE:
  2602.     if (mystat(arg,st[1]) < 0)
  2603.         goto say_undef;
  2604.     if (S_ISFIFO(statcache.st_mode))
  2605.         goto say_yes;
  2606.     goto say_no;
  2607.     case O_FTLINK:
  2608.     if (mylstat(arg,st[1]) < 0)
  2609.         goto say_undef;
  2610.     if (S_ISLNK(statcache.st_mode))
  2611.         goto say_yes;
  2612.     goto say_no;
  2613.     case O_SYMLINK:
  2614. #ifdef HAS_SYMLINK
  2615.     tmps = str_get(st[1]);
  2616.     tmps2 = str_get(st[2]);
  2617. #ifdef TAINT
  2618.     taintproper("Insecure dependency in symlink");
  2619. #endif
  2620.     value = (double)(symlink(tmps,tmps2) >= 0);
  2621.     goto donumset;
  2622. #else
  2623.     fatal("Unsupported function symlink");
  2624. #endif
  2625.     case O_READLINK:
  2626. #ifdef HAS_SYMLINK
  2627.     if (maxarg < 1)
  2628.         tmps = str_get(stab_val(defstab));
  2629.     else
  2630.         tmps = str_get(st[1]);
  2631.     anum = readlink(tmps,buf,sizeof buf);
  2632.     if (anum < 0)
  2633.         goto say_undef;
  2634.     str_nset(str,buf,anum);
  2635.     break;
  2636. #else
  2637.     goto say_undef;        /* just pretend it's a normal file */
  2638. #endif
  2639.     case O_FTSUID:
  2640. #ifdef S_ISUID
  2641.     anum = S_ISUID;
  2642.     goto check_xid;
  2643. #else
  2644.     goto say_no;
  2645. #endif
  2646.     case O_FTSGID:
  2647. #ifdef S_ISGID
  2648.     anum = S_ISGID;
  2649.     goto check_xid;
  2650. #else
  2651.     goto say_no;
  2652. #endif
  2653.     case O_FTSVTX:
  2654. #ifdef S_ISVTX
  2655.     anum = S_ISVTX;
  2656. #else
  2657.     goto say_no;
  2658. #endif
  2659.       check_xid:
  2660.     if (mystat(arg,st[1]) < 0)
  2661.         goto say_undef;
  2662.     if (statcache.st_mode & anum)
  2663.         goto say_yes;
  2664.     goto say_no;
  2665.     case O_FTTTY:
  2666.     if (arg[1].arg_type & A_DONT) {
  2667.         stab = arg[1].arg_ptr.arg_stab;
  2668.         tmps = "";
  2669.     }
  2670.     else
  2671.         stab = stabent(tmps = str_get(st[1]),FALSE);
  2672.     if (stab && stab_io(stab) && stab_io(stab)->ifp)
  2673.         anum = fileno(stab_io(stab)->ifp);
  2674.     else if (isDIGIT(*tmps))
  2675.         anum = atoi(tmps);
  2676.     else
  2677.         goto say_undef;
  2678.     if (isatty(anum))
  2679.         goto say_yes;
  2680.     goto say_no;
  2681.     case O_FTTEXT:
  2682.     case O_FTBINARY:
  2683.     str = do_fttext(arg,st[1]);
  2684.     break;
  2685. #ifdef HAS_SOCKET
  2686.     case O_SOCKET:
  2687.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2688.         stab = arg[1].arg_ptr.arg_stab;
  2689.     else
  2690.         stab = stabent(str_get(st[1]),TRUE);
  2691. #ifndef lint
  2692.     value = (double)do_socket(stab,arglast);
  2693. #else
  2694.     (void)do_socket(stab,arglast);
  2695. #endif
  2696.     goto donumset;
  2697.     case O_BIND:
  2698.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2699.         stab = arg[1].arg_ptr.arg_stab;
  2700.     else
  2701.         stab = stabent(str_get(st[1]),TRUE);
  2702. #ifndef lint
  2703.     value = (double)do_bind(stab,arglast);
  2704. #else
  2705.     (void)do_bind(stab,arglast);
  2706. #endif
  2707.     goto donumset;
  2708.     case O_CONNECT:
  2709.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2710.         stab = arg[1].arg_ptr.arg_stab;
  2711.     else
  2712.         stab = stabent(str_get(st[1]),TRUE);
  2713. #ifndef lint
  2714.     value = (double)do_connect(stab,arglast);
  2715. #else
  2716.     (void)do_connect(stab,arglast);
  2717. #endif
  2718.     goto donumset;
  2719.     case O_LISTEN:
  2720.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2721.         stab = arg[1].arg_ptr.arg_stab;
  2722.     else
  2723.         stab = stabent(str_get(st[1]),TRUE);
  2724. #ifndef lint
  2725.     value = (double)do_listen(stab,arglast);
  2726. #else
  2727.     (void)do_listen(stab,arglast);
  2728. #endif
  2729.     goto donumset;
  2730.     case O_ACCEPT:
  2731.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2732.         stab = arg[1].arg_ptr.arg_stab;
  2733.     else
  2734.         stab = stabent(str_get(st[1]),TRUE);
  2735.     if ((arg[2].arg_type & A_MASK) == A_WORD)
  2736.         stab2 = arg[2].arg_ptr.arg_stab;
  2737.     else
  2738.         stab2 = stabent(str_get(st[2]),TRUE);
  2739.     do_accept(str,stab,stab2);
  2740.     STABSET(str);
  2741.     break;
  2742.     case O_GHBYNAME:
  2743.     if (maxarg < 1)
  2744.         goto say_undef;
  2745.     case O_GHBYADDR:
  2746.     case O_GHOSTENT:
  2747.     sp = do_ghent(optype,
  2748.       gimme,arglast);
  2749.     goto array_return;
  2750.     case O_GNBYNAME:
  2751.     if (maxarg < 1)
  2752.         goto say_undef;
  2753.     case O_GNBYADDR:
  2754.     case O_GNETENT:
  2755.     sp = do_gnent(optype,
  2756.       gimme,arglast);
  2757.     goto array_return;
  2758.     case O_GPBYNAME:
  2759.     if (maxarg < 1)
  2760.         goto say_undef;
  2761.     case O_GPBYNUMBER:
  2762.     case O_GPROTOENT:
  2763.     sp = do_gpent(optype,
  2764.       gimme,arglast);
  2765.     goto array_return;
  2766.     case O_GSBYNAME:
  2767.     if (maxarg < 1)
  2768.         goto say_undef;
  2769.     case O_GSBYPORT:
  2770.     case O_GSERVENT:
  2771.     sp = do_gsent(optype,
  2772.       gimme,arglast);
  2773.     goto array_return;
  2774.     case O_SHOSTENT:
  2775.     value = (double) sethostent((int)str_gnum(st[1]));
  2776.     goto donumset;
  2777.     case O_SNETENT:
  2778.     value = (double) setnetent((int)str_gnum(st[1]));
  2779.     goto donumset;
  2780.     case O_SPROTOENT:
  2781.     value = (double) setprotoent((int)str_gnum(st[1]));
  2782.     goto donumset;
  2783.     case O_SSERVENT:
  2784.     value = (double) setservent((int)str_gnum(st[1]));
  2785.     goto donumset;
  2786.     case O_EHOSTENT:
  2787.     value = (double) endhostent();
  2788.     goto donumset;
  2789.     case O_ENETENT:
  2790.     value = (double) endnetent();
  2791.     goto donumset;
  2792.     case O_EPROTOENT:
  2793.     value = (double) endprotoent();
  2794.     goto donumset;
  2795.     case O_ESERVENT:
  2796.     value = (double) endservent();
  2797.     goto donumset;
  2798.     case O_SOCKPAIR:
  2799.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2800.         stab = arg[1].arg_ptr.arg_stab;
  2801.     else
  2802.         stab = stabent(str_get(st[1]),TRUE);
  2803.     if ((arg[2].arg_type & A_MASK) == A_WORD)
  2804.         stab2 = arg[2].arg_ptr.arg_stab;
  2805.     else
  2806.         stab2 = stabent(str_get(st[2]),TRUE);
  2807. #ifndef lint
  2808.     value = (double)do_spair(stab,stab2,arglast);
  2809. #else
  2810.     (void)do_spair(stab,stab2,arglast);
  2811. #endif
  2812.     goto donumset;
  2813.     case O_SHUTDOWN:
  2814.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2815.         stab = arg[1].arg_ptr.arg_stab;
  2816.     else
  2817.         stab = stabent(str_get(st[1]),TRUE);
  2818. #ifndef lint
  2819.     value = (double)do_shutdown(stab,arglast);
  2820. #else
  2821.     (void)do_shutdown(stab,arglast);
  2822. #endif
  2823.     goto donumset;
  2824.     case O_GSOCKOPT:
  2825.     case O_SSOCKOPT:
  2826.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2827.         stab = arg[1].arg_ptr.arg_stab;
  2828.     else
  2829.         stab = stabent(str_get(st[1]),TRUE);
  2830.     sp = do_sopt(optype,stab,arglast);
  2831.     goto array_return;
  2832.     case O_GETSOCKNAME:
  2833.     case O_GETPEERNAME:
  2834.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2835.         stab = arg[1].arg_ptr.arg_stab;
  2836.     else
  2837.         stab = stabent(str_get(st[1]),TRUE);
  2838.     if (!stab)
  2839.         goto say_undef;
  2840.     sp = do_getsockname(optype,stab,arglast);
  2841.     goto array_return;
  2842.  
  2843. #else /* HAS_SOCKET not defined */
  2844.     case O_SOCKET:
  2845.     case O_BIND:
  2846.     case O_CONNECT:
  2847.     case O_LISTEN:
  2848.     case O_ACCEPT:
  2849.     case O_SOCKPAIR:
  2850.     case O_GHBYNAME:
  2851.     case O_GHBYADDR:
  2852.     case O_GHOSTENT:
  2853.     case O_GNBYNAME:
  2854.     case O_GNBYADDR:
  2855.     case O_GNETENT:
  2856.     case O_GPBYNAME:
  2857.     case O_GPBYNUMBER:
  2858.     case O_GPROTOENT:
  2859.     case O_GSBYNAME:
  2860.     case O_GSBYPORT:
  2861.     case O_GSERVENT:
  2862.     case O_SHOSTENT:
  2863.     case O_SNETENT:
  2864.     case O_SPROTOENT:
  2865.     case O_SSERVENT:
  2866.     case O_EHOSTENT:
  2867.     case O_ENETENT:
  2868.     case O_EPROTOENT:
  2869.     case O_ESERVENT:
  2870.     case O_SHUTDOWN:
  2871.     case O_GSOCKOPT:
  2872.     case O_SSOCKOPT:
  2873.     case O_GETSOCKNAME:
  2874.     case O_GETPEERNAME:
  2875.       badsock:
  2876.     fatal("Unsupported socket function");
  2877. #endif /* HAS_SOCKET */
  2878.     case O_SSELECT:
  2879. #ifdef HAS_SELECT
  2880.     sp = do_select(gimme,arglast);
  2881.     goto array_return;
  2882. #else
  2883.     fatal("select not implemented");
  2884. #endif
  2885.     case O_FILENO:
  2886.     if (maxarg < 1)
  2887.         goto say_undef;
  2888.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2889.         stab = arg[1].arg_ptr.arg_stab;
  2890.     else
  2891.         stab = stabent(str_get(st[1]),TRUE);
  2892.     if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
  2893.         goto say_undef;
  2894.     value = fileno(fp);
  2895.     goto donumset;
  2896.     case O_BINMODE:
  2897.     if (maxarg < 1)
  2898.         goto say_undef;
  2899.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2900.         stab = arg[1].arg_ptr.arg_stab;
  2901.     else
  2902.         stab = stabent(str_get(st[1]),TRUE);
  2903.     if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
  2904.         goto say_undef;
  2905. #ifdef DOSISH
  2906. #ifdef atarist
  2907.     if(fflush(fp))
  2908.        str_set(str, No);
  2909.     else
  2910.     {
  2911.         fp->_flag |= _IOBIN;
  2912.         str_set(str, Yes);
  2913.     }
  2914. #else
  2915.     str_set(str, (setmode(fileno(fp), O_BINARY) != -1) ? Yes : No);
  2916. #endif
  2917. #else
  2918.     str_set(str, Yes);
  2919. #endif
  2920.     STABSET(str);
  2921.     break;
  2922.     case O_VEC:
  2923.     sp = do_vec(str == st[1], arg->arg_ptr.arg_str, arglast);
  2924.     goto array_return;
  2925.     case O_GPWNAM:
  2926.     case O_GPWUID:
  2927.     case O_GPWENT:
  2928. #ifdef HAS_PASSWD
  2929.     sp = do_gpwent(optype,
  2930.       gimme,arglast);
  2931.     goto array_return;
  2932.     case O_SPWENT:
  2933.     value = (double) setpwent();
  2934.     goto donumset;
  2935.     case O_EPWENT:
  2936.     value = (double) endpwent();
  2937.     goto donumset;
  2938. #else
  2939.     case O_EPWENT:
  2940.     case O_SPWENT:
  2941.     fatal("Unsupported password function");
  2942.     break;
  2943. #endif
  2944.     case O_GGRNAM:
  2945.     case O_GGRGID:
  2946.     case O_GGRENT:
  2947. #ifdef HAS_GROUP
  2948.     sp = do_ggrent(optype,
  2949.       gimme,arglast);
  2950.     goto array_return;
  2951.     case O_SGRENT:
  2952.     value = (double) setgrent();
  2953.     goto donumset;
  2954.     case O_EGRENT:
  2955.     value = (double) endgrent();
  2956.     goto donumset;
  2957. #else
  2958.     case O_EGRENT:
  2959.     case O_SGRENT:
  2960.     fatal("Unsupported group function");
  2961.     break;
  2962. #endif
  2963.     case O_GETLOGIN:
  2964. #ifdef HAS_GETLOGIN
  2965.     if (!(tmps = getlogin()))
  2966.         goto say_undef;
  2967.     str_set(str,tmps);
  2968. #else
  2969.     fatal("Unsupported function getlogin");
  2970. #endif
  2971.     break;
  2972.     case O_OPEN_DIR:
  2973.     case O_READDIR:
  2974.     case O_TELLDIR:
  2975.     case O_SEEKDIR:
  2976.     case O_REWINDDIR:
  2977.     case O_CLOSEDIR:
  2978.     if (maxarg < 1)
  2979.         goto say_undef;
  2980.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2981.         stab = arg[1].arg_ptr.arg_stab;
  2982.     else
  2983.         stab = stabent(str_get(st[1]),TRUE);
  2984.     if (!stab)
  2985.         goto say_undef;
  2986.     sp = do_dirop(optype,stab,gimme,arglast);
  2987.     goto array_return;
  2988.     case O_SYSCALL:
  2989.     value = (double)do_syscall(arglast);
  2990.     goto donumset;
  2991.     case O_PIPE_OP:
  2992. #ifdef HAS_PIPE
  2993.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2994.         stab = arg[1].arg_ptr.arg_stab;
  2995.     else
  2996.         stab = stabent(str_get(st[1]),TRUE);
  2997.     if ((arg[2].arg_type & A_MASK) == A_WORD)
  2998.         stab2 = arg[2].arg_ptr.arg_stab;
  2999.     else
  3000.         stab2 = stabent(str_get(st[2]),TRUE);
  3001.     do_pipe(str,stab,stab2);
  3002.     STABSET(str);
  3003. #else
  3004.     fatal("Unsupported function pipe");
  3005. #endif
  3006.     break;
  3007.     }
  3008.  
  3009.   normal_return:
  3010.     st[1] = str;
  3011. #ifdef DEBUGGING
  3012.     if (debug) {
  3013.     dlevel--;
  3014.     if (debug & 8)
  3015.         deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str));
  3016.     }
  3017. #endif
  3018.     return arglast[0] + 1;
  3019. }
  3020.