-/* $Header: eval.c,v 2.0 88/06/05 00:08:48 root Exp $
+/* $Header: eval.c,v 3.0.1.3 89/12/21 20:03:05 lwall Locked $
+ *
+ * Copyright (c) 1989, 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.
*
* $Log: eval.c,v $
- * Revision 2.0 88/06/05 00:08:48 root
- * Baseline version 2.0.
+ * 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
*
*/
#include "perl.h"
#include <signal.h>
-#include <errno.h>
-extern int errno;
+#ifdef I_VFORK
+# include <vfork.h>
+#endif
#ifdef VOIDSIG
static void (*ihand)();
ARG *debarg;
STR str_args;
+static STAB *stab2;
+static STIO *stio;
+static struct lstring *lstr;
+static char old_record_separator;
+
+double sin(), cos(), atan2(), pow();
+
+char *getlogin();
-STR *
-eval(arg,retary,sargoff)
+int
+eval(arg,gimme,sp)
register ARG *arg;
-STR ***retary; /* where to return an array to, null if nowhere */
-int sargoff; /* how many elements in sarg are already assigned */
+int gimme;
+register int sp;
{
register STR *str;
register int anum;
register int optype;
+ register STR **st;
int maxarg;
- int maxsarg;
double value;
- STR *quicksarg[5];
- register STR **sarg = quicksarg;
register char *tmps;
char *tmps2;
int argflags;
int argtype;
union argptr argptr;
- int cushion;
+ int arglast[8]; /* highest sp for arg--valid only for non-O_LIST args */
unsigned long tmplong;
long when;
FILE *fp;
bool assigning = FALSE;
double exp(), log(), sqrt(), modf();
char *crypt(), *getenv();
+ extern void grow_dlevel();
if (!arg)
- return &str_no;
- str = arg->arg_ptr.arg_str;
+ goto say_undef;
optype = arg->arg_type;
- maxsarg = maxarg = arg->arg_len;
- if (maxsarg > 3 || retary) {
- if (sargoff >= 0) { /* array already exists, just append to it */
- cushion = 10;
- sarg = (STR **)saferealloc((char*)*retary,
- (maxsarg+sargoff+2+cushion) * sizeof(STR*)) + sargoff;
- /* Note that sarg points into the middle of the array */
- }
- else {
- sargoff = cushion = 0;
- sarg = (STR **)safemalloc((maxsarg+2) * sizeof(STR*));
- }
- }
- else
- sargoff = 0;
+ 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++] = ':';
+ debdelim[dlevel] = ':';
+ if (++dlevel >= dlmax)
+ grow_dlevel();
}
#endif
- for (anum = 1; anum <= maxarg; anum++) {
- argflags = arg[anum].arg_flags;
- if (argflags & AF_SPECIAL)
- continue;
- argtype = arg[anum].arg_type;
- argptr = arg[anum].arg_ptr;
- re_eval:
- switch (argtype) {
- default:
- sarg[anum] = &str_no;
-#ifdef DEBUGGING
- tmps = "NULL";
-#endif
- break;
- case A_EXPR:
-#ifdef DEBUGGING
- if (debug & 8) {
- tmps = "EXPR";
- deb("%d.EXPR =>\n",anum);
- }
-#endif
- if (retary &&
- (optype == O_LIST || optype == O_ITEM2 || optype == O_ITEM3)) {
- *retary = sarg - sargoff;
- eval(argptr.arg_arg, retary, anum - 1 + sargoff);
- sarg = *retary; /* they do realloc it... */
- argtype = maxarg - anum; /* how many left? */
- maxsarg = (int)(str_gnum(sarg[0])) + argtype;
- sargoff = maxsarg - maxarg;
- if (argtype > 9 - cushion) { /* we don't have room left */
- sarg = (STR **)saferealloc((char*)sarg,
- (maxsarg+2+cushion) * sizeof(STR*));
- }
- sarg += sargoff;
- }
- else
- sarg[anum] = eval(argptr.arg_arg, Null(STR***),-1);
- break;
- case A_CMD:
-#ifdef DEBUGGING
- if (debug & 8) {
- tmps = "CMD";
- deb("%d.CMD (%lx) =>\n",anum,argptr.arg_cmd);
- }
-#endif
- sarg[anum] = cmd_exec(argptr.arg_cmd);
- break;
- case A_STAB:
- sarg[anum] = STAB_STR(argptr.arg_stab);
-#ifdef DEBUGGING
- if (debug & 8) {
- sprintf(buf,"STAB $%s",argptr.arg_stab->stab_name);
- tmps = buf;
- }
-#endif
- break;
- case A_LEXPR:
-#ifdef DEBUGGING
- if (debug & 8) {
- tmps = "LEXPR";
- deb("%d.LEXPR =>\n",anum);
- }
-#endif
- str = eval(argptr.arg_arg,Null(STR***),-1);
- if (!str)
- fatal("panic: A_LEXPR");
- goto do_crement;
- case A_LVAL:
-#ifdef DEBUGGING
- if (debug & 8) {
- sprintf(buf,"LVAL $%s",argptr.arg_stab->stab_name);
- tmps = buf;
- }
-#endif
- 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);
- sarg[anum] = str;
- str = arg->arg_ptr.arg_str;
- }
- else if (argflags & AF_POST) {
- sarg[anum] = str_static(str);
- if (argflags & AF_UP)
- str_inc(str);
- else
- str_dec(str);
- STABSET(str);
- str = arg->arg_ptr.arg_str;
- }
- else {
- sarg[anum] = str;
- }
- break;
- case A_LARYLEN:
- str = sarg[anum] =
- argptr.arg_stab->stab_array->ary_magic;
-#ifdef DEBUGGING
- tmps = "LARYLEN";
-#endif
- if (!str)
- fatal("panic: A_LEXPR");
- goto do_crement;
- case A_ARYLEN:
- stab = argptr.arg_stab;
- sarg[anum] = stab->stab_array->ary_magic;
- str_numset(sarg[anum],(double)(stab->stab_array->ary_fill+arybase));
-#ifdef DEBUGGING
- tmps = "ARYLEN";
-#endif
- break;
- case A_SINGLE:
- sarg[anum] = argptr.arg_str;
-#ifdef DEBUGGING
- tmps = "SINGLE";
-#endif
- break;
- case A_DOUBLE:
- (void) interp(str,str_get(argptr.arg_str));
- sarg[anum] = str;
-#ifdef DEBUGGING
- tmps = "DOUBLE";
-#endif
- break;
- case A_BACKTICK:
- tmps = str_get(argptr.arg_str);
- fp = popen(str_get(interp(str,tmps)),"r");
- tmpstr = str_new(80);
- str_set(str,"");
- if (fp) {
- while (str_gets(tmpstr,fp) != Nullch) {
- str_scat(str,tmpstr);
- }
- statusvalue = pclose(fp);
- }
- else
- statusvalue = -1;
- str_free(tmpstr);
- sarg[anum] = str;
-#ifdef DEBUGGING
- tmps = "BACK";
-#endif
- break;
- case A_INDREAD:
- last_in_stab = stabent(str_get(STAB_STR(argptr.arg_stab)),TRUE);
- goto do_read;
- case A_GLOB:
- argflags |= AF_POST; /* enable newline chopping */
- case A_READ:
- last_in_stab = argptr.arg_stab;
- do_read:
- fp = Nullfp;
- if (last_in_stab->stab_io) {
- fp = last_in_stab->stab_io->fp;
- if (!fp) {
- if (last_in_stab->stab_io->flags & IOF_ARGV) {
- if (last_in_stab->stab_io->flags & IOF_START) {
- last_in_stab->stab_io->flags &= ~IOF_START;
- last_in_stab->stab_io->lines = 0;
- if (alen(last_in_stab->stab_array) < 0) {
- tmpstr = str_make("-"); /* assume stdin */
- apush(last_in_stab->stab_array, tmpstr);
- }
- }
- fp = nextargv(last_in_stab);
- if (!fp) /* Note: fp != last_in_stab->stab_io->fp */
- do_close(last_in_stab,FALSE); /* now it does */
- }
- else if (argtype == A_GLOB) {
- (void) interp(str,str_get(last_in_stab->stab_val));
- tmps = str->str_ptr;
- if (*tmps == '!')
- sprintf(tokenbuf,"%s|",tmps+1);
- else {
- if (*tmps == ';')
- sprintf(tokenbuf, "%s", tmps+1);
- else
- sprintf(tokenbuf, "echo %s", tmps);
- strcat(tokenbuf,
- "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
- }
- do_open(last_in_stab,tokenbuf);
- fp = last_in_stab->stab_io->fp;
- }
- }
- }
- if (!fp && dowarn)
- warn("Read on closed filehandle <%s>",last_in_stab->stab_name);
- keepgoing:
- if (!fp)
- sarg[anum] = &str_no;
- else if (!str_gets(str,fp)) {
- if (last_in_stab->stab_io->flags & IOF_ARGV) {
- fp = nextargv(last_in_stab);
- if (fp)
- goto keepgoing;
- do_close(last_in_stab,FALSE);
- last_in_stab->stab_io->flags |= IOF_START;
- }
- else if (argflags & AF_POST) {
- do_close(last_in_stab,FALSE);
- }
- if (fp == stdin) {
- clearerr(fp);
- }
- sarg[anum] = &str_no;
- if (retary) {
- maxarg = anum - 1;
- maxsarg = maxarg + sargoff;
- }
- break;
- }
- else {
- last_in_stab->stab_io->lines++;
- sarg[anum] = str;
- if (argflags & AF_POST) {
- if (str->str_cur > 0)
- str->str_cur--;
- str->str_ptr[str->str_cur] = '\0';
- }
- if (retary) {
- sarg[anum] = str_static(sarg[anum]);
- anum++;
- if (anum > maxarg) {
- maxarg = anum + anum;
- maxsarg = maxarg + sargoff;
- sarg = (STR **)saferealloc((char*)(sarg-sargoff),
- (maxsarg+2+cushion) * sizeof(STR*)) + sargoff;
- }
- goto keepgoing;
- }
- }
- if (retary) {
- maxarg = anum - 1;
- maxsarg = maxarg + sargoff;
- }
-#ifdef DEBUGGING
- tmps = "READ";
-#endif
- break;
- }
-#ifdef DEBUGGING
- if (debug & 8)
- deb("%d.%s = '%s'\n",anum,tmps,str_peek(sarg[anum]));
-#endif
- }
+#include "evalargs.xc"
+
+ st += arglast[0];
switch (optype) {
+ case O_RCAT:
+ STABSET(str);
+ break;
case O_ITEM:
- if (maxarg > arg->arg_len)
+ if (gimme == G_ARRAY)
goto array_return;
- if (str != sarg[1])
- str_sset(str,sarg[1]);
+ STR_SSET(str,st[1]);
STABSET(str);
break;
case O_ITEM2:
- if (str != sarg[--anum])
- str_sset(str,sarg[anum]);
+ if (gimme == G_ARRAY)
+ goto array_return;
+ --anum;
+ STR_SSET(str,st[arglast[anum]-arglast[0]]);
STABSET(str);
break;
case O_ITEM3:
- if (str != sarg[--anum])
- str_sset(str,sarg[anum]);
+ if (gimme == G_ARRAY)
+ goto array_return;
+ --anum;
+ STR_SSET(str,st[arglast[anum]-arglast[0]]);
STABSET(str);
break;
case O_CONCAT:
- if (str != sarg[1])
- str_sset(str,sarg[1]);
- str_scat(str,sarg[2]);
+ STR_SSET(str,st[1]);
+ str_scat(str,st[2]);
STABSET(str);
break;
case O_REPEAT:
- if (str != sarg[1])
- str_sset(str,sarg[1]);
- anum = (int)str_gnum(sarg[2]);
+ STR_SSET(str,st[1]);
+ anum = (int)str_gnum(st[2]);
if (anum >= 1) {
- tmpstr = str_new(0);
+ tmpstr = Str_new(50,0);
str_sset(tmpstr,str);
while (--anum > 0)
str_scat(str,tmpstr);
STABSET(str);
break;
case O_MATCH:
- str_sset(str, do_match(arg,
- retary,sarg,&maxsarg,sargoff,cushion));
- if (retary) {
- sarg = *retary; /* they realloc it */
+ sp = do_match(str,arg,
+ gimme,arglast);
+ if (gimme == G_ARRAY)
goto array_return;
- }
STABSET(str);
break;
case O_NMATCH:
- str_sset(str, do_match(arg,
- retary,sarg,&maxsarg,sargoff,cushion));
- if (retary) {
- sarg = *retary; /* they realloc it */
- goto array_return; /* ignore negation */
- }
- str_set(str, str_true(str) ? No : Yes);
+ sp = do_match(str,arg,
+ gimme,arglast);
+ if (gimme == G_ARRAY)
+ goto array_return;
+ str_sset(str, str_true(str) ? &str_no : &str_yes);
STABSET(str);
break;
case O_SUBST:
- value = (double) do_subst(str, arg);
- str = arg->arg_ptr.arg_str;
- goto donumset;
+ sp = do_subst(str,arg,arglast[0]);
+ goto array_return;
case O_NSUBST:
- str_set(arg->arg_ptr.arg_str, do_subst(str, arg) ? No : Yes);
+ sp = do_subst(str,arg,arglast[0]);
str = arg->arg_ptr.arg_str;
- break;
+ str_set(str, str_true(str) ? No : Yes);
+ goto array_return;
case O_ASSIGN:
- if (arg[1].arg_flags & AF_SPECIAL)
- do_assign(str,arg,sarg);
+ if (arg[1].arg_flags & AF_ARYOK) {
+ if (arg->arg_len == 1) {
+ arg->arg_type = O_LOCAL;
+ goto local;
+ }
+ else {
+ arg->arg_type = O_AASSIGN;
+ goto aassign;
+ }
+ }
else {
- if (str != sarg[2])
- str_sset(str, sarg[2]);
- STABSET(str);
+ arg->arg_type = O_SASSIGN;
+ goto sassign;
}
+ case O_LOCAL:
+ local:
+ arglast[2] = arglast[1]; /* push a null array */
+ /* FALL THROUGH */
+ case O_AASSIGN:
+ aassign:
+ sp = do_assign(arg,
+ gimme,arglast);
+ goto array_return;
+ case O_SASSIGN:
+ sassign:
+ STR_SSET(str, st[2]);
+ STABSET(str);
break;
case O_CHOP:
- tmps = str_get(str);
- tmps += str->str_cur - (str->str_cur != 0);
- str_set(arg->arg_ptr.arg_str,tmps); /* remember last char */
- *tmps = '\0'; /* wipe it out */
- str->str_cur = tmps - str->str_ptr;
- str->str_nok = 0;
+ st -= arglast[0];
str = arg->arg_ptr.arg_str;
+ for (sp = arglast[0] + 1; sp <= arglast[1]; sp++)
+ do_chop(str,st[sp]);
+ st += arglast[0];
break;
+ case O_DEFINED:
+ if (arg[1].arg_type & A_DONT) {
+ sp = do_defined(str,arg,
+ gimme,arglast);
+ goto array_return;
+ }
+ else if (str->str_pok || str->str_nok)
+ goto say_yes;
+ goto say_no;
+ case O_UNDEF:
+ if (arg[1].arg_type & A_DONT) {
+ sp = do_undef(str,arg,
+ gimme,arglast);
+ goto array_return;
+ }
+ else if (str != stab_val(defstab)) {
+ str->str_pok = str->str_nok = 0;
+ STABSET(str);
+ }
+ goto say_undef;
case O_STUDY:
- value = (double)do_study(str);
- str = arg->arg_ptr.arg_str;
+ sp = do_study(str,arg,
+ gimme,arglast);
+ goto array_return;
+ case O_POW:
+ value = str_gnum(st[1]);
+ value = pow(value,str_gnum(st[2]));
goto donumset;
case O_MULTIPLY:
- value = str_gnum(sarg[1]);
- value *= str_gnum(sarg[2]);
+ value = str_gnum(st[1]);
+ value *= str_gnum(st[2]);
goto donumset;
case O_DIVIDE:
- if ((value = str_gnum(sarg[2])) == 0.0)
+ if ((value = str_gnum(st[2])) == 0.0)
fatal("Illegal division by zero");
- value = str_gnum(sarg[1]) / value;
+ value = str_gnum(st[1]) / value;
goto donumset;
case O_MODULO:
- if ((tmplong = (unsigned long) str_gnum(sarg[2])) == 0L)
+ tmplong = (long) str_gnum(st[2]);
+ if (tmplong == 0L)
fatal("Illegal modulus zero");
- value = str_gnum(sarg[1]);
- value = (double)(((unsigned long)value) % tmplong);
+ when = (long)str_gnum(st[1]);
+#ifndef lint
+ if (when >= 0)
+ value = (double)(when % tmplong);
+ else
+ value = (double)(tmplong - (-when % tmplong));
+#endif
goto donumset;
case O_ADD:
- value = str_gnum(sarg[1]);
- value += str_gnum(sarg[2]);
+ value = str_gnum(st[1]);
+ value += str_gnum(st[2]);
goto donumset;
case O_SUBTRACT:
- value = str_gnum(sarg[1]);
- value -= str_gnum(sarg[2]);
+ value = str_gnum(st[1]);
+ value -= str_gnum(st[2]);
goto donumset;
case O_LEFT_SHIFT:
- value = str_gnum(sarg[1]);
- anum = (int)str_gnum(sarg[2]);
- value = (double)(((unsigned long)value) << anum);
+ value = str_gnum(st[1]);
+ anum = (int)str_gnum(st[2]);
+#ifndef lint
+ value = (double)(((long)value) << anum);
+#endif
goto donumset;
case O_RIGHT_SHIFT:
- value = str_gnum(sarg[1]);
- anum = (int)str_gnum(sarg[2]);
- value = (double)(((unsigned long)value) >> anum);
+ value = str_gnum(st[1]);
+ anum = (int)str_gnum(st[2]);
+#ifndef lint
+ value = (double)(((long)value) >> anum);
+#endif
goto donumset;
case O_LT:
- value = str_gnum(sarg[1]);
- value = (double)(value < str_gnum(sarg[2]));
+ value = str_gnum(st[1]);
+ value = (value < str_gnum(st[2])) ? 1.0 : 0.0;
goto donumset;
case O_GT:
- value = str_gnum(sarg[1]);
- value = (double)(value > str_gnum(sarg[2]));
+ value = str_gnum(st[1]);
+ value = (value > str_gnum(st[2])) ? 1.0 : 0.0;
goto donumset;
case O_LE:
- value = str_gnum(sarg[1]);
- value = (double)(value <= str_gnum(sarg[2]));
+ value = str_gnum(st[1]);
+ value = (value <= str_gnum(st[2])) ? 1.0 : 0.0;
goto donumset;
case O_GE:
- value = str_gnum(sarg[1]);
- value = (double)(value >= str_gnum(sarg[2]));
+ value = str_gnum(st[1]);
+ value = (value >= str_gnum(st[2])) ? 1.0 : 0.0;
goto donumset;
case O_EQ:
- value = str_gnum(sarg[1]);
- value = (double)(value == str_gnum(sarg[2]));
+ if (dowarn) {
+ if ((!st[1]->str_nok && !looks_like_number(st[1])) ||
+ (!st[2]->str_nok && !looks_like_number(st[2])) )
+ warn("Possible use of == on string value");
+ }
+ value = str_gnum(st[1]);
+ value = (value == str_gnum(st[2])) ? 1.0 : 0.0;
goto donumset;
case O_NE:
- value = str_gnum(sarg[1]);
- value = (double)(value != str_gnum(sarg[2]));
+ value = str_gnum(st[1]);
+ value = (value != str_gnum(st[2])) ? 1.0 : 0.0;
goto donumset;
case O_BIT_AND:
- value = str_gnum(sarg[1]);
- value = (double)(((unsigned long)value) &
- (unsigned long)str_gnum(sarg[2]));
- goto donumset;
+ if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
+ value = str_gnum(st[1]);
+#ifndef lint
+ value = (double)(((long)value) & (long)str_gnum(st[2]));
+#endif
+ goto donumset;
+ }
+ else
+ do_vop(optype,str,st[1],st[2]);
+ break;
case O_XOR:
- value = str_gnum(sarg[1]);
- value = (double)(((unsigned long)value) ^
- (unsigned long)str_gnum(sarg[2]));
- goto donumset;
+ if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
+ value = str_gnum(st[1]);
+#ifndef lint
+ value = (double)(((long)value) ^ (long)str_gnum(st[2]));
+#endif
+ goto donumset;
+ }
+ else
+ do_vop(optype,str,st[1],st[2]);
+ break;
case O_BIT_OR:
- value = str_gnum(sarg[1]);
- value = (double)(((unsigned long)value) |
- (unsigned long)str_gnum(sarg[2]));
- goto donumset;
+ if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
+ value = str_gnum(st[1]);
+#ifndef lint
+ value = (double)(((long)value) | (long)str_gnum(st[2]));
+#endif
+ goto donumset;
+ }
+ else
+ do_vop(optype,str,st[1],st[2]);
+ break;
+/* use register in evaluating str_true() */
case O_AND:
- if (str_true(sarg[1])) {
+ if (str_true(st[1])) {
anum = 2;
optype = O_ITEM2;
argflags = arg[anum].arg_flags;
- argtype = arg[anum].arg_type;
+ if (gimme == G_ARRAY)
+ argflags |= AF_ARYOK;
+ argtype = arg[anum].arg_type & A_MASK;
argptr = arg[anum].arg_ptr;
maxarg = anum = 1;
+ sp = arglast[0];
+ st -= sp;
goto re_eval;
}
else {
if (assigning) {
- str_sset(str, sarg[1]);
+ str_sset(str, st[1]);
STABSET(str);
}
else
- str = sarg[1];
+ str = st[1];
break;
}
case O_OR:
- if (str_true(sarg[1])) {
+ if (str_true(st[1])) {
if (assigning) {
- str_sset(str, sarg[1]);
+ str_sset(str, st[1]);
STABSET(str);
}
else
- str = sarg[1];
+ str = st[1];
break;
}
else {
anum = 2;
optype = O_ITEM2;
argflags = arg[anum].arg_flags;
- argtype = arg[anum].arg_type;
+ if (gimme == G_ARRAY)
+ argflags |= AF_ARYOK;
+ argtype = arg[anum].arg_type & A_MASK;
argptr = arg[anum].arg_ptr;
maxarg = anum = 1;
+ sp = arglast[0];
+ st -= sp;
goto re_eval;
}
case O_COND_EXPR:
- anum = (str_true(sarg[1]) ? 2 : 3);
+ anum = (str_true(st[1]) ? 2 : 3);
optype = (anum == 2 ? O_ITEM2 : O_ITEM3);
argflags = arg[anum].arg_flags;
- argtype = arg[anum].arg_type;
+ if (gimme == G_ARRAY)
+ argflags |= AF_ARYOK;
+ argtype = arg[anum].arg_type & A_MASK;
argptr = arg[anum].arg_ptr;
maxarg = anum = 1;
+ sp = arglast[0];
+ st -= sp;
goto re_eval;
case O_COMMA:
- str = sarg[2];
+ if (gimme == G_ARRAY)
+ goto array_return;
+ str = st[2];
break;
case O_NEGATE:
- value = -str_gnum(sarg[1]);
+ value = -str_gnum(st[1]);
goto donumset;
case O_NOT:
- value = (double) !str_true(sarg[1]);
+ value = (double) !str_true(st[1]);
goto donumset;
case O_COMPLEMENT:
- value = (double) ~(long)str_gnum(sarg[1]);
+#ifndef lint
+ value = (double) ~(long)str_gnum(st[1]);
+#endif
goto donumset;
case O_SELECT:
- if (arg[1].arg_type == A_LVAL)
- defoutstab = arg[1].arg_ptr.arg_stab;
- else
- defoutstab = stabent(str_get(sarg[1]),TRUE);
- if (!defoutstab->stab_io)
- defoutstab->stab_io = stio_new();
- curoutstab = defoutstab;
- str_set(str,curoutstab->stab_io->fp ? Yes : No);
+ tmps = stab_name(defoutstab);
+ if (maxarg > 0) {
+ if ((arg[1].arg_type & A_MASK) == A_WORD)
+ defoutstab = arg[1].arg_ptr.arg_stab;
+ else
+ defoutstab = stabent(str_get(st[1]),TRUE);
+ if (!stab_io(defoutstab))
+ stab_io(defoutstab) = stio_new();
+ curoutstab = defoutstab;
+ }
+ str_set(str, tmps);
STABSET(str);
break;
case O_WRITE:
if (maxarg == 0)
stab = defoutstab;
- else if (arg[1].arg_type == A_LVAL)
- stab = arg[1].arg_ptr.arg_stab;
+ else if ((arg[1].arg_type & A_MASK) == A_WORD) {
+ if (!(stab = arg[1].arg_ptr.arg_stab))
+ stab = defoutstab;
+ }
else
- stab = stabent(str_get(sarg[1]),TRUE);
- if (!stab->stab_io) {
+ stab = stabent(str_get(st[1]),TRUE);
+ if (!stab_io(stab)) {
str_set(str, No);
STABSET(str);
break;
}
curoutstab = stab;
- fp = stab->stab_io->fp;
+ fp = stab_io(stab)->ofp;
debarg = arg;
- if (stab->stab_io->fmt_stab)
- form = stab->stab_io->fmt_stab->stab_form;
+ if (stab_io(stab)->fmt_stab)
+ form = stab_form(stab_io(stab)->fmt_stab);
else
- form = stab->stab_form;
+ form = stab_form(stab);
if (!form || !fp) {
+ if (dowarn) {
+ if (form)
+ warn("No format for filehandle");
+ else {
+ if (stab_io(stab)->ifp)
+ warn("Filehandle only opened for input");
+ else
+ warn("Write on closed filehandle");
+ }
+ }
str_set(str, No);
STABSET(str);
break;
}
- format(&outrec,form);
- do_write(&outrec,stab->stab_io);
- if (stab->stab_io->flags & IOF_FLUSH)
- fflush(fp);
+ format(&outrec,form,sp);
+ do_write(&outrec,stab_io(stab),sp);
+ if (stab_io(stab)->flags & IOF_FLUSH)
+ (void)fflush(fp);
str_set(str, Yes);
STABSET(str);
break;
+ case O_DBMOPEN:
+#ifdef SOME_DBM
+ if ((arg[1].arg_type & A_MASK) == A_WORD)
+ stab = arg[1].arg_ptr.arg_stab;
+ else
+ stab = stabent(str_get(st[1]),TRUE);
+ anum = (int)str_gnum(st[3]);
+ value = (double)hdbmopen(stab_hash(stab),str_get(st[2]),anum);
+ goto donumset;
+#else
+ fatal("No dbm or ndbm on this machine");
+#endif
+ case O_DBMCLOSE:
+#ifdef SOME_DBM
+ if ((arg[1].arg_type & A_MASK) == A_WORD)
+ stab = arg[1].arg_ptr.arg_stab;
+ else
+ stab = stabent(str_get(st[1]),TRUE);
+ hdbmclose(stab_hash(stab));
+ goto say_yes;
+#else
+ fatal("No dbm or ndbm on this machine");
+#endif
case O_OPEN:
- if (arg[1].arg_type == A_WORD)
+ if ((arg[1].arg_type & A_MASK) == A_WORD)
stab = arg[1].arg_ptr.arg_stab;
else
- stab = stabent(str_get(sarg[1]),TRUE);
- if (do_open(stab,str_get(sarg[2]))) {
+ stab = stabent(str_get(st[1]),TRUE);
+ if (do_open(stab,str_get(st[2]))) {
value = (double)forkprocess;
- stab->stab_io->lines = 0;
+ stab_io(stab)->lines = 0;
goto donumset;
}
else
- str_set(str, No);
- STABSET(str);
+ goto say_undef;
break;
case O_TRANS:
value = (double) do_trans(str,arg);
str = arg->arg_ptr.arg_str;
break;
case O_CLOSE:
- if (arg[1].arg_type == A_WORD)
+ if (maxarg == 0)
+ stab = defoutstab;
+ else if ((arg[1].arg_type & A_MASK) == A_WORD)
stab = arg[1].arg_ptr.arg_stab;
else
- stab = stabent(str_get(sarg[1]),TRUE);
+ stab = stabent(str_get(st[1]),TRUE);
str_set(str, do_close(stab,TRUE) ? Yes : No );
STABSET(str);
break;
case O_EACH:
- str_sset(str,do_each(arg[1].arg_ptr.arg_stab->stab_hash,
- retary,sarg,&maxsarg,sargoff,cushion));
- if (retary) {
- sarg = *retary; /* they realloc it */
- goto array_return;
- }
- STABSET(str);
- break;
+ sp = do_each(str,stab_hash(arg[1].arg_ptr.arg_stab),
+ gimme,arglast);
+ goto array_return;
case O_VALUES:
case O_KEYS:
- value = (double) do_kv(arg[1].arg_ptr.arg_stab->stab_hash, optype,
- retary,sarg,&maxsarg,sargoff,cushion);
- if (retary) {
- sarg = *retary; /* they realloc it */
- goto array_return;
- }
- goto donumset;
+ sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
+ gimme,arglast);
+ goto array_return;
+ case O_LARRAY:
+ str->str_nok = str->str_pok = 0;
+ str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
+ str->str_state = SS_ARY;
+ break;
case O_ARRAY:
- if (maxarg == 1) {
- ary = arg[1].arg_ptr.arg_stab->stab_array;
- maxarg = ary->ary_fill;
- maxsarg = maxarg + sargoff;
- if (retary) { /* array wanted */
- sarg = (STR **)saferealloc((char*)(sarg-sargoff),
- (maxsarg+3+cushion)*sizeof(STR*)) + sargoff;
- for (anum = 0; anum <= maxarg; anum++) {
- sarg[anum+1] = str = afetch(ary,anum);
- }
- maxarg++;
- maxsarg++;
- goto array_return;
+ ary = stab_array(arg[1].arg_ptr.arg_stab);
+ maxarg = ary->ary_fill + 1;
+ if (gimme == G_ARRAY) { /* array wanted */
+ sp = arglast[0];
+ st -= sp;
+ if (maxarg > 0 && sp + maxarg > stack->ary_max) {
+ astore(stack,sp + maxarg, Nullstr);
+ st = stack->ary_array;
}
- else
- str = afetch(ary,maxarg);
+ Copy(ary->ary_array, &st[sp+1], maxarg, STR*);
+ sp += maxarg;
+ goto array_return;
}
else
- str = afetch(arg[2].arg_ptr.arg_stab->stab_array,
- ((int)str_gnum(sarg[1])) - arybase);
+ str = afetch(ary,maxarg - 1,FALSE);
+ break;
+ case O_AELEM:
+ anum = ((int)str_gnum(st[2])) - arybase;
+ str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE);
if (!str)
- str = &str_no;
+ goto say_undef;
break;
case O_DELETE:
- tmpstab = arg[2].arg_ptr.arg_stab; /* XXX */
- str = hdelete(tmpstab->stab_hash,str_get(sarg[1]));
+ 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);
if (!str)
- str = &str_no;
+ goto say_undef;
+ break;
+ case O_LHASH:
+ str->str_nok = str->str_pok = 0;
+ str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
+ str->str_state = SS_HASH;
break;
case O_HASH:
- tmpstab = arg[2].arg_ptr.arg_stab; /* XXX */
- str = hfetch(tmpstab->stab_hash,str_get(sarg[1]));
+ if (gimme == G_ARRAY) { /* array wanted */
+ sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
+ gimme,arglast);
+ goto array_return;
+ }
+ else {
+ tmpstab = arg[1].arg_ptr.arg_stab;
+ sprintf(buf,"%d/%d",stab_hash(tmpstab)->tbl_fill,
+ stab_hash(tmpstab)->tbl_max+1);
+ str_set(str,buf);
+ }
+ break;
+ case O_HELEM:
+ 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)
- str = &str_no;
+ goto say_undef;
break;
- case O_LARRAY:
- anum = ((int)str_gnum(sarg[1])) - arybase;
- str = afetch(arg[2].arg_ptr.arg_stab->stab_array,anum);
- if (!str || str == &str_no) {
- str = str_new(0);
- astore(arg[2].arg_ptr.arg_stab->stab_array,anum,str);
- }
+ case O_LAELEM:
+ anum = ((int)str_gnum(st[2])) - arybase;
+ str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,TRUE);
+ if (!str)
+ fatal("Assignment to non-creatable value, subscript %d",anum);
break;
- case O_LHASH:
- tmpstab = arg[2].arg_ptr.arg_stab;
- str = hfetch(tmpstab->stab_hash,str_get(sarg[1]));
- if (!str) {
- str = str_new(0);
- hstore(tmpstab->stab_hash,str_get(sarg[1]),str);
- }
- if (tmpstab == envstab) { /* heavy wizardry going on here */
- str->str_link.str_magic = tmpstab;/* str is now magic */
- envname = savestr(str_get(sarg[1]));
+ case O_LHELEM:
+ tmpstab = arg[1].arg_ptr.arg_stab;
+ tmps = str_get(st[2]);
+ anum = st[2]->str_cur;
+ str = hfetch(stab_hash(tmpstab),tmps,anum,TRUE);
+ if (!str)
+ 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 */
/* he threw the brick up into the air */
- }
- else if (tmpstab == sigstab) { /* same thing, only different */
- str->str_link.str_magic = tmpstab;
- signame = savestr(str_get(sarg[1]));
- }
+ else if (tmpstab == sigstab)
+ str_magic(str, tmpstab, 'S', tmps, anum);
+#ifdef SOME_DBM
+ else if (stab_hash(tmpstab)->tbl_dbm)
+ str_magic(str, tmpstab, 'D', tmps, anum);
+#endif
break;
+ case O_ASLICE:
+ anum = TRUE;
+ argtype = FALSE;
+ goto do_slice_already;
+ case O_HSLICE:
+ anum = FALSE;
+ argtype = FALSE;
+ goto do_slice_already;
+ case O_LASLICE:
+ anum = TRUE;
+ argtype = TRUE;
+ goto do_slice_already;
+ case O_LHSLICE:
+ anum = FALSE;
+ argtype = TRUE;
+ do_slice_already:
+ sp = do_slice(arg[1].arg_ptr.arg_stab,anum,argtype,
+ gimme,arglast);
+ goto array_return;
case O_PUSH:
- if (arg[1].arg_flags & AF_SPECIAL)
- str = do_push(arg,arg[2].arg_ptr.arg_stab->stab_array);
+ if (arglast[2] - arglast[1] != 1)
+ str = do_push(stab_array(arg[1].arg_ptr.arg_stab),arglast);
else {
- str = str_new(0); /* must copy the STR */
- str_sset(str,sarg[1]);
- apush(arg[2].arg_ptr.arg_stab->stab_array,str);
+ str = Str_new(51,0); /* must copy the STR */
+ str_sset(str,st[2]);
+ (void)apush(stab_array(arg[1].arg_ptr.arg_stab),str);
}
break;
case O_POP:
- str = apop(arg[1].arg_ptr.arg_stab->stab_array);
- if (!str) {
- str = &str_no;
- break;
- }
-#ifdef STRUCTCOPY
- *(arg->arg_ptr.arg_str) = *str;
-#else
- bcopy((char*)str, (char*)arg->arg_ptr.arg_str, sizeof *str);
-#endif
- safefree((char*)str);
- str = arg->arg_ptr.arg_str;
- break;
+ str = apop(ary = stab_array(arg[1].arg_ptr.arg_stab));
+ goto staticalization;
case O_SHIFT:
- str = ashift(arg[1].arg_ptr.arg_stab->stab_array);
- if (!str) {
- str = &str_no;
- break;
- }
-#ifdef STRUCTCOPY
- *(arg->arg_ptr.arg_str) = *str;
-#else
- bcopy((char*)str, (char*)arg->arg_ptr.arg_str, sizeof *str);
-#endif
- safefree((char*)str);
- str = arg->arg_ptr.arg_str;
+ str = ashift(ary = stab_array(arg[1].arg_ptr.arg_stab));
+ staticalization:
+ if (!str)
+ goto say_undef;
+ if (ary->ary_flags & ARF_REAL)
+ (void)str_2static(str);
break;
+ case O_UNPACK:
+ sp = do_unpack(str,gimme,arglast);
+ goto array_return;
case O_SPLIT:
- value = (double) do_split(arg[2].arg_ptr.arg_spat,
- retary,sarg,&maxsarg,sargoff,cushion);
- if (retary) {
- sarg = *retary; /* they realloc it */
- goto array_return;
- }
- goto donumset;
+ value = str_gnum(st[3]);
+ sp = do_split(str, arg[2].arg_ptr.arg_spat, (int)value,
+ gimme,arglast);
+ goto array_return;
case O_LENGTH:
- value = (double) str_len(sarg[1]);
+ if (maxarg < 1)
+ value = (double)str_len(stab_val(defstab));
+ else
+ value = (double)str_len(st[1]);
goto donumset;
case O_SPRINTF:
- sarg[maxsarg+1] = Nullstr;
- do_sprintf(str,arg->arg_len,sarg);
+ do_sprintf(str, sp-arglast[0], st+1);
break;
case O_SUBSTR:
- anum = ((int)str_gnum(sarg[2])) - arybase;
- for (tmps = str_get(sarg[1]); *tmps && anum > 0; tmps++,anum--) ;
- anum = (int)str_gnum(sarg[3]);
- if (anum >= 0 && strlen(tmps) > anum)
+ anum = ((int)str_gnum(st[2])) - arybase; /* anum=where to start*/
+ tmps = str_get(st[1]); /* force conversion to string */
+ if (argtype = (str == st[1]))
+ str = arg->arg_ptr.arg_str;
+ if (anum < 0)
+ anum += st[1]->str_cur + arybase;
+ if (anum < 0 || anum > st[1]->str_cur)
+ str_nset(str,"",0);
+ else {
+ optype = (int)str_gnum(st[3]);
+ if (optype < 0)
+ optype = 0;
+ tmps += anum;
+ anum = st[1]->str_cur - anum; /* anum=how many bytes left*/
+ if (anum > optype)
+ anum = optype;
str_nset(str, tmps, anum);
- else
- str_set(str, tmps);
+ if (argtype) { /* it's an lvalue! */
+ lstr = (struct lstring*)str;
+ str->str_magic = st[1];
+ st[1]->str_rare = 's';
+ lstr->lstr_offset = tmps - str_get(st[1]);
+ lstr->lstr_len = anum;
+ }
+ }
break;
+ case O_PACK:
+ (void)do_pack(str,arglast);
+ break;
+ case O_GREP:
+ sp = do_grep(arg,str,gimme,arglast);
+ goto array_return;
case O_JOIN:
- if (arg[2].arg_flags & AF_SPECIAL && arg[2].arg_type == A_EXPR)
- do_join(arg,str_get(sarg[1]),str);
- else
- ajoin(arg[2].arg_ptr.arg_stab->stab_array,str_get(sarg[1]),str);
+ do_join(str,arglast);
break;
case O_SLT:
- tmps = str_get(sarg[1]);
- value = (double) strLT(tmps,str_get(sarg[2]));
+ tmps = str_get(st[1]);
+ value = (double) (str_cmp(st[1],st[2]) < 0);
goto donumset;
case O_SGT:
- tmps = str_get(sarg[1]);
- value = (double) strGT(tmps,str_get(sarg[2]));
+ tmps = str_get(st[1]);
+ value = (double) (str_cmp(st[1],st[2]) > 0);
goto donumset;
case O_SLE:
- tmps = str_get(sarg[1]);
- value = (double) strLE(tmps,str_get(sarg[2]));
+ tmps = str_get(st[1]);
+ value = (double) (str_cmp(st[1],st[2]) <= 0);
goto donumset;
case O_SGE:
- tmps = str_get(sarg[1]);
- value = (double) strGE(tmps,str_get(sarg[2]));
+ tmps = str_get(st[1]);
+ value = (double) (str_cmp(st[1],st[2]) >= 0);
goto donumset;
case O_SEQ:
- tmps = str_get(sarg[1]);
- value = (double) strEQ(tmps,str_get(sarg[2]));
+ tmps = str_get(st[1]);
+ value = (double) str_eq(st[1],st[2]);
goto donumset;
case O_SNE:
- tmps = str_get(sarg[1]);
- value = (double) strNE(tmps,str_get(sarg[2]));
+ tmps = str_get(st[1]);
+ value = (double) !str_eq(st[1],st[2]);
goto donumset;
case O_SUBR:
- str_sset(str,do_subr(arg,sarg));
- STABSET(str);
- break;
+ 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);
+ st = stack->ary_array + arglast[0]; /* maybe realloced */
+ goto array_return;
case O_SORT:
- if (maxarg <= 1)
+ 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,
+ gimme,arglast);
+ goto array_return;
+ case O_REVERSE:
+ sp = do_reverse(str,
+ gimme,arglast);
+ goto array_return;
+ case O_WARN:
+ if (arglast[2] - arglast[1] != 1) {
+ do_join(str,arglast);
+ tmps = str_get(st[1]);
+ }
else {
- if (arg[2].arg_type == A_WORD)
- stab = arg[2].arg_ptr.arg_stab;
- else
- stab = stabent(str_get(sarg[2]),TRUE);
- if (!stab)
- stab = defoutstab;
+ str = st[2];
+ tmps = str_get(st[2]);
}
- value = (double)do_sort(arg,stab,
- retary,sarg,&maxsarg,sargoff,cushion);
- if (retary) {
- sarg = *retary; /* they realloc it */
- goto array_return;
+ if (!tmps || !*tmps)
+ tmps = "Warning: something's wrong";
+ warn("%s",tmps);
+ goto say_yes;
+ case O_DIE:
+ if (arglast[2] - arglast[1] != 1) {
+ do_join(str,arglast);
+ tmps = str_get(st[1]);
}
- goto donumset;
+ else {
+ str = st[2];
+ tmps = str_get(st[2]);
+ }
+ if (!tmps || !*tmps)
+ exit(1);
+ fatal("%s",tmps);
+ goto say_zero;
case O_PRTF:
case O_PRINT:
- if (maxarg <= 1)
+ 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;
- else {
- if (arg[2].arg_type == A_WORD)
- stab = arg[2].arg_ptr.arg_stab;
- else
- stab = stabent(str_get(sarg[2]),TRUE);
- if (!stab)
- stab = defoutstab;
+ if (!stab_io(stab)) {
+ if (dowarn)
+ warn("Filehandle never opened");
+ goto say_zero;
+ }
+ if (!(fp = stab_io(stab)->ofp)) {
+ if (dowarn) {
+ if (stab_io(stab)->ifp)
+ warn("Filehandle opened only for input");
+ else
+ warn("Print on closed filehandle");
+ }
+ goto say_zero;
}
- if (!stab->stab_io || !(fp = stab->stab_io->fp))
- value = 0.0;
else {
- if (arg[1].arg_flags & AF_SPECIAL)
- value = (double)do_aprint(arg,fp);
+ if (optype == O_PRTF || arglast[2] - arglast[1] != 1)
+ value = (double)do_aprint(arg,fp,arglast);
else {
- value = (double)do_print(sarg[1],fp);
- if (ors && optype == O_PRINT)
- fputs(ors, fp);
+ value = (double)do_print(st[2],fp);
+ if (orslen && optype == O_PRINT)
+ if (fwrite(ors, 1, orslen, fp) == 0)
+ goto say_zero;
}
- if (stab->stab_io->flags & IOF_FLUSH)
- fflush(fp);
+ if (stab_io(stab)->flags & IOF_FLUSH)
+ if (fflush(fp) == EOF)
+ goto say_zero;
}
goto donumset;
case O_CHDIR:
- tmps = str_get(sarg[1]);
- if (!tmps || !*tmps)
- tmps = getenv("HOME");
- if (!tmps || !*tmps)
- tmps = getenv("LOGDIR");
+ if (maxarg < 1)
+ tmps = str_get(stab_val(defstab));
+ else
+ tmps = str_get(st[1]);
+ if (!tmps || !*tmps) {
+ tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE);
+ if (tmpstr)
+ tmps = str_get(tmpstr);
+ }
+ if (!tmps || !*tmps) {
+ tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE);
+ if (tmpstr)
+ tmps = str_get(tmpstr);
+ }
+#ifdef TAINT
+ taintproper("Insecure dependency in chdir");
+#endif
value = (double)(chdir(tmps) >= 0);
goto donumset;
- case O_DIE:
- tmps = str_get(sarg[1]);
- if (!tmps || !*tmps)
- exit(1);
- fatal("%s",str_get(sarg[1]));
- value = 0.0;
- goto donumset;
case O_EXIT:
- exit((int)str_gnum(sarg[1]));
- value = 0.0;
- goto donumset;
+ if (maxarg < 1)
+ anum = 0;
+ else
+ anum = (int)str_gnum(st[1]);
+ exit(anum);
+ goto say_zero;
case O_RESET:
- str_reset(str_get(sarg[1]));
+ if (maxarg < 1)
+ tmps = "";
+ else
+ tmps = str_get(st[1]);
+ str_reset(tmps,arg[2].arg_ptr.arg_hash);
value = 1.0;
goto donumset;
case O_LIST:
- if (arg->arg_flags & AF_LOCAL)
- savelist(sarg,maxsarg);
+ if (gimme == G_ARRAY)
+ goto array_return;
if (maxarg > 0)
- str = sarg[maxsarg]; /* unwanted list, return last item */
+ str = st[sp - arglast[0]]; /* unwanted list, return last item */
else
- str = &str_no;
- if (retary)
- goto array_return;
+ str = &str_undef;
break;
case O_EOF:
if (maxarg <= 0)
stab = last_in_stab;
- else if (arg[1].arg_type == A_WORD)
+ else if ((arg[1].arg_type & A_MASK) == A_WORD)
stab = arg[1].arg_ptr.arg_stab;
else
- stab = stabent(str_get(sarg[1]),TRUE);
+ stab = stabent(str_get(st[1]),TRUE);
str_set(str, do_eof(stab) ? Yes : No);
STABSET(str);
break;
- case O_TELL:
+ case O_GETC:
if (maxarg <= 0)
- stab = last_in_stab;
- else if (arg[1].arg_type == A_WORD)
+ stab = stdinstab;
+ else if ((arg[1].arg_type & A_MASK) == A_WORD)
stab = arg[1].arg_ptr.arg_stab;
else
- stab = stabent(str_get(sarg[1]),TRUE);
- value = (double)do_tell(stab);
- goto donumset;
- case O_SEEK:
- if (arg[1].arg_type == A_WORD)
+ stab = stabent(str_get(st[1]),TRUE);
+ if (do_eof(stab)) /* make sure we have fp with something */
+ str_set(str, No);
+ else {
+#ifdef TAINT
+ tainted = 1;
+#endif
+ str_set(str," ");
+ *str->str_ptr = getc(stab_io(stab)->ifp); /* should never be EOF */
+ }
+ STABSET(str);
+ break;
+ case O_TELL:
+ if (maxarg <= 0)
+ stab = last_in_stab;
+ else if ((arg[1].arg_type & A_MASK) == A_WORD)
+ stab = arg[1].arg_ptr.arg_stab;
+ else
+ stab = stabent(str_get(st[1]),TRUE);
+#ifndef lint
+ value = (double)do_tell(stab);
+#else
+ (void)do_tell(stab);
+#endif
+ goto donumset;
+ case O_RECV:
+ case O_READ:
+ 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;
+ if (!stab_io(stab) || !stab_io(stab)->ifp)
+ goto say_zero;
+#ifdef SOCKET
+ else if (optype == O_RECV) {
+ argtype = sizeof buf;
+ optype = (int)str_gnum(st[4]);
+ anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, optype,
+ buf, &argtype);
+ if (anum >= 0) {
+ st[2]->str_cur = anum;
+ st[2]->str_ptr[anum] = '\0';
+ str_nset(str,buf,argtype);
+ }
+ else
+ 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)
+ goto badsock;
+#endif
+ else
+ anum = fread(tmps, 1, anum, stab_io(stab)->ifp);
+ if (anum < 0)
+ goto say_undef;
+ st[2]->str_cur = anum;
+ st[2]->str_ptr[anum] = '\0';
+ value = (double)anum;
+ goto donumset;
+ 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);
+ if (!stio || !stio->ifp) {
+ anum = -1;
+ if (dowarn)
+ warn("Send on closed socket");
+ }
+ else if (optype >= 4) {
+ 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);
+ 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;
else
- stab = stabent(str_get(sarg[1]),TRUE);
- value = str_gnum(sarg[2]);
+ stab = stabent(str_get(st[1]),TRUE);
+ value = str_gnum(st[2]);
str_set(str, do_seek(stab,
- (long)value, (int)str_gnum(sarg[3]) ) ? Yes : No);
+ (long)value, (int)str_gnum(st[3]) ) ? Yes : No);
STABSET(str);
break;
+ case O_RETURN:
+ tmps = "SUB"; /* just fake up a "last SUB" */
+ optype = O_LAST;
+ if (gimme == G_ARRAY) {
+ lastretstr = Nullstr;
+ lastspbase = arglast[1];
+ lastsize = arglast[2] - arglast[1];
+ }
+ else
+ lastretstr = str_static(st[arglast[2] - arglast[0]]);
+ goto dopop;
case O_REDO:
case O_NEXT:
case O_LAST:
if (maxarg > 0) {
- tmps = str_get(sarg[1]);
+ tmps = str_get(arg[1].arg_ptr.arg_str);
+ dopop:
while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
#ifdef DEBUGGING
}
if (loop_ptr < 0)
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]);
+ }
+ longjmp(loop_stack[loop_ptr].loop_env, O_LAST);
+ }
longjmp(loop_stack[loop_ptr].loop_env, optype);
+ case O_DUMP:
case O_GOTO:/* shudder */
- goto_targ = str_get(sarg[1]);
+ goto_targ = str_get(arg[1].arg_ptr.arg_str);
+ if (!*goto_targ)
+ goto_targ = Nullch; /* just restart from top */
+ if (optype == O_DUMP) {
+ do_undump = 1;
+ abort();
+ }
longjmp(top_env, 1);
case O_INDEX:
- tmps = str_get(sarg[1]);
- if (!(tmps2 = fbminstr(tmps, tmps + sarg[1]->str_cur, sarg[2])))
+ tmps = str_get(st[1]);
+#ifndef lint
+ if (!(tmps2 = fbminstr((unsigned char*)tmps,
+ (unsigned char*)tmps + st[1]->str_cur, st[2])))
+#else
+ if (tmps2 = fbminstr(Null(unsigned char*),Null(unsigned char*),Nullstr))
+#endif
+ value = (double)(-1 + arybase);
+ else
+ value = (double)(tmps2 - tmps + arybase);
+ goto donumset;
+ case O_RINDEX:
+ tmps = str_get(st[1]);
+ tmps2 = str_get(st[2]);
+#ifndef lint
+ if (!(tmps2 = rninstr(tmps, tmps + st[1]->str_cur,
+ tmps2, tmps2 + st[2]->str_cur)))
+#else
+ if (tmps2 = rninstr(Nullch,Nullch,Nullch,Nullch))
+#endif
value = (double)(-1 + arybase);
else
value = (double)(tmps2 - tmps + arybase);
goto donumset;
case O_TIME:
+#ifndef lint
value = (double) time(Null(long*));
+#endif
goto donumset;
case O_TMS:
- value = (double) do_tms(retary,sarg,&maxsarg,sargoff,cushion);
- if (retary) {
- sarg = *retary; /* they realloc it */
- goto array_return;
- }
- goto donumset;
+ sp = do_tms(str,gimme,arglast);
+ goto array_return;
case O_LOCALTIME:
- when = (long)str_gnum(sarg[1]);
- value = (double)do_time(localtime(&when),
- retary,sarg,&maxsarg,sargoff,cushion);
- if (retary) {
- sarg = *retary; /* they realloc it */
- goto array_return;
- }
- goto donumset;
+ if (maxarg < 1)
+ (void)time(&when);
+ else
+ when = (long)str_gnum(st[1]);
+ sp = do_time(str,localtime(&when),
+ gimme,arglast);
+ goto array_return;
case O_GMTIME:
- when = (long)str_gnum(sarg[1]);
- value = (double)do_time(gmtime(&when),
- retary,sarg,&maxsarg,sargoff,cushion);
- if (retary) {
- sarg = *retary; /* they realloc it */
- goto array_return;
- }
- goto donumset;
+ if (maxarg < 1)
+ (void)time(&when);
+ else
+ when = (long)str_gnum(st[1]);
+ sp = do_time(str,gmtime(&when),
+ gimme,arglast);
+ goto array_return;
+ case O_LSTAT:
case O_STAT:
- value = (double) do_stat(arg,
- retary,sarg,&maxsarg,sargoff,cushion);
- if (retary) {
- sarg = *retary; /* they realloc it */
- goto array_return;
- }
- goto donumset;
+ sp = do_stat(str,arg,
+ gimme,arglast);
+ goto array_return;
case O_CRYPT:
#ifdef CRYPT
- tmps = str_get(sarg[1]);
- str_set(str,crypt(tmps,str_get(sarg[2])));
+ tmps = str_get(st[1]);
+#ifdef FCRYPT
+ str_set(str,fcrypt(tmps,str_get(st[2])));
+#else
+ str_set(str,crypt(tmps,str_get(st[2])));
+#endif
#else
fatal(
"The crypt() function is unimplemented due to excessive paranoia.");
#endif
break;
+ case O_ATAN2:
+ value = str_gnum(st[1]);
+ value = atan2(value,str_gnum(st[2]));
+ goto donumset;
+ case O_SIN:
+ if (maxarg < 1)
+ value = str_gnum(stab_val(defstab));
+ else
+ value = str_gnum(st[1]);
+ value = sin(value);
+ goto donumset;
+ case O_COS:
+ if (maxarg < 1)
+ value = str_gnum(stab_val(defstab));
+ else
+ value = str_gnum(st[1]);
+ value = cos(value);
+ goto donumset;
+ case O_RAND:
+ if (maxarg < 1)
+ value = 1.0;
+ else
+ value = str_gnum(st[1]);
+ if (value == 0.0)
+ value = 1.0;
+#if RANDBITS == 31
+ value = rand() * value / 2147483648.0;
+#else
+#if RANDBITS == 16
+ value = rand() * value / 65536.0;
+#else
+#if RANDBITS == 15
+ value = rand() * value / 32768.0;
+#else
+ value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
+#endif
+#endif
+#endif
+ goto donumset;
+ case O_SRAND:
+ if (maxarg < 1) {
+ (void)time(&when);
+ anum = when;
+ }
+ else
+ anum = (int)str_gnum(st[1]);
+ (void)srand(anum);
+ goto say_yes;
case O_EXP:
- value = exp(str_gnum(sarg[1]));
+ if (maxarg < 1)
+ value = str_gnum(stab_val(defstab));
+ else
+ value = str_gnum(st[1]);
+ value = exp(value);
goto donumset;
case O_LOG:
- value = log(str_gnum(sarg[1]));
+ if (maxarg < 1)
+ value = str_gnum(stab_val(defstab));
+ else
+ value = str_gnum(st[1]);
+ value = log(value);
goto donumset;
case O_SQRT:
- value = sqrt(str_gnum(sarg[1]));
+ if (maxarg < 1)
+ value = str_gnum(stab_val(defstab));
+ else
+ value = str_gnum(st[1]);
+ value = sqrt(value);
goto donumset;
case O_INT:
- value = str_gnum(sarg[1]);
+ if (maxarg < 1)
+ value = str_gnum(stab_val(defstab));
+ else
+ value = str_gnum(st[1]);
if (value >= 0.0)
- modf(value,&value);
+ (void)modf(value,&value);
else {
- modf(-value,&value);
+ (void)modf(-value,&value);
value = -value;
}
goto donumset;
case O_ORD:
- value = (double) *str_get(sarg[1]);
+ if (maxarg < 1)
+ tmps = str_get(stab_val(defstab));
+ else
+ tmps = str_get(st[1]);
+#ifndef I286
+ value = (double) (*tmps & 255);
+#else
+ anum = (int) *tmps;
+ value = (double) (anum & 255);
+#endif
goto donumset;
case O_SLEEP:
- tmps = str_get(sarg[1]);
- time(&when);
+ if (maxarg < 1)
+ tmps = Nullch;
+ else
+ tmps = str_get(st[1]);
+ (void)time(&when);
if (!tmps || !*tmps)
sleep((32767<<16)+32767);
else
- sleep((unsigned)atoi(tmps));
+ sleep((unsigned int)atoi(tmps));
+#ifndef lint
value = (double)when;
- time(&when);
+ (void)time(&when);
value = ((double)when) - value;
+#endif
goto donumset;
+ case O_RANGE:
+ sp = do_range(gimme,arglast);
+ goto array_return;
+ case O_F_OR_R:
+ if (gimme == G_ARRAY) { /* it's a range */
+ /* can we optimize to constant array? */
+ if ((arg[1].arg_type & A_MASK) == A_SINGLE &&
+ (arg[2].arg_type & A_MASK) == A_SINGLE) {
+ st[2] = arg[2].arg_ptr.arg_str;
+ sp = do_range(gimme,arglast);
+ st = stack->ary_array;
+ maxarg = sp - arglast[0];
+ str_free(arg[1].arg_ptr.arg_str);
+ str_free(arg[2].arg_ptr.arg_str);
+ 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);
+ st += arglast[0]+1;
+ while (maxarg-- > 0)
+ ary->ary_array[maxarg] = str_smake(st[maxarg]);
+ goto array_return;
+ }
+ arg->arg_type = optype = O_RANGE;
+ maxarg = arg->arg_len = 2;
+ anum = 2;
+ arg[anum].arg_flags &= ~AF_ARYOK;
+ argflags = arg[anum].arg_flags;
+ argtype = arg[anum].arg_type & A_MASK;
+ arg[anum].arg_type = argtype;
+ argptr = arg[anum].arg_ptr;
+ sp = arglast[0];
+ st -= sp;
+ sp++;
+ goto re_eval;
+ }
+ arg->arg_type = O_FLIP;
+ /* FALL THROUGH */
case O_FLIP:
- if (str_true(sarg[1])) {
+ if ((arg[1].arg_type & A_MASK) == A_SINGLE ?
+ 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_flags &= ~AF_SPECIAL;
- arg[1].arg_flags |= AF_SPECIAL;
+ arg[2].arg_type &= ~A_DONT;
+ arg[1].arg_type |= A_DONT;
argflags = arg[2].arg_flags;
- argtype = arg[2].arg_type;
+ argtype = arg[2].arg_type & A_MASK;
argptr = arg[2].arg_ptr;
+ sp = arglast[0];
+ st -= sp;
goto re_eval;
}
str_set(str,"");
break;
case O_FLOP:
str_inc(str);
- if (str_true(sarg[2])) {
+ if ((arg[2].arg_type & A_MASK) == A_SINGLE ?
+ last_in_stab && (int)str_gnum(st[2]) == stab_io(last_in_stab)->lines
+ :
+ str_true(st[2]) ) {
arg->arg_type = O_FLIP;
- arg[1].arg_flags &= ~AF_SPECIAL;
- arg[2].arg_flags |= AF_SPECIAL;
+ arg[1].arg_type &= ~A_DONT;
+ arg[2].arg_type |= A_DONT;
str_cat(str,"E0");
}
break;
case O_FORK:
- value = (double)fork();
+ anum = fork();
+ if (!anum && (tmpstab = stabent("$",allstabs)))
+ str_numset(STAB_STR(tmpstab),(double)getpid());
+ value = (double)anum;
goto donumset;
case O_WAIT:
+#ifndef lint
ihand = signal(SIGINT, SIG_IGN);
qhand = signal(SIGQUIT, SIG_IGN);
- value = (double)wait(&argflags);
- signal(SIGINT, ihand);
- signal(SIGQUIT, qhand);
+ anum = wait(&argflags);
+ if (anum > 0)
+ pidgone(anum,argflags);
+ value = (double)anum;
+#else
+ ihand = qhand = 0;
+#endif
+ (void)signal(SIGINT, ihand);
+ (void)signal(SIGQUIT, qhand);
statusvalue = (unsigned short)argflags;
goto donumset;
case O_SYSTEM:
+#ifdef TAINT
+ if (arglast[2] - arglast[1] == 1) {
+ taintenv();
+ tainted |= st[2]->str_tainted;
+ taintproper("Insecure dependency in system");
+ }
+#endif
while ((anum = vfork()) == -1) {
if (errno != EAGAIN) {
value = -1.0;
sleep(5);
}
if (anum > 0) {
+#ifndef lint
ihand = signal(SIGINT, SIG_IGN);
qhand = signal(SIGQUIT, SIG_IGN);
- while ((argtype = wait(&argflags)) != anum && argtype != -1)
- ;
- signal(SIGINT, ihand);
- signal(SIGQUIT, qhand);
+ while ((argtype = wait(&argflags)) != anum && argtype >= 0)
+ pidgone(argtype,argflags);
+#else
+ ihand = qhand = 0;
+#endif
+ (void)signal(SIGINT, ihand);
+ (void)signal(SIGQUIT, qhand);
statusvalue = (unsigned short)argflags;
if (argtype == -1)
value = -1.0;
}
goto donumset;
}
- if (arg[1].arg_flags & AF_SPECIAL)
- value = (double)do_aexec(arg);
+ 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_static(sarg[1]));
+ value = (double)do_exec(str_get(str_static(st[2])));
}
_exit(-1);
case O_EXEC:
- if (arg[1].arg_flags & AF_SPECIAL)
- value = (double)do_aexec(arg);
+ 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_static(sarg[1]));
+ value = (double)do_exec(str_get(str_static(st[2])));
}
goto donumset;
case O_HEX:
snarfnum:
anum = 0;
- tmps = str_get(sarg[1]);
+ if (maxarg < 1)
+ tmps = str_get(stab_val(defstab));
+ else
+ tmps = str_get(st[1]);
for (;;) {
switch (*tmps) {
default:
case O_KILL:
case O_UNLINK:
case O_UTIME:
- if (arg[1].arg_flags & AF_SPECIAL)
- value = (double)apply(optype,arg,Null(STR**));
- else {
- sarg[2] = Nullstr;
- value = (double)apply(optype,arg,sarg);
- }
+ value = (double)apply(optype,arglast);
goto donumset;
case O_UMASK:
- value = (double)umask((int)str_gnum(sarg[1]));
+ if (maxarg < 1) {
+ anum = umask(0);
+ (void)umask(anum);
+ }
+ else
+ anum = umask((int)str_gnum(st[1]));
+ value = (double)anum;
+#ifdef TAINT
+ taintproper("Insecure dependency in umask");
+#endif
goto donumset;
case O_RENAME:
- tmps = str_get(sarg[1]);
+ tmps = str_get(st[1]);
+ tmps2 = str_get(st[2]);
+#ifdef TAINT
+ taintproper("Insecure dependency in rename");
+#endif
#ifdef RENAME
- value = (double)(rename(tmps,str_get(sarg[2])) >= 0);
+ value = (double)(rename(tmps,tmps2) >= 0);
#else
- tmps2 = str_get(sarg[2]);
if (euid || stat(tmps2,&statbuf) < 0 ||
(statbuf.st_mode & S_IFMT) != S_IFDIR )
- UNLINK(tmps2); /* avoid unlinking a directory */
+ (void)UNLINK(tmps2); /* avoid unlinking a directory */
if (!(anum = link(tmps,tmps2)))
anum = UNLINK(tmps);
value = (double)(anum >= 0);
#endif
goto donumset;
case O_LINK:
- tmps = str_get(sarg[1]);
- value = (double)(link(tmps,str_get(sarg[2])) >= 0);
+ tmps = str_get(st[1]);
+ tmps2 = str_get(st[2]);
+#ifdef TAINT
+ taintproper("Insecure dependency in link");
+#endif
+ value = (double)(link(tmps,tmps2) >= 0);
+ goto donumset;
+ case O_MKDIR:
+ tmps = str_get(st[1]);
+ anum = (int)str_gnum(st[2]);
+#ifdef TAINT
+ taintproper("Insecure dependency in mkdir");
+#endif
+#ifdef MKDIR
+ value = (double)(mkdir(tmps,anum) >= 0);
+ goto donumset;
+#else
+ (void)strcpy(buf,"mkdir ");
+#endif
+#if !defined(MKDIR) || !defined(RMDIR)
+ one_liner:
+ for (tmps2 = buf+6; *tmps; ) {
+ *tmps2++ = '\\';
+ *tmps2++ = *tmps++;
+ }
+ (void)strcpy(tmps2," 2>&1");
+ rsfp = mypopen(buf,"r");
+ if (rsfp) {
+ *buf = '\0';
+ tmps2 = fgets(buf,sizeof buf,rsfp);
+ (void)mypclose(rsfp);
+ if (tmps2 != Nullch) {
+ for (errno = 1; errno < sys_nerr; errno++) {
+ if (instr(buf,sys_errlist[errno])) /* you don't see this */
+ goto say_zero;
+ }
+ errno = 0;
+#ifndef EACCES
+#define EACCES EPERM
+#endif
+ if (instr(buf,"cannot make"))
+ errno = EEXIST;
+ else if (instr(buf,"non-exist"))
+ errno = ENOENT;
+ else if (instr(buf,"not empty"))
+ errno = EBUSY;
+ else if (instr(buf,"cannot access"))
+ errno = EACCES;
+ else
+ errno = EPERM;
+ goto say_zero;
+ }
+ else { /* some mkdirs return no failure indication */
+ tmps = str_get(st[1]);
+ anum = (stat(tmps,&statbuf) >= 0);
+ if (optype == O_RMDIR)
+ anum = !anum;
+ if (anum)
+ errno = 0;
+ else
+ errno = EACCES; /* a guess */
+ value = (double)anum;
+ }
+ goto donumset;
+ }
+ else
+ goto say_zero;
+#endif
+ case O_RMDIR:
+ if (maxarg < 1)
+ tmps = str_get(stab_val(defstab));
+ else
+ tmps = str_get(st[1]);
+#ifdef TAINT
+ taintproper("Insecure dependency in rmdir");
+#endif
+#ifdef RMDIR
+ value = (double)(rmdir(tmps) >= 0);
+ goto donumset;
+#else
+ (void)strcpy(buf,"rmdir ");
+ goto one_liner; /* see above in MKDIR */
+#endif
+ case O_GETPPID:
+ value = (double)getppid();
+ goto donumset;
+ case O_GETPGRP:
+#ifdef GETPGRP
+ if (maxarg < 1)
+ anum = 0;
+ else
+ anum = (int)str_gnum(st[1]);
+ value = (double)getpgrp(anum);
+ goto donumset;
+#else
+ fatal("The getpgrp() function is unimplemented on this machine");
+ break;
+#endif
+ case O_SETPGRP:
+#ifdef SETPGRP
+ argtype = (int)str_gnum(st[1]);
+ anum = (int)str_gnum(st[2]);
+#ifdef TAINT
+ taintproper("Insecure dependency in setpgrp");
+#endif
+ value = (double)(setpgrp(argtype,anum) >= 0);
+ goto donumset;
+#else
+ fatal("The setpgrp() function is unimplemented on this machine");
+ break;
+#endif
+ case O_GETPRIORITY:
+#ifdef GETPRIORITY
+ argtype = (int)str_gnum(st[1]);
+ anum = (int)str_gnum(st[2]);
+ value = (double)getpriority(argtype,anum);
+ goto donumset;
+#else
+ fatal("The getpriority() function is unimplemented on this machine");
+ break;
+#endif
+ case O_SETPRIORITY:
+#ifdef SETPRIORITY
+ argtype = (int)str_gnum(st[1]);
+ anum = (int)str_gnum(st[2]);
+ optype = (int)str_gnum(st[3]);
+#ifdef TAINT
+ taintproper("Insecure dependency in setpriority");
+#endif
+ value = (double)(setpriority(argtype,anum,optype) >= 0);
+ goto donumset;
+#else
+ fatal("The setpriority() function is unimplemented on this machine");
+ break;
+#endif
+ case O_CHROOT:
+ if (maxarg < 1)
+ tmps = str_get(stab_val(defstab));
+ else
+ tmps = str_get(st[1]);
+#ifdef TAINT
+ taintproper("Insecure dependency in chroot");
+#endif
+ value = (double)(chroot(tmps) >= 0);
+ goto donumset;
+ case O_FCNTL:
+ case O_IOCTL:
+ if (maxarg <= 0)
+ stab = last_in_stab;
+ else if ((arg[1].arg_type & A_MASK) == A_WORD)
+ stab = arg[1].arg_ptr.arg_stab;
+ else
+ stab = stabent(str_get(st[1]),TRUE);
+ argtype = (int)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)
+ goto donumset;
+ str_set(str,"0 but true");
+ STABSET(str);
+ break;
+ case O_FLOCK:
+#ifdef FLOCK
+ if (maxarg <= 0)
+ stab = last_in_stab;
+ else 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_io(stab))
+ fp = stab_io(stab)->ifp;
+ else
+ fp = Nullfp;
+ if (fp) {
+ argtype = (int)str_gnum(st[2]);
+ value = (double)(flock(fileno(fp),argtype) >= 0);
+ }
+ else
+ value = 0;
goto donumset;
+#else
+ fatal("The flock() function is unimplemented on this machine");
+ break;
+#endif
case O_UNSHIFT:
- ary = arg[2].arg_ptr.arg_stab->stab_array;
- if (arg[1].arg_flags & AF_SPECIAL)
- do_unshift(arg,ary);
+ ary = stab_array(arg[1].arg_ptr.arg_stab);
+ if (arglast[2] - arglast[1] != 1)
+ do_unshift(ary,arglast);
else {
- str = str_new(0); /* must copy the STR */
- str_sset(str,sarg[1]);
+ str = Str_new(52,0); /* must copy the STR */
+ str_sset(str,st[2]);
aunshift(ary,1);
- astore(ary,0,str);
+ (void)astore(ary,0,str);
}
value = (double)(ary->ary_fill + 1);
break;
case O_DOFILE:
case O_EVAL:
- str_sset(str,
- do_eval(arg[1].arg_type != A_NULL ? sarg[1] : defstab->stab_val,
- optype) );
- STABSET(str);
- break;
+ if (maxarg < 1)
+ tmpstr = stab_val(defstab);
+ else
+ tmpstr =
+ (arg[1].arg_type & A_MASK) != A_NULL ? st[1] : stab_val(defstab);
+#ifdef TAINT
+ tainted |= tmpstr->str_tainted;
+ taintproper("Insecure dependency in eval");
+#endif
+ sp = do_eval(tmpstr, optype, arg[2].arg_ptr.arg_hash,
+ gimme,arglast);
+ goto array_return;
case O_FTRREAD:
argtype = 0;
argtype = 1;
anum = S_IEXEC;
check_perm:
- str = &str_no;
- if (mystat(arg,sarg[1]) < 0)
- break;
- if (cando(anum,argtype))
- str = &str_yes;
- break;
+ if (mystat(arg,st[1]) < 0)
+ goto say_undef;
+ if (cando(anum,argtype,&statcache))
+ goto say_yes;
+ goto say_no;
case O_FTIS:
- if (mystat(arg,sarg[1]) >= 0)
- str = &str_yes;
- else
- str = &str_no;
- break;
+ if (mystat(arg,st[1]) < 0)
+ goto say_undef;
+ goto say_yes;
case O_FTEOWNED:
case O_FTROWNED:
- if (mystat(arg,sarg[1]) >= 0 &&
- statbuf.st_uid == (optype == O_FTEOWNED ? euid : uid) )
- str = &str_yes;
- else
- str = &str_no;
- break;
+ if (mystat(arg,st[1]) < 0)
+ goto say_undef;
+ if (statcache.st_uid == (optype == O_FTEOWNED ? euid : uid) )
+ goto say_yes;
+ goto say_no;
case O_FTZERO:
- if (mystat(arg,sarg[1]) >= 0 && !statbuf.st_size)
- str = &str_yes;
- else
- str = &str_no;
- break;
+ if (mystat(arg,st[1]) < 0)
+ goto say_undef;
+ if (!statcache.st_size)
+ goto say_yes;
+ goto say_no;
case O_FTSIZE:
- if (mystat(arg,sarg[1]) >= 0 && statbuf.st_size)
- str = &str_yes;
- else
- str = &str_no;
- break;
+ if (mystat(arg,st[1]) < 0)
+ goto say_undef;
+ if (statcache.st_size)
+ goto say_yes;
+ goto say_no;
case O_FTSOCK:
#ifdef S_IFSOCK
anum = S_IFSOCK;
goto check_file_type;
#else
- str = &str_no;
- break;
+ goto say_no;
#endif
case O_FTCHR:
anum = S_IFCHR;
case O_FTDIR:
anum = S_IFDIR;
check_file_type:
- if (mystat(arg,sarg[1]) >= 0 &&
- (statbuf.st_mode & S_IFMT) == anum )
- str = &str_yes;
- else
- str = &str_no;
- break;
+ if (mystat(arg,st[1]) < 0)
+ goto say_undef;
+ if ((statcache.st_mode & S_IFMT) == anum )
+ goto say_yes;
+ goto say_no;
case O_FTPIPE:
#ifdef S_IFIFO
anum = S_IFIFO;
goto check_file_type;
#else
- str = &str_no;
- break;
+ goto say_no;
#endif
case O_FTLINK:
-#ifdef S_IFLNK
- if (lstat(str_get(sarg[1]),&statbuf) >= 0 &&
- (statbuf.st_mode & S_IFMT) == S_IFLNK )
- str = &str_yes;
- else
+#ifdef LSTAT
+ if (lstat(str_get(st[1]),&statcache) < 0)
+ goto say_undef;
+ if ((statcache.st_mode & S_IFMT) == S_IFLNK )
+ goto say_yes;
#endif
- str = &str_no;
- break;
+ goto say_no;
case O_SYMLINK:
#ifdef SYMLINK
- tmps = str_get(sarg[1]);
- value = (double)(symlink(tmps,str_get(sarg[2])) >= 0);
+ tmps = str_get(st[1]);
+ tmps2 = str_get(st[2]);
+#ifdef TAINT
+ taintproper("Insecure dependency in symlink");
+#endif
+ value = (double)(symlink(tmps,tmps2) >= 0);
goto donumset;
#else
fatal("Unsupported function symlink()");
#endif
+ case O_READLINK:
+#ifdef SYMLINK
+ if (maxarg < 1)
+ tmps = str_get(stab_val(defstab));
+ else
+ tmps = str_get(st[1]);
+ anum = readlink(tmps,buf,sizeof buf);
+ if (anum < 0)
+ goto say_undef;
+ str_nset(str,buf,anum);
+ break;
+#else
+ fatal("Unsupported function readlink()");
+#endif
case O_FTSUID:
anum = S_ISUID;
goto check_xid;
case O_FTSVTX:
anum = S_ISVTX;
check_xid:
- if (mystat(arg,sarg[1]) >= 0 && statbuf.st_mode & anum)
- str = &str_yes;
- else
- str = &str_no;
- break;
+ if (mystat(arg,st[1]) < 0)
+ goto say_undef;
+ if (statcache.st_mode & anum)
+ goto say_yes;
+ goto say_no;
case O_FTTTY:
- if (arg[1].arg_flags & AF_SPECIAL) {
+ if (arg[1].arg_type & A_DONT) {
stab = arg[1].arg_ptr.arg_stab;
tmps = "";
}
else
- stab = stabent(tmps = str_get(sarg[1]),FALSE);
- if (stab && stab->stab_io && stab->stab_io->fp)
- anum = fileno(stab->stab_io->fp);
+ 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))
anum = atoi(tmps);
else
- anum = -1;
+ goto say_undef;
if (isatty(anum))
- str = &str_yes;
- else
- str = &str_no;
- break;
+ goto say_yes;
+ goto say_no;
case O_FTTEXT:
case O_FTBINARY:
- str = do_fttext(arg,sarg[1]);
+ str = do_fttext(arg,st[1]);
break;
+#ifdef SOCKET
+ case O_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);
+#ifndef lint
+ value = (double)do_socket(stab,arglast);
+#else
+ (void)do_socket(stab,arglast);
+#endif
+ goto donumset;
+ case O_BIND:
+ if ((arg[1].arg_type & A_MASK) == A_WORD)
+ stab = arg[1].arg_ptr.arg_stab;
+ else
+ stab = stabent(str_get(st[1]),TRUE);
+#ifndef lint
+ value = (double)do_bind(stab,arglast);
+#else
+ (void)do_bind(stab,arglast);
+#endif
+ goto donumset;
+ case O_CONNECT:
+ if ((arg[1].arg_type & A_MASK) == A_WORD)
+ stab = arg[1].arg_ptr.arg_stab;
+ else
+ stab = stabent(str_get(st[1]),TRUE);
+#ifndef lint
+ value = (double)do_connect(stab,arglast);
+#else
+ (void)do_connect(stab,arglast);
+#endif
+ goto donumset;
+ case O_LISTEN:
+ if ((arg[1].arg_type & A_MASK) == A_WORD)
+ stab = arg[1].arg_ptr.arg_stab;
+ else
+ stab = stabent(str_get(st[1]),TRUE);
+#ifndef lint
+ value = (double)do_listen(stab,arglast);
+#else
+ (void)do_listen(stab,arglast);
+#endif
+ goto donumset;
+ case O_ACCEPT:
+ 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 ((arg[2].arg_type & A_MASK) == A_WORD)
+ stab2 = arg[2].arg_ptr.arg_stab;
+ else
+ stab2 = stabent(str_get(st[2]),TRUE);
+ do_accept(str,stab,stab2);
+ STABSET(str);
+ break;
+ case O_GHBYNAME:
+ if (maxarg < 1)
+ goto say_undef;
+ case O_GHBYADDR:
+ case O_GHOSTENT:
+ sp = do_ghent(optype,
+ gimme,arglast);
+ goto array_return;
+ case O_GNBYNAME:
+ if (maxarg < 1)
+ goto say_undef;
+ case O_GNBYADDR:
+ case O_GNETENT:
+ sp = do_gnent(optype,
+ gimme,arglast);
+ goto array_return;
+ case O_GPBYNAME:
+ if (maxarg < 1)
+ goto say_undef;
+ case O_GPBYNUMBER:
+ case O_GPROTOENT:
+ sp = do_gpent(optype,
+ gimme,arglast);
+ goto array_return;
+ case O_GSBYNAME:
+ if (maxarg < 1)
+ goto say_undef;
+ case O_GSBYPORT:
+ case O_GSERVENT:
+ sp = do_gsent(optype,
+ gimme,arglast);
+ goto array_return;
+ case O_SHOSTENT:
+ value = (double) sethostent((int)str_gnum(st[1]));
+ goto donumset;
+ case O_SNETENT:
+ value = (double) setnetent((int)str_gnum(st[1]));
+ goto donumset;
+ case O_SPROTOENT:
+ value = (double) setprotoent((int)str_gnum(st[1]));
+ goto donumset;
+ case O_SSERVENT:
+ value = (double) setservent((int)str_gnum(st[1]));
+ goto donumset;
+ case O_EHOSTENT:
+ value = (double) endhostent();
+ goto donumset;
+ case O_ENETENT:
+ value = (double) endnetent();
+ goto donumset;
+ case O_EPROTOENT:
+ value = (double) endprotoent();
+ goto donumset;
+ case O_ESERVENT:
+ value = (double) endservent();
+ goto donumset;
+ case O_SSELECT:
+ sp = do_select(gimme,arglast);
+ goto array_return;
+ case O_SOCKETPAIR:
+ 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 ((arg[2].arg_type & A_MASK) == A_WORD)
+ stab2 = arg[2].arg_ptr.arg_stab;
+ else
+ stab2 = stabent(str_get(st[2]),TRUE);
+#ifndef lint
+ value = (double)do_spair(stab,stab2,arglast);
+#else
+ (void)do_spair(stab,stab2,arglast);
+#endif
+ goto donumset;
+ case O_SHUTDOWN:
+ if ((arg[1].arg_type & A_MASK) == A_WORD)
+ stab = arg[1].arg_ptr.arg_stab;
+ else
+ stab = stabent(str_get(st[1]),TRUE);
+#ifndef lint
+ value = (double)do_shutdown(stab,arglast);
+#else
+ (void)do_shutdown(stab,arglast);
+#endif
+ goto donumset;
+ case O_GSOCKOPT:
+ case O_SSOCKOPT:
+ if ((arg[1].arg_type & A_MASK) == A_WORD)
+ stab = arg[1].arg_ptr.arg_stab;
+ else
+ stab = stabent(str_get(st[1]),TRUE);
+ sp = do_sopt(optype,stab,arglast);
+ goto array_return;
+ case O_GETSOCKNAME:
+ case O_GETPEERNAME:
+ if ((arg[1].arg_type & A_MASK) == A_WORD)
+ stab = arg[1].arg_ptr.arg_stab;
+ else
+ stab = stabent(str_get(st[1]),TRUE);
+ sp = do_getsockname(optype,stab,arglast);
+ goto array_return;
+
+#else /* 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_GHBYNAME:
+ case O_GHBYADDR:
+ case O_GHOSTENT:
+ case O_GNBYNAME:
+ case O_GNBYADDR:
+ case O_GNETENT:
+ case O_GPBYNAME:
+ case O_GPBYNUMBER:
+ case O_GPROTOENT:
+ case O_GSBYNAME:
+ case O_GSBYPORT:
+ case O_GSERVENT:
+ case O_SHOSTENT:
+ case O_SNETENT:
+ case O_SPROTOENT:
+ case O_SSERVENT:
+ case O_EHOSTENT:
+ case O_ENETENT:
+ case O_EPROTOENT:
+ case O_ESERVENT:
+ case O_SHUTDOWN:
+ case O_GSOCKOPT:
+ case O_SSOCKOPT:
+ case O_GETSOCKNAME:
+ case O_GETPEERNAME:
+ badsock:
+ fatal("Unsupported socket function");
+#endif /* SOCKET */
+ case O_FILENO:
+ 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;
+ value = fileno(fp);
+ goto donumset;
+ 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:
+ sp = do_gpwent(optype,
+ gimme,arglast);
+ goto array_return;
+ case O_SPWENT:
+ value = (double) setpwent();
+ goto donumset;
+ case O_EPWENT:
+ value = (double) endpwent();
+ goto donumset;
+ case O_GGRNAM:
+ case O_GGRGID:
+ case O_GGRENT:
+ sp = do_ggrent(optype,
+ gimme,arglast);
+ goto array_return;
+ case O_SGRENT:
+ value = (double) setgrent();
+ goto donumset;
+ case O_EGRENT:
+ value = (double) endgrent();
+ goto donumset;
+ case O_GETLOGIN:
+ if (!(tmps = getlogin()))
+ goto say_undef;
+ str_set(str,tmps);
+ break;
+ case O_OPENDIR:
+ case O_READDIR:
+ case O_TELLDIR:
+ case O_SEEKDIR:
+ case O_REWINDDIR:
+ case O_CLOSEDIR:
+ 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);
+ sp = do_dirop(optype,stab,gimme,arglast);
+ goto array_return;
+ case O_SYSCALL:
+ value = (double)do_syscall(arglast);
+ goto donumset;
}
- if (retary) {
- sarg[1] = str;
- maxsarg = sargoff + 1;
- }
+
+ normal_return:
+ st[1] = str;
#ifdef DEBUGGING
if (debug) {
dlevel--;
deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str));
}
#endif
- goto freeargs;
+ return arglast[0] + 1;
array_return:
#ifdef DEBUGGING
if (debug) {
dlevel--;
if (debug & 8)
- deb("%s RETURNS ARRAY OF %d ARGS\n",opname[optype],maxsarg-sargoff);
+ deb("%s RETURNS ARRAY OF %d ARGS\n",opname[optype],sp - arglast[0]);
}
#endif
- goto freeargs;
+ 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);
- if (retary) {
- sarg[1] = str;
- maxsarg = sargoff + 1;
- }
+ st[1] = str;
#ifdef DEBUGGING
if (debug) {
dlevel--;
deb("%s RETURNS \"%f\"\n",opname[optype],value);
}
#endif
-
-freeargs:
- sarg -= sargoff;
- if (sarg != quicksarg) {
- if (retary) {
- sarg[0] = &str_args;
- str_numset(sarg[0], (double)(maxsarg));
- sarg[maxsarg+1] = Nullstr;
- *retary = sarg; /* up to them to free it */
- }
- else
- safefree((char*)sarg);
- }
- return str;
-}
-
-int
-ingroup(gid,effective)
-int gid;
-int effective;
-{
- if (gid == (effective ? getegid() : getgid()))
- return TRUE;
-#ifdef GETGROUPS
-#ifndef NGROUPS
-#define NGROUPS 32
-#endif
- {
- GIDTYPE gary[NGROUPS];
- int anum;
-
- anum = getgroups(NGROUPS,gary);
- while (--anum >= 0)
- if (gary[anum] == gid)
- return TRUE;
- }
-#endif
- return FALSE;
-}
-
-/* Do the permissions allow some operation? Assumes statbuf already set. */
-
-int
-cando(bit, effective)
-int bit;
-int effective;
-{
- if ((effective ? euid : uid) == 0) { /* root is special */
- if (bit == S_IEXEC) {
- if (statbuf.st_mode & 0111 ||
- (statbuf.st_mode & S_IFMT) == S_IFDIR )
- return TRUE;
- }
- else
- return TRUE; /* root reads and writes anything */
- return FALSE;
- }
- if (statbuf.st_uid == (effective ? euid : uid) ) {
- if (statbuf.st_mode & bit)
- return TRUE; /* ok as "user" */
- }
- else if (ingroup((int)statbuf.st_gid,effective)) {
- if (statbuf.st_mode & bit >> 3)
- return TRUE; /* ok as "group" */
- }
- else if (statbuf.st_mode & bit >> 6)
- return TRUE; /* ok as "other" */
- return FALSE;
+ return arglast[0] + 1;
}
projects / p5sagit/p5-mst-13.2.git / blobdiff