perl 3.0 patch #44 patch #42, continuedperl-3.044

See patch #42.

15 files changed, 192 insertions, 69 deletions

diff --git a/Configure b/Configure
index a1bdeb41f2..f40c802da2 100755
--- a/Configure
+++ b/Configure
@@ -8,7 +8,7 @@
 # and edit it to reflect your system.  Some packages may include samples
 # of config.h for certain machines, so you might look for one of those.)
 #
-# $Header: Configure,v 3.0.1.13 91/01/11 17:01:32 lwall Locked $
+# $Header: Configure,v 3.0.1.14 91/01/11 21:56:38 lwall Locked $
 #
 # Yes, you may rip this off to use in other distribution packages.
 # (Note: this Configure script was generated automatically.  Rather than
@@ -1321,15 +1321,16 @@ main()
 	exit(result);
 }
 EOCP
-if $cc -o try $ccflags try.c >/dev/null 2>&1 && ./try; then
-    d_castneg="$define"
-    castflags=0
+$cc -o try $ccflags try.c >/dev/null 2>&1 && ./try
+castflags=$?
+case "$castflags" in
+0)  d_castneg="$define"
     echo "Yup, it does."
-else
-    d_castneg="$undef"
-    castflags=$?
+    ;;
+*)  d_castneg="$undef"
     echo "Nope, it doesn't."
-fi
+    ;;
+esac
 $rm -f try.*
 
 : see how we invoke the C preprocessor
diff --git a/lib/perldb.pl b/lib/perldb.pl
index c86fb16506..4c2f54d499 100644
--- a/lib/perldb.pl
+++ b/lib/perldb.pl
@@ -1,6 +1,6 @@
 package DB;
 
-$header = '$Header: perldb.pl,v 3.0.1.5 90/11/10 01:40:26 lwall Locked $';
+$header = '$Header: perldb.pl,v 3.0.1.6 91/01/11 18:08:58 lwall Locked $';
 #
 # This file is automatically included if you do perl -d.
 # It's probably not useful to include this yourself.
@@ -10,6 +10,9 @@ $header = '$Header: perldb.pl,v 3.0.1.5 90/11/10 01:40:26 lwall Locked $';
 # have a breakpoint.  It also inserts a do 'perldb.pl' before the first line.
 #
 # $Log:	perldb.pl,v $
+# Revision 3.0.1.6  91/01/11  18:08:58  lwall
+# patch42: @_ couldn't be accessed from debugger
+# 
 # Revision 3.0.1.5  90/11/10  01:40:26  lwall
 # patch38: the debugger wouldn't stop correctly or do action routines
 # 
@@ -62,7 +65,7 @@ sub DB {
 	    $signal |= 1;
 	}
 	else {
-	    &eval("\$DB'signal |= do {$stop;}");
+	    $evalarg = "\$DB'signal |= do {$stop;}"; &eval;
 	    $dbline{$line} =~ s/;9($|\0)/$1/;
 	}
     }
@@ -74,9 +77,9 @@ sub DB {
 	    print OUT "$sub($filename:$i):\t",$dbline[$i];
 	}
     }
-    &eval($action) if $action;
+    $evalarg = $action, &eval if $action;
     if ($single || $signal) {
-	&eval($pre) if $pre;
+	$evalarg = $pre, &eval if $pre;
 	print OUT $#stack . " levels deep in subroutine calls!\n"
 	    if $single & 4;
 	$start = $line;
@@ -452,11 +455,11 @@ command		Execute as a perl statement in current package.
 		    };
 		};
 		next; };
-	    &eval($cmd);
+	    $evalarg = $cmd; &eval;
 	    print OUT "\n";
 	}
 	if ($post) {
-	    &eval($post);
+	    $evalarg = $post; &eval;
 	}
     }
     ($@, $!, $[, $,, $/, $\) = @saved;
@@ -467,8 +470,10 @@ sub save {
     $[ = 0; $, = ""; $/ = "\n"; $\ = "";
 }
 
+# The following takes its argument via $evalarg to preserve current @_
+
 sub eval {
-    eval "$usercontext $_[0]; &DB'save";
+    eval "$usercontext $evalarg; &DB'save";
     print OUT $@;
 }
 
diff --git a/lib/pwd.pl b/lib/pwd.pl
index c141e9888e..7abcc1f97d 100644
--- a/lib/pwd.pl
+++ b/lib/pwd.pl
@@ -1,8 +1,11 @@
 ;# pwd.pl - keeps track of current working directory in PWD environment var
 ;#
-;# $Header: pwd.pl,v 3.0.1.1 90/08/09 04:01:24 lwall Locked $
+;# $Header: pwd.pl,v 3.0.1.2 91/01/11 18:09:24 lwall Locked $
 ;#
 ;# $Log:	pwd.pl,v $
+;# Revision 3.0.1.2  91/01/11  18:09:24  lwall
+;# patch42: some .pl files were missing their trailing 1;
+;# 
 ;# Revision 3.0.1.1  90/08/09  04:01:24  lwall
 ;# patch19: Initial revision
 ;# 
@@ -46,3 +49,4 @@ sub main'chdir {
     }
 }
 
+1;
diff --git a/patchlevel.h b/patchlevel.h
index 64b1306a8b..760709b84a 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 43
+#define PATCHLEVEL 44
diff --git a/perl.man.1 b/perl.man.1
index 9a24089704..fdc606c215 100644
--- a/perl.man.1
+++ b/perl.man.1
@@ -1,7 +1,10 @@
 .rn '' }`
-''' $Header: perl_man.1,v 3.0.1.10 90/11/10 01:45:16 lwall Locked $
+''' $Header: perl_man.1,v 3.0.1.11 91/01/11 18:15:46 lwall Locked $
 ''' 
 ''' $Log:	perl.man.1,v $
+''' Revision 3.0.1.11  91/01/11  18:15:46  lwall
+''' patch42: added -0 option
+''' 
 ''' Revision 3.0.1.10  90/11/10  01:45:16  lwall
 ''' patch38: random cleanup
 ''' 
@@ -180,6 +183,22 @@ only allows one argument.  Example:
 .fi
 Options include:
 .TP 5
+.BI \-0 digits
+specifies the record separator ($/) as an octal number.
+If there are no digits, the null character is the separator.
+Other switches may precede or follow the digits.
+For example, if you have a version of
+.I find
+which can print filenames terminated by the null character, you can say this:
+.nf
+
+    find . \-name '*.bak' \-print0 | perl \-n0e unlink
+
+.fi
+The special value 00 will cause Perl to slurp files in paragraph mode.
+The value 0777 will cause Perl to slurp files whole since there is no
+legal character with that value.
+.TP 5
 .B \-a
 turns on autosplit mode when used with a
 .B \-n
diff --git a/perl.man.2 b/perl.man.2
index b9c37ef313..a6ab6a1a86 100644
--- a/perl.man.2
+++ b/perl.man.2
@@ -1,7 +1,10 @@
 ''' Beginning of part 2
-''' $Header: perl_man.2,v 3.0.1.10 90/11/10 01:46:29 lwall Locked $
+''' $Header: perl_man.2,v 3.0.1.11 91/01/11 18:17:08 lwall Locked $
 '''
 ''' $Log:	perl.man.2,v $
+''' Revision 3.0.1.11  91/01/11  18:17:08  lwall
+''' patch42: fixed some man page entries
+''' 
 ''' Revision 3.0.1.10  90/11/10  01:46:29  lwall
 ''' patch38: random cleanup
 ''' patch38: added alarm function
@@ -88,8 +91,8 @@ Only one timer may be counting at once.  Each call disables the previous
 timer, and an argument of 0 may be supplied to cancel the previous timer
 without starting a new one.
 The returned value is the amount of time remaining on the previous timer.
-.Ip "atan2(X,Y)" 8 2
-Returns the arctangent of X/Y in the range
+.Ip "atan2(Y,X)" 8 2
+Returns the arctangent of Y/X in the range
 .if t \-\(*p to \(*p.
 .if n \-PI to PI.
 .Ip "bind(SOCKET,NAME)" 8 2
@@ -653,6 +656,7 @@ the filehandle.
 .Ip "flock(FILEHANDLE,OPERATION)" 8 4
 Calls flock(2) on FILEHANDLE.
 See manual page for flock(2) for definition of OPERATION.
+Returns true for success, false on failure.
 Will produce a fatal error if used on a machine that doesn't implement
 flock(2).
 Here's a mailbox appender for BSD systems.
@@ -957,7 +961,7 @@ Here is yet another way to print your environment:
 	@keys = keys %ENV;
 	@values = values %ENV;
 	while ($#keys >= 0) {
-		print pop(keys), \'=\', pop(values), "\en";
+		print pop(@keys), \'=\', pop(@values), "\en";
 	}
 
 or how about sorted by key:
diff --git a/perl.man.3 b/perl.man.3
index be1cc72e2b..d4574ebd69 100644
--- a/perl.man.3
+++ b/perl.man.3
@@ -1,7 +1,10 @@
 ''' Beginning of part 3
-''' $Header: perl_man.3,v 3.0.1.11 90/11/10 01:48:21 lwall Locked $
+''' $Header: perl_man.3,v 3.0.1.12 91/01/11 18:18:15 lwall Locked $
 '''
 ''' $Log:	perl.man.3,v $
+''' Revision 3.0.1.12  91/01/11  18:18:15  lwall
+''' patch42: added binary and hex pack/unpack options
+''' 
 ''' Revision 3.0.1.11  90/11/10  01:48:21  lwall
 ''' patch38: random cleanup
 ''' patch38: documented tr///cds
@@ -291,17 +294,24 @@ of values, as follows:
 	X	Back up a byte.
 	@	Null fill to absolute position.
 	u	A uuencoded string.
+	b	A bit string (ascending bit order, like vec()).
+	B	A bit string (descending bit order).
+	h	A hex string (low nybble first).
+	H	A hex string (high nybble first).
 
 .fi
 Each letter may optionally be followed by a number which gives a repeat
 count.
-With all types except "a" and "A" the pack function will gobble up that many values
+With all types except "a", "A", "b", "B", "h" and "H",
+the pack function will gobble up that many values
 from the LIST.
 A * for the repeat count means to use however many items are left.
 The "a" and "A" types gobble just one value, but pack it as a string of length
 count,
 padding with nulls or spaces as necessary.
 (When unpacking, "A" strips trailing spaces and nulls, but "a" does not.)
+Likewise, the "b" and "B" fields pack a string that many bits long.
+The "h" and "H" fields pack a string that many nybbles long.
 Real numbers (floats and doubles) are in the native machine format
 only; due to the multiplicity of floating formats around, and the lack
 of a standard \*(L"network\*(R" representation, no facility for
@@ -342,6 +352,9 @@ Examples:
 	$foo = pack("i9pl", gmtime);
 	# a real struct tm (on my system anyway)
 
+	sub bintodec {
+	    unpack("N", pack("B32", substr("0" x 32 . shift, -32)));
+	}
 .fi
 The same template may generally also be used in the unpack function.
 .Ip "pipe(READHANDLE,WRITEHANDLE)" 8 3
@@ -1358,6 +1371,15 @@ which will assume a bit vector operation is desired when both operands are
 strings.
 This interpretation is not enabled unless there is at least one vec() in
 your program, to protect older programs.
+.Sp
+To transform a bit vector into a string or array of 0's and 1's, use these:
+.nf
+
+	$bits = unpack("b*", $vector);
+	@bits = split(//, unpack("b*", $vector));
+
+.fi
+If you know the exact length in bits, it can be used in place of the *.
 .Ip "wait" 8 6
 Waits for a child process to terminate and returns the pid of the deceased
 process, or -1 if there are no child processes.
diff --git a/perl.man.4 b/perl.man.4
index 7100e80a22..54ddff5248 100644
--- a/perl.man.4
+++ b/perl.man.4
@@ -1,7 +1,10 @@
 ''' Beginning of part 4
-''' $Header: perl_man.4,v 3.0.1.13 90/11/10 01:51:00 lwall Locked $
+''' $Header: perl_man.4,v 3.0.1.14 91/01/11 18:18:53 lwall Locked $
 '''
 ''' $Log:	perl.man.4,v $
+''' Revision 3.0.1.14  91/01/11  18:18:53  lwall
+''' patch42: started an addendum and errata section in the man page
+''' 
 ''' Revision 3.0.1.13  90/11/10  01:51:00  lwall
 ''' patch38: random cleanup
 ''' 
@@ -407,6 +410,7 @@ with multiple <, >, or | characters to specify, respectively, left justification
 right justification, or centering.
 As an alternate form of right justification,
 you may also use # characters (with an optional .) to specify a numeric field.
+(Use of ^ instead of @ causes the field to be blanked if undefined.)
 If any of the values supplied for these fields contains a newline, only
 the text up to the newline is printed.
 The special field @* can be used for printing multi-line values.
@@ -1556,6 +1560,18 @@ compiles the whole program before executing it.
 The arguments are available via @ARGV, not $1, $2, etc.
 .Ip * 4 2
 The environment is not automatically made available as variables.
+.SH ERRATA\0AND\0ADDENDA
+The Perl book,
+.I Programming\0Perl ,
+has the following omissions and goofs.
+.PP
+The
+.B \-0
+switch was added to Perl after the book went to press.
+.PP
+The new @###.## format was omitted accidentally.
+.PP
+It wasn't known at press time that s///ee caused multiple evaluations.
 .SH BUGS
 .PP
 .I Perl
diff --git a/perl.y b/perl.y
index 5c5b4a4796..b3e7512948 100644
--- a/perl.y
+++ b/perl.y
@@ -1,4 +1,4 @@
-/* $Header: perl.y,v 3.0.1.10 91/01/11 18:14:28 lwall Locked $
+/* $Header: perl.y,v 3.0.1.11 91/01/11 21:57:40 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:	perl.y,v $
+ * Revision 3.0.1.11  91/01/11  21:57:40  lwall
+ * patch42: addendum
+ * 
  * Revision 3.0.1.10  91/01/11  18:14:28  lwall
  * patch42: package didn't create symbol tables that could be reset
  * patch42: split with no arguments could wipe out next operator
@@ -672,7 +675,7 @@ term	:	'-' term %prec UMINUS
 	|	SPLIT	%prec '('
 			{   static char p[]="/\\s+/";
 			    char *oldend = bufend;
-			    int oldarg = yylval.arg;
+			    ARG *oldarg = yylval.arg;
 			    
 			    bufend=p+5;
 			    (void)scanpat(p);
diff --git a/perly.c b/perly.c
index 08aa11f10f..87acead688 100644
--- a/perly.c
+++ b/perly.c
@@ -1,4 +1,4 @@
-char rcsid[] = "$Header: perly.c,v 3.0.1.9 90/11/10 01:53:26 lwall Locked $\nPatch level: ###\n";
+char rcsid[] = "$Header: perly.c,v 3.0.1.10 91/01/11 18:22:48 lwall Locked $\nPatch level: ###\n";
 /*
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,11 @@ char rcsid[] = "$Header: perly.c,v 3.0.1.9 90/11/10 01:53:26 lwall Locked $\nPat
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	perly.c,v $
+ * Revision 3.0.1.10  91/01/11  18:22:48  lwall
+ * patch42: added -0 option
+ * patch42: ANSIfied the stat mode checking
+ * patch42: executables for multiple versions may now coexist
+ * 
  * Revision 3.0.1.9  90/11/10  01:53:26  lwall
  * patch38: random cleanup
  * patch38: more msdos/os2 upgrades
@@ -82,6 +87,7 @@ static char* moreswitches();
 static char* cddir;
 extern char **environ;
 static bool minus_c;
+static char patchlevel[6];
 
 main(argc,argv,env)
 register int argc;
@@ -110,6 +116,7 @@ setuid perl scripts securely.\n");
     euid = (int)geteuid();
     gid = (int)getgid();
     egid = (int)getegid();
+    sprintf(patchlevel,"%3.3s%2.2d", rcsid+19, PATCHLEVEL);
 #ifdef MSDOS
     /*
      * There is no way we can refer to them from Perl so close them to save
@@ -147,6 +154,7 @@ setuid perl scripts securely.\n");
 	s = argv[0]+1;
       reswitch:
 	switch (*s) {
+	case '0':
 	case 'a':
 	case 'c':
 	case 'd':
@@ -287,8 +295,8 @@ setuid perl scripts securely.\n");
 #endif
 	    if (stat(tokenbuf,&statbuf) < 0)		/* not there? */
 		continue;
-	    if ((statbuf.st_mode & S_IFMT) == S_IFREG
-	     && cando(S_IREAD,TRUE,&statbuf) && cando(S_IEXEC,TRUE,&statbuf)) {
+	    if (S_ISREG(statbuf.st_mode)
+	     && cando(S_IRUSR,TRUE,&statbuf) && cando(S_IXUSR,TRUE,&statbuf)) {
 		xfound = tokenbuf;              /* bingo! */
 		break;
 	    }
@@ -303,7 +311,7 @@ setuid perl scripts securely.\n");
     }
 
     fdpid = anew(Nullstab);	/* for remembering popen pids by fd */
-    pidstatus = hnew(Nullstab);	/* for remembering status of dead pids */
+    pidstatus = hnew(COEFFSIZE);/* for remembering status of dead pids */
 
     origfilename = savestr(argv[0]);
     curcmd->c_filestab = fstab(origfilename);
@@ -360,7 +368,7 @@ setuid perl scripts securely.\n");
 #ifndef IAMSUID		/* in case script is not readable before setuid */
 	if (euid && stat(stab_val(curcmd->c_filestab)->str_ptr,&statbuf) >= 0 &&
 	  statbuf.st_mode & (S_ISUID|S_ISGID)) {
-	    (void)sprintf(buf, "%s/%s", BIN, "suidperl");
+	    (void)sprintf(buf, "%s/sperl%s", BIN, patchlevel);
 	    execv(buf, origargv);	/* try again */
 	    fatal("Can't do setuid\n");
 	}
@@ -378,12 +386,13 @@ setuid perl scripts securely.\n");
      * in perl will not fix that problem, but if you have disabled setuid
      * scripts in the kernel, this will attempt to emulate setuid and setgid
      * on scripts that have those now-otherwise-useless bits set.  The setuid
-     * root version must be called suidperl.  If regular perl discovers that
-     * it has opened a setuid script, it calls suidperl with the same argv
-     * that it had.  If suidperl finds that the script it has just opened
-     * is NOT setuid root, it sets the effective uid back to the uid.  We
-     * don't just make perl setuid root because that loses the effective
-     * uid we had before invoking perl, if it was different from the uid.
+     * root version must be called suidperl or sperlN.NNN.  If regular perl
+     * discovers that it has opened a setuid script, it calls suidperl with
+     * the same argv that it had.  If suidperl finds that the script it has
+     * just opened is NOT setuid root, it sets the effective uid back to the
+     * uid.  We don't just make perl setuid root because that loses the
+     * effective uid we had before invoking perl, if it was different from the
+     * uid.
      *
      * DOSUID must be defined in both perl and suidperl, and IAMSUID must
      * be defined in suidperl only.  suidperl must be setuid root.  The
@@ -394,7 +403,7 @@ setuid perl scripts securely.\n");
      * on these set-id scripts, but don't want to have the overhead of
      * them in normal perl, and can't use suidperl because it will lose
      * the effective uid info, so we have an additional non-setuid root
-     * version called taintperl that just does the TAINT checks.
+     * version called taintperl or tperlN.NNN that just does the TAINT checks.
      */
 
 #ifdef DOSUID
@@ -445,15 +454,15 @@ setuid perl scripts securely.\n");
 	    }
 	    if (setreuid(uid,euid) < 0 || getuid() != uid || geteuid() != euid)
 		fatal("Can't reswap uid and euid");
-	    if (!cando(S_IEXEC,FALSE,&statbuf))		/* can real uid exec? */
+	    if (!cando(S_IXUSR,FALSE,&statbuf))		/* can real uid exec? */
 		fatal("Permission denied\n");
 	}
 #endif /* SETREUID */
 #endif /* IAMSUID */
 
-	if ((statbuf.st_mode & S_IFMT) != S_IFREG)
+	if (!S_ISREG(statbuf.st_mode))
 	    fatal("Permission denied");
-	if ((statbuf.st_mode >> 6) & S_IWRITE)
+	if (statbuf.st_mode & S_IWOTH)
 	    fatal("Setuid/gid script is writable by world");
 	doswitches = FALSE;		/* -s is insecure in suid */
 	curcmd->c_line++;
@@ -463,7 +472,7 @@ setuid perl scripts securely.\n");
 	s = tokenbuf+2;
 	if (*s == ' ') s++;
 	while (!isspace(*s)) s++;
-	if (strnNE(s-4,"perl",4))	/* sanity check */
+	if (strnNE(s-4,"perl",4) && strnNE(s-9,"perl",4))  /* sanity check */
 	    fatal("Not a perl script");
 	while (*s == ' ' || *s == '\t') s++;
 	/*
@@ -487,7 +496,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 	if (euid) {	/* oops, we're not the setuid root perl */
 	    (void)fclose(rsfp);
 #ifndef IAMSUID
-	    (void)sprintf(buf, "%s/%s", BIN, "suidperl");
+	    (void)sprintf(buf, "%s/sperl%s", BIN, patchlevel);
 	    execv(buf, origargv);	/* try again */
 #endif
 	    fatal("Can't do setuid\n");
@@ -529,7 +538,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 	euid = (int)geteuid();
 	gid = (int)getgid();
 	egid = (int)getegid();
-	if (!cando(S_IEXEC,TRUE,&statbuf))
+	if (!cando(S_IXUSR,TRUE,&statbuf))
 	    fatal("Permission denied\n");	/* they can't do this */
     }
 #ifdef IAMSUID
@@ -542,7 +551,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
     /* script has a wrapper--can't run suidperl or we lose euid */
     else if (euid != uid || egid != gid) {
 	(void)fclose(rsfp);
-	(void)sprintf(buf, "%s/%s", BIN, "taintperl");
+	(void)sprintf(buf, "%s/tperl%s", BIN, patchlevel);
 	execv(buf, origargv);	/* try again */
 	fatal("Can't run setuid script with taint checks");
     }
@@ -563,7 +572,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 #endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */
 	/* not set-id, must be wrapped */
 	(void)fclose(rsfp);
-	(void)sprintf(buf, "%s/%s", BIN, "taintperl");
+	(void)sprintf(buf, "%s/tperl%s", BIN, patchlevel);
 	execv(buf, origargv);	/* try again */
 	fatal("Can't run setuid script with taint checks");
     }
@@ -677,9 +686,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
     if (tmpstab = stabent("]",allstabs)) {
 	str = STAB_STR(tmpstab);
 	str_set(str,rcsid);
-	strncpy(tokenbuf,rcsid+19,3);
-	sprintf(tokenbuf+3,"%2.2d",PATCHLEVEL);
-	str->str_u.str_nval = atof(tokenbuf);
+	str->str_u.str_nval = atof(patchlevel);
 	str->str_nok = 1;
     }
     str_nset(stab_val(stabent("\"", TRUE)), " ", 1);
@@ -1024,6 +1031,15 @@ char *s;
 {
   reswitch:
     switch (*s) {
+    case '0':
+	record_separator = 0;
+	if (s[1] == '0' && !isdigit(s[2]))
+	    rslen = 0;
+	while (*s >= '0' && *s <= '7') {
+	    record_separator <<= 3;
+	    record_separator += *s++ & 7;
+	}
+	return s;
     case 'a':
 	minus_a = TRUE;
 	s++;
diff --git a/stab.c b/stab.c
index 481a5042d8..8900e7f8c9 100644
--- a/stab.c
+++ b/stab.c
@@ -1,4 +1,4 @@
-/* $Header: stab.c,v 3.0.1.10 90/11/10 02:02:05 lwall Locked $
+/* $Header: stab.c,v 3.0.1.11 91/01/11 18:23:44 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.11  91/01/11  18:23:44  lwall
+ * patch42: added -0 option
+ * 
  * Revision 3.0.1.10  90/11/10  02:02:05  lwall
  * patch38: random cleanup
  * 
@@ -170,7 +173,7 @@ STR *str;
 	break;
 #endif
     case '/':
-	if (record_separator != 12345) {
+	if (record_separator != 0777) {
 	    *tokenbuf = record_separator;
 	    tokenbuf[1] = '\0';
 	    str_nset(stab_val(stab),tokenbuf,rslen);
@@ -401,7 +404,7 @@ STR *str;
 		rslen = str->str_cur;
 	    }
 	    else {
-		record_separator = 12345;	/* fake a non-existent char */
+		record_separator = 0777;	/* fake a non-existent char */
 		rslen = 1;
 	    }
 	    break;
diff --git a/str.c b/str.c
index e392cee728..7ec76fe906 100644
--- a/str.c
+++ b/str.c
@@ -1,4 +1,4 @@
-/* $Header: str.c,v 3.0.1.11 90/11/13 15:27:14 lwall Locked $
+/* $Header: str.c,v 3.0.1.12 91/01/11 18:26:54 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,11 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	str.c,v $
+ * Revision 3.0.1.12  91/01/11  18:26:54  lwall
+ * patch42: s/^foo/bar/ occasionally brought on core dumps
+ * patch42: undid unwarranted assumptions about memcmp() return value
+ * patch42: ('a' .. 'z') could lose its value in a loop
+ * 
  * Revision 3.0.1.11  90/11/13  15:27:14  lwall
  * patch41: fixed a couple of malloc/free problems
  * 
@@ -285,8 +290,14 @@ register STR *sstr;
 	    sstr->str_pok = 0;			/* wipe out any weird flags */
 	    sstr->str_state = 0;		/* so sstr frees uneventfully */
 	}
-	else					/* have to copy actual string */
+	else {					/* have to copy actual string */
+	    if (dstr->str_ptr) {
+		if (dstr->str_state == SS_INCR) {
+			Str_Grow(dstr,0);
+		}
+	    }
 	    str_nset(dstr,sstr->str_ptr,sstr->str_cur);
+	}
 	if (dstr->str_nok = sstr->str_nok)
 	    dstr->str_u.str_nval = sstr->str_u.str_nval;
 	else {
@@ -738,12 +749,12 @@ register STR *str2;
 
     if (str1->str_cur < str2->str_cur) {
 	if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
-	    return retval;
+	    return retval < 0 ? -1 : 1;
 	else
 	    return -1;
     }
     else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
-	return retval;
+	return retval < 0 ? -1 : 1;
     else if (str1->str_cur == str2->str_cur)
 	return 0;
     else
@@ -804,6 +815,7 @@ int append;
 	    if (get_paragraph && oldbp)
 		obpx = oldbp - str->str_ptr;
 	    bpx = bp - str->str_ptr;	/* prepare for possible relocation */
+	    str->str_cur = bpx;
 	    STR_GROW(str, str->str_len + append + cnt + 2);
 	    bp = str->str_ptr + bpx;	/* reconstitute our pointer */
 	    if (get_paragraph && oldbp)
@@ -1373,8 +1385,10 @@ register STR *old;
     if (new->str_ptr)
 	Safefree(new->str_ptr);
     Copy(old,new,1,STR);
-    if (old->str_ptr)
+    if (old->str_ptr) {
 	new->str_ptr = nsavestr(old->str_ptr,old->str_len);
+	new->str_pok &= ~SP_TEMP;
+    }
     return new;
 }
 
diff --git a/toke.c b/toke.c
index 5f1ccd043a..e3f3c73db6 100644
--- a/toke.c
+++ b/toke.c
@@ -1,4 +1,4 @@
-/* $Header: toke.c,v 3.0.1.11 90/11/10 02:13:44 lwall Locked $
+/* $Header: toke.c,v 3.0.1.12 91/01/11 18:31:45 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,10 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	toke.c,v $
+ * Revision 3.0.1.12  91/01/11  18:31:45  lwall
+ * patch42: eval'ed formats without proper termination blew up
+ * patch42: whitespace now allowed after terminating . of format
+ * 
  * Revision 3.0.1.11  90/11/10  02:13:44  lwall
  * patch38: added alarm function
  * patch38: tr was busted in metacharacters on signed char machines
@@ -2341,7 +2345,7 @@ load_format()
 
     Zero(&froot, 1, FCMD);
     s = bufptr;
-    while (s < bufend || (s = str_gets(linestr,rsfp, 0)) != Nullch) {
+    while (s < bufend || (rsfp && (s = str_gets(linestr,rsfp, 0)) != Nullch)) {
 	curcmd->c_line++;
 	if (in_eval && !rsfp) {
 	    eol = index(s,'\n');
@@ -2356,9 +2360,12 @@ load_format()
 	    str_nset(tmpstr, s, eol-s);
 	    astore(stab_xarray(curcmd->c_filestab), (int)curcmd->c_line,tmpstr);
 	}
-	if (strnEQ(s,".\n",2)) {
-	    bufptr = s;
-	    return froot.f_next;
+	if (*s == '.') {
+	    for (t = s+1; *t == ' ' || *t == '\t'; t++) ;
+	    if (*t == '\n') {
+		bufptr = s;
+		return froot.f_next;
+	    }
 	}
 	if (*s == '#') {
 	    s = eol;
@@ -2456,7 +2463,8 @@ load_format()
 	}
 	if (flinebeg) {
 	  again:
-	    if (s >= bufend && (s = str_gets(linestr, rsfp, 0)) == Nullch)
+	    if (s >= bufend &&
+	      (!rsfp || (s = str_gets(linestr, rsfp, 0)) == Nullch) )
 		goto badform;
 	    curcmd->c_line++;
 	    if (in_eval && !rsfp) {
diff --git a/util.c b/util.c
index de8f122593..b14069411d 100644
--- a/util.c
+++ b/util.c
@@ -1,4 +1,4 @@
-/* $Header: util.c,v 3.0.1.10 90/11/10 02:19:28 lwall Locked $
+/* $Header: util.c,v 3.0.1.11 91/01/11 18:33:10 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,10 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	util.c,v $
+ * Revision 3.0.1.11  91/01/11  18:33:10  lwall
+ * patch42: die could exit with 0 value on some machines
+ * patch42: Configure checks typecasting behavior better
+ * 
  * Revision 3.0.1.10  90/11/10  02:19:28  lwall
  * patch38: random cleanup
  * patch38: sequence of s/^x//; s/x$//; could screw up malloc
@@ -855,7 +859,7 @@ long a1, a2, a3, a4;
     if (e_fp)
 	(void)UNLINK(e_tmpname);
     statusvalue >>= 8;
-    exit(errno?errno:(statusvalue?statusvalue:255));
+    exit((int)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
 }
 
 /*VARARGS1*/
@@ -959,7 +963,7 @@ va_dcl
     if (e_fp)
 	(void)UNLINK(e_tmpname);
     statusvalue >>= 8;
-    exit((int)(errno?errno:(statusvalue?statusvalue:255)));
+    exit((int)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
 }
 
 /*VARARGS0*/
@@ -1458,7 +1462,7 @@ double f;
 {
     long along;
 
-#ifdef mips
+#if CASTFLAGS & 2
 #   define BIGDOUBLE 2147483648.0
     if (f >= BIGDOUBLE)
 	return (unsigned long)(f-(long)(f/BIGDOUBLE)*BIGDOUBLE)|0x80000000;
diff --git a/x2p/s2p.SH b/x2p/s2p.SH
index 9898dcf6a0..36eab5e11e 100644
--- a/x2p/s2p.SH
+++ b/x2p/s2p.SH
@@ -7,6 +7,7 @@ case $CONFIG in
 '')
     if test ! -f config.sh; then
 	ln ../config.sh . || \
+	ln -s ../config.sh . || \
 	ln ../../config.sh . || \
 	ln ../../../config.sh . || \
 	(echo "Can't find config.sh."; exit 1)
@@ -28,9 +29,12 @@ $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.1.6 90/10/20 02:21:43 lwall Locked $
+# $Header: s2p.SH,v 3.0.1.7 91/01/11 18:36:44 lwall Locked $
 #
 # $Log:	s2p.SH,v $
+# Revision 3.0.1.7  91/01/11  18:36:44  lwall
+# patch42: x2p/s2p.SH blew up on /afs misfeature
+# 
 # Revision 3.0.1.6  90/10/20  02:21:43  lwall
 # patch37: changed some ". config.sh" to ". ./config.sh"
 #