lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (03/02/90)
System: perl version 3.0 Patch #: 10 Priority: HIGH Subject: patch #9, continued Description: See patch #9. Fix: From rn, say "| patch -p -N -d DIR", where DIR is your perl source directory. Outside of rn, say "cd DIR; patch -p -N <thisarticle". If you don't have the patch program, apply the following by hand, or get patch (version 2.0, latest patchlevel). After patching: *** DO NOTHING--INSTALL ALL PATCHES UP THROUGH #12 FIRST *** If patch indicates that patchlevel is the wrong version, you may need to apply one or more previous patches, or the patch may already have been applied. See the patchlevel.h file to find out what has or has not been applied. In any event, don't continue with the patch. If you are missing previous patches they can be obtained from me: Larry Wall lwall@jpl-devvax.jpl.nasa.gov If you send a mail message of the following form it will greatly speed processing: Subject: Command @SH mailpatch PATH perl 3.0 LIST ^ note the c where PATH is a return path FROM ME TO YOU either in Internet notation, or in bang notation from some well-known host, and LIST is the number of one or more patches you need, separated by spaces, commas, and/or hyphens. Saying 35- says everything from 35 to the end. You can also get the patches via anonymous FTP from jpl-devvax.jpl.nasa.gov (128.149.1.143). Index: patchlevel.h Prereq: 9 1c1 < #define PATCHLEVEL 9 --- > #define PATCHLEVEL 10 Index: t/base.term Prereq: 3.0 *** t/base.term.old Thu Mar 1 10:54:44 1990 --- t/base.term Thu Mar 1 10:54:46 1990 *************** *** 1,6 **** #!./perl ! # $Header: base.term,v 3.0 89/10/18 15:24:34 lwall Locked $ print "1..6\n"; --- 1,6 ---- #!./perl ! # $Header: base.term,v 3.0.1.1 90/02/28 18:31:56 lwall Locked $ print "1..6\n"; *************** *** 30,36 **** # check <> pseudoliteral open(try, "/dev/null") || (die "Can't open /dev/null."); ! if (<try> eq '') {print "ok 5\n";} else {print "not ok 5\n";} open(try, "../Makefile") || (die "Can't open ../Makefile."); if (<try> ne '') {print "ok 6\n";} else {print "not ok 6\n";} --- 30,42 ---- # check <> pseudoliteral open(try, "/dev/null") || (die "Can't open /dev/null."); ! if (<try> 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 (<try> ne '') {print "ok 6\n";} else {print "not ok 6\n";} Index: cmd.c Prereq: 3.0.1.4 *** cmd.c.old Thu Mar 1 10:48:45 1990 --- cmd.c Thu Mar 1 10:48:48 1990 *************** *** 1,4 **** ! /* $Header: cmd.c,v 3.0.1.4 89/12/21 19:17:41 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: cmd.c,v 3.0.1.5 90/02/28 16:38:31 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,19 ---- * 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,60 **** int cmd_exec(cmdparm,gimme,sp) CMD *VOLATILE cmdparm; ! int gimme; ! int sp; { register CMD *cmd = cmdparm; SPAT *VOLATILE oldspat; VOLATILE int oldsave; VOLATILE int aryoptsave; #ifdef DEBUGGING --- 58,69 ---- int cmd_exec(cmdparm,gimme,sp) CMD *VOLATILE cmdparm; ! 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,189 **** cmdparm = cmd; #endif if (match = setjmp(loop_stack[loop_ptr].loop_env)) { - #ifdef JMPCLOBBER st = stack->ary_array; /* possibly reallocated */ cmd = cmdparm; cmdflags = cmd->c_flags|CF_ONCE; #endif switch (match) { case O_LAST: /* not done unless go_to found */ go_to = Nullch; if (lastretstr) { --- 187,202 ---- cmdparm = cmd; #endif if (match = setjmp(loop_stack[loop_ptr].loop_env)) { 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,205 **** 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; --- 211,216 ---- *************** *** 450,456 **** } } if (--cmd->c_short->str_u.str_useful < 0) { ! cmdflags &= ~CF_OPTIMIZE; cmdflags |= CFT_EVAL; /* never try this optimization again */ cmd->c_flags = cmdflags; } --- 461,467 ---- } } if (--cmd->c_short->str_u.str_useful < 0) { ! cmdflags &= ~(CF_OPTIMIZE|CF_ONCE); cmdflags |= CFT_EVAL; /* never try this optimization again */ cmd->c_flags = cmdflags; } *************** *** 563,570 **** savesptr(&stab_val(cmd->c_stab)); savelong(&cmd->c_short->str_u.str_useful); } ! else ar = stab_xarray(cmd->c_expr[1].arg_ptr.arg_stab); if (match >= ar->ary_fill) { /* we're in LAST, probably */ retstr = &str_undef; --- 574,584 ---- savesptr(&stab_val(cmd->c_stab)); savelong(&cmd->c_short->str_u.str_useful); } ! 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,765 **** cmdparm = cmd; #endif if (match = setjmp(loop_stack[loop_ptr].loop_env)) { - #ifdef JMPCLOBBER st = stack->ary_array; /* possibly reallocated */ cmd = cmdparm; cmdflags = cmd->c_flags|CF_ONCE; go_to = goto_targ; #endif switch (match) { case O_LAST: if (lastretstr) { retstr = lastretstr; --- 767,783 ---- cmdparm = cmd; #endif if (match = setjmp(loop_stack[loop_ptr].loop_env)) { 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,777 **** retstr = st[newsp]; } curspat = oldspat; - if (savestack->ary_fill > oldsave) - restorelist(oldsave); goto next_cmd; case O_NEXT: #ifdef JMPCLOBBER --- 788,793 ---- *************** *** 831,838 **** } finish_while: curspat = oldspat; ! if (savestack->ary_fill > oldsave) restorelist(oldsave); #ifdef DEBUGGING dlevel = olddlevel - 1; #endif --- 847,860 ---- } finish_while: curspat = oldspat; ! 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,861 **** } #endif loop_ptr--; ! if ((cmdflags & CF_OPTIMIZE) == CFT_ARRAY) restorelist(aryoptsave); } cmd = cmd->c_next; --- 877,884 ---- } #endif loop_ptr--; ! if ((cmdflags & CF_OPTIMIZE) == CFT_ARRAY && ! savestack->ary_fill > aryoptsave) restorelist(aryoptsave); } cmd = cmd->c_next; Index: cmd.h Prereq: 3.0.1.1 *** cmd.h.old Thu Mar 1 10:48:53 1990 --- cmd.h Thu Mar 1 10:48:55 1990 *************** *** 1,4 **** ! /* $Header: cmd.h,v 3.0.1.1 89/10/26 23:05:43 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: cmd.h,v 3.0.1.2 90/02/28 16:39:36 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * 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,133 **** struct scmd scmd; /* switch command */ } ucmd; short c_slen; /* len of c_short, if not null */ ! 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 */ --- 130,136 ---- struct scmd scmd; /* switch command */ } ucmd; short c_slen; /* len of c_short, if not null */ ! 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,142 **** #define Nullcmd Null(CMD*) ! EXT CMD *main_root INIT(Nullcmd); ! EXT CMD *eval_root INIT(Nullcmd); struct compcmd { CMD *comp_true; --- 138,145 ---- #define Nullcmd Null(CMD*) ! EXT CMD * VOLATILE main_root INIT(Nullcmd); ! EXT CMD * VOLATILE eval_root INIT(Nullcmd); struct compcmd { CMD *comp_true; Index: lib/complete.pl *** lib/complete.pl.old Thu Mar 1 10:51:47 1990 --- lib/complete.pl Thu Mar 1 10:51:49 1990 *************** *** 25,30 **** --- 25,31 ---- local ($prompt) = shift (@_); local ($c, $cmp, $l, $r, $ret, $return, $test); @_cmp_lst = sort @_; + local($[) = 0; system 'stty raw -echo'; loop: { print $prompt, $return; Index: config.h.SH *** config.h.SH.old Thu Mar 1 10:49:02 1990 --- config.h.SH Thu Mar 1 10:49:05 1990 *************** *** 422,427 **** --- 422,433 ---- */ #$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,548 **** /* I_UTIME: * This symbol, if defined, indicates to the C program that it should ! * include utime.h (a DG/UX thingie). */ #$i_utime I_UTIME /**/ --- 548,554 ---- /* I_UTIME: * This symbol, if defined, indicates to the C program that it should ! * include utime.h. */ #$i_utime I_UTIME /**/ Index: cons.c Prereq: 3.0.1.3 *** cons.c.old Thu Mar 1 10:49:15 1990 --- cons.c Thu Mar 1 10:49:17 1990 *************** *** 1,4 **** ! /* $Header: cons.c,v 3.0.1.3 89/12/21 19:20:25 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: cons.c,v 3.0.1.4 90/02/28 16:44:00 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,16 ---- * 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,74 **** mycompblock.comp_true = cmd; mycompblock.comp_alt = Nullcmd; ! cmd = add_label(savestr("SUB"),make_ccmd(C_BLOCK,Nullarg,mycompblock)); saw_return = FALSE; } sub->cmd = cmd; stab_sub(stab) = sub; --- 72,83 ---- mycompblock.comp_true = cmd; mycompblock.comp_alt = Nullcmd; ! 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,418 **** cmd->c_expr = cond; if (cond) cmd->c_flags |= CF_COND; ! if (cmdline != NOLINE) { cmd->c_line = cmdline; cmdline = NOLINE; } --- 421,429 ---- cmd->c_expr = cond; if (cond) cmd->c_flags |= CF_COND; ! if (cmdline == NOLINE) ! cmd->c_line = line; ! else { cmd->c_line = cmdline; cmdline = NOLINE; } *************** *** 437,443 **** cmd->ucmd.ccmd.cc_alt = cblock.comp_alt; if (arg) cmd->c_flags |= CF_COND; ! if (cmdline != NOLINE) { cmd->c_line = cmdline; cmdline = NOLINE; } --- 448,456 ---- cmd->ucmd.ccmd.cc_alt = cblock.comp_alt; if (arg) cmd->c_flags |= CF_COND; ! if (cmdline == NOLINE) ! cmd->c_line = line; ! else { cmd->c_line = cmdline; cmdline = NOLINE; } *************** *** 466,472 **** cmd->ucmd.ccmd.cc_alt = cblock.comp_alt; if (arg) cmd->c_flags |= CF_COND; ! if (cmdline != NOLINE) { cmd->c_line = cmdline; cmdline = NOLINE; } --- 479,487 ---- cmd->ucmd.ccmd.cc_alt = cblock.comp_alt; if (arg) cmd->c_flags |= CF_COND; ! if (cmdline == NOLINE) ! cmd->c_line = line; ! else { cmd->c_line = cmdline; cmdline = NOLINE; } Index: consarg.c Prereq: 3.0.1.2 *** consarg.c.old Thu Mar 1 10:49:25 1990 --- consarg.c Thu Mar 1 10:49:27 1990 *************** *** 1,4 **** ! /* $Header: consarg.c,v 3.0.1.2 89/11/17 15:11:34 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: consarg.c,v 3.0.1.3 90/02/28 16:47:54 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,15 ---- * 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,320 **** break; case O_REPEAT: i = (int)str_gnum(s2); str_nset(str,"",0); ! while (i-- > 0) ! str_scat(str,s1); break; case O_MULTIPLY: value = str_gnum(s1); --- 316,327 ---- break; case O_REPEAT: i = (int)str_gnum(s2); + tmps = str_get(s1); str_nset(str,"",0); ! 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,657 **** 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 && nothing_in_common(arg1,spat->spat_repl)) { spat->spat_repl[1].arg_ptr.arg_stab = arg1[1].arg_ptr.arg_stab; arg_free(arg1); /* recursive */ free_arg(arg); /* non-recursive */ return arg2; /* split has builtin assign */ --- 655,665 ---- 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_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 */ Index: doarg.c Prereq: 3.0.1.2 *** doarg.c.old Thu Mar 1 10:49:38 1990 --- doarg.c Thu Mar 1 10:49:42 1990 *************** *** 1,4 **** ! /* $Header: doarg.c,v 3.0.1.2 89/12/21 19:52:15 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: doarg.c,v 3.0.1.3 90/02/28 16:56:58 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,20 ---- * 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,49 **** --- 53,59 ---- register char *d; int clen; int iters = 0; + int maxiters = (strend - s) + 10; register int i; bool once; char *orig; *************** *** 192,198 **** /* NOTREACHED */ } do { ! if (iters++ > 10000) fatal("Substitution loop"); m = spat->spat_regexp->startp[0]; if (i = m - s) { --- 202,208 ---- /* NOTREACHED */ } do { ! if (iters++ > maxiters) fatal("Substitution loop"); m = spat->spat_regexp->startp[0]; if (i = m - s) { *************** *** 233,239 **** curspat = spat; lastspat = spat; do { ! if (iters++ > 10000) fatal("Substitution loop"); if (spat->spat_regexp->subbase && spat->spat_regexp->subbase != orig) { --- 243,249 ---- curspat = spat; lastspat = spat; do { ! if (iters++ > maxiters) fatal("Substitution loop"); if (spat->spat_regexp->subbase && spat->spat_regexp->subbase != orig) { *************** *** 351,357 **** --- 361,369 ---- char achar; short ashort; int aint; + unsigned int auint; long along; + unsigned long aulong; char *aptr; items = arglast[2] - sp; *************** *** 361,369 **** #define NEXTFROM (items-- > 0 ? *st++ : &str_no) datumtype = *pat++; if (isdigit(*pat)) { ! len = atoi(pat); while (isdigit(*pat)) ! pat++; } else len = 1; --- 373,381 ---- #define NEXTFROM (items-- > 0 ? *st++ : &str_no) datumtype = *pat++; if (isdigit(*pat)) { ! len = *pat++ - '0'; while (isdigit(*pat)) ! len = (len * 10) + (*pat++ - '0'); } else len = 1; *************** *** 429,434 **** --- 441,452 ---- } 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,452 **** --- 465,476 ---- } 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,486 **** --- 505,511 ---- register char *send; char *xs; int xlen; + double value; str_set(str,""); len--; /* don't count pattern string */ *************** *** 547,556 **** case 'x': case 'o': case 'u': ch = *(++t); *t = '\0'; if (dolong) ! (void)sprintf(buf,s,(unsigned long)str_gnum(*(sarg++))); else ! (void)sprintf(buf,s,(unsigned int)str_gnum(*(sarg++))); s = t; *(t--) = ch; break; --- 572,591 ---- 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)value); else ! (void)sprintf(buf,s,(unsigned int)value); s = t; *(t--) = ch; break; *************** *** 798,803 **** --- 833,839 ---- 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,836 **** while (relem <= lastrelem) { /* gobble up all the rest */ str = Str_new(28,0); if (*relem) ! str_sset(str,*(relem++)); ! else ! relem++; (void)astore(ary,i++,str); } } --- 864,871 ---- while (relem <= lastrelem) { /* gobble up all the rest */ str = Str_new(28,0); if (*relem) ! str_sset(str,*relem); ! *(relem++) = str; (void)astore(ary,i++,str); } } *************** *** 852,860 **** tmps = str_get(str); tmpstr = Str_new(29,0); if (*relem) ! str_sset(tmpstr,*(relem++)); /* value */ ! else ! relem++; (void)hstore(hash,tmps,str->str_cur,tmpstr,0); } } --- 887,894 ---- tmps = str_get(str); tmpstr = Str_new(29,0); if (*relem) ! str_sset(tmpstr,*relem); /* value */ ! *(relem++) = tmpstr; (void)hstore(hash,tmps,str->str_cur,tmpstr,0); } } *************** *** 864,873 **** else { if (makelocal) saveitem(str); ! if (relem <= lastrelem) ! str_sset(str, *(relem++)); ! else str_nset(str, "", 0); STABSET(str); } } --- 898,923 ---- else { if (makelocal) saveitem(str); ! 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,887 **** --- 932,938 ---- #endif } delaymagic = 0; + localizing = FALSE; if (gimme == G_ARRAY) { i = lastrelem - firstrelem + 1; if (ary || hash) *************** *** 1283,1291 **** arg[7]); break; } ! st[sp] = str_static(&str_undef); ! str_numset(st[sp], (double)retval); ! return sp; #else fatal("syscall() unimplemented"); #endif --- 1334,1340 ---- arg[7]); break; } ! return retval; #else fatal("syscall() unimplemented"); #endif Index: doio.c Prereq: 3.0.1.4 *** doio.c.old Thu Mar 1 10:49:56 1990 --- doio.c Thu Mar 1 10:50:03 1990 *************** *** 1,4 **** ! /* $Header: doio.c,v 3.0.1.4 89/12/21 19:55:10 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: doio.c,v 3.0.1.5 90/02/28 17:01:36 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,17 ---- * 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,64 **** #endif bool ! do_open(stab,name) STAB *stab; register char *name; { FILE *fp; - int len = strlen(name); register STIO *stio = stab_io(stab); char *myname = savestr(name); int result; --- 59,70 ---- #endif bool ! do_open(stab,name,len) STAB *stab; register char *name; + int len; { FILE *fp; register STIO *stio = stab_io(stab); char *myname = savestr(name); int result; *************** *** 202,223 **** 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 */ #endif --- 208,214 ---- *************** *** 250,256 **** str_sset(stab_val(stab),str); STABSET(stab_val(stab)); oldname = str_get(stab_val(stab)); ! if (do_open(stab,oldname)) { if (inplace) { #ifdef TAINT taintproper("Insecure dependency in inplace open"); --- 241,247 ---- str_sset(stab_val(stab),str); STABSET(stab_val(stab)); oldname = str_get(stab_val(stab)); ! if (do_open(stab,oldname,stab_val(stab)->str_cur)) { if (inplace) { #ifdef TAINT taintproper("Insecure dependency in inplace open"); *************** *** 275,281 **** str_nset(str,">",1); str_cat(str,oldname); errno = 0; /* in case sprintf set errno */ ! if (!do_open(argvoutstab,str->str_ptr)) fatal("Can't do inplace edit"); defoutstab = argvoutstab; #ifdef FCHMOD --- 266,272 ---- str_nset(str,">",1); str_cat(str,oldname); errno = 0; /* in case sprintf set errno */ ! if (!do_open(argvoutstab,str->str_ptr,str->str_cur)) fatal("Can't do inplace edit"); defoutstab = argvoutstab; #ifdef FCHMOD *************** *** 303,308 **** --- 294,342 ---- 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,2002 **** } utbuf; #endif 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; --- 2025,2033 ---- } 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 */ items -= 2; #ifndef lint tot = items; Index: dolist.c Prereq: 3.0.1.4 *** dolist.c.old Thu Mar 1 10:50:18 1990 --- dolist.c Thu Mar 1 10:50:21 1990 *************** *** 1,4 **** ! /* $Header: dolist.c,v 3.0.1.4 89/12/21 19:58:46 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: dolist.c,v 3.0.1.5 90/02/28 17:09:44 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,20 ---- * 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,269 **** --- 273,279 ---- register STR *dstr; register char *m; int iters = 0; + int maxiters = (strend - s) + 10; int i; char *orig; int origlimit = limit; *************** *** 299,305 **** } #endif ary = stab_xarray(spat->spat_repl[1].arg_ptr.arg_stab); ! if (ary && ((ary->ary_flags & ARF_REAL) || gimme != G_ARRAY)) { realarray = 1; if (!(ary->ary_flags & ARF_REAL)) { ary->ary_flags |= ARF_REAL; --- 309,315 ---- } #endif ary = stab_xarray(spat->spat_repl[1].arg_ptr.arg_stab); ! if (ary && (gimme != G_ARRAY || (spat->spat_flags & SPAT_ONCE))) { realarray = 1; if (!(ary->ary_flags & ARF_REAL)) { ary->ary_flags |= ARF_REAL; *************** *** 317,323 **** s++; } if (!limit) ! limit = 10001; if (spat->spat_short) { i = spat->spat_short->str_cur; if (i == 1) { --- 327,333 ---- s++; } if (!limit) ! limit = maxiters + 2; if (spat->spat_short) { i = spat->spat_short->str_cur; if (i == 1) { *************** *** 353,358 **** --- 363,369 ---- } } 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,395 **** iters = sp + 1; else iters = sp - arglast[0]; ! if (iters > 9999) fatal("Split loop"); if (s < strend || origlimit) { /* keep field after final delim? */ if (realarray) --- 400,406 ---- iters = sp + 1; else iters = sp - arglast[0]; ! if (iters > maxiters) fatal("Split loop"); if (s < strend || origlimit) { /* keep field after final delim? */ if (realarray) *************** *** 468,486 **** unsigned long aulong; char *aptr; ! if (gimme != G_ARRAY) { ! str_sset(str,&str_undef); ! STABSET(str); ! st[sp] = str; ! return sp; } sp--; while (pat < patend) { datumtype = *pat++; if (isdigit(*pat)) { ! len = atoi(pat); while (isdigit(*pat)) ! pat++; } else len = 1; --- 479,498 ---- unsigned long aulong; char *aptr; ! 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 = *pat++ - '0'; while (isdigit(*pat)) ! len = (len * 10) + (*pat++ - '0'); } else len = 1; *************** *** 675,682 **** if (numarray) { while (sp < max) { if (st[++sp]) { ! st[sp-1] = afetch(stab_array(stab),(int)str_gnum(st[sp]), ! lval); } else st[sp-1] = &str_undef; --- 687,694 ---- if (numarray) { while (sp < max) { if (st[++sp]) { ! st[sp-1] = afetch(stab_array(stab), ! ((int)str_gnum(st[sp])) - arybase, lval); } else st[sp-1] = &str_undef; *************** *** 700,706 **** else { if (numarray) { if (st[max]) ! st[sp] = afetch(stab_array(stab),(int)str_gnum(st[max]), lval); else st[sp] = &str_undef; } --- 712,719 ---- else { if (numarray) { if (st[max]) ! st[sp] = afetch(stab_array(stab), ! ((int)str_gnum(st[max])) - arybase, lval); else st[sp] = &str_undef; } *************** *** 732,737 **** --- 745,751 ---- 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,756 **** if (str_true(st[sp+1])) st[dst++] = st[src]; src++; } restorelist(oldsave); if (gimme != G_ARRAY) { ! str_sset(str,&str_undef); STABSET(str); st[arglast[0]+1] = str; return arglast[0]+1; --- 761,771 ---- if (str_true(st[sp+1])) st[dst++] = st[src]; src++; + curspat = oldspat; } restorelist(oldsave); if (gimme != G_ARRAY) { ! str_numset(str,(double)(dst - arglast[1])); STABSET(str); st[arglast[0]+1] = str; return arglast[0]+1; Index: eval.c Prereq: 3.0.1.3 *** eval.c.old Thu Mar 1 10:51:08 1990 --- eval.c Thu Mar 1 10:51:15 1990 *************** *** 1,4 **** ! /* $Header: eval.c,v 3.0.1.3 89/12/21 20:03:05 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: eval.c,v 3.0.1.4 90/02/28 17:36:59 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,23 ---- * 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,53 **** --- 60,66 ---- static STIO *stio; static struct lstring *lstr; static char old_record_separator; + extern int wantarray; double sin(), cos(), atan2(), pow(); *************** *** 141,150 **** STR_SSET(str,st[1]); anum = (int)str_gnum(st[2]); if (anum >= 1) { ! tmpstr = Str_new(50,0); str_sset(tmpstr,str); ! while (--anum > 0) ! str_scat(str,tmpstr); } else str_sset(str,&str_no); --- 154,165 ---- 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(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,167 **** break; case O_NMATCH: sp = do_match(str,arg, ! gimme,arglast); ! if (gimme == G_ARRAY) ! goto array_return; str_sset(str, str_true(str) ? &str_no : &str_yes); STABSET(str); break; --- 174,180 ---- 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; *************** *** 270,276 **** value = str_gnum(st[1]); anum = (int)str_gnum(st[2]); #ifndef lint ! value = (double)(((long)value) << anum); #endif goto donumset; case O_RIGHT_SHIFT: --- 283,289 ---- value = str_gnum(st[1]); anum = (int)str_gnum(st[2]); #ifndef lint ! value = (double)(((unsigned long)value) << anum); #endif goto donumset; case O_RIGHT_SHIFT: *************** *** 277,283 **** value = str_gnum(st[1]); anum = (int)str_gnum(st[2]); #ifndef lint ! value = (double)(((long)value) >> anum); #endif goto donumset; case O_LT: --- 290,296 ---- value = str_gnum(st[1]); anum = (int)str_gnum(st[2]); #ifndef lint ! value = (double)(((unsigned long)value) >> anum); #endif goto donumset; case O_LT: *************** *** 313,319 **** if (!sawvec || st[1]->str_nok || st[2]->str_nok) { value = str_gnum(st[1]); #ifndef lint ! value = (double)(((long)value) & (long)str_gnum(st[2])); #endif goto donumset; } --- 326,333 ---- if (!sawvec || st[1]->str_nok || st[2]->str_nok) { value = str_gnum(st[1]); #ifndef lint ! value = (double)(((unsigned long)value) & ! (unsigned long)str_gnum(st[2])); #endif goto donumset; } *************** *** 324,330 **** if (!sawvec || st[1]->str_nok || st[2]->str_nok) { value = str_gnum(st[1]); #ifndef lint ! value = (double)(((long)value) ^ (long)str_gnum(st[2])); #endif goto donumset; } --- 338,345 ---- if (!sawvec || st[1]->str_nok || st[2]->str_nok) { value = str_gnum(st[1]); #ifndef lint ! value = (double)(((unsigned long)value) ^ ! (unsigned long)str_gnum(st[2])); #endif goto donumset; } *************** *** 335,341 **** if (!sawvec || st[1]->str_nok || st[2]->str_nok) { value = str_gnum(st[1]); #ifndef lint ! value = (double)(((long)value) | (long)str_gnum(st[2])); #endif goto donumset; } --- 350,357 ---- if (!sawvec || st[1]->str_nok || st[2]->str_nok) { value = str_gnum(st[1]); #ifndef lint ! value = (double)(((unsigned long)value) | ! (unsigned long)str_gnum(st[2])); #endif goto donumset; } *************** *** 414,420 **** goto donumset; case O_COMPLEMENT: #ifndef lint ! value = (double) ~(long)str_gnum(st[1]); #endif goto donumset; case O_SELECT: --- 430,436 ---- goto donumset; case O_COMPLEMENT: #ifndef lint ! value = (double) ~(unsigned long)str_gnum(st[1]); #endif goto donumset; case O_SELECT: *************** *** 502,512 **** stab = arg[1].arg_ptr.arg_stab; else stab = stabent(str_get(st[1]),TRUE); ! if (do_open(stab,str_get(st[2]))) { value = (double)forkprocess; stab_io(stab)->lines = 0; goto donumset; } else goto say_undef; break; --- 518,531 ---- 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; *************** *** 556,564 **** sp += maxarg; goto array_return; } ! else ! str = afetch(ary,maxarg - 1,FALSE); ! break; case O_AELEM: anum = ((int)str_gnum(st[2])) - arybase; str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE); --- 575,584 ---- 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); *************** *** 824,830 **** goto donumset; case O_CHDIR: if (maxarg < 1) ! tmps = str_get(stab_val(defstab)); else tmps = str_get(st[1]); if (!tmps || !*tmps) { --- 844,850 ---- goto donumset; case O_CHDIR: if (maxarg < 1) ! tmps = Nullch; else tmps = str_get(st[1]); if (!tmps || !*tmps) { *************** *** 993,1001 **** STABSET(str); break; case O_RETURN: ! tmps = "SUB"; /* just fake up a "last SUB" */ optype = O_LAST; ! if (gimme == G_ARRAY) { lastretstr = Nullstr; lastspbase = arglast[1]; lastsize = arglast[2] - arglast[1]; --- 1013,1021 ---- STABSET(str); break; case O_RETURN: ! tmps = "_SUB_"; /* just fake up a "last _SUB_" */ optype = O_LAST; ! if (wantarray == G_ARRAY) { lastretstr = Nullstr; lastspbase = arglast[1]; lastsize = arglast[2] - arglast[1]; *************** *** 1304,1320 **** goto donumset; case O_WAIT: #ifndef lint ! 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; #endif ! (void)signal(SIGINT, ihand); ! (void)signal(SIGQUIT, qhand); statusvalue = (unsigned short)argflags; goto donumset; case O_SYSTEM: --- 1324,1340 ---- goto donumset; case O_WAIT: #ifndef lint ! /* 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; */ #endif ! /* (void)signal(SIGINT, ihand); */ ! /* (void)signal(SIGQUIT, qhand); */ statusvalue = (unsigned short)argflags; goto donumset; case O_SYSTEM: *************** *** 1491,1496 **** --- 1511,1518 ---- 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,1606 **** stab = arg[1].arg_ptr.arg_stab; else stab = stabent(str_get(st[1]),TRUE); ! argtype = (int)str_gnum(st[2]); #ifdef TAINT taintproper("Insecure dependency in ioctl"); #endif --- 1622,1628 ---- stab = arg[1].arg_ptr.arg_stab; else stab = stabent(str_get(st[1]),TRUE); ! argtype = (unsigned int)str_gnum(st[2]); #ifdef TAINT taintproper("Insecure dependency in ioctl"); #endif *************** *** 1748,1753 **** --- 1770,1777 ---- 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,2075 **** --- 2094,2111 ---- 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,2094 **** #ifdef DEBUGGING if (debug) { dlevel--; ! if (debug & 8) ! deb("%s RETURNS ARRAY OF %d ARGS\n",opname[optype],sp - arglast[0]); } #endif return sp; --- 2123,2143 ---- #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: ! 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; *** End of Patch 10 ***