X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=eval.c;h=82b7a8bf894538e1a9c62cb56e4a6c1ae048e3f9;hb=8adcabd8d9cf3c71e660c45cb7165ae4694308d4;hp=42436e4b8f7c70c2cb758fc1b40deca23aa9dae8;hpb=154e51a4a1b0258759b5e901183403af515a35b9;p=p5sagit%2Fp5-mst-13.2.git diff --git a/eval.c b/eval.c index 42436e4..82b7a8b 100644 --- a/eval.c +++ b/eval.c @@ -1,72 +1,67 @@ -/* $Header: eval.c,v 3.0.1.7 90/08/09 03:33:44 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.7 90/08/09 03:33:44 lwall - * patch19: made ~ do vector operation on strings like &, | and ^ - * patch19: dbmopen(%name...) didn't work right - * patch19: dbmopen(name, 'filename', undef) now refrains from creating - * patch19: empty %array now returns 0 in scalar context - * patch19: die with no arguments no longer exits unconditionally - * patch19: return outside a subroutine now returns a reasonable message - * patch19: rename done with unlink()/link()/unlink() now checks for clobbering - * patch19: -s now returns size of file + * 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.6 90/03/27 15:53:51 lwall - * patch16: MSDOS support - * patch16: support for machines that can't cast negative floats to unsigned ints - * patch16: ioctl didn't return values correctly + * 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.5 90/03/12 16:37:40 lwall - * patch13: undef $/ didn't work as advertised - * patch13: added list slice operator (LIST)[LIST] - * patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST) + * 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.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.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.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 3.0.1.2 89/11/17 15:19:34 lwall - * patch5: constant numeric subscripts get lost inside ?: - * - * 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 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" -#ifndef NSIG +#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 @@ -84,8 +79,8 @@ STR str_args; static STAB *stab2; static STIO *stio; static struct lstring *lstr; -static int old_record_separator; -extern int wantarray; +static int old_rschar; +static int old_rslen; double sin(), cos(), atan2(), pow(); @@ -109,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; @@ -143,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); @@ -153,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; @@ -176,19 +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_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: @@ -238,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; @@ -264,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); } @@ -281,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 - 1) % tmplong)) - 1; + 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: @@ -348,6 +810,14 @@ 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]); @@ -449,7 +919,11 @@ 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) { @@ -461,12 +935,12 @@ register int sp; else { STR_SSET(str,st[1]); tmps = str_get(str); - for (anum = str->str_cur; anum; anum--) + 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; @@ -476,7 +950,6 @@ register int sp; stab_io(defoutstab) = stio_new(); curoutstab = defoutstab; } - str_set(str, tmps); STABSET(str); break; case O_WRITE: @@ -516,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); @@ -524,7 +997,11 @@ register int sp; break; case O_DBMOPEN: #ifdef SOME_DBM - stab = arg[1].arg_ptr.arg_stab; + 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); if (st[3]->str_nok || st[3]->str_pok) anum = (int)str_gnum(st[3]); else @@ -536,7 +1013,11 @@ register int sp; #endif case O_DBMCLOSE: #ifdef SOME_DBM - stab = arg[1].arg_ptr.arg_stab; + 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); hdbmclose(stab_hash(stab)); goto say_yes; #else @@ -612,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; @@ -648,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: @@ -662,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 */ @@ -673,6 +1150,8 @@ 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; @@ -718,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); @@ -740,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) @@ -747,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; @@ -765,6 +1245,7 @@ register int sp; } break; case O_PACK: + /*SUPPRESS 701*/ (void)do_pack(str,arglast); break; case O_GREP: @@ -797,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]; @@ -835,7 +1320,7 @@ 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]; @@ -888,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"); @@ -913,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: @@ -941,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; @@ -967,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; @@ -992,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 - anum = fread(tmps, 1, anum, stab_io(stab)->ifp); +#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 +#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 >= 4) { + 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); + } +#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; @@ -1054,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: @@ -1096,7 +1611,7 @@ register int sp; 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); } @@ -1108,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)) @@ -1126,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)) @@ -1148,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; @@ -1156,7 +1689,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,gmtime(&when), gimme,arglast); goto array_return; @@ -1170,7 +1703,7 @@ register int sp; 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]))); @@ -1242,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: @@ -1249,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: @@ -1275,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; @@ -1304,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; @@ -1336,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; @@ -1363,10 +1927,16 @@ register int sp; } break; case O_FORK: -#ifdef 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 @@ -1374,7 +1944,7 @@ register int sp; break; #endif case O_WAIT: -#ifdef WAIT +#ifdef HAS_WAIT #ifndef lint anum = wait(&argflags); if (anum > 0) @@ -1387,8 +1957,22 @@ register int sp; 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 + statusvalue = (unsigned short)argflags; + goto donumset; +#else + fatal("Unsupported function wait"); + break; +#endif case O_SYSTEM: -#ifdef FORK +#ifdef HAS_FORK #ifdef TAINT if (arglast[2] - arglast[1] == 1) { taintenv(); @@ -1407,15 +1991,14 @@ 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); @@ -1428,7 +2011,7 @@ 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); #else /* ! FORK */ @@ -1437,63 +2020,109 @@ register int sp; else if (arglast[2] - arglast[1] != 1) value = (double)do_aspawn(Nullstr,arglast); else { - value = (double)do_spawn(str_get(str_static(st[2]))); + value = (double)do_spawn(str_get(str_mortal(st[2]))); } goto donumset; #endif /* FORK */ - case O_EXEC: + 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 { - value = (double)do_exec(str_get(str_static(st[2]))); +#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: - argtype = 4; - goto snarfnum; + 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; + } +#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 CHOWN +#ifdef HAS_CHOWN value = (double)apply(optype,arglast); goto donumset; #else @@ -1501,7 +2130,7 @@ register int sp; break; #endif case O_KILL: -#ifdef KILL +#ifdef HAS_KILL value = (double)apply(optype,arglast); goto donumset; #else @@ -1514,7 +2143,7 @@ register int sp; value = (double)apply(optype,arglast); goto donumset; case O_UMASK: -#ifdef UMASK +#ifdef HAS_UMASK if (maxarg < 1) { anum = umask(0); (void)umask(anum); @@ -1530,20 +2159,67 @@ register int sp; 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 (same_dirent(tmps2, tmps) /* can always rename to same name */ + if (same_dirent(tmps2, tmps)) /* can always rename to same name */ anum = 1; else { - if (euid || stat(tmps2,&statbuf) < 0 || - (statbuf.st_mode & S_IFMT) != S_IFDIR ) + if (euid || stat(tmps2,&statbuf) < 0 || !S_ISDIR(statbuf.st_mode)) (void)UNLINK(tmps2); if (!(anum = link(tmps,tmps2))) anum = UNLINK(tmps); @@ -1552,7 +2228,7 @@ register int sp; #endif goto donumset; case O_LINK: -#ifdef LINK +#ifdef HAS_LINK tmps = str_get(st[1]); tmps2 = str_get(st[2]); #ifdef TAINT @@ -1570,13 +2246,13 @@ register int sp; #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++ = '\\'; @@ -1599,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")) @@ -1635,15 +2315,15 @@ 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 GETPPID +#ifdef HAS_GETPPID value = (double)getppid(); goto donumset; #else @@ -1651,19 +2331,25 @@ register int sp; 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 @@ -1676,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); @@ -1686,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]); @@ -1700,7 +2386,7 @@ register int sp; break; #endif case O_CHROOT: -#ifdef CHROOT +#ifdef HAS_CHROOT if (maxarg < 1) tmps = str_get(stab_val(defstab)); else @@ -1737,7 +2423,7 @@ register int sp; 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) @@ -1764,13 +2450,29 @@ 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: @@ -1784,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; @@ -1841,53 +2543,66 @@ register int sp; 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: -#ifdef S_IFBLK - anum = S_IFBLK; - goto check_file_type; -#else + if (mystat(arg,st[1]) < 0) + goto say_undef; + if (S_ISBLK(statcache.st_mode)) + goto say_yes; goto say_no; -#endif 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 @@ -1899,7 +2614,7 @@ register int sp; fatal("Unsupported function symlink"); #endif case O_READLINK: -#ifdef SYMLINK +#ifdef HAS_SYMLINK if (maxarg < 1) tmps = str_get(stab_val(defstab)); else @@ -1910,7 +2625,7 @@ 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 @@ -1947,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; @@ -1958,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; @@ -2111,10 +2826,12 @@ 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: @@ -2148,9 +2865,9 @@ register int sp; case O_GETPEERNAME: badsock: fatal("Unsupported socket function"); -#endif /* SOCKET */ +#endif /* HAS_SOCKET */ case O_SSELECT: -#ifdef SELECT +#ifdef HAS_SELECT sp = do_select(gimme,arglast); goto array_return; #else @@ -2176,8 +2893,18 @@ register int sp; stab = stabent(str_get(st[1]),TRUE); if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp)) goto say_undef; -#ifdef MSDOS +#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 @@ -2189,7 +2916,7 @@ register int sp; case O_GPWNAM: case O_GPWUID: case O_GPWENT: -#ifdef PASSWD +#ifdef HAS_PASSWD sp = do_gpwent(optype, gimme,arglast); goto array_return; @@ -2208,7 +2935,7 @@ register int sp; case O_GGRNAM: case O_GGRGID: case O_GGRENT: -#ifdef GROUP +#ifdef HAS_GROUP sp = do_ggrent(optype, gimme,arglast); goto array_return; @@ -2225,7 +2952,7 @@ register int sp; break; #endif case O_GETLOGIN: -#ifdef GETLOGIN +#ifdef HAS_GETLOGIN if (!(tmps = getlogin())) goto say_undef; str_set(str,tmps); @@ -2233,7 +2960,7 @@ register int sp; fatal("Unsupported function getlogin"); #endif break; - case O_OPENDIR: + case O_OPEN_DIR: case O_READDIR: case O_TELLDIR: case O_SEEKDIR: @@ -2245,13 +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: -#ifdef 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 @@ -2278,57 +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: - tmps = str_get(st[1]); - deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\")\n",opname[optype], - anum,tmps,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; }