diff options
| -rw-r--r-- | README | 46 | ||||
| -rw-r--r-- | hints/sunos_4_0_1.sh | 5 | ||||
| -rw-r--r-- | hints/sunos_4_0_2.sh | 5 | ||||
| -rw-r--r-- | hints/svr4.sh | 6 | ||||
| -rw-r--r-- | hints/ultrix_3.sh | 14 | ||||
| -rw-r--r-- | hints/ultrix_4.sh | 18 | ||||
| -rw-r--r-- | hints/vax.sh | 1 | ||||
| -rw-r--r-- | patchlevel.h | 2 | ||||
| -rw-r--r-- | stab.h | 15 | ||||
| -rw-r--r-- | str.c | 16 | ||||
| -rw-r--r-- | str.h | 11 | ||||
| -rw-r--r-- | t/op/stat.t | 19 | ||||
| -rw-r--r-- | toke.c | 92 | ||||
| -rw-r--r-- | util.c | 42 | ||||
| -rw-r--r-- | util.h | 11 | ||||
| -rw-r--r-- | x2p/Makefile.SH | 26 | ||||
| -rw-r--r-- | x2p/str.c | 11 | ||||
| -rw-r--r-- | x2p/str.h | 11 | ||||
| -rw-r--r-- | x2p/util.c | 11 | ||||
| -rw-r--r-- | x2p/util.h | 11 | ||||
| -rw-r--r-- | x2p/walk.c | 66 |
21 files changed, 277 insertions, 162 deletions
@@ -2,26 +2,35 @@ 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 the GNU General Public License as published by - the Free Software Foundation; either version 1, or (at your option) - any later version. + 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 the - GNU General Public License for more details. + 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 have received a copy of the GNU General Public License + 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. - 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 + 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 License, provided such object code only adds definitions + 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,16 +40,19 @@ 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 + 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 License. If you still have concerns or difficulties understanding - my intent, feel free to contact me. + 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. +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,13 +119,14 @@ Installation 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 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. 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,7 +177,8 @@ Installation 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. + 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 diff --git a/hints/sunos_4_0_1.sh b/hints/sunos_4_0_1.sh index 0cdff54578..7fd8c889cb 100644 --- a/hints/sunos_4_0_1.sh +++ b/hints/sunos_4_0_1.sh @@ -1,4 +1 @@ -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 +$ccflags="$ccflags -DFPUTS_BOTCH" diff --git a/hints/sunos_4_0_2.sh b/hints/sunos_4_0_2.sh index 0cdff54578..7fd8c889cb 100644 --- a/hints/sunos_4_0_2.sh +++ b/hints/sunos_4_0_2.sh @@ -1,4 +1 @@ -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 +$ccflags="$ccflags -DFPUTS_BOTCH" diff --git a/hints/svr4.sh b/hints/svr4.sh new file mode 100644 index 0000000000..eae477e807 --- /dev/null +++ b/hints/svr4.sh @@ -0,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/'` diff --git a/hints/ultrix_3.sh b/hints/ultrix_3.sh index 2057bc683c..0df47231f6 100644 --- a/hints/ultrix_3.sh +++ b/hints/ultrix_3.sh @@ -1,2 +1,14 @@ ccflags="$ccflags -DLANGUAGE_C" -d_waitpid=$undef +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 diff --git a/hints/ultrix_4.sh b/hints/ultrix_4.sh index 008e1ef82a..ffaf376272 100644 --- a/hints/ultrix_4.sh +++ b/hints/ultrix_4.sh @@ -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 + diff --git a/hints/vax.sh b/hints/vax.sh new file mode 100644 index 0000000000..ea8f224396 --- /dev/null +++ b/hints/vax.sh @@ -0,0 +1 @@ +teval_cflags='case $cc in *gcc);; *) optimize="-O";; esac' diff --git a/patchlevel.h b/patchlevel.h index a6997a9a35..618bca4808 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1 +1 @@ -#define PATCHLEVEL 8 +#define PATCHLEVEL 9 @@ -1,11 +1,15 @@ -/* $Header: stab.h,v 4.0 91/03/20 01:39:49 lwall Locked $ +/* $RCSfile: stab.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:56:35 $ * - * Copyright (c) 1989, Larry Wall + * Copyright (c) 1991, 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. + * 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,7 +97,10 @@ struct sub { #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))) @@ -1,11 +1,15 @@ -/* $RCSfile: str.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:15:30 $ +/* $RCSfile: str.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:58:13 $ * - * Copyright (c) 1989, Larry Wall + * Copyright (c) 1991, 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. + * 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,11 +373,11 @@ str_scat(dstr,sstr) STR *dstr; register STR *sstr; { + if (!sstr) + return; #ifdef TAINT tainted |= sstr->str_tainted; #endif - if (!sstr) - return; if (!(sstr->str_pok)) (void)str_2ptr(sstr); if (sstr) @@ -1,11 +1,14 @@ -/* $RCSfile: str.h,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:16:12 $ +/* $RCSfile: str.h,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:58:33 $ * - * Copyright (c) 1989, Larry Wall + * Copyright (c) 1991, 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. + * 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 * diff --git a/t/op/stat.t b/t/op/stat.t index 8ba8e54a5d..92da97af82 100644 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -1,11 +1,13 @@ #!./perl -# $Header: stat.t,v 4.0 91/03/20 01:54:55 lwall Locked $ +# $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,16 +83,25 @@ if (-e 'Op.stat.tmp') {print "ok 27\n";} else {print "not ok 27\n";} `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 ($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 (! -e '/dev/printer' || -c '/dev/printer' || -S '/dev/printer') +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 (! -e '/dev/mt0' || -b '/dev/mt0') +if ($DEV !~ /\nb.* (\S+)\n/) + {print "ok 33\n";} +elsif (-b "/dev/$1") {print "ok 33\n";} else {print "not ok 33\n";} @@ -1,11 +1,17 @@ -/* $RCSfile: toke.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:18:18 $ +/* $RCSfile: toke.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 12:05:56 $ * - * Copyright (c) 1989, Larry Wall + * Copyright (c) 1991, 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. + * 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,6 +31,10 @@ #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,13 +336,6 @@ yylex() 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(); @@ -947,7 +950,7 @@ yylex() if (strEQ(d,"oct")) UNI(O_OCT); if (strEQ(d,"opendir")) - FOP2(O_OPENDIR); + FOP2(O_OPEN_DIR); break; case 'p': case 'P': SNARFWORD; @@ -1417,7 +1420,8 @@ char *dest; } STR * -scanconst(string,len) +scanconst(spat,string,len) +SPAT *spat; char *string; int len; { @@ -1425,10 +1429,13 @@ int len; register char *t; register char *d; register char *e; + char *origstring = string; + static char *vert = "|"; - if (index(string,'|')) { + 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,6 +1495,12 @@ int len; } *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,7 +1539,7 @@ register char *s; return s; } s++; - while (*s == 'i' || *s == 'o') { + while (*s == 'i' || *s == 'o' || *s == 'g') { if (*s == 'i') { s++; sawi = TRUE; @@ -1536,6 +1549,10 @@ register char *s; 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,23 +1592,7 @@ register char *s; #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; - } - } + 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,17 +1671,7 @@ register char *s; 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; - } + scanconst(spat,str->str_ptr,len); get_repl: s = scanstr(s); if (s >= bufend) { @@ -1690,7 +1681,6 @@ get_repl: 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) { @@ -1719,7 +1709,7 @@ get_repl: } if (*s == 'g') { s++; - spat->spat_flags &= ~SPAT_ONCE; + spat->spat_flags |= SPAT_GLOBAL; } if (*s == 'i') { s++; @@ -1751,7 +1741,14 @@ get_repl: hoistmust(spat) register SPAT *spat; { - if (spat->spat_regexp->regmust) { /* is there a better short-circuit? */ + 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,6 +2116,7 @@ register char *s; STR *tmpstr; char *tmps; + CLINE; multi_start = curcmd->c_line; if (hereis) multi_open = multi_close = '<'; @@ -1,11 +1,18 @@ -/* $RCSfile: util.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:19:25 $ +/* $RCSfile: util.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 12:10:42 $ * - * Copyright (c) 1989, Larry Wall + * Copyright (c) 1991, 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. + * 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,9 +67,9 @@ MEM_SIZE size; #endif /* MSDOS */ { char *ptr; -#ifndef __STDC__ +#ifndef STANDARD_C char *malloc(); -#endif /* ! __STDC__ */ +#endif /* ! STANDARD_C */ #ifdef MSDOS if (size > 0xffff) { @@ -108,9 +115,9 @@ unsigned long size; #endif /* MSDOS */ { char *ptr; -#ifndef __STDC__ +#ifndef STANDARD_C char *realloc(); -#endif /* ! __STDC__ */ +#endif /* ! STANDARD_C */ #ifdef MSDOS if (size > 0xffff) { @@ -514,9 +521,12 @@ STR *littlestr; register unsigned char *oldlittle; #ifndef lint - if (!(littlestr->str_pok & SP_FBM)) + 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,11 +861,13 @@ va_list args; { char *pat; char *s; +#ifndef HAS_VPRINTF #ifdef CHARVSPRINTF char *vsprintf(); #else int vsprintf(); #endif +#endif s = buf; #ifdef lint @@ -1196,6 +1208,12 @@ char *mode; 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,13 +1232,13 @@ char *mode; close(p[THIS]); } if (doexec) { -#if !defined(I_FCNTL) || !defined(F_SETFD) +#if !defined(HAS_FCNTL) || !defined(F_SETFD) int fd; #ifndef NOFILE #define NOFILE 20 #endif - for (fd = 3; fd < NOFILE; fd++) + for (fd = maxsysfd + 1; fd < NOFILE; fd++) close(fd); #endif do_exec(cmd); /* may or may not use the shell */ @@ -1273,7 +1291,7 @@ int newfd; close(newfd); fcntl(oldfd, F_DUPFD, newfd); #else - int fdtmp[20]; + int fdtmp[256]; int fdx = 0; int fd; @@ -1,11 +1,14 @@ -/* $Header: util.h,v 4.0 91/03/20 01:56:48 lwall Locked $ +/* $RCSfile: util.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:11:00 $ * - * Copyright (c) 1989, Larry Wall + * Copyright (c) 1991, 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. + * 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. * diff --git a/x2p/Makefile.SH b/x2p/Makefile.SH index 82b14239ad..f4a1c665a4 100644 --- a/x2p/Makefile.SH +++ b/x2p/Makefile.SH @@ -19,9 +19,12 @@ case "$mallocsrc" in 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 $ +# $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,7 +36,6 @@ bin = $bin lib = $lib mansrc = $mansrc manext = $manext -CFLAGS = $ccflags $optimize LDFLAGS = $ldflags SMALL = $small LARGE = $large $split @@ -45,6 +47,8 @@ libs = $libs cat >>Makefile <<'!NO!SUBS!' +CCCMD = `sh cflags $@` + public = a2p s2p find2perl private = @@ -69,13 +73,13 @@ addedbyconf = Makefile.old bsd eunice filexp loc pdp11 usg v7 SHELL = /bin/sh .c.o: - $(CC) -c $(CFLAGS) $(LARGE) $*.c + $(CCCMD) $*.c all: $(public) $(private) $(util) touch all a2p: $(obj) a2p.o - $(CC) $(LARGE) $(LDFLAGS) $(obj) a2p.o $(libs) -o a2p + $(CC) $(LDFLAGS) $(obj) a2p.o $(libs) -o a2p a2p.c: a2p.y @ echo Expect 226 shift/reduce conflicts... @@ -83,7 +87,7 @@ a2p.c: a2p.y 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 + $(CCCMD) $(LARGE) a2p.c install: a2p s2p # won't work with csh @@ -95,16 +99,6 @@ install: a2p s2p 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); \ @@ -115,7 +109,7 @@ clean: rm -f a2p *.o realclean: clean - rm -f *.orig */*.orig core $(addedbyconf) a2p.c s2p all + 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. @@ -1,11 +1,14 @@ -/* $Header: str.c,v 4.0 91/03/20 01:58:15 lwall Locked $ +/* $RCSfile: str.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:20:08 $ * - * Copyright (c) 1989, Larry Wall + * Copyright (c) 1991, 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. + * 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. * @@ -1,11 +1,14 @@ -/* $Header: str.h,v 4.0 91/03/20 01:58:21 lwall Locked $ +/* $RCSfile: str.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:20:22 $ * - * Copyright (c) 1989, Larry Wall + * Copyright (c) 1991, 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. + * 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. * diff --git a/x2p/util.c b/x2p/util.c index d1ba317677..7c2485aab1 100644 --- a/x2p/util.c +++ b/x2p/util.c @@ -1,11 +1,14 @@ -/* $Header: util.c,v 4.0 91/03/20 01:58:25 lwall Locked $ +/* $RCSfile: util.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:20:35 $ * - * Copyright (c) 1989, Larry Wall + * Copyright (c) 1991, 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. + * 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. * diff --git a/x2p/util.h b/x2p/util.h index d682ee1d4b..f8a686bd7f 100644 --- a/x2p/util.h +++ b/x2p/util.h @@ -1,11 +1,14 @@ -/* $Header: util.h,v 4.0 91/03/20 01:58:29 lwall Locked $ +/* $RCSfile: util.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:20:43 $ * - * Copyright (c) 1989, Larry Wall + * Copyright (c) 1991, 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. + * 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. * diff --git a/x2p/walk.c b/x2p/walk.c index 3dd4a1a266..f38968b0d5 100644 --- a/x2p/walk.c +++ b/x2p/walk.c @@ -1,11 +1,15 @@ -/* $Header: walk.c,v 4.0 91/03/20 01:58:36 lwall Locked $ +/* $RCSfile: walk.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:22:04 $ * - * Copyright (c) 1989, Larry Wall + * Copyright (c) 1991, 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. + * 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,6 +26,7 @@ bool saw_getline = FALSE; bool subretnum = FALSE; bool saw_FNR = FALSE; bool saw_argv0 = FALSE; +bool saw_fh = FALSE; int maxtmp = 0; char *lparen; char *rparen; @@ -60,6 +65,20 @@ int minprec; /* minimum precedence without parens */ 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,20 +134,6 @@ int minprec; /* minimum precedence without parens */ 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); @@ -584,11 +589,13 @@ sub Pick {\n\ 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"); + strcpy(t,"_FH"); tmp3str = hfetch(symtab,tokenbuf); if (!tmp3str) { do_opens = TRUE; @@ -1110,11 +1117,13 @@ sub Pick {\n\ 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"); + strcpy(t,"_FH"); str_free(tmpstr); safefree(s); str_set(str,"close "); @@ -1145,11 +1154,13 @@ sub Pick {\n\ 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"); + strcpy(t,"_FH"); tmp3str = hfetch(symtab,tokenbuf); if (!tmp3str) { str_cat(opens,"open("); @@ -1195,9 +1206,12 @@ sub Pick {\n\ str_cat(str,"printf"); else str_cat(str,"print"); + saw_fh = 0; if (len == 3 || do_fancy_opens) { - if (*tokenbuf) + 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,7 +1238,13 @@ sub Pick {\n\ } if (*tmpstr->str_ptr) { str_cat(str," "); - str_scat(str,tmpstr); + 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," $_"); |