From: Larry Wall Date: Wed, 28 Feb 1990 21:54:46 +0000 (+0000) Subject: perl 3.0 patch #10 patch #9, continued X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=afd9f252e30d37007c653bd21680f0b5f6c32608;p=p5sagit%2Fp5-mst-13.2.git perl 3.0 patch #10 patch #9, continued See patch #9. --- diff --git a/cmd.c b/cmd.c index 36c36bd..be03fe0 100644 --- a/cmd.c +++ b/cmd.c @@ -1,4 +1,4 @@ -/* $Header: cmd.c,v 3.0.1.4 89/12/21 19:17:41 lwall Locked $ +/* $Header: cmd.c,v 3.0.1.5 90/02/28 16:38:31 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,14 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: cmd.c,v $ + * Revision 3.0.1.5 90/02/28 16:38:31 lwall + * patch9: volatilized some more variables for super-optimizing compilers + * patch9: nested foreach loops didn't reset inner loop on next to outer loop + * patch9: returned values were read from obsolete stack + * patch9: added sanity check on longjmp() return value + * patch9: substitutions that almost always succeed can corrupt label stack + * patch9: subs which return by both mechanisms can clobber local return data + * * Revision 3.0.1.4 89/12/21 19:17:41 lwall * patch7: arranged for certain registers to be restored after longjmp() * patch7: made nested or recursive foreach work right @@ -50,11 +58,12 @@ void grow_dlevel(); int cmd_exec(cmdparm,gimme,sp) CMD *VOLATILE cmdparm; -int gimme; -int sp; +VOLATILE int gimme; +VOLATILE int sp; { register CMD *cmd = cmdparm; SPAT *VOLATILE oldspat; + VOLATILE int firstsave = savestack->ary_fill; VOLATILE int oldsave; VOLATILE int aryoptsave; #ifdef DEBUGGING @@ -178,12 +187,16 @@ tail_recursion_entry: cmdparm = cmd; #endif if (match = setjmp(loop_stack[loop_ptr].loop_env)) { -#ifdef JMPCLOBBER st = stack->ary_array; /* possibly reallocated */ +#ifdef JMPCLOBBER cmd = cmdparm; cmdflags = cmd->c_flags|CF_ONCE; #endif + if (savestack->ary_fill > oldsave) + restorelist(oldsave); switch (match) { + default: + fatal("longjmp returned bad value (%d)",match); case O_LAST: /* not done unless go_to found */ go_to = Nullch; if (lastretstr) { @@ -198,8 +211,6 @@ tail_recursion_entry: olddlevel = dlevel; #endif curspat = oldspat; - if (savestack->ary_fill > oldsave) - restorelist(oldsave); goto next_cmd; case O_NEXT: /* not done unless go_to found */ go_to = Nullch; @@ -450,7 +461,7 @@ until_loop: } } if (--cmd->c_short->str_u.str_useful < 0) { - cmdflags &= ~CF_OPTIMIZE; + cmdflags &= ~(CF_OPTIMIZE|CF_ONCE); cmdflags |= CFT_EVAL; /* never try this optimization again */ cmd->c_flags = cmdflags; } @@ -563,8 +574,11 @@ until_loop: savesptr(&stab_val(cmd->c_stab)); savelong(&cmd->c_short->str_u.str_useful); } - else + else { ar = stab_xarray(cmd->c_expr[1].arg_ptr.arg_stab); + if (cmd->c_type != C_WHILE && savestack->ary_fill > firstsave) + restorelist(firstsave); + } if (match >= ar->ary_fill) { /* we're in LAST, probably */ retstr = &str_undef; @@ -753,13 +767,17 @@ until_loop: cmdparm = cmd; #endif if (match = setjmp(loop_stack[loop_ptr].loop_env)) { -#ifdef JMPCLOBBER st = stack->ary_array; /* possibly reallocated */ +#ifdef JMPCLOBBER cmd = cmdparm; cmdflags = cmd->c_flags|CF_ONCE; go_to = goto_targ; #endif + if (savestack->ary_fill > oldsave) + restorelist(oldsave); switch (match) { + default: + fatal("longjmp returned bad value (%d)",match); case O_LAST: if (lastretstr) { retstr = lastretstr; @@ -770,8 +788,6 @@ until_loop: retstr = st[newsp]; } curspat = oldspat; - if (savestack->ary_fill > oldsave) - restorelist(oldsave); goto next_cmd; case O_NEXT: #ifdef JMPCLOBBER @@ -831,8 +847,14 @@ until_loop: } finish_while: curspat = oldspat; - if (savestack->ary_fill > oldsave) + if (savestack->ary_fill > oldsave) { + if (cmdflags & CF_TERM) { + for (match = sp + 1; match <= newsp; match++) + st[match] = str_static(st[match]); + retstr = st[newsp]; + } restorelist(oldsave); + } #ifdef DEBUGGING dlevel = olddlevel - 1; #endif @@ -855,7 +877,8 @@ until_loop: } #endif loop_ptr--; - if ((cmdflags & CF_OPTIMIZE) == CFT_ARRAY) + if ((cmdflags & CF_OPTIMIZE) == CFT_ARRAY && + savestack->ary_fill > aryoptsave) restorelist(aryoptsave); } cmd = cmd->c_next; diff --git a/cmd.h b/cmd.h index 3a1d832..0c4a0b8 100644 --- a/cmd.h +++ b/cmd.h @@ -1,4 +1,4 @@ -/* $Header: cmd.h,v 3.0.1.1 89/10/26 23:05:43 lwall Locked $ +/* $Header: cmd.h,v 3.0.1.2 90/02/28 16:39:36 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: cmd.h,v $ + * Revision 3.0.1.2 90/02/28 16:39:36 lwall + * patch9: volatilized some more variables for super-optimizing compilers + * * Revision 3.0.1.1 89/10/26 23:05:43 lwall * patch1: unless was broken when run under the debugger * @@ -127,7 +130,7 @@ struct cmd { struct scmd scmd; /* switch command */ } ucmd; short c_slen; /* len of c_short, if not null */ - short c_flags; /* optimization flags--see above */ + VOLATILE short c_flags; /* optimization flags--see above */ char *c_file; /* file the following line # is from */ line_t c_line; /* line # of this command */ char c_type; /* what this command does */ @@ -135,8 +138,8 @@ struct cmd { #define Nullcmd Null(CMD*) -EXT CMD *main_root INIT(Nullcmd); -EXT CMD *eval_root INIT(Nullcmd); +EXT CMD * VOLATILE main_root INIT(Nullcmd); +EXT CMD * VOLATILE eval_root INIT(Nullcmd); struct compcmd { CMD *comp_true; diff --git a/config.h.SH b/config.h.SH index af686c6..7215ef9 100644 --- a/config.h.SH +++ b/config.h.SH @@ -422,6 +422,12 @@ sed <config.h -e 's!^#undef!/\*#undef!' */ #$d_voidsig VOIDSIG /**/ +/* HASVOLATILE: + * This symbol, if defined, indicates that this C compiler knows about + * the volatile declaration. + */ +#$d_volatile HASVOLATILE /**/ + /* VPRINTF: * This symbol, if defined, indicates that the vprintf routine is available * to printf with a pointer to an argument list. If unavailable, you @@ -542,7 +548,7 @@ sed <config.h -e 's!^#undef!/\*#undef!' /* I_UTIME: * This symbol, if defined, indicates to the C program that it should - * include utime.h (a DG/UX thingie). + * include utime.h. */ #$i_utime I_UTIME /**/ diff --git a/cons.c b/cons.c index 6db876c..28b6ddf 100644 --- a/cons.c +++ b/cons.c @@ -1,4 +1,4 @@ -/* $Header: cons.c,v 3.0.1.3 89/12/21 19:20:25 lwall Locked $ +/* $Header: cons.c,v 3.0.1.4 90/02/28 16:44:00 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,11 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: cons.c,v $ + * Revision 3.0.1.4 90/02/28 16:44:00 lwall + * patch9: subs which return by both mechanisms can clobber local return data + * patch9: changed internal SUB label to _SUB_ + * patch9: line numbers were bogus during certain portions of foreach evaluation + * * Revision 3.0.1.3 89/12/21 19:20:25 lwall * patch7: made nested or recursive foreach work right * @@ -67,8 +72,12 @@ CMD *cmd; mycompblock.comp_true = cmd; mycompblock.comp_alt = Nullcmd; - cmd = add_label(savestr("SUB"),make_ccmd(C_BLOCK,Nullarg,mycompblock)); + cmd = add_label(savestr("_SUB_"),make_ccmd(C_BLOCK,Nullarg,mycompblock)); saw_return = FALSE; + if (perldb) + cmd->c_next->c_flags |= CF_TERM; + else + cmd->c_flags |= CF_TERM; } sub->cmd = cmd; stab_sub(stab) = sub; @@ -412,7 +421,9 @@ ARG *arg; cmd->c_expr = cond; if (cond) cmd->c_flags |= CF_COND; - if (cmdline != NOLINE) { + if (cmdline == NOLINE) + cmd->c_line = line; + else { cmd->c_line = cmdline; cmdline = NOLINE; } @@ -437,7 +448,9 @@ struct compcmd cblock; cmd->ucmd.ccmd.cc_alt = cblock.comp_alt; if (arg) cmd->c_flags |= CF_COND; - if (cmdline != NOLINE) { + if (cmdline == NOLINE) + cmd->c_line = line; + else { cmd->c_line = cmdline; cmdline = NOLINE; } @@ -466,7 +479,9 @@ struct compcmd cblock; cmd->ucmd.ccmd.cc_alt = cblock.comp_alt; if (arg) cmd->c_flags |= CF_COND; - if (cmdline != NOLINE) { + if (cmdline == NOLINE) + cmd->c_line = line; + else { cmd->c_line = cmdline; cmdline = NOLINE; } diff --git a/consarg.c b/consarg.c index 6feeb9b..4252ad5 100644 --- a/consarg.c +++ b/consarg.c @@ -1,4 +1,4 @@ -/* $Header: consarg.c,v 3.0.1.2 89/11/17 15:11:34 lwall Locked $ +/* $Header: consarg.c,v 3.0.1.3 90/02/28 16:47:54 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,10 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: consarg.c,v $ + * Revision 3.0.1.3 90/02/28 16:47:54 lwall + * patch9: the x operator is now up to 10 times faster + * patch9: @_ clobbered by ($foo,$bar) = split + * * Revision 3.0.1.2 89/11/17 15:11:34 lwall * patch5: defined $foo{'bar'} should not create element * @@ -312,9 +316,12 @@ register ARG *arg; break; case O_REPEAT: i = (int)str_gnum(s2); + tmps = str_get(s1); str_nset(str,"",0); - while (i-- > 0) - str_scat(str,s1); + STR_GROW(str, i * s1->str_cur + 1); + repeatcpy(str->str_ptr, tmps, s1->str_cur, i); + str->str_cur = i * s1->str_cur; + str->str_ptr[str->str_cur] = '\0'; break; case O_MULTIPLY: value = str_gnum(s1); @@ -648,10 +655,11 @@ register ARG *arg; arg2 = arg[2].arg_ptr.arg_arg; if (arg2->arg_type == O_SPLIT) { /* use split's builtin =?*/ spat = arg2[2].arg_ptr.arg_spat; - if (spat->spat_repl[1].arg_ptr.arg_stab == defstab && + if (!(spat->spat_flags & SPAT_ONCE) && nothing_in_common(arg1,spat->spat_repl)) { spat->spat_repl[1].arg_ptr.arg_stab = arg1[1].arg_ptr.arg_stab; + spat->spat_flags |= SPAT_ONCE; arg_free(arg1); /* recursive */ free_arg(arg); /* non-recursive */ return arg2; /* split has builtin assign */ diff --git a/doarg.c b/doarg.c index 7e7bfc8..43d945f 100644 --- a/doarg.c +++ b/doarg.c @@ -1,4 +1,4 @@ -/* $Header: doarg.c,v 3.0.1.2 89/12/21 19:52:15 lwall Locked $ +/* $Header: doarg.c,v 3.0.1.3 90/02/28 16:56:58 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,15 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: doarg.c,v $ + * Revision 3.0.1.3 90/02/28 16:56:58 lwall + * patch9: split now can split into more than 10000 elements + * patch9: sped up pack and unpack + * patch9: pack of unsigned ints and longs blew up some places + * patch9: sun3 can't cast negative float to unsigned int or long + * patch9: local($.) didn't work + * patch9: grep(s/foo/bar/, @abc = @xyz) modified @xyz rather than @abc + * patch9: syscall returned stack size rather than value of system call + * * Revision 3.0.1.2 89/12/21 19:52:15 lwall * patch7: a pattern wouldn't match a null string before the first character * patch7: certain patterns didn't match correctly at end of string @@ -44,6 +53,7 @@ int sp; register char *d; int clen; int iters = 0; + int maxiters = (strend - s) + 10; register int i; bool once; char *orig; @@ -192,7 +202,7 @@ int sp; /* NOTREACHED */ } do { - if (iters++ > 10000) + if (iters++ > maxiters) fatal("Substitution loop"); m = spat->spat_regexp->startp[0]; if (i = m - s) { @@ -233,7 +243,7 @@ int sp; curspat = spat; lastspat = spat; do { - if (iters++ > 10000) + if (iters++ > maxiters) fatal("Substitution loop"); if (spat->spat_regexp->subbase && spat->spat_regexp->subbase != orig) { @@ -351,7 +361,9 @@ int *arglast; char achar; short ashort; int aint; + unsigned int auint; long along; + unsigned long aulong; char *aptr; items = arglast[2] - sp; @@ -361,9 +373,9 @@ int *arglast; #define NEXTFROM (items-- > 0 ? *st++ : &str_no) datumtype = *pat++; if (isdigit(*pat)) { - len = atoi(pat); + len = *pat++ - '0'; while (isdigit(*pat)) - pat++; + len = (len * 10) + (*pat++ - '0'); } else len = 1; @@ -429,6 +441,12 @@ int *arglast; } break; case 'I': + while (len-- > 0) { + fromstr = NEXTFROM; + auint = (unsigned int)str_gnum(fromstr); + str_ncat(str,(char*)&auint,sizeof(unsigned int)); + } + break; case 'i': while (len-- > 0) { fromstr = NEXTFROM; @@ -447,6 +465,12 @@ int *arglast; } break; case 'L': + while (len-- > 0) { + fromstr = NEXTFROM; + aulong = (unsigned long)str_gnum(fromstr); + str_ncat(str,(char*)&aulong,sizeof(unsigned long)); + } + break; case 'l': while (len-- > 0) { fromstr = NEXTFROM; @@ -481,6 +505,7 @@ register STR **sarg; register char *send; char *xs; int xlen; + double value; str_set(str,""); len--; /* don't count pattern string */ @@ -547,10 +572,20 @@ register STR **sarg; case 'x': case 'o': case 'u': ch = *(++t); *t = '\0'; + value = str_gnum(*(sarg++)); +#if defined(sun) && !defined(sparc) + if (value < 0.0) { /* sigh */ + if (dolong) + (void)sprintf(buf,s,(long)value); + else + (void)sprintf(buf,s,(int)value); + } + else +#endif if (dolong) - (void)sprintf(buf,s,(unsigned long)str_gnum(*(sarg++))); + (void)sprintf(buf,s,(unsigned long)value); else - (void)sprintf(buf,s,(unsigned int)str_gnum(*(sarg++))); + (void)sprintf(buf,s,(unsigned int)value); s = t; *(t--) = ch; break; @@ -798,6 +833,7 @@ int *arglast; int i; makelocal = (arg->arg_flags & AF_LOCAL); + localizing = makelocal; delaymagic = DM_DELAY; /* catch simultaneous items */ /* If there's a common identifier on both sides we have to take @@ -828,9 +864,8 @@ int *arglast; while (relem <= lastrelem) { /* gobble up all the rest */ str = Str_new(28,0); if (*relem) - str_sset(str,*(relem++)); - else - relem++; + str_sset(str,*relem); + *(relem++) = str; (void)astore(ary,i++,str); } } @@ -852,9 +887,8 @@ int *arglast; tmps = str_get(str); tmpstr = Str_new(29,0); if (*relem) - str_sset(tmpstr,*(relem++)); /* value */ - else - relem++; + str_sset(tmpstr,*relem); /* value */ + *(relem++) = tmpstr; (void)hstore(hash,tmps,str->str_cur,tmpstr,0); } } @@ -864,10 +898,26 @@ int *arglast; else { if (makelocal) saveitem(str); - if (relem <= lastrelem) - str_sset(str, *(relem++)); - else + if (relem <= lastrelem) { + str_sset(str, *relem); + *(relem++) = str; + } + else { str_nset(str, "", 0); + if (gimme == G_ARRAY) { + i = ++lastrelem - firstrelem; + relem++; /* tacky, I suppose */ + astore(stack,i,str); + if (st != stack->ary_array) { + st = stack->ary_array; + firstrelem = st + arglast[1] + 1; + firstlelem = st + arglast[0] + 1; + lastlelem = st + arglast[1]; + lastrelem = st + i; + relem = lastrelem + 1; + } + } + } STABSET(str); } } @@ -882,6 +932,7 @@ int *arglast; #endif } delaymagic = 0; + localizing = FALSE; if (gimme == G_ARRAY) { i = lastrelem - firstrelem + 1; if (ary || hash) @@ -1283,9 +1334,7 @@ int *arglast; arg[7]); break; } - st[sp] = str_static(&str_undef); - str_numset(st[sp], (double)retval); - return sp; + return retval; #else fatal("syscall() unimplemented"); #endif diff --git a/doio.c b/doio.c index 853347a..766d120 100644 --- a/doio.c +++ b/doio.c @@ -1,4 +1,4 @@ -/* $Header: doio.c,v 3.0.1.4 89/12/21 19:55:10 lwall Locked $ +/* $Header: doio.c,v 3.0.1.5 90/02/28 17:01:36 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,12 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: doio.c,v $ + * Revision 3.0.1.5 90/02/28 17:01:36 lwall + * patch9: open(FOO,"$filename\0") will now protect trailing spaces in filename + * patch9: removed obsolete checks to avoid opening block devices + * patch9: removed references to acusec and modusec that some utime.h's have + * patch9: added pipe function + * * Revision 3.0.1.4 89/12/21 19:55:10 lwall * patch7: select now works on big-endian machines * patch7: errno may now be a macro with an lvalue @@ -53,12 +59,12 @@ #endif bool -do_open(stab,name) +do_open(stab,name,len) STAB *stab; register char *name; +int len; { FILE *fp; - int len = strlen(name); register STIO *stio = stab_io(stab); char *myname = savestr(name); int result; @@ -202,21 +208,6 @@ register char *name; return FALSE; } result = (statbuf.st_mode & S_IFMT); - if (result != S_IFREG && -#ifdef S_IFSOCK - result != S_IFSOCK && -#endif -#ifdef S_IFFIFO - result != S_IFFIFO && -#endif -#ifdef S_IFIFO - result != S_IFIFO && -#endif - result != 0 && /* socket? */ - result != S_IFCHR) { - (void)fclose(fp); - return FALSE; - } #ifdef S_IFSOCK if (result == S_IFSOCK || result == 0) stio->type = 's'; /* in case a socket was passed in to us */ @@ -250,7 +241,7 @@ register STAB *stab; str_sset(stab_val(stab),str); STABSET(stab_val(stab)); oldname = str_get(stab_val(stab)); - if (do_open(stab,oldname)) { + if (do_open(stab,oldname,stab_val(stab)->str_cur)) { if (inplace) { #ifdef TAINT taintproper("Insecure dependency in inplace open"); @@ -275,7 +266,7 @@ register STAB *stab; str_nset(str,">",1); str_cat(str,oldname); errno = 0; /* in case sprintf set errno */ - if (!do_open(argvoutstab,str->str_ptr)) + if (!do_open(argvoutstab,str->str_ptr,str->str_cur)) fatal("Can't do inplace edit"); defoutstab = argvoutstab; #ifdef FCHMOD @@ -303,6 +294,49 @@ register STAB *stab; return Nullfp; } +void +do_pipe(str, rstab, wstab) +STR *str; +STAB *rstab; +STAB *wstab; +{ + register STIO *rstio; + register STIO *wstio; + int fd[2]; + + if (!rstab) + goto badexit; + if (!wstab) + goto badexit; + + rstio = stab_io(rstab); + wstio = stab_io(wstab); + + if (!rstio) + rstio = stab_io(rstab) = stio_new(); + else if (rstio->ifp) + do_close(rstab,FALSE); + if (!wstio) + wstio = stab_io(wstab) = stio_new(); + else if (wstio->ifp) + do_close(wstab,FALSE); + + if (pipe(fd) < 0) + goto badexit; + rstio->ifp = fdopen(fd[0], "r"); + wstio->ofp = fdopen(fd[1], "w"); + wstio->ifp = wstio->ofp; + rstio->type = '<'; + wstio->type = '>'; + + str_sset(str,&str_yes); + return; + +badexit: + str_sset(str,&str_undef); + return; +} + bool do_close(stab,explicit) STAB *stab; @@ -1991,12 +2025,9 @@ int *arglast; } utbuf; #endif + Zero(&utbuf, sizeof utbuf, char); utbuf.actime = (long)str_gnum(st[++sp]); /* time accessed */ utbuf.modtime = (long)str_gnum(st[++sp]); /* time modified */ -#ifdef I_UTIME - utbuf.acusec = 0; /* hopefully I_UTIME implies these */ - utbuf.modusec = 0; -#endif items -= 2; #ifndef lint tot = items; diff --git a/dolist.c b/dolist.c index 4823231..bd7db0b 100644 --- a/dolist.c +++ b/dolist.c @@ -1,4 +1,4 @@ -/* $Header: dolist.c,v 3.0.1.4 89/12/21 19:58:46 lwall Locked $ +/* $Header: dolist.c,v 3.0.1.5 90/02/28 17:09:44 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,15 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: dolist.c,v $ + * Revision 3.0.1.5 90/02/28 17:09:44 lwall + * patch9: split now can split into more than 10000 elements + * patch9: @_ clobbered by ($foo,$bar) = split + * patch9: sped up pack and unpack + * patch9: unpack of single item now works in a scalar context + * patch9: slices ignored value of $[ + * patch9: grep now returns number of items matched in scalar context + * patch9: grep iterations no longer in the regexp context of previous iteration + * * Revision 3.0.1.4 89/12/21 19:58:46 lwall * patch7: grep(1,@array) didn't work * patch7: /$pat/; //; wrongly freed runtime pattern twice @@ -264,6 +273,7 @@ int *arglast; register STR *dstr; register char *m; int iters = 0; + int maxiters = (strend - s) + 10; int i; char *orig; int origlimit = limit; @@ -299,7 +309,7 @@ int *arglast; } #endif ary = stab_xarray(spat->spat_repl[1].arg_ptr.arg_stab); - if (ary && ((ary->ary_flags & ARF_REAL) || gimme != G_ARRAY)) { + if (ary && (gimme != G_ARRAY || (spat->spat_flags & SPAT_ONCE))) { realarray = 1; if (!(ary->ary_flags & ARF_REAL)) { ary->ary_flags |= ARF_REAL; @@ -317,7 +327,7 @@ int *arglast; s++; } if (!limit) - limit = 10001; + limit = maxiters + 2; if (spat->spat_short) { i = spat->spat_short->str_cur; if (i == 1) { @@ -353,6 +363,7 @@ int *arglast; } } else { + maxiters += (strend - s) * spat->spat_regexp->nparens; while (s < strend && --limit && regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr, TRUE) ) { if (spat->spat_regexp->subbase @@ -389,7 +400,7 @@ int *arglast; iters = sp + 1; else iters = sp - arglast[0]; - if (iters > 9999) + if (iters > maxiters) fatal("Split loop"); if (s < strend || origlimit) { /* keep field after final delim? */ if (realarray) @@ -468,19 +479,20 @@ int *arglast; unsigned long aulong; char *aptr; - if (gimme != G_ARRAY) { - str_sset(str,&str_undef); - STABSET(str); - st[sp] = str; - return sp; + if (gimme != G_ARRAY) { /* arrange to do first one only */ + patend = pat+1; + if (*pat == 'a' || *pat == 'A') { + while (isdigit(*patend)) + patend++; + } } sp--; while (pat < patend) { datumtype = *pat++; if (isdigit(*pat)) { - len = atoi(pat); + len = *pat++ - '0'; while (isdigit(*pat)) - pat++; + len = (len * 10) + (*pat++ - '0'); } else len = 1; @@ -675,8 +687,8 @@ int *arglast; if (numarray) { while (sp < max) { if (st[++sp]) { - st[sp-1] = afetch(stab_array(stab),(int)str_gnum(st[sp]), - lval); + st[sp-1] = afetch(stab_array(stab), + ((int)str_gnum(st[sp])) - arybase, lval); } else st[sp-1] = &str_undef; @@ -700,7 +712,8 @@ int *arglast; else { if (numarray) { if (st[max]) - st[sp] = afetch(stab_array(stab),(int)str_gnum(st[max]), lval); + st[sp] = afetch(stab_array(stab), + ((int)str_gnum(st[max])) - arybase, lval); else st[sp] = &str_undef; } @@ -732,6 +745,7 @@ int *arglast; register int sp = arglast[2]; register int i = sp - arglast[1]; int oldsave = savestack->ary_fill; + SPAT *oldspat = curspat; savesptr(&stab_val(defstab)); if ((arg[1].arg_type & A_MASK) != A_EXPR) { @@ -747,10 +761,11 @@ int *arglast; if (str_true(st[sp+1])) st[dst++] = st[src]; src++; + curspat = oldspat; } restorelist(oldsave); if (gimme != G_ARRAY) { - str_sset(str,&str_undef); + str_numset(str,(double)(dst - arglast[1])); STABSET(str); st[arglast[0]+1] = str; return arglast[0]+1; diff --git a/eval.c b/eval.c index 95870b1..03518a8 100644 --- a/eval.c +++ b/eval.c @@ -1,4 +1,4 @@ -/* $Header: eval.c,v 3.0.1.3 89/12/21 20:03:05 lwall Locked $ +/* $Header: eval.c,v 3.0.1.4 90/02/28 17:36:59 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,18 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: eval.c,v $ + * Revision 3.0.1.4 90/02/28 17:36:59 lwall + * patch9: added pipe function + * patch9: a return in scalar context wouldn't return array + * patch9: !~ now always returns scalar even in array context + * patch9: some machines can't cast float to long with high bit set + * patch9: piped opens returned undef in child + * patch9: @array in scalar context now returns length of array + * patch9: chdir; coredumped + * patch9: wait no longer ignores signals + * patch9: mkdir now handles odd versions of /bin/mkdir + * patch9: -l FILEHANDLE now disallowed + * * Revision 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 @@ -48,6 +60,7 @@ static STAB *stab2; static STIO *stio; static struct lstring *lstr; static char old_record_separator; +extern int wantarray; double sin(), cos(), atan2(), pow(); @@ -141,10 +154,12 @@ register int sp; STR_SSET(str,st[1]); anum = (int)str_gnum(st[2]); if (anum >= 1) { - tmpstr = Str_new(50,0); + tmpstr = Str_new(50, 0); str_sset(tmpstr,str); - while (--anum > 0) - str_scat(str,tmpstr); + 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'; } else str_sset(str,&str_no); @@ -159,9 +174,7 @@ register int sp; break; case O_NMATCH: sp = do_match(str,arg, - gimme,arglast); - if (gimme == G_ARRAY) - goto array_return; + G_SCALAR,arglast); str_sset(str, str_true(str) ? &str_no : &str_yes); STABSET(str); break; @@ -270,14 +283,14 @@ register int sp; value = str_gnum(st[1]); anum = (int)str_gnum(st[2]); #ifndef lint - value = (double)(((long)value) << anum); + value = (double)(((unsigned long)value) << anum); #endif goto donumset; case O_RIGHT_SHIFT: value = str_gnum(st[1]); anum = (int)str_gnum(st[2]); #ifndef lint - value = (double)(((long)value) >> anum); + value = (double)(((unsigned long)value) >> anum); #endif goto donumset; case O_LT: @@ -313,7 +326,8 @@ register int sp; if (!sawvec || st[1]->str_nok || st[2]->str_nok) { value = str_gnum(st[1]); #ifndef lint - value = (double)(((long)value) & (long)str_gnum(st[2])); + value = (double)(((unsigned long)value) & + (unsigned long)str_gnum(st[2])); #endif goto donumset; } @@ -324,7 +338,8 @@ register int sp; if (!sawvec || st[1]->str_nok || st[2]->str_nok) { value = str_gnum(st[1]); #ifndef lint - value = (double)(((long)value) ^ (long)str_gnum(st[2])); + value = (double)(((unsigned long)value) ^ + (unsigned long)str_gnum(st[2])); #endif goto donumset; } @@ -335,7 +350,8 @@ register int sp; if (!sawvec || st[1]->str_nok || st[2]->str_nok) { value = str_gnum(st[1]); #ifndef lint - value = (double)(((long)value) | (long)str_gnum(st[2])); + value = (double)(((unsigned long)value) | + (unsigned long)str_gnum(st[2])); #endif goto donumset; } @@ -414,7 +430,7 @@ register int sp; goto donumset; case O_COMPLEMENT: #ifndef lint - value = (double) ~(long)str_gnum(st[1]); + value = (double) ~(unsigned long)str_gnum(st[1]); #endif goto donumset; case O_SELECT: @@ -502,11 +518,14 @@ register int sp; stab = arg[1].arg_ptr.arg_stab; else stab = stabent(str_get(st[1]),TRUE); - if (do_open(stab,str_get(st[2]))) { + 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; @@ -556,9 +575,10 @@ register int sp; sp += maxarg; goto array_return; } - else - str = afetch(ary,maxarg - 1,FALSE); - break; + 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); @@ -824,7 +844,7 @@ register int sp; goto donumset; case O_CHDIR: if (maxarg < 1) - tmps = str_get(stab_val(defstab)); + tmps = Nullch; else tmps = str_get(st[1]); if (!tmps || !*tmps) { @@ -993,9 +1013,9 @@ register int sp; STABSET(str); break; case O_RETURN: - tmps = "SUB"; /* just fake up a "last SUB" */ + tmps = "_SUB_"; /* just fake up a "last _SUB_" */ optype = O_LAST; - if (gimme == G_ARRAY) { + if (wantarray == G_ARRAY) { lastretstr = Nullstr; lastspbase = arglast[1]; lastsize = arglast[2] - arglast[1]; @@ -1304,17 +1324,17 @@ register int sp; goto donumset; case O_WAIT: #ifndef lint - ihand = signal(SIGINT, SIG_IGN); - qhand = signal(SIGQUIT, SIG_IGN); + /* ihand = signal(SIGINT, SIG_IGN); */ + /* qhand = signal(SIGQUIT, SIG_IGN); */ anum = wait(&argflags); if (anum > 0) pidgone(anum,argflags); value = (double)anum; #else - ihand = qhand = 0; + /* ihand = qhand = 0; */ #endif - (void)signal(SIGINT, ihand); - (void)signal(SIGQUIT, qhand); + /* (void)signal(SIGINT, ihand); */ + /* (void)signal(SIGQUIT, qhand); */ statusvalue = (unsigned short)argflags; goto donumset; case O_SYSTEM: @@ -1491,6 +1511,8 @@ register int sp; 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")) @@ -1600,7 +1622,7 @@ register int sp; stab = arg[1].arg_ptr.arg_stab; else stab = stabent(str_get(st[1]),TRUE); - argtype = (int)str_gnum(st[2]); + argtype = (unsigned int)str_gnum(st[2]); #ifdef TAINT taintproper("Insecure dependency in ioctl"); #endif @@ -1748,6 +1770,8 @@ register int sp; 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) goto say_undef; @@ -2070,6 +2094,18 @@ register int sp; case O_SYSCALL: value = (double)do_syscall(arglast); goto donumset; + case O_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); + break; } normal_return: @@ -2087,8 +2123,21 @@ array_return: #ifdef DEBUGGING if (debug) { dlevel--; - if (debug & 8) - deb("%s RETURNS ARRAY OF %d ARGS\n",opname[optype],sp - arglast[0]); + if (debug & 8) { + anum = sp - arglast[0]; + switch (anum) { + case 0: + deb("%s RETURNS ()\n",opname[optype]); + break; + case 1: + deb("%s RETURNS (\"%s\")\n",opname[optype],str_get(st[1])); + break; + default: + deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\"\n",opname[optype],anum, + str_get(st[1]),anum==2?"":"...,",str_get(st[anum])); + break; + } + } } #endif return sp; diff --git a/lib/complete.pl b/lib/complete.pl index 334d539..b59bee3 100644 --- a/lib/complete.pl +++ b/lib/complete.pl @@ -25,6 +25,7 @@ sub Complete { local ($prompt) = shift (@_); local ($c, $cmp, $l, $r, $ret, $return, $test); @_cmp_lst = sort @_; + local($[) = 0; system 'stty raw -echo'; loop: { print $prompt, $return; diff --git a/patchlevel.h b/patchlevel.h index 618bca4..4e0e918 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1 +1 @@ -#define PATCHLEVEL 9 +#define PATCHLEVEL 10 diff --git a/t/base.term b/t/base.term index 945dedd..6055fe2 100644 --- a/t/base.term +++ b/t/base.term @@ -1,6 +1,6 @@ #!./perl -# $Header: base.term,v 3.0 89/10/18 15:24:34 lwall Locked $ +# $Header: base.term,v 3.0.1.1 90/02/28 18:31:56 lwall Locked $ print "1..6\n"; @@ -30,7 +30,13 @@ if ($x == '1') {print "ok 4\n";} else {print "not ok 4\n";} # check <> pseudoliteral open(try, "/dev/null") || (die "Can't open /dev/null."); -if ( eq '') {print "ok 5\n";} else {print "not ok 5\n";} +if ( eq '') { + print "ok 5\n"; +} +else { + print "not ok 5\n"; + die "/dev/null IS NOT A CHARACTER SPECIAL FILE!!!!\n" unless -c '/dev/null'; +} open(try, "../Makefile") || (die "Can't open ../Makefile."); if ( ne '') {print "ok 6\n";} else {print "not ok 6\n";}