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