lwall@netlabs.com (Larry Wall) (06/20/91)
Submitted-by: Larry Wall <lwall@netlabs.com> Posting-number: Volume 20, Issue 61 Archive-name: perl/patch09 Patch-To: perl: Volume 18, Issue 19-54 System: perl version 4.0 Patch #: 9 Priority: High Subject: patch #4, continued Description: See patch #4. 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: Configure -d make depend make make test make install 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@netlabs.com If you send a mail message of the following form it will greatly speed processing: Subject: Command @SH mailpatch PATH perl 4.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. Index: patchlevel.h Prereq: 8 1c1 < #define PATCHLEVEL 8 --- > #define PATCHLEVEL 9 Index: stab.h Prereq: 4.0 *** stab.h.old Fri Jun 7 12:26:50 1991 --- stab.h Fri Jun 7 12:26:51 1991 *************** *** 1,11 **** ! /* $Header: stab.h,v 4.0 91/03/20 01:39:49 lwall Locked $ * ! * Copyright (c) 1989, Larry Wall * ! * You may distribute under the terms of the GNU General Public License ! * as specified in the README file that comes with the perl 3.0 kit. * * $Log: stab.h,v $ * Revision 4.0 91/03/20 01:39:49 lwall * 4.0 baseline. * --- 1,15 ---- ! /* $RCSfile: stab.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:56:35 $ * ! * Copyright (c) 1991, Larry Wall * ! * You may distribute under the terms of either the GNU General Public ! * License or the Artistic License, as specified in the README file. * * $Log: stab.h,v $ + * Revision 4.0.1.1 91/06/07 11:56:35 lwall + * patch4: new copyright notice + * patch4: length($`), length($&), length($') now optimized to avoid string copy + * * Revision 4.0 91/03/20 01:39:49 lwall * 4.0 baseline. * *************** *** 93,99 **** --- 97,106 ---- #define Nullstab Null(STAB*) + STRLEN stab_len(); + #define STAB_STR(s) (tmpstab = (s), stab_flags(tmpstab) & SF_VMAGIC ? stab_str(stab_val(tmpstab)->str_magic) : stab_val(tmpstab)) + #define STAB_LEN(s) (tmpstab = (s), stab_flags(tmpstab) & SF_VMAGIC ? stab_len(stab_val(tmpstab)->str_magic) : stab_val(tmpstab)->str_cur) #define STAB_GET(s) (tmpstab = (s), str_get(stab_flags(tmpstab) & SF_VMAGIC ? stab_str(tmpstab->str_magic) : stab_val(tmpstab))) #define STAB_GNUM(s) (tmpstab = (s), str_gnum(stab_flags(tmpstab) & SF_VMAGIC ? stab_str(tmpstab->str_magic) : stab_val(tmpstab))) Index: t/op/stat.t Prereq: 4.0 *** t/op/stat.t.old Fri Jun 7 12:27:11 1991 --- t/op/stat.t Fri Jun 7 12:27:12 1991 *************** *** 1,11 **** #!./perl ! # $Header: stat.t,v 4.0 91/03/20 01:54:55 lwall Locked $ print "1..56\n"; chop($cwd = `pwd`); unlink "Op.stat.tmp"; open(foo, ">Op.stat.tmp"); --- 1,13 ---- #!./perl ! # $RCSfile: stat.t,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:02:42 $ print "1..56\n"; chop($cwd = `pwd`); + $DEV = `ls -l /dev`; + unlink "Op.stat.tmp"; open(foo, ">Op.stat.tmp"); *************** *** 81,96 **** `rm -f Op.stat.tmp Op.stat.tmp2`; if (! -e 'Op.stat.tmp') {print "ok 28\n";} else {print "not ok 28\n";} ! if (-c '/dev/tty') {print "ok 29\n";} else {print "not ok 29\n";} if (! -c '.') {print "ok 30\n";} else {print "not ok 30\n";} ! if (! -e '/dev/printer' || -c '/dev/printer' || -S '/dev/printer') {print "ok 31\n";} else {print "not ok 31\n";} if (! -S '.') {print "ok 32\n";} else {print "not ok 32\n";} ! if (! -e '/dev/mt0' || -b '/dev/mt0') {print "ok 33\n";} else {print "not ok 33\n";} --- 83,107 ---- `rm -f Op.stat.tmp Op.stat.tmp2`; if (! -e 'Op.stat.tmp') {print "ok 28\n";} else {print "not ok 28\n";} ! if ($DEV !~ /\nc.* (\S+)\n/) ! {print "ok 29\n";} ! elsif (-c "/dev/$1") ! {print "ok 29\n";} ! else ! {print "not ok 29\n";} if (! -c '.') {print "ok 30\n";} else {print "not ok 30\n";} ! if ($DEV !~ /\ns.* (\S+)\n/) {print "ok 31\n";} + elsif (-S "/dev/$1") + {print "ok 31\n";} else {print "not ok 31\n";} if (! -S '.') {print "ok 32\n";} else {print "not ok 32\n";} ! if ($DEV !~ /\nb.* (\S+)\n/) ! {print "ok 33\n";} ! elsif (-b "/dev/$1") {print "ok 33\n";} else {print "not ok 33\n";} Index: str.c *** str.c.old Fri Jun 7 12:26:55 1991 --- str.c Fri Jun 7 12:26:56 1991 *************** *** 1,11 **** ! /* $RCSfile: str.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:15:30 $ * ! * Copyright (c) 1989, Larry Wall * ! * You may distribute under the terms of the GNU General Public License ! * as specified in the README file that comes with the perl 3.0 kit. * * $Log: str.c,v $ * Revision 4.0.1.1 91/04/12 09:15:30 lwall * patch1: fixed undefined environ problem * patch1: substr($ENV{"PATH"},0,0) = "/foo:" didn't modify environment --- 1,15 ---- ! /* $RCSfile: str.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:58:13 $ * ! * Copyright (c) 1991, Larry Wall * ! * You may distribute under the terms of either the GNU General Public ! * License or the Artistic License, as specified in the README file. * * $Log: str.c,v $ + * Revision 4.0.1.2 91/06/07 11:58:13 lwall + * patch4: new copyright notice + * patch4: taint check on undefined string could cause core dump + * * Revision 4.0.1.1 91/04/12 09:15:30 lwall * patch1: fixed undefined environ problem * patch1: substr($ENV{"PATH"},0,0) = "/foo:" didn't modify environment *************** *** 369,379 **** STR *dstr; register STR *sstr; { #ifdef TAINT tainted |= sstr->str_tainted; #endif - if (!sstr) - return; if (!(sstr->str_pok)) (void)str_2ptr(sstr); if (sstr) --- 373,383 ---- STR *dstr; register STR *sstr; { + if (!sstr) + return; #ifdef TAINT tainted |= sstr->str_tainted; #endif if (!(sstr->str_pok)) (void)str_2ptr(sstr); if (sstr) Index: x2p/str.c Prereq: 4.0 *** x2p/str.c.old Fri Jun 7 12:28:17 1991 --- x2p/str.c Fri Jun 7 12:28:17 1991 *************** *** 1,11 **** ! /* $Header: str.c,v 4.0 91/03/20 01:58:15 lwall Locked $ * ! * Copyright (c) 1989, Larry Wall * ! * You may distribute under the terms of the GNU General Public License ! * as specified in the README file that comes with the perl 3.0 kit. * * $Log: str.c,v $ * Revision 4.0 91/03/20 01:58:15 lwall * 4.0 baseline. * --- 1,14 ---- ! /* $RCSfile: str.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:20:08 $ * ! * Copyright (c) 1991, Larry Wall * ! * You may distribute under the terms of either the GNU General Public ! * License or the Artistic License, as specified in the README file. * * $Log: str.c,v $ + * Revision 4.0.1.1 91/06/07 12:20:08 lwall + * patch4: new copyright notice + * * Revision 4.0 91/03/20 01:58:15 lwall * 4.0 baseline. * Index: str.h *** str.h.old Fri Jun 7 12:26:59 1991 --- str.h Fri Jun 7 12:27:01 1991 *************** *** 1,11 **** ! /* $RCSfile: str.h,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:16:12 $ * ! * Copyright (c) 1989, Larry Wall * ! * You may distribute under the terms of the GNU General Public License ! * as specified in the README file that comes with the perl 3.0 kit. * * $Log: str.h,v $ * Revision 4.0.1.1 91/04/12 09:16:12 lwall * patch1: you may now use "die" and "caller" in a signal handler * --- 1,14 ---- ! /* $RCSfile: str.h,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:58:33 $ * ! * Copyright (c) 1991, Larry Wall * ! * You may distribute under the terms of either the GNU General Public ! * License or the Artistic License, as specified in the README file. * * $Log: str.h,v $ + * Revision 4.0.1.2 91/06/07 11:58:33 lwall + * patch4: new copyright notice + * * Revision 4.0.1.1 91/04/12 09:16:12 lwall * patch1: you may now use "die" and "caller" in a signal handler * Index: x2p/str.h Prereq: 4.0 *** x2p/str.h.old Fri Jun 7 12:28:20 1991 --- x2p/str.h Fri Jun 7 12:28:20 1991 *************** *** 1,11 **** ! /* $Header: str.h,v 4.0 91/03/20 01:58:21 lwall Locked $ * ! * Copyright (c) 1989, Larry Wall * ! * You may distribute under the terms of the GNU General Public License ! * as specified in the README file that comes with the perl 3.0 kit. * * $Log: str.h,v $ * Revision 4.0 91/03/20 01:58:21 lwall * 4.0 baseline. * --- 1,14 ---- ! /* $RCSfile: str.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:20:22 $ * ! * Copyright (c) 1991, Larry Wall * ! * You may distribute under the terms of either the GNU General Public ! * License or the Artistic License, as specified in the README file. * * $Log: str.h,v $ + * Revision 4.0.1.1 91/06/07 12:20:22 lwall + * patch4: new copyright notice + * * Revision 4.0 91/03/20 01:58:21 lwall * 4.0 baseline. * Index: hints/sunos_4_0_1.sh *** hints/sunos_4_0_1.sh.old Fri Jun 7 12:24:51 1991 --- hints/sunos_4_0_1.sh Fri Jun 7 12:24:51 1991 *************** *** 1,4 **** ! echo ': work around botch in SunOS 4.0.1 and 4.0.2' >>../perl.h ! echo '#ifndef fputs' >>../perl.h ! echo '#define fputs(str,fp) fprintf(fp,"%s",str)' >>../perl.h ! echo '#endif' >>../perl.h --- 1 ---- ! $ccflags="$ccflags -DFPUTS_BOTCH" Index: hints/sunos_4_0_2.sh *** hints/sunos_4_0_2.sh.old Fri Jun 7 12:24:53 1991 --- hints/sunos_4_0_2.sh Fri Jun 7 12:24:54 1991 *************** *** 1,4 **** ! echo ': work around botch in SunOS 4.0.1 and 4.0.2' >>../perl.h ! echo '#ifndef fputs' >>../perl.h ! echo '#define fputs(str,fp) fprintf(fp,"%s",str)' >>../perl.h ! echo '#endif' >>../perl.h --- 1 ---- ! $ccflags="$ccflags -DFPUTS_BOTCH" Index: hints/svr4.sh *** hints/svr4.sh.old Fri Jun 7 12:24:56 1991 --- hints/svr4.sh Fri Jun 7 12:24:57 1991 *************** *** 0 **** --- 1,6 ---- + cc='/bin/cc' + test -f $cc || cc='/usr/ccs/bin/cc' + ldflags='-L/usr/ucblib' + mansrc='/usr/share/man/man1' + ccflags='-I/usr/include -I/usr/ucbinclude' + libswanted=`echo $libswanted | sed 's/ ucb/ c ucb/'` Index: toke.c *** toke.c.old Fri Jun 7 12:27:17 1991 --- toke.c Fri Jun 7 12:27:19 1991 *************** *** 1,11 **** ! /* $RCSfile: toke.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:18:18 $ * ! * Copyright (c) 1989, Larry Wall * ! * You may distribute under the terms of the GNU General Public License ! * as specified in the README file that comes with the perl 3.0 kit. * * $Log: toke.c,v $ * Revision 4.0.1.1 91/04/12 09:18:18 lwall * patch1: perl -de "print" wouldn't stop at the first statement * --- 1,17 ---- ! /* $RCSfile: toke.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 12:05:56 $ * ! * Copyright (c) 1991, Larry Wall * ! * You may distribute under the terms of either the GNU General Public ! * License or the Artistic License, as specified in the README file. * * $Log: toke.c,v $ + * Revision 4.0.1.2 91/06/07 12:05:56 lwall + * patch4: new copyright notice + * patch4: debugger lost track of lines in eval + * patch4: //o and s///o now optimize themselves fully at runtime + * patch4: added global modifier for pattern matches + * * Revision 4.0.1.1 91/04/12 09:18:18 lwall * patch1: perl -de "print" wouldn't stop at the first statement * *************** *** 25,30 **** --- 31,40 ---- #include <sys/file.h> #endif + #ifdef f_next + #undef f_next + #endif + /* which backslash sequences to keep in m// or s// */ static char *patleave = "\\.^$@dDwWsSbB+*?|()-nrtf0123456789[{]}"; *************** *** 326,338 **** s++; if (s < d) s++; - if (perldb) { - STR *str = Str_new(85,0); - - str_nset(str,linestr->str_ptr, s - linestr->str_ptr); - astore(stab_xarray(curcmd->c_filestab),(int)curcmd->c_line,str); - str_chop(linestr, s); - } if (in_format) { bufptr = s; yylval.formval = load_format(); --- 336,341 ---- *************** *** 947,953 **** if (strEQ(d,"oct")) UNI(O_OCT); if (strEQ(d,"opendir")) ! FOP2(O_OPENDIR); break; case 'p': case 'P': SNARFWORD; --- 950,956 ---- if (strEQ(d,"oct")) UNI(O_OCT); if (strEQ(d,"opendir")) ! FOP2(O_OPEN_DIR); break; case 'p': case 'P': SNARFWORD; *************** *** 1417,1423 **** } STR * ! scanconst(string,len) char *string; int len; { --- 1420,1427 ---- } STR * ! scanconst(spat,string,len) ! SPAT *spat; char *string; int len; { *************** *** 1425,1434 **** register char *t; register char *d; register char *e; ! if (index(string,'|')) { return Nullstr; ! } retstr = Str_new(86,len); str_nset(retstr,string,len); t = str_get(retstr); --- 1429,1441 ---- register char *t; register char *d; register char *e; + char *origstring = string; + static char *vert = "|"; ! if (ninstr(string, string+len, vert, vert+1)) return Nullstr; ! if (*string == '^') ! string++, len--; retstr = Str_new(86,len); str_nset(retstr,string,len); t = str_get(retstr); *************** *** 1488,1493 **** --- 1495,1506 ---- } *d = '\0'; retstr->str_cur = d - t; + if (d == t+len) + spat->spat_flags |= SPAT_ALL; + if (*origstring != '^') + spat->spat_flags |= SPAT_SCANFIRST; + spat->spat_short = retstr; + spat->spat_slen = d - t; return retstr; } *************** *** 1526,1532 **** return s; } s++; ! while (*s == 'i' || *s == 'o') { if (*s == 'i') { s++; sawi = TRUE; --- 1539,1545 ---- return s; } s++; ! while (*s == 'i' || *s == 'o' || *s == 'g') { if (*s == 'i') { s++; sawi = TRUE; *************** *** 1536,1541 **** --- 1549,1558 ---- s++; spat->spat_flags |= SPAT_KEEP; } + if (*s == 'g') { + s++; + spat->spat_flags |= SPAT_GLOBAL; + } } len = str->str_cur; e = str->str_ptr + len; *************** *** 1575,1597 **** #else (void)bcopy((char *)spat, (char *)&savespat, sizeof(SPAT)); #endif ! if (*str->str_ptr == '^') { ! spat->spat_short = scanconst(str->str_ptr+1,len-1); ! if (spat->spat_short) { ! spat->spat_slen = spat->spat_short->str_cur; ! if (spat->spat_slen == len - 1) ! spat->spat_flags |= SPAT_ALL; ! } ! } ! else { ! spat->spat_flags |= SPAT_SCANFIRST; ! spat->spat_short = scanconst(str->str_ptr,len); ! if (spat->spat_short) { ! spat->spat_slen = spat->spat_short->str_cur; ! if (spat->spat_slen == len) ! spat->spat_flags |= SPAT_ALL; ! } ! } if ((spat->spat_flags & SPAT_ALL) && (spat->spat_flags & SPAT_SCANFIRST)) { fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD); spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len, --- 1592,1598 ---- #else (void)bcopy((char *)spat, (char *)&savespat, sizeof(SPAT)); #endif ! scanconst(spat,str->str_ptr,len); if ((spat->spat_flags & SPAT_ALL) && (spat->spat_flags & SPAT_SCANFIRST)) { fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD); spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len, *************** *** 1670,1686 **** goto get_repl; /* skip compiling for now */ } } ! if (*str->str_ptr == '^') { ! spat->spat_short = scanconst(str->str_ptr+1,len-1); ! if (spat->spat_short) ! spat->spat_slen = spat->spat_short->str_cur; ! } ! else { ! spat->spat_flags |= SPAT_SCANFIRST; ! spat->spat_short = scanconst(str->str_ptr,len); ! if (spat->spat_short) ! spat->spat_slen = spat->spat_short->str_cur; ! } get_repl: s = scanstr(s); if (s >= bufend) { --- 1671,1677 ---- goto get_repl; /* skip compiling for now */ } } ! scanconst(spat,str->str_ptr,len); get_repl: s = scanstr(s); if (s >= bufend) { *************** *** 1690,1696 **** return s; } spat->spat_repl = yylval.arg; - spat->spat_flags |= SPAT_ONCE; if ((spat->spat_repl[1].arg_type & A_MASK) == A_SINGLE) spat->spat_flags |= SPAT_CONST; else if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE) { --- 1681,1686 ---- *************** *** 1719,1725 **** } if (*s == 'g') { s++; ! spat->spat_flags &= ~SPAT_ONCE; } if (*s == 'i') { s++; --- 1709,1715 ---- } if (*s == 'g') { s++; ! spat->spat_flags |= SPAT_GLOBAL; } if (*s == 'i') { s++; *************** *** 1751,1757 **** hoistmust(spat) register SPAT *spat; { ! if (spat->spat_regexp->regmust) { /* is there a better short-circuit? */ if (spat->spat_short && str_eq(spat->spat_short,spat->spat_regexp->regmust)) { --- 1741,1754 ---- hoistmust(spat) register SPAT *spat; { ! if (!spat->spat_short && spat->spat_regexp->regstart && ! (!spat->spat_regexp->regmust || spat->spat_regexp->reganch & ROPT_ANCH) ! ) { ! spat->spat_short = spat->spat_regexp->regstart; ! if (!(spat->spat_regexp->reganch & ROPT_ANCH)) ! spat->spat_flags |= SPAT_SCANFIRST; ! } ! else if (spat->spat_regexp->regmust) {/* is there a better short-circuit? */ if (spat->spat_short && str_eq(spat->spat_short,spat->spat_regexp->regmust)) { *************** *** 2119,2124 **** --- 2116,2122 ---- STR *tmpstr; char *tmps; + CLINE; multi_start = curcmd->c_line; if (hereis) multi_open = multi_close = '<'; Index: hints/ultrix_3.sh *** hints/ultrix_3.sh.old Fri Jun 7 12:25:00 1991 --- hints/ultrix_3.sh Fri Jun 7 12:25:00 1991 *************** *** 1,2 **** ccflags="$ccflags -DLANGUAGE_C" ! d_waitpid=$undef --- 1,14 ---- ccflags="$ccflags -DLANGUAGE_C" ! tmp="`(uname -a) 2>/dev/null`" ! case "$tmp" in ! *3.[01]*RISC) d_waitpid=$undef;; ! '') d_waitpid=$undef;; ! esac ! case "$tmp" in ! *RISC) ! cmd_cflags='optimize="-g"' ! perl_cflags='optimize="-g"' ! tcmd_cflags='optimize="-g"' ! tperl_cflags='optimize="-g"' ! ;; ! esac Index: hints/ultrix_4.sh *** hints/ultrix_4.sh.old Fri Jun 7 12:25:02 1991 --- hints/ultrix_4.sh Fri Jun 7 12:25:03 1991 *************** *** 1 **** --- 1,19 ---- ccflags="$ccflags -DLANGUAGE_C -Olimit 2900" + tmp=`(uname -a) 2>/dev/null` + case "$tmp" in + *RISC*) cat <<EOF + Note that there is a bug in some versions of NFS on the DECStation that + may cause utime() to work incorrectly. If so, regression test io/fs + may fail if run under NFS. Ignore the failure. + EOF + ;; + esac + case "$tmp" in + *4.1*) + eval_cflags='optimize="-g"' + teval_cflags='optimize="-g"' + toke_cflags='optimize="-g"' + ttoke_cflags='optimize="-g"' + ;; + esac + Index: util.c *** util.c.old Fri Jun 7 12:27:26 1991 --- util.c Fri Jun 7 12:27:27 1991 *************** *** 1,11 **** ! /* $RCSfile: util.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:19:25 $ * ! * Copyright (c) 1989, Larry Wall * ! * You may distribute under the terms of the GNU General Public License ! * as specified in the README file that comes with the perl 3.0 kit. * * $Log: util.c,v $ * Revision 4.0.1.1 91/04/12 09:19:25 lwall * patch1: random cleanup in cpp namespace * --- 1,18 ---- ! /* $RCSfile: util.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 12:10:42 $ * ! * Copyright (c) 1991, Larry Wall * ! * You may distribute under the terms of either the GNU General Public ! * License or the Artistic License, as specified in the README file. * * $Log: util.c,v $ + * Revision 4.0.1.2 91/06/07 12:10:42 lwall + * patch4: new copyright notice + * patch4: made some allowances for "semi-standard" C + * patch4: index() could blow up searching for null string + * patch4: taintchecks could improperly modify parent in vfork() + * patch4: exec would close files even if you cleared close-on-exec flag + * * Revision 4.0.1.1 91/04/12 09:19:25 lwall * patch1: random cleanup in cpp namespace * *************** *** 60,68 **** #endif /* MSDOS */ { char *ptr; ! #ifndef __STDC__ char *malloc(); ! #endif /* ! __STDC__ */ #ifdef MSDOS if (size > 0xffff) { --- 67,75 ---- #endif /* MSDOS */ { char *ptr; ! #ifndef STANDARD_C char *malloc(); ! #endif /* ! STANDARD_C */ #ifdef MSDOS if (size > 0xffff) { *************** *** 108,116 **** #endif /* MSDOS */ { char *ptr; ! #ifndef __STDC__ char *realloc(); ! #endif /* ! __STDC__ */ #ifdef MSDOS if (size > 0xffff) { --- 115,123 ---- #endif /* MSDOS */ { char *ptr; ! #ifndef STANDARD_C char *realloc(); ! #endif /* ! STANDARD_C */ #ifdef MSDOS if (size > 0xffff) { *************** *** 514,522 **** register unsigned char *oldlittle; #ifndef lint ! if (!(littlestr->str_pok & SP_FBM)) return ninstr((char*)big,(char*)bigend, littlestr->str_ptr, littlestr->str_ptr + littlestr->str_cur); #endif littlelen = littlestr->str_cur; --- 521,532 ---- register unsigned char *oldlittle; #ifndef lint ! if (!(littlestr->str_pok & SP_FBM)) { ! if (!littlestr->str_ptr) ! return (char*)big; return ninstr((char*)big,(char*)bigend, littlestr->str_ptr, littlestr->str_ptr + littlestr->str_cur); + } #endif littlelen = littlestr->str_cur; *************** *** 851,861 **** --- 861,873 ---- { char *pat; char *s; + #ifndef HAS_VPRINTF #ifdef CHARVSPRINTF char *vsprintf(); #else int vsprintf(); #endif + #endif s = buf; #ifdef lint *************** *** 1196,1201 **** --- 1208,1219 ---- return Nullfp; this = (*mode == 'w'); that = !this; + #ifdef TAINT + if (doexec) { + taintenv(); + taintproper("Insecure dependency in exec"); + } + #endif while ((pid = (doexec?vfork():fork())) < 0) { if (errno != EAGAIN) { close(p[this]); *************** *** 1214,1226 **** close(p[THIS]); } if (doexec) { ! #if !defined(I_FCNTL) || !defined(F_SETFD) int fd; #ifndef NOFILE #define NOFILE 20 #endif ! for (fd = 3; fd < NOFILE; fd++) close(fd); #endif do_exec(cmd); /* may or may not use the shell */ --- 1232,1244 ---- close(p[THIS]); } if (doexec) { ! #if !defined(HAS_FCNTL) || !defined(F_SETFD) int fd; #ifndef NOFILE #define NOFILE 20 #endif ! for (fd = maxsysfd + 1; fd < NOFILE; fd++) close(fd); #endif do_exec(cmd); /* may or may not use the shell */ *************** *** 1273,1279 **** close(newfd); fcntl(oldfd, F_DUPFD, newfd); #else ! int fdtmp[20]; int fdx = 0; int fd; --- 1291,1297 ---- close(newfd); fcntl(oldfd, F_DUPFD, newfd); #else ! int fdtmp[256]; int fdx = 0; int fd; Index: x2p/util.c Prereq: 4.0 *** x2p/util.c.old Fri Jun 7 12:28:22 1991 --- x2p/util.c Fri Jun 7 12:28:23 1991 *************** *** 1,11 **** ! /* $Header: util.c,v 4.0 91/03/20 01:58:25 lwall Locked $ * ! * Copyright (c) 1989, Larry Wall * ! * You may distribute under the terms of the GNU General Public License ! * as specified in the README file that comes with the perl 3.0 kit. * * $Log: util.c,v $ * Revision 4.0 91/03/20 01:58:25 lwall * 4.0 baseline. * --- 1,14 ---- ! /* $RCSfile: util.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:20:35 $ * ! * Copyright (c) 1991, Larry Wall * ! * You may distribute under the terms of either the GNU General Public ! * License or the Artistic License, as specified in the README file. * * $Log: util.c,v $ + * Revision 4.0.1.1 91/06/07 12:20:35 lwall + * patch4: new copyright notice + * * Revision 4.0 91/03/20 01:58:25 lwall * 4.0 baseline. * Index: util.h Prereq: 4.0 *** util.h.old Fri Jun 7 12:27:31 1991 --- util.h Fri Jun 7 12:27:32 1991 *************** *** 1,11 **** ! /* $Header: util.h,v 4.0 91/03/20 01:56:48 lwall Locked $ * ! * Copyright (c) 1989, Larry Wall * ! * You may distribute under the terms of the GNU General Public License ! * as specified in the README file that comes with the perl 3.0 kit. * * $Log: util.h,v $ * Revision 4.0 91/03/20 01:56:48 lwall * 4.0 baseline. * --- 1,14 ---- ! /* $RCSfile: util.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:11:00 $ * ! * Copyright (c) 1991, Larry Wall * ! * You may distribute under the terms of either the GNU General Public ! * License or the Artistic License, as specified in the README file. * * $Log: util.h,v $ + * Revision 4.0.1.1 91/06/07 12:11:00 lwall + * patch4: new copyright notice + * * Revision 4.0 91/03/20 01:56:48 lwall * 4.0 baseline. * Index: x2p/util.h Prereq: 4.0 *** x2p/util.h.old Fri Jun 7 12:28:25 1991 --- x2p/util.h Fri Jun 7 12:28:26 1991 *************** *** 1,11 **** ! /* $Header: util.h,v 4.0 91/03/20 01:58:29 lwall Locked $ * ! * Copyright (c) 1989, Larry Wall * ! * You may distribute under the terms of the GNU General Public License ! * as specified in the README file that comes with the perl 3.0 kit. * * $Log: util.h,v $ * Revision 4.0 91/03/20 01:58:29 lwall * 4.0 baseline. * --- 1,14 ---- ! /* $RCSfile: util.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:20:43 $ * ! * Copyright (c) 1991, Larry Wall * ! * You may distribute under the terms of either the GNU General Public ! * License or the Artistic License, as specified in the README file. * * $Log: util.h,v $ + * Revision 4.0.1.1 91/06/07 12:20:43 lwall + * patch4: new copyright notice + * * Revision 4.0 91/03/20 01:58:29 lwall * 4.0 baseline. * Index: hints/vax.sh *** hints/vax.sh.old Fri Jun 7 12:25:04 1991 --- hints/vax.sh Fri Jun 7 12:25:05 1991 *************** *** 0 **** --- 1 ---- + teval_cflags='case $cc in *gcc);; *) optimize="-O";; esac' Index: x2p/walk.c Prereq: 4.0 *** x2p/walk.c.old Fri Jun 7 12:28:29 1991 --- x2p/walk.c Fri Jun 7 12:28:30 1991 *************** *** 1,11 **** ! /* $Header: walk.c,v 4.0 91/03/20 01:58:36 lwall Locked $ * ! * Copyright (c) 1989, Larry Wall * ! * You may distribute under the terms of the GNU General Public License ! * as specified in the README file that comes with the perl 3.0 kit. * * $Log: walk.c,v $ * Revision 4.0 91/03/20 01:58:36 lwall * 4.0 baseline. * --- 1,15 ---- ! /* $RCSfile: walk.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:22:04 $ * ! * Copyright (c) 1991, Larry Wall * ! * You may distribute under the terms of either the GNU General Public ! * License or the Artistic License, as specified in the README file. * * $Log: walk.c,v $ + * Revision 4.0.1.1 91/06/07 12:22:04 lwall + * patch4: new copyright notice + * patch4: a2p didn't correctly implement -n switch + * * Revision 4.0 91/03/20 01:58:36 lwall * 4.0 baseline. * *************** *** 22,27 **** --- 26,32 ---- bool subretnum = FALSE; bool saw_FNR = FALSE; bool saw_argv0 = FALSE; + bool saw_fh = FALSE; int maxtmp = 0; char *lparen; char *rparen; *************** *** 60,65 **** --- 65,84 ---- type &= 255; switch (type) { case OPROG: + arymax = 0; + if (namelist) { + while (isalpha(*namelist)) { + for (d = tokenbuf,s=namelist; + isalpha(*s) || isdigit(*s) || *s == '_'; + *d++ = *s++) ; + *d = '\0'; + while (*s && !isalpha(*s)) s++; + namelist = s; + nameary[++arymax] = savestr(tokenbuf); + } + } + if (maxfld < arymax) + maxfld = arymax; opens = str_new(0); subs = str_new(0); str = walk(0,level,ops[node+1].ival,&numarg,P_MIN); *************** *** 115,134 **** str_cat(str,"chop;\t# strip record separator\n"); tab(str,level); } - arymax = 0; - if (namelist) { - while (isalpha(*namelist)) { - for (d = tokenbuf,s=namelist; - isalpha(*s) || isdigit(*s) || *s == '_'; - *d++ = *s++) ; - *d = '\0'; - while (*s && !isalpha(*s)) s++; - namelist = s; - nameary[++arymax] = savestr(tokenbuf); - } - } - if (maxfld < arymax) - maxfld = arymax; if (do_split) emit_split(str,level); str_scat(str,fstr); --- 134,139 ---- *************** *** 584,594 **** s = savestr(tokenbuf); for (t = tokenbuf; *t; t++) { *t &= 127; if (!isalpha(*t) && !isdigit(*t)) *t = '_'; } if (!index(tokenbuf,'_')) ! strcpy(t,"_fh"); tmp3str = hfetch(symtab,tokenbuf); if (!tmp3str) { do_opens = TRUE; --- 589,601 ---- s = savestr(tokenbuf); for (t = tokenbuf; *t; t++) { *t &= 127; + if (islower(*t)) + *t = toupper(*t); if (!isalpha(*t) && !isdigit(*t)) *t = '_'; } if (!index(tokenbuf,'_')) ! strcpy(t,"_FH"); tmp3str = hfetch(symtab,tokenbuf); if (!tmp3str) { do_opens = TRUE; *************** *** 1110,1120 **** s = savestr(tokenbuf); for (t = tokenbuf; *t; t++) { *t &= 127; if (!isalpha(*t) && !isdigit(*t)) *t = '_'; } if (!index(tokenbuf,'_')) ! strcpy(t,"_fh"); str_free(tmpstr); safefree(s); str_set(str,"close "); --- 1117,1129 ---- s = savestr(tokenbuf); for (t = tokenbuf; *t; t++) { *t &= 127; + if (islower(*t)) + *t = toupper(*t); if (!isalpha(*t) && !isdigit(*t)) *t = '_'; } if (!index(tokenbuf,'_')) ! strcpy(t,"_FH"); str_free(tmpstr); safefree(s); str_set(str,"close "); *************** *** 1145,1155 **** s = savestr(tokenbuf); for (t = tokenbuf; *t; t++) { *t &= 127; if (!isalpha(*t) && !isdigit(*t)) *t = '_'; } if (!index(tokenbuf,'_')) ! strcpy(t,"_fh"); tmp3str = hfetch(symtab,tokenbuf); if (!tmp3str) { str_cat(opens,"open("); --- 1154,1166 ---- s = savestr(tokenbuf); for (t = tokenbuf; *t; t++) { *t &= 127; + if (islower(*t)) + *t = toupper(*t); if (!isalpha(*t) && !isdigit(*t)) *t = '_'; } if (!index(tokenbuf,'_')) ! strcpy(t,"_FH"); tmp3str = hfetch(symtab,tokenbuf); if (!tmp3str) { str_cat(opens,"open("); *************** *** 1195,1203 **** str_cat(str,"printf"); else str_cat(str,"print"); if (len == 3 || do_fancy_opens) { ! if (*tokenbuf) str_cat(str," "); str_cat(str,tokenbuf); } tmpstr = walk(1+(type==OPRINT),level,ops[node+1].ival,&numarg,P_MIN); --- 1206,1217 ---- str_cat(str,"printf"); else str_cat(str,"print"); + saw_fh = 0; if (len == 3 || do_fancy_opens) { ! if (*tokenbuf) { str_cat(str," "); + saw_fh = 1; + } str_cat(str,tokenbuf); } tmpstr = walk(1+(type==OPRINT),level,ops[node+1].ival,&numarg,P_MIN); *************** *** 1224,1230 **** } if (*tmpstr->str_ptr) { str_cat(str," "); ! str_scat(str,tmpstr); } else { str_cat(str," $_"); --- 1238,1250 ---- } if (*tmpstr->str_ptr) { str_cat(str," "); ! if (!saw_fh && *tmpstr->str_ptr == '(') { ! str_cat(str,"("); ! str_scat(str,tmpstr); ! str_cat(str,")"); ! } ! else ! str_scat(str,tmpstr); } else { str_cat(str," $_"); Index: x2p/Makefile.SH Prereq: 4.0 *** x2p/Makefile.SH.old Fri Jun 7 12:27:40 1991 --- x2p/Makefile.SH Fri Jun 7 12:27:41 1991 *************** *** 19,27 **** esac echo "Extracting x2p/Makefile (with variable substitutions)" cat >Makefile <<!GROK!THIS! ! # $Header: Makefile.SH,v 4.0 91/03/20 01:57:03 lwall Locked $ # # $Log: Makefile.SH,v $ # Revision 4.0 91/03/20 01:57:03 lwall # 4.0 baseline. # --- 19,30 ---- esac echo "Extracting x2p/Makefile (with variable substitutions)" cat >Makefile <<!GROK!THIS! ! # $RCSfile: Makefile.SH,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:12:14 $ # # $Log: Makefile.SH,v $ + # Revision 4.0.1.1 91/06/07 12:12:14 lwall + # patch4: cflags now emits entire cc command except for the filename + # # Revision 4.0 91/03/20 01:57:03 lwall # 4.0 baseline. # *************** *** 33,39 **** lib = $lib mansrc = $mansrc manext = $manext - CFLAGS = $ccflags $optimize LDFLAGS = $ldflags SMALL = $small LARGE = $large $split --- 36,41 ---- *************** *** 45,50 **** --- 47,54 ---- cat >>Makefile <<'!NO!SUBS!' + CCCMD = `sh cflags $@` + public = a2p s2p find2perl private = *************** *** 69,81 **** SHELL = /bin/sh .c.o: ! $(CC) -c $(CFLAGS) $(LARGE) $*.c all: $(public) $(private) $(util) touch all a2p: $(obj) a2p.o ! $(CC) $(LARGE) $(LDFLAGS) $(obj) a2p.o $(libs) -o a2p a2p.c: a2p.y @ echo Expect 226 shift/reduce conflicts... --- 73,85 ---- SHELL = /bin/sh .c.o: ! $(CCCMD) $*.c all: $(public) $(private) $(util) touch all a2p: $(obj) a2p.o ! $(CC) $(LDFLAGS) $(obj) a2p.o $(libs) -o a2p a2p.c: a2p.y @ echo Expect 226 shift/reduce conflicts... *************** *** 83,89 **** mv y.tab.c a2p.c a2p.o: a2p.c a2py.c a2p.h EXTERN.h util.h INTERN.h handy.h ../config.h str.h hash.h ! $(CC) -c $(CFLAGS) $(LARGE) a2p.c install: a2p s2p # won't work with csh --- 87,93 ---- mv y.tab.c a2p.c a2p.o: a2p.c a2py.c a2p.h EXTERN.h util.h INTERN.h handy.h ../config.h str.h hash.h ! $(CCCMD) $(LARGE) a2p.c install: a2p s2p # won't work with csh *************** *** 95,110 **** for pub in $(public); do \ chmod +x `basename $$pub`; \ done - # chmod +x makedir - # - ./makedir `filexp $(lib)` - # - \ - #if test `pwd` != `filexp $(lib)`; then \ - #cp $(private) `filexp $(lib)`; \ - #fi - # cd `filexp $(lib)`; \ - #for priv in $(private); do \ - #chmod +x `basename $$priv`; \ - #done - if test `pwd` != $(mansrc); then \ for page in $(manpages); do \ cp $$page $(mansrc)/`basename $$page .man`.$(manext); \ --- 99,104 ---- *************** *** 115,121 **** rm -f a2p *.o realclean: clean ! rm -f *.orig */*.orig core $(addedbyconf) a2p.c s2p all # The following lint has practically everything turned on. Unfortunately, # you have to wade through a lot of mumbo jumbo that can't be suppressed. --- 109,115 ---- rm -f a2p *.o realclean: clean ! rm -f *.orig */*.orig core $(addedbyconf) a2p.c s2p find2perl all cflags # The following lint has practically everything turned on. Unfortunately, # you have to wade through a lot of mumbo jumbo that can't be suppressed. Index: README *** README.old Fri Jun 7 12:22:37 1991 --- README Fri Jun 7 12:22:38 1991 *************** *** 2,27 **** Perl Kit, Version 4.0 Copyright (c) 1989,1990,1991, Larry Wall This program is free software; you can redistribute it and/or modify ! it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 1, or (at your option) ! any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ! My interpretation of the GNU General Public License is that no Perl ! script falls under the terms of the License unless you explicitly put ! said script under the terms of the License yourself. Furthermore, any object code linked with uperl.o does not automatically fall under the ! terms of the License, provided such object code only adds definitions of subroutines and variables, and does not otherwise impair the resulting interpreter from executing any standard Perl script. I consider linking in C subroutines in this manner to be the moral --- 2,36 ---- Perl Kit, Version 4.0 Copyright (c) 1989,1990,1991, Larry Wall + All rights reserved. This program is free software; you can redistribute it and/or modify ! it under the terms of either: ! ! a) the GNU General Public License as published by the Free ! Software Foundation; either version 1, or (at your option) any ! later version, or + b) the "Artistic License" which comes with this Kit. + This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either ! the GNU General Public License or the Artistic License for more details. ! You should have received a copy of the Artistic License with this ! Kit, in the file named "Artistic". If not, I'll be glad to provide one. ! ! You should also have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ! For those of you that choose to use the GNU General Public License, ! my interpretation of the GNU General Public License is that no Perl ! script falls under the terms of the GPL unless you explicitly put ! said script under the terms of the GPL yourself. Furthermore, any object code linked with uperl.o does not automatically fall under the ! terms of the GPL, provided such object code only adds definitions of subroutines and variables, and does not otherwise impair the resulting interpreter from executing any standard Perl script. I consider linking in C subroutines in this manner to be the moral *************** *** 31,46 **** Public License. (This is merely an alternate way of specifying input to the program.) You may also sell a binary produced by the dumping of a running Perl script that belongs to you, provided that you provide or ! offer to provide the Perl source as specified by the License. (The fact that a Perl interpreter and your code are in the same binary file is, in this case, a form of mere aggregation.) This is my interpretation ! of the License. If you still have concerns or difficulties understanding ! my intent, feel free to contact me. -------------------------------------------------------------------------- Perl is a language that combines some of the features of C, sed, awk and shell. ! See the manual page for more hype. Perl will probably not run on machines with a small address space. --- 40,58 ---- Public License. (This is merely an alternate way of specifying input to the program.) You may also sell a binary produced by the dumping of a running Perl script that belongs to you, provided that you provide or ! offer to provide the Perl source as specified by the GPL. (The fact that a Perl interpreter and your code are in the same binary file is, in this case, a form of mere aggregation.) This is my interpretation ! of the GPL. If you still have concerns or difficulties understanding ! my intent, feel free to contact me. Of course, the Artistic License ! spells all this out for your protection, so you may prefer to use that. -------------------------------------------------------------------------- Perl is a language that combines some of the features of C, sed, awk and shell. ! See the manual page for more hype. There's also a Nutshell Handbook published ! by O'Reilly & Assoc. Their U.S. number is 1-800-338-6887 (dev-nuts) and ! their international number is 1-707-829-0515. E-mail to nuts@ora.com. Perl will probably not run on machines with a small address space. *************** *** 107,113 **** AIX/RT may need a -a switch and -DCRIPPLED_CC. AIX RS/6000 needs to use system malloc and avoid -O on eval.c and toke.c. AIX RS/6000 needs -D_NO_PROTO. ! SUNOS 4.0.[12] needs #define fputs(str,fp) fprintf(fp,"%s",str) in perl.h SUNOS 3.[45] should use the system malloc. SGI machines may need -Ddouble="long float" and -O1. Vax-based systems may need to hand assemble teval.s with a -J switch. --- 119,125 ---- AIX/RT may need a -a switch and -DCRIPPLED_CC. AIX RS/6000 needs to use system malloc and avoid -O on eval.c and toke.c. AIX RS/6000 needs -D_NO_PROTO. ! SUNOS 4.0.[12] needs -DFPUTS_BOTCH. SUNOS 3.[45] should use the system malloc. SGI machines may need -Ddouble="long float" and -O1. Vax-based systems may need to hand assemble teval.s with a -J switch. *************** *** 114,119 **** --- 126,132 ---- Ultrix on MIPS machines may need -DLANGUAGE_C. Ultrix 4.0 on MIPS machines may need -Olimit 2900 or so. Ultrix 3.[01] on MIPS needs to undefine WAITPID--the system call is busted. + MIPS machines need /bin before /bsd43/bin in PATH. MIPS machines may need to undef d_volatile. MIPS machines may need to turn off -O on cmd.c, perl.c and tperl.c. Some MIPS machines may need to undefine CASTNEGFLOAT. *************** *** 164,170 **** If possible, send in patches such that the patch program will apply them. Context diffs are the best, then normal diffs. Don't send ed scripts-- ! I've probably changed my copy since the version you have. Watch for perl patches in comp.lang.perl. Patches will generally be in a form usable by the patch program. If you are just now bringing up --- 177,184 ---- If possible, send in patches such that the patch program will apply them. Context diffs are the best, then normal diffs. Don't send ed scripts-- ! I've probably changed my copy since the version you have. It's also ! helpful if you send the output of "uname -a". Watch for perl patches in comp.lang.perl. Patches will generally be in a form usable by the patch program. If you are just now bringing up *** End of Patch 9 *** -- Kent Landfield INTERNET: kent@sparky.IMD.Sterling.COM Sterling Software, IMD UUCP: uunet!sparky!kent Phone: (402) 291-8300 FAX: (402) 291-4362 Please send comp.sources.misc-related mail to kent@uunet.uu.net.