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