-/* $Header: eval.c,v 3.0.1.4 90/02/28 17:36:59 lwall Locked $
+/* $RCSfile: eval.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 17:15:21 $
*
- * 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.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.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.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.2 89/11/17 15:19:34 lwall
- * patch5: constant numeric subscripts get lost inside ?:
+ * 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.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"
+#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
#include <signal.h>
+#endif
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
+#ifdef I_SYS_FILE
+#include <sys/file.h>
+#endif
#ifdef I_VFORK
# include <vfork.h>
#endif
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();
}
#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",stab_name(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",stab_name(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 MSDOS
+ 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 MSDOS
+ 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_name(last_in_stab));
+ when = str->str_len; /* remember if already alloced */
+ if (!when)
+ 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 (!when && 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);
case O_ITEM:
if (gimme == G_ARRAY)
goto array_return;
+ /* FALL THROUGH */
+ case O_SCALAR:
STR_SSET(str,st[1]);
STABSET(str);
break;
STABSET(str);
break;
case O_REPEAT:
- STR_SSET(str,st[1]);
- anum = (int)str_gnum(st[2]);
+ if (gimme == G_ARRAY && arg[1].arg_flags & AF_ARYOK) {
+ sp = do_repeatary(arglast);
+ goto array_return;
+ }
+ STR_SSET(str,st[arglast[1] - arglast[0]]);
+ anum = (int)str_gnum(st[arglast[2] - arglast[0]]);
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
str_sset(str,&str_no);
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;
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);
}
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 (when >= 0)
value = (double)(when % tmplong);
else
- value = (double)(tmplong - (-when % tmplong));
+ value = (double)(tmplong - ((-when - 1) % tmplong)) - 1;
#endif
goto donumset;
case O_ADD:
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:
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;
}
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;
}
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;
}
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_fullname(str,defoutstab);
if (maxarg > 0) {
if ((arg[1].arg_type & A_MASK) == A_WORD)
defoutstab = arg[1].arg_ptr.arg_stab;
stab_io(defoutstab) = stio_new();
curoutstab = defoutstab;
}
- str_set(str, tmps);
STABSET(str);
break;
case O_WRITE:
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);
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
goto say_zero;
else
goto say_undef;
- break;
+ /* break; */
case O_TRANS:
value = (double) do_trans(str,arg);
str = arg->arg_ptr.arg_str;
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;
}
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;
}
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);
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:
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 */
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);
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);
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)
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;
}
break;
case O_PACK:
+ /*SUPPRESS 701*/
(void)do_pack(str,arglast);
break;
case O_GREP:
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];
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:
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");
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:
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;
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;
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 == 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;
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:
}
#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 : "<null>");
+ }
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);
}
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))
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))
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])));
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:
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:
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;
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;
argtype = arg[2].arg_type & A_MASK;
argptr = arg[2].arg_ptr;
sp = arglast[0];
- st -= sp;
+ st -= sp++;
goto re_eval;
}
str_set(str,"");
}
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();
#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)
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_aspawn(st[1],arglast);
+ else if (arglast[2] - arglast[1] != 1)
+ value = (double)do_aspawn(Nullstr,arglast);
+ else {
+ value = (double)do_spawn(str_get(str_mortal(st[2])));
+ }
+ goto donumset;
+#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 {
- 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;
- 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);
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
#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++ = '\\';
#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"))
#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
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);
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]);
break;
#endif
case O_CHROOT:
+#ifdef HAS_CHROOT
if (maxarg < 1)
tmps = str_get(stab_val(defstab));
else
#endif
value = (double)(chroot(tmps) >= 0);
goto donumset;
+#else
+ fatal("Unsupported function chroot");
+ break;
+#endif
case O_FCNTL:
case O_IOCTL:
if (maxarg <= 0)
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)
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)
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;
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
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
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;
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;
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;
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
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:
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;
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 MSDOS
+ str_set(str, (setmode(fileno(fp), O_BINARY) != -1) ? Yes : No);
+#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;
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;
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:
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 HAS_PIPE
if ((arg[1].arg_type & A_MASK) == A_WORD)
stab = arg[1].arg_ptr.arg_stab;
else
stab2 = stabent(str_get(st[2]),TRUE);
do_pipe(str,stab,stab2);
STABSET(str);
+#else
+ fatal("Unsupported function pipe");
+#endif
break;
}
}
#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;
}
https://perl5.git.perl.org / perl5.git / blobdiff