/* $RCSfile: eval.c,v $$Revision: 4.1 $$Date: 92/08/07 18:20:29 $ * * 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.1 92/08/07 18:20:29 lwall * * 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" extern int (*ppaddr[])(); extern int mark[]; #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) #include #endif #ifdef I_FCNTL #include #endif #ifdef MSDOS /* I_FCNTL *MUST* not be defined for MS-DOS and OS/2 but fcntl.h is required for O_BINARY */ #include #endif #ifdef I_SYS_FILE #include #endif #ifdef I_VFORK # include #endif 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; STAB *stab2; STIO *stio; ARRAY *ary; int old_rslen; int old_rschar; VOIDRET (*ihand)(); /* place to save signal during system() */ VOIDRET (*qhand)(); /* place to save signal during system() */ bool assigning = FALSE; int mymarkbase = savestack->ary_fill; 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 if (mark[optype]) { saveint(&markbase); markbase = mymarkbase; saveint(&stack_mark); stack_mark = sp; } 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: if (!ppaddr[optype] || optype == O_SUBR || optype == O_DBSUBR) { 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 TAINT_PROPER("``"); #endif fp = mypopen(tmps,"r"); str_set(str,""); if (fp) { if (gimme == G_SCALAR) { while (str_gets(str,fp,str->str_cur) != Nullch) /*SUPPRESS 530*/ ; } else { for (;;) { if (++sp > stack->ary_max) { astore(stack, sp, Nullstr); st = stack->ary_array; } str = st[sp] = Str_new(56,80); if (str_gets(str,fp,0) == Nullch) { sp--; break; } if (str->str_len - str->str_cur > 20) { str->str_len = str->str_cur+1; Renew(str->str_ptr, str->str_len, char); } str_2mortal(str); } } statusvalue = mypclose(fp); } else statusvalue = -1; if (gimme == G_SCALAR) st[++sp] = str; #ifdef DEBUGGING tmps = "BACK"; #endif break; case A_WANTARRAY: { if (curcsv->wantarray == G_ARRAY) st[++sp] = &str_yes; else st[++sp] = &str_no; } #ifdef DEBUGGING tmps = "WANTARRAY"; #endif break; case A_INDREAD: last_in_stab = stabent(str_get(STAB_STR(argptr.arg_stab)),TRUE); old_rschar = rschar; old_rslen = rslen; goto do_read; case A_GLOB: argflags |= AF_POST; /* enable newline chopping */ last_in_stab = argptr.arg_stab; old_rschar = rschar; old_rslen = rslen; rslen = 1; #ifdef DOSISH rschar = 0; #else #ifdef CSH rschar = 0; #else rschar = '\n'; #endif /* !CSH */ #endif /* !MSDOS */ goto do_read; case A_READ: last_in_stab = argptr.arg_stab; old_rschar = rschar; old_rslen = rslen; do_read: if (anum > 1) /* assign to scalar */ gimme = G_SCALAR; /* force context to scalar */ if (gimme == G_ARRAY) str = Str_new(57,0); ++sp; fp = Nullfp; if (stab_io(last_in_stab)) { fp = stab_io(last_in_stab)->ifp; if (!fp) { if (stab_io(last_in_stab)->flags & IOF_ARGV) { if (stab_io(last_in_stab)->flags & IOF_START) { stab_io(last_in_stab)->flags &= ~IOF_START; stab_io(last_in_stab)->lines = 0; if (alen(stab_array(last_in_stab)) < 0) { tmpstr = str_make("-",1); /* assume stdin */ (void)apush(stab_array(last_in_stab), tmpstr); } } fp = nextargv(last_in_stab); if (!fp) { /* Note: fp != stab_io(last_in_stab)->ifp */ (void)do_close(last_in_stab,FALSE); /* now it does*/ stab_io(last_in_stab)->flags |= IOF_START; } } else if (argtype == A_GLOB) { (void) interp(str,stab_val(last_in_stab),sp); st = stack->ary_array; tmpstr = Str_new(55,0); #ifdef DOSISH str_set(tmpstr, "perlglob "); str_scat(tmpstr,str); str_cat(tmpstr," |"); #else #ifdef CSH str_nset(tmpstr,cshname,cshlen); str_cat(tmpstr," -cf 'set nonomatch; glob "); str_scat(tmpstr,str); str_cat(tmpstr,"'|"); #else str_set(tmpstr, "echo "); str_scat(tmpstr,str); str_cat(tmpstr, "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|"); #endif /* !CSH */ #endif /* !MSDOS */ (void)do_open(last_in_stab,tmpstr->str_ptr, tmpstr->str_cur); fp = stab_io(last_in_stab)->ifp; str_free(tmpstr); } } } if (!fp && dowarn) warn("Read on closed filehandle <%s>",stab_ename(last_in_stab)); tmplen = str->str_len; /* remember if already alloced */ if (!tmplen) Str_Grow(str,80); /* try short-buffering it */ keepgoing: if (!fp) st[sp] = &str_undef; else if (!str_gets(str,fp, optype == O_RCAT ? str->str_cur : 0)) { clearerr(fp); if (stab_io(last_in_stab)->flags & IOF_ARGV) { fp = nextargv(last_in_stab); if (fp) goto keepgoing; (void)do_close(last_in_stab,FALSE); stab_io(last_in_stab)->flags |= IOF_START; } else if (argflags & AF_POST) { (void)do_close(last_in_stab,FALSE); } st[sp] = &str_undef; rschar = old_rschar; rslen = old_rslen; if (gimme == G_ARRAY) { --sp; str_2mortal(str); goto array_return; } break; } else { stab_io(last_in_stab)->lines++; st[sp] = str; #ifdef TAINT str->str_tainted = 1; /* Anything from the outside world...*/ #endif if (argflags & AF_POST) { if (str->str_cur > 0) str->str_cur--; if (str->str_ptr[str->str_cur] == rschar) str->str_ptr[str->str_cur] = '\0'; else str->str_cur++; for (tmps = str->str_ptr; *tmps; tmps++) if (!isALPHA(*tmps) && !isDIGIT(*tmps) && index("$&*(){}[]'\";\\|?<>~`",*tmps)) break; if (*tmps && stat(str->str_ptr,&statbuf) < 0) goto keepgoing; /* unmatched wildcard? */ } if (gimme == G_ARRAY) { if (str->str_len - str->str_cur > 20) { str->str_len = str->str_cur+1; Renew(str->str_ptr, str->str_len, char); } str_2mortal(str); if (++sp > stack->ary_max) { astore(stack, sp, Nullstr); st = stack->ary_array; } str = Str_new(58,80); goto keepgoing; } else if (!tmplen && str->str_len - str->str_cur > 80) { /* try to reclaim a bit of scalar space on 1st alloc */ if (str->str_cur < 60) str->str_len = 80; else str->str_len = str->str_cur+40; /* allow some slop */ Renew(str->str_ptr, str->str_len, char); } } rschar = old_rschar; rslen = old_rslen; #ifdef DEBUGGING tmps = "READ"; #endif break; } #ifdef DEBUGGING if (debug & 8) { if (strEQ(tmps, "NULL")) deb("%d.%s\n",anum,tmps); else deb("%d.%s = '%s'\n",anum,tmps,str_peek(st[sp])); } #endif if (anum < 8) arglast[anum] = sp; } if (ppaddr[optype]) { int status; /* pretend like we've been maintaining stack_* all along */ stack_ary = stack->ary_array; stack_sp = stack_ary + sp; if (mark[optype] && stack_mark != arglast[0]) warn("Inconsistent stack mark %d != %d", stack_mark, arglast[0]); stack_max = stack_ary + stack->ary_max; status = (*ppaddr[optype])(str, arg, gimme); if (savestack->ary_fill > mymarkbase) { warn("Inconsistent stack base"); restorelist(mymarkbase); } sp = stack_sp - stack_ary; if (sp < arglast[0]) warn("TOO MANY POPS"); st += arglast[0]; goto array_return; } st += arglast[0]; #ifdef SMALLSWITCHES if (optype < O_CHOWN) #endif switch (optype) { case O_RCAT: STABSET(str); break; case O_ITEM: if (gimme == G_ARRAY) goto array_return; /* FALL THROUGH */ case O_SCALAR: STR_SSET(str,st[1]); STABSET(str); break; case O_ITEM2: if (gimme == G_ARRAY) goto array_return; --anum; STR_SSET(str,st[arglast[anum]-arglast[0]]); STABSET(str); break; case O_ITEM3: if (gimme == G_ARRAY) goto array_return; --anum; STR_SSET(str,st[arglast[anum]-arglast[0]]); STABSET(str); break; case O_CONCAT: STR_SSET(str,st[1]); str_scat(str,st[2]); STABSET(str); break; case O_REPEAT: if (gimme == G_ARRAY && arg[1].arg_flags & AF_ARYOK) { sp = do_repeatary(arglast); goto array_return; } STR_SSET(str,st[1]); anum = (int)str_gnum(st[2]); if (anum >= 1) { tmpstr = Str_new(50, 0); tmps = str_get(str); str_nset(tmpstr,tmps,str->str_cur); tmps = str_get(tmpstr); /* force to be string */ STR_GROW(str, (anum * str->str_cur) + 1); repeatcpy(str->str_ptr, tmps, tmpstr->str_cur, anum); str->str_cur *= anum; str->str_ptr[str->str_cur] = '\0'; str->str_nok = 0; str_free(tmpstr); } else { if (dowarn && st[2]->str_pok && !looks_like_number(st[2])) warn("Right operand of x is not numeric"); str_sset(str,&str_no); } STABSET(str); break; case O_MATCH: sp = do_match(str,arg, gimme,arglast); if (gimme == G_ARRAY) goto array_return; STABSET(str); break; case O_NMATCH: sp = do_match(str,arg, G_SCALAR,arglast); str_sset(str, str_true(str) ? &str_no : &str_yes); STABSET(str); break; case O_SUBST: sp = do_subst(str,arg,arglast[0]); goto array_return; case O_NSUBST: sp = do_subst(str,arg,arglast[0]); str = arg->arg_ptr.arg_str; str_set(str, str_true(str) ? No : Yes); goto array_return; case O_ASSIGN: 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 { 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: #ifdef TAINT if (tainted && !st[2]->str_tainted) tainted = 0; #endif STR_SSET(str, st[2]); STABSET(str); break; case O_CHOP: 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)) { 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); } goto say_undef; case O_STUDY: 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(st[1]); value *= str_gnum(st[2]); goto donumset; case O_DIVIDE: 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: tmpulong = (unsigned long) str_gnum(st[2]); if (tmpulong == 0L) fatal("Illegal modulus zero"); #ifndef lint value = str_gnum(st[1]); if (value >= 0.0) value = (double)(((unsigned long)value) % tmpulong); else { tmplong = (long)value; value = (double)(tmpulong - ((-tmplong - 1) % tmpulong)) - 1; } #endif goto donumset; case O_ADD: value = str_gnum(st[1]); value += str_gnum(st[2]); goto donumset; case O_SUBTRACT: value = str_gnum(st[1]); value -= str_gnum(st[2]); goto donumset; case O_LEFT_SHIFT: value = str_gnum(st[1]); anum = (int)str_gnum(st[2]); #ifndef lint 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)(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_GT: value = str_gnum(st[1]); value = (value > str_gnum(st[2])) ? 1.0 : 0.0; goto donumset; case O_LE: value = str_gnum(st[1]); value = (value <= str_gnum(st[2])) ? 1.0 : 0.0; goto donumset; case O_GE: value = str_gnum(st[1]); value = (value >= str_gnum(st[2])) ? 1.0 : 0.0; goto donumset; case O_EQ: 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(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)(U_L(value) & U_L(str_gnum(st[2]))); #endif goto donumset; } else do_vop(optype,str,st[1],st[2]); break; case O_XOR: if (!sawvec || st[1]->str_nok || st[2]->str_nok) { value = str_gnum(st[1]); #ifndef lint value = (double)(U_L(value) ^ U_L(str_gnum(st[2]))); #endif goto donumset; } else do_vop(optype,str,st[1],st[2]); break; case O_BIT_OR: if (!sawvec || st[1]->str_nok || st[2]->str_nok) { value = str_gnum(st[1]); #ifndef lint value = (double)(U_L(value) | U_L(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(st[1])) { anum = 2; optype = O_ITEM2; argflags = arg[anum].arg_flags; 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, st[1]); STABSET(str); } else str = st[1]; break; } case O_OR: if (str_true(st[1])) { if (assigning) { str_sset(str, st[1]); STABSET(str); } else str = st[1]; break; } else { anum = 2; optype = O_ITEM2; argflags = arg[anum].arg_flags; 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(st[1]) ? 2 : 3); optype = (anum == 2 ? O_ITEM2 : O_ITEM3); argflags = arg[anum].arg_flags; 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: if (gimme == G_ARRAY) goto array_return; str = st[2]; break; case O_NEGATE: 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) ~U_L(str_gnum(st[1])); #endif 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: stab_efullname(str,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; } STABSET(str); break; case O_WRITE: if (maxarg == 0) stab = defoutstab; 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(st[1]),TRUE); if (!stab_io(stab)) { str_set(str, No); STABSET(str); break; } curoutstab = stab; fp = stab_io(stab)->ofp; if (stab_io(stab)->fmt_stab) form = stab_form(stab_io(stab)->fmt_stab); else 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,sp); do_write(&outrec,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 anum = arg[1].arg_type & A_MASK; if (anum == A_WORD || anum == A_STAB) stab = arg[1].arg_ptr.arg_stab; else stab = stabent(str_get(st[1]),TRUE); if (st[3]->str_nok || st[3]->str_pok) anum = (int)str_gnum(st[3]); else anum = -1; 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 anum = arg[1].arg_type & A_MASK; if (anum == A_WORD || anum == A_STAB) stab = arg[1].arg_ptr.arg_stab; else stab = stabent(str_get(st[1]),TRUE); hdbmclose(stab_hash(stab)); goto say_yes; #else fatal("No dbm or ndbm on this machine"); #endif case O_OPEN: 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]); if (do_open(stab,tmps,st[2]->str_cur)) { value = (double)forkprocess; stab_io(stab)->lines = 0; goto donumset; } else if (forkprocess == 0) /* we are a new child */ goto say_zero; else goto say_undef; /* break; */ case O_TRANS: value = (double) do_trans(str,arg); str = arg->arg_ptr.arg_str; goto donumset; case O_NTRANS: str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No); str = arg->arg_ptr.arg_str; break; case O_CLOSE: 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(st[1]),TRUE); str_set(str, do_close(stab,TRUE) ? Yes : No ); STABSET(str); break; case O_EACH: sp = do_each(str,stab_hash(arg[1].arg_ptr.arg_stab), gimme,arglast); goto array_return; case O_VALUES: case O_KEYS: 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: 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; } st += sp; Copy(ary->ary_array, &st[1], maxarg, STR*); sp += maxarg; goto array_return; } else { value = (double)maxarg; goto donumset; } case O_AELEM: anum = ((int)str_gnum(st[2])) - arybase; str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE); break; case O_DELETE: tmpstab = arg[1].arg_ptr.arg_stab; tmps = str_get(st[2]); str = hdelete(stab_hash(tmpstab),tmps,st[2]->str_cur); if (tmpstab == envstab) my_setenv(tmps,Nullch); if (!str) 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: 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; 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); } 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); 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 || str == &str_undef) fatal("Assignment to non-creatable value, subscript %d",anum); break; 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 || 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 */ /* he threw the brick up into the air */ 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 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 = 1; argtype = FALSE; goto do_slice_already; case O_HSLICE: anum = 0; argtype = FALSE; goto do_slice_already; case O_LASLICE: anum = 1; argtype = TRUE; goto do_slice_already; case O_LHSLICE: anum = 0; argtype = TRUE; do_slice_already: 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); else { 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(ary = stab_array(arg[1].arg_ptr.arg_stab)); goto staticalization; case O_SHIFT: 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_2mortal(str); break; case O_UNPACK: sp = do_unpack(str,gimme,arglast); goto array_return; case O_SPLIT: 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: if (maxarg < 1) value = (double)str_len(stab_val(defstab)); else value = (double)str_len(st[1]); goto donumset; case O_SPRINTF: do_sprintf(str, sp-arglast[0], st+1); break; 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) anum += st[1]->str_cur + arybase; if (anum < 0 || anum > st[1]->str_cur) str_nset(str,"",0); else { optype = maxarg < 3 ? st[1]->str_cur : (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); if (argtype) { /* it's an lvalue! */ Lstring *lstr = (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: /*SUPPRESS 701*/ (void)do_pack(str,arglast); break; case O_GREP: sp = do_grep(arg,str,gimme,arglast); goto array_return; case O_JOIN: do_join(str,arglast); break; case O_SLT: tmps = str_get(st[1]); value = (double) (str_cmp(st[1],st[2]) < 0); goto donumset; case O_SGT: tmps = str_get(st[1]); value = (double) (str_cmp(st[1],st[2]) > 0); goto donumset; case O_SLE: tmps = str_get(st[1]); value = (double) (str_cmp(st[1],st[2]) <= 0); goto donumset; case O_SGE: tmps = str_get(st[1]); value = (double) (str_cmp(st[1],st[2]) >= 0); goto donumset; case O_SEQ: tmps = str_get(st[1]); value = (double) str_eq(st[1],st[2]); goto donumset; case O_SNE: 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_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: sp = do_sort(str,arg, gimme,arglast); goto array_return; case O_REVERSE: 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(str); } else { str = st[2]; tmps = str_get(st[2]); } 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(str); } else { str = st[2]; tmps = str_get(st[2]); } if (!tmps || !*tmps) tmps = "Died"; fatal("%s",tmps); goto say_zero; case O_PRTF: case O_PRINT: 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; 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; } else { if (optype == O_PRTF || arglast[2] - arglast[1] != 1) value = (double)do_aprint(arg,fp,arglast); else { value = (double)do_print(st[2],fp); if (orslen && optype == O_PRINT) if (fwrite(ors, 1, orslen, fp) == 0) goto say_zero; } if (stab_io(stab)->flags & IOF_FLUSH) if (fflush(fp) == EOF) goto say_zero; } goto donumset; case O_CHDIR: if (maxarg < 1) tmps = Nullch; else tmps = str_get(st[1]); if (!tmps || !*tmps) { tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE); tmps = str_get(tmpstr); } if (!tmps || !*tmps) { tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE); tmps = str_get(tmpstr); } #ifdef TAINT TAINT_PROPER("chdir"); #endif value = (double)(chdir(tmps) >= 0); goto donumset; case O_EXIT: if (maxarg < 1) anum = 0; else anum = (int)str_gnum(st[1]); my_exit(anum); goto say_zero; case O_RESET: if (maxarg < 1) tmps = ""; else tmps = str_get(st[1]); str_reset(tmps,curcmd->c_stash); value = 1.0; goto donumset; case O_LIST: if (gimme == G_ARRAY) goto array_return; if (maxarg > 0) str = st[sp - arglast[0]]; /* unwanted list, return last item */ else str = &str_undef; break; case O_EOF: 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); str_set(str, do_eof(stab) ? Yes : No); STABSET(str); break; case O_GETC: if (maxarg <= 0) stab = stdinstab; 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 = argvstab; if (!stab || do_eof(stab)) /* make sure we have fp with something */ goto say_undef; 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: 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]); 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_undef; #ifdef HAS_SOCKET if (optype == O_RECV) { argtype = sizeof buf; 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; st[2]->str_ptr[anum] = '\0'; str_nset(str,buf,argtype); } else str_sset(str,&str_undef); break; } #else if (optype == O_RECV) goto badsock; #endif STR_GROW(st[2], anum+maxarg+1), (tmps = str_get(st[2])); /* sneaky */ if (optype == O_SYSREAD) { anum = read(fileno(stab_io(stab)->ifp), tmps+maxarg, anum); } else #ifdef HAS_SOCKET if (stab_io(stab)->type == 's') { argtype = sizeof buf; anum = recvfrom(fileno(stab_io(stab)->ifp), tmps+maxarg, anum, 0, buf, &argtype); } else #endif anum = fread(tmps+maxarg, 1, anum, stab_io(stab)->ifp); if (anum < 0) goto say_undef; st[2]->str_cur = anum+maxarg; st[2]->str_ptr[anum+maxarg] = '\0'; value = (double)anum; goto donumset; case O_SYSWRITE: case O_SEND: 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]); errno = 0; stio = stab_io(stab); maxarg = sp - arglast[0]; if (!stio || !stio->ifp) { anum = -1; 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); } #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; case O_SEEK: if ((arg[1].arg_type & A_MASK) == A_WORD) stab = arg[1].arg_ptr.arg_stab; else stab = stabent(str_get(st[1]),TRUE); value = str_gnum(st[2]); str_set(str, do_seek(stab, (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 (curcsv && curcsv->wantarray == G_ARRAY) { lastretstr = Nullstr; lastspbase = arglast[1]; lastsize = arglast[2] - arglast[1]; } else 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: while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label || strNE(tmps,loop_stack[loop_ptr].loop_label) )) { #ifdef DEBUGGING if (debug & 4) { deb("(Skipping label #%d %s)\n",loop_ptr, loop_stack[loop_ptr].loop_label); } #endif loop_ptr--; } #ifdef DEBUGGING if (debug & 4) { deb("(Found label #%d %s)\n",loop_ptr, loop_stack[loop_ptr].loop_label); } #endif } if (loop_ptr < 0) { if (tmps && strEQ(tmps, "_SUB_")) fatal("Can't return outside a subroutine"); fatal("Bad label: %s", maxarg > 0 ? tmps : ""); } if (!lastretstr && optype == O_LAST && lastsize) { st -= arglast[0]; st += lastspbase + 1; optype = loop_stack[loop_ptr].loop_sp - lastspbase; /* negative */ if (optype) { for (anum = lastsize; anum > 0; anum--,st++) st[optype] = str_mortal(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(arg[1].arg_ptr.arg_str); if (!*goto_targ) goto_targ = Nullch; /* just restart from top */ if (optype == O_DUMP) { do_undump = TRUE; 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 + anum, (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]); 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 + anum, 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: sp = do_tms(str,gimme,arglast); goto array_return; case O_LOCALTIME: if (maxarg < 1) (void)time(&when); else when = (time_t)str_gnum(st[1]); sp = do_time(str,localtime(&when), gimme,arglast); goto array_return; case O_GMTIME: if (maxarg < 1) (void)time(&when); else when = (time_t)str_gnum(st[1]); sp = do_time(str,gmtime(&when), gimme,arglast); goto array_return; case O_TRUNCATE: sp = do_truncate(str,arg, gimme,arglast); goto array_return; case O_LSTAT: case O_STAT: sp = do_stat(str,arg, gimme,arglast); goto array_return; case O_CRYPT: #ifdef HAS_CRYPT 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: if (maxarg < 1) value = str_gnum(stab_val(defstab)); else value = str_gnum(st[1]); value = exp(value); goto donumset; case O_LOG: if (maxarg < 1) 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: if (maxarg < 1) 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: if (maxarg < 1) value = str_gnum(stab_val(defstab)); else value = str_gnum(st[1]); if (value >= 0.0) (void)modf(value,&value); else { (void)modf(-value,&value); value = -value; } goto donumset; case O_ORD: 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_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; else tmps = str_get(st[1]); (void)time(&when); if (!tmps || !*tmps) sleep((32767<<16)+32767); else sleep((unsigned int)atoi(tmps)); #ifndef lint value = (double)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); 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; 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 ((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]) ) { arg[2].arg_type &= ~A_DONT; arg[1].arg_type |= A_DONT; arg->arg_type = optype = O_FLOP; if (arg->arg_flags & AF_COMMON) { str_numset(str,0.0); anum = 2; argflags = arg[2].arg_flags; argtype = arg[2].arg_type & A_MASK; argptr = arg[2].arg_ptr; sp = arglast[0]; st -= sp++; goto re_eval; } else { str_numset(str,1.0); break; } } str_set(str,""); break; case O_FLOP: str_inc(str); 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_type &= ~A_DONT; arg[2].arg_type |= A_DONT; str_cat(str,"E0"); } break; case O_FORK: #ifdef HAS_FORK anum = fork(); 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 anum = wait(&argflags); if (anum > 0) pidgone(anum,argflags); value = (double)anum; #endif statusvalue = (unsigned short)argflags; goto donumset; #else fatal("Unsupported function wait"); break; #endif case O_WAITPID: #ifdef HAS_WAIT #ifndef lint anum = (int)str_gnum(st[1]); optype = (int)str_gnum(st[2]); anum = wait4pid(anum, &argflags,optype); value = (double)anum; #endif statusvalue = (unsigned short)argflags; goto donumset; #else fatal("Unsupported function wait"); break; #endif case O_SYSTEM: #ifdef HAS_FORK #ifdef TAINT if (arglast[2] - arglast[1] == 1) { taintenv(); tainted |= st[2]->str_tainted; TAINT_PROPER("system"); } #endif while ((anum = vfork()) == -1) { if (errno != EAGAIN) { value = -1.0; goto donumset; } sleep(5); } if (anum > 0) { #ifndef lint ihand = signal(SIGINT, SIG_IGN); qhand = signal(SIGQUIT, SIG_IGN); argtype = wait4pid(anum, &argflags, 0); #else ihand = qhand = 0; #endif (void)signal(SIGINT, ihand); (void)signal(SIGQUIT, qhand); statusvalue = (unsigned short)argflags; 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) 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_mortal(st[2]))); } _exit(-1); #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 { #ifdef TAINT taintenv(); tainted |= st[2]->str_tainted; TAINT_PROPER("exec"); #endif value = (double)do_exec(str_get(str_mortal(st[2]))); } goto donumset; case O_HEX: if (maxarg < 1) tmps = str_get(stab_val(defstab)); else tmps = str_get(st[1]); value = (double)scanhex(tmps, 99, &argtype); goto donumset; case O_OCT: if (maxarg < 1) tmps = str_get(stab_val(defstab)); else tmps = str_get(st[1]); 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 1: deb("%s RETURNS (\"%s\")\n",opname[optype], st[1] ? str_get(st[1]) : ""); break; 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; } } } #endif stack_ary = stack->ary_array; stack_max = stack_ary + stack->ary_max; stack_sp = stack_ary + sp; 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 stack_ary = stack->ary_array; stack_max = stack_ary + stack->ary_max; stack_sp = stack_ary + arglast[0] + 1; 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); } else anum = umask((int)str_gnum(st[1])); value = (double)anum; #ifdef TAINT TAINT_PROPER("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 TAINT_PROPER("rename"); #endif #ifdef HAS_RENAME value = (double)(rename(tmps,tmps2) >= 0); #else 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 TAINT_PROPER("link"); #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 TAINT_PROPER("mkdir"); #endif #ifdef HAS_MKDIR value = (double)(mkdir(tmps,anum) >= 0); goto donumset; #else (void)strcpy(buf,"mkdir "); #endif #if !defined(HAS_MKDIR) || !defined(HAS_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,"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")) 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 TAINT_PROPER("rmdir"); #endif #ifdef HAS_RMDIR value = (double)(rmdir(tmps) >= 0); goto donumset; #else (void)strcpy(buf,"rmdir "); 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 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 HAS_SETPGRP argtype = (int)str_gnum(st[1]); anum = (int)str_gnum(st[2]); #ifdef TAINT TAINT_PROPER("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 HAS_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 HAS_SETPRIORITY argtype = (int)str_gnum(st[1]); anum = (int)str_gnum(st[2]); optype = (int)str_gnum(st[3]); #ifdef TAINT TAINT_PROPER("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: #ifdef HAS_CHROOT if (maxarg < 1) tmps = str_get(stab_val(defstab)); else tmps = str_get(st[1]); #ifdef TAINT TAINT_PROPER("chroot"); #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 = 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 = U_I(str_gnum(st[2])); #ifdef TAINT TAINT_PROPER("ioctl"); #endif anum = do_ctl(optype,stab,argtype,st[3]); 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_FLOCK: #ifdef HAS_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 = stab_array(arg[1].arg_ptr.arg_stab); if (arglast[2] - arglast[1] != 1) do_unshift(ary,arglast); else { STR *tmpstr = Str_new(52,0); /* must copy the STR */ str_sset(tmpstr,st[2]); aunshift(ary,1); (void)astore(ary,0,tmpstr); } value = (double)(ary->ary_fill + 1); 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) 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; TAINT_PROPER("eval"); #endif sp = do_eval(tmpstr, optype, curcmd->c_stash, FALSE, gimme,arglast); goto array_return; case O_FTRREAD: argtype = 0; anum = S_IRUSR; goto check_perm; case O_FTRWRITE: argtype = 0; anum = S_IWUSR; goto check_perm; case O_FTREXEC: argtype = 0; anum = S_IXUSR; goto check_perm; case O_FTEREAD: argtype = 1; anum = S_IRUSR; goto check_perm; case O_FTEWRITE: argtype = 1; anum = S_IWUSR; goto check_perm; case O_FTEEXEC: argtype = 1; anum = S_IXUSR; check_perm: 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,st[1]) < 0) goto say_undef; goto say_yes; case O_FTEOWNED: case O_FTROWNED: 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,st[1]) < 0) goto say_undef; if (!statcache.st_size) goto say_yes; goto say_no; case O_FTSIZE: if (mystat(arg,st[1]) < 0) goto say_undef; 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: if (mystat(arg,st[1]) < 0) goto say_undef; if (S_ISSOCK(statcache.st_mode)) goto say_yes; goto say_no; case O_FTCHR: if (mystat(arg,st[1]) < 0) goto say_undef; if (S_ISCHR(statcache.st_mode)) goto say_yes; goto say_no; case O_FTBLK: if (mystat(arg,st[1]) < 0) goto say_undef; if (S_ISBLK(statcache.st_mode)) goto say_yes; goto say_no; case O_FTFILE: if (mystat(arg,st[1]) < 0) goto say_undef; if (S_ISREG(statcache.st_mode)) goto say_yes; goto say_no; case O_FTDIR: if (mystat(arg,st[1]) < 0) goto say_undef; if (S_ISDIR(statcache.st_mode)) goto say_yes; goto say_no; case O_FTPIPE: if (mystat(arg,st[1]) < 0) goto say_undef; if (S_ISFIFO(statcache.st_mode)) goto say_yes; goto say_no; case O_FTLINK: if (mylstat(arg,st[1]) < 0) goto say_undef; if (S_ISLNK(statcache.st_mode)) goto say_yes; goto say_no; case O_SYMLINK: #ifdef HAS_SYMLINK tmps = str_get(st[1]); tmps2 = str_get(st[2]); #ifdef TAINT TAINT_PROPER("symlink"); #endif value = (double)(symlink(tmps,tmps2) >= 0); goto donumset; #else fatal("Unsupported function symlink"); #endif case O_READLINK: #ifdef HAS_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 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; if (statcache.st_mode & anum) goto say_yes; goto say_no; case O_FTTTY: if (arg[1].arg_type & A_DONT) { stab = arg[1].arg_ptr.arg_stab; tmps = ""; } else 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 goto say_undef; if (isatty(anum)) goto say_yes; goto say_no; case O_FTTEXT: case O_FTBINARY: str = do_fttext(arg,st[1]); break; #ifdef HAS_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_SOCKPAIR: 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); if (!stab) goto say_undef; sp = do_getsockname(optype,stab,arglast); goto array_return; #else /* HAS_SOCKET not defined */ case O_SOCKET: case O_BIND: case O_CONNECT: case O_LISTEN: case O_ACCEPT: case O_SOCKPAIR: 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 /* 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; 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_BINMODE: if (maxarg < 1) goto say_undef; if ((arg[1].arg_type & A_MASK) == A_WORD) stab = arg[1].arg_ptr.arg_stab; else stab = stabent(str_get(st[1]),TRUE); if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp)) goto say_undef; #ifdef DOSISH #ifdef atarist if(fflush(fp)) str_set(str, No); else { fp->_flag |= _IOBIN; str_set(str, Yes); } #else str_set(str, (setmode(fileno(fp), O_BINARY) != -1) ? Yes : No); #endif #else str_set(str, Yes); #endif STABSET(str); break; case O_VEC: sp = do_vec(str == st[1], arg->arg_ptr.arg_str, arglast); goto array_return; case O_GPWNAM: case O_GPWUID: case O_GPWENT: #ifdef HAS_PASSWD sp = do_gpwent(optype, gimme,arglast); goto array_return; case O_SPWENT: value = (double) setpwent(); goto donumset; 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_SGRENT: value = (double) setgrent(); goto donumset; 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_OPEN_DIR: 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); 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_OP: #ifdef HAS_PIPE 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_pipe(str,stab,stab2); STABSET(str); #else fatal("Unsupported function pipe"); #endif break; } normal_return: st[1] = str; #ifdef DEBUGGING if (debug) { dlevel--; if (debug & 8) deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str)); } #endif stack_ary = stack->ary_array; stack_max = stack_ary + stack->ary_max; stack_sp = stack_ary + arglast[0] + 1; return arglast[0] + 1; }