summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLarry Wall <lwall@jpl-devvax.jpl.nasa.gov>1989-11-10 16:20:57 +0000
committerLarry Wall <lwall@jpl-devvax.jpl.nasa.gov>1989-11-10 16:20:57 +0000
commitae98613044a1084886d80b8283b25bad38cfd171 (patch)
tree7dfe17f2ae5835a17db41a0bb4d7ef903d6ff3d9
parentbf38876a182e0df9dd73362f56cf0ab8b43aa789 (diff)
downloadperl-ae98613044a1084886d80b8283b25bad38cfd171.tar.gz
perl 3.0 patch #4 Patch #2 continued
-rw-r--r--patchlevel.h2
-rw-r--r--perl.h58
-rw-r--r--perl.man.117
-rw-r--r--perl.man.280
-rw-r--r--perl.man.354
-rw-r--r--perl.man.428
-rw-r--r--perl.y54
-rw-r--r--perly.c20
-rw-r--r--regcomp.c6
-rw-r--r--regexec.c9
-rw-r--r--stab.c7
-rw-r--r--str.c25
-rw-r--r--toke.c28
-rw-r--r--util.c39
-rw-r--r--x2p/s2p.SH13
-rw-r--r--x2p/walk.c7
16 files changed, 331 insertions, 116 deletions
diff --git a/patchlevel.h b/patchlevel.h
index 558d48cd9b..82d4f629a7 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 3
+#define PATCHLEVEL 4
diff --git a/perl.h b/perl.h
index 4808d56329..2f7131f516 100644
--- a/perl.h
+++ b/perl.h
@@ -1,4 +1,4 @@
-/* $Header: perl.h,v 3.0.1.1 89/10/26 23:17:08 lwall Locked $
+/* $Header: perl.h,v 3.0.1.2 89/11/11 04:39:38 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
@@ -6,6 +6,12 @@
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: perl.h,v $
+ * Revision 3.0.1.2 89/11/11 04:39:38 lwall
+ * patch2: Configure may now set -DDEBUGGING
+ * patch2: netinet/in.h needed sys/types.h some places
+ * patch2: more <sys/time.h> and <time.h> wrangling
+ * patch2: yydebug moved to where type doesn't matter
+ *
* Revision 3.0.1.1 89/10/26 23:17:08 lwall
* patch1: vfork now conditionally defined based on VFORK
* patch1: DEC risc machines have a buggy memcmp
@@ -16,10 +22,6 @@
*
*/
-#ifndef lint
-#define DEBUGGING
-#endif
-
#define VOIDUSED 1
#include "config.h"
@@ -51,26 +53,25 @@ extern char *memcpy(), *memset();
#include <setjmp.h>
#include <sys/param.h> /* if this needs types.h we're still wrong */
-#ifdef I_NETINET_IN
-#include <netinet/in.h>
-#endif
-
#ifndef _TYPES_ /* If types.h defines this it's easy. */
#ifndef major /* Does everyone's types.h define this? */
#include <sys/types.h>
#endif
#endif
+#ifdef I_NETINET_IN
+#include <netinet/in.h>
+#endif
+
#include <sys/stat.h>
-#ifdef TMINSYS
+#if defined(TMINSYS) || defined(I_SYSTIME)
#include <sys/time.h>
-#else
-#ifdef I_SYSTIME
-#include <sys/time.h>
-#else
+#ifdef TIMETOO
#include <time.h>
#endif
+#else
+#include <time.h>
#endif
#include <sys/times.h>
@@ -93,6 +94,9 @@ extern char *memcpy(), *memset();
#ifdef NDBM
#include <ndbm.h>
#define SOME_DBM
+#ifdef ODBM
+#undef ODBM
+#endif
#else
#ifdef ODBM
#ifdef NULL
@@ -129,7 +133,11 @@ EXT int dbmlen;
#define DIRENT dirent
#else
#ifdef I_SYSDIR
+#ifdef hp9000s500
+#include <ndir.h> /* may be wrong in the future */
+#else
#include <sys/dir.h>
+#endif
#define DIRENT direct
#endif
#endif
@@ -233,8 +241,20 @@ EXT STR *Str;
#define BYTEORDER 01234
#endif
+#if defined(htonl) && !defined(HTONL)
+#define HTONL
+#endif
+#if defined(htons) && !defined(HTONS)
+#define HTONS
+#endif
+#if defined(ntohl) && !defined(NTOHL)
+#define NTOHL
+#endif
+#if defined(ntohs) && !defined(NTOHS)
+#define NTOHS
+#endif
#ifndef HTONL
-#if BYTEORDER != 04321
+#if (BYTEORDER != 04321) && (BYTEORDER != 087654321)
#define HTONS
#define HTONL
#define NTOHS
@@ -246,7 +266,7 @@ EXT STR *Str;
#define ntohl my_ntohl
#endif
#else
-#if BYTEORDER == 04321
+#if (BYTEORDER == 04321) || (BYTEORDER == 087654321)
#undef HTONS
#undef HTONL
#undef NTOHS
@@ -419,7 +439,10 @@ EXT bool sawstudy INIT(FALSE); /* do fbminstr on all strings */
EXT bool sawi INIT(FALSE); /* study must assume case insensitive */
EXT bool sawvec INIT(FALSE);
-EXT int csh INIT(0); /* 1 if /bin/csh is there, -1 if not */
+#ifdef CSH
+char *cshname INIT(CSH);
+int cshlen INIT(0);
+#endif /* CSH */
#ifdef TAINT
EXT bool tainted INIT(FALSE); /* using variables controlled by $< */
@@ -469,7 +492,6 @@ EXT int dlmax INIT(128);
EXT char *debname;
EXT char *debdelim;
#define YYDEBUG 1
-extern int yydebug;
#endif
EXT int perldb INIT(0);
diff --git a/perl.man.1 b/perl.man.1
index 3aec9684a3..f61350bf74 100644
--- a/perl.man.1
+++ b/perl.man.1
@@ -1,7 +1,11 @@
.rn '' }`
-''' $Header: perl.man.1,v 3.0 89/10/18 15:21:29 lwall Locked $
+''' $Header: perl.man.1,v 3.0.1.1 89/11/11 04:41:22 lwall Locked $
'''
''' $Log: perl.man.1,v $
+''' Revision 3.0.1.1 89/11/11 04:41:22 lwall
+''' patch2: explained about sh and ${1+"$@"}
+''' patch2: documented that space must separate word and '' string
+'''
''' Revision 3.0 89/10/18 15:21:29 lwall
''' 3.0 baseline
'''
@@ -347,6 +351,12 @@ After
.I perl
locates the script, it parses the lines and ignores them because
the variable $running_under_some_shell is never true.
+A better construct than $* would be ${1+"$@"}, which handles embedded spaces
+and such in the filenames, but doesn't work if the script is being interpreted
+by csh.
+In order to start up sh rather than csh, some systems may have to replace the
+#! line with a line containing just
+a colon, which will be politely ignored by perl.
.TP 5
.B \-u
causes
@@ -531,6 +541,9 @@ The following code segment prints out \*(L"The price is $100.\*(R"
.fi
Note that you can put curly brackets around the identifier to delimit it
from following alphanumerics.
+Also note that a single quoted string must be separated from a preceding
+word by a space, since single quote is a valid character in an identifier
+(see Packages).
.PP
Array values are interpolated into double-quoted strings by joining all the
elements of the array with the delimiter specified in the $" variable,
@@ -549,7 +562,7 @@ The following are equivalent:
system "echo @ARGV";
.fi
-Within search patterns (which also undergo double-quoteish substitution)
+Within search patterns (which also undergo double-quotish substitution)
there is a bad ambiguity: Is /$foo[bar]/ to be
interpreted as /${foo}[bar]/ (where [bar] is a character class for the
regular expression) or as /${foo[bar]}/ (where [bar] is the subscript to
diff --git a/perl.man.2 b/perl.man.2
index 8e26ef2bc4..c310cfce93 100644
--- a/perl.man.2
+++ b/perl.man.2
@@ -1,7 +1,11 @@
''' Beginning of part 2
-''' $Header: perl.man.2,v 3.0 89/10/18 15:21:37 lwall Locked $
+''' $Header: perl.man.2,v 3.0.1.1 89/11/11 04:43:10 lwall Locked $
'''
''' $Log: perl.man.2,v $
+''' Revision 3.0.1.1 89/11/11 04:43:10 lwall
+''' patch2: made some line breaks depend on troff vs. nroff
+''' patch2: example of unshift had args backwards
+'''
''' Revision 3.0 89/10/18 15:21:37 lwall
''' 3.0 baseline
'''
@@ -124,7 +128,13 @@ Here's an example of looking up non-numeric uids:
print "Files: "
$pattern = <STDIN>;
chop($pattern);
+.ie t \{\
open(pass, \'/etc/passwd\') || die "Can't open passwd: $!\en";
+'br\}
+.el \{\
+ open(pass, \'/etc/passwd\')
+ || die "Can't open passwd: $!\en";
+'br\}
while (<pass>) {
($login,$pass,$uid,$gid) = split(/:/);
$uid{$login} = $uid;
@@ -287,7 +297,13 @@ Equivalent examples:
.nf
.ne 3
+.ie t \{\
die "Can't cd to spool: $!\en" unless chdir \'/usr/spool/news\';
+'br\}
+.el \{\
+ die "Can't cd to spool: $!\en"
+ unless chdir \'/usr/spool/news\';
+'br\}
chdir \'/usr/spool/news\' || die "Can't cd to spool: $!\en"
@@ -559,6 +575,7 @@ Argument processing and value return works just like ioctl below.
Note that fcntl will produce a fatal error if used on a machine that doesn't implement
fcntl(2).
.Ip "fileno(FILEHANDLE)" 8 4
+.Ip "fileno FILEHANDLE" 8 4
Returns the file descriptor for a filehandle.
Useful for constructing bitmaps for select().
If FILEHANDLE is an expression, the value is taken as the name of
@@ -621,7 +638,13 @@ Returns the packed sockaddr address of other end of the SOCKET connection.
# An internet sockaddr
$sockaddr = 'S n a4 x8';
$hersockaddr = getpeername(S);
+.ie t \{\
($family, $port, $heraddr) = unpack($sockaddr,$hersockaddr);
+'br\}
+.el \{\
+ ($family, $port, $heraddr) =
+ unpack($sockaddr,$hersockaddr);
+'br\}
.fi
.Ip "getpgrp(PID)" 8 4
@@ -650,24 +673,24 @@ getpriority(2).
.Ip "getnetbyaddr(ADDR,ADDRTYPE)" 8
.Ip "getprotobynumber(NUMBER)" 8
.Ip "getservbyport(PORT,PROTO)" 8
-.Ip "getpwent()" 8
-.Ip "getgrent()" 8
-.Ip "gethostent()" 8
-.Ip "getnetent()" 8
-.Ip "getprotoent()" 8
-.Ip "getservent()" 8
-.Ip "setpwent()" 8
-.Ip "setgrent()" 8
+.Ip "getpwent" 8
+.Ip "getgrent" 8
+.Ip "gethostent" 8
+.Ip "getnetent" 8
+.Ip "getprotoent" 8
+.Ip "getservent" 8
+.Ip "setpwent" 8
+.Ip "setgrent" 8
.Ip "sethostent(STAYOPEN)" 8
.Ip "setnetent(STAYOPEN)" 8
.Ip "setprotoent(STAYOPEN)" 8
.Ip "setservent(STAYOPEN)" 8
-.Ip "endpwent()" 8
-.Ip "endgrent()" 8
-.Ip "endhostent()" 8
-.Ip "endnetent()" 8
-.Ip "endprotoent()" 8
-.Ip "endservent()" 8
+.Ip "endpwent" 8
+.Ip "endgrent" 8
+.Ip "endhostent" 8
+.Ip "endnetent" 8
+.Ip "endprotoent" 8
+.Ip "endservent" 8
These routines perform the same functions as their counterparts in the
system library.
The return values from the various get routines are as follows:
@@ -702,7 +725,13 @@ Returns the packed sockaddr address of this end of the SOCKET connection.
# An internet sockaddr
$sockaddr = 'S n a4 x8';
$mysockaddr = getsockname(S);
+.ie t \{\
($family, $port, $myaddr) = unpack($sockaddr,$mysockaddr);
+'br\}
+.el \{\
+ ($family, $port, $myaddr) =
+ unpack($sockaddr,$mysockaddr);
+'br\}
.fi
.Ip "getsockopt(SOCKET,LEVEL,OPTNAME)" 8 3
@@ -715,7 +744,13 @@ Typically used as follows:
.nf
.ne 3
+.ie t \{\
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time);
+'br\}
+.el \{\
+ ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
+ gmtime(time);
+'br\}
.fi
All array elements are numeric, and come straight out of a struct tm.
@@ -818,7 +853,13 @@ separated by the value of EXPR, and returns the string.
Example:
.nf
+.ie t \{\
$_ = join(\|\':\', $login,$passwd,$uid,$gid,$gcos,$home,$shell);
+'br\}
+.el \{\
+ $_ = join(\|\':\',
+ $login,$passwd,$uid,$gid,$gcos,$home,$shell);
+'br\}
.fi
See
@@ -929,7 +970,7 @@ Examples:
if ($sw eq \'-v\') {
# init local array with global array
local(@ARGV) = @ARGV;
- unshift(\'echo\',@ARGV);
+ unshift(@ARGV,\'echo\');
system @ARGV;
}
# @ARGV restored
@@ -954,7 +995,13 @@ Typically used as follows:
.nf
.ne 3
+.ie t \{\
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
+'br\}
+.el \{\
+ ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
+ localtime(time);
+'br\}
.fi
All array elements are numeric, and come straight out of a struct tm.
@@ -970,6 +1017,7 @@ If EXPR is omitted, returns log of $_.
.Ip "lstat(FILEHANDLE)" 8 6
.Ip "lstat FILEHANDLE" 8
.Ip "lstat(EXPR)" 8
+.Ip "lstat SCALARVARIABLE" 8
Does the same thing as the stat() function, but stats a symbolic link
instead of the file the symbolic link points to.
If symbolic links are unimplemented on your system, a normal stat is done.
diff --git a/perl.man.3 b/perl.man.3
index 179bc3cee8..456c228ad9 100644
--- a/perl.man.3
+++ b/perl.man.3
@@ -1,7 +1,10 @@
''' Beginning of part 3
-''' $Header: perl.man.3,v 3.0 89/10/18 15:21:46 lwall Locked $
+''' $Header: perl.man.3,v 3.0.1.1 89/11/11 04:45:06 lwall Locked $
'''
''' $Log: perl.man.3,v $
+''' Revision 3.0.1.1 89/11/11 04:45:06 lwall
+''' patch2: made some line breaks depend on troff vs. nroff
+'''
''' Revision 3.0 89/10/18 15:21:46 lwall
''' 3.0 baseline
'''
@@ -71,11 +74,29 @@ Examples:
open article || die "Can't find article $article: $!\en";
while (<article>) {\|.\|.\|.
+.ie t \{\
open(LOG, \'>>/usr/spool/news/twitlog\'\|); # (log is reserved)
+'br\}
+.el \{\
+ open(LOG, \'>>/usr/spool/news/twitlog\'\|);
+ # (log is reserved)
+'br\}
+.ie t \{\
open(article, "caesar <$article |"\|); # decrypt article
+'br\}
+.el \{\
+ open(article, "caesar <$article |"\|);
+ # decrypt article
+'br\}
+.ie t \{\
open(extract, "|sort >/tmp/Tmp$$"\|); # $$ is our process#
+'br\}
+.el \{\
+ open(extract, "|sort >/tmp/Tmp$$"\|);
+ # $$ is our process#
+'br\}
.ne 7
# process argument list of files along with any includes
@@ -91,7 +112,12 @@ Examples:
print STDERR "Can't open $filename: $!\en";
return;
}
+.ie t \{\
while (<$input>) { # note the use of indirection
+'br\}
+.el \{\
+ while (<$input>) { # note use of indirection
+'br\}
if (/^#include "(.*)"/) {
do process($1, $input);
next;
@@ -105,10 +131,12 @@ You may also, in the Bourne shell tradition, specify an EXPR beginning
with \*(L">&\*(R", in which case the rest of the string
is interpreted as the name of a filehandle
(or file descriptor, if numeric) which is to be duped and opened.
+You may use & after >, >>, <, +>, +>> and +<.
+The mode you specify should match the mode of the original filehandle.
Here is a script that saves, redirects, and restores
.I STDOUT
and
-.IR STDIN :
+.IR STDERR :
.nf
.ne 21
@@ -229,7 +257,7 @@ Examples:
$foo = pack("a14","abcdefg");
# "abcdefg\e0\e0\e0\e0\e0\e0\e0"
- $foo = pack("i9pl", gmtime());
+ $foo = pack("i9pl", gmtime);
# a real struct tm (on my system anyway)
.fi
@@ -312,6 +340,7 @@ FILEHANDLE.
Returns the number of bytes actually read.
SCALAR will be grown or shrunk to the length actually read.
.Ip "readdir(DIRHANDLE)" 8 3
+.Ip "readdir DIRHANDLE" 8
Returns the next directory entry for a directory opened by opendir().
If used in an array context, returns all the rest of the entries in the
directory.
@@ -535,7 +564,13 @@ The usual idiom is:
or to block until something becomes ready:
+.ie t \{\
$nfound = select($rout=$rin, $wout=$win, $eout=$ein, undef);
+'br\}
+.el \{\
+ $nfound = select($rout=$rin, $wout=$win,
+ $eout=$ein, undef);
+'br\}
.fi
Any of the bitmasks can also be undef.
@@ -731,9 +766,10 @@ Sets the random number seed for the
.I rand
operator.
If EXPR is omitted, does srand(time).
-.Ip "stat(FILEHANDLE)" 8 6
+.Ip "stat(FILEHANDLE)" 8 8
.Ip "stat FILEHANDLE" 8
.Ip "stat(EXPR)" 8
+.Ip "stat SCALARVARIABLE" 8
Returns a 13-element array giving the statistics for a file, either the file
opened via FILEHANDLE, or named by EXPR.
Typically used as follows:
@@ -830,7 +866,7 @@ If OFFSET is negative, starts that far from the end of the string.
You can use the substr() function as an lvalue, in which case EXPR must
be an lvalue.
If you assign something shorter than LEN, the string will shrink, and
-if you assign something longer than LEN, the string will grow to accomodate it.
+if you assign something longer than LEN, the string will grow to accommodate it.
To keep the string the same length you may need to pad or chop your value using
sprintf().
.Ip "syscall(LIST)" 8 6
@@ -925,6 +961,7 @@ Examples:
.fi
.Ip "umask(EXPR)" 8 4
.Ip "umask EXPR" 8
+.Ip "umask" 8
Sets the umask for the process and returns the old one.
If EXPR is omitted, merely returns current umask.
.Ip "undef(EXPR)" 8 6
@@ -1038,8 +1075,11 @@ This interpretation is not enabled unless there is at least one vec() in
your program, to protect older programs.
.Ip "wait" 8 6
Waits for a child process to terminate and returns the pid of the deceased
-process.
+process, or -1 if there are no child processes.
The status is returned in $?.
+If you expected a child and didn't find it, you probably had a call to
+system, a close on a pipe, or backticks between the fork and the wait.
+These constructs also do a wait and may have harvested your child process.
.Ip "wantarray" 8 4
Returns true if the context of the currently executing subroutine
is looking for an array value.
@@ -1054,7 +1094,7 @@ Returns false if the context is looking for a scalar.
Produces a message on STDERR just like \*(L"die\*(R", but doesn't exit.
.Ip "write(FILEHANDLE)" 8 6
.Ip "write(EXPR)" 8
-.Ip "write(\|)" 8
+.Ip "write" 8
Writes a formatted record (possibly multi-line) to the specified file,
using the format associated with that file.
By default the format for a file is the one having the same name is the
diff --git a/perl.man.4 b/perl.man.4
index af423de2cc..5d3b8c91bd 100644
--- a/perl.man.4
+++ b/perl.man.4
@@ -1,7 +1,11 @@
''' Beginning of part 4
-''' $Header: perl.man.4,v 3.0.1.1 89/10/26 23:18:43 lwall Locked $
+''' $Header: perl.man.4,v 3.0.1.2 89/11/11 04:46:40 lwall Locked $
'''
''' $Log: perl.man.4,v $
+''' Revision 3.0.1.2 89/11/11 04:46:40 lwall
+''' patch2: made some line breaks depend on troff vs. nroff
+''' patch2: clarified operation of ^ and $ when $* is false
+'''
''' Revision 3.0.1.1 89/10/26 23:18:43 lwall
''' patch1: documented the desirability of unnecessary parentheses
'''
@@ -218,7 +222,7 @@ You can actually assign to *name anywhere, but the previous referent of
This may or may not bother you.
.Sp
Note that scalars are already passed by reference, so you can modify scalar
-arguments without using this mechanism by refering explicitly to the $_[nnn]
+arguments without using this mechanism by referring explicitly to the $_[nnn]
in question.
You can modify all the elements of an array by passing all the elements
as scalars, but you have to use the * mechanism to push, pop or change the
@@ -267,12 +271,14 @@ Examples:
}
.fi
-By default, the ^ character matches only the beginning of the string,
-the $ character matches only at the end (or before the newline at the end)
+By default, the ^ character is only guaranteed to match at the beginning
+of the string,
+the $ character only at the end (or before the newline at the end)
and
.I perl
does certain optimizations with the assumption that the string contains
only one line.
+The behavior of ^ and $ on embedded newlines will be inconsistent.
You may, however, wish to treat a string as a multi-line buffer, such that
the ^ will match after any newline within the string, and $ will match
before any newline.
@@ -477,7 +483,13 @@ Here is a sample client (untested):
($name, $aliases, $proto) = getprotobyname('tcp');
($name, $aliases, $port) = getservbyname($port, 'tcp')
unless $port =~ /^\ed+$/;;
+.ie t \{\
($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname);
+'br\}
+.el \{\
+ ($name, $aliases, $type, $len, $thisaddr) =
+ gethostbyname($hostname);
+'br\}
($name, $aliases, $type, $len, $thataddr) = gethostbyname($them);
$this = pack($sockaddr, &AF_INET, 0, $thisaddr);
@@ -532,7 +544,7 @@ And here's a server:
($addr = accept(NS,S)) || die $!;
print "accept ok\en";
- ($af,$port,$inetaddr) = unpack($pat,$addr);
+ ($af,$port,$inetaddr) = unpack($sockaddr,$addr);
@inetaddr = unpack('C4',$inetaddr);
print "$af $port @inetaddr\en";
@@ -1035,7 +1047,7 @@ machine, test the construct in an eval to see if it fails.
If you know what version or patchlevel a particular feature was implemented,
you can test $] to see if it will be there.
.Ip 4. 4 4
-Choose mnemonic indentifiers.
+Choose mnemonic identifiers.
.Ip 5. 4 4
Be consistent.
.Sh "Debugging"
@@ -1219,7 +1231,7 @@ of an array can be tainted, and others not.
If you try to do something insecure, you will get a fatal error saying
something like \*(L"Insecure dependency\*(R" or \*(L"Insecure PATH\*(R".
Note that you can still write an insecure system call or exec,
-but only by explicity doing something like the last example above.
+but only by explicitly doing something like the last example above.
You can also bypass the tainting mechanism by referencing
subpatterns\*(--\c
.I perl
@@ -1373,7 +1385,7 @@ The following variables work differently
OFS \h'|2.5i'$,
ORS \h'|2.5i'$\e
RLENGTH \h'|2.5i'length($&)
- RS \h'|2.5i'$/
+ RS \h'|2.5i'$\/
RSTART \h'|2.5i'length($\`)
SUBSEP \h'|2.5i'$;
diff --git a/perl.y b/perl.y
index 05e5a68990..2b1e91748f 100644
--- a/perl.y
+++ b/perl.y
@@ -1,4 +1,4 @@
-/* $Header: perl.y,v 3.0.1.1 89/10/26 23:20:41 lwall Locked $
+/* $Header: perl.y,v 3.0.1.2 89/11/11 04:49:04 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
@@ -6,6 +6,12 @@
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: perl.y,v $
+ * Revision 3.0.1.2 89/11/11 04:49:04 lwall
+ * patch2: moved yydebug to where its type doesn't matter
+ * patch2: !$foo++ was unreasonably illegal
+ * patch2: local(@foo) didn't work
+ * patch2: default args to unary operators didn't work
+ *
* Revision 3.0.1.1 89/10/26 23:20:41 lwall
* patch1: grandfathered "format stdout"
* patch1: operator(); is now normally equivalent to operator;
@@ -82,11 +88,17 @@ ARG *arg5;
%% /* RULES */
-prog : lineseq
+prog : /* NULL */
+ {
+#if defined(YYDEBUG) && defined(DEBUGGING)
+ yydebug = (debug & 1);
+#endif
+ }
+ /*CONTINUED*/ lineseq
{ if (in_eval)
- eval_root = block_head($1);
+ eval_root = block_head($2);
else
- main_root = block_head($1); }
+ main_root = block_head($2); }
;
compblock: block CONTINUE block
@@ -379,18 +391,6 @@ sexpr : sexpr '=' sexpr
{ $$ = mod_match(O_MATCH, $1, $3); }
| sexpr NMATCH sexpr
{ $$ = mod_match(O_NMATCH, $1, $3); }
- | term INC
- { $$ = addflags(1, AF_POST|AF_UP,
- l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
- | term DEC
- { $$ = addflags(1, AF_POST,
- l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
- | INC term
- { $$ = addflags(1, AF_PRE|AF_UP,
- l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
- | DEC term
- { $$ = addflags(1, AF_PRE,
- l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
| term
{ $$ = $1; }
;
@@ -403,6 +403,18 @@ term : '-' term %prec UMINUS
{ $$ = make_op(O_NOT, 1, $2, Nullarg, Nullarg); }
| '~' term
{ $$ = make_op(O_COMPLEMENT, 1, $2, Nullarg, Nullarg);}
+ | term INC
+ { $$ = addflags(1, AF_POST|AF_UP,
+ l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
+ | term DEC
+ { $$ = addflags(1, AF_POST,
+ l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
+ | INC term
+ { $$ = addflags(1, AF_PRE|AF_UP,
+ l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
+ | DEC term
+ { $$ = addflags(1, AF_PRE,
+ l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
| FILETEST WORD
{ opargs[$1] = 0; /* force it special */
$$ = make_op($1, 1,
@@ -419,9 +431,9 @@ term : '-' term %prec UMINUS
$1 == O_FTTTY?stabent("STDIN",TRUE):defstab),
Nullarg, Nullarg); }
| LOCAL '(' expr ')'
- { $$ = l(make_op(O_ITEM, 1,
+ { $$ = l(localize(make_op(O_ASSIGN, 1,
localize(listish(make_list($3))),
- Nullarg,Nullarg)); }
+ Nullarg,Nullarg))); }
| '(' expr ')'
{ $$ = make_list(hide_ary($2)); }
| '(' ')'
@@ -533,7 +545,7 @@ term : '-' term %prec UMINUS
{ $$ = make_op($1,1,cval_to_arg($2),
Nullarg,Nullarg); }
| UNIOP
- { $$ = make_op($1,1,Nullarg,Nullarg,Nullarg);
+ { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg);
if ($1 == O_EVAL || $1 == O_RESET)
$$ = fixeval($$); }
| UNIOP sexpr
@@ -642,8 +654,10 @@ term : '-' term %prec UMINUS
Nullarg, Nullarg)); }
| FUNC0
{ $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
+ | FUNC0 '(' ')'
+ { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
| FUNC1 '(' ')'
- { $$ = make_op($1, 1, Nullarg, Nullarg, Nullarg);
+ { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg);
if ($1 == O_EVAL || $1 == O_RESET)
$$ = fixeval($$); }
| FUNC1 '(' expr ')'
diff --git a/perly.c b/perly.c
index 5cde95237f..645ac3dcdb 100644
--- a/perly.c
+++ b/perly.c
@@ -1,4 +1,4 @@
-char rcsid[] = "$Header: perly.c,v 3.0 89/10/18 15:22:21 lwall Locked $\nPatch level: ###\n";
+char rcsid[] = "$Header: perly.c,v 3.0.1.1 89/11/11 04:50:04 lwall Locked $\nPatch level: ###\n";
/*
* Copyright (c) 1989, Larry Wall
*
@@ -6,6 +6,9 @@ char rcsid[] = "$Header: perly.c,v 3.0 89/10/18 15:22:21 lwall Locked $\nPatch l
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: perly.c,v $
+ * Revision 3.0.1.1 89/11/11 04:50:04 lwall
+ * patch2: moved yydebug to where its type didn't matter
+ *
* Revision 3.0 89/10/18 15:22:21 lwall
* 3.0 baseline
*
@@ -92,18 +95,17 @@ setuid perl scripts securely.\n");
perldb = TRUE;
s++;
goto reswitch;
-#ifdef DEBUGGING
case 'D':
+#ifdef DEBUGGING
#ifdef TAINT
if (euid != uid || egid != gid)
fatal("No -D allowed in setuid scripts");
#endif
debug = atoi(s+1);
-#ifdef YYDEBUG
- yydebug = (debug & 1);
+#else
+ warn("Recompile perl with -DDEBUGGING to use -D switch\n");
#endif
break;
-#endif
case 'e':
#ifdef TAINT
if (euid != uid || egid != gid)
@@ -531,8 +533,12 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
fatal("Execution aborted due to compilation errors.\n");
New(50,loop_stack,128,struct loop);
- New(51,debname,128,char);
- New(52,debdelim,128,char);
+#ifdef DEBUGGING
+ if (debug) {
+ New(51,debname,128,char);
+ New(52,debdelim,128,char);
+ }
+#endif
curstash = defstash;
preprocess = FALSE;
diff --git a/regcomp.c b/regcomp.c
index c0ec81a18a..cde84bd77b 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -7,9 +7,12 @@
* blame Henry for some of the lack of readability.
*/
-/* $Header: regcomp.c,v 3.0 89/10/18 15:22:29 lwall Locked $
+/* $Header: regcomp.c,v 3.0.1.1 89/11/11 04:51:04 lwall Locked $
*
* $Log: regcomp.c,v $
+ * Revision 3.0.1.1 89/11/11 04:51:04 lwall
+ * patch2: /[\000]/ didn't work
+ *
* Revision 3.0 89/10/18 15:22:29 lwall
* 3.0 baseline
*
@@ -874,7 +877,6 @@ regclass()
}
if (*regparse != ']')
FAIL("unmatched [] in regexp");
- regset(bits,0,0); /* always bomb out on null */
regparse++;
return ret;
}
diff --git a/regexec.c b/regexec.c
index 2246454b0a..37fe129394 100644
--- a/regexec.c
+++ b/regexec.c
@@ -7,9 +7,12 @@
* blame Henry for some of the lack of readability.
*/
-/* $Header: regexec.c,v 3.0 89/10/18 15:22:53 lwall Locked $
+/* $Header: regexec.c,v 3.0.1.1 89/11/11 04:52:04 lwall Locked $
*
* $Log: regexec.c,v $
+ * Revision 3.0.1.1 89/11/11 04:52:04 lwall
+ * patch2: /\b$foo/ didn't work
+ *
* Revision 3.0 89/10/18 15:22:53 lwall
* 3.0 baseline
*
@@ -262,7 +265,7 @@ int safebase; /* no need to remember string in subbase */
}
s++;
}
- if (tmp && regtry(prog,s))
+ if ((minlen || tmp) && regtry(prog,s))
goto got_it;
break;
case NBOUND:
@@ -282,7 +285,7 @@ int safebase; /* no need to remember string in subbase */
goto got_it;
s++;
}
- if (!tmp && regtry(prog,s))
+ if ((minlen || !tmp) && regtry(prog,s))
goto got_it;
break;
case ALNUM:
diff --git a/stab.c b/stab.c
index 3b235d7c5f..d1f3571bd6 100644
--- a/stab.c
+++ b/stab.c
@@ -1,4 +1,4 @@
-/* $Header: stab.c,v 3.0 89/10/18 15:23:23 lwall Locked $
+/* $Header: stab.c,v 3.0.1.1 89/11/11 04:55:07 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
@@ -6,6 +6,9 @@
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: stab.c,v $
+ * Revision 3.0.1.1 89/11/11 04:55:07 lwall
+ * patch2: sys_errlist[sys_nerr] is illegal
+ *
* Revision 3.0 89/10/18 15:23:23 lwall
* 3.0 baseline
*
@@ -140,7 +143,7 @@ STR *str;
case '!':
str_numset(stab_val(stab), (double)errno);
str_set(stab_val(stab),
- errno < 0 || errno > sys_nerr ? "(unknown)" : sys_errlist[errno]);
+ errno < 0 || errno >= sys_nerr ? "(unknown)" : sys_errlist[errno]);
stab_val(stab)->str_nok = 1; /* what a wonderful hack! */
break;
case '<':
diff --git a/str.c b/str.c
index 0d19b59952..ee76096f06 100644
--- a/str.c
+++ b/str.c
@@ -1,4 +1,4 @@
-/* $Header: str.c,v 3.0.1.1 89/10/26 23:23:41 lwall Locked $
+/* $Header: str.c,v 3.0.1.2 89/11/11 04:56:22 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
@@ -6,6 +6,9 @@
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: str.c,v $
+ * Revision 3.0.1.2 89/11/11 04:56:22 lwall
+ * patch2: uchar gives Crays fits
+ *
* Revision 3.0.1.1 89/10/26 23:23:41 lwall
* patch1: string ordering tests were wrong
* patch1: $/ now works even when STDSTDIO undefined
@@ -840,7 +843,7 @@ STR *src;
else if (*d == '[' && s[-1] == ']') { /* char class? */
int weight = 2; /* let's weigh the evidence */
char seen[256];
- unsigned char uchar = 0, lastuchar;
+ unsigned char unchar = 0, lastunchar;
Zero(seen,256,char);
*--s = '\0';
@@ -857,12 +860,12 @@ STR *src;
weight -= 100;
}
for (d++; d < s; d++) {
- lastuchar = uchar;
- uchar = (unsigned char)*d;
+ lastunchar = unchar;
+ unchar = (unsigned char)*d;
switch (*d) {
case '&':
case '$':
- weight -= seen[uchar] * 10;
+ weight -= seen[unchar] * 10;
if (isalpha(d[1]) || isdigit(d[1]) ||
d[1] == '_') {
d = scanreg(d,s,tokenbuf);
@@ -880,7 +883,7 @@ STR *src;
}
break;
case '\\':
- uchar = 254;
+ unchar = 254;
if (d[1]) {
if (index("wds",d[1]))
weight += 100;
@@ -898,8 +901,8 @@ STR *src;
weight += 100;
break;
case '-':
- if (lastuchar < d[1] || d[1] == '\\') {
- if (index("aA01! ",lastuchar))
+ if (lastunchar < d[1] || d[1] == '\\') {
+ if (index("aA01! ",lastunchar))
weight += 30;
if (index("zZ79~",d[1]))
weight += 30;
@@ -913,12 +916,12 @@ STR *src;
weight -= 150;
d = bufptr;
}
- if (uchar == lastuchar + 1)
+ if (unchar == lastunchar + 1)
weight += 5;
- weight -= seen[uchar];
+ weight -= seen[unchar];
break;
}
- seen[uchar]++;
+ seen[unchar]++;
}
#ifdef DEBUGGING
if (debug & 512)
diff --git a/toke.c b/toke.c
index 2d83a717b8..1d9474e5cb 100644
--- a/toke.c
+++ b/toke.c
@@ -1,4 +1,4 @@
-/* $Header: toke.c,v 3.0.1.1 89/10/26 23:26:21 lwall Locked $
+/* $Header: toke.c,v 3.0.1.2 89/11/11 05:04:42 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
@@ -6,6 +6,9 @@
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: toke.c,v $
+ * Revision 3.0.1.2 89/11/11 05:04:42 lwall
+ * patch2: fixed a CLINE macro conflict
+ *
* Revision 3.0.1.1 89/10/26 23:26:21 lwall
* patch1: disambiguated word after "sort" better
*
@@ -20,6 +23,9 @@
char *reparse; /* if non-null, scanreg found ${foo[$bar]} */
+#ifdef CLINE
+#undef CLINE
+#endif
#define CLINE (cmdline = (line < cmdline ? line : cmdline))
#define META(c) ((c) | 128)
@@ -86,7 +92,7 @@ yylex()
retry:
#ifdef YYDEBUG
- if (yydebug)
+ if (debug & 1)
if (index(s,'\n'))
fprintf(stderr,"Tokener at %s",s);
else
@@ -159,7 +165,13 @@ yylex()
}
#endif
bufend = linestr->str_ptr + linestr->str_cur;
- firstline = FALSE;
+ if (firstline) {
+ while (s < bufend && isspace(*s))
+ s++;
+ if (*s == ':') /* for csh's that have to exec sh scripts */
+ s++;
+ firstline = FALSE;
+ }
goto retry;
case ' ': case '\t': case '\f':
s++;
@@ -2094,10 +2106,8 @@ load_format()
set_csh()
{
- if (!csh) {
- if (stat("/bin/csh",&statbuf) < 0)
- csh = -1;
- else
- csh = 1;
- }
+#ifdef CSH
+ if (!cshlen)
+ cshlen = strlen(cshname);
+#endif
}
diff --git a/util.c b/util.c
index 4d24d1cbf1..e267578ec6 100644
--- a/util.c
+++ b/util.c
@@ -1,4 +1,4 @@
-/* $Header: util.c,v 3.0 89/10/18 15:32:43 lwall Locked $
+/* $Header: util.c,v 3.0.1.1 89/11/11 05:06:13 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
@@ -6,6 +6,9 @@
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: util.c,v $
+ * Revision 3.0.1.1 89/11/11 05:06:13 lwall
+ * patch2: made dup2 a little better
+ *
* Revision 3.0 89/10/18 15:32:43 lwall
* 3.0 baseline
*
@@ -1089,6 +1092,15 @@ char *mode;
close(p[THIS]);
}
if (doexec) {
+#if !defined(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 */
_exit(1);
}
@@ -1106,13 +1118,36 @@ char *mode;
return fdopen(p[this], mode);
}
+#ifdef NOTDEF
+dumpfds(s)
+char *s;
+{
+ int fd;
+ struct stat tmpstatbuf;
+
+ fprintf(stderr,"%s", s);
+ for (fd = 0; fd < 32; fd++) {
+ if (fstat(fd,&tmpstatbuf) >= 0)
+ fprintf(stderr," %d",fd);
+ }
+ fprintf(stderr,"\n");
+}
+#endif
+
#ifndef DUP2
dup2(oldfd,newfd)
int oldfd;
int newfd;
{
+ int fdtmp[10];
+ int fdx = 0;
+ int fd;
+
close(newfd);
- while (dup(oldfd) != newfd) ; /* good enough for our purposes */
+ while ((fd = dup(oldfd)) != newfd) /* good enough for low fd's */
+ fdtmp[fdx++] = fd;
+ while (fdx > 0)
+ close(fdtmp[--fdx]);
}
#endif
diff --git a/x2p/s2p.SH b/x2p/s2p.SH
index 35ee9e2870..e428d41910 100644
--- a/x2p/s2p.SH
+++ b/x2p/s2p.SH
@@ -28,9 +28,13 @@ $spitshell >s2p <<!GROK!THIS!
: In the following dollars and backticks do not need the extra backslash.
$spitshell >>s2p <<'!NO!SUBS!'
-# $Header: s2p.SH,v 3.0 89/10/18 15:35:02 lwall Locked $
+# $Header: s2p.SH,v 3.0.1.1 89/11/11 05:08:25 lwall Locked $
#
# $Log: s2p.SH,v $
+# Revision 3.0.1.1 89/11/11 05:08:25 lwall
+# patch2: in s2p, + within patterns needed backslashing
+# patch2: s2p was printing out some debugging info to the output file
+#
# Revision 3.0 89/10/18 15:35:02 lwall
# 3.0 baseline
#
@@ -418,7 +422,7 @@ ${space}next line;";
elsif ($c eq ']') {
$inbracket = 0;
}
- elsif (!$repl && index("()",$c) >= 0) {
+ elsif (!$repl && index("()+",$c) >= 0) {
$_ = substr($_,0,$i) . '\\' . substr($_,$i,10000);
$i++;
$len++;
@@ -583,10 +587,9 @@ sub fetchpat {
local($inbracket);
local($prefix,$delim,$ch);
- delim: while (s:^([^\](|)[\\/]*)([](|)[\\/])::) {
+ delim: while (s:^([^\]+(|)[\\/]*)([]+(|)[\\/])::) {
$prefix = $1;
$delim = $2;
- print "$prefix\t$delim\t$_\n";
if ($delim eq '\\') {
s/(.)//;
$ch = $1;
@@ -597,13 +600,11 @@ sub fetchpat {
$inbracket = 1;
s/^\^// && ($delim .= '^');
s/^]// && ($delim .= ']');
- print "$prefix\t$delim\t$_\n";
}
elsif ($delim eq ']') {
$inbracket = 0;
}
elsif ($inbracket || $delim ne $outer) {
- print "Adding\n";
$delim = '\\' . $delim;
}
$addr .= $prefix;
diff --git a/x2p/walk.c b/x2p/walk.c
index 959527de3a..d0ea34112c 100644
--- a/x2p/walk.c
+++ b/x2p/walk.c
@@ -1,4 +1,4 @@
-/* $Header: walk.c,v 3.0 89/10/18 15:35:48 lwall Locked $
+/* $Header: walk.c,v 3.0.1.1 89/11/11 05:09:33 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
@@ -6,6 +6,9 @@
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: walk.c,v $
+ * Revision 3.0.1.1 89/11/11 05:09:33 lwall
+ * patch2: in a2p, awk script with no line actions still needs main loop
+ *
* Revision 3.0 89/10/18 15:35:48 lwall
* 3.0 baseline
*
@@ -139,7 +142,7 @@ int minprec; /* minimum precedence without parens */
str_cat(str,"continue {\n $FNRbase = $. if eof;\n}\n");
}
else
- str_cat(str,"# (no line actions)\n");
+ str_cat(str,"while (<>) { } # (no line actions)\n");
if (ops[node+4].ival) {
realexit = TRUE;
str_cat(str,"\n");