home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / perl / Source / C / Eval < prev    next >
Encoding:
Text File  |  1991-02-09  |  40.1 KB  |  1,687 lines
  1. /* $Header: eval.c,v 3.0.1.11 91/01/11 17:58:30 lwall Locked $
  2.  *
  3.  *    Copyright (c) 1989, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of the GNU General Public License
  6.  *    as specified in the README file that comes with the perl 3.0 kit.
  7.  *
  8.  * $Log:    eval.c,v $
  9.  * Revision 3.0.1.11  91/01/11  17:58:30  lwall
  10.  * patch42: ANSIfied the stat mode checking
  11.  * patch42: perl -D14 crashed on ..
  12.  * patch42: waitpid() emulation was useless because of #ifdef WAITPID
  13.  * 
  14.  * Revision 3.0.1.10  90/11/10  01:33:22  lwall
  15.  * patch38: random cleanup
  16.  * patch38: couldn't return from sort routine
  17.  * patch38: added hooks for unexec()
  18.  * patch38: added alarm function
  19.  * 
  20.  * Revision 3.0.1.9  90/10/15  16:46:13  lwall
  21.  * patch29: added caller
  22.  * patch29: added scalar
  23.  * patch29: added cmp and <=>
  24.  * patch29: added sysread and syswrite
  25.  * patch29: added -M, -A and -C
  26.  * patch29: index and substr now have optional 3rd args
  27.  * patch29: you can now read into the middle string
  28.  * patch29: ~ now works on vector string
  29.  * patch29: non-existent array values no longer cause core dumps
  30.  * patch29: eof; core dumped
  31.  * patch29: oct and hex now produce unsigned result
  32.  * patch29: unshift did not return the documented value
  33.  * 
  34.  * Revision 3.0.1.8  90/08/13  22:17:14  lwall
  35.  * patch28: the NSIG hack didn't work right on Xenix
  36.  * patch28: defined(@array) and defined(%array) didn't work right
  37.  * patch28: rename was busted on systems without rename system call
  38.  * 
  39.  * Revision 3.0.1.7  90/08/09  03:33:44  lwall
  40.  * patch19: made ~ do vector operation on strings like &, | and ^
  41.  * patch19: dbmopen(%name...) didn't work right
  42.  * patch19: dbmopen(name, 'filename', undef) now refrains from creating
  43.  * patch19: empty %array now returns 0 in scalar context
  44.  * patch19: die with no arguments no longer exits unconditionally
  45.  * patch19: return outside a subroutine now returns a reasonable message
  46.  * patch19: rename done with unlink()/link()/unlink() now checks for clobbering
  47.  * patch19: -s now returns size of file
  48.  * 
  49.  * Revision 3.0.1.6  90/03/27  15:53:51  lwall
  50.  * patch16: MSDOS support
  51.  * patch16: support for machines that can't cast negative floats to unsigned ints
  52.  * patch16: ioctl didn't return values correctly
  53.  * 
  54.  * Revision 3.0.1.5  90/03/12  16:37:40  lwall
  55.  * patch13: undef $/ didn't work as advertised
  56.  * patch13: added list slice operator (LIST)[LIST]
  57.  * patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST)
  58.  * 
  59.  * Revision 3.0.1.4  90/02/28  17:36:59  lwall
  60.  * patch9: added pipe function
  61.  * patch9: a return in scalar context wouldn't return array
  62.  * patch9: !~ now always returns scalar even in array context
  63.  * patch9: some machines can't cast float to long with high bit set
  64.  * patch9: piped opens returned undef in child
  65.  * patch9: @array in scalar context now returns length of array
  66.  * patch9: chdir; coredumped
  67.  * patch9: wait no longer ignores signals
  68.  * patch9: mkdir now handles odd versions of /bin/mkdir
  69.  * patch9: -l FILEHANDLE now disallowed
  70.  * 
  71.  * Revision 3.0.1.3  89/12/21  20:03:05  lwall
  72.  * patch7: errno may now be a macro with an lvalue
  73.  * patch7: ANSI strerror() is now supported
  74.  * patch7: send() didn't allow a TO argument
  75.  * patch7: ord() now always returns positive even on signed char machines
  76.  * 
  77.  * Revision 3.0.1.2  89/11/17  15:19:34  lwall
  78.  * patch5: constant numeric subscripts get lost inside ?:
  79.  * 
  80.  * Revision 3.0.1.1  89/11/11  04:31:51  lwall
  81.  * patch2: mkdir and rmdir needed to quote argument when passed to shell
  82.  * patch2: mkdir and rmdir now return better error codes
  83.  * patch2: fileno, seekdir, rewinddir and closedir now disallow defaults
  84.  * 
  85.  * Revision 3.0  89/10/18  15:17:04  lwall
  86.  * 3.0 baseline
  87.  * 
  88.  */
  89.  
  90. #include "EXTERN.h"
  91. #include "perl.h"
  92.  
  93. #include <math.h>
  94. #include <signal.h>
  95.  
  96. #ifdef I_FCNTL
  97. #include <fcntl.h>
  98. #endif
  99. #ifdef I_VFORK
  100. #   include <vfork.h>
  101. #endif
  102.  
  103. ARG *debarg;
  104. STR str_args;
  105. static struct lstring *lstr;
  106. static int old_record_separator;
  107.  
  108. char *getlogin PROTO((void));
  109.  
  110. int
  111. eval(arg,gimme,sp)
  112. register ARG *arg;
  113. int gimme;
  114. register int sp;
  115. {
  116.     register STR *str;
  117.     register int anum;
  118.     register int optype;
  119.     register STR **st;
  120.     int maxarg;
  121.     double value;
  122.     register char *tmps;
  123.     char *tmps2;
  124.     char *tmps3;
  125.     int argflags;
  126.     int argtype;
  127.     union argptr argptr;
  128.     int arglast[8];    /* highest sp for arg--valid only for non-O_LIST args */
  129.     unsigned long tmplong;
  130.     long tmplong2;
  131.     TIME_T when;
  132.     FILE *fp;
  133.     STR *tmpstr;
  134.     FCMD *form;
  135.     STAB *stab;
  136.     ARRAY *ary;
  137.     bool assigning = FALSE;
  138.  
  139.     if (!arg)
  140.     goto say_undef;
  141.     optype = arg->arg_type;
  142.     maxarg = arg->arg_len;
  143.     arglast[0] = sp;
  144.     str = arg->arg_ptr.arg_str;
  145.     if (sp + maxarg > stack->ary_max)
  146.     astore(stack, sp + maxarg, Nullstr);
  147.     st = stack->ary_array;
  148.  
  149. #ifdef DEBUGGING
  150.     if (debug) {
  151.     if (debug & 8) {
  152.         deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg);
  153.     }
  154.     debname[dlevel] = opname[optype][0];
  155.     debdelim[dlevel] = ':';
  156.     if (++dlevel >= dlmax)
  157.         grow_dlevel();
  158.     }
  159. #endif
  160.  
  161. #include "xc.evalargs"
  162.  
  163.     st += arglast[0];
  164.     switch (optype) {
  165.     case O_RCAT:
  166.     STABSET(str);
  167.     break;
  168.     case O_ITEM:
  169.     if (gimme == G_ARRAY)
  170.         goto array_return;
  171.     /* FALL THROUGH */
  172.     case O_SCALAR:
  173.     STR_SSET(str,st[1]);
  174.     STABSET(str);
  175.     break;
  176.     case O_ITEM2:
  177.     if (gimme == G_ARRAY)
  178.         goto array_return;
  179.     --anum;
  180.     STR_SSET(str,st[arglast[anum]-arglast[0]]);
  181.     STABSET(str);
  182.     break;
  183.     case O_ITEM3:
  184.     if (gimme == G_ARRAY)
  185.         goto array_return;
  186.     --anum;
  187.     STR_SSET(str,st[arglast[anum]-arglast[0]]);
  188.     STABSET(str);
  189.     break;
  190.     case O_CONCAT:
  191.     STR_SSET(str,st[1]);
  192.     str_scat(str,st[2]);
  193.     STABSET(str);
  194.     break;
  195.     case O_REPEAT:
  196.     STR_SSET(str,st[1]);
  197.     anum = (int)str_gnum(st[2]);
  198.     if (anum >= 1) {
  199.         tmpstr = Str_new(50, 0);
  200.         str_sset(tmpstr,str);
  201.         tmps = str_get(tmpstr);    /* force to be string */
  202.         STR_GROW(str, (anum * str->str_cur) + 1);
  203.         repeatcpy(str->str_ptr, tmps, tmpstr->str_cur, anum);
  204.         str->str_cur *= anum;
  205.         str->str_ptr[str->str_cur] = '\0';
  206.     }
  207.     else
  208.         str_sset(str,&str_no);
  209.     STABSET(str);
  210.     break;
  211.     case O_MATCH:
  212.     sp = do_match(str,arg,
  213.       gimme,arglast);
  214.     if (gimme == G_ARRAY)
  215.         goto array_return;
  216.     STABSET(str);
  217.     break;
  218.     case O_NMATCH:
  219.     sp = do_match(str,arg,
  220.       G_SCALAR,arglast);
  221.     str_sset(str, str_true(str) ? &str_no : &str_yes);
  222.     STABSET(str);
  223.     break;
  224.     case O_SUBST:
  225.     sp = do_subst(str,arg,arglast[0]);
  226.     goto array_return;
  227.     case O_NSUBST:
  228.     sp = do_subst(str,arg,arglast[0]);
  229.     str = arg->arg_ptr.arg_str;
  230.     str_set(str, str_true(str) ? No : Yes);
  231.     goto array_return;
  232.     case O_ASSIGN:
  233.     if (arg[1].arg_flags & AF_ARYOK) {
  234.         if (arg->arg_len == 1) {
  235.         arg->arg_type = O_LOCAL;
  236.         goto local;
  237.         }
  238.         else {
  239.         arg->arg_type = O_AASSIGN;
  240.         goto aassign;
  241.         }
  242.     }
  243.     else {
  244.         arg->arg_type = O_SASSIGN;
  245.         goto sassign;
  246.     }
  247.     case O_LOCAL:
  248.       local:
  249.     arglast[2] = arglast[1];    /* push a null array */
  250.     /* FALL THROUGH */
  251.     case O_AASSIGN:
  252.       aassign:
  253.     sp = do_assign(arg,
  254.       gimme,arglast);
  255.     goto array_return;
  256.     case O_SASSIGN:
  257.       sassign:
  258.     STR_SSET(str, st[2]);
  259.     STABSET(str);
  260.     break;
  261.     case O_CHOP:
  262.     st -= arglast[0];
  263.     str = arg->arg_ptr.arg_str;
  264.     for (sp = arglast[0] + 1; sp <= arglast[1]; sp++)
  265.         do_chop(str,st[sp]);
  266.     st += arglast[0];
  267.     break;
  268.     case O_DEFINED:
  269.     if (arg[1].arg_type & A_DONT) {
  270.         sp = do_defined(str,arg,
  271.           gimme,arglast);
  272.         goto array_return;
  273.     }
  274.     else if (str->str_pok || str->str_nok)
  275.         goto say_yes;
  276.     goto say_no;
  277.     case O_UNDEF:
  278.     if (arg[1].arg_type & A_DONT) {
  279.         sp = do_undef(str,arg,
  280.           gimme,arglast);
  281.         goto array_return;
  282.     }
  283.     else if (str != stab_val(defstab)) {
  284.         str->str_pok = str->str_nok = 0;
  285.         STABSET(str);
  286.     }
  287.     goto say_undef;
  288.     case O_STUDY:
  289.     sp = do_study(str,arg,
  290.       gimme,arglast);
  291.     goto array_return;
  292.     case O_POW:
  293.     value = str_gnum(st[1]);
  294.     value = pow(value,str_gnum(st[2]));
  295.     goto donumset;
  296.     case O_MULTIPLY:
  297.     value = str_gnum(st[1]);
  298.     value *= str_gnum(st[2]);
  299.     goto donumset;
  300.     case O_DIVIDE:
  301.         if ((value = str_gnum(st[2])) == 0.0)
  302.             fatal("Illegal division by zero");
  303.     value = str_gnum(st[1]) / value;
  304.     goto donumset;
  305.     case O_MODULO:
  306.     tmplong = (long) str_gnum(st[2]);
  307.         if (tmplong == 0L)
  308.             fatal("Illegal modulus zero");
  309.     tmplong2 = (long)str_gnum(st[1]);
  310. #ifndef lint
  311.     if (tmplong2 >= 0)
  312.         value = (double)(tmplong2 % tmplong);
  313.     else
  314.         value = (double)(tmplong - ((-tmplong2 - 1) % tmplong)) - 1;
  315. #endif
  316.     goto donumset;
  317.     case O_ADD:
  318.     value = str_gnum(st[1]);
  319.     value += str_gnum(st[2]);
  320.     goto donumset;
  321.     case O_SUBTRACT:
  322.     value = str_gnum(st[1]);
  323.     value -= str_gnum(st[2]);
  324.     goto donumset;
  325.     case O_LEFT_SHIFT:
  326.     value = str_gnum(st[1]);
  327.     anum = (int)str_gnum(st[2]);
  328. #ifndef lint
  329.     value = (double)(U_L(value) << anum);
  330. #endif
  331.     goto donumset;
  332.     case O_RIGHT_SHIFT:
  333.     value = str_gnum(st[1]);
  334.     anum = (int)str_gnum(st[2]);
  335. #ifndef lint
  336.     value = (double)(U_L(value) >> anum);
  337. #endif
  338.     goto donumset;
  339.     case O_LT:
  340.     value = str_gnum(st[1]);
  341.     value = (value < str_gnum(st[2])) ? 1.0 : 0.0;
  342.     goto donumset;
  343.     case O_GT:
  344.     value = str_gnum(st[1]);
  345.     value = (value > str_gnum(st[2])) ? 1.0 : 0.0;
  346.     goto donumset;
  347.     case O_LE:
  348.     value = str_gnum(st[1]);
  349.     value = (value <= str_gnum(st[2])) ? 1.0 : 0.0;
  350.     goto donumset;
  351.     case O_GE:
  352.     value = str_gnum(st[1]);
  353.     value = (value >= str_gnum(st[2])) ? 1.0 : 0.0;
  354.     goto donumset;
  355.     case O_EQ:
  356.     if (dowarn) {
  357.         if ((!st[1]->str_nok && !looks_like_number(st[1])) ||
  358.         (!st[2]->str_nok && !looks_like_number(st[2])) )
  359.         warn("Possible use of == on string value");
  360.     }
  361.     value = str_gnum(st[1]);
  362.     value = (value == str_gnum(st[2])) ? 1.0 : 0.0;
  363.     goto donumset;
  364.     case O_NE:
  365.     value = str_gnum(st[1]);
  366.     value = (value != str_gnum(st[2])) ? 1.0 : 0.0;
  367.     goto donumset;
  368.     case O_NCMP:
  369.     value = str_gnum(st[1]);
  370.     value -= str_gnum(st[2]);
  371.     if (value > 0.0)
  372.         value = 1.0;
  373.     else if (value < 0.0)
  374.         value = -1.0;
  375.     goto donumset;
  376.     case O_BIT_AND:
  377.     if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
  378.         value = str_gnum(st[1]);
  379. #ifndef lint
  380.         value = (double)(U_L(value) & U_L(str_gnum(st[2])));
  381. #endif
  382.         goto donumset;
  383.     }
  384.     else
  385.         do_vop(optype,str,st[1],st[2]);
  386.     break;
  387.     case O_XOR:
  388.     if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
  389.         value = str_gnum(st[1]);
  390. #ifndef lint
  391.         value = (double)(U_L(value) ^ U_L(str_gnum(st[2])));
  392. #endif
  393.         goto donumset;
  394.     }
  395.     else
  396.         do_vop(optype,str,st[1],st[2]);
  397.     break;
  398.     case O_BIT_OR:
  399.     if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
  400.         value = str_gnum(st[1]);
  401. #ifndef lint
  402.         value = (double)(U_L(value) | U_L(str_gnum(st[2])));
  403. #endif
  404.         goto donumset;
  405.     }
  406.     else
  407.         do_vop(optype,str,st[1],st[2]);
  408.     break;
  409. /* use register in evaluating str_true() */
  410.     case O_AND:
  411.     if (str_true(st[1])) {
  412.         anum = 2;
  413.         optype = O_ITEM2;
  414.         argflags = arg[anum].arg_flags;
  415.         if (gimme == G_ARRAY)
  416.         argflags |= AF_ARYOK;
  417.         argtype = arg[anum].arg_type & A_MASK;
  418.         argptr = arg[anum].arg_ptr;
  419.         maxarg = anum = 1;
  420.         sp = arglast[0];
  421.         st -= sp;
  422.         goto re_eval;
  423.     }
  424.     else {
  425.         if (assigning) {
  426.         str_sset(str, st[1]);
  427.         STABSET(str);
  428.         }
  429.         else
  430.         str = st[1];
  431.         break;
  432.     }
  433.     case O_OR:
  434.     if (str_true(st[1])) {
  435.         if (assigning) {
  436.         str_sset(str, st[1]);
  437.         STABSET(str);
  438.         }
  439.         else
  440.         str = st[1];
  441.         break;
  442.     }
  443.     else {
  444.         anum = 2;
  445.         optype = O_ITEM2;
  446.         argflags = arg[anum].arg_flags;
  447.         if (gimme == G_ARRAY)
  448.         argflags |= AF_ARYOK;
  449.         argtype = arg[anum].arg_type & A_MASK;
  450.         argptr = arg[anum].arg_ptr;
  451.         maxarg = anum = 1;
  452.         sp = arglast[0];
  453.         st -= sp;
  454.         goto re_eval;
  455.     }
  456.     case O_COND_EXPR:
  457.     anum = (str_true(st[1]) ? 2 : 3);
  458.     optype = (anum == 2 ? O_ITEM2 : O_ITEM3);
  459.     argflags = arg[anum].arg_flags;
  460.     if (gimme == G_ARRAY)
  461.         argflags |= AF_ARYOK;
  462.     argtype = arg[anum].arg_type & A_MASK;
  463.     argptr = arg[anum].arg_ptr;
  464.     maxarg = anum = 1;
  465.     sp = arglast[0];
  466.     st -= sp;
  467.     goto re_eval;
  468.     case O_COMMA:
  469.     if (gimme == G_ARRAY)
  470.         goto array_return;
  471.     str = st[2];
  472.     break;
  473.     case O_NEGATE:
  474.     value = -str_gnum(st[1]);
  475.     goto donumset;
  476.     case O_NOT:
  477.     value = (double) !str_true(st[1]);
  478.     goto donumset;
  479.     case O_COMPLEMENT:
  480.     if (!sawvec || st[1]->str_nok) {
  481. #ifndef lint
  482.         value = (double) ~U_L(str_gnum(st[1]));
  483. #endif
  484.         goto donumset;
  485.     }
  486.     else {
  487.         STR_SSET(str,st[1]);
  488.         tmps = str_get(str);
  489.         for (anum = str->str_cur; anum; anum--, tmps++)
  490.         *tmps = ~*tmps;
  491.     }
  492.     break;
  493.     case O_SELECT:
  494.     stab_fullname(str,defoutstab);
  495.     if (maxarg > 0) {
  496.         if ((arg[1].arg_type & A_MASK) == A_WORD)
  497.         defoutstab = arg[1].arg_ptr.arg_stab;
  498.         else
  499.         defoutstab = stabent(str_get(st[1]),TRUE);
  500.         if (!stab_io(defoutstab))
  501.         stab_io(defoutstab) = stio_new();
  502.         curoutstab = defoutstab;
  503.     }
  504.     STABSET(str);
  505.     break;
  506.     case O_WRITE:
  507.     if (maxarg == 0)
  508.         stab = defoutstab;
  509.     else if ((arg[1].arg_type & A_MASK) == A_WORD) {
  510.         if ((stab = arg[1].arg_ptr.arg_stab) == Nullstab)
  511.         stab = defoutstab;
  512.     }
  513.     else
  514.         stab = stabent(str_get(st[1]),TRUE);
  515.     if (!stab_io(stab)) {
  516.         str_set(str, No);
  517.         STABSET(str);
  518.         break;
  519.     }
  520.     curoutstab = stab;
  521.     fp = stab_io(stab)->ofp;
  522.     debarg = arg;
  523.     if (stab_io(stab)->fmt_stab)
  524.         form = stab_form(stab_io(stab)->fmt_stab);
  525.     else
  526.         form = stab_form(stab);
  527.     if (!form || !fp) {
  528.         if (dowarn) {
  529.         if (form)
  530.             warn("No format for filehandle");
  531.         else {
  532.             if (stab_io(stab)->ifp)
  533.             warn("Filehandle only opened for input");
  534.             else
  535.             warn("Write on closed filehandle");
  536.         }
  537.         }
  538.         str_set(str, No);
  539.         STABSET(str);
  540.         break;
  541.     }
  542.     format(&outrec,form,sp);
  543.     do_write(&outrec,stab_io(stab),sp);
  544.     if (stab_io(stab)->flags & IOF_FLUSH)
  545.         (void)fflush(fp);
  546.     str_set(str, Yes);
  547.     STABSET(str);
  548.     break;
  549.     case O_DBMOPEN:
  550. #ifdef SOME_DBM
  551.     stab = arg[1].arg_ptr.arg_stab;
  552.     if (st[3]->str_nok || st[3]->str_pok)
  553.         anum = (int)str_gnum(st[3]);
  554.     else
  555.         anum = -1;
  556.     value = (double)hdbmopen(stab_hash(stab),str_get(st[2]),anum);
  557.     goto donumset;
  558. #else
  559.     fatal("No dbm or ndbm on this machine");
  560. #endif
  561.     case O_DBMCLOSE:
  562. #ifdef SOME_DBM
  563.     stab = arg[1].arg_ptr.arg_stab;
  564.     hdbmclose(stab_hash(stab));
  565.     goto say_yes;
  566. #else
  567.     fatal("No dbm or ndbm on this machine");
  568. #endif
  569.     case O_OPEN:
  570.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  571.         stab = arg[1].arg_ptr.arg_stab;
  572.     else
  573.         stab = stabent(str_get(st[1]),TRUE);
  574.     tmps = str_get(st[2]);
  575.     if (do_open(stab,tmps,st[2]->str_cur)) {
  576.         value = 1.0;
  577.         stab_io(stab)->lines = 0;
  578.         goto donumset;
  579.     }
  580.     else
  581.         goto say_undef;
  582.     /* break; */
  583.     case O_TRANS:
  584.     value = (double) do_trans(str,arg);
  585.     str = arg->arg_ptr.arg_str;
  586.     goto donumset;
  587.     case O_NTRANS:
  588.     str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No);
  589.     str = arg->arg_ptr.arg_str;
  590.     break;
  591.     case O_CLOSE:
  592.     if (maxarg == 0)
  593.         stab = defoutstab;
  594.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  595.         stab = arg[1].arg_ptr.arg_stab;
  596.     else
  597.         stab = stabent(str_get(st[1]),TRUE);
  598.     str_set(str, do_close(stab,TRUE) ? Yes : No );
  599.     STABSET(str);
  600.     break;
  601.     case O_EACH:
  602.     sp = do_each(str,stab_hash(arg[1].arg_ptr.arg_stab),
  603.       gimme,arglast);
  604.     goto array_return;
  605.     case O_VALUES:
  606.     case O_KEYS:
  607.     sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
  608.       gimme,arglast);
  609.     goto array_return;
  610.     case O_LARRAY:
  611.     str->str_nok = str->str_pok = 0;
  612.     str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
  613.     str->str_state = SS_ARY;
  614.     break;
  615.     case O_ARRAY:
  616.     ary = stab_array(arg[1].arg_ptr.arg_stab);
  617.     maxarg = ary->ary_fill + 1;
  618.     if (gimme == G_ARRAY) { /* array wanted */
  619.         sp = arglast[0];
  620.         st -= sp;
  621.         if (maxarg > 0 && sp + maxarg > stack->ary_max) {
  622.         astore(stack,sp + maxarg, Nullstr);
  623.         st = stack->ary_array;
  624.         }
  625.         st += sp;
  626.         Copy(ary->ary_array, &st[1], maxarg, STR*);
  627.         sp += maxarg;
  628.         goto array_return;
  629.     }
  630.     else {
  631.         value = (double)maxarg;
  632.         goto donumset;
  633.     }
  634.     case O_AELEM:
  635.     anum = ((int)str_gnum(st[2])) - arybase;
  636.     str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE);
  637.     break;
  638.     case O_DELETE:
  639.     tmpstab = arg[1].arg_ptr.arg_stab;
  640.     tmps = str_get(st[2]);
  641.     str = hdelete(stab_hash(tmpstab),tmps,st[2]->str_cur);
  642.     if (tmpstab == envstab)
  643.         setenv(tmps,Nullch);
  644.     if (!str)
  645.         goto say_undef;
  646.     break;
  647.     case O_LHASH:
  648.     str->str_nok = str->str_pok = 0;
  649.     str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
  650.     str->str_state = SS_HASH;
  651.     break;
  652.     case O_HASH:
  653.     if (gimme == G_ARRAY) { /* array wanted */
  654.         sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
  655.         gimme,arglast);
  656.         goto array_return;
  657.     }
  658.     else {
  659.         tmpstab = arg[1].arg_ptr.arg_stab;
  660.         if (!stab_hash(tmpstab)->tbl_fill)
  661.         goto say_zero;
  662.         sprintf(buf,"%d/%d",stab_hash(tmpstab)->tbl_fill,
  663.         stab_hash(tmpstab)->tbl_max+1);
  664.         str_set(str,buf);
  665.     }
  666.     break;
  667.     case O_HELEM:
  668.     tmpstab = arg[1].arg_ptr.arg_stab;
  669.     tmps = str_get(st[2]);
  670.     str = hfetch(stab_hash(tmpstab),tmps,st[2]->str_cur,FALSE);
  671.     break;
  672.     case O_LAELEM:
  673.     anum = ((int)str_gnum(st[2])) - arybase;
  674.     str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,TRUE);
  675.     if (!str || str == &str_undef)
  676.         fatal("Assignment to non-creatable value, subscript %d",anum);
  677.     break;
  678.     case O_LHELEM:
  679.     tmpstab = arg[1].arg_ptr.arg_stab;
  680.     tmps = str_get(st[2]);
  681.     anum = st[2]->str_cur;
  682.     str = hfetch(stab_hash(tmpstab),tmps,anum,TRUE);
  683.     if (!str || str == &str_undef)
  684.         fatal("Assignment to non-creatable value, subscript \"%s\"",tmps);
  685.     if (tmpstab == envstab)        /* heavy wizardry going on here */
  686.         str_magic(str, tmpstab, 'E', tmps, anum);    /* str is now magic */
  687.                     /* he threw the brick up into the air */
  688.     else if (tmpstab == sigstab)
  689.         str_magic(str, tmpstab, 'S', tmps, anum);
  690. #ifdef SOME_DBM
  691.     else if (stab_hash(tmpstab)->tbl_dbm)
  692.         str_magic(str, tmpstab, 'D', tmps, anum);
  693. #endif
  694.     else if (perldb && tmpstab == DBline)
  695.         str_magic(str, tmpstab, 'L', tmps, anum);
  696.     break;
  697.     case O_LSLICE:
  698.     anum = 2;
  699.     argtype = FALSE;
  700.     goto do_slice_already;
  701.     case O_ASLICE:
  702.     anum = 1;
  703.     argtype = FALSE;
  704.     goto do_slice_already;
  705.     case O_HSLICE:
  706.     anum = 0;
  707.     argtype = FALSE;
  708.     goto do_slice_already;
  709.     case O_LASLICE:
  710.     anum = 1;
  711.     argtype = TRUE;
  712.     goto do_slice_already;
  713.     case O_LHSLICE:
  714.     anum = 0;
  715.     argtype = TRUE;
  716.       do_slice_already:
  717.     sp = do_slice(arg[1].arg_ptr.arg_stab,str,anum,argtype,
  718.         gimme,arglast);
  719.     goto array_return;
  720.     case O_SPLICE:
  721.     sp = do_splice(stab_array(arg[1].arg_ptr.arg_stab),gimme,arglast);
  722.     goto array_return;
  723.     case O_PUSH:
  724.     if (arglast[2] - arglast[1] != 1)
  725.         str = do_push(stab_array(arg[1].arg_ptr.arg_stab),arglast);
  726.     else {
  727.         str = Str_new(51,0);        /* must copy the STR */
  728.         str_sset(str,st[2]);
  729.         (void)apush(stab_array(arg[1].arg_ptr.arg_stab),str);
  730.     }
  731.     break;
  732.     case O_POP:
  733.     str = apop(ary = stab_array(arg[1].arg_ptr.arg_stab));
  734.     goto staticalization;
  735.     case O_SHIFT:
  736.     str = ashift(ary = stab_array(arg[1].arg_ptr.arg_stab));
  737.       staticalization:
  738.     if (!str)
  739.         goto say_undef;
  740.     if (ary->ary_flags & ARF_REAL)
  741.         (void)str_2static(str);
  742.     break;
  743.     case O_UNPACK:
  744.     sp = do_unpack(str,gimme,arglast);
  745.     goto array_return;
  746.     case O_SPLIT:
  747.     value = str_gnum(st[3]);
  748.     sp = do_split(str, arg[2].arg_ptr.arg_spat, (int)value,
  749.       gimme,arglast);
  750.     goto array_return;
  751.     case O_LENGTH:
  752.     if (maxarg < 1)
  753.         value = (double)str_len(stab_val(defstab));
  754.     else
  755.         value = (double)str_len(st[1]);
  756.     goto donumset;
  757.     case O_SPRINTF:
  758.     do_sprintf(str, sp-arglast[0], st+1);
  759.     break;
  760.     case O_SUBSTR:
  761.     anum = ((int)str_gnum(st[2])) - arybase;    /* anum=where to start*/
  762.     tmps = str_get(st[1]);        /* force conversion to string */
  763.     if ((argtype = (str == st[1])) != 0)
  764.         str = arg->arg_ptr.arg_str;
  765.     if (anum < 0)
  766.         anum += st[1]->str_cur + arybase;
  767.     if (anum < 0 || anum > st[1]->str_cur)
  768.         str_nset(str,"",0);
  769.     else {
  770.         optype = maxarg < 3 ? st[1]->str_cur : (int)str_gnum(st[3]);
  771.         if (optype < 0)
  772.         optype = 0;
  773.         tmps += anum;
  774.         anum = st[1]->str_cur - anum;    /* anum=how many bytes left*/
  775.         if (anum > optype)
  776.         anum = optype;
  777.         str_nset(str, tmps, anum);
  778.         if (argtype) {            /* it's an lvalue! */
  779.         lstr = (struct lstring*)str;
  780.         str->str_magic = st[1];
  781.         st[1]->str_rare = 's';
  782.         lstr->lstr_offset = tmps - str_get(st[1]); 
  783.         lstr->lstr_len = anum; 
  784.         }
  785.     }
  786.     break;
  787.     case O_PACK:
  788.     (void)do_pack(str,arglast);
  789.     break;
  790.     case O_GREP:
  791.     sp = do_grep(arg,str,gimme,arglast);
  792.     goto array_return;
  793.     case O_JOIN:
  794.     do_join(str,arglast);
  795.     break;
  796.     case O_SLT:
  797.     tmps = str_get(st[1]);
  798.     value = (double) (str_cmp(st[1],st[2]) < 0);
  799.     goto donumset;
  800.     case O_SGT:
  801.     tmps = str_get(st[1]);
  802.     value = (double) (str_cmp(st[1],st[2]) > 0);
  803.     goto donumset;
  804.     case O_SLE:
  805.     tmps = str_get(st[1]);
  806.     value = (double) (str_cmp(st[1],st[2]) <= 0);
  807.     goto donumset;
  808.     case O_SGE:
  809.     tmps = str_get(st[1]);
  810.     value = (double) (str_cmp(st[1],st[2]) >= 0);
  811.     goto donumset;
  812.     case O_SEQ:
  813.     tmps = str_get(st[1]);
  814.     value = (double) str_eq(st[1],st[2]);
  815.     goto donumset;
  816.     case O_SNE:
  817.     tmps = str_get(st[1]);
  818.     value = (double) !str_eq(st[1],st[2]);
  819.     goto donumset;
  820.     case O_SCMP:
  821.     tmps = str_get(st[1]);
  822.     value = (double) str_cmp(st[1],st[2]);
  823.     goto donumset;
  824.     case O_SUBR:
  825.     sp = do_subr(arg,gimme,arglast);
  826.     st = stack->ary_array + arglast[0];        /* maybe realloced */
  827.     goto array_return;
  828.     case O_DBSUBR:
  829.     sp = do_subr(arg,gimme,arglast);
  830.     st = stack->ary_array + arglast[0];        /* maybe realloced */
  831.     goto array_return;
  832.     case O_CALLER:
  833.     sp = do_caller(arg,maxarg,gimme,arglast);
  834.     st = stack->ary_array + arglast[0];        /* maybe realloced */
  835.     goto array_return;
  836.     case O_SORT:
  837.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  838.         stab = arg[1].arg_ptr.arg_stab;
  839.     else
  840.         stab = stabent(str_get(st[1]),TRUE);
  841.     sp = do_sort(str,stab,
  842.       gimme,arglast);
  843.     goto array_return;
  844.     case O_REVERSE:
  845.     if (gimme == G_ARRAY)
  846.         sp = do_reverse(arglast);
  847.     else
  848.         sp = do_sreverse(str, arglast);
  849.     goto array_return;
  850.     case O_WARN:
  851.     if (arglast[2] - arglast[1] != 1) {
  852.         do_join(str,arglast);
  853.         tmps = str_get(st[1]);
  854.     }
  855.     else {
  856.         str = st[2];
  857.         tmps = str_get(st[2]);
  858.     }
  859.     if (!tmps || !*tmps)
  860.         tmps = "Warning: something's wrong";
  861.     warn("%s",tmps);
  862.     goto say_yes;
  863.     case O_DIE:
  864.     if (arglast[2] - arglast[1] != 1) {
  865.         do_join(str,arglast);
  866.         tmps = str_get(st[1]);
  867.     }
  868.     else {
  869.         str = st[2];
  870.         tmps = str_get(st[2]);
  871.     }
  872.     if (!tmps || !*tmps)
  873.         tmps = "Died";
  874.     fatal("%s",tmps);
  875.     goto say_zero;
  876.     case O_PRTF:
  877.     case O_PRINT:
  878.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  879.         stab = arg[1].arg_ptr.arg_stab;
  880.     else
  881.         stab = stabent(str_get(st[1]),TRUE);
  882.     if (!stab)
  883.         stab = defoutstab;
  884.     if (!stab_io(stab)) {
  885.         if (dowarn)
  886.         warn("Filehandle never opened");
  887.         goto say_zero;
  888.     }
  889.     if ((fp = stab_io(stab)->ofp) == Nullfp) {
  890.         if (dowarn)  {
  891.         if (stab_io(stab)->ifp)
  892.             warn("Filehandle opened only for input");
  893.         else
  894.             warn("Print on closed filehandle");
  895.         }
  896.         goto say_zero;
  897.     }
  898.     else {
  899.         if (optype == O_PRTF || arglast[2] - arglast[1] != 1)
  900.         value = (double)do_aprint(arg,fp,arglast);
  901.         else {
  902.         value = (double)do_print(st[2],fp);
  903.         if (orslen && optype == O_PRINT)
  904.             if (fwrite(ors, 1, orslen, fp) == 0)
  905.             goto say_zero;
  906.         }
  907.         if (stab_io(stab)->flags & IOF_FLUSH)
  908.         if (fflush(fp) == EOF)
  909.             goto say_zero;
  910.     }
  911.     goto donumset;
  912.     case O_CHDIR:
  913.     if (maxarg < 1)
  914.         tmps = Nullch;
  915.     else
  916.         tmps = str_get(st[1]);
  917.     if (!tmps || !*tmps) {
  918.         tmps = "&"; /* User root directory */
  919.     }
  920. #ifdef TAINT
  921.     taintproper("Insecure dependency in chdir");
  922. #endif
  923.     value = (double)(chdir(tmps) >= 0);
  924.     goto donumset;
  925.     case O_EXIT:
  926.     if (maxarg < 1)
  927.         anum = 0;
  928.     else
  929.         anum = (int)str_gnum(st[1]);
  930.     exit(anum);
  931.     goto say_zero;
  932.     case O_RESET:
  933.     if (maxarg < 1)
  934.         tmps = "";
  935.     else
  936.         tmps = str_get(st[1]);
  937.     str_reset(tmps,curcmd->c_stash);
  938.     value = 1.0;
  939.     goto donumset;
  940.     case O_LIST:
  941.     if (gimme == G_ARRAY)
  942.         goto array_return;
  943.     if (maxarg > 0)
  944.         str = st[sp - arglast[0]];    /* unwanted list, return last item */
  945.     else
  946.         str = &str_undef;
  947.     break;
  948.     case O_EOF:
  949.     if (maxarg <= 0)
  950.         stab = last_in_stab;
  951.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  952.         stab = arg[1].arg_ptr.arg_stab;
  953.     else
  954.         stab = stabent(str_get(st[1]),TRUE);
  955.     str_set(str, do_eof(stab) ? Yes : No);
  956.     STABSET(str);
  957.     break;
  958.     case O_GETC:
  959.     if (maxarg <= 0)
  960.         stab = stdinstab;
  961.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  962.         stab = arg[1].arg_ptr.arg_stab;
  963.     else
  964.         stab = stabent(str_get(st[1]),TRUE);
  965.     if (!stab)
  966.         stab = argvstab;
  967.     if (!stab || do_eof(stab)) /* make sure we have fp with something */
  968.         goto say_undef;
  969.     else {
  970. #ifdef TAINT
  971.         tainted = 1;
  972. #endif
  973.         str_set(str," ");
  974.         *str->str_ptr = getc(stab_io(stab)->ifp); /* should never be EOF */
  975.     }
  976.     STABSET(str);
  977.     break;
  978.     case O_TELL:
  979.     if (maxarg <= 0)
  980.         stab = last_in_stab;
  981.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  982.         stab = arg[1].arg_ptr.arg_stab;
  983.     else
  984.         stab = stabent(str_get(st[1]),TRUE);
  985. #ifndef lint
  986.     value = (double)do_tell(stab);
  987. #else
  988.     (void)do_tell(stab);
  989. #endif
  990.     goto donumset;
  991.     case O_READ:
  992.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  993.         stab = arg[1].arg_ptr.arg_stab;
  994.     else
  995.         stab = stabent(str_get(st[1]),TRUE);
  996.     tmps = str_get(st[2]);
  997.     anum = (int)str_gnum(st[3]);
  998.     errno = 0;
  999.     maxarg = sp - arglast[0];
  1000.     if (maxarg > 4)
  1001.         warn("Too many args on read");
  1002.     if (maxarg == 4)
  1003.         maxarg = (int)str_gnum(st[4]);
  1004.     else
  1005.         maxarg = 0;
  1006.     if (!stab_io(stab) || !stab_io(stab)->ifp)
  1007.         goto say_undef;
  1008.     STR_GROW(st[2], anum+maxarg+1), (tmps = str_get(st[2]));  /* sneaky */
  1009.     anum = fread(tmps+maxarg, 1, anum, stab_io(stab)->ifp);
  1010.     if (anum < 0)
  1011.         goto say_undef;
  1012.     st[2]->str_cur = anum;
  1013.     st[2]->str_ptr[anum] = '\0';
  1014.     value = (double)anum;
  1015.     goto donumset;
  1016.     case O_SEEK:
  1017.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1018.         stab = arg[1].arg_ptr.arg_stab;
  1019.     else
  1020.         stab = stabent(str_get(st[1]),TRUE);
  1021.     value = str_gnum(st[2]);
  1022.     str_set(str, do_seek(stab,
  1023.       (long)value, (int)str_gnum(st[3]) ) ? Yes : No);
  1024.     STABSET(str);
  1025.     break;
  1026.     case O_RETURN:
  1027.     tmps = "_SUB_";        /* just fake up a "last _SUB_" */
  1028.     optype = O_LAST;
  1029.     if (curcsv && curcsv->wantarray == G_ARRAY) {
  1030.         lastretstr = Nullstr;
  1031.         lastspbase = arglast[1];
  1032.         lastsize = arglast[2] - arglast[1];
  1033.     }
  1034.     else
  1035.         lastretstr = str_static(st[arglast[2] - arglast[0]]);
  1036.     goto dopop;
  1037.     case O_REDO:
  1038.     case O_NEXT:
  1039.     case O_LAST:
  1040.     if (maxarg > 0) {
  1041.         tmps = str_get(arg[1].arg_ptr.arg_str);
  1042.       dopop:
  1043.         while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
  1044.           strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
  1045. #ifdef DEBUGGING
  1046.         if (debug & 4) {
  1047.             deb("(Skipping label #%d %s)\n",loop_ptr,
  1048.             loop_stack[loop_ptr].loop_label);
  1049.         }
  1050. #endif
  1051.         loop_ptr--;
  1052.         }
  1053. #ifdef DEBUGGING
  1054.         if (debug & 4) {
  1055.         deb("(Found label #%d %s)\n",loop_ptr,
  1056.             loop_stack[loop_ptr].loop_label);
  1057.         }
  1058. #endif
  1059.     }
  1060.     if (loop_ptr < 0) {
  1061.         if (tmps && strEQ(tmps, "_SUB_"))
  1062.         fatal("Can't return outside a subroutine");
  1063.         fatal("Bad label: %s", maxarg > 0 ? tmps : "<null>");
  1064.     }
  1065.     if (!lastretstr && optype == O_LAST && lastsize) {
  1066.         st -= arglast[0];
  1067.         st += lastspbase + 1;
  1068.         optype = loop_stack[loop_ptr].loop_sp - lastspbase; /* negative */
  1069.         if (optype) {
  1070.         for (anum = lastsize; anum > 0; anum--,st++)
  1071.             st[optype] = str_static(st[0]);
  1072.         }
  1073.         longjmp(loop_stack[loop_ptr].loop_env, O_LAST);
  1074.     }
  1075.     longjmp(loop_stack[loop_ptr].loop_env, optype);
  1076.     case O_GOTO:/* shudder */
  1077.     goto_targ = str_get(arg[1].arg_ptr.arg_str);
  1078.     if (!*goto_targ)
  1079.         goto_targ = Nullch;        /* just restart from top */
  1080.     longjmp(top_env, 1);
  1081.     case O_INDEX:
  1082.     tmps = str_get(st[1]);
  1083.     if (maxarg < 3)
  1084.         anum = 0;
  1085.     else {
  1086.         anum = (int) str_gnum(st[3]) - arybase;
  1087.         if (anum < 0)
  1088.         anum = 0;
  1089.         else if (anum > st[1]->str_cur)
  1090.         anum = st[1]->str_cur;
  1091.     }
  1092. #ifndef lint
  1093.     if ((tmps2 = fbminstr((unsigned char*)tmps + anum,
  1094.       (unsigned char*)tmps + st[1]->str_cur, st[2])) == Nullch)
  1095. #else
  1096.     if (tmps2 = fbminstr(Null(unsigned char*),Null(unsigned char*),Nullstr))
  1097. #endif
  1098.         value = (double)(-1 + arybase);
  1099.     else
  1100.         value = (double)(tmps2 - tmps + arybase);
  1101.     goto donumset;
  1102.     case O_RINDEX:
  1103.     tmps = str_get(st[1]);
  1104.     tmps2 = str_get(st[2]);
  1105.     if (maxarg < 3)
  1106.         anum = st[1]->str_cur;
  1107.     else {
  1108.         anum = (int) str_gnum(st[3]) - arybase + st[2]->str_cur;
  1109.         if (anum < 0)
  1110.         anum = 0;
  1111.         else if (anum > st[1]->str_cur)
  1112.         anum = st[1]->str_cur;
  1113.     }
  1114. #ifndef lint
  1115.     if ((tmps2 = rninstr(tmps,  tmps  + anum,
  1116.                  tmps2, tmps2 + st[2]->str_cur)) == Nullch)
  1117. #else
  1118.     if (tmps2 = rninstr(Nullch,Nullch,Nullch,Nullch))
  1119. #endif
  1120.         value = (double)(-1 + arybase);
  1121.     else
  1122.         value = (double)(tmps2 - tmps + arybase);
  1123.     goto donumset;
  1124.     case O_TIME:
  1125. #ifndef lint
  1126.     value = (double) time(Null(TIME_T*));
  1127. #endif
  1128.     goto donumset;
  1129.     case O_LOCALTIME:
  1130.     if (maxarg < 1)
  1131.         (void)time(&when);
  1132.     else
  1133.         when = (TIME_T)str_gnum(st[1]);
  1134.     {
  1135.         /* Under RISC OS, the localtime() function does not take
  1136.          * summer time into account. We therefore assume the system
  1137.          * time is localtime(), but if the OS variable Time$DST is
  1138.          * set, we flag it as daylight saving time.
  1139.          */
  1140.         struct tm *localtm;
  1141.         char *dst = getenv("Time$DST");
  1142.  
  1143.         localtm = localtime(&when);
  1144.         localtm->tm_isdst = (dst && *dst) ? 1 : 0;
  1145.  
  1146.         sp = do_time(str,localtm,gimme,arglast);
  1147.     }
  1148.     goto array_return;
  1149.     case O_GMTIME:
  1150.     if (maxarg < 1)
  1151.         (void)time(&when);
  1152.     else
  1153.         when = (TIME_T)str_gnum(st[1]);
  1154.     {
  1155.         /* Under RISC OS, there is no gmtime() function!! We
  1156.          * therefore use localtime(), but if the OS variable
  1157.          * Time$DST is set, we subtract 1 hour.
  1158.          */
  1159.         struct tm *gmtm;
  1160.         time_t when_adj = when;
  1161.         char *dst = getenv("Time$DST");
  1162.  
  1163.         if (dst && *dst)
  1164.         {
  1165.             when_adj -= 3600;
  1166.         }
  1167.  
  1168.         gmtm = localtime(&when_adj);
  1169.         gmtm->tm_isdst = 0;
  1170.  
  1171.         sp = do_time(str,gmtm,gimme,arglast);
  1172.     }
  1173.     goto array_return;
  1174.     case O_TRUNCATE:
  1175.     sp = do_truncate(str,arg,
  1176.       gimme,arglast);
  1177.     goto array_return;
  1178.     case O_STAT:
  1179.     sp = do_stat(str,arg,
  1180.       gimme,arglast);
  1181.     goto array_return;
  1182.     case O_CRYPT:
  1183. #ifdef CRYPT
  1184.     tmps = str_get(st[1]);
  1185. #ifdef FCRYPT
  1186.     str_set(str,fcrypt(tmps,str_get(st[2])));
  1187. #else
  1188.     str_set(str,crypt(tmps,str_get(st[2])));
  1189. #endif
  1190. #else
  1191.     fatal(
  1192.       "The crypt() function is unimplemented due to excessive paranoia.");
  1193. #endif
  1194.     break;
  1195.     case O_ATAN2:
  1196.     value = str_gnum(st[1]);
  1197.     value = atan2(value,str_gnum(st[2]));
  1198.     goto donumset;
  1199.     case O_SIN:
  1200.     if (maxarg < 1)
  1201.         value = str_gnum(stab_val(defstab));
  1202.     else
  1203.         value = str_gnum(st[1]);
  1204.     value = sin(value);
  1205.     goto donumset;
  1206.     case O_COS:
  1207.     if (maxarg < 1)
  1208.         value = str_gnum(stab_val(defstab));
  1209.     else
  1210.         value = str_gnum(st[1]);
  1211.     value = cos(value);
  1212.     goto donumset;
  1213.     case O_RAND:
  1214.     if (maxarg < 1)
  1215.         value = 1.0;
  1216.     else
  1217.         value = str_gnum(st[1]);
  1218.     if (value == 0.0)
  1219.         value = 1.0;
  1220. #if RANDBITS == 31
  1221.     value = rand() * value / 2147483648.0;
  1222. #else
  1223. #if RANDBITS == 16
  1224.     value = rand() * value / 65536.0;
  1225. #else
  1226. #if RANDBITS == 15
  1227.     value = rand() * value / 32768.0;
  1228. #else
  1229.     value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
  1230. #endif
  1231. #endif
  1232. #endif
  1233.     goto donumset;
  1234.     case O_SRAND:
  1235.     if (maxarg < 1) {
  1236.         (void)time(&when);
  1237.         anum = when;
  1238.     }
  1239.     else
  1240.         anum = (int)str_gnum(st[1]);
  1241.     (void)srand(anum);
  1242.     goto say_yes;
  1243.     case O_EXP:
  1244.     if (maxarg < 1)
  1245.         value = str_gnum(stab_val(defstab));
  1246.     else
  1247.         value = str_gnum(st[1]);
  1248.     value = exp(value);
  1249.     goto donumset;
  1250.     case O_LOG:
  1251.     if (maxarg < 1)
  1252.         value = str_gnum(stab_val(defstab));
  1253.     else
  1254.         value = str_gnum(st[1]);
  1255.     value = log(value);
  1256.     goto donumset;
  1257.     case O_SQRT:
  1258.     if (maxarg < 1)
  1259.         value = str_gnum(stab_val(defstab));
  1260.     else
  1261.         value = str_gnum(st[1]);
  1262.     value = sqrt(value);
  1263.     goto donumset;
  1264.     case O_INT:
  1265.     if (maxarg < 1)
  1266.         value = str_gnum(stab_val(defstab));
  1267.     else
  1268.         value = str_gnum(st[1]);
  1269.     if (value >= 0.0)
  1270.         (void)modf(value,&value);
  1271.     else {
  1272.         (void)modf(-value,&value);
  1273.         value = -value;
  1274.     }
  1275.     goto donumset;
  1276.     case O_ORD:
  1277.     if (maxarg < 1)
  1278.         tmps = str_get(stab_val(defstab));
  1279.     else
  1280.         tmps = str_get(st[1]);
  1281. #ifndef I286
  1282.     value = (double) (*tmps & 255);
  1283. #else
  1284.     anum = (int) *tmps;
  1285.     value = (double) (anum & 255);
  1286. #endif
  1287.     goto donumset;
  1288.     case O_KILL:
  1289.     if (maxarg < 1)
  1290.         anum = SIGTERM;
  1291.     else {
  1292.         tmps = str_get(st[1]);
  1293.  
  1294.         if (isupper(*tmps)) {
  1295.         if (*tmps == 'S' && tmps[1] == 'I' && tmps[2] == 'G')
  1296.             tmps += 3;
  1297.         if ((anum = whichsig(tmps)) == 0)
  1298.             fatal("Unrecognized signal name \"%s\"",tmps);
  1299.         }
  1300.         else
  1301.         anum = (int)str_gnum(st[1]);
  1302.     }
  1303.     anum = raise(anum);
  1304.  
  1305.     if (anum == 0)
  1306.         goto say_yes;
  1307.     else
  1308.         goto say_no;
  1309.     case O_SLEEP:
  1310.     if (maxarg < 1)
  1311.         tmps = Nullch;
  1312.     else
  1313.         tmps = str_get(st[1]);
  1314.     (void)time(&when);
  1315.     if (!tmps || !*tmps)
  1316.         sleep((32767<<16)+32767);
  1317.     else
  1318.         sleep((unsigned int)atoi(tmps));
  1319. #ifndef lint
  1320.     value = (double)when;
  1321.     (void)time(&when);
  1322.     value = ((double)when) - value;
  1323. #endif
  1324.     goto donumset;
  1325.     case O_RANGE:
  1326.     sp = do_range(gimme,arglast);
  1327.     goto array_return;
  1328.     case O_F_OR_R:
  1329.     if (gimme == G_ARRAY) {        /* it's a range */
  1330.         /* can we optimize to constant array? */
  1331.         if ((arg[1].arg_type & A_MASK) == A_SINGLE &&
  1332.           (arg[2].arg_type & A_MASK) == A_SINGLE) {
  1333.         st[2] = arg[2].arg_ptr.arg_str;
  1334.         sp = do_range(gimme,arglast);
  1335.         st = stack->ary_array;
  1336.         maxarg = sp - arglast[0];
  1337.         str_free(arg[1].arg_ptr.arg_str);
  1338.         str_free(arg[2].arg_ptr.arg_str);
  1339.         arg->arg_type = O_ARRAY;
  1340.         arg[1].arg_type = A_STAB|A_DONT;
  1341.         arg->arg_len = 1;
  1342.         stab = arg[1].arg_ptr.arg_stab = aadd(genstab());
  1343.         ary = stab_array(stab);
  1344.         afill(ary,maxarg - 1);
  1345.         anum = maxarg;
  1346.         st += arglast[0]+1;
  1347.         while (maxarg-- > 0)
  1348.             ary->ary_array[maxarg] = str_smake(st[maxarg]);
  1349.         st -= arglast[0]+1;
  1350.         goto array_return;
  1351.         }
  1352.         arg->arg_type = optype = O_RANGE;
  1353.         maxarg = arg->arg_len = 2;
  1354.         anum = 2;
  1355.         arg[anum].arg_flags &= ~AF_ARYOK;
  1356.         argflags = arg[anum].arg_flags;
  1357.         argtype = arg[anum].arg_type & A_MASK;
  1358.         arg[anum].arg_type = argtype;
  1359.         argptr = arg[anum].arg_ptr;
  1360.         sp = arglast[0];
  1361.         st -= sp;
  1362.         sp++;
  1363.         goto re_eval;
  1364.     }
  1365.     arg->arg_type = O_FLIP;
  1366.     /* FALL THROUGH */
  1367.     case O_FLIP:
  1368.     if ((arg[1].arg_type & A_MASK) == A_SINGLE ?
  1369.       last_in_stab && (int)str_gnum(st[1]) == stab_io(last_in_stab)->lines
  1370.       :
  1371.       str_true(st[1]) ) {
  1372.         str_numset(str,0.0);
  1373.         anum = 2;
  1374.         arg->arg_type = optype = O_FLOP;
  1375.         arg[2].arg_type &= ~A_DONT;
  1376.         arg[1].arg_type |= A_DONT;
  1377.         argflags = arg[2].arg_flags;
  1378.         argtype = arg[2].arg_type & A_MASK;
  1379.         argptr = arg[2].arg_ptr;
  1380.         sp = arglast[0];
  1381.         st -= sp++;
  1382.         goto re_eval;
  1383.     }
  1384.     str_set(str,"");
  1385.     break;
  1386.     case O_FLOP:
  1387.     str_inc(str);
  1388.     if ((arg[2].arg_type & A_MASK) == A_SINGLE ?
  1389.       last_in_stab && (int)str_gnum(st[2]) == stab_io(last_in_stab)->lines
  1390.       :
  1391.       str_true(st[2]) ) {
  1392.         arg->arg_type = O_FLIP;
  1393.         arg[1].arg_type &= ~A_DONT;
  1394.         arg[2].arg_type |= A_DONT;
  1395.         str_cat(str,"E0");
  1396.     }
  1397.     break;
  1398.     case O_SYSTEM:
  1399.     if ((arg[1].arg_type & A_MASK) == A_STAB)
  1400.         value = (double)do_aspawn(st[1],arglast);
  1401.     else if (arglast[2] - arglast[1] != 1)
  1402.         value = (double)do_aspawn(Nullstr,arglast);
  1403.     else {
  1404.         value = (double)do_spawn(str_get(str_static(st[2])));
  1405.     }
  1406.     goto donumset;
  1407.     case O_EXEC_OP:
  1408.     if ((arg[1].arg_type & A_MASK) == A_STAB)
  1409.         value = (double)do_aexec(st[1],arglast);
  1410.     else if (arglast[2] - arglast[1] != 1)
  1411.         value = (double)do_aexec(Nullstr,arglast);
  1412.     else {
  1413.         value = (double)do_exec(str_get(str_static(st[2])));
  1414.     }
  1415.     goto donumset;
  1416.     case O_HEX:
  1417.     argtype = 4;
  1418.     goto snarfnum;
  1419.  
  1420.     case O_OCT:
  1421.     argtype = 3;
  1422.  
  1423.       snarfnum:
  1424.     tmplong = 0;
  1425.     if (maxarg < 1)
  1426.         tmps = str_get(stab_val(defstab));
  1427.     else
  1428.         tmps = str_get(st[1]);
  1429.     for (;;) {
  1430.         switch (*tmps) {
  1431.         default:
  1432.         goto out;
  1433.         case '8': case '9':
  1434.         if (argtype != 4)
  1435.             goto out;
  1436.         /* FALL THROUGH */
  1437.         case '0': case '1': case '2': case '3': case '4':
  1438.         case '5': case '6': case '7':
  1439.         tmplong <<= argtype;
  1440.         tmplong += *tmps++ & 15L;
  1441.         break;
  1442.         case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
  1443.         case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
  1444.         if (argtype != 4)
  1445.             goto out;
  1446.         tmplong <<= 4;
  1447.         tmplong += (*tmps++ & 7L) + 9L;
  1448.         break;
  1449.         case 'x':
  1450.         argtype = 4;
  1451.         tmps++;
  1452.         break;
  1453.         }
  1454.     }
  1455.       out:
  1456.     value = (double)tmplong;
  1457.     goto donumset;
  1458.     case O_UNLINK:
  1459.     value = (double)do_unlink(arglast);
  1460.     goto donumset;
  1461.     case O_RENAME:
  1462.     tmps = str_get(st[1]);
  1463.     tmps2 = str_get(st[2]);
  1464. #ifdef TAINT
  1465.     taintproper("Insecure dependency in rename");
  1466. #endif
  1467.     value = (double)(rename(tmps,tmps2) >= 0);
  1468.     goto donumset;
  1469.     case O_MKDIR:
  1470.     if (maxarg < 1)
  1471.         tmps = str_get(stab_val(defstab));
  1472.     else
  1473.         tmps = str_get(st[1]);
  1474. #ifdef TAINT
  1475.     taintproper("Insecure dependency in mkdir");
  1476. #endif
  1477.     value = (double)(mkdir(tmps) >= 0);
  1478.     goto donumset;
  1479.     case O_RMDIR:
  1480.     if (maxarg < 1)
  1481.         tmps = str_get(stab_val(defstab));
  1482.     else
  1483.         tmps = str_get(st[1]);
  1484. #ifdef TAINT
  1485.     taintproper("Insecure dependency in rmdir");
  1486. #endif
  1487.     value = (double)(rmdir(tmps) >= 0);
  1488.     goto donumset;
  1489.     case O_UNSHIFT:
  1490.     ary = stab_array(arg[1].arg_ptr.arg_stab);
  1491.     if (arglast[2] - arglast[1] != 1)
  1492.         do_unshift(ary,arglast);
  1493.     else {
  1494.         STR *tmpstr = Str_new(52,0);    /* must copy the STR */
  1495.         str_sset(tmpstr,st[2]);
  1496.         aunshift(ary,1);
  1497.         (void)astore(ary,0,tmpstr);
  1498.     }
  1499.     value = (double)(ary->ary_fill + 1);
  1500.     goto donumset;
  1501.  
  1502.     case O_REQUIRE:
  1503.     case O_DOFILE:
  1504.     case O_EVAL:
  1505.     if (maxarg < 1)
  1506.         tmpstr = stab_val(defstab);
  1507.     else
  1508.         tmpstr =
  1509.           (arg[1].arg_type & A_MASK) != A_NULL ? st[1] : stab_val(defstab);
  1510. #ifdef TAINT
  1511.     tainted |= tmpstr->str_tainted;
  1512.     taintproper("Insecure dependency in eval");
  1513. #endif
  1514.     sp = do_eval(tmpstr, optype, curcmd->c_stash,
  1515.         gimme,arglast);
  1516.     goto array_return;
  1517.  
  1518.     case O_FTREAD:
  1519.     anum = S_READ;
  1520.     goto check_attr;
  1521.     case O_FTWRITE:
  1522.     anum = S_WRITE;
  1523.     goto check_attr;
  1524.     case O_FTLOCK:
  1525.     anum = S_LOCK;
  1526.     goto check_attr;
  1527.     case O_FTPREAD:
  1528.     anum = S_PREAD;
  1529.     goto check_attr;
  1530.     case O_FTPWRITE:
  1531.     anum = S_PWRITE;
  1532.       check_attr:
  1533.     if (mystat(arg,st[1]) < 0)
  1534.         goto say_undef;
  1535.     if (anum & statcache.st_attr)
  1536.         goto say_yes;
  1537.     goto say_no;
  1538.     case O_FTIS:
  1539.     if (mystat(arg,st[1]) < 0)
  1540.         goto say_undef;
  1541.     goto say_yes;
  1542.     case O_FTZERO:
  1543.     if (mystat(arg,st[1]) < 0)
  1544.         goto say_undef;
  1545.     if (!statcache.st_length)
  1546.         goto say_yes;
  1547.     goto say_no;
  1548.     case O_FTSIZE:
  1549.     if (mystat(arg,st[1]) < 0)
  1550.         goto say_undef;
  1551.     value = (double)statcache.st_length;
  1552.     goto donumset;
  1553.     case O_FTTIME:
  1554.     if (mystat(arg,st[1]) < 0)
  1555.         goto say_undef;
  1556.     value = (basetime - statcache.st_time) / 8640000.0;
  1557.     goto donumset;
  1558.     case O_FTFILE:
  1559.     anum = T_FILE;
  1560.     goto check_file_type;
  1561.     case O_FTDIR:
  1562.     anum = T_DIRECTORY;
  1563.       check_file_type:
  1564.     if (mystat(arg,st[1]) < 0)
  1565.         goto say_undef;
  1566.     if (statcache.st_type == anum)
  1567.         goto say_yes;
  1568.     goto say_no;
  1569.     case O_FTTTY:
  1570.     if (arg[1].arg_type & A_DONT) {
  1571.         stab = arg[1].arg_ptr.arg_stab;
  1572.         tmps = "";
  1573.     }
  1574.     else
  1575.         stab = stabent(tmps = str_get(st[1]),FALSE);
  1576.     if (stab && stab_io(stab) && stab_io(stab)->ifp)
  1577.         fp = stab_io(stab)->ifp;
  1578.     else if (isdigit(*tmps)) {
  1579.         anum = atoi(tmps);
  1580.         switch (anum)
  1581.         {
  1582.         case 0:  fp = stdin;  break;
  1583.         case 1:  fp = stdout; break;
  1584.         case 2:  fp = stderr; break;
  1585.         default: goto say_undef;
  1586.         }
  1587.     }
  1588.     else
  1589.         goto say_undef;
  1590.     if (isatty(fp))
  1591.         goto say_yes;
  1592.     goto say_no;
  1593.     case O_FTTEXT:
  1594.     case O_FTBINARY:
  1595.     str = do_fttext(arg,st[1]);
  1596.     break;
  1597.     case O_VEC:
  1598.     sp = do_vec(str == st[1], arg->arg_ptr.arg_str, arglast);
  1599.     goto array_return;
  1600.     case O_OPENDIR:
  1601.     case O_READDIR:
  1602.     case O_TELLDIR:
  1603.     case O_SEEKDIR:
  1604.     case O_REWINDDIR:
  1605.     case O_CLOSEDIR:
  1606.     if (maxarg < 1)
  1607.         goto say_undef;
  1608.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1609.         stab = arg[1].arg_ptr.arg_stab;
  1610.     else
  1611.         stab = stabent(str_get(st[1]),TRUE);
  1612.     if (!stab)
  1613.         goto say_undef;
  1614.     sp = do_dirop(optype,stab,gimme,arglast);
  1615.     goto array_return;
  1616.     case O_SYSCALL:
  1617.     str = do_syscall(arglast);
  1618.     if (!str)
  1619.         goto say_undef;
  1620.     break;
  1621.     }
  1622.  
  1623.   normal_return:
  1624.     st[1] = str;
  1625. #ifdef DEBUGGING
  1626.     if (debug) {
  1627.     dlevel--;
  1628.     if (debug & 8)
  1629.         deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str));
  1630.     }
  1631. #endif
  1632.     return arglast[0] + 1;
  1633.  
  1634. array_return:
  1635. #ifdef DEBUGGING
  1636.     if (debug) {
  1637.     dlevel--;
  1638.     if (debug & 8) {
  1639.         anum = sp - arglast[0];
  1640.         switch (anum) {
  1641.         case 0:
  1642.         deb("%s RETURNS ()\n",opname[optype]);
  1643.         break;
  1644.         case 1:
  1645.         deb("%s RETURNS (\"%s\")\n",opname[optype],str_get(st[1]));
  1646.         break;
  1647.         default:
  1648.         tmps = str_get(st[1]);
  1649.         deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\")\n",opname[optype],
  1650.           anum,tmps,anum==2?"":"...,",str_get(st[anum]));
  1651.         break;
  1652.         }
  1653.     }
  1654.     }
  1655. #endif
  1656.     return sp;
  1657.  
  1658. say_yes:
  1659.     str = &str_yes;
  1660.     goto normal_return;
  1661.  
  1662. say_no:
  1663.     str = &str_no;
  1664.     goto normal_return;
  1665.  
  1666. say_undef:
  1667.     str = &str_undef;
  1668.     goto normal_return;
  1669.  
  1670. say_zero:
  1671.     value = 0.0;
  1672.     /* FALL THROUGH */
  1673.  
  1674. donumset:
  1675.     str_numset(str,value);
  1676.     STABSET(str);
  1677.     st[1] = str;
  1678. #ifdef DEBUGGING
  1679.     if (debug) {
  1680.     dlevel--;
  1681.     if (debug & 8)
  1682.         deb("%s RETURNS \"%f\"\n",opname[optype],value);
  1683.     }
  1684. #endif
  1685.     return arglast[0] + 1;
  1686. }
  1687.