Xref: utzoo comp.sources.bugs:2942 comp.lang.perl:5615 Path: utzoo!utgpu!news-server.csri.toronto.edu!rpi!usc!elroy.jpl.nasa.gov!jpl-devvax!lwall From: lwall@jpl-devvax.jpl.nasa.gov (Larry Wall) Newsgroups: comp.sources.bugs,comp.lang.perl Subject: perl 4.0 patch #9 Summary: This is an official patch for perl 4.0. Please apply it. Message-ID: <1991Jun8.010933.27295@jpl-devvax.jpl.nasa.gov> Date: 8 Jun 91 01:09:33 GMT Organization: NetLabs, Inc. Lines: 1494 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 #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 #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 < 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 <Makefile <>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 ***