eval.c

早期freebsd实现

/* $RCSfile: eval.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 13:20:20 $
 *
 *    Copyright (c) 1991, Larry Wall
 *
 *    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 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 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 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 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 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 MSDOS
/* I_FCNTL *MUST* not be defined for MS-DOS and OS/2
   but fcntl.h is required for O_BINARY */
#include <fcntl.h>
#endif
#ifdef I_SYS_FILE
#include <sys/file.h>
#endif
#ifdef I_VFORK
#   include <vfork.h>
#endif

#ifdef VOIDSIG
static void (*ihand)();
static void (*qhand)();
#else
static int (*ihand)();
static int (*qhand)();
#endif

ARG *debarg;
STR str_args;
static STAB *stab2;
static STIO *stio;
static struct lstring *lstr;
static int old_rschar;
static int old_rslen;

double sin(), cos(), atan2(), pow();

char *getlogin();

int
eval(arg,gimme,sp)
register ARG *arg;
int gimme;
register int sp;
{
    register STR *str;
    register int anum;
    register int optype;
    register STR **st;
    int maxarg;
    double value;
    register char *tmps;
    char *tmps2;
    int argflags;
    int argtype;
    union argptr argptr;
    int arglast[8];	/* highest sp for arg--valid only for non-O_LIST args */
    unsigned long tmpulong;
    long tmplong;
    time_t when;
    STRLEN tmplen;
    FILE *fp;
    STR *tmpstr;
    FCMD *form;
    STAB *stab;
    ARRAY *ary;
    bool assigning = FALSE;
    double exp(), log(), sqrt(), modf();
    char *crypt(), *getenv();
    extern void grow_dlevel();

    if (!arg)
	goto say_undef;
    optype = arg->arg_type;
    maxarg = arg->arg_len;
    arglast[0] = sp;
    str = arg->arg_ptr.arg_str;
    if (sp + maxarg > stack->ary_max)
	astore(stack, sp + maxarg, Nullstr);
    st = stack->ary_array;

#ifdef DEBUGGING
    if (debug) {
	if (debug & 8) {
	    deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg);
	}
	debname[dlevel] = opname[optype][0];
	debdelim[dlevel] = ':';
	if (++dlevel >= dlmax)
	    grow_dlevel();
    }
#endif

    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;