lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (03/13/90)
System: perl version 3.0 Patch #: 13 Priority: HIGH Subject: added list slice operator (LIST)[LIST] Subject: added splice operator: @oldelems = splice(@array,$offset,$len,LIST) Subject: removed -lPW from default list Subject: added (~name ok) support to some Configure options Subject: putting man pages into manp left .n extension Subject: optional libraries now believes config.sh preferentially Subject: some compilers can't grok 0x0807060504030201 Subject: some compilers need ccflags before .c file Subject: vprintf test needs stdio.h Subject: added test for char *volatile Subject: some dependencies missing on perly.h Subject: some relief for buggy parallel makes Subject: bison doesn't declare extern YYSTYPE yylval; Subject: some Xenix 386 lowdown Subject: fixed some backwards VOLATILE declarations Subject: while (s/x//) {} still caused some anomolies Subject: greater-than test of numeric switch structures did less-than action Subject: perl -d coredumped on scripts with subs that did explicit return Subject: return (@array) did counter-intuitive things Subject: pack of ascii strings could call str_ncat() with negative length Subject: printf("%s", *foo) was busted Subject: system 'FOO=bar command' didn't invoke sh as it should Subject: made split('') act like split(//) rather than split(' ') Subject: eg/g/gsh used pipe as filehandle Subject: /eg/scan/scanner used pipe as filehandle Subject: undef $/ didn't work as advertised Subject: perl -d didn't format stack traces of *foo right Subject: perl -d wiped out scalar return values of subroutines Subject: did some ndir straightening up for Xenix Subject: (LIST,) now legal Subject: improved LIST documentation Subject: example of if-elsif switch was wrong Subject: documented behavior of @array = /noparens/ Subject: documented that print $filehandle &foo is ambiguous Subject: improved documentation of *name Subject: pattern matches can now use \0 to mean \000 Subject: substr as lvalue didn't invalidate old numeric value Subject: t/op.mkdir should create directories 0777 rather than 0666 Subject: last semicolon of program is now optional, just for Randal Description: I added the list slice operator: (LIST)[LIST] $hexdigit = (0..9,'a','b','c','d','e','f')[$fourbits] There was no way to cut stuff out of the middle of an array or to insert stuff without copying the head and tail of the array, which is gross. I added the splice operator to do this: @oldelems = splice(@array,$offset,$len,LIST) Equivalencies: shift @array splice(@array,0,1) unshift(@array,$x,$y) splice(@array,0,0,$x,$y) pop @array splice(@array,-1,1) push(@array,$x,$y) splice(@array,$#array+1,0,$x,$y) $array[$x] = $y splice(@array,$x,1,$y) Having -lPW as one of the libraries that Configure looks for was causing lots of people grief. It was only there for people using bison who otherwise don't have alloca(), so I zapped it. Some of the questions that supported the ~name syntax didn't say so, and some that should have supported it didn't. Now they do. If you selected the manp directory for your man pages, the manext variable was left set to 'n'. When Configure sees that the optional libraries have previously been determined in config.sh, it now believes it rather than using the list it generates. In the test for byteorder, some compilers get indigestion on the constant 0x0807060504030201. It's now split into two parts. Some compilers don't like it if you put CCFLAGS after the .c file on the command line. Some of the Configure tests did this. On some systems, the test for vprintf() needs to have stdio.h included in order to give valid results. Some machines don't support the volatile declaration as applied to a pointer. The Configure test now checks for this. Also, cmd.c had some VOLATILE declarations on pointed-to items rather than the pointers themselves, causing MIPS heartburn. In Makefile.SH, some of the t*.c files needed to have dependencies on perly.h. Additionally, some parallel makes can't handle a dependency line with two targets, so the perly.h and perl.c lines have been separated. Also, when perly.h is generated, it will now have a declaration added to it for yylval--bison wasn't supplying this. The construct "while (s/x//) {}" was partially fixed in patch 9, but there were still some weirdnesses about it. Hopefully these are ironed out now. If you did a switch structure based on numeric value, and there was some action attached to when the variable is greater than the maximum specified value, that action would not happen. Instead, any action for values under the minimum value happened. The debugger had some difficulties after patch 9, due to changes in the meaning of @array in a scalar context, and because of an pointer error in patch 9. Because of the fix in patch 9 to let return () work right, the construct "return (@array)" did counter-intuitive things. It now returns an array value. "return @array" and "return (@array)" now mean the same thing. A pack of ascii strings could call str_ncat() with negative length when the length of the string was greater than the length specified for the field. Patch 9 fixed *name values so that the wouldn't collide with ordinary string values, but there were two places I missed, one in perldb, and one in the sprintf code. Perl looks at commands it is going to execute to see if it can bypass /bin/sh and execute them directly. Ordinarily = is not a shell metacharacter, but in a command like "system 'FOO=bar command'"i it indicates that /bin/sh should be used, since it's setting an environment variable. It now does that (other than that construct, the = character is still not a shell metacharacter). If a runtime pattern to split happens to be null, it was being interpreted as if it were a space, that is, as the awk-emulating split. It now splits all characters apart, since that's more in line with what people expect, and the other behavior wasn't documented. Patch 9 added the reserved word "pipe". The scripts eg/g/gsh and /eg/scan/scanner used pipe as filehandle since they were written before the recommendation of upper-case filehandles was devised. They now use PIPE. The undef $/ command was supposed to let you slurp in an entire binary file with one <>, but it didn't work as advertised. Xenix systems have been having problems with Configure setting up ndir right. Hopefully this will work better now, but it's possible the changes will blow someone else up. Such is life... The construct (LIST,) is now legal, so that you can say @foo = ( 1, 2, 3, ); Various changes were made to the documentation. In double quoted strings, you could say \0 to mean the null character. In pattern matches, only \000 was allowed since \0 was taken to be a \<digit> backreference. Since it doesn't make sense to refer to the whole matched string before it's done, there's no reason \0 can't mean null in a pattern too. So now it does. You could modify a numeric variable by using substr as an lvalue, and if you then reference the variable numerically, you'd get the old number out rather than one derived from the new string. Now the old number is invalidated on lvalued substr. The test t/op.mkdir should create directories 0777 rather than 0666. As Randal requested, the last semicolon of a program is now optional. Actually, he just asked for -e 'prog' to have that behaviour, but it seemed reasonable to generalize it slightly. It's been that way with eval for some time. 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 #14 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: 12 1c1 < #define PATCHLEVEL 12 --- > #define PATCHLEVEL 13 Index: Configure Prereq: 3.0.1.5 *** Configure.old Mon Mar 12 17:07:04 1990 --- Configure Mon Mar 12 17:07:09 1990 *************** *** 8,14 **** # and edit it to reflect your system. Some packages may include samples # of config.h for certain machines, so you might look for one of those.) # ! # $Header: Configure,v 3.0.1.5 90/02/28 16:17:50 lwall Locked $ # # Yes, you may rip this off to use in other distribution packages. # (Note: this Configure script was generated automatically. Rather than --- 8,14 ---- # and edit it to reflect your system. Some packages may include samples # of config.h for certain machines, so you might look for one of those.) # ! # $Header: Configure,v 3.0.1.6 90/03/12 16:10:23 lwall Locked $ # # Yes, you may rip this off to use in other distribution packages. # (Note: this Configure script was generated automatically. Rather than *************** *** 257,263 **** pth="/usr/ucb /bin /usr/bin /usr/local /usr/local/bin /usr/lbin /usr/plx /usr/5bin /vol/local/bin /etc /usr/lib /lib /usr/local/lib /sys5.3/bin /sys5.3/usr/bin /bsd4.3/bin /bsd4.3/usr/bin /bsd4.3/usr/ucb" d_newshome="/usr/NeWS" defvoidused=7 ! libswanted="net_s net nsl_s nsl socket nm ndir ndbm dbm sun bsd BSD x c_s PW" inclwanted='/usr/netinclude /usr/include/sun /usr/include/bsd /usr/include/lan' : some greps do not return status, grrr. echo "grimblepritz" >grimble --- 257,263 ---- pth="/usr/ucb /bin /usr/bin /usr/local /usr/local/bin /usr/lbin /usr/plx /usr/5bin /vol/local/bin /etc /usr/lib /lib /usr/local/lib /sys5.3/bin /sys5.3/usr/bin /bsd4.3/bin /bsd4.3/usr/bin /bsd4.3/usr/ucb" d_newshome="/usr/NeWS" defvoidused=7 ! libswanted="net_s net nsl_s nsl socket nm ndir ndbm dbm sun bsd BSD x c_s" inclwanted='/usr/netinclude /usr/include/sun /usr/include/bsd /usr/include/lan' : some greps do not return status, grrr. echo "grimblepritz" >grimble *************** *** 638,648 **** cont=true while $test "$cont" ; do echo " " ! rp="Where do you want to put the public executables? [$dflt]" $echo $n "$rp $c" . myread bin="$ans" ! bin=`filexp $bin` if test -d $bin; then cont='' else --- 638,648 ---- cont=true while $test "$cont" ; do echo " " ! rp="Where do you want to put the public executables? (~name ok) [$dflt]" $echo $n "$rp $c" . myread bin="$ans" ! bin=`./filexp "$bin"` if test -d $bin; then cont='' else *************** *** 675,684 **** cont=true while $test "$cont" ; do echo " " ! rp="Where do the manual pages (source) go? [$dflt]" $echo $n "$rp $c" . myread ! mansrc=`filexp "$ans"` if $test -d "$mansrc"; then cont='' else --- 675,684 ---- cont=true while $test "$cont" ; do echo " " ! rp="Where do the manual pages (source) go? (~name ok) [$dflt]" $echo $n "$rp $c" . myread ! mansrc=`./filexp "$ans"` if $test -d "$mansrc"; then cont='' else *************** *** 707,713 **** manext=l ;; *p) ! manext=n ;; *C) manext=C --- 707,713 ---- manext=l ;; *p) ! manext=p ;; *C) manext=C *************** *** 1110,1119 **** echo " " echo "Checking for optional libraries..." - case "$libs" in - '') dflt='';; - *) dflt="$libs";; - esac case "$libswanted" in '') libswanted='c_s';; esac --- 1110,1115 ---- *************** *** 1156,1161 **** --- 1152,1160 ---- set X $dflt shift dflt="$*" + case "$libs" in + *) dflt="$libs";; + esac case "$dflt" in '') dflt='none';; esac *************** *** 1206,1212 **** } u; if (sizeof(long) > 4) ! u.l = 0x0807060504030201; else u.l = 0x04030201; for (i=0; i < sizeof(long); i++) --- 1205,1211 ---- } u; if (sizeof(long) > 4) ! u.l = (0x08070605<<32) | 0x04030201; else u.l = 0x04030201; for (i=0; i < sizeof(long); i++) *************** *** 1214,1220 **** printf("\n"); } EOCP ! if $cc try.c -o try >/dev/null 2>&1 ; then dflt=`./try` case "$dflt" in ????|????????) echo "(The test program ran ok.)";; --- 1213,1219 ---- printf("\n"); } EOCP ! if $cc $ccflags try.c -o try >/dev/null 2>&1 ; then dflt=`./try` case "$dflt" in ????|????????) echo "(The test program ran ok.)";; *************** *** 1513,1518 **** --- 1512,1518 ---- echo 'vprintf() found.' d_vprintf="$define" cat >.ucbsprf.c <<'EOF' + #include <stdio.h> #include <varargs.h> main() { xxx("foo"); } *************** *** 1948,1954 **** foo = bar; } EOCP ! if $cc -c try.c >/dev/null 2>&1 ; then d_strctcpy="$define" echo "Yup, it can." else --- 1948,1954 ---- foo = bar; } EOCP ! if $cc -c $ccflags try.c >/dev/null 2>&1 ; then d_strctcpy="$define" echo "Yup, it can." else *************** *** 2007,2015 **** for i_systime in '-DI_SYSTIME' ''; do case "$flags" in '') echo Trying $i_time $i_systime $d_systimekernel $s_timeval ! if $cc try.c $ccflags \ $i_time $i_systime $d_systimekernel $s_timeval \ ! -o try >/dev/null 2>&1 ; then set X $i_time $i_systime $d_systimekernel $s_timeval shift flags="$*" --- 2007,2015 ---- for i_systime in '-DI_SYSTIME' ''; do case "$flags" in '') echo Trying $i_time $i_systime $d_systimekernel $s_timeval ! if $cc $ccflags \ $i_time $i_systime $d_systimekernel $s_timeval \ ! try.c -o try >/dev/null 2>&1 ; then set X $i_time $i_systime $d_systimekernel $s_timeval shift flags="$*" *************** *** 2067,2077 **** $cat >try.c <<'EOCP' main() { ! volatile int foo; foo = foo; } EOCP ! if $cc -c try.c >/dev/null 2>&1 ; then d_volatile="$define" echo "Yup, it does." else --- 2067,2078 ---- $cat >try.c <<'EOCP' main() { ! char *volatile foo; ! volatile int bar; foo = foo; } EOCP ! if $cc -c $ccflags try.c >/dev/null 2>&1 ; then d_volatile="$define" echo "Yup, it does." else *************** *** 2117,2123 **** exit(0); } EOCP ! if $cc -S -DTRY=$defvoidused try.c >.out 2>&1 ; then voidflags=$defvoidused echo "It appears to support void." if $contains warning .out >/dev/null 2>&1; then --- 2118,2124 ---- exit(0); } EOCP ! if $cc $ccflags -c -DTRY=$defvoidused try.c >.out 2>&1 ; then voidflags=$defvoidused echo "It appears to support void." if $contains warning .out >/dev/null 2>&1; then *************** *** 2126,2139 **** fi else echo "Hmm, your compiler has some difficulty with void. Checking further..." ! if $cc -S -DTRY=1 try.c >/dev/null 2>&1 ; then echo "It supports 1..." ! if $cc -S -DTRY=3 try.c >/dev/null 2>&1 ; then voidflags=3 echo "And it supports 2 but not 4." else echo "It doesn't support 2..." ! if $cc -S -DTRY=5 try.c >/dev/null 2>&1 ; then voidflags=5 echo "But it supports 4." else --- 2127,2140 ---- fi else echo "Hmm, your compiler has some difficulty with void. Checking further..." ! if $cc $ccflags -c -DTRY=1 try.c >/dev/null 2>&1 ; then echo "It supports 1..." ! if $cc $ccflags -c -DTRY=3 try.c >/dev/null 2>&1 ; then voidflags=3 echo "And it supports 2 but not 4." else echo "It doesn't support 2..." ! if $cc $ccflags -c -DTRY=5 try.c >/dev/null 2>&1 ; then voidflags=5 echo "But it supports 4." else *************** *** 2286,2292 **** printf("%d\n", sizeof(int)); } EOCP ! if $cc try.c -o try >/dev/null 2>&1 ; then dflt=`./try` else dflt='4' --- 2287,2293 ---- printf("%d\n", sizeof(int)); } EOCP ! if $cc $ccflags try.c -o try >/dev/null 2>&1 ; then dflt=`./try` else dflt='4' *************** *** 2317,2326 **** The $package package has some auxiliary files that should be put in a library that is accessible by everyone. Where do you want to put these "private" EOM ! $echo $n "but accessible files? [$dflt] $c" rp="Put private files where? [$dflt]" . myread ! privlib="$ans" : check for size of random number generator echo " " --- 2318,2327 ---- The $package package has some auxiliary files that should be put in a library that is accessible by everyone. Where do you want to put these "private" EOM ! $echo $n "but accessible files? (~name ok) [$dflt] $c" rp="Put private files where? [$dflt]" . myread ! privlib=`./filexp "$ans"` : check for size of random number generator echo " " *************** *** 2344,2350 **** printf("%d\n",i); } EOCP ! if $cc try.c -o try >/dev/null 2>&1 ; then dflt=`./try` else dflt='?' --- 2345,2351 ---- printf("%d\n",i); } EOCP ! if $cc $ccflags try.c -o try >/dev/null 2>&1 ; then dflt=`./try` else dflt='?' Index: Makefile.SH Prereq: 3.0.1.4 *** Makefile.SH.old Mon Mar 12 17:07:19 1990 --- Makefile.SH Mon Mar 12 17:07:21 1990 *************** *** 25,33 **** echo "Extracting Makefile (with variable substitutions)" cat >Makefile <<!GROK!THIS! ! # $Header: Makefile.SH,v 3.0.1.4 90/02/28 16:19:43 lwall Locked $ # # $Log: Makefile.SH,v $ # Revision 3.0.1.4 90/02/28 16:19:43 lwall # patch9: extraneous $ on suidperl in Makefile # --- 25,38 ---- echo "Extracting Makefile (with variable substitutions)" cat >Makefile <<!GROK!THIS! ! # $Header: Makefile.SH,v 3.0.1.5 90/03/12 16:15:17 lwall Locked $ # # $Log: Makefile.SH,v $ + # Revision 3.0.1.5 90/03/12 16:15:17 lwall + # patch13: some dependencies missing on perly.h + # patch13: some relief for buggy parallel makes + # patch13: bison doesn't declare extern YYSTYPE yylval; + # # Revision 3.0.1.4 90/02/28 16:19:43 lwall # patch9: extraneous $ on suidperl in Makefile # *************** *** 167,173 **** $(CC) -c -DTAINT $(CFLAGS) $(LARGE) tcmd.c /bin/rm -f tcmd.c ! tcons.o: cons.c $(h) /bin/rm -f tcons.c $(SLN) cons.c tcons.c $(CC) -c -DTAINT $(CFLAGS) $(LARGE) tcons.c --- 172,178 ---- $(CC) -c -DTAINT $(CFLAGS) $(LARGE) tcmd.c /bin/rm -f tcmd.c ! tcons.o: cons.c $(h) perly.h /bin/rm -f tcons.c $(SLN) cons.c tcons.c $(CC) -c -DTAINT $(CFLAGS) $(LARGE) tcons.c *************** *** 239,251 **** $(CC) -c -DTAINT $(CFLAGS) $(LARGE) tstab.c /bin/rm -f tstab.c ! tstr.o: str.c $(h) /bin/rm -f tstr.c $(SLN) str.c tstr.c $(CC) -c -DTAINT $(CFLAGS) $(LARGE) tstr.c /bin/rm -f tstr.c ! ttoke.o: toke.c $(h) /bin/rm -f ttoke.c $(SLN) toke.c ttoke.c $(CC) -c -DTAINT $(CFLAGS) $(LARGE) ttoke.c --- 244,256 ---- $(CC) -c -DTAINT $(CFLAGS) $(LARGE) tstab.c /bin/rm -f tstab.c ! tstr.o: str.c $(h) perly.h /bin/rm -f tstr.c $(SLN) str.c tstr.c $(CC) -c -DTAINT $(CFLAGS) $(LARGE) tstr.c /bin/rm -f tstr.c ! ttoke.o: toke.c $(h) perly.h /bin/rm -f ttoke.c $(SLN) toke.c ttoke.c $(CC) -c -DTAINT $(CFLAGS) $(LARGE) ttoke.c *************** *** 257,267 **** $(CC) -c -DTAINT $(CFLAGS) $(LARGE) tutil.c /bin/rm -f tutil.c ! perl.c perly.h: perl.y @ echo Expect 25 shift/reduce errors... $(YACC) -d perl.y mv y.tab.c perl.c mv y.tab.h perly.h perl.o: perl.c perly.h $(h) $(CC) -c $(CFLAGS) $(LARGE) perl.c --- 262,277 ---- $(CC) -c -DTAINT $(CFLAGS) $(LARGE) tutil.c /bin/rm -f tutil.c ! perly.h: perl.c ! @ echo Dummy dependency for dumb parallel make ! touch perly.h ! ! perl.c: perl.y @ echo Expect 25 shift/reduce errors... $(YACC) -d perl.y mv y.tab.c perl.c mv y.tab.h perly.h + echo 'extern YYSTYPE yylval;' >>perly.h perl.o: perl.c perly.h $(h) $(CC) -c $(CFLAGS) $(LARGE) perl.c Index: README *** README.old Mon Mar 12 17:07:27 1990 --- README Mon Mar 12 17:07:28 1990 *************** *** 80,85 **** --- 80,86 ---- Ultrix (2.3) may need to hand assemble teval.s with a -J switch. Ultrix on MIPS machines may need -DLANGUAGE_C. SCO Xenix may need -m25000 for yacc. + Xenix 386 needs -Sm10000 for yacc. Genix needs to use libc rather than libc_s, or #undef VARARGS. NCR Tower 32 (OS 2.01.01) may need -W2,-Sl,2000 and #undef MKDIR. Machines with half-implemented dbm routines will need to #undef ODBM & NDBM. Index: arg.h Prereq: 3.0.1.3 *** arg.h.old Mon Mar 12 17:07:35 1990 --- arg.h Mon Mar 12 17:07:39 1990 *************** *** 1,4 **** ! /* $Header: arg.h,v 3.0.1.3 90/02/28 16:21:55 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: arg.h,v 3.0.1.4 90/03/12 16:18:21 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: arg.h,v $ + * Revision 3.0.1.4 90/03/12 16:18:21 lwall + * patch13: added list slice operator (LIST)[LIST] + * patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST) + * * Revision 3.0.1.3 90/02/28 16:21:55 lwall * patch9: added pipe function * *************** *** 261,267 **** #define O_SSOCKOPT 238 #define O_GETSOCKNAME 239 #define O_GETPEERNAME 240 ! #define MAXO 241 #ifndef DOINIT extern char *opname[]; --- 265,273 ---- #define O_SSOCKOPT 238 #define O_GETSOCKNAME 239 #define O_GETPEERNAME 240 ! #define O_LSLICE 241 ! #define O_SPLICE 242 ! #define MAXO 243 #ifndef DOINIT extern char *opname[]; *************** *** 508,514 **** "SSOCKOPT", "GETSOCKNAME", "GETPEERNAME", ! "241" }; #endif --- 514,522 ---- "SSOCKOPT", "GETSOCKNAME", "GETPEERNAME", ! "LSLICE", ! "SPLICE", ! "243" }; #endif *************** *** 882,887 **** --- 890,897 ---- A(1,1,1), /* SSOCKOPT */ A(1,0,0), /* GETSOCKNAME */ A(1,0,0), /* GETPEERNAME */ + A(0,3,3), /* LSLICE */ + A(0,3,1), /* SPLICE */ 0 }; #undef A Index: cmd.c Prereq: 3.0.1.5 *** cmd.c.old Mon Mar 12 17:07:54 1990 --- cmd.c Mon Mar 12 17:07:58 1990 *************** *** 1,4 **** ! /* $Header: cmd.c,v 3.0.1.5 90/02/28 16:38:31 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: cmd.c,v 3.0.1.6 90/03/12 16:21:09 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: cmd.c,v $ + * Revision 3.0.1.6 90/03/12 16:21:09 lwall + * patch13: fixed some backwards VOLATILE declarations + * patch13: while (s/x//) {} still caused some anomolies + * patch13: greater-than test of numeric switch structures did less-than action + * * 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 *************** *** 77,84 **** register char *go_to = goto_targ; register int newsp = -2; register STR **st = stack->ary_array; ! VOLATILE FILE *fp; ! VOLATILE ARRAY *ar; lastsize = 0; #ifdef DEBUGGING --- 82,89 ---- register char *go_to = goto_targ; register int newsp = -2; register STR **st = stack->ary_array; ! FILE *VOLATILE fp; ! ARRAY *VOLATILE ar; lastsize = 0; #ifdef DEBUGGING *************** *** 461,469 **** } } 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; } break; /* must evaluate */ --- 466,474 ---- } } if (--cmd->c_short->str_u.str_useful < 0) { ! cmdflags &= ~CF_OPTIMIZE; cmdflags |= CFT_EVAL; /* never try this optimization again */ ! cmd->c_flags = (cmdflags & ~CF_ONCE); } break; /* must evaluate */ *************** *** 681,687 **** if (match < 0) match = 0; else if (match > cmd->ucmd.scmd.sc_max) ! match = cmd->c_slen; cmd = cmd->ucmd.scmd.sc_next[match]; goto tail_recursion_entry; case C_NEXT: --- 686,692 ---- if (match < 0) match = 0; else if (match > cmd->ucmd.scmd.sc_max) ! match = cmd->ucmd.scmd.sc_max; cmd = cmd->ucmd.scmd.sc_next[match]; goto tail_recursion_entry; case C_NEXT: Index: cons.c Prereq: 3.0.1.4 *** cons.c.old Mon Mar 12 17:08:13 1990 --- cons.c Mon Mar 12 17:08:17 1990 *************** *** 1,4 **** ! /* $Header: cons.c,v 3.0.1.4 90/02/28 16:44:00 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: cons.c,v 3.0.1.5 90/03/12 16:23:10 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: cons.c,v $ + * Revision 3.0.1.5 90/03/12 16:23:10 lwall + * patch13: perl -d coredumped on scripts with subs that did explicit return + * * 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_ *************** *** 74,83 **** 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; --- 77,83 ---- mycompblock.comp_alt = Nullcmd; cmd = add_label(savestr("_SUB_"),make_ccmd(C_BLOCK,Nullarg,mycompblock)); saw_return = FALSE; ! cmd->c_flags |= CF_TERM; } sub->cmd = cmd; stab_sub(stab) = sub; Index: consarg.c Prereq: 3.0.1.3 *** consarg.c.old Mon Mar 12 17:08:29 1990 --- consarg.c Mon Mar 12 17:08:33 1990 *************** *** 1,4 **** ! /* $Header: consarg.c,v 3.0.1.3 90/02/28 16:47:54 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: consarg.c,v 3.0.1.4 90/03/12 16:24:40 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: consarg.c,v $ + * Revision 3.0.1.4 90/03/12 16:24:40 lwall + * patch13: return (@array) did counter-intuitive things + * * 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 *************** *** 905,911 **** int optype; ARG *arg; { ! if (optype == O_PRTF || (arg->arg_type == O_ASLICE || arg->arg_type == O_HSLICE || arg->arg_type == O_F_OR_R) ) arg = listish(arg); --- 908,923 ---- int optype; ARG *arg; { ! ARG *tmparg = arg; ! ! if (optype == O_RETURN && arg->arg_type == O_ITEM && ! arg[1].arg_type == A_EXPR && (tmparg = arg[1].arg_ptr.arg_arg) && ! ((tmparg->arg_flags & AF_LISTISH) || (tmparg->arg_type == O_ARRAY) )) { ! tmparg = listish(tmparg); ! free_arg(arg); ! arg = tmparg; ! } ! else if (optype == O_PRTF || (arg->arg_type == O_ASLICE || arg->arg_type == O_HSLICE || arg->arg_type == O_F_OR_R) ) arg = listish(arg); Index: doarg.c Prereq: 3.0.1.3 *** doarg.c.old Mon Mar 12 17:08:45 1990 --- doarg.c Mon Mar 12 17:08:49 1990 *************** *** 1,4 **** ! /* $Header: doarg.c,v 3.0.1.3 90/02/28 16:56:58 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: doarg.c,v 3.0.1.4 90/03/12 16:28:42 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: doarg.c,v $ + * Revision 3.0.1.4 90/03/12 16:28:42 lwall + * patch13: pack of ascii strings could call str_ncat() with negative length + * patch13: printf("%s", *foo) was busted + * * 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 *************** *** 395,416 **** aptr = str_get(fromstr); if (fromstr->str_cur > len) str_ncat(str,aptr,len); ! else str_ncat(str,aptr,fromstr->str_cur); ! len -= fromstr->str_cur; ! if (datumtype == 'A') { ! while (len >= 10) { ! str_ncat(str,space10,10); ! len -= 10; } ! str_ncat(str,space10,len); ! } ! else { ! while (len >= 10) { ! str_ncat(str,null10,10); ! len -= 10; } - str_ncat(str,null10,len); } break; case 'C': --- 399,421 ---- aptr = str_get(fromstr); if (fromstr->str_cur > len) str_ncat(str,aptr,len); ! else { str_ncat(str,aptr,fromstr->str_cur); ! len -= fromstr->str_cur; ! if (datumtype == 'A') { ! while (len >= 10) { ! str_ncat(str,space10,10); ! len -= 10; ! } ! str_ncat(str,space10,len); } ! else { ! while (len >= 10) { ! str_ncat(str,null10,10); ! len -= 10; ! } ! str_ncat(str,null10,len); } } break; case 'C': *************** *** 601,607 **** *t = '\0'; xs = str_get(*sarg); xlen = (*sarg)->str_cur; ! if (*xs == 'S' && xs[1] == 't' && xs[2] == 'a' && xs[3] == 'b' && xlen == sizeof(STBP) && strlen(xs) < xlen) { xs = stab_name(((STAB*)(*sarg))); /* a stab value! */ sprintf(tokenbuf,"*%s",xs); /* reformat to non-binary */ --- 606,612 ---- *t = '\0'; xs = str_get(*sarg); xlen = (*sarg)->str_cur; ! if (*xs == 'S' && xs[1] == 't' && xs[2] == 'B' && xlen == sizeof(STBP) && strlen(xs) < xlen) { xs = stab_name(((STAB*)(*sarg))); /* a stab value! */ sprintf(tokenbuf,"*%s",xs); /* reformat to non-binary */ Index: doio.c Prereq: 3.0.1.5 *** doio.c.old Mon Mar 12 17:09:03 1990 --- doio.c Mon Mar 12 17:09:10 1990 *************** *** 1,4 **** ! /* $Header: doio.c,v 3.0.1.5 90/02/28 17:01:36 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: doio.c,v 3.0.1.6 90/03/12 16:30:07 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: doio.c,v $ + * Revision 3.0.1.6 90/03/12 16:30:07 lwall + * patch13: system 'FOO=bar command' didn't invoke sh as it should + * * 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 *************** *** 939,944 **** --- 942,950 ---- return FALSE; } } + for (s = cmd; *s && isalpha(*s); s++) ; /* catch VAR=val gizmo */ + if (*s == '=') + goto doshell; New(402,argv, (s - cmd) / 2 + 2, char*); a = argv; Index: dolist.c Prereq: 3.0.1.5 *** dolist.c.old Mon Mar 12 17:09:24 1990 --- dolist.c Mon Mar 12 17:09:28 1990 *************** *** 1,4 **** ! /* $Header: dolist.c,v 3.0.1.5 90/02/28 17:09:44 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: dolist.c,v 3.0.1.6 90/03/12 16:33:02 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: dolist.c,v $ + * Revision 3.0.1.6 90/03/12 16:33:02 lwall + * patch13: added list slice operator (LIST)[LIST] + * patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST) + * patch13: made split('') act like split(//) rather than split(' ') + * * 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 *************** *** 287,293 **** st = stack->ary_array; m = str_get(dstr = st[sp--]); nointrp = ""; ! if (!dstr->str_cur || (*m == ' ' && dstr->str_cur == 1)) { str_set(dstr,"\\s+"); m = dstr->str_ptr; spat->spat_flags |= SPAT_SKIPWHITE; --- 292,298 ---- st = stack->ary_array; m = str_get(dstr = st[sp--]); nointrp = ""; ! if (*m == ' ' && dstr->str_cur == 1) { str_set(dstr,"\\s+"); m = dstr->str_ptr; spat->spat_flags |= SPAT_SKIPWHITE; *************** *** 658,665 **** } int ! do_slice(stab,numarray,lval,gimme,arglast) ! register STAB *stab; int numarray; int lval; int gimme; --- 663,671 ---- } int ! do_slice(stab,str,numarray,lval,gimme,arglast) ! STAB *stab; ! STR *str; int numarray; int lval; int gimme; *************** *** 671,686 **** register char *tmps; register int len; register int magic = 0; ! if (lval && !numarray) { ! if (stab == envstab) ! magic = 'E'; ! else if (stab == sigstab) ! magic = 'S'; #ifdef SOME_DBM ! else if (stab_hash(stab)->tbl_dbm) ! magic = 'D'; #endif /* SOME_DBM */ } if (gimme == G_ARRAY) { --- 677,709 ---- register char *tmps; register int len; register int magic = 0; + register ARRAY *ary; + register HASH *hash; + int oldarybase = arybase; ! if (numarray) { ! if (numarray == 2) { /* a slice of a LIST */ ! ary = stack; ! ary->ary_fill = arglast[3]; ! arybase -= max + 1; ! st[sp] = str; /* make stack size available */ ! str_numset(str,(double)(sp - 1)); ! } ! else ! ary = stab_array(stab); /* a slice of an array */ ! } ! else { ! if (lval) { ! if (stab == envstab) ! magic = 'E'; ! else if (stab == sigstab) ! magic = 'S'; #ifdef SOME_DBM ! else if (stab_hash(stab)->tbl_dbm) ! magic = 'D'; #endif /* SOME_DBM */ + } + hash = stab_hash(stab); /* a slice of an associative array */ } if (gimme == G_ARRAY) { *************** *** 687,693 **** if (numarray) { while (sp < max) { if (st[++sp]) { ! st[sp-1] = afetch(stab_array(stab), ((int)str_gnum(st[sp])) - arybase, lval); } else --- 710,716 ---- if (numarray) { while (sp < max) { if (st[++sp]) { ! st[sp-1] = afetch(ary, ((int)str_gnum(st[sp])) - arybase, lval); } else *************** *** 699,705 **** if (st[++sp]) { tmps = str_get(st[sp]); len = st[sp]->str_cur; ! st[sp-1] = hfetch(stab_hash(stab),tmps,len, lval); if (magic) str_magic(st[sp-1],stab,magic,tmps,len); } --- 722,728 ---- if (st[++sp]) { tmps = str_get(st[sp]); len = st[sp]->str_cur; ! st[sp-1] = hfetch(hash,tmps,len, lval); if (magic) str_magic(st[sp-1],stab,magic,tmps,len); } *************** *** 712,718 **** else { if (numarray) { if (st[max]) ! st[sp] = afetch(stab_array(stab), ((int)str_gnum(st[max])) - arybase, lval); else st[sp] = &str_undef; --- 735,741 ---- else { if (numarray) { if (st[max]) ! st[sp] = afetch(ary, ((int)str_gnum(st[max])) - arybase, lval); else st[sp] = &str_undef; *************** *** 721,727 **** if (st[max]) { tmps = str_get(st[max]); len = st[max]->str_cur; ! st[sp] = hfetch(stab_hash(stab),tmps,len, lval); if (magic) str_magic(st[sp],stab,magic,tmps,len); } --- 744,750 ---- if (st[max]) { tmps = str_get(st[max]); len = st[max]->str_cur; ! st[sp] = hfetch(hash,tmps,len, lval); if (magic) str_magic(st[sp],stab,magic,tmps,len); } *************** *** 728,733 **** --- 751,934 ---- else st[sp] = &str_undef; } + } + arybase = oldarybase; + return sp; + } + + int + do_splice(ary,str,gimme,arglast) + register ARRAY *ary; + STR *str; + int gimme; + int *arglast; + { + register STR **st = stack->ary_array; + register int sp = arglast[1]; + int max = arglast[2] + 1; + register STR **src; + register STR **dst; + register int i; + register int offset; + register int length; + int newlen; + int after; + int diff; + STR **tmparyval; + + if (++sp < max) { + offset = ((int)str_gnum(st[sp])) - arybase; + if (offset < 0) + offset += ary->ary_fill + 1; + if (++sp < max) { + length = (int)str_gnum(st[sp++]); + if (length < 0) + length = 0; + } + else + length = ary->ary_max; /* close enough to infinity */ + } + else { + offset = 0; + length = ary->ary_max; + } + if (offset < 0) { + length += offset; + offset = 0; + if (length < 0) + length = 0; + } + if (offset > ary->ary_fill + 1) + offset = ary->ary_fill + 1; + after = ary->ary_fill + 1 - (offset + length); + if (after < 0) { /* not that much array */ + length += after; /* offset+length now in array */ + after = 0; + } + + /* At this point, sp .. max-1 is our new LIST */ + + newlen = max - sp; + diff = newlen - length; + + if (diff < 0) { /* shrinking the area */ + if (newlen) { + New(451, tmparyval, newlen, STR*); /* so remember insertion */ + Copy(st+sp, tmparyval, newlen, STR*); + } + + sp = arglast[0] + 1; + if (gimme == G_ARRAY) { /* copy return vals to stack */ + if (sp + length >= stack->ary_max) { + astore(stack,sp + length, Nullstr); + st = stack->ary_array; + } + Copy(ary->ary_array+offset, st+sp, length, STR*); + if (ary->ary_flags & ARF_REAL) { + for (i = length, dst = st+sp; i; i--) + str_2static(*dst++); /* free them eventualy */ + } + sp += length - 1; + } + else { + st[sp] = ary->ary_array[offset+length-1]; + if (ary->ary_flags & ARF_REAL) + str_2static(st[sp]); + } + ary->ary_fill += diff; + + /* pull up or down? */ + + if (offset < after) { /* easier to pull up */ + if (offset) { /* esp. if nothing to pull */ + src = &ary->ary_array[offset-1]; + dst = src - diff; /* diff is negative */ + for (i = offset; i > 0; i--) /* can't trust Copy */ + *dst-- = *src--; + } + ary->ary_array -= diff; /* diff is negative */ + ary->ary_max += diff; + } + else { + if (after) { /* anything to pull down? */ + src = ary->ary_array + offset + length; + dst = src + diff; /* diff is negative */ + Copy(src, dst, after, STR*); + } + Zero(&ary->ary_array[ary->ary_fill+1], -diff, STR*); + /* avoid later double free */ + } + if (newlen) { + for (src = tmparyval, dst = ary->ary_array + offset; + newlen; newlen--) { + *dst = Str_new(46,0); + str_sset(*dst++,*src++); + } + Safefree(tmparyval); + } + } + else { /* no, expanding (or same) */ + if (length) { + New(452, tmparyval, length, STR*); /* so remember deletion */ + Copy(ary->ary_array+offset, tmparyval, length, STR*); + } + + if (diff > 0) { /* expanding */ + + /* push up or down? */ + + if (offset < after && diff <= ary->ary_array - ary->ary_alloc) { + if (offset) { + src = ary->ary_array; + dst = src - diff; + Copy(src, dst, offset, STR*); + } + ary->ary_array -= diff; /* diff is positive */ + ary->ary_max += diff; + ary->ary_fill += diff; + } + else { + if (ary->ary_fill + diff >= ary->ary_max) /* oh, well */ + astore(ary, ary->ary_fill + diff, Nullstr); + else + ary->ary_fill += diff; + if (after) { + dst = ary->ary_array + ary->ary_fill; + src = dst - diff; + for (i = after; i; i--) { + if (*dst) /* str was hanging around */ + str_free(*dst); /* after $#foo */ + *dst-- = *src; + *src-- = Nullstr; + } + } + } + } + + for (src = st+sp, dst = ary->ary_array + offset; newlen; newlen--) { + *dst = Str_new(46,0); + str_sset(*dst++,*src++); + } + sp = arglast[0] + 1; + if (gimme == G_ARRAY) { /* copy return vals to stack */ + if (length) { + Copy(tmparyval, st+sp, length, STR*); + if (ary->ary_flags & ARF_REAL) { + for (i = length, dst = st+sp; i; i--) + str_2static(*dst++); /* free them eventualy */ + } + Safefree(tmparyval); + } + sp += length - 1; + } + else if (length) { + st[sp] = tmparyval[length-1]; + if (ary->ary_flags & ARF_REAL) + str_2static(st[sp]); + Safefree(tmparyval); + } + else + st[sp] = &str_undef; } return sp; } *** End of Patch 13 ***