Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

perl 4.0 patch 7: patch #4, continued

See patch #4.
  • Loading branch information...
commit 352d5a3ab0aab9889c59e847643d265e062cec0b 1 parent 6e21c82
authored June 06, 1991
2  emacs/perl-mode.el
@@ -572,7 +572,7 @@ Returns new value of point in all cases."
572 572
   (or arg (setq arg 1))
573 573
   (if (< arg 0) (forward-char 1))
574 574
   (and (/= arg 0)
575  
-       (re-search-backward "^\\s(\\|^\\s-*sub\\b[^{]+{\\|^\\s-*format\\b[^=]*="
  575
+       (re-search-backward "^\\s(\\|^\\s-*sub\\b[^{]+{\\|^\\s-*format\\b[^=]*=\\|^\\."
576 576
 			   nil 'move arg)
577 577
        (goto-char (1- (match-end 0))))
578 578
   (point))
2  h2pl/mkvars
@@ -19,7 +19,7 @@ foreach $include (@ARGV) {
19 19
 	    $val = eval "&$var;";
20 20
 	    if ($@) {
21 21
 		warn "$@: $_";
22  
-		print <<EOT
  22
+		print <<EOT;
23 23
 warn "\$$var isn't correctly set" if defined \$_main{'$var'};
24 24
 EOT
25 25
 		next;
11  hash.h
... ...
@@ -1,11 +1,14 @@
1  
-/* $Header: hash.h,v 4.0 91/03/20 01:22:38 lwall Locked $
  1
+/* $RCSfile: hash.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:10:33 $
2 2
  *
3  
- *    Copyright (c) 1989, Larry Wall
  3
+ *    Copyright (c) 1991, Larry Wall
4 4
  *
5  
- *    You may distribute under the terms of the GNU General Public License
6  
- *    as specified in the README file that comes with the perl 3.0 kit.
  5
+ *    You may distribute under the terms of either the GNU General Public
  6
+ *    License or the Artistic License, as specified in the README file.
7 7
  *
8 8
  * $Log:	hash.h,v $
  9
+ * Revision 4.0.1.1  91/06/07  11:10:33  lwall
  10
+ * patch4: new copyright notice
  11
+ * 
9 12
  * Revision 4.0  91/03/20  01:22:38  lwall
10 13
  * 4.0 baseline.
11 14
  * 
5  hints/hpux.sh
... ...
@@ -1,4 +1,7 @@
1  
-d_syscall=$undef
2 1
 echo " "
3 2
 echo "NOTE: regression test op.read may fail due to an NFS bug in HP/UX."
4 3
 echo "If so, don't worry about it."
  4
+case `(uname -r) 2>/dev/null` in
  5
+*3.1*) d_syscall=$undef ;;
  6
+*2.1*) libswanted=`echo $libswanted | sed 's/ malloc / /'` ;;
  7
+esac
13  hints/mips.sh
... ...
@@ -1,6 +1,17 @@
1  
-optimize='-g'
  1
+cmd_cflags='optimize="-g"'
  2
+perl_cflags='optimize="-g"'
  3
+tcmd_cflags='optimize="-g"'
  4
+tperl_cflags='optimize="-g"'
2 5
 d_volatile=undef
3 6
 d_castneg=undef
4 7
 cc=cc
5 8
 libpth="/usr/lib/cmplrs/cc $libpth"
6 9
 groupstype=int
  10
+nm_opts='-B'
  11
+case $PATH in
  12
+*bsd*:/bin:*) cat <<END
  13
+NOTE:  Some people have reported having much better luck with Mips CC than
  14
+with the BSD cc.  Put /bin first in your PATH if you have difficulties.
  15
+END
  16
+;;
  17
+esac
4  hints/next.sh
... ...
@@ -1,2 +1,4 @@
1 1
 : Just disable defaulting to -fpcc-struct-return, since gcc is native compiler.
2  
-ccflags="$ccflags "
  2
+nativegcc='define'
  3
+groupstype="int"
  4
+usemymalloc="n"
19  installperl
@@ -6,8 +6,8 @@ while (@ARGV) {
6 6
     shift;
7 7
 }
8 8
 
9  
-@scripts = 'h2ph';
10  
-@manpages = ('perl.man', 'h2ph.man');
  9
+@scripts = ('h2ph', 'x2p/s2p', 'x2p/find2perl');
  10
+@manpages = ('perl.man', 'h2ph.man', 'x2p/a2p.man', 'x2p/s2p.man');
11 11
 
12 12
 $version = sprintf("%5.3f", $]);
13 13
 $release = substr($version,0,3);
@@ -72,6 +72,14 @@ if ($bdev != $ddev || $bino != $dino) {
72 72
     &link("$installbin/sperl$ver", "$installbin/suidperl") if $d_dosuid;
73 73
 }
74 74
 
  75
+($bdev,$bino) = stat($installbin);
  76
+($ddev,$dino) = stat('x2p');
  77
+
  78
+if ($bdev != $ddev || $bino != $dino) {
  79
+    &unlink("$installbin/a2p");
  80
+    &cmd("cp x2p/a2p $installbin/a2p");
  81
+}
  82
+
75 83
 # Make some enemies in the name of standardization.   :-)
76 84
 
77 85
 ($udev,$uino) = stat("/usr/bin");
@@ -85,11 +93,11 @@ if (-w _ && ($udev != $ddev || $uino != $dino) && !$nonono) {
85 93
 
86 94
 # Install scripts.
87 95
 
88  
-&makedir($scriptdir);
  96
+&makedir($installscr);
89 97
 
90 98
 for (@scripts) {
91  
-    &cmd("cp $_ $scriptdir");
92  
-    &chmod(0755, "$scriptdir/$_");
  99
+    &cmd("cp $_ $installscr");
  100
+    s#.*/##; &chmod(0755, "$installscr/$_");
93 101
 }
94 102
 
95 103
 # Install library files.
@@ -111,6 +119,7 @@ if ($mansrc ne '') {
111 119
     if ($mdev != $ddev || $mino != $dino) {
112 120
 	for (@manpages) {
113 121
 	    ($new = $_) =~ s/man$/$manext/;
  122
+	    $new =~ s#.*/##;
114 123
 	    print STDERR "  Installing $mansrc/$new\n";
115 124
 	    next if $nonono;
116 125
 	    open(MI,$_);
204  lib/newgetopt.pl
... ...
@@ -0,0 +1,204 @@
  1
+# newgetopt.pl -- new options parsing
  2
+
  3
+# SCCS Status     : @(#)@ newgetopt.pl	1.7
  4
+# Author          : Johan Vromans
  5
+# Created On      : Tue Sep 11 15:00:12 1990
  6
+# Last Modified By: Johan Vromans
  7
+# Last Modified On: Sun Oct 14 14:35:36 1990
  8
+# Update Count    : 34
  9
+# Status          : Okay
  10
+
  11
+# This package implements a new getopt function. This function adheres
  12
+# to the new syntax (long option names, no bundling).
  13
+#
  14
+# Arguments to the function are:
  15
+#
  16
+#  - a list of possible options. These should designate valid perl
  17
+#    identifiers, optionally followed by an argument specifier ("="
  18
+#    for mandatory arguments or ":" for optional arguments) and an
  19
+#    argument type specifier: "n" or "i" for integer numbers, "f" for
  20
+#    real (fix) numbers or "s" for strings.
  21
+#
  22
+#  - if the first option of the list consists of non-alphanumeric
  23
+#    characters only, it is interpreted as a generic option starter.
  24
+#    Everything starting with one of the characters from the starter
  25
+#    will be considered an option.
  26
+#    Likewise, a double occurrence (e.g. "--") signals end of
  27
+#    the options list.
  28
+#    The default value for the starter is "-".
  29
+#
  30
+# Upon return, the option variables, prefixed with "opt_", are defined
  31
+# and set to the respective option arguments, if any.
  32
+# Options that do not take an argument are set to 1. Note that an
  33
+# option with an optional argument will be defined, but set to '' if
  34
+# no actual argument has been supplied.
  35
+# A return status of 0 (false) indicates that the function detected
  36
+# one or more errors.
  37
+#
  38
+# Special care is taken to give a correct treatment to optional arguments.
  39
+#
  40
+# E.g. if option "one:i" (i.e. takes an optional integer argument),
  41
+# then the following situations are handled:
  42
+#
  43
+#    -one -two		-> $opt_one = '', -two is next option
  44
+#    -one -2		-> $opt_one = -2
  45
+#
  46
+# Also, assume "foo=s" and "bar:s" :
  47
+#
  48
+#    -bar -xxx		-> $opt_bar = '', '-xxx' is next option
  49
+#    -foo -bar		-> $opt_foo = '-bar'
  50
+#    -foo --		-> $opt_foo = '--'
  51
+#
  52
+
  53
+# HISTORY 
  54
+# 20-Sep-1990		Johan Vromans	
  55
+#    Set options w/o argument to 1.
  56
+#    Correct the dreadful semicolon/require bug.
  57
+
  58
+
  59
+package newgetopt;
  60
+
  61
+$debug = 0;			# for debugging
  62
+
  63
+sub main'NGetOpt {
  64
+    local (@optionlist) = @_;
  65
+    local ($[) = 0;
  66
+    local ($genprefix) = "-";
  67
+    local ($error) = 0;
  68
+    local ($opt, $optx, $arg, $type, $mand, @hits);
  69
+
  70
+    # See if the first element of the optionlist contains option
  71
+    # starter characters.
  72
+    $genprefix = shift (@optionlist) if $optionlist[0] =~ /^\W+$/;
  73
+
  74
+    # Turn into regexp.
  75
+    $genprefix =~ s/(\W)/\\\1/g;
  76
+    $genprefix = "[" . $genprefix . "]";
  77
+
  78
+    # Verify correctness of optionlist.
  79
+    @hits = grep ($_ !~ /^\w+([=:][infse])?$/, @optionlist);
  80
+    if ( $#hits >= 0 ) {
  81
+	foreach $opt ( @hits ) {
  82
+	    print STDERR ("Error in option spec: \"", $opt, "\"\n");
  83
+	    $error++;
  84
+	}
  85
+	return 0;
  86
+    }
  87
+
  88
+    # Process argument list
  89
+
  90
+    while ( $#main'ARGV >= 0 ) {		#'){
  91
+
  92
+	# >>> See also the continue block <<<
  93
+
  94
+	# Get next argument
  95
+	$opt = shift (@main'ARGV);		#');
  96
+	print STDERR ("=> option \"", $opt, "\"\n") if $debug;
  97
+	$arg = undef;
  98
+
  99
+	# Check for exhausted list.
  100
+	if ( $opt =~ /^$genprefix/o ) {
  101
+	    # Double occurrence is terminator
  102
+	    return ($error == 0) if $opt eq "$+$+";
  103
+	    $opt = $';		# option name (w/o prefix)
  104
+	}
  105
+	else {
  106
+	    # Apparently not an option - push back and exit.
  107
+	    unshift (@main'ARGV, $opt);		#');
  108
+	    return ($error == 0);
  109
+	}
  110
+
  111
+	# Grep in option list. Hide regexp chars from option.
  112
+	($optx = $opt) =~ s/(\W)/\\\1/g;
  113
+	@hits = grep (/^$optx([=:].+)?$/, @optionlist);
  114
+	if ( $#hits != 0 ) {
  115
+	    print STDERR ("Unknown option: ", $opt, "\n");
  116
+	    $error++;
  117
+	    next;
  118
+	}
  119
+
  120
+	# Determine argument status.
  121
+	undef $type;
  122
+	$type = $+ if $hits[0] =~ /[=:].+$/;
  123
+	print STDERR ("=> found \"$hits[0]\" for ", $opt, "\n") if $debug;
  124
+
  125
+	# If it is an option w/o argument, we're almost finished with it.
  126
+	if ( ! defined $type ) {
  127
+	    $arg = 1;		# supply explicit value
  128
+	    next;
  129
+	}
  130
+
  131
+	# Get mandatory status and type info.
  132
+	($mand, $type) = $type =~ /^(.)(.)$/;
  133
+
  134
+	# Check if the argument list is exhausted.
  135
+	if ( $#main'ARGV < 0 ) {		#'){
  136
+
  137
+	    # Complain if this option needs an argument.
  138
+	    if ( $mand eq "=" ) {
  139
+		print STDERR ("Option ", $opt, " requires an argument\n");
  140
+		$error++;
  141
+	    }
  142
+	    next;
  143
+	}
  144
+
  145
+	# Get (possibly optional) argument.
  146
+	$arg = shift (@main'ARGV);		#');
  147
+
  148
+	# Check if it is a valid argument. A mandatory string takes
  149
+ 	# anything. 
  150
+	if ( "$mand$type" ne "=s" && $arg =~ /^$genprefix/o ) {
  151
+
  152
+	    # Check for option list terminator.
  153
+	    if ( $arg eq "$+$+" ) {
  154
+		# Complain if an argument is required.
  155
+		if ($mand eq "=") {
  156
+		    print STDERR ("Option ", $opt, " requires an argument\n");
  157
+		    $error++;
  158
+		}
  159
+		# Push back so the outer loop will terminate.
  160
+		unshift (@main'ARGV, $arg);	#');
  161
+		$arg = "";	# don't assign it
  162
+		next;
  163
+	    }
  164
+
  165
+	    # Maybe the optional argument is the next option?
  166
+	    if ( $mand eq ":" && $' =~ /[a-zA-Z_]/ ) {
  167
+		# Yep. Push back.
  168
+		unshift (@main'ARGV, $arg);	#');
  169
+		$arg = "";	# don't assign it
  170
+		next;
  171
+	    }
  172
+	}
  173
+
  174
+	if ( $type eq "n" || $type eq "i" ) { # numeric/integer
  175
+	    if ( $arg !~ /^-?[0-9]+$/ ) {
  176
+		print STDERR ("Value \"", $arg, "\" invalid for option ",
  177
+			       $opt, " (numeric required)\n");
  178
+		$error++;
  179
+	    }
  180
+	    next;
  181
+	}
  182
+
  183
+	if ( $type eq "f" ) { # fixed real number, int is also ok
  184
+	    if ( $arg !~ /^-?[0-9.]+$/ ) {
  185
+		print STDERR ("Value \"", $arg, "\" invalid for option ",
  186
+			       $opt, " (real number required)\n");
  187
+		$error++;
  188
+	    }
  189
+	    next;
  190
+	}
  191
+
  192
+	if ( $type eq "s" ) { # string
  193
+	    next;
  194
+	}
  195
+
  196
+    }
  197
+    continue {
  198
+	print STDERR ("=> \$main'opt_$opt = $arg\n") if $debug;
  199
+	eval ("\$main'opt_$opt = \$arg");
  200
+    }
  201
+
  202
+    return ($error == 0);
  203
+}
  204
+1;
54  makedepend.SH
@@ -15,9 +15,15 @@ esac
15 15
 echo "Extracting makedepend (with variable substitutions)"
16 16
 $spitshell >makedepend <<!GROK!THIS!
17 17
 $startsh
18  
-# $Header: makedepend.SH,v 4.0 91/03/20 01:27:04 lwall Locked $
  18
+# $RCSfile: makedepend.SH,v $$Revision: 4.0.1.2 $$Date: 91/06/07 15:40:06 $
19 19
 #
20 20
 # $Log:	makedepend.SH,v $
  21
+# Revision 4.0.1.2  91/06/07  15:40:06  lwall
  22
+# patch4: fixed cppstdin to run in the right directory
  23
+# 
  24
+# Revision 4.0.1.1  91/06/07  11:20:06  lwall
  25
+# patch4: Makefile is no longer self-modifying code under makedepend
  26
+# 
21 27
 # Revision 4.0  91/03/20  01:27:04  lwall
22 28
 # 4.0 baseline.
23 29
 # 
@@ -28,7 +34,8 @@ export PATH || (echo "OOPS, this isn't sh.  Desperation time.  I will feed mysel
28 34
 cat='$cat'
29 35
 cppflags='$cppflags'
30 36
 cp='$cp'
31  
-cpp='$cppstdin'
  37
+cppstdin='$cppstdin'
  38
+cppminus='$cppminus'
32 39
 echo='$echo'
33 40
 egrep='$egrep'
34 41
 expr='$expr'
@@ -46,10 +53,9 @@ $spitshell >>makedepend <<'!NO!SUBS!'
46 53
 $cat /dev/null >.deptmp
47 54
 $rm -f *.c.c c/*.c.c
48 55
 if test -f Makefile; then
49  
-    mf=Makefile
50  
-else
51  
-    mf=makefile
  56
+    cp Makefile makefile
52 57
 fi
  58
+mf=makefile
53 59
 if test -f $mf; then
54 60
     defrule=`<$mf sed -n		\
55 61
 	-e '/^\.c\.o:.*;/{'		\
@@ -84,7 +90,7 @@ for file in `$cat .clist`; do
84 90
 	-e 's|\\$||' \
85 91
 	-e p \
86 92
 	-e '}'
87  
-    $cpp -I/usr/local/include -I. $cppflags $file.c | \
  93
+    $cppstdin -I/usr/local/include -I. $cppflags $cppminus <$file.c | sed -e 's#\.[0-9][0-9]*\.c#'"$file.c#" | \
88 94
     $sed \
89 95
 	-e '/^# *[0-9]/!d' \
90 96
 	-e 's/^.*"\(.*\)".*$/'$filebase'.o: \1/' \
@@ -93,52 +99,52 @@ for file in `$cat .clist`; do
93 99
     $uniq | $sort | $uniq >> .deptmp
94 100
 done
95 101
 
96  
-$sed <Makefile >Makefile.new -e '1,/^# AUTOMATICALLY/!d'
  102
+$sed <$mf >$mf.new -e '1,/^# AUTOMATICALLY/!d'
97 103
 
98 104
 make shlist || ($echo "Searching for .SH files..."; \
99 105
 	$echo *.SH | $tr ' ' '\012' | $egrep -v '\*' >.shlist)
100 106
 if $test -s .deptmp; then
101 107
     for file in `cat .shlist`; do
102  
-	$echo `$expr X$file : 'X\(.*\).SH`: $file config.sh \; \
  108
+	$echo `$expr X$file : 'X\(.*\).SH'`: $file config.sh \; \
103 109
 	    /bin/sh $file >> .deptmp
104 110
     done
105  
-    $echo "Updating Makefile..."
  111
+    $echo "Updating $mf..."
106 112
     $echo "# If this runs make out of memory, delete /usr/include lines." \
107  
-	>> Makefile.new
  113
+	>> $mf.new
108 114
     $sed 's|^\(.*\.o:\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \
109  
-       >>Makefile.new
  115
+       >>$mf.new
110 116
 else
111 117
     make hlist || ($echo "Searching for .h files..."; \
112 118
 	$echo *.h | $tr ' ' '\012' | $egrep -v '\*' >.hlist)
113 119
     $echo "You don't seem to have a proper C preprocessor.  Using grep instead."
114 120
     $egrep '^#include ' `cat .clist` `cat .hlist`  >.deptmp
115  
-    $echo "Updating Makefile..."
  121
+    $echo "Updating $mf..."
116 122
     <.clist $sed -n							\
117 123
 	-e '/\//{'							\
118 124
 	-e   's|^\(.*\)/\(.*\)\.c|\2.o: \1/\2.c; '"$defrule \1/\2.c|p"	\
119 125
 	-e   d								\
120 126
 	-e '}'								\
121  
-	-e 's|^\(.*\)\.c|\1.o: \1.c|p' >> Makefile.new
  127
+	-e 's|^\(.*\)\.c|\1.o: \1.c|p' >> $mf.new
122 128
     <.hlist $sed -n 's|\(.*/\)\(.*\)|s= \2= \1\2=|p' >.hsed
123 129
     <.deptmp $sed -n 's|c:#include "\(.*\)".*$|o: \1|p' | \
124 130
        $sed 's|^[^;]*/||' | \
125  
-       $sed -f .hsed >> Makefile.new
  131
+       $sed -f .hsed >> $mf.new
126 132
     <.deptmp $sed -n 's|c:#include <\(.*\)>.*$|o: /usr/include/\1|p' \
127  
-       >> Makefile.new
  133
+       >> $mf.new
128 134
     <.deptmp $sed -n 's|h:#include "\(.*\)".*$|h: \1|p' | \
129  
-       $sed -f .hsed >> Makefile.new
  135
+       $sed -f .hsed >> $mf.new
130 136
     <.deptmp $sed -n 's|h:#include <\(.*\)>.*$|h: /usr/include/\1|p' \
131  
-       >> Makefile.new
  137
+       >> $mf.new
132 138
     for file in `$cat .shlist`; do
133  
-	$echo `$expr X$file : 'X\(.*\).SH`: $file config.sh \; \
134  
-	    /bin/sh $file >> Makefile.new
  139
+	$echo `$expr X$file : 'X\(.*\).SH'`: $file config.sh \; \
  140
+	    /bin/sh $file >> $mf.new
135 141
     done
136 142
 fi
137  
-$rm -f Makefile.old
138  
-$cp Makefile Makefile.old
139  
-$cp Makefile.new Makefile
140  
-$rm Makefile.new
141  
-$echo "# WARNING: Put nothing here or make depend will gobble it up!" >> Makefile
  143
+$rm -f $mf.old
  144
+$cp $mf $mf.old
  145
+$cp $mf.new $mf
  146
+$rm $mf.new
  147
+$echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf
142 148
 $rm -f .deptmp `sed 's/\.c/.c.c/' .clist` .shlist .clist .hlist .hsed
143 149
 
144 150
 !NO!SUBS!
23  malloc.c
... ...
@@ -1,6 +1,9 @@
1  
-/* $RCSfile: malloc.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:48:31 $
  1
+/* $RCSfile: malloc.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:20:45 $
2 2
  *
3 3
  * $Log:	malloc.c,v $
  4
+ * Revision 4.0.1.2  91/06/07  11:20:45  lwall
  5
+ * patch4: many, many itty-bitty portability fixes
  6
+ * 
4 7
  * Revision 4.0.1.1  91/04/11  17:48:31  lwall
5 8
  * patch1: Configure now figures out malloc ptr type
6 9
  * 
@@ -160,7 +163,7 @@ malloc(nbytes)
160 163
 	p->ov_rmagic = RMAGIC;
161 164
   	*((u_int *)((caddr_t)p + nbytes - RSLOP)) = RMAGIC;
162 165
 #endif
163  
-  	return ((char *)(p + 1));
  166
+  	return ((MALLOCPTRTYPE *)(p + 1));
164 167
 }
165 168
 
166 169
 /*
@@ -230,11 +233,12 @@ morecore(bucket)
230 233
 }
231 234
 
232 235
 void
233  
-free(cp)
234  
-	char *cp;
  236
+free(mp)
  237
+	MALLOCPTRTYPE *mp;
235 238
 {   
236 239
   	register int size;
237 240
 	register union overhead *op;
  241
+	char *cp = (char*)mp;
238 242
 
239 243
   	if (cp == NULL)
240 244
   		return;
@@ -277,8 +281,8 @@ free(cp)
277 281
 int reall_srchlen = 4;	/* 4 should be plenty, -1 =>'s whole list */
278 282
 
279 283
 MALLOCPTRTYPE *
280  
-realloc(cp, nbytes)
281  
-	char *cp; 
  284
+realloc(mp, nbytes)
  285
+	MALLOCPTRTYPE *mp; 
282 286
 	unsigned nbytes;
283 287
 {   
284 288
   	register u_int onb;
@@ -286,6 +290,7 @@ realloc(cp, nbytes)
286 290
   	char *res;
287 291
 	register int i;
288 292
 	int was_alloced = 0;
  293
+	char *cp = (char*)mp;
289 294
 
290 295
   	if (cp == NULL)
291 296
   		return (malloc(nbytes));
@@ -331,15 +336,15 @@ realloc(cp, nbytes)
331 336
 			*((u_int *)((caddr_t)op + nbytes - RSLOP)) = RMAGIC;
332 337
 		}
333 338
 #endif
334  
-		return(cp);
  339
+		return((MALLOCPTRTYPE*)cp);
335 340
 	}
336  
-  	if ((res = malloc(nbytes)) == NULL)
  341
+  	if ((res = (char*)malloc(nbytes)) == NULL)
337 342
   		return (NULL);
338 343
   	if (cp != res)			/* common optimization */
339 344
 		(void)bcopy(cp, res, (int)((nbytes < onb) ? nbytes : onb));
340 345
   	if (was_alloced)
341 346
 		free(cp);
342  
-  	return (res);
  347
+  	return ((MALLOCPTRTYPE*)res);
343 348
 }
344 349
 
345 350
 /*
9  msdos/msdos.c
... ...
@@ -1,11 +1,14 @@
1  
-/* $Header: msdos.c,v 4.0 91/03/20 01:34:46 lwall Locked $
  1
+/* $RCSfile: msdos.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:22:37 $
2 2
  *
3 3
  *    (C) Copyright 1989, 1990 Diomidis Spinellis.
4 4
  *
5  
- *    You may distribute under the terms of the GNU General Public License
6  
- *    as specified in the README file that comes with the perl 3.0 kit.
  5
+ *    You may distribute under the terms of either the GNU General Public
  6
+ *    License or the Artistic License, as specified in the README file.
7 7
  *
8 8
  * $Log:	msdos.c,v $
  9
+ * Revision 4.0.1.1  91/06/07  11:22:37  lwall
  10
+ * patch4: new copyright notice
  11
+ * 
9 12
  * Revision 4.0  91/03/20  01:34:46  lwall
10 13
  * 4.0 baseline.
11 14
  * 
9  os2/os2.c
... ...
@@ -1,11 +1,14 @@
1  
-/* $Header: os2.c,v 4.0 91/03/20 01:36:21 lwall Locked $
  1
+/* $RCSfile: os2.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:23:06 $
2 2
  *
3 3
  *    (C) Copyright 1989, 1990 Diomidis Spinellis.
4 4
  *
5  
- *    You may distribute under the terms of the GNU General Public License
6  
- *    as specified in the README file that comes with the perl 3.0 kit.
  5
+ *    You may distribute under the terms of either the GNU General Public
  6
+ *    License or the Artistic License, as specified in the README file.
7 7
  *
8 8
  * $Log:	os2.c,v $
  9
+ * Revision 4.0.1.1  91/06/07  11:23:06  lwall
  10
+ * patch4: new copyright notice
  11
+ * 
9 12
  * Revision 4.0  91/03/20  01:36:21  lwall
10 13
  * 4.0 baseline.
11 14
  * 
2  patchlevel.h
... ...
@@ -1 +1 @@
1  
-#define PATCHLEVEL 6
  1
+#define PATCHLEVEL 7
58  perl.c
... ...
@@ -1,11 +1,20 @@
1  
-char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:49:05 $\nPatch level: ###\n";
  1
+char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.3 $$Date: 91/06/07 11:40:18 $\nPatch level: ###\n";
2 2
 /*
3  
- *    Copyright (c) 1989, Larry Wall
  3
+ *    Copyright (c) 1991, Larry Wall
4 4
  *
5  
- *    You may distribute under the terms of the GNU General Public License
6  
- *    as specified in the README file that comes with the perl 3.0 kit.
  5
+ *    You may distribute under the terms of either the GNU General Public
  6
+ *    License or the Artistic License, as specified in the README file.
7 7
  *
8 8
  * $Log:	perl.c,v $
  9
+ * Revision 4.0.1.3  91/06/07  11:40:18  lwall
  10
+ * patch4: changed old $^P to $^X
  11
+ * 
  12
+ * Revision 4.0.1.2  91/06/07  11:26:16  lwall
  13
+ * patch4: new copyright notice
  14
+ * patch4: added $^P variable to control calling of perldb routines
  15
+ * patch4: added $^F variable to specify maximum system fd, default 2
  16
+ * patch4: debugger lost track of lines in eval
  17
+ * 
9 18
  * Revision 4.0.1.1  91/04/11  17:49:05  lwall
10 19
  * patch1: fixed undefined environ problem
11 20
  * 
@@ -23,6 +32,8 @@ char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:49:05
23 32
 #include "patchlevel.h"
24 33
 #endif
25 34
 
  35
+char *getenv();
  36
+
26 37
 #ifdef IAMSUID
27 38
 #ifndef DOSUID
28 39
 #define DOSUID
@@ -50,7 +61,7 @@ register char **env;
50 61
 {
51 62
     register STR *str;
52 63
     register char *s;
53  
-    char *index(), *strcpy(), *getenv();
  64
+    char *getenv();
54 65
     bool dosearch = FALSE;
55 66
 #ifdef DOSUID
56 67
     char *validarg = "";
@@ -656,7 +667,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
656 667
 	(void)hadd(sigstab);
657 668
     }
658 669
 
659  
-    magicalize("!#?^~=-%.+&*()<>,\\/[|`':\004\t\024\027");
  670
+    magicalize("!#?^~=-%.+&*()<>,\\/[|`':\004\t\020\024\027\006");
660 671
     userinit();		/* in case linked C routines want magical variables */
661 672
 
662 673
     amperstab = stabent("&",allstabs);
@@ -740,7 +751,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
740 751
 	str_set(stab_val(tmpstab),origfilename);
741 752
 	magicname("0", Nullch, 0);
742 753
     }
743  
-    if (tmpstab = stabent("\020",allstabs))
  754
+    if (tmpstab = stabent("\030",allstabs))
744 755
 	str_set(stab_val(tmpstab),origargv[0]);
745 756
     if (argvstab = stabent("ARGV",allstabs)) {
746 757
 	argvstab->str_pok |= SP_MULTI;
@@ -830,6 +841,31 @@ int namlen;
830 841
     }
831 842
 }
832 843
 
  844
+void
  845
+savelines(array, str)
  846
+ARRAY *array;
  847
+STR *str;
  848
+{
  849
+    register char *s = str->str_ptr;
  850
+    register char *send = str->str_ptr + str->str_cur;
  851
+    register char *t;
  852
+    register int line = 1;
  853
+
  854
+    while (s && s < send) {
  855
+	STR *tmpstr = Str_new(85,0);
  856
+
  857
+	t = index(s, '\n');
  858
+	if (t)
  859
+	    t++;
  860
+	else
  861
+	    t = send;
  862
+
  863
+	str_nset(tmpstr, s, t - s);
  864
+	astore(array, line++, tmpstr);
  865
+	s = t;
  866
+    }
  867
+}
  868
+
833 869
 /* this routine is in perl.c by virtue of being sort of an alternate main() */
834 870
 
835 871
 int
@@ -871,7 +907,9 @@ int *arglast;
871 907
 	curcmd->c_filestab = fstab("(eval)");
872 908
 	curcmd->c_line = 1;
873 909
 	str_sset(linestr,str);
874  
-	str_cat(linestr,";");		/* be kind to them */
  910
+	str_cat(linestr,";\n");		/* be kind to them */
  911
+	if (perldb)
  912
+	    savelines(stab_xarray(curcmd->c_filestab), linestr);
875 913
     }
876 914
     else {
877 915
 	if (last_root && !in_eval) {
@@ -1201,6 +1239,9 @@ my_unexec()
1201 1239
 	fprintf(stderr, "unexec of %s into %s failed!\n", perlpath, dumpname);
1202 1240
     exit(status);
1203 1241
 #else
  1242
+#ifdef MSDOS
  1243
+    abort();	/* nothing else to do */
  1244
+#else /* ! MSDOS */
1204 1245
 #   ifndef SIGABRT
1205 1246
 #	define SIGABRT SIGILL
1206 1247
 #   endif
@@ -1208,6 +1249,7 @@ my_unexec()
1208 1249
 #	define SIGILL 6		/* blech */
1209 1250
 #   endif
1210 1251
     kill(getpid(),SIGABRT);	/* for use with undump */
  1252
+#endif /* ! MSDOS */
1211 1253
 #endif
1212 1254
 }
1213 1255
 
66  perl.h
... ...
@@ -1,11 +1,16 @@
1  
-/* $RCSfile: perl.h,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:49:51 $
  1
+/* $RCSfile: perl.h,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:28:33 $
2 2
  *
3  
- *    Copyright (c) 1989, Larry Wall
  3
+ *    Copyright (c) 1991, Larry Wall
4 4
  *
5  
- *    You may distribute under the terms of the GNU General Public License
6  
- *    as specified in the README file that comes with the perl 3.0 kit.
  5
+ *    You may distribute under the terms of either the GNU General Public
  6
+ *    License or the Artistic License, as specified in the README file.
7 7
  *
8 8
  * $Log:	perl.h,v $
  9
+ * Revision 4.0.1.2  91/06/07  11:28:33  lwall
  10
+ * patch4: new copyright notice
  11
+ * patch4: made some allowances for "semi-standard" C
  12
+ * patch4: many, many itty-bitty portability fixes
  13
+ * 
9 14
  * Revision 4.0.1.1  91/04/11  17:49:51  lwall
10 15
  * patch1: hopefully straightened out some of the Xenix mess
11 16
  * 
@@ -47,7 +52,11 @@
47 52
 
48 53
 #endif /* !MSDOS */
49 54
 
50  
-#if defined(HASVOLATILE) || defined(__STDC__)
  55
+#if defined(__STDC__) || defined(_AIX) || defined(__stdc__)
  56
+# define STANDARD_C 1
  57
+#endif
  58
+
  59
+#if defined(HASVOLATILE) || defined(STANDARD_C)
51 60
 #define VOLATILE volatile
52 61
 #else
53 62
 #define VOLATILE
@@ -81,13 +90,16 @@
81 90
 #include <ctype.h>
82 91
 #include <setjmp.h>
83 92
 #ifndef MSDOS
84  
-#include <sys/param.h>	/* if this needs types.h we're still wrong */
  93
+#ifdef PARAM_NEEDS_TYPES
  94
+#include <sys/types.h>
85 95
 #endif
86  
-#ifdef __STDC__
  96
+#include <sys/param.h>
  97
+#endif
  98
+#ifdef STANDARD_C
87 99
 /* Use all the "standard" definitions */
88 100
 #include <stdlib.h>
89 101
 #include <string.h>
90  
-#endif /* __STDC__ */
  102
+#endif /* STANDARD_C */
91 103
 
92 104
 #if defined(HAS_MEMCMP) && defined(mips) && BYTEORDER == 0x1234
93 105
 #undef HAS_MEMCMP
@@ -95,19 +107,25 @@
95 107
 
96 108
 #ifdef HAS_MEMCPY
97 109
 
98  
-#  ifndef __STDC__
  110
+#  ifndef STANDARD_C
99 111
 #    ifndef memcpy
100 112
 extern char * memcpy(), *memset();
101 113
 extern int memcmp();
102 114
 #    endif /* ndef memcpy */
103  
-#  endif /* ndef __STDC__ */
  115
+#  endif /* ndef STANDARD_C */
104 116
 
105  
-#define bcopy(s1,s2,l) memcpy(s2,s1,l)
106  
-#define bzero(s,l) memset(s,0,l)
  117
+#   ifndef bcopy
  118
+#	define bcopy(s1,s2,l) memcpy(s2,s1,l)
  119
+#   endif
  120
+#   ifndef bzero
  121
+#	define bzero(s,l) memset(s,0,l)
  122
+#   endif
107 123
 #endif /* HAS_MEMCPY */
108 124
 
109 125
 #ifndef HAS_BCMP		/* prefer bcmp slightly 'cuz it doesn't order */
110  
-#define bcmp(s1,s2,l) memcmp(s1,s2,l)
  126
+#   ifndef bcmp
  127
+#	define bcmp(s1,s2,l) memcmp(s1,s2,l)
  128
+#   endif
111 129
 #endif
112 130
 
113 131
 #ifndef _TYPES_		/* If types.h defines this it's easy. */
@@ -245,6 +263,13 @@ EXT int dbmlen;
245 263
 #   endif
246 264
 #endif
247 265
 
  266
+#ifdef FPUTS_BOTCH
  267
+/* work around botch in SunOS 4.0.1 and 4.0.2 */
  268
+#   ifndef fputs
  269
+#	define fputs(str,fp) fprintf(fp,"%s",str)
  270
+#   endif
  271
+#endif
  272
+
248 273
 /*
249 274
  * The following gobbledygook brought to you on behalf of __STDC__.
250 275
  * (I could just use #ifndef __STDC__, but this is more bulletproof
@@ -345,6 +370,10 @@ EXT int dbmlen;
345 370
 #   define S_ISGID 02000
346 371
 #endif
347 372
 
  373
+#ifdef f_next
  374
+#undef f_next
  375
+#endif
  376
+
348 377
 typedef unsigned int STRLEN;
349 378
 
350 379
 typedef struct arg ARG;
@@ -377,7 +406,7 @@ typedef struct callsave CSV;
377 406
 #   define I286
378 407
 #endif
379 408
 
380  
-#ifndef	__STDC__
  409
+#ifndef	STANDARD_C
381 410
 #ifdef CHARSPRINTF
382 411
     char *sprintf();
383 412
 #else
@@ -681,6 +710,11 @@ EXT bool sawi INIT(FALSE);		/* study must assume case insensitive */
681 710
 EXT bool sawvec INIT(FALSE);
682 711
 EXT bool localizing INIT(FALSE);	/* are we processing a local() list? */
683 712
 
  713
+#ifndef MAXSYSFD
  714
+#   define MAXSYSFD 2
  715
+#endif
  716
+EXT int maxsysfd INIT(MAXSYSFD);	/* top fd to pass to subprocesses */
  717
+
684 718
 #ifdef CSH
685 719
 char *cshname INIT(CSH);
686 720
 int cshlen INIT(0);
@@ -790,14 +824,14 @@ EXT short *ds;
790 824
 /* Fix these up for __STDC__ */
791 825
 EXT long basetime INIT(0);
792 826
 char *mktemp();
793  
-#ifndef __STDC__
  827
+#ifndef STANDARD_C
794 828
 /* All of these are in stdlib.h or time.h for ANSI C */
795 829
 double atof();
796 830
 long time();
797 831
 struct tm *gmtime(), *localtime();
798 832
 char *index(), *rindex();
799 833
 char *strcpy(), *strcat();
800  
-#endif /* ! __STDC__ */
  834
+#endif /* ! STANDARD_C */
801 835
 
802 836
 #ifdef EUNICE
803 837
 #define UNLINK unlnk
243  perl.man
... ...
@@ -1,7 +1,14 @@
1 1
 .rn '' }`
2  
-''' $RCSfile: perl.man,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:50:44 $
  2
+''' $RCSfile: perl.man,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:41:23 $
3 3
 ''' 
4 4
 ''' $Log:	perl.man,v $
  5
+''' Revision 4.0.1.2  91/06/07  11:41:23  lwall
  6
+''' patch4: added global modifier for pattern matches
  7
+''' patch4: default top-of-form format is now FILEHANDLE_TOP
  8
+''' patch4: added $^P variable to control calling of perldb routines
  9
+''' patch4: added $^F variable to specify maximum system fd, default 2
  10
+''' patch4: changed old $^P to $^X
  11
+''' 
5 12
 ''' Revision 4.0.1.1  91/04/11  17:50:44  lwall
6 13
 ''' patch1: fixed some typos
7 14
 ''' 
@@ -1606,58 +1613,6 @@ Thus, a portable way to find out the home directory might be:
1606 1613
 	    (getpwuid($<))[7] || die "You're homeless!\en";
1607 1614
 
1608 1615
 .fi
1609  
-''' Beginning of part 2
1610  
-''' $RCSfile: perl.man,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:50:44 $
1611  
-'''
1612  
-''' $Log:	perl.man,v $
1613  
-''' Revision 4.0.1.1  91/04/11  17:50:44  lwall
1614  
-''' patch1: fixed some typos
1615  
-''' 
1616  
-''' Revision 4.0  91/03/20  01:38:08  lwall
1617  
-''' 4.0 baseline.
1618  
-''' 
1619  
-''' Revision 3.0.1.11  91/01/11  18:17:08  lwall
1620  
-''' patch42: fixed some man page entries
1621  
-''' 
1622  
-''' Revision 3.0.1.10  90/11/10  01:46:29  lwall
1623  
-''' patch38: random cleanup
1624  
-''' patch38: added alarm function
1625  
-''' 
1626  
-''' Revision 3.0.1.9  90/10/15  18:17:37  lwall
1627  
-''' patch29: added caller
1628  
-''' patch29: index and substr now have optional 3rd args
1629  
-''' patch29: added SysV IPC
1630  
-''' 
1631  
-''' Revision 3.0.1.8  90/08/13  22:21:00  lwall
1632  
-''' patch28: documented that you can't interpolate $) or $| in pattern
1633  
-''' 
1634  
-''' Revision 3.0.1.7  90/08/09  04:27:04  lwall
1635  
-''' patch19: added require operator
1636  
-''' 
1637  
-''' Revision 3.0.1.6  90/08/03  11:15:29  lwall
1638  
-''' patch19: Intermediate diffs for Randal
1639  
-''' 
1640  
-''' Revision 3.0.1.5  90/03/27  16:15:17  lwall
1641  
-''' patch16: MSDOS support
1642  
-''' 
1643  
-''' Revision 3.0.1.4  90/03/12  16:46:02  lwall
1644  
-''' patch13: documented behavior of @array = /noparens/
1645  
-''' 
1646  
-''' Revision 3.0.1.3  90/02/28  17:55:58  lwall
1647  
-''' patch9: grep now returns number of items matched in scalar context
1648  
-''' patch9: documented in-place modification capabilites of grep
1649  
-''' 
1650  
-''' Revision 3.0.1.2  89/11/17  15:30:16  lwall
1651  
-''' patch5: fixed some manual typos and indent problems
1652  
-''' 
1653  
-''' Revision 3.0.1.1  89/11/11  04:43:10  lwall
1654  
-''' patch2: made some line breaks depend on troff vs. nroff
1655  
-''' patch2: example of unshift had args backwards
1656  
-''' 
1657  
-''' Revision 3.0  89/10/18  15:21:37  lwall
1658  
-''' 3.0 baseline
1659  
-''' 
1660  
-'''
1661 1616
 .PP
1662 1617
 Along with the literals and variables mentioned earlier,
1663 1618
 the operations in the following section can serve as terms in an expression.
@@ -1796,7 +1751,7 @@ Returns the number of files successfully changed.
1796 1751
 
1797 1752
 .fi
1798 1753
 .ne 23
1799  
-Here's an example of looking up non-numeric uids:
  1754
+Here's an example that looks up non-numeric uids in the passwd file:
1800 1755
 .nf
1801 1756
 
1802 1757
 	print "User: ";
@@ -2718,8 +2673,8 @@ If EXPR is omitted, returns log of $_.
2718 2673
 Does the same thing as the stat() function, but stats a symbolic link
2719 2674
 instead of the file the symbolic link points to.
2720 2675
 If symbolic links are unimplemented on your system, a normal stat is done.
2721  
-.Ip "m/PATTERN/io" 8 4
2722  
-.Ip "/PATTERN/io" 8
  2676
+.Ip "m/PATTERN/gio" 8 4
  2677
+.Ip "/PATTERN/gio" 8
2723 2678
 Searches a string for a pattern match, and returns true (1) or false (\'\').
2724 2679
 If no string is specified via the =~ or !~ operator,
2725 2680
 the $_ string is searched.
@@ -2778,6 +2733,36 @@ This last example splits $foo into the first two words and the remainder
2778 2733
 of the line, and assigns those three fields to $F1, $F2 and $Etc.
2779 2734
 The conditional is true if any variables were assigned, i.e. if the pattern
2780 2735
 matched.
  2736
+.Sp
  2737
+The \*(L"g\*(R" modifier specifies global pattern matching\*(--that is,
  2738
+matching as many times as possible within the string.  How it behaves
  2739
+depends on the context.  In an array context, it returns a list of
  2740
+all the substrings matched by all the parentheses in the regular expression.
  2741
+If there are no parentheses, it returns a list of all the matched strings,
  2742
+as if there were parentheses around the whole pattern.  In a scalar context,
  2743
+it iterates through the string, returning TRUE each time it matches, and
  2744
+FALSE when it eventually runs out of matches.  (In other words, it remembers
  2745
+where it left off last time and restarts the search at that point.)  It
  2746
+presumes that you have not modified the string since the last match.
  2747
+Modifying the string between matches may result in undefined behavior.
  2748
+(You can actually get away with in-place modifications via substr()
  2749
+that do not change the length of the entire string.  In general, however,
  2750
+you should be using s///g for such modifications.)  Examples:
  2751
+.nf
  2752
+
  2753
+	# array context
  2754
+	($one,$five,$fifteen) = (\`uptime\` =~ /(\ed+\e.\ed+)/g);
  2755
+
  2756
+	# scalar context
  2757
+	$/ = 1; $* = 1;
  2758
+	while ($paragraph = <>) {
  2759
+	    while ($paragraph =~ /[a-z][\'")]*[.!?]+[\'")]*\es/g) {
  2760
+		$sentences++;
  2761
+	    }
  2762
+	}
  2763
+	print "$sentences\en";
  2764
+
  2765
+.fi
2781 2766
 .Ip "mkdir(FILENAME,MODE)" 8 3
2782 2767
 Creates the directory specified by FILENAME, with permissions specified by
2783 2768
 MODE (as modified by umask).
@@ -2802,70 +2787,6 @@ SIZE.  Note that if a message is received, the message type will be
2802 2787
 the first thing in VAR, and the maximum length of VAR is SIZE plus the
2803 2788
 size of the message type.  Returns true if successful, or false if
2804 2789
 there is an error.
2805  
-''' Beginning of part 3
2806  
-''' $RCSfile: perl.man,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:50:44 $
2807  
-'''
2808  
-''' $Log:	perl.man,v $
2809  
-''' Revision 4.0.1.1  91/04/11  17:50:44  lwall
2810  
-''' patch1: fixed some typos
2811  
-''' 
2812  
-''' Revision 4.0  91/03/20  01:38:08  lwall
2813  
-''' 4.0 baseline.
2814  
-''' 
2815  
-''' Revision 3.0.1.12  91/01/11  18:18:15  lwall
2816  
-''' patch42: added binary and hex pack/unpack options
2817  
-''' 
2818  
-''' Revision 3.0.1.11  90/11/10  01:48:21  lwall
2819  
-''' patch38: random cleanup
2820  
-''' patch38: documented tr///cds
2821  
-''' 
2822  
-''' Revision 3.0.1.10  90/10/20  02:15:17  lwall
2823  
-''' patch37: patch37: fixed various typos in man page
2824  
-''' 
2825  
-''' Revision 3.0.1.9  90/10/16  10:02:43  lwall
2826  
-''' patch29: you can now read into the middle string
2827  
-''' patch29: index and substr now have optional 3rd args
2828  
-''' patch29: added scalar reverse
2829  
-''' patch29: added scalar
2830  
-''' patch29: added SysV IPC
2831  
-''' patch29: added waitpid
2832  
-''' patch29: added sysread and syswrite
2833  
-''' 
2834  
-''' Revision 3.0.1.8  90/08/09  04:39:04  lwall
2835  
-''' patch19: added require operator
2836  
-''' patch19: added truncate operator
2837  
-''' patch19: unpack can do checksumming
2838  
-''' 
2839  
-''' Revision 3.0.1.7  90/08/03  11:15:42  lwall
2840  
-''' patch19: Intermediate diffs for Randal
2841  
-''' 
2842  
-''' Revision 3.0.1.6  90/03/27  16:17:56  lwall
2843  
-''' patch16: MSDOS support
2844  
-''' 
2845  
-''' Revision 3.0.1.5  90/03/12  16:52:21  lwall
2846  
-''' patch13: documented that print $filehandle &foo is ambiguous
2847  
-''' patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST)
2848  
-''' 
2849  
-''' Revision 3.0.1.4  90/02/28  18:00:09  lwall
2850  
-''' patch9: added pipe function
2851  
-''' patch9: documented how to handle arbitrary weird characters in filenames
2852  
-''' patch9: documented the unflushed buffers problem on piped opens
2853  
-''' patch9: documented how to force top of page
2854  
-''' 
2855  
-''' Revision 3.0.1.3  89/12/21  20:10:12  lwall
2856  
-''' patch7: documented that s`pat`repl` does command substitution on replacement
2857  
-''' patch7: documented that $timeleft from select() is likely not implemented
2858  
-''' 
2859  
-''' Revision 3.0.1.2  89/11/17  15:31:05  lwall
2860  
-''' patch5: fixed some manual typos and indent problems
2861  
-''' patch5: added warning about print making an array context
2862  
-''' 
2863  
-''' Revision 3.0.1.1  89/11/11  04:45:06  lwall
2864  
-''' patch2: made some line breaks depend on troff vs. nroff
2865  
-''' 
2866  
-''' Revision 3.0  89/10/18  15:21:46  lwall
2867  
-''' 3.0 baseline
2868  
-''' 
2869 2790
 .Ip "next LABEL" 8 8
2870 2791
 .Ip "next" 8
2871 2792
 The
@@ -3661,6 +3582,7 @@ If SUBROUTINE is omitted, sorts in standard string comparison order.
3661 3582
 If SUBROUTINE is specified, gives the name of a subroutine that returns
3662 3583
 an integer less than, equal to, or greater than 0,
3663 3584
 depending on how the elements of the array are to be ordered.
  3585
+(The <=> and cmp operators are extremely useful in such routines.)
3664 3586
 In the interests of efficiency the normal calling code for subroutines
3665 3587
 is bypassed, with the following effects: the subroutine may not be a recursive
3666 3588
 subroutine, and the two elements to be compared are passed into the subroutine
@@ -3673,12 +3595,12 @@ Examples:
3673 3595
 
3674 3596
 .ne 4
3675 3597
 	sub byage {
3676  
-	    $age{$a} - $age{$b};	# presuming integers
  3598
+	    $age{$a} <=> $age{$b};	# presuming integers
3677 3599
 	}
3678 3600
 	@sortedclass = sort byage @class;
3679 3601
 
3680 3602
 .ne 9
3681  
-	sub reverse { $a lt $b ? 1 : $a gt $b ? \-1 : 0; }
  3603
+	sub reverse { $b cmp $a; }
3682 3604
 	@harry = (\'dog\',\'cat\',\'x\',\'Cain\',\'Abel\');
3683 3605
 	@george = (\'gone\',\'chased\',\'yz\',\'Punished\',\'Axed\');
3684 3606
 	print sort @harry;
@@ -3842,6 +3764,7 @@ Example:
3842 3764
 	}
3843 3765
 
3844 3766
 .fi
  3767
+(This only works on machines for which the device number is negative under NFS.)
3845 3768
 .Ip "study(SCALAR)" 8 6
3846 3769
 .Ip "study SCALAR" 8
3847 3770
 .Ip "study"
@@ -4266,65 +4189,6 @@ resulting string is used to look up the name of the FILEHANDLE at run time.
4266 4189
 For more on formats, see the section on formats later on.
4267 4190
 .Sp
4268 4191
 Note that write is NOT the opposite of read.
4269  
-''' Beginning of part 4
4270  
-''' $RCSfile: perl.man,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:50:44 $
4271  
-'''
4272  
-''' $Log:	perl.man,v $
4273  
-''' Revision 4.0.1.1  91/04/11  17:50:44  lwall
4274  
-''' patch1: fixed some typos
4275  
-''' 
4276  
-''' Revision 4.0  91/03/20  01:38:08  lwall
4277  
-''' 4.0 baseline.
4278  
-''' 
4279  
-''' Revision 3.0.1.14  91/01/11  18:18:53  lwall
4280  
-''' patch42: started an addendum and errata section in the man page
4281  
-''' 
4282  
-''' Revision 3.0.1.13  90/11/10  01:51:00  lwall
4283  
-''' patch38: random cleanup
4284  
-''' 
4285  
-''' Revision 3.0.1.12  90/10/20  02:15:43  lwall
4286  
-''' patch37: patch37: fixed various typos in man page
4287  
-''' 
4288  
-''' Revision 3.0.1.11  90/10/16  10:04:28  lwall
4289  
-''' patch29: added @###.## fields to format
4290  
-''' 
4291  
-''' Revision 3.0.1.10  90/08/09  04:47:35  lwall
4292  
-''' patch19: added require operator
4293  
-''' patch19: added numeric interpretation of $]
4294  
-''' 
4295  
-''' Revision 3.0.1.9  90/08/03  11:15:58  lwall
4296  
-''' patch19: Intermediate diffs for Randal
4297  
-''' 
4298  
-''' Revision 3.0.1.8  90/03/27  16:19:31  lwall
4299  
-''' patch16: MSDOS support
4300  
-''' 
4301  
-''' Revision 3.0.1.7  90/03/14  12:29:50  lwall
4302  
-''' patch15: man page falsely states that you can't subscript array values
4303  
-''' 
4304  
-''' Revision 3.0.1.6  90/03/12  16:54:04  lwall
4305  
-''' patch13: improved documentation of *name
4306  
-''' 
4307  
-''' Revision 3.0.1.5  90/02/28  18:01:52  lwall
4308  
-''' patch9: $0 is now always the command name
4309  
-''' 
4310  
-''' Revision 3.0.1.4  89/12/21  20:12:39  lwall
4311  
-''' patch7: documented that package'filehandle works as well as $package'variable
4312  
-''' patch7: documented which identifiers are always in package main
4313  
-''' 
4314  
-''' Revision 3.0.1.3  89/11/17  15:32:25  lwall
4315  
-''' patch5: fixed some manual typos and indent problems
4316  
-''' patch5: clarified difference between $! and $@
4317  
-''' 
4318  
-''' Revision 3.0.1.2  89/11/11  04:46:40  lwall
4319  
-''' patch2: made some line breaks depend on troff vs. nroff
4320  
-''' patch2: clarified operation of ^ and $ when $* is false
4321  
-''' 
4322  
-''' Revision 3.0.1.1  89/10/26  23:18:43  lwall
4323  
-''' patch1: documented the desirability of unnecessary parentheses
4324  
-''' 
4325  
-''' Revision 3.0  89/10/18  15:21:55  lwall
4326  
-''' 3.0 baseline
4327  
-''' 
4328 4192
 .Sh "Precedence"
4329 4193
 .I Perl
4330 4194
 operators have the following associativity and precedence:
@@ -4736,7 +4600,7 @@ Examples:
4736 4600
 
4737 4601
 .ne 10
4738 4602
 # a report on the /etc/passwd file
4739  
-format top =
  4603
+format STDOUT_TOP =
4740 4604
 \&                        Passwd File
4741 4605
 Name                Login    Office   Uid   Gid Home
4742 4606
 ------------------------------------------------------------------
@@ -4748,7 +4612,7 @@ $name,              $login,  $office,$uid,$gid, $home
4748 4612
 
4749 4613
 .ne 29
4750 4614
 # a report from a bug report form
4751  
-format top =
  4615
+format STDOUT_TOP =
4752 4616
 \&                        Bug Reports
4753 4617
 @<<<<<<<<<<<<<<<<<<<<<<<     @|||         @>>>>>>>>>>>>>>>>>>>>>>>
4754 4618
 $system,                      $%,         $date
@@ -4990,10 +4854,12 @@ The number of lines left on the page of the currently selected output channel.
4990 4854
 .Ip $~ 8
4991 4855
 The name of the current report format for the currently selected output
4992 4856
 channel.
  4857
+Default is name of the filehandle.
4993 4858
 (Mnemonic: brother to $^.)
4994 4859
 .Ip $^ 8
4995 4860
 The name of the current top-of-page format for the currently selected output
4996 4861
 channel.
  4862
+Default is name of the filehandle with \*(L"_TOP\*(R" appended.
4997 4863
 (Mnemonic: points to top of page.)
4998 4864
 .Ip $| 8
4999 4865
 If set to nonzero, forces a flush after every write or print on the currently
@@ -5197,6 +5063,11 @@ The current value of the debugging flags.
5197 5063
 (Mnemonic: value of
5198 5064
 .B \-D
5199 5065
 switch.)
  5066
+.Ip $^F 8 2
  5067
+The maximum system file descriptor, ordinarily 2.  System file descriptors
  5068
+are passed to subprocesses, while higher file descriptors are not.
  5069
+During an open, system file descriptors are preserved even if the open
  5070
+fails.  Ordinary file descriptors are closed before the open is attempted.
5200 5071
 .Ip $^I 8 2
5201 5072
 The current value of the inplace-edit extension.
5202 5073
 Use undef to disable inplace editing.
@@ -5204,7 +5075,9 @@ Use undef to disable inplace editing.
5204 5075
 .B \-i
5205 5076
 switch.)
5206 5077
 .Ip $^P 8 2
5207  
-The name that Perl itself was invoked as, from argv[0].
  5078
+The internal flag that the debugger clears so that it doesn't
  5079
+debug itself.  You could conceivable disable debugging yourself
  5080
+by clearing it.
5208 5081
 .Ip $^T 8 2
5209 5082
 The time at which the script began running, in seconds since the epoch.
5210 5083
 The values returned by the
@@ -5218,6 +5091,8 @@ The current value of the warning switch.
5218 5091
 (Mnemonic: related to the
5219 5092
 .B \-w
5220 5093
 switch.)
  5094
+.Ip $^X 8 2
  5095
+The name that Perl itself was executed as, from argv[0].
5221 5096
 .Ip $ARGV 8 3
5222 5097
 contains the name of the current file when reading from <>.
5223 5098
 .Ip @ARGV 8 3