X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=eval.c;h=82b7a8bf894538e1a9c62cb56e4a6c1ae048e3f9;hb=8adcabd8d9cf3c71e660c45cb7165ae4694308d4;hp=03518a8bb4c7f320beab39896b797bf0df3411b9;hpb=afd9f252e30d37007c653bd21680f0b5f6c32608;p=p5sagit%2Fp5-mst-13.2.git diff --git a/eval.c b/eval.c index 03518a8..82b7a8b 100644 --- a/eval.c +++ b/eval.c @@ -1,47 +1,67 @@ -/* $Header: eval.c,v 3.0.1.4 90/02/28 17:36:59 lwall Locked $ +/* $RCSfile: eval.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 13:20:20 $ * - * Copyright (c) 1989, Larry Wall + * Copyright (c) 1991, Larry Wall * - * You may distribute under the terms of the GNU General Public License - * as specified in the README file that comes with the perl 3.0 kit. + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. * * $Log: eval.c,v $ - * Revision 3.0.1.4 90/02/28 17:36:59 lwall - * patch9: added pipe function - * patch9: a return in scalar context wouldn't return array - * patch9: !~ now always returns scalar even in array context - * patch9: some machines can't cast float to long with high bit set - * patch9: piped opens returned undef in child - * patch9: @array in scalar context now returns length of array - * patch9: chdir; coredumped - * patch9: wait no longer ignores signals - * patch9: mkdir now handles odd versions of /bin/mkdir - * patch9: -l FILEHANDLE now disallowed + * Revision 4.0.1.4 92/06/08 13:20:20 lwall + * patch20: added explicit time_t support + * patch20: fixed confusion between a *var's real name and its effective name + * patch20: added Atari ST portability + * patch20: new warning for use of x with non-numeric right operand + * patch20: modulus with highest bit in left operand set didn't always work + * patch20: dbmclose(%array) didn't work + * patch20: added ... as variant on .. + * patch20: O_PIPE conflicted with Atari * - * Revision 3.0.1.3 89/12/21 20:03:05 lwall - * patch7: errno may now be a macro with an lvalue - * patch7: ANSI strerror() is now supported - * patch7: send() didn't allow a TO argument - * patch7: ord() now always returns positive even on signed char machines + * Revision 4.0.1.3 91/11/05 17:15:21 lwall + * patch11: prepared for ctype implementations that don't define isascii() + * patch11: various portability fixes + * patch11: added sort {} LIST + * patch11: added eval {} + * patch11: sysread() in socket was substituting recv() + * patch11: a last statement outside any block caused occasional core dumps + * patch11: missing arguments caused core dump in -D8 code + * patch11: eval 'stuff' now optimized to eval {stuff} * - * Revision 3.0.1.2 89/11/17 15:19:34 lwall - * patch5: constant numeric subscripts get lost inside ?: + * Revision 4.0.1.2 91/06/07 11:07:23 lwall + * patch4: new copyright notice + * patch4: length($`), length($&), length($') now optimized to avoid string copy + * patch4: assignment wasn't correctly de-tainting the assigned variable. + * patch4: default top-of-form format is now FILEHANDLE_TOP + * patch4: added $^P variable to control calling of perldb routines + * patch4: taintchecks could improperly modify parent in vfork() + * patch4: many, many itty-bitty portability fixes * - * Revision 3.0.1.1 89/11/11 04:31:51 lwall - * patch2: mkdir and rmdir needed to quote argument when passed to shell - * patch2: mkdir and rmdir now return better error codes - * patch2: fileno, seekdir, rewinddir and closedir now disallow defaults + * Revision 4.0.1.1 91/04/11 17:43:48 lwall + * patch1: fixed failed fork to return undef as documented + * patch1: reduced maximum branch distance in eval.c * - * Revision 3.0 89/10/18 15:17:04 lwall - * 3.0 baseline + * Revision 4.0 91/03/20 01:16:48 lwall + * 4.0 baseline. * */ #include "EXTERN.h" #include "perl.h" +#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) #include +#endif +#ifdef I_FCNTL +#include +#endif +#ifdef MSDOS +/* I_FCNTL *MUST* not be defined for MS-DOS and OS/2 + but fcntl.h is required for O_BINARY */ +#include +#endif +#ifdef I_SYS_FILE +#include +#endif #ifdef I_VFORK # include #endif @@ -59,8 +79,8 @@ STR str_args; static STAB *stab2; static STIO *stio; static struct lstring *lstr; -static char old_record_separator; -extern int wantarray; +static int old_rschar; +static int old_rslen; double sin(), cos(), atan2(), pow(); @@ -84,8 +104,10 @@ register int sp; int argtype; union argptr argptr; int arglast[8]; /* highest sp for arg--valid only for non-O_LIST args */ - unsigned long tmplong; - long when; + unsigned long tmpulong; + long tmplong; + time_t when; + STRLEN tmplen; FILE *fp; STR *tmpstr; FCMD *form; @@ -118,9 +140,433 @@ register int sp; } #endif -#include "evalargs.xc" + for (anum = 1; anum <= maxarg; anum++) { + argflags = arg[anum].arg_flags; + argtype = arg[anum].arg_type; + argptr = arg[anum].arg_ptr; + re_eval: + switch (argtype) { + default: + st[++sp] = &str_undef; +#ifdef DEBUGGING + tmps = "NULL"; +#endif + break; + case A_EXPR: +#ifdef DEBUGGING + if (debug & 8) { + tmps = "EXPR"; + deb("%d.EXPR =>\n",anum); + } +#endif + sp = eval(argptr.arg_arg, + (argflags & AF_ARYOK) ? G_ARRAY : G_SCALAR, sp); + if (sp + (maxarg - anum) > stack->ary_max) + astore(stack, sp + (maxarg - anum), Nullstr); + st = stack->ary_array; /* possibly reallocated */ + break; + case A_CMD: +#ifdef DEBUGGING + if (debug & 8) { + tmps = "CMD"; + deb("%d.CMD (%lx) =>\n",anum,argptr.arg_cmd); + } +#endif + sp = cmd_exec(argptr.arg_cmd, gimme, sp); + if (sp + (maxarg - anum) > stack->ary_max) + astore(stack, sp + (maxarg - anum), Nullstr); + st = stack->ary_array; /* possibly reallocated */ + break; + case A_LARYSTAB: + ++sp; + switch (optype) { + case O_ITEM2: argtype = 2; break; + case O_ITEM3: argtype = 3; break; + default: argtype = anum; break; + } + str = afetch(stab_array(argptr.arg_stab), + arg[argtype].arg_len - arybase, TRUE); +#ifdef DEBUGGING + if (debug & 8) { + (void)sprintf(buf,"LARYSTAB $%s[%d]",stab_name(argptr.arg_stab), + arg[argtype].arg_len); + tmps = buf; + } +#endif + goto do_crement; + case A_ARYSTAB: + switch (optype) { + case O_ITEM2: argtype = 2; break; + case O_ITEM3: argtype = 3; break; + default: argtype = anum; break; + } + st[++sp] = afetch(stab_array(argptr.arg_stab), + arg[argtype].arg_len - arybase, FALSE); +#ifdef DEBUGGING + if (debug & 8) { + (void)sprintf(buf,"ARYSTAB $%s[%d]",stab_name(argptr.arg_stab), + arg[argtype].arg_len); + tmps = buf; + } +#endif + break; + case A_STAR: + stab = argptr.arg_stab; + st[++sp] = (STR*)stab; + if (!stab_xarray(stab)) + aadd(stab); + if (!stab_xhash(stab)) + hadd(stab); + if (!stab_io(stab)) + stab_io(stab) = stio_new(); +#ifdef DEBUGGING + if (debug & 8) { + (void)sprintf(buf,"STAR *%s -> *%s", + stab_name(argptr.arg_stab), stab_ename(argptr.arg_stab)); + tmps = buf; + } +#endif + break; + case A_LSTAR: + str = st[++sp] = (STR*)argptr.arg_stab; +#ifdef DEBUGGING + if (debug & 8) { + (void)sprintf(buf,"LSTAR *%s -> *%s", + stab_name(argptr.arg_stab), stab_ename(argptr.arg_stab)); + tmps = buf; + } +#endif + break; + case A_STAB: + st[++sp] = STAB_STR(argptr.arg_stab); +#ifdef DEBUGGING + if (debug & 8) { + (void)sprintf(buf,"STAB $%s",stab_name(argptr.arg_stab)); + tmps = buf; + } +#endif + break; + case A_LENSTAB: + str_numset(str, (double)STAB_LEN(argptr.arg_stab)); + st[++sp] = str; +#ifdef DEBUGGING + if (debug & 8) { + (void)sprintf(buf,"LENSTAB $%s",stab_name(argptr.arg_stab)); + tmps = buf; + } +#endif + break; + case A_LEXPR: +#ifdef DEBUGGING + if (debug & 8) { + tmps = "LEXPR"; + deb("%d.LEXPR =>\n",anum); + } +#endif + if (argflags & AF_ARYOK) { + sp = eval(argptr.arg_arg, G_ARRAY, sp); + if (sp + (maxarg - anum) > stack->ary_max) + astore(stack, sp + (maxarg - anum), Nullstr); + st = stack->ary_array; /* possibly reallocated */ + } + else { + sp = eval(argptr.arg_arg, G_SCALAR, sp); + st = stack->ary_array; /* possibly reallocated */ + str = st[sp]; + goto do_crement; + } + break; + case A_LVAL: +#ifdef DEBUGGING + if (debug & 8) { + (void)sprintf(buf,"LVAL $%s",stab_name(argptr.arg_stab)); + tmps = buf; + } +#endif + ++sp; + str = STAB_STR(argptr.arg_stab); + if (!str) + fatal("panic: A_LVAL"); + do_crement: + assigning = TRUE; + if (argflags & AF_PRE) { + if (argflags & AF_UP) + str_inc(str); + else + str_dec(str); + STABSET(str); + st[sp] = str; + str = arg->arg_ptr.arg_str; + } + else if (argflags & AF_POST) { + st[sp] = str_mortal(str); + if (argflags & AF_UP) + str_inc(str); + else + str_dec(str); + STABSET(str); + str = arg->arg_ptr.arg_str; + } + else + st[sp] = str; + break; + case A_LARYLEN: + ++sp; + stab = argptr.arg_stab; + str = stab_array(argptr.arg_stab)->ary_magic; + if (optype != O_SASSIGN || argflags & (AF_PRE|AF_POST)) + str_numset(str,(double)(stab_array(stab)->ary_fill+arybase)); +#ifdef DEBUGGING + tmps = "LARYLEN"; +#endif + if (!str) + fatal("panic: A_LEXPR"); + goto do_crement; + case A_ARYLEN: + stab = argptr.arg_stab; + st[++sp] = stab_array(stab)->ary_magic; + str_numset(st[sp],(double)(stab_array(stab)->ary_fill+arybase)); +#ifdef DEBUGGING + tmps = "ARYLEN"; +#endif + break; + case A_SINGLE: + st[++sp] = argptr.arg_str; +#ifdef DEBUGGING + tmps = "SINGLE"; +#endif + break; + case A_DOUBLE: + (void) interp(str,argptr.arg_str,sp); + st = stack->ary_array; + st[++sp] = str; +#ifdef DEBUGGING + tmps = "DOUBLE"; +#endif + break; + case A_BACKTICK: + tmps = str_get(interp(str,argptr.arg_str,sp)); + st = stack->ary_array; +#ifdef TAINT + taintproper("Insecure dependency in ``"); +#endif + fp = mypopen(tmps,"r"); + str_set(str,""); + if (fp) { + if (gimme == G_SCALAR) { + while (str_gets(str,fp,str->str_cur) != Nullch) + /*SUPPRESS 530*/ + ; + } + else { + for (;;) { + if (++sp > stack->ary_max) { + astore(stack, sp, Nullstr); + st = stack->ary_array; + } + str = st[sp] = Str_new(56,80); + if (str_gets(str,fp,0) == Nullch) { + sp--; + break; + } + if (str->str_len - str->str_cur > 20) { + str->str_len = str->str_cur+1; + Renew(str->str_ptr, str->str_len, char); + } + str_2mortal(str); + } + } + statusvalue = mypclose(fp); + } + else + statusvalue = -1; + + if (gimme == G_SCALAR) + st[++sp] = str; +#ifdef DEBUGGING + tmps = "BACK"; +#endif + break; + case A_WANTARRAY: + { + if (curcsv->wantarray == G_ARRAY) + st[++sp] = &str_yes; + else + st[++sp] = &str_no; + } +#ifdef DEBUGGING + tmps = "WANTARRAY"; +#endif + break; + case A_INDREAD: + last_in_stab = stabent(str_get(STAB_STR(argptr.arg_stab)),TRUE); + old_rschar = rschar; + old_rslen = rslen; + goto do_read; + case A_GLOB: + argflags |= AF_POST; /* enable newline chopping */ + last_in_stab = argptr.arg_stab; + old_rschar = rschar; + old_rslen = rslen; + rslen = 1; +#ifdef DOSISH + rschar = 0; +#else +#ifdef CSH + rschar = 0; +#else + rschar = '\n'; +#endif /* !CSH */ +#endif /* !MSDOS */ + goto do_read; + case A_READ: + last_in_stab = argptr.arg_stab; + old_rschar = rschar; + old_rslen = rslen; + do_read: + if (anum > 1) /* assign to scalar */ + gimme = G_SCALAR; /* force context to scalar */ + if (gimme == G_ARRAY) + str = Str_new(57,0); + ++sp; + fp = Nullfp; + if (stab_io(last_in_stab)) { + fp = stab_io(last_in_stab)->ifp; + if (!fp) { + if (stab_io(last_in_stab)->flags & IOF_ARGV) { + if (stab_io(last_in_stab)->flags & IOF_START) { + stab_io(last_in_stab)->flags &= ~IOF_START; + stab_io(last_in_stab)->lines = 0; + if (alen(stab_array(last_in_stab)) < 0) { + tmpstr = str_make("-",1); /* assume stdin */ + (void)apush(stab_array(last_in_stab), tmpstr); + } + } + fp = nextargv(last_in_stab); + if (!fp) { /* Note: fp != stab_io(last_in_stab)->ifp */ + (void)do_close(last_in_stab,FALSE); /* now it does*/ + stab_io(last_in_stab)->flags |= IOF_START; + } + } + else if (argtype == A_GLOB) { + (void) interp(str,stab_val(last_in_stab),sp); + st = stack->ary_array; + tmpstr = Str_new(55,0); +#ifdef DOSISH + str_set(tmpstr, "perlglob "); + str_scat(tmpstr,str); + str_cat(tmpstr," |"); +#else +#ifdef CSH + str_nset(tmpstr,cshname,cshlen); + str_cat(tmpstr," -cf 'set nonomatch; glob "); + str_scat(tmpstr,str); + str_cat(tmpstr,"'|"); +#else + str_set(tmpstr, "echo "); + str_scat(tmpstr,str); + str_cat(tmpstr, + "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|"); +#endif /* !CSH */ +#endif /* !MSDOS */ + (void)do_open(last_in_stab,tmpstr->str_ptr, + tmpstr->str_cur); + fp = stab_io(last_in_stab)->ifp; + str_free(tmpstr); + } + } + } + if (!fp && dowarn) + warn("Read on closed filehandle <%s>",stab_ename(last_in_stab)); + tmplen = str->str_len; /* remember if already alloced */ + if (!tmplen) + Str_Grow(str,80); /* try short-buffering it */ + keepgoing: + if (!fp) + st[sp] = &str_undef; + else if (!str_gets(str,fp, optype == O_RCAT ? str->str_cur : 0)) { + clearerr(fp); + if (stab_io(last_in_stab)->flags & IOF_ARGV) { + fp = nextargv(last_in_stab); + if (fp) + goto keepgoing; + (void)do_close(last_in_stab,FALSE); + stab_io(last_in_stab)->flags |= IOF_START; + } + else if (argflags & AF_POST) { + (void)do_close(last_in_stab,FALSE); + } + st[sp] = &str_undef; + rschar = old_rschar; + rslen = old_rslen; + if (gimme == G_ARRAY) { + --sp; + str_2mortal(str); + goto array_return; + } + break; + } + else { + stab_io(last_in_stab)->lines++; + st[sp] = str; +#ifdef TAINT + str->str_tainted = 1; /* Anything from the outside world...*/ +#endif + if (argflags & AF_POST) { + if (str->str_cur > 0) + str->str_cur--; + if (str->str_ptr[str->str_cur] == rschar) + str->str_ptr[str->str_cur] = '\0'; + else + str->str_cur++; + for (tmps = str->str_ptr; *tmps; tmps++) + if (!isALPHA(*tmps) && !isDIGIT(*tmps) && + index("$&*(){}[]'\";\\|?<>~`",*tmps)) + break; + if (*tmps && stat(str->str_ptr,&statbuf) < 0) + goto keepgoing; /* unmatched wildcard? */ + } + if (gimme == G_ARRAY) { + if (str->str_len - str->str_cur > 20) { + str->str_len = str->str_cur+1; + Renew(str->str_ptr, str->str_len, char); + } + str_2mortal(str); + if (++sp > stack->ary_max) { + astore(stack, sp, Nullstr); + st = stack->ary_array; + } + str = Str_new(58,80); + goto keepgoing; + } + else if (!tmplen && str->str_len - str->str_cur > 80) { + /* try to reclaim a bit of scalar space on 1st alloc */ + if (str->str_cur < 60) + str->str_len = 80; + else + str->str_len = str->str_cur+40; /* allow some slop */ + Renew(str->str_ptr, str->str_len, char); + } + } + rschar = old_rschar; + rslen = old_rslen; +#ifdef DEBUGGING + tmps = "READ"; +#endif + break; + } +#ifdef DEBUGGING + if (debug & 8) + deb("%d.%s = '%s'\n",anum,tmps,str_peek(st[sp])); +#endif + if (anum < 8) + arglast[anum] = sp; + } st += arglast[0]; +#ifdef SMALLSWITCHES + if (optype < O_CHOWN) +#endif switch (optype) { case O_RCAT: STABSET(str); @@ -128,6 +574,8 @@ register int sp; case O_ITEM: if (gimme == G_ARRAY) goto array_return; + /* FALL THROUGH */ + case O_SCALAR: STR_SSET(str,st[1]); STABSET(str); break; @@ -151,18 +599,29 @@ register int sp; STABSET(str); break; case O_REPEAT: + if (gimme == G_ARRAY && arg[1].arg_flags & AF_ARYOK) { + sp = do_repeatary(arglast); + goto array_return; + } STR_SSET(str,st[1]); anum = (int)str_gnum(st[2]); if (anum >= 1) { tmpstr = Str_new(50, 0); - str_sset(tmpstr,str); + tmps = str_get(str); + str_nset(tmpstr,tmps,str->str_cur); tmps = str_get(tmpstr); /* force to be string */ STR_GROW(str, (anum * str->str_cur) + 1); repeatcpy(str->str_ptr, tmps, tmpstr->str_cur, anum); - str->str_cur *= anum; str->str_ptr[str->str_cur] = '\0'; + str->str_cur *= anum; + str->str_ptr[str->str_cur] = '\0'; + str->str_nok = 0; + str_free(tmpstr); } - else + else { + if (dowarn && st[2]->str_pok && !looks_like_number(st[2])) + warn("Right operand of x is not numeric"); str_sset(str,&str_no); + } STABSET(str); break; case O_MATCH: @@ -212,6 +671,10 @@ register int sp; goto array_return; case O_SASSIGN: sassign: +#ifdef TAINT + if (tainted && !st[2]->str_tainted) + tainted = 0; +#endif STR_SSET(str, st[2]); STABSET(str); break; @@ -238,6 +701,13 @@ register int sp; goto array_return; } else if (str != stab_val(defstab)) { + if (str->str_len) { + if (str->str_state == SS_INCR) + Str_Grow(str,0); + Safefree(str->str_ptr); + str->str_ptr = Nullch; + str->str_len = 0; + } str->str_pok = str->str_nok = 0; STABSET(str); } @@ -255,20 +725,38 @@ register int sp; value *= str_gnum(st[2]); goto donumset; case O_DIVIDE: - if ((value = str_gnum(st[2])) == 0.0) - fatal("Illegal division by zero"); + if ((value = str_gnum(st[2])) == 0.0) + fatal("Illegal division by zero"); +#ifdef SLOPPYDIVIDE + /* insure that 20./5. == 4. */ + { + double x; + int k; + x = str_gnum(st[1]); + if ((double)(int)x == x && + (double)(int)value == value && + (k = (int)x/(int)value)*(int)value == (int)x) { + value = k; + } else { + value = x/value; + } + } +#else value = str_gnum(st[1]) / value; +#endif goto donumset; case O_MODULO: - tmplong = (long) str_gnum(st[2]); - if (tmplong == 0L) + tmpulong = (unsigned long) str_gnum(st[2]); + if (tmpulong == 0L) fatal("Illegal modulus zero"); - when = (long)str_gnum(st[1]); #ifndef lint - if (when >= 0) - value = (double)(when % tmplong); - else - value = (double)(tmplong - (-when % tmplong)); + value = str_gnum(st[1]); + if (value >= 0.0) + value = (double)(((unsigned long)value) % tmpulong); + else { + tmplong = (long)value; + value = (double)(tmpulong - ((-tmplong - 1) % tmpulong)) - 1; + } #endif goto donumset; case O_ADD: @@ -283,14 +771,14 @@ register int sp; value = str_gnum(st[1]); anum = (int)str_gnum(st[2]); #ifndef lint - value = (double)(((unsigned long)value) << anum); + value = (double)(U_L(value) << anum); #endif goto donumset; case O_RIGHT_SHIFT: value = str_gnum(st[1]); anum = (int)str_gnum(st[2]); #ifndef lint - value = (double)(((unsigned long)value) >> anum); + value = (double)(U_L(value) >> anum); #endif goto donumset; case O_LT: @@ -322,12 +810,19 @@ register int sp; value = str_gnum(st[1]); value = (value != str_gnum(st[2])) ? 1.0 : 0.0; goto donumset; + case O_NCMP: + value = str_gnum(st[1]); + value -= str_gnum(st[2]); + if (value > 0.0) + value = 1.0; + else if (value < 0.0) + value = -1.0; + goto donumset; case O_BIT_AND: if (!sawvec || st[1]->str_nok || st[2]->str_nok) { value = str_gnum(st[1]); #ifndef lint - value = (double)(((unsigned long)value) & - (unsigned long)str_gnum(st[2])); + value = (double)(U_L(value) & U_L(str_gnum(st[2]))); #endif goto donumset; } @@ -338,8 +833,7 @@ register int sp; if (!sawvec || st[1]->str_nok || st[2]->str_nok) { value = str_gnum(st[1]); #ifndef lint - value = (double)(((unsigned long)value) ^ - (unsigned long)str_gnum(st[2])); + value = (double)(U_L(value) ^ U_L(str_gnum(st[2]))); #endif goto donumset; } @@ -350,8 +844,7 @@ register int sp; if (!sawvec || st[1]->str_nok || st[2]->str_nok) { value = str_gnum(st[1]); #ifndef lint - value = (double)(((unsigned long)value) | - (unsigned long)str_gnum(st[2])); + value = (double)(U_L(value) | U_L(str_gnum(st[2]))); #endif goto donumset; } @@ -426,15 +919,28 @@ register int sp; value = -str_gnum(st[1]); goto donumset; case O_NOT: +#ifdef NOTNOT + { char xxx = str_true(st[1]); value = (double) !xxx; } +#else value = (double) !str_true(st[1]); +#endif goto donumset; case O_COMPLEMENT: + if (!sawvec || st[1]->str_nok) { #ifndef lint - value = (double) ~(unsigned long)str_gnum(st[1]); + value = (double) ~U_L(str_gnum(st[1])); #endif - goto donumset; + goto donumset; + } + else { + STR_SSET(str,st[1]); + tmps = str_get(str); + for (anum = str->str_cur; anum; anum--, tmps++) + *tmps = ~*tmps; + } + break; case O_SELECT: - tmps = stab_name(defoutstab); + stab_efullname(str,defoutstab); if (maxarg > 0) { if ((arg[1].arg_type & A_MASK) == A_WORD) defoutstab = arg[1].arg_ptr.arg_stab; @@ -444,7 +950,6 @@ register int sp; stab_io(defoutstab) = stio_new(); curoutstab = defoutstab; } - str_set(str, tmps); STABSET(str); break; case O_WRITE: @@ -484,7 +989,7 @@ register int sp; break; } format(&outrec,form,sp); - do_write(&outrec,stab_io(stab),sp); + do_write(&outrec,stab,sp); if (stab_io(stab)->flags & IOF_FLUSH) (void)fflush(fp); str_set(str, Yes); @@ -492,11 +997,15 @@ register int sp; break; case O_DBMOPEN: #ifdef SOME_DBM - if ((arg[1].arg_type & A_MASK) == A_WORD) + anum = arg[1].arg_type & A_MASK; + if (anum == A_WORD || anum == A_STAB) stab = arg[1].arg_ptr.arg_stab; else stab = stabent(str_get(st[1]),TRUE); - anum = (int)str_gnum(st[3]); + if (st[3]->str_nok || st[3]->str_pok) + anum = (int)str_gnum(st[3]); + else + anum = -1; value = (double)hdbmopen(stab_hash(stab),str_get(st[2]),anum); goto donumset; #else @@ -504,7 +1013,8 @@ register int sp; #endif case O_DBMCLOSE: #ifdef SOME_DBM - if ((arg[1].arg_type & A_MASK) == A_WORD) + anum = arg[1].arg_type & A_MASK; + if (anum == A_WORD || anum == A_STAB) stab = arg[1].arg_ptr.arg_stab; else stab = stabent(str_get(st[1]),TRUE); @@ -528,7 +1038,7 @@ register int sp; goto say_zero; else goto say_undef; - break; + /* break; */ case O_TRANS: value = (double) do_trans(str,arg); str = arg->arg_ptr.arg_str; @@ -571,7 +1081,8 @@ register int sp; astore(stack,sp + maxarg, Nullstr); st = stack->ary_array; } - Copy(ary->ary_array, &st[sp+1], maxarg, STR*); + st += sp; + Copy(ary->ary_array, &st[1], maxarg, STR*); sp += maxarg; goto array_return; } @@ -582,15 +1093,13 @@ register int sp; case O_AELEM: anum = ((int)str_gnum(st[2])) - arybase; str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE); - if (!str) - goto say_undef; break; case O_DELETE: tmpstab = arg[1].arg_ptr.arg_stab; tmps = str_get(st[2]); str = hdelete(stab_hash(tmpstab),tmps,st[2]->str_cur); if (tmpstab == envstab) - setenv(tmps,Nullch); + my_setenv(tmps,Nullch); if (!str) goto say_undef; break; @@ -607,6 +1116,8 @@ register int sp; } else { tmpstab = arg[1].arg_ptr.arg_stab; + if (!stab_hash(tmpstab)->tbl_fill) + goto say_zero; sprintf(buf,"%d/%d",stab_hash(tmpstab)->tbl_fill, stab_hash(tmpstab)->tbl_max+1); str_set(str,buf); @@ -616,13 +1127,11 @@ register int sp; tmpstab = arg[1].arg_ptr.arg_stab; tmps = str_get(st[2]); str = hfetch(stab_hash(tmpstab),tmps,st[2]->str_cur,FALSE); - if (!str) - goto say_undef; break; case O_LAELEM: anum = ((int)str_gnum(st[2])) - arybase; str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,TRUE); - if (!str) + if (!str || str == &str_undef) fatal("Assignment to non-creatable value, subscript %d",anum); break; case O_LHELEM: @@ -630,7 +1139,7 @@ register int sp; tmps = str_get(st[2]); anum = st[2]->str_cur; str = hfetch(stab_hash(tmpstab),tmps,anum,TRUE); - if (!str) + if (!str || str == &str_undef) fatal("Assignment to non-creatable value, subscript \"%s\"",tmps); if (tmpstab == envstab) /* heavy wizardry going on here */ str_magic(str, tmpstab, 'E', tmps, anum); /* str is now magic */ @@ -641,26 +1150,35 @@ register int sp; else if (stab_hash(tmpstab)->tbl_dbm) str_magic(str, tmpstab, 'D', tmps, anum); #endif + else if (tmpstab == DBline) + str_magic(str, tmpstab, 'L', tmps, anum); break; + case O_LSLICE: + anum = 2; + argtype = FALSE; + goto do_slice_already; case O_ASLICE: - anum = TRUE; + anum = 1; argtype = FALSE; goto do_slice_already; case O_HSLICE: - anum = FALSE; + anum = 0; argtype = FALSE; goto do_slice_already; case O_LASLICE: - anum = TRUE; + anum = 1; argtype = TRUE; goto do_slice_already; case O_LHSLICE: - anum = FALSE; + anum = 0; argtype = TRUE; do_slice_already: - sp = do_slice(arg[1].arg_ptr.arg_stab,anum,argtype, + sp = do_slice(arg[1].arg_ptr.arg_stab,str,anum,argtype, gimme,arglast); goto array_return; + case O_SPLICE: + sp = do_splice(stab_array(arg[1].arg_ptr.arg_stab),gimme,arglast); + goto array_return; case O_PUSH: if (arglast[2] - arglast[1] != 1) str = do_push(stab_array(arg[1].arg_ptr.arg_stab),arglast); @@ -679,7 +1197,7 @@ register int sp; if (!str) goto say_undef; if (ary->ary_flags & ARF_REAL) - (void)str_2static(str); + (void)str_2mortal(str); break; case O_UNPACK: sp = do_unpack(str,gimme,arglast); @@ -701,6 +1219,7 @@ register int sp; case O_SUBSTR: anum = ((int)str_gnum(st[2])) - arybase; /* anum=where to start*/ tmps = str_get(st[1]); /* force conversion to string */ + /*SUPPRESS 560*/ if (argtype = (str == st[1])) str = arg->arg_ptr.arg_str; if (anum < 0) @@ -708,7 +1227,7 @@ register int sp; if (anum < 0 || anum > st[1]->str_cur) str_nset(str,"",0); else { - optype = (int)str_gnum(st[3]); + optype = maxarg < 3 ? st[1]->str_cur : (int)str_gnum(st[3]); if (optype < 0) optype = 0; tmps += anum; @@ -726,6 +1245,7 @@ register int sp; } break; case O_PACK: + /*SUPPRESS 701*/ (void)do_pack(str,arglast); break; case O_GREP: @@ -758,32 +1278,36 @@ register int sp; tmps = str_get(st[1]); value = (double) !str_eq(st[1],st[2]); goto donumset; + case O_SCMP: + tmps = str_get(st[1]); + value = (double) str_cmp(st[1],st[2]); + goto donumset; case O_SUBR: sp = do_subr(arg,gimme,arglast); st = stack->ary_array + arglast[0]; /* maybe realloced */ goto array_return; case O_DBSUBR: - sp = do_dbsubr(arg,gimme,arglast); + sp = do_subr(arg,gimme,arglast); + st = stack->ary_array + arglast[0]; /* maybe realloced */ + goto array_return; + case O_CALLER: + sp = do_caller(arg,maxarg,gimme,arglast); st = stack->ary_array + arglast[0]; /* maybe realloced */ goto array_return; case O_SORT: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - if (!stab) - stab = defoutstab; - sp = do_sort(str,stab, + sp = do_sort(str,arg, gimme,arglast); goto array_return; case O_REVERSE: - sp = do_reverse(str, - gimme,arglast); + if (gimme == G_ARRAY) + sp = do_reverse(arglast); + else + sp = do_sreverse(str, arglast); goto array_return; case O_WARN: if (arglast[2] - arglast[1] != 1) { do_join(str,arglast); - tmps = str_get(st[1]); + tmps = str_get(str); } else { str = st[2]; @@ -796,14 +1320,14 @@ register int sp; case O_DIE: if (arglast[2] - arglast[1] != 1) { do_join(str,arglast); - tmps = str_get(st[1]); + tmps = str_get(str); } else { str = st[2]; tmps = str_get(st[2]); } if (!tmps || !*tmps) - exit(1); + tmps = "Died"; fatal("%s",tmps); goto say_zero; case O_PRTF: @@ -849,13 +1373,11 @@ register int sp; tmps = str_get(st[1]); if (!tmps || !*tmps) { tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE); - if (tmpstr) - tmps = str_get(tmpstr); + tmps = str_get(tmpstr); } if (!tmps || !*tmps) { tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE); - if (tmpstr) - tmps = str_get(tmpstr); + tmps = str_get(tmpstr); } #ifdef TAINT taintproper("Insecure dependency in chdir"); @@ -874,7 +1396,7 @@ register int sp; tmps = ""; else tmps = str_get(st[1]); - str_reset(tmps,arg[2].arg_ptr.arg_hash); + str_reset(tmps,curcmd->c_stash); value = 1.0; goto donumset; case O_LIST: @@ -902,8 +1424,10 @@ register int sp; stab = arg[1].arg_ptr.arg_stab; else stab = stabent(str_get(st[1]),TRUE); - if (do_eof(stab)) /* make sure we have fp with something */ - str_set(str, No); + if (!stab) + stab = argvstab; + if (!stab || do_eof(stab)) /* make sure we have fp with something */ + goto say_undef; else { #ifdef TAINT tainted = 1; @@ -928,21 +1452,28 @@ register int sp; goto donumset; case O_RECV: case O_READ: + case O_SYSREAD: if ((arg[1].arg_type & A_MASK) == A_WORD) stab = arg[1].arg_ptr.arg_stab; else stab = stabent(str_get(st[1]),TRUE); tmps = str_get(st[2]); anum = (int)str_gnum(st[3]); - STR_GROW(st[2], anum+1), (tmps = str_get(st[2])); /* sneaky */ errno = 0; + maxarg = sp - arglast[0]; + if (maxarg > 4) + warn("Too many args on read"); + if (maxarg == 4) + maxarg = (int)str_gnum(st[4]); + else + maxarg = 0; if (!stab_io(stab) || !stab_io(stab)->ifp) - goto say_zero; -#ifdef SOCKET - else if (optype == O_RECV) { + goto say_undef; +#ifdef HAS_SOCKET + if (optype == O_RECV) { argtype = sizeof buf; - optype = (int)str_gnum(st[4]); - anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, optype, + STR_GROW(st[2], anum+1), (tmps = str_get(st[2])); /* sneaky */ + anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, maxarg, buf, &argtype); if (anum >= 0) { st[2]->str_cur = anum; @@ -953,55 +1484,77 @@ register int sp; str_sset(str,&str_undef); break; } - else if (stab_io(stab)->type == 's') { - argtype = sizeof buf; - anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, 0, - buf, &argtype); - } #else - else if (optype == O_RECV) + if (optype == O_RECV) goto badsock; #endif + STR_GROW(st[2], anum+maxarg+1), (tmps = str_get(st[2])); /* sneaky */ + if (optype == O_SYSREAD) { + anum = read(fileno(stab_io(stab)->ifp), tmps+maxarg, anum); + } + else +#ifdef HAS_SOCKET + if (stab_io(stab)->type == 's') { + argtype = sizeof buf; + anum = recvfrom(fileno(stab_io(stab)->ifp), tmps+maxarg, anum, 0, + buf, &argtype); + } else - anum = fread(tmps, 1, anum, stab_io(stab)->ifp); +#endif + anum = fread(tmps+maxarg, 1, anum, stab_io(stab)->ifp); if (anum < 0) goto say_undef; - st[2]->str_cur = anum; - st[2]->str_ptr[anum] = '\0'; + st[2]->str_cur = anum+maxarg; + st[2]->str_ptr[anum+maxarg] = '\0'; value = (double)anum; goto donumset; + case O_SYSWRITE: case O_SEND: -#ifdef SOCKET if ((arg[1].arg_type & A_MASK) == A_WORD) stab = arg[1].arg_ptr.arg_stab; else stab = stabent(str_get(st[1]),TRUE); tmps = str_get(st[2]); anum = (int)str_gnum(st[3]); - optype = sp - arglast[0]; errno = 0; - if (optype > 4) - warn("Too many args on send"); stio = stab_io(stab); + maxarg = sp - arglast[0]; if (!stio || !stio->ifp) { anum = -1; - if (dowarn) - warn("Send on closed socket"); + if (dowarn) { + if (optype == O_SYSWRITE) + warn("Syswrite on closed filehandle"); + else + warn("Send on closed socket"); + } + } + else if (optype == O_SYSWRITE) { + if (maxarg > 4) + warn("Too many args on syswrite"); + if (maxarg == 4) + optype = (int)str_gnum(st[4]); + else + optype = 0; + anum = write(fileno(stab_io(stab)->ifp), tmps+optype, anum); } - else if (optype >= 4) { +#ifdef HAS_SOCKET + else if (maxarg >= 4) { + if (maxarg > 4) + warn("Too many args on send"); tmps2 = str_get(st[4]); anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum, tmps2, st[4]->str_cur); } else anum = send(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum); +#else + else + goto badsock; +#endif if (anum < 0) goto say_undef; value = (double)anum; goto donumset; -#else - goto badsock; -#endif case O_SEEK: if ((arg[1].arg_type & A_MASK) == A_WORD) stab = arg[1].arg_ptr.arg_stab; @@ -1015,17 +1568,18 @@ register int sp; case O_RETURN: tmps = "_SUB_"; /* just fake up a "last _SUB_" */ optype = O_LAST; - if (wantarray == G_ARRAY) { + if (curcsv && curcsv->wantarray == G_ARRAY) { lastretstr = Nullstr; lastspbase = arglast[1]; lastsize = arglast[2] - arglast[1]; } else - lastretstr = str_static(st[arglast[2] - arglast[0]]); + lastretstr = str_mortal(st[arglast[2] - arglast[0]]); goto dopop; case O_REDO: case O_NEXT: case O_LAST: + tmps = Nullch; if (maxarg > 0) { tmps = str_get(arg[1].arg_ptr.arg_str); dopop: @@ -1046,15 +1600,18 @@ register int sp; } #endif } - if (loop_ptr < 0) + if (loop_ptr < 0) { + if (tmps && strEQ(tmps, "_SUB_")) + fatal("Can't return outside a subroutine"); fatal("Bad label: %s", maxarg > 0 ? tmps : ""); + } if (!lastretstr && optype == O_LAST && lastsize) { st -= arglast[0]; st += lastspbase + 1; optype = loop_stack[loop_ptr].loop_sp - lastspbase; /* negative */ if (optype) { for (anum = lastsize; anum > 0; anum--,st++) - st[optype] = str_static(st[0]); + st[optype] = str_mortal(st[0]); } longjmp(loop_stack[loop_ptr].loop_env, O_LAST); } @@ -1066,13 +1623,22 @@ register int sp; goto_targ = Nullch; /* just restart from top */ if (optype == O_DUMP) { do_undump = 1; - abort(); + my_unexec(); } longjmp(top_env, 1); case O_INDEX: tmps = str_get(st[1]); + if (maxarg < 3) + anum = 0; + else { + anum = (int) str_gnum(st[3]) - arybase; + if (anum < 0) + anum = 0; + else if (anum > st[1]->str_cur) + anum = st[1]->str_cur; + } #ifndef lint - if (!(tmps2 = fbminstr((unsigned char*)tmps, + if (!(tmps2 = fbminstr((unsigned char*)tmps + anum, (unsigned char*)tmps + st[1]->str_cur, st[2]))) #else if (tmps2 = fbminstr(Null(unsigned char*),Null(unsigned char*),Nullstr)) @@ -1084,8 +1650,17 @@ register int sp; case O_RINDEX: tmps = str_get(st[1]); tmps2 = str_get(st[2]); + if (maxarg < 3) + anum = st[1]->str_cur; + else { + anum = (int) str_gnum(st[3]) - arybase + st[2]->str_cur; + if (anum < 0) + anum = 0; + else if (anum > st[1]->str_cur) + anum = st[1]->str_cur; + } #ifndef lint - if (!(tmps2 = rninstr(tmps, tmps + st[1]->str_cur, + if (!(tmps2 = rninstr(tmps, tmps + anum, tmps2, tmps2 + st[2]->str_cur))) #else if (tmps2 = rninstr(Nullch,Nullch,Nullch,Nullch)) @@ -1106,7 +1681,7 @@ register int sp; if (maxarg < 1) (void)time(&when); else - when = (long)str_gnum(st[1]); + when = (time_t)str_gnum(st[1]); sp = do_time(str,localtime(&when), gimme,arglast); goto array_return; @@ -1114,17 +1689,21 @@ register int sp; if (maxarg < 1) (void)time(&when); else - when = (long)str_gnum(st[1]); + when = (time_t)str_gnum(st[1]); sp = do_time(str,gmtime(&when), gimme,arglast); goto array_return; + case O_TRUNCATE: + sp = do_truncate(str,arg, + gimme,arglast); + goto array_return; case O_LSTAT: case O_STAT: sp = do_stat(str,arg, gimme,arglast); goto array_return; case O_CRYPT: -#ifdef CRYPT +#ifdef HAS_CRYPT tmps = str_get(st[1]); #ifdef FCRYPT str_set(str,fcrypt(tmps,str_get(st[2]))); @@ -1196,6 +1775,8 @@ register int sp; value = str_gnum(stab_val(defstab)); else value = str_gnum(st[1]); + if (value <= 0.0) + fatal("Can't take log of %g\n", value); value = log(value); goto donumset; case O_SQRT: @@ -1203,6 +1784,8 @@ register int sp; value = str_gnum(stab_val(defstab)); else value = str_gnum(st[1]); + if (value < 0.0) + fatal("Can't take sqrt of %g\n", value); value = sqrt(value); goto donumset; case O_INT: @@ -1229,6 +1812,23 @@ register int sp; value = (double) (anum & 255); #endif goto donumset; + case O_ALARM: +#ifdef HAS_ALARM + if (maxarg < 1) + tmps = str_get(stab_val(defstab)); + else + tmps = str_get(st[1]); + if (!tmps) + tmps = "0"; + anum = alarm((unsigned int)atoi(tmps)); + if (anum < 0) + goto say_undef; + value = (double)anum; + goto donumset; +#else + fatal("Unsupported function alarm"); + break; +#endif case O_SLEEP: if (maxarg < 1) tmps = Nullch; @@ -1258,16 +1858,20 @@ register int sp; st = stack->ary_array; maxarg = sp - arglast[0]; str_free(arg[1].arg_ptr.arg_str); + arg[1].arg_ptr.arg_str = Nullstr; str_free(arg[2].arg_ptr.arg_str); + arg[2].arg_ptr.arg_str = Nullstr; arg->arg_type = O_ARRAY; arg[1].arg_type = A_STAB|A_DONT; arg->arg_len = 1; stab = arg[1].arg_ptr.arg_stab = aadd(genstab()); ary = stab_array(stab); afill(ary,maxarg - 1); + anum = maxarg; st += arglast[0]+1; while (maxarg-- > 0) ary->ary_array[maxarg] = str_smake(st[maxarg]); + st -= arglast[0]+1; goto array_return; } arg->arg_type = optype = O_RANGE; @@ -1290,17 +1894,23 @@ register int sp; last_in_stab && (int)str_gnum(st[1]) == stab_io(last_in_stab)->lines : str_true(st[1]) ) { - str_numset(str,0.0); - anum = 2; - arg->arg_type = optype = O_FLOP; arg[2].arg_type &= ~A_DONT; arg[1].arg_type |= A_DONT; - argflags = arg[2].arg_flags; - argtype = arg[2].arg_type & A_MASK; - argptr = arg[2].arg_ptr; - sp = arglast[0]; - st -= sp; - goto re_eval; + arg->arg_type = optype = O_FLOP; + if (arg->arg_flags & AF_COMMON) { + str_numset(str,0.0); + anum = 2; + argflags = arg[2].arg_flags; + argtype = arg[2].arg_type & A_MASK; + argptr = arg[2].arg_ptr; + sp = arglast[0]; + st -= sp++; + goto re_eval; + } + else { + str_numset(str,1.0); + break; + } } str_set(str,""); break; @@ -1317,27 +1927,52 @@ register int sp; } break; case O_FORK: +#ifdef HAS_FORK anum = fork(); - if (!anum && (tmpstab = stabent("$",allstabs))) - str_numset(STAB_STR(tmpstab),(double)getpid()); + if (anum < 0) + goto say_undef; + if (!anum) { + /*SUPPRESS 560*/ + if (tmpstab = stabent("$",allstabs)) + str_numset(STAB_STR(tmpstab),(double)getpid()); + hclear(pidstatus, FALSE); /* no kids, so don't wait for 'em */ + } value = (double)anum; goto donumset; +#else + fatal("Unsupported function fork"); + break; +#endif case O_WAIT: +#ifdef HAS_WAIT #ifndef lint - /* ihand = signal(SIGINT, SIG_IGN); */ - /* qhand = signal(SIGQUIT, SIG_IGN); */ anum = wait(&argflags); if (anum > 0) pidgone(anum,argflags); value = (double)anum; +#endif + statusvalue = (unsigned short)argflags; + goto donumset; #else - /* ihand = qhand = 0; */ + fatal("Unsupported function wait"); + break; +#endif + case O_WAITPID: +#ifdef HAS_WAIT +#ifndef lint + anum = (int)str_gnum(st[1]); + optype = (int)str_gnum(st[2]); + anum = wait4pid(anum, &argflags,optype); + value = (double)anum; #endif - /* (void)signal(SIGINT, ihand); */ - /* (void)signal(SIGQUIT, qhand); */ statusvalue = (unsigned short)argflags; goto donumset; +#else + fatal("Unsupported function wait"); + break; +#endif case O_SYSTEM: +#ifdef HAS_FORK #ifdef TAINT if (arglast[2] - arglast[1] == 1) { taintenv(); @@ -1356,19 +1991,19 @@ register int sp; #ifndef lint ihand = signal(SIGINT, SIG_IGN); qhand = signal(SIGQUIT, SIG_IGN); - while ((argtype = wait(&argflags)) != anum && argtype >= 0) - pidgone(argtype,argflags); + argtype = wait4pid(anum, &argflags, 0); #else ihand = qhand = 0; #endif (void)signal(SIGINT, ihand); (void)signal(SIGQUIT, qhand); statusvalue = (unsigned short)argflags; - if (argtype == -1) + if (argtype < 0) value = -1.0; else { value = (double)((unsigned int)argflags & 0xffff); } + do_execfree(); /* free any memory child malloced on vfork */ goto donumset; } if ((arg[1].arg_type & A_MASK) == A_STAB) @@ -1376,68 +2011,139 @@ register int sp; else if (arglast[2] - arglast[1] != 1) value = (double)do_aexec(Nullstr,arglast); else { - value = (double)do_exec(str_get(str_static(st[2]))); + value = (double)do_exec(str_get(str_mortal(st[2]))); } _exit(-1); - case O_EXEC: +#else /* ! FORK */ if ((arg[1].arg_type & A_MASK) == A_STAB) - value = (double)do_aexec(st[1],arglast); + value = (double)do_aspawn(st[1],arglast); else if (arglast[2] - arglast[1] != 1) - value = (double)do_aexec(Nullstr,arglast); + value = (double)do_aspawn(Nullstr,arglast); else { - value = (double)do_exec(str_get(str_static(st[2]))); + value = (double)do_spawn(str_get(str_mortal(st[2]))); } goto donumset; - case O_HEX: - argtype = 4; - goto snarfnum; +#endif /* FORK */ + case O_EXEC_OP: + if ((arg[1].arg_type & A_MASK) == A_STAB) + value = (double)do_aexec(st[1],arglast); + else if (arglast[2] - arglast[1] != 1) + value = (double)do_aexec(Nullstr,arglast); + else { +#ifdef TAINT + taintenv(); + tainted |= st[2]->str_tainted; + taintproper("Insecure dependency in exec"); +#endif + value = (double)do_exec(str_get(str_mortal(st[2]))); + } + goto donumset; + case O_HEX: + if (maxarg < 1) + tmps = str_get(stab_val(defstab)); + else + tmps = str_get(st[1]); + value = (double)scanhex(tmps, 99, &argtype); + goto donumset; case O_OCT: - argtype = 3; - - snarfnum: - anum = 0; if (maxarg < 1) tmps = str_get(stab_val(defstab)); else tmps = str_get(st[1]); - for (;;) { - switch (*tmps) { - default: - goto out; - case '8': case '9': - if (argtype != 4) - goto out; - /* FALL THROUGH */ - case '0': case '1': case '2': case '3': case '4': - case '5': case '6': case '7': - anum <<= argtype; - anum += *tmps++ & 15; + while (*tmps && (isSPACE(*tmps) || *tmps == '0')) + tmps++; + if (*tmps == 'x') + value = (double)scanhex(++tmps, 99, &argtype); + else + value = (double)scanoct(tmps, 99, &argtype); + goto donumset; + +/* These common exits are hidden here in the middle of the switches for the + benefit of those machines with limited branch addressing. Sigh. */ + +array_return: +#ifdef DEBUGGING + if (debug) { + dlevel--; + if (debug & 8) { + anum = sp - arglast[0]; + switch (anum) { + case 0: + deb("%s RETURNS ()\n",opname[optype]); break; - case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': - case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': - if (argtype != 4) - goto out; - anum <<= 4; - anum += (*tmps++ & 7) + 9; + case 1: + deb("%s RETURNS (\"%s\")\n",opname[optype], + st[1] ? str_get(st[1]) : ""); break; - case 'x': - argtype = 4; - tmps++; + default: + tmps = st[1] ? str_get(st[1]) : ""; + deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\")\n",opname[optype], + anum,tmps,anum==2?"":"...,", + st[anum] ? str_get(st[anum]) : ""); break; } } - out: - value = (double)anum; - goto donumset; - case O_CHMOD: + } +#endif + return sp; + +say_yes: + str = &str_yes; + goto normal_return; + +say_no: + str = &str_no; + goto normal_return; + +say_undef: + str = &str_undef; + goto normal_return; + +say_zero: + value = 0.0; + /* FALL THROUGH */ + +donumset: + str_numset(str,value); + STABSET(str); + st[1] = str; +#ifdef DEBUGGING + if (debug) { + dlevel--; + if (debug & 8) + deb("%s RETURNS \"%f\"\n",opname[optype],value); + } +#endif + return arglast[0] + 1; +#ifdef SMALLSWITCHES + } + else + switch (optype) { +#endif case O_CHOWN: +#ifdef HAS_CHOWN + value = (double)apply(optype,arglast); + goto donumset; +#else + fatal("Unsupported function chown"); + break; +#endif case O_KILL: +#ifdef HAS_KILL + value = (double)apply(optype,arglast); + goto donumset; +#else + fatal("Unsupported function kill"); + break; +#endif case O_UNLINK: + case O_CHMOD: case O_UTIME: value = (double)apply(optype,arglast); goto donumset; case O_UMASK: +#ifdef HAS_UMASK if (maxarg < 1) { anum = umask(0); (void)umask(anum); @@ -1449,24 +2155,80 @@ register int sp; taintproper("Insecure dependency in umask"); #endif goto donumset; +#else + fatal("Unsupported function umask"); + break; +#endif +#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) + case O_MSGGET: + case O_SHMGET: + case O_SEMGET: + if ((anum = do_ipcget(optype, arglast)) == -1) + goto say_undef; + value = (double)anum; + goto donumset; + case O_MSGCTL: + case O_SHMCTL: + case O_SEMCTL: + anum = do_ipcctl(optype, arglast); + if (anum == -1) + goto say_undef; + if (anum != 0) { + value = (double)anum; + goto donumset; + } + str_set(str,"0 but true"); + STABSET(str); + break; + case O_MSGSND: + value = (double)(do_msgsnd(arglast) >= 0); + goto donumset; + case O_MSGRCV: + value = (double)(do_msgrcv(arglast) >= 0); + goto donumset; + case O_SEMOP: + value = (double)(do_semop(arglast) >= 0); + goto donumset; + case O_SHMREAD: + case O_SHMWRITE: + value = (double)(do_shmio(optype, arglast) >= 0); + goto donumset; +#else /* not SYSVIPC */ + case O_MSGGET: + case O_MSGCTL: + case O_MSGSND: + case O_MSGRCV: + case O_SEMGET: + case O_SEMCTL: + case O_SEMOP: + case O_SHMGET: + case O_SHMCTL: + case O_SHMREAD: + case O_SHMWRITE: + fatal("System V IPC is not implemented on this machine"); +#endif /* not SYSVIPC */ case O_RENAME: tmps = str_get(st[1]); tmps2 = str_get(st[2]); #ifdef TAINT taintproper("Insecure dependency in rename"); #endif -#ifdef RENAME +#ifdef HAS_RENAME value = (double)(rename(tmps,tmps2) >= 0); #else - if (euid || stat(tmps2,&statbuf) < 0 || - (statbuf.st_mode & S_IFMT) != S_IFDIR ) - (void)UNLINK(tmps2); /* avoid unlinking a directory */ - if (!(anum = link(tmps,tmps2))) - anum = UNLINK(tmps); + if (same_dirent(tmps2, tmps)) /* can always rename to same name */ + anum = 1; + else { + if (euid || stat(tmps2,&statbuf) < 0 || !S_ISDIR(statbuf.st_mode)) + (void)UNLINK(tmps2); + if (!(anum = link(tmps,tmps2))) + anum = UNLINK(tmps); + } value = (double)(anum >= 0); #endif goto donumset; case O_LINK: +#ifdef HAS_LINK tmps = str_get(st[1]); tmps2 = str_get(st[2]); #ifdef TAINT @@ -1474,19 +2236,23 @@ register int sp; #endif value = (double)(link(tmps,tmps2) >= 0); goto donumset; +#else + fatal("Unsupported function link"); + break; +#endif case O_MKDIR: tmps = str_get(st[1]); anum = (int)str_gnum(st[2]); #ifdef TAINT taintproper("Insecure dependency in mkdir"); #endif -#ifdef MKDIR +#ifdef HAS_MKDIR value = (double)(mkdir(tmps,anum) >= 0); goto donumset; #else (void)strcpy(buf,"mkdir "); #endif -#if !defined(MKDIR) || !defined(RMDIR) +#if !defined(HAS_MKDIR) || !defined(HAS_RMDIR) one_liner: for (tmps2 = buf+6; *tmps; ) { *tmps2++ = '\\'; @@ -1509,6 +2275,10 @@ register int sp; #endif if (instr(buf,"cannot make")) errno = EEXIST; + else if (instr(buf,"existing file")) + errno = EEXIST; + else if (instr(buf,"ile exists")) + errno = EEXIST; else if (instr(buf,"non-exist")) errno = ENOENT; else if (instr(buf,"does not exist")) @@ -1545,30 +2315,41 @@ register int sp; #ifdef TAINT taintproper("Insecure dependency in rmdir"); #endif -#ifdef RMDIR +#ifdef HAS_RMDIR value = (double)(rmdir(tmps) >= 0); goto donumset; #else (void)strcpy(buf,"rmdir "); - goto one_liner; /* see above in MKDIR */ + goto one_liner; /* see above in HAS_MKDIR */ #endif case O_GETPPID: +#ifdef HAS_GETPPID value = (double)getppid(); goto donumset; +#else + fatal("Unsupported function getppid"); + break; +#endif case O_GETPGRP: -#ifdef GETPGRP +#ifdef HAS_GETPGRP if (maxarg < 1) anum = 0; else anum = (int)str_gnum(st[1]); +#ifdef _POSIX_SOURCE + if (anum != 0) + fatal("POSIX getpgrp can't take an argument"); + value = (double)getpgrp(); +#else value = (double)getpgrp(anum); +#endif goto donumset; #else fatal("The getpgrp() function is unimplemented on this machine"); break; #endif case O_SETPGRP: -#ifdef SETPGRP +#ifdef HAS_SETPGRP argtype = (int)str_gnum(st[1]); anum = (int)str_gnum(st[2]); #ifdef TAINT @@ -1581,7 +2362,7 @@ register int sp; break; #endif case O_GETPRIORITY: -#ifdef GETPRIORITY +#ifdef HAS_GETPRIORITY argtype = (int)str_gnum(st[1]); anum = (int)str_gnum(st[2]); value = (double)getpriority(argtype,anum); @@ -1591,7 +2372,7 @@ register int sp; break; #endif case O_SETPRIORITY: -#ifdef SETPRIORITY +#ifdef HAS_SETPRIORITY argtype = (int)str_gnum(st[1]); anum = (int)str_gnum(st[2]); optype = (int)str_gnum(st[3]); @@ -1605,6 +2386,7 @@ register int sp; break; #endif case O_CHROOT: +#ifdef HAS_CHROOT if (maxarg < 1) tmps = str_get(stab_val(defstab)); else @@ -1614,6 +2396,10 @@ register int sp; #endif value = (double)(chroot(tmps) >= 0); goto donumset; +#else + fatal("Unsupported function chroot"); + break; +#endif case O_FCNTL: case O_IOCTL: if (maxarg <= 0) @@ -1622,20 +2408,22 @@ register int sp; stab = arg[1].arg_ptr.arg_stab; else stab = stabent(str_get(st[1]),TRUE); - argtype = (unsigned int)str_gnum(st[2]); + argtype = U_I(str_gnum(st[2])); #ifdef TAINT taintproper("Insecure dependency in ioctl"); #endif anum = do_ctl(optype,stab,argtype,st[3]); if (anum == -1) goto say_undef; - if (anum != 0) + if (anum != 0) { + value = (double)anum; goto donumset; + } str_set(str,"0 but true"); STABSET(str); break; case O_FLOCK: -#ifdef FLOCK +#ifdef HAS_FLOCK if (maxarg <= 0) stab = last_in_stab; else if ((arg[1].arg_type & A_MASK) == A_WORD) @@ -1662,13 +2450,31 @@ register int sp; if (arglast[2] - arglast[1] != 1) do_unshift(ary,arglast); else { - str = Str_new(52,0); /* must copy the STR */ - str_sset(str,st[2]); + STR *tmpstr = Str_new(52,0); /* must copy the STR */ + str_sset(tmpstr,st[2]); aunshift(ary,1); - (void)astore(ary,0,str); + (void)astore(ary,0,tmpstr); } value = (double)(ary->ary_fill + 1); - break; + goto donumset; + + case O_TRY: + sp = do_try(arg[1].arg_ptr.arg_cmd, + gimme,arglast); + goto array_return; + + case O_EVALONCE: + sp = do_eval(st[1], O_EVAL, curcmd->c_stash, TRUE, + gimme,arglast); + if (eval_root) { + str_free(arg[1].arg_ptr.arg_str); + arg[1].arg_ptr.arg_cmd = eval_root; + arg[1].arg_type = (A_CMD|A_DONT); + arg[0].arg_type = O_TRY; + } + goto array_return; + + case O_REQUIRE: case O_DOFILE: case O_EVAL: if (maxarg < 1) @@ -1680,33 +2486,33 @@ register int sp; tainted |= tmpstr->str_tainted; taintproper("Insecure dependency in eval"); #endif - sp = do_eval(tmpstr, optype, arg[2].arg_ptr.arg_hash, + sp = do_eval(tmpstr, optype, curcmd->c_stash, FALSE, gimme,arglast); goto array_return; case O_FTRREAD: argtype = 0; - anum = S_IREAD; + anum = S_IRUSR; goto check_perm; case O_FTRWRITE: argtype = 0; - anum = S_IWRITE; + anum = S_IWUSR; goto check_perm; case O_FTREXEC: argtype = 0; - anum = S_IEXEC; + anum = S_IXUSR; goto check_perm; case O_FTEREAD: argtype = 1; - anum = S_IREAD; + anum = S_IRUSR; goto check_perm; case O_FTEWRITE: argtype = 1; - anum = S_IWRITE; + anum = S_IWUSR; goto check_perm; case O_FTEEXEC: argtype = 1; - anum = S_IEXEC; + anum = S_IXUSR; check_perm: if (mystat(arg,st[1]) < 0) goto say_undef; @@ -1734,53 +2540,69 @@ register int sp; case O_FTSIZE: if (mystat(arg,st[1]) < 0) goto say_undef; - if (statcache.st_size) - goto say_yes; - goto say_no; + value = (double)statcache.st_size; + goto donumset; + + case O_FTMTIME: + if (mystat(arg,st[1]) < 0) + goto say_undef; + value = (double)(basetime - statcache.st_mtime) / 86400.0; + goto donumset; + case O_FTATIME: + if (mystat(arg,st[1]) < 0) + goto say_undef; + value = (double)(basetime - statcache.st_atime) / 86400.0; + goto donumset; + case O_FTCTIME: + if (mystat(arg,st[1]) < 0) + goto say_undef; + value = (double)(basetime - statcache.st_ctime) / 86400.0; + goto donumset; case O_FTSOCK: -#ifdef S_IFSOCK - anum = S_IFSOCK; - goto check_file_type; -#else + if (mystat(arg,st[1]) < 0) + goto say_undef; + if (S_ISSOCK(statcache.st_mode)) + goto say_yes; goto say_no; -#endif case O_FTCHR: - anum = S_IFCHR; - goto check_file_type; + if (mystat(arg,st[1]) < 0) + goto say_undef; + if (S_ISCHR(statcache.st_mode)) + goto say_yes; + goto say_no; case O_FTBLK: - anum = S_IFBLK; - goto check_file_type; + if (mystat(arg,st[1]) < 0) + goto say_undef; + if (S_ISBLK(statcache.st_mode)) + goto say_yes; + goto say_no; case O_FTFILE: - anum = S_IFREG; - goto check_file_type; + if (mystat(arg,st[1]) < 0) + goto say_undef; + if (S_ISREG(statcache.st_mode)) + goto say_yes; + goto say_no; case O_FTDIR: - anum = S_IFDIR; - check_file_type: if (mystat(arg,st[1]) < 0) goto say_undef; - if ((statcache.st_mode & S_IFMT) == anum ) + if (S_ISDIR(statcache.st_mode)) goto say_yes; goto say_no; case O_FTPIPE: -#ifdef S_IFIFO - anum = S_IFIFO; - goto check_file_type; -#else + if (mystat(arg,st[1]) < 0) + goto say_undef; + if (S_ISFIFO(statcache.st_mode)) + goto say_yes; goto say_no; -#endif case O_FTLINK: - if (arg[1].arg_type & A_DONT) - fatal("You must supply explicit filename with -l"); -#ifdef LSTAT - if (lstat(str_get(st[1]),&statcache) < 0) + if (mylstat(arg,st[1]) < 0) goto say_undef; - if ((statcache.st_mode & S_IFMT) == S_IFLNK ) + if (S_ISLNK(statcache.st_mode)) goto say_yes; -#endif goto say_no; case O_SYMLINK: -#ifdef SYMLINK +#ifdef HAS_SYMLINK tmps = str_get(st[1]); tmps2 = str_get(st[2]); #ifdef TAINT @@ -1789,10 +2611,10 @@ register int sp; value = (double)(symlink(tmps,tmps2) >= 0); goto donumset; #else - fatal("Unsupported function symlink()"); + fatal("Unsupported function symlink"); #endif case O_READLINK: -#ifdef SYMLINK +#ifdef HAS_SYMLINK if (maxarg < 1) tmps = str_get(stab_val(defstab)); else @@ -1803,16 +2625,28 @@ register int sp; str_nset(str,buf,anum); break; #else - fatal("Unsupported function readlink()"); + goto say_undef; /* just pretend it's a normal file */ #endif case O_FTSUID: +#ifdef S_ISUID anum = S_ISUID; goto check_xid; +#else + goto say_no; +#endif case O_FTSGID: +#ifdef S_ISGID anum = S_ISGID; goto check_xid; +#else + goto say_no; +#endif case O_FTSVTX: +#ifdef S_ISVTX anum = S_ISVTX; +#else + goto say_no; +#endif check_xid: if (mystat(arg,st[1]) < 0) goto say_undef; @@ -1828,7 +2662,7 @@ register int sp; stab = stabent(tmps = str_get(st[1]),FALSE); if (stab && stab_io(stab) && stab_io(stab)->ifp) anum = fileno(stab_io(stab)->ifp); - else if (isdigit(*tmps)) + else if (isDIGIT(*tmps)) anum = atoi(tmps); else goto say_undef; @@ -1839,7 +2673,7 @@ register int sp; case O_FTBINARY: str = do_fttext(arg,st[1]); break; -#ifdef SOCKET +#ifdef HAS_SOCKET case O_SOCKET: if ((arg[1].arg_type & A_MASK) == A_WORD) stab = arg[1].arg_ptr.arg_stab; @@ -1952,10 +2786,7 @@ register int sp; case O_ESERVENT: value = (double) endservent(); goto donumset; - case O_SSELECT: - sp = do_select(gimme,arglast); - goto array_return; - case O_SOCKETPAIR: + case O_SOCKPAIR: if ((arg[1].arg_type & A_MASK) == A_WORD) stab = arg[1].arg_ptr.arg_stab; else @@ -1995,17 +2826,18 @@ register int sp; stab = arg[1].arg_ptr.arg_stab; else stab = stabent(str_get(st[1]),TRUE); + if (!stab) + goto say_undef; sp = do_getsockname(optype,stab,arglast); goto array_return; -#else /* SOCKET not defined */ +#else /* HAS_SOCKET not defined */ case O_SOCKET: case O_BIND: case O_CONNECT: case O_LISTEN: case O_ACCEPT: - case O_SSELECT: - case O_SOCKETPAIR: + case O_SOCKPAIR: case O_GHBYNAME: case O_GHBYADDR: case O_GHOSTENT: @@ -2033,7 +2865,14 @@ register int sp; case O_GETPEERNAME: badsock: fatal("Unsupported socket function"); -#endif /* SOCKET */ +#endif /* HAS_SOCKET */ + case O_SSELECT: +#ifdef HAS_SELECT + sp = do_select(gimme,arglast); + goto array_return; +#else + fatal("select not implemented"); +#endif case O_FILENO: if (maxarg < 1) goto say_undef; @@ -2045,12 +2884,39 @@ register int sp; goto say_undef; value = fileno(fp); goto donumset; + case O_BINMODE: + if (maxarg < 1) + goto say_undef; + if ((arg[1].arg_type & A_MASK) == A_WORD) + stab = arg[1].arg_ptr.arg_stab; + else + stab = stabent(str_get(st[1]),TRUE); + if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp)) + goto say_undef; +#ifdef DOSISH +#ifdef atarist + if(fflush(fp)) + str_set(str, No); + else + { + fp->_flag |= _IOBIN; + str_set(str, Yes); + } +#else + str_set(str, (setmode(fileno(fp), O_BINARY) != -1) ? Yes : No); +#endif +#else + str_set(str, Yes); +#endif + STABSET(str); + break; case O_VEC: sp = do_vec(str == st[1], arg->arg_ptr.arg_str, arglast); goto array_return; case O_GPWNAM: case O_GPWUID: case O_GPWENT: +#ifdef HAS_PASSWD sp = do_gpwent(optype, gimme,arglast); goto array_return; @@ -2060,9 +2926,16 @@ register int sp; case O_EPWENT: value = (double) endpwent(); goto donumset; +#else + case O_EPWENT: + case O_SPWENT: + fatal("Unsupported password function"); + break; +#endif case O_GGRNAM: case O_GGRGID: case O_GGRENT: +#ifdef HAS_GROUP sp = do_ggrent(optype, gimme,arglast); goto array_return; @@ -2072,12 +2945,22 @@ register int sp; case O_EGRENT: value = (double) endgrent(); goto donumset; +#else + case O_EGRENT: + case O_SGRENT: + fatal("Unsupported group function"); + break; +#endif case O_GETLOGIN: +#ifdef HAS_GETLOGIN if (!(tmps = getlogin())) goto say_undef; str_set(str,tmps); +#else + fatal("Unsupported function getlogin"); +#endif break; - case O_OPENDIR: + case O_OPEN_DIR: case O_READDIR: case O_TELLDIR: case O_SEEKDIR: @@ -2089,12 +2972,15 @@ register int sp; stab = arg[1].arg_ptr.arg_stab; else stab = stabent(str_get(st[1]),TRUE); + if (!stab) + goto say_undef; sp = do_dirop(optype,stab,gimme,arglast); goto array_return; case O_SYSCALL: value = (double)do_syscall(arglast); goto donumset; - case O_PIPE: + case O_PIPE_OP: +#ifdef HAS_PIPE if ((arg[1].arg_type & A_MASK) == A_WORD) stab = arg[1].arg_ptr.arg_stab; else @@ -2105,6 +2991,9 @@ register int sp; stab2 = stabent(str_get(st[2]),TRUE); do_pipe(str,stab,stab2); STABSET(str); +#else + fatal("Unsupported function pipe"); +#endif break; } @@ -2118,56 +3007,4 @@ register int sp; } #endif return arglast[0] + 1; - -array_return: -#ifdef DEBUGGING - if (debug) { - dlevel--; - if (debug & 8) { - anum = sp - arglast[0]; - switch (anum) { - case 0: - deb("%s RETURNS ()\n",opname[optype]); - break; - case 1: - deb("%s RETURNS (\"%s\")\n",opname[optype],str_get(st[1])); - break; - default: - deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\"\n",opname[optype],anum, - str_get(st[1]),anum==2?"":"...,",str_get(st[anum])); - break; - } - } - } -#endif - return sp; - -say_yes: - str = &str_yes; - goto normal_return; - -say_no: - str = &str_no; - goto normal_return; - -say_undef: - str = &str_undef; - goto normal_return; - -say_zero: - value = 0.0; - /* FALL THROUGH */ - -donumset: - str_numset(str,value); - STABSET(str); - st[1] = str; -#ifdef DEBUGGING - if (debug) { - dlevel--; - if (debug & 8) - deb("%s RETURNS \"%f\"\n",opname[optype],value); - } -#endif - return arglast[0] + 1; }