X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=eval.c;h=82b7a8bf894538e1a9c62cb56e4a6c1ae048e3f9;hb=8adcabd8d9cf3c71e660c45cb7165ae4694308d4;hp=2020eb73efa48fd5f4c6056610d1054aae7aa006;hpb=c2ab57d4ffc80c0e2a9e968e66e52c289ac9ed45;p=p5sagit%2Fp5-mst-13.2.git diff --git a/eval.c b/eval.c index 2020eb7..82b7a8b 100644 --- a/eval.c +++ b/eval.c @@ -1,78 +1,46 @@ -/* $Header: eval.c,v 3.0.1.9 90/10/15 16:46:13 lwall Locked $ +/* $RCSfile: eval.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 13:20:20 $ * - * Copyright (c) 1989, Larry Wall + * Copyright (c) 1991, Larry Wall * - * You may distribute under the terms of the GNU General Public License - * as specified in the README file that comes with the perl 3.0 kit. + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. * * $Log: eval.c,v $ - * Revision 3.0.1.9 90/10/15 16:46:13 lwall - * patch29: added caller - * patch29: added scalar - * patch29: added cmp and <=> - * patch29: added sysread and syswrite - * patch29: added -M, -A and -C - * patch29: index and substr now have optional 3rd args - * patch29: you can now read into the middle string - * patch29: ~ now works on vector string - * patch29: non-existent array values no longer cause core dumps - * patch29: eof; core dumped - * patch29: oct and hex now produce unsigned result - * patch29: unshift did not return the documented value + * Revision 4.0.1.4 92/06/08 13:20:20 lwall + * patch20: added explicit time_t support + * patch20: fixed confusion between a *var's real name and its effective name + * patch20: added Atari ST portability + * patch20: new warning for use of x with non-numeric right operand + * patch20: modulus with highest bit in left operand set didn't always work + * patch20: dbmclose(%array) didn't work + * patch20: added ... as variant on .. + * patch20: O_PIPE conflicted with Atari * - * Revision 3.0.1.8 90/08/13 22:17:14 lwall - * patch28: the NSIG hack didn't work right on Xenix - * patch28: defined(@array) and defined(%array) didn't work right - * patch28: rename was busted on systems without rename system call + * Revision 4.0.1.3 91/11/05 17:15:21 lwall + * patch11: prepared for ctype implementations that don't define isascii() + * patch11: various portability fixes + * patch11: added sort {} LIST + * patch11: added eval {} + * patch11: sysread() in socket was substituting recv() + * patch11: a last statement outside any block caused occasional core dumps + * patch11: missing arguments caused core dump in -D8 code + * patch11: eval 'stuff' now optimized to eval {stuff} * - * Revision 3.0.1.7 90/08/09 03:33:44 lwall - * patch19: made ~ do vector operation on strings like &, | and ^ - * patch19: dbmopen(%name...) didn't work right - * patch19: dbmopen(name, 'filename', undef) now refrains from creating - * patch19: empty %array now returns 0 in scalar context - * patch19: die with no arguments no longer exits unconditionally - * patch19: return outside a subroutine now returns a reasonable message - * patch19: rename done with unlink()/link()/unlink() now checks for clobbering - * patch19: -s now returns size of file + * Revision 4.0.1.2 91/06/07 11:07:23 lwall + * patch4: new copyright notice + * patch4: length($`), length($&), length($') now optimized to avoid string copy + * patch4: assignment wasn't correctly de-tainting the assigned variable. + * patch4: default top-of-form format is now FILEHANDLE_TOP + * patch4: added $^P variable to control calling of perldb routines + * patch4: taintchecks could improperly modify parent in vfork() + * patch4: many, many itty-bitty portability fixes * - * Revision 3.0.1.6 90/03/27 15:53:51 lwall - * patch16: MSDOS support - * patch16: support for machines that can't cast negative floats to unsigned ints - * patch16: ioctl didn't return values correctly + * Revision 4.0.1.1 91/04/11 17:43:48 lwall + * patch1: fixed failed fork to return undef as documented + * patch1: reduced maximum branch distance in eval.c * - * Revision 3.0.1.5 90/03/12 16:37:40 lwall - * patch13: undef $/ didn't work as advertised - * patch13: added list slice operator (LIST)[LIST] - * patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST) - * - * Revision 3.0.1.4 90/02/28 17:36:59 lwall - * patch9: added pipe function - * patch9: a return in scalar context wouldn't return array - * patch9: !~ now always returns scalar even in array context - * patch9: some machines can't cast float to long with high bit set - * patch9: piped opens returned undef in child - * patch9: @array in scalar context now returns length of array - * patch9: chdir; coredumped - * patch9: wait no longer ignores signals - * patch9: mkdir now handles odd versions of /bin/mkdir - * patch9: -l FILEHANDLE now disallowed - * - * Revision 3.0.1.3 89/12/21 20:03:05 lwall - * patch7: errno may now be a macro with an lvalue - * patch7: ANSI strerror() is now supported - * patch7: send() didn't allow a TO argument - * patch7: ord() now always returns positive even on signed char machines - * - * Revision 3.0.1.2 89/11/17 15:19:34 lwall - * patch5: constant numeric subscripts get lost inside ?: - * - * Revision 3.0.1.1 89/11/11 04:31:51 lwall - * patch2: mkdir and rmdir needed to quote argument when passed to shell - * patch2: mkdir and rmdir now return better error codes - * patch2: fileno, seekdir, rewinddir and closedir now disallow defaults - * - * Revision 3.0 89/10/18 15:17:04 lwall - * 3.0 baseline + * Revision 4.0 91/03/20 01:16:48 lwall + * 4.0 baseline. * */ @@ -86,6 +54,14 @@ #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 @@ -103,7 +79,8 @@ STR str_args; static STAB *stab2; static STIO *stio; static struct lstring *lstr; -static int old_record_separator; +static int old_rschar; +static int old_rslen; double sin(), cos(), atan2(), pow(); @@ -127,8 +104,10 @@ register int sp; int argtype; union argptr argptr; int arglast[8]; /* highest sp for arg--valid only for non-O_LIST args */ - unsigned long tmplong; - long when; + unsigned long tmpulong; + long tmplong; + time_t when; + STRLEN tmplen; FILE *fp; STR *tmpstr; FCMD *form; @@ -161,9 +140,433 @@ register int sp; } #endif -#include "evalargs.xc" + for (anum = 1; anum <= maxarg; anum++) { + argflags = arg[anum].arg_flags; + argtype = arg[anum].arg_type; + argptr = arg[anum].arg_ptr; + re_eval: + switch (argtype) { + default: + st[++sp] = &str_undef; +#ifdef DEBUGGING + tmps = "NULL"; +#endif + break; + case A_EXPR: +#ifdef DEBUGGING + if (debug & 8) { + tmps = "EXPR"; + deb("%d.EXPR =>\n",anum); + } +#endif + sp = eval(argptr.arg_arg, + (argflags & AF_ARYOK) ? G_ARRAY : G_SCALAR, sp); + if (sp + (maxarg - anum) > stack->ary_max) + astore(stack, sp + (maxarg - anum), Nullstr); + st = stack->ary_array; /* possibly reallocated */ + break; + case A_CMD: +#ifdef DEBUGGING + if (debug & 8) { + tmps = "CMD"; + deb("%d.CMD (%lx) =>\n",anum,argptr.arg_cmd); + } +#endif + sp = cmd_exec(argptr.arg_cmd, gimme, sp); + if (sp + (maxarg - anum) > stack->ary_max) + astore(stack, sp + (maxarg - anum), Nullstr); + st = stack->ary_array; /* possibly reallocated */ + break; + case A_LARYSTAB: + ++sp; + switch (optype) { + case O_ITEM2: argtype = 2; break; + case O_ITEM3: argtype = 3; break; + default: argtype = anum; break; + } + str = afetch(stab_array(argptr.arg_stab), + arg[argtype].arg_len - arybase, TRUE); +#ifdef DEBUGGING + if (debug & 8) { + (void)sprintf(buf,"LARYSTAB $%s[%d]",stab_name(argptr.arg_stab), + arg[argtype].arg_len); + tmps = buf; + } +#endif + goto do_crement; + case A_ARYSTAB: + switch (optype) { + case O_ITEM2: argtype = 2; break; + case O_ITEM3: argtype = 3; break; + default: argtype = anum; break; + } + st[++sp] = afetch(stab_array(argptr.arg_stab), + arg[argtype].arg_len - arybase, FALSE); +#ifdef DEBUGGING + if (debug & 8) { + (void)sprintf(buf,"ARYSTAB $%s[%d]",stab_name(argptr.arg_stab), + arg[argtype].arg_len); + tmps = buf; + } +#endif + break; + case A_STAR: + stab = argptr.arg_stab; + st[++sp] = (STR*)stab; + if (!stab_xarray(stab)) + aadd(stab); + if (!stab_xhash(stab)) + hadd(stab); + if (!stab_io(stab)) + stab_io(stab) = stio_new(); +#ifdef DEBUGGING + if (debug & 8) { + (void)sprintf(buf,"STAR *%s -> *%s", + stab_name(argptr.arg_stab), stab_ename(argptr.arg_stab)); + tmps = buf; + } +#endif + break; + case A_LSTAR: + str = st[++sp] = (STR*)argptr.arg_stab; +#ifdef DEBUGGING + if (debug & 8) { + (void)sprintf(buf,"LSTAR *%s -> *%s", + stab_name(argptr.arg_stab), stab_ename(argptr.arg_stab)); + tmps = buf; + } +#endif + break; + case A_STAB: + st[++sp] = STAB_STR(argptr.arg_stab); +#ifdef DEBUGGING + if (debug & 8) { + (void)sprintf(buf,"STAB $%s",stab_name(argptr.arg_stab)); + tmps = buf; + } +#endif + break; + case A_LENSTAB: + str_numset(str, (double)STAB_LEN(argptr.arg_stab)); + st[++sp] = str; +#ifdef DEBUGGING + if (debug & 8) { + (void)sprintf(buf,"LENSTAB $%s",stab_name(argptr.arg_stab)); + tmps = buf; + } +#endif + break; + case A_LEXPR: +#ifdef DEBUGGING + if (debug & 8) { + tmps = "LEXPR"; + deb("%d.LEXPR =>\n",anum); + } +#endif + if (argflags & AF_ARYOK) { + sp = eval(argptr.arg_arg, G_ARRAY, sp); + if (sp + (maxarg - anum) > stack->ary_max) + astore(stack, sp + (maxarg - anum), Nullstr); + st = stack->ary_array; /* possibly reallocated */ + } + else { + sp = eval(argptr.arg_arg, G_SCALAR, sp); + st = stack->ary_array; /* possibly reallocated */ + str = st[sp]; + goto do_crement; + } + break; + case A_LVAL: +#ifdef DEBUGGING + if (debug & 8) { + (void)sprintf(buf,"LVAL $%s",stab_name(argptr.arg_stab)); + tmps = buf; + } +#endif + ++sp; + str = STAB_STR(argptr.arg_stab); + if (!str) + fatal("panic: A_LVAL"); + do_crement: + assigning = TRUE; + if (argflags & AF_PRE) { + if (argflags & AF_UP) + str_inc(str); + else + str_dec(str); + STABSET(str); + st[sp] = str; + str = arg->arg_ptr.arg_str; + } + else if (argflags & AF_POST) { + st[sp] = str_mortal(str); + if (argflags & AF_UP) + str_inc(str); + else + str_dec(str); + STABSET(str); + str = arg->arg_ptr.arg_str; + } + else + st[sp] = str; + break; + case A_LARYLEN: + ++sp; + stab = argptr.arg_stab; + str = stab_array(argptr.arg_stab)->ary_magic; + if (optype != O_SASSIGN || argflags & (AF_PRE|AF_POST)) + str_numset(str,(double)(stab_array(stab)->ary_fill+arybase)); +#ifdef DEBUGGING + tmps = "LARYLEN"; +#endif + if (!str) + fatal("panic: A_LEXPR"); + goto do_crement; + case A_ARYLEN: + stab = argptr.arg_stab; + st[++sp] = stab_array(stab)->ary_magic; + str_numset(st[sp],(double)(stab_array(stab)->ary_fill+arybase)); +#ifdef DEBUGGING + tmps = "ARYLEN"; +#endif + break; + case A_SINGLE: + st[++sp] = argptr.arg_str; +#ifdef DEBUGGING + tmps = "SINGLE"; +#endif + break; + case A_DOUBLE: + (void) interp(str,argptr.arg_str,sp); + st = stack->ary_array; + st[++sp] = str; +#ifdef DEBUGGING + tmps = "DOUBLE"; +#endif + break; + case A_BACKTICK: + tmps = str_get(interp(str,argptr.arg_str,sp)); + st = stack->ary_array; +#ifdef TAINT + taintproper("Insecure dependency in ``"); +#endif + fp = mypopen(tmps,"r"); + str_set(str,""); + if (fp) { + if (gimme == G_SCALAR) { + while (str_gets(str,fp,str->str_cur) != Nullch) + /*SUPPRESS 530*/ + ; + } + else { + for (;;) { + if (++sp > stack->ary_max) { + astore(stack, sp, Nullstr); + st = stack->ary_array; + } + str = st[sp] = Str_new(56,80); + if (str_gets(str,fp,0) == Nullch) { + sp--; + break; + } + if (str->str_len - str->str_cur > 20) { + str->str_len = str->str_cur+1; + Renew(str->str_ptr, str->str_len, char); + } + str_2mortal(str); + } + } + statusvalue = mypclose(fp); + } + else + statusvalue = -1; + + if (gimme == G_SCALAR) + st[++sp] = str; +#ifdef DEBUGGING + tmps = "BACK"; +#endif + break; + case A_WANTARRAY: + { + if (curcsv->wantarray == G_ARRAY) + st[++sp] = &str_yes; + else + st[++sp] = &str_no; + } +#ifdef DEBUGGING + tmps = "WANTARRAY"; +#endif + break; + case A_INDREAD: + last_in_stab = stabent(str_get(STAB_STR(argptr.arg_stab)),TRUE); + old_rschar = rschar; + old_rslen = rslen; + goto do_read; + case A_GLOB: + argflags |= AF_POST; /* enable newline chopping */ + last_in_stab = argptr.arg_stab; + old_rschar = rschar; + old_rslen = rslen; + rslen = 1; +#ifdef DOSISH + rschar = 0; +#else +#ifdef CSH + rschar = 0; +#else + rschar = '\n'; +#endif /* !CSH */ +#endif /* !MSDOS */ + goto do_read; + case A_READ: + last_in_stab = argptr.arg_stab; + old_rschar = rschar; + old_rslen = rslen; + do_read: + if (anum > 1) /* assign to scalar */ + gimme = G_SCALAR; /* force context to scalar */ + if (gimme == G_ARRAY) + str = Str_new(57,0); + ++sp; + fp = Nullfp; + if (stab_io(last_in_stab)) { + fp = stab_io(last_in_stab)->ifp; + if (!fp) { + if (stab_io(last_in_stab)->flags & IOF_ARGV) { + if (stab_io(last_in_stab)->flags & IOF_START) { + stab_io(last_in_stab)->flags &= ~IOF_START; + stab_io(last_in_stab)->lines = 0; + if (alen(stab_array(last_in_stab)) < 0) { + tmpstr = str_make("-",1); /* assume stdin */ + (void)apush(stab_array(last_in_stab), tmpstr); + } + } + fp = nextargv(last_in_stab); + if (!fp) { /* Note: fp != stab_io(last_in_stab)->ifp */ + (void)do_close(last_in_stab,FALSE); /* now it does*/ + stab_io(last_in_stab)->flags |= IOF_START; + } + } + else if (argtype == A_GLOB) { + (void) interp(str,stab_val(last_in_stab),sp); + st = stack->ary_array; + tmpstr = Str_new(55,0); +#ifdef DOSISH + str_set(tmpstr, "perlglob "); + str_scat(tmpstr,str); + str_cat(tmpstr," |"); +#else +#ifdef CSH + str_nset(tmpstr,cshname,cshlen); + str_cat(tmpstr," -cf 'set nonomatch; glob "); + str_scat(tmpstr,str); + str_cat(tmpstr,"'|"); +#else + str_set(tmpstr, "echo "); + str_scat(tmpstr,str); + str_cat(tmpstr, + "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|"); +#endif /* !CSH */ +#endif /* !MSDOS */ + (void)do_open(last_in_stab,tmpstr->str_ptr, + tmpstr->str_cur); + fp = stab_io(last_in_stab)->ifp; + str_free(tmpstr); + } + } + } + if (!fp && dowarn) + warn("Read on closed filehandle <%s>",stab_ename(last_in_stab)); + tmplen = str->str_len; /* remember if already alloced */ + if (!tmplen) + Str_Grow(str,80); /* try short-buffering it */ + keepgoing: + if (!fp) + st[sp] = &str_undef; + else if (!str_gets(str,fp, optype == O_RCAT ? str->str_cur : 0)) { + clearerr(fp); + if (stab_io(last_in_stab)->flags & IOF_ARGV) { + fp = nextargv(last_in_stab); + if (fp) + goto keepgoing; + (void)do_close(last_in_stab,FALSE); + stab_io(last_in_stab)->flags |= IOF_START; + } + else if (argflags & AF_POST) { + (void)do_close(last_in_stab,FALSE); + } + st[sp] = &str_undef; + rschar = old_rschar; + rslen = old_rslen; + if (gimme == G_ARRAY) { + --sp; + str_2mortal(str); + goto array_return; + } + break; + } + else { + stab_io(last_in_stab)->lines++; + st[sp] = str; +#ifdef TAINT + str->str_tainted = 1; /* Anything from the outside world...*/ +#endif + if (argflags & AF_POST) { + if (str->str_cur > 0) + str->str_cur--; + if (str->str_ptr[str->str_cur] == rschar) + str->str_ptr[str->str_cur] = '\0'; + else + str->str_cur++; + for (tmps = str->str_ptr; *tmps; tmps++) + if (!isALPHA(*tmps) && !isDIGIT(*tmps) && + index("$&*(){}[]'\";\\|?<>~`",*tmps)) + break; + if (*tmps && stat(str->str_ptr,&statbuf) < 0) + goto keepgoing; /* unmatched wildcard? */ + } + if (gimme == G_ARRAY) { + if (str->str_len - str->str_cur > 20) { + str->str_len = str->str_cur+1; + Renew(str->str_ptr, str->str_len, char); + } + str_2mortal(str); + if (++sp > stack->ary_max) { + astore(stack, sp, Nullstr); + st = stack->ary_array; + } + str = Str_new(58,80); + goto keepgoing; + } + else if (!tmplen && str->str_len - str->str_cur > 80) { + /* try to reclaim a bit of scalar space on 1st alloc */ + if (str->str_cur < 60) + str->str_len = 80; + else + str->str_len = str->str_cur+40; /* allow some slop */ + Renew(str->str_ptr, str->str_len, char); + } + } + rschar = old_rschar; + rslen = old_rslen; +#ifdef DEBUGGING + tmps = "READ"; +#endif + break; + } +#ifdef DEBUGGING + if (debug & 8) + deb("%d.%s = '%s'\n",anum,tmps,str_peek(st[sp])); +#endif + if (anum < 8) + arglast[anum] = sp; + } st += arglast[0]; +#ifdef SMALLSWITCHES + if (optype < O_CHOWN) +#endif switch (optype) { case O_RCAT: STABSET(str); @@ -196,19 +599,29 @@ register int sp; STABSET(str); break; case O_REPEAT: + if (gimme == G_ARRAY && arg[1].arg_flags & AF_ARYOK) { + sp = do_repeatary(arglast); + goto array_return; + } STR_SSET(str,st[1]); anum = (int)str_gnum(st[2]); if (anum >= 1) { tmpstr = Str_new(50, 0); - str_sset(tmpstr,str); + tmps = str_get(str); + str_nset(tmpstr,tmps,str->str_cur); tmps = str_get(tmpstr); /* force to be string */ STR_GROW(str, (anum * str->str_cur) + 1); repeatcpy(str->str_ptr, tmps, tmpstr->str_cur, anum); str->str_cur *= anum; str->str_ptr[str->str_cur] = '\0'; + str->str_nok = 0; + str_free(tmpstr); } - else + else { + if (dowarn && st[2]->str_pok && !looks_like_number(st[2])) + warn("Right operand of x is not numeric"); str_sset(str,&str_no); + } STABSET(str); break; case O_MATCH: @@ -258,6 +671,10 @@ register int sp; goto array_return; case O_SASSIGN: sassign: +#ifdef TAINT + if (tainted && !st[2]->str_tainted) + tainted = 0; +#endif STR_SSET(str, st[2]); STABSET(str); break; @@ -284,6 +701,13 @@ register int sp; goto array_return; } else if (str != stab_val(defstab)) { + if (str->str_len) { + if (str->str_state == SS_INCR) + Str_Grow(str,0); + Safefree(str->str_ptr); + str->str_ptr = Nullch; + str->str_len = 0; + } str->str_pok = str->str_nok = 0; STABSET(str); } @@ -301,20 +725,38 @@ register int sp; value *= str_gnum(st[2]); goto donumset; case O_DIVIDE: - if ((value = str_gnum(st[2])) == 0.0) - fatal("Illegal division by zero"); + if ((value = str_gnum(st[2])) == 0.0) + fatal("Illegal division by zero"); +#ifdef SLOPPYDIVIDE + /* insure that 20./5. == 4. */ + { + double x; + int k; + x = str_gnum(st[1]); + if ((double)(int)x == x && + (double)(int)value == value && + (k = (int)x/(int)value)*(int)value == (int)x) { + value = k; + } else { + value = x/value; + } + } +#else value = str_gnum(st[1]) / value; +#endif goto donumset; case O_MODULO: - tmplong = (long) str_gnum(st[2]); - if (tmplong == 0L) + tmpulong = (unsigned long) str_gnum(st[2]); + if (tmpulong == 0L) fatal("Illegal modulus zero"); - when = (long)str_gnum(st[1]); #ifndef lint - if (when >= 0) - value = (double)(when % tmplong); - else - value = (double)(tmplong - ((-when - 1) % tmplong)) - 1; + value = str_gnum(st[1]); + if (value >= 0.0) + value = (double)(((unsigned long)value) % tmpulong); + else { + tmplong = (long)value; + value = (double)(tmpulong - ((-tmplong - 1) % tmpulong)) - 1; + } #endif goto donumset; case O_ADD: @@ -477,7 +919,11 @@ register int sp; value = -str_gnum(st[1]); goto donumset; case O_NOT: +#ifdef NOTNOT + { char xxx = str_true(st[1]); value = (double) !xxx; } +#else value = (double) !str_true(st[1]); +#endif goto donumset; case O_COMPLEMENT: if (!sawvec || st[1]->str_nok) { @@ -494,7 +940,7 @@ register int sp; } break; case O_SELECT: - stab_fullname(str,defoutstab); + stab_efullname(str,defoutstab); if (maxarg > 0) { if ((arg[1].arg_type & A_MASK) == A_WORD) defoutstab = arg[1].arg_ptr.arg_stab; @@ -543,7 +989,7 @@ register int sp; break; } format(&outrec,form,sp); - do_write(&outrec,stab_io(stab),sp); + do_write(&outrec,stab,sp); if (stab_io(stab)->flags & IOF_FLUSH) (void)fflush(fp); str_set(str, Yes); @@ -551,7 +997,11 @@ register int sp; break; case O_DBMOPEN: #ifdef SOME_DBM - stab = arg[1].arg_ptr.arg_stab; + anum = arg[1].arg_type & A_MASK; + if (anum == A_WORD || anum == A_STAB) + stab = arg[1].arg_ptr.arg_stab; + else + stab = stabent(str_get(st[1]),TRUE); if (st[3]->str_nok || st[3]->str_pok) anum = (int)str_gnum(st[3]); else @@ -563,7 +1013,11 @@ register int sp; #endif case O_DBMCLOSE: #ifdef SOME_DBM - stab = arg[1].arg_ptr.arg_stab; + anum = arg[1].arg_type & A_MASK; + if (anum == A_WORD || anum == A_STAB) + stab = arg[1].arg_ptr.arg_stab; + else + stab = stabent(str_get(st[1]),TRUE); hdbmclose(stab_hash(stab)); goto say_yes; #else @@ -645,7 +1099,7 @@ register int sp; tmps = str_get(st[2]); str = hdelete(stab_hash(tmpstab),tmps,st[2]->str_cur); if (tmpstab == envstab) - setenv(tmps,Nullch); + my_setenv(tmps,Nullch); if (!str) goto say_undef; break; @@ -696,7 +1150,7 @@ register int sp; else if (stab_hash(tmpstab)->tbl_dbm) str_magic(str, tmpstab, 'D', tmps, anum); #endif - else if (perldb && tmpstab == DBline) + else if (tmpstab == DBline) str_magic(str, tmpstab, 'L', tmps, anum); break; case O_LSLICE: @@ -743,7 +1197,7 @@ register int sp; if (!str) goto say_undef; if (ary->ary_flags & ARF_REAL) - (void)str_2static(str); + (void)str_2mortal(str); break; case O_UNPACK: sp = do_unpack(str,gimme,arglast); @@ -765,6 +1219,7 @@ register int sp; case O_SUBSTR: anum = ((int)str_gnum(st[2])) - arybase; /* anum=where to start*/ tmps = str_get(st[1]); /* force conversion to string */ + /*SUPPRESS 560*/ if (argtype = (str == st[1])) str = arg->arg_ptr.arg_str; if (anum < 0) @@ -790,6 +1245,7 @@ register int sp; } break; case O_PACK: + /*SUPPRESS 701*/ (void)do_pack(str,arglast); break; case O_GREP: @@ -839,25 +1295,19 @@ register int sp; st = stack->ary_array + arglast[0]; /* maybe realloced */ goto array_return; case O_SORT: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - sp = do_sort(str,stab, + sp = do_sort(str,arg, gimme,arglast); goto array_return; case O_REVERSE: if (gimme == G_ARRAY) - sp = do_reverse(str, - gimme,arglast); + sp = do_reverse(arglast); else - sp = do_sreverse(str, - gimme,arglast); + sp = do_sreverse(str, arglast); goto array_return; case O_WARN: if (arglast[2] - arglast[1] != 1) { do_join(str,arglast); - tmps = str_get(st[1]); + tmps = str_get(str); } else { str = st[2]; @@ -870,7 +1320,7 @@ register int sp; case O_DIE: if (arglast[2] - arglast[1] != 1) { do_join(str,arglast); - tmps = str_get(st[1]); + tmps = str_get(str); } else { str = st[2]; @@ -1019,9 +1469,10 @@ register int sp; maxarg = 0; if (!stab_io(stab) || !stab_io(stab)->ifp) goto say_undef; -#ifdef SOCKET +#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) { @@ -1038,7 +1489,11 @@ register int sp; goto badsock; #endif STR_GROW(st[2], anum+maxarg+1), (tmps = str_get(st[2])); /* sneaky */ -#ifdef SOCKET + 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, @@ -1046,10 +1501,6 @@ register int sp; } else #endif - if (optype == O_SYSREAD) { - anum = read(fileno(stab_io(stab)->ifp), tmps+maxarg, anum); - } - else anum = fread(tmps+maxarg, 1, anum, stab_io(stab)->ifp); if (anum < 0) goto say_undef; @@ -1086,7 +1537,7 @@ register int sp; optype = 0; anum = write(fileno(stab_io(stab)->ifp), tmps+optype, anum); } -#ifdef SOCKET +#ifdef HAS_SOCKET else if (maxarg >= 4) { if (maxarg > 4) warn("Too many args on send"); @@ -1117,17 +1568,18 @@ register int sp; case O_RETURN: tmps = "_SUB_"; /* just fake up a "last _SUB_" */ optype = O_LAST; - if (curcsv->wantarray == G_ARRAY) { + if (curcsv && curcsv->wantarray == G_ARRAY) { lastretstr = Nullstr; lastspbase = arglast[1]; lastsize = arglast[2] - arglast[1]; } else - lastretstr = str_static(st[arglast[2] - arglast[0]]); + lastretstr = str_mortal(st[arglast[2] - arglast[0]]); goto dopop; case O_REDO: case O_NEXT: case O_LAST: + tmps = Nullch; if (maxarg > 0) { tmps = str_get(arg[1].arg_ptr.arg_str); dopop: @@ -1159,7 +1611,7 @@ register int sp; optype = loop_stack[loop_ptr].loop_sp - lastspbase; /* negative */ if (optype) { for (anum = lastsize; anum > 0; anum--,st++) - st[optype] = str_static(st[0]); + st[optype] = str_mortal(st[0]); } longjmp(loop_stack[loop_ptr].loop_env, O_LAST); } @@ -1171,7 +1623,7 @@ register int sp; goto_targ = Nullch; /* just restart from top */ if (optype == O_DUMP) { do_undump = 1; - abort(); + my_unexec(); } longjmp(top_env, 1); case O_INDEX: @@ -1229,7 +1681,7 @@ register int sp; if (maxarg < 1) (void)time(&when); else - when = (long)str_gnum(st[1]); + when = (time_t)str_gnum(st[1]); sp = do_time(str,localtime(&when), gimme,arglast); goto array_return; @@ -1237,7 +1689,7 @@ register int sp; if (maxarg < 1) (void)time(&when); else - when = (long)str_gnum(st[1]); + when = (time_t)str_gnum(st[1]); sp = do_time(str,gmtime(&when), gimme,arglast); goto array_return; @@ -1251,7 +1703,7 @@ register int sp; gimme,arglast); goto array_return; case O_CRYPT: -#ifdef CRYPT +#ifdef HAS_CRYPT tmps = str_get(st[1]); #ifdef FCRYPT str_set(str,fcrypt(tmps,str_get(st[2]))); @@ -1323,6 +1775,8 @@ register int sp; value = str_gnum(stab_val(defstab)); else value = str_gnum(st[1]); + if (value <= 0.0) + fatal("Can't take log of %g\n", value); value = log(value); goto donumset; case O_SQRT: @@ -1330,6 +1784,8 @@ register int sp; value = str_gnum(stab_val(defstab)); else value = str_gnum(st[1]); + if (value < 0.0) + fatal("Can't take sqrt of %g\n", value); value = sqrt(value); goto donumset; case O_INT: @@ -1356,6 +1812,23 @@ register int sp; value = (double) (anum & 255); #endif goto donumset; + case O_ALARM: +#ifdef HAS_ALARM + if (maxarg < 1) + tmps = str_get(stab_val(defstab)); + else + tmps = str_get(st[1]); + if (!tmps) + tmps = "0"; + anum = alarm((unsigned int)atoi(tmps)); + if (anum < 0) + goto say_undef; + value = (double)anum; + goto donumset; +#else + fatal("Unsupported function alarm"); + break; +#endif case O_SLEEP: if (maxarg < 1) tmps = Nullch; @@ -1385,16 +1858,20 @@ register int sp; st = stack->ary_array; maxarg = sp - arglast[0]; str_free(arg[1].arg_ptr.arg_str); + arg[1].arg_ptr.arg_str = Nullstr; str_free(arg[2].arg_ptr.arg_str); + arg[2].arg_ptr.arg_str = Nullstr; arg->arg_type = O_ARRAY; arg[1].arg_type = A_STAB|A_DONT; arg->arg_len = 1; stab = arg[1].arg_ptr.arg_stab = aadd(genstab()); ary = stab_array(stab); afill(ary,maxarg - 1); + anum = maxarg; st += arglast[0]+1; while (maxarg-- > 0) ary->ary_array[maxarg] = str_smake(st[maxarg]); + st -= arglast[0]+1; goto array_return; } arg->arg_type = optype = O_RANGE; @@ -1417,17 +1894,23 @@ register int sp; last_in_stab && (int)str_gnum(st[1]) == stab_io(last_in_stab)->lines : str_true(st[1]) ) { - str_numset(str,0.0); - anum = 2; - arg->arg_type = optype = O_FLOP; arg[2].arg_type &= ~A_DONT; arg[1].arg_type |= A_DONT; - argflags = arg[2].arg_flags; - argtype = arg[2].arg_type & A_MASK; - argptr = arg[2].arg_ptr; - sp = arglast[0]; - st -= sp++; - goto re_eval; + arg->arg_type = optype = O_FLOP; + if (arg->arg_flags & AF_COMMON) { + str_numset(str,0.0); + anum = 2; + argflags = arg[2].arg_flags; + argtype = arg[2].arg_type & A_MASK; + argptr = arg[2].arg_ptr; + sp = arglast[0]; + st -= sp++; + goto re_eval; + } + else { + str_numset(str,1.0); + break; + } } str_set(str,""); break; @@ -1444,12 +1927,15 @@ register int sp; } break; case O_FORK: -#ifdef 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); /* no kids, so don't wait for 'em */ + hclear(pidstatus, FALSE); /* no kids, so don't wait for 'em */ } value = (double)anum; goto donumset; @@ -1458,7 +1944,7 @@ register int sp; break; #endif case O_WAIT: -#ifdef WAIT +#ifdef HAS_WAIT #ifndef lint anum = wait(&argflags); if (anum > 0) @@ -1472,7 +1958,7 @@ register int sp; break; #endif case O_WAITPID: -#ifdef WAITPID +#ifdef HAS_WAIT #ifndef lint anum = (int)str_gnum(st[1]); optype = (int)str_gnum(st[2]); @@ -1486,7 +1972,7 @@ register int sp; break; #endif case O_SYSTEM: -#ifdef FORK +#ifdef HAS_FORK #ifdef TAINT if (arglast[2] - arglast[1] == 1) { taintenv(); @@ -1525,7 +2011,7 @@ register int sp; else if (arglast[2] - arglast[1] != 1) value = (double)do_aexec(Nullstr,arglast); else { - value = (double)do_exec(str_get(str_static(st[2]))); + value = (double)do_exec(str_get(str_mortal(st[2]))); } _exit(-1); #else /* ! FORK */ @@ -1534,7 +2020,7 @@ register int sp; else if (arglast[2] - arglast[1] != 1) value = (double)do_aspawn(Nullstr,arglast); else { - value = (double)do_spawn(str_get(str_static(st[2]))); + value = (double)do_spawn(str_get(str_mortal(st[2]))); } goto donumset; #endif /* FORK */ @@ -1544,53 +2030,99 @@ register int sp; else if (arglast[2] - arglast[1] != 1) value = (double)do_aexec(Nullstr,arglast); else { - value = (double)do_exec(str_get(str_static(st[2]))); +#ifdef TAINT + taintenv(); + tainted |= st[2]->str_tainted; + taintproper("Insecure dependency in exec"); +#endif + value = (double)do_exec(str_get(str_mortal(st[2]))); } goto donumset; case O_HEX: - argtype = 4; - goto snarfnum; + if (maxarg < 1) + tmps = str_get(stab_val(defstab)); + else + tmps = str_get(st[1]); + value = (double)scanhex(tmps, 99, &argtype); + goto donumset; case O_OCT: - argtype = 3; - - snarfnum: - tmplong = 0; if (maxarg < 1) tmps = str_get(stab_val(defstab)); else tmps = str_get(st[1]); - for (;;) { - switch (*tmps) { - default: - goto out; - case '8': case '9': - if (argtype != 4) - goto out; - /* FALL THROUGH */ - case '0': case '1': case '2': case '3': case '4': - case '5': case '6': case '7': - tmplong <<= argtype; - tmplong += *tmps++ & 15; + while (*tmps && (isSPACE(*tmps) || *tmps == '0')) + tmps++; + if (*tmps == 'x') + value = (double)scanhex(++tmps, 99, &argtype); + else + value = (double)scanoct(tmps, 99, &argtype); + goto donumset; + +/* These common exits are hidden here in the middle of the switches for the + benefit of those machines with limited branch addressing. Sigh. */ + +array_return: +#ifdef DEBUGGING + if (debug) { + dlevel--; + if (debug & 8) { + anum = sp - arglast[0]; + switch (anum) { + case 0: + deb("%s RETURNS ()\n",opname[optype]); break; - case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': - case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': - if (argtype != 4) - goto out; - tmplong <<= 4; - tmplong += (*tmps++ & 7) + 9; + case 1: + deb("%s RETURNS (\"%s\")\n",opname[optype], + st[1] ? str_get(st[1]) : ""); break; - case 'x': - argtype = 4; - tmps++; + default: + tmps = st[1] ? str_get(st[1]) : ""; + deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\")\n",opname[optype], + anum,tmps,anum==2?"":"...,", + st[anum] ? str_get(st[anum]) : ""); break; } } - out: - value = (double)tmplong; - goto donumset; + } +#endif + return sp; + +say_yes: + str = &str_yes; + goto normal_return; + +say_no: + str = &str_no; + goto normal_return; + +say_undef: + str = &str_undef; + goto normal_return; + +say_zero: + value = 0.0; + /* FALL THROUGH */ + +donumset: + str_numset(str,value); + STABSET(str); + st[1] = str; +#ifdef DEBUGGING + if (debug) { + dlevel--; + if (debug & 8) + deb("%s RETURNS \"%f\"\n",opname[optype],value); + } +#endif + return arglast[0] + 1; +#ifdef SMALLSWITCHES + } + else + switch (optype) { +#endif case O_CHOWN: -#ifdef CHOWN +#ifdef HAS_CHOWN value = (double)apply(optype,arglast); goto donumset; #else @@ -1598,7 +2130,7 @@ register int sp; break; #endif case O_KILL: -#ifdef KILL +#ifdef HAS_KILL value = (double)apply(optype,arglast); goto donumset; #else @@ -1611,7 +2143,7 @@ register int sp; value = (double)apply(optype,arglast); goto donumset; case O_UMASK: -#ifdef UMASK +#ifdef HAS_UMASK if (maxarg < 1) { anum = umask(0); (void)umask(anum); @@ -1627,7 +2159,7 @@ register int sp; fatal("Unsupported function umask"); break; #endif -#ifdef SYSVIPC +#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) case O_MSGGET: case O_SHMGET: case O_SEMGET: @@ -1681,14 +2213,13 @@ register int sp; #ifdef TAINT taintproper("Insecure dependency in rename"); #endif -#ifdef RENAME +#ifdef HAS_RENAME value = (double)(rename(tmps,tmps2) >= 0); #else if (same_dirent(tmps2, tmps)) /* can always rename to same name */ anum = 1; else { - if (euid || stat(tmps2,&statbuf) < 0 || - (statbuf.st_mode & S_IFMT) != S_IFDIR ) + if (euid || stat(tmps2,&statbuf) < 0 || !S_ISDIR(statbuf.st_mode)) (void)UNLINK(tmps2); if (!(anum = link(tmps,tmps2))) anum = UNLINK(tmps); @@ -1697,7 +2228,7 @@ register int sp; #endif goto donumset; case O_LINK: -#ifdef LINK +#ifdef HAS_LINK tmps = str_get(st[1]); tmps2 = str_get(st[2]); #ifdef TAINT @@ -1715,13 +2246,13 @@ register int sp; #ifdef TAINT taintproper("Insecure dependency in mkdir"); #endif -#ifdef MKDIR +#ifdef HAS_MKDIR value = (double)(mkdir(tmps,anum) >= 0); goto donumset; #else (void)strcpy(buf,"mkdir "); #endif -#if !defined(MKDIR) || !defined(RMDIR) +#if !defined(HAS_MKDIR) || !defined(HAS_RMDIR) one_liner: for (tmps2 = buf+6; *tmps; ) { *tmps2++ = '\\'; @@ -1784,15 +2315,15 @@ register int sp; #ifdef TAINT taintproper("Insecure dependency in rmdir"); #endif -#ifdef RMDIR +#ifdef HAS_RMDIR value = (double)(rmdir(tmps) >= 0); goto donumset; #else (void)strcpy(buf,"rmdir "); - goto one_liner; /* see above in MKDIR */ + goto one_liner; /* see above in HAS_MKDIR */ #endif case O_GETPPID: -#ifdef GETPPID +#ifdef HAS_GETPPID value = (double)getppid(); goto donumset; #else @@ -1800,19 +2331,25 @@ register int sp; break; #endif case O_GETPGRP: -#ifdef GETPGRP +#ifdef HAS_GETPGRP if (maxarg < 1) anum = 0; else anum = (int)str_gnum(st[1]); +#ifdef _POSIX_SOURCE + if (anum != 0) + fatal("POSIX getpgrp can't take an argument"); + value = (double)getpgrp(); +#else value = (double)getpgrp(anum); +#endif goto donumset; #else fatal("The getpgrp() function is unimplemented on this machine"); break; #endif case O_SETPGRP: -#ifdef SETPGRP +#ifdef HAS_SETPGRP argtype = (int)str_gnum(st[1]); anum = (int)str_gnum(st[2]); #ifdef TAINT @@ -1825,7 +2362,7 @@ register int sp; break; #endif case O_GETPRIORITY: -#ifdef GETPRIORITY +#ifdef HAS_GETPRIORITY argtype = (int)str_gnum(st[1]); anum = (int)str_gnum(st[2]); value = (double)getpriority(argtype,anum); @@ -1835,7 +2372,7 @@ register int sp; break; #endif case O_SETPRIORITY: -#ifdef SETPRIORITY +#ifdef HAS_SETPRIORITY argtype = (int)str_gnum(st[1]); anum = (int)str_gnum(st[2]); optype = (int)str_gnum(st[3]); @@ -1849,7 +2386,7 @@ register int sp; break; #endif case O_CHROOT: -#ifdef CHROOT +#ifdef HAS_CHROOT if (maxarg < 1) tmps = str_get(stab_val(defstab)); else @@ -1886,7 +2423,7 @@ register int sp; STABSET(str); break; case O_FLOCK: -#ifdef FLOCK +#ifdef HAS_FLOCK if (maxarg <= 0) stab = last_in_stab; else if ((arg[1].arg_type & A_MASK) == A_WORD) @@ -1921,6 +2458,22 @@ register int sp; 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: @@ -1933,33 +2486,33 @@ register int sp; tainted |= tmpstr->str_tainted; taintproper("Insecure dependency in eval"); #endif - sp = do_eval(tmpstr, optype, curcmd->c_stash, + sp = do_eval(tmpstr, optype, curcmd->c_stash, FALSE, gimme,arglast); goto array_return; case O_FTRREAD: argtype = 0; - anum = S_IREAD; + anum = S_IRUSR; goto check_perm; case O_FTRWRITE: argtype = 0; - anum = S_IWRITE; + anum = S_IWUSR; goto check_perm; case O_FTREXEC: argtype = 0; - anum = S_IEXEC; + anum = S_IXUSR; goto check_perm; case O_FTEREAD: argtype = 1; - anum = S_IREAD; + anum = S_IRUSR; goto check_perm; case O_FTEWRITE: argtype = 1; - anum = S_IWRITE; + anum = S_IWUSR; goto check_perm; case O_FTEEXEC: argtype = 1; - anum = S_IEXEC; + anum = S_IXUSR; check_perm: if (mystat(arg,st[1]) < 0) goto say_undef; @@ -2007,52 +2560,49 @@ register int sp; goto donumset; case O_FTSOCK: -#ifdef S_IFSOCK - anum = S_IFSOCK; - goto check_file_type; -#else + if (mystat(arg,st[1]) < 0) + goto say_undef; + if (S_ISSOCK(statcache.st_mode)) + goto say_yes; goto say_no; -#endif case O_FTCHR: - anum = S_IFCHR; - goto check_file_type; + if (mystat(arg,st[1]) < 0) + goto say_undef; + if (S_ISCHR(statcache.st_mode)) + goto say_yes; + goto say_no; case O_FTBLK: -#ifdef S_IFBLK - anum = S_IFBLK; - goto check_file_type; -#else + if (mystat(arg,st[1]) < 0) + goto say_undef; + if (S_ISBLK(statcache.st_mode)) + goto say_yes; goto say_no; -#endif case O_FTFILE: - anum = S_IFREG; - goto check_file_type; + if (mystat(arg,st[1]) < 0) + goto say_undef; + if (S_ISREG(statcache.st_mode)) + goto say_yes; + goto say_no; case O_FTDIR: - anum = S_IFDIR; - check_file_type: if (mystat(arg,st[1]) < 0) goto say_undef; - if ((statcache.st_mode & S_IFMT) == anum ) + if (S_ISDIR(statcache.st_mode)) goto say_yes; goto say_no; case O_FTPIPE: -#ifdef S_IFIFO - anum = S_IFIFO; - goto check_file_type; -#else + if (mystat(arg,st[1]) < 0) + goto say_undef; + if (S_ISFIFO(statcache.st_mode)) + goto say_yes; goto say_no; -#endif case O_FTLINK: - if (arg[1].arg_type & A_DONT) - fatal("You must supply explicit filename with -l"); -#ifdef LSTAT - if (lstat(str_get(st[1]),&statcache) < 0) + if (mylstat(arg,st[1]) < 0) goto say_undef; - if ((statcache.st_mode & S_IFMT) == S_IFLNK ) + if (S_ISLNK(statcache.st_mode)) goto say_yes; -#endif goto say_no; case O_SYMLINK: -#ifdef SYMLINK +#ifdef HAS_SYMLINK tmps = str_get(st[1]); tmps2 = str_get(st[2]); #ifdef TAINT @@ -2064,7 +2614,7 @@ register int sp; fatal("Unsupported function symlink"); #endif case O_READLINK: -#ifdef SYMLINK +#ifdef HAS_SYMLINK if (maxarg < 1) tmps = str_get(stab_val(defstab)); else @@ -2075,7 +2625,7 @@ register int sp; str_nset(str,buf,anum); break; #else - fatal("Unsupported function readlink"); + goto say_undef; /* just pretend it's a normal file */ #endif case O_FTSUID: #ifdef S_ISUID @@ -2112,7 +2662,7 @@ register int sp; stab = stabent(tmps = str_get(st[1]),FALSE); if (stab && stab_io(stab) && stab_io(stab)->ifp) anum = fileno(stab_io(stab)->ifp); - else if (isdigit(*tmps)) + else if (isDIGIT(*tmps)) anum = atoi(tmps); else goto say_undef; @@ -2123,7 +2673,7 @@ register int sp; case O_FTBINARY: str = do_fttext(arg,st[1]); break; -#ifdef SOCKET +#ifdef HAS_SOCKET case O_SOCKET: if ((arg[1].arg_type & A_MASK) == A_WORD) stab = arg[1].arg_ptr.arg_stab; @@ -2281,7 +2831,7 @@ register int sp; sp = do_getsockname(optype,stab,arglast); goto array_return; -#else /* SOCKET not defined */ +#else /* HAS_SOCKET not defined */ case O_SOCKET: case O_BIND: case O_CONNECT: @@ -2315,9 +2865,9 @@ register int sp; case O_GETPEERNAME: badsock: fatal("Unsupported socket function"); -#endif /* SOCKET */ +#endif /* HAS_SOCKET */ case O_SSELECT: -#ifdef SELECT +#ifdef HAS_SELECT sp = do_select(gimme,arglast); goto array_return; #else @@ -2343,8 +2893,18 @@ register int sp; stab = stabent(str_get(st[1]),TRUE); if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp)) goto say_undef; -#ifdef MSDOS +#ifdef DOSISH +#ifdef atarist + if(fflush(fp)) + str_set(str, No); + else + { + fp->_flag |= _IOBIN; + str_set(str, Yes); + } +#else str_set(str, (setmode(fileno(fp), O_BINARY) != -1) ? Yes : No); +#endif #else str_set(str, Yes); #endif @@ -2356,7 +2916,7 @@ register int sp; case O_GPWNAM: case O_GPWUID: case O_GPWENT: -#ifdef PASSWD +#ifdef HAS_PASSWD sp = do_gpwent(optype, gimme,arglast); goto array_return; @@ -2375,7 +2935,7 @@ register int sp; case O_GGRNAM: case O_GGRGID: case O_GGRENT: -#ifdef GROUP +#ifdef HAS_GROUP sp = do_ggrent(optype, gimme,arglast); goto array_return; @@ -2392,7 +2952,7 @@ register int sp; break; #endif case O_GETLOGIN: -#ifdef GETLOGIN +#ifdef HAS_GETLOGIN if (!(tmps = getlogin())) goto say_undef; str_set(str,tmps); @@ -2400,7 +2960,7 @@ register int sp; fatal("Unsupported function getlogin"); #endif break; - case O_OPENDIR: + case O_OPEN_DIR: case O_READDIR: case O_TELLDIR: case O_SEEKDIR: @@ -2419,8 +2979,8 @@ register int sp; case O_SYSCALL: value = (double)do_syscall(arglast); goto donumset; - case O_PIPE: -#ifdef PIPE + case O_PIPE_OP: +#ifdef HAS_PIPE if ((arg[1].arg_type & A_MASK) == A_WORD) stab = arg[1].arg_ptr.arg_stab; else @@ -2447,57 +3007,4 @@ register int sp; } #endif return arglast[0] + 1; - -array_return: -#ifdef DEBUGGING - if (debug) { - dlevel--; - if (debug & 8) { - anum = sp - arglast[0]; - switch (anum) { - case 0: - deb("%s RETURNS ()\n",opname[optype]); - break; - case 1: - deb("%s RETURNS (\"%s\")\n",opname[optype],str_get(st[1])); - break; - default: - tmps = str_get(st[1]); - deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\")\n",opname[optype], - anum,tmps,anum==2?"":"...,",str_get(st[anum])); - break; - } - } - } -#endif - return sp; - -say_yes: - str = &str_yes; - goto normal_return; - -say_no: - str = &str_no; - goto normal_return; - -say_undef: - str = &str_undef; - goto normal_return; - -say_zero: - value = 0.0; - /* FALL THROUGH */ - -donumset: - str_numset(str,value); - STABSET(str); - st[1] = str; -#ifdef DEBUGGING - if (debug) { - dlevel--; - if (debug & 8) - deb("%s RETURNS \"%f\"\n",opname[optype],value); - } -#endif - return arglast[0] + 1; }