perl 4.0.00: (no release announcement available)perl-4.0.00

So far, 4.0 is still a beta test version.  For the last production
version, look in pub/perl.3.0/kits@44.

14 files changed, 420 insertions, 534 deletions

diff --git a/lib/bigfloat.pl b/lib/bigfloat.pl
index feaaa6e494..99a00794bb 100644
--- a/lib/bigfloat.pl
+++ b/lib/bigfloat.pl
@@ -73,7 +73,7 @@ sub main'fneg { #(fnum_str) return fnum_str
 # absolute value
 sub main'fabs { #(fnum_str) return fnum_str
     local($_) = &'fnorm($_[0]);
-    substr($_,0,1) = '+';                       # mash sign
+    substr($_,0,1) = '+' unless $_ eq 'NaN';                       # mash sign
     $_;
 }
 
diff --git a/lib/bigrat.pl b/lib/bigrat.pl
index 3157cf8244..008befff20 100644
--- a/lib/bigrat.pl
+++ b/lib/bigrat.pl
@@ -75,7 +75,7 @@ sub main'rneg { #(rat_num) return rat_num
 # absolute value
 sub main'rabs { #(rat_num) return $rat_num
     local($_) = &'rnorm($_[0]);
-    substr($_,0,1) = '+';
+    substr($_,0,1) = '+' unless $_ eq 'NaN';
     $_;
 }
 
diff --git a/lib/ctime.pl b/lib/ctime.pl
index fe6ef51538..988d05a841 100644
--- a/lib/ctime.pl
+++ b/lib/ctime.pl
@@ -2,8 +2,8 @@
 ;#
 ;# Waldemar Kebsch, Federal Republic of Germany, November 1988
 ;# kebsch.pad@nixpbe.UUCP
-;# Modified March 1990 to better handle timezones
-;#  $Id: ctime.pl,v 1.3 90/03/22 10:49:10 hakanson Exp $
+;# Modified March 1990, Feb 1991 to properly handle timezones
+;#  $Id: ctime.pl,v 1.8 91/02/04 18:28:12 hakanson Exp $
 ;#   Marion Hakanson (hakanson@cse.ogi.edu)
 ;#   Oregon Graduate Institute of Science and Technology
 ;#
@@ -26,15 +26,23 @@ sub ctime {
     local($time) = @_;
     local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
 
-    # Use GMT if can't find local TZ
-    $TZ = defined($ENV{'TZ'}) ? $ENV{'TZ'} : 'GMT';
+    # Determine what time zone is in effect.
+    # Use GMT if TZ is defined as null, local time if TZ undefined.
+    # There's no portable way to find the system default timezone.
+
+    $TZ = defined($ENV{'TZ'}) ? ( $ENV{'TZ'} ? $ENV{'TZ'} : 'GMT' ) : '';
     ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
         ($TZ eq 'GMT') ? gmtime($time) : localtime($time);
+
     # Hack to deal with 'PST8PDT' format of TZ
-    if ( $TZ =~ /-?\d+/ ) {
-        $TZ = $isdst ? $' : $`;
+    # Note that this can't deal with all the esoteric forms, but it
+    # does recognize the most common: [:]STDoff[DST[off][,rule]]
+
+    if($TZ=~/^([^:\d+\-,]{3,})([+-]?\d{1,2}(:\d{1,2}){0,2})([^\d+\-,]{3,})?/){
+        $TZ = $isdst ? $4 : $1;
     }
-    $TZ .= " " unless $TZ eq "";
+    $TZ .= ' ' unless $TZ eq '';
+
     $year += ($year < 70) ? 2000 : 1900;
     sprintf("%s %s %2d %2d:%02d:%02d %s%4d\n",
       $DoW[$wday], $MoY[$mon], $mday, $hour, $min, $sec, $TZ, $year);
diff --git a/lib/getopt.pl b/lib/getopt.pl
index 93acafc5bf..da39d3b29d 100644
--- a/lib/getopt.pl
+++ b/lib/getopt.pl
@@ -1,4 +1,4 @@
-;# $Header: getopt.pl,v 3.0.1.1 90/02/28 17:41:59 lwall Locked $
+;# $Header: getopt.pl,v 4.0 91/03/20 01:25:11 lwall Locked $
 
 ;# Process single-character switches with switch clustering.  Pass one argument
 ;# which is a string containing all switches that take an argument.  For each
diff --git a/lib/importenv.pl b/lib/importenv.pl
index db3128be43..98ffa14131 100644
--- a/lib/importenv.pl
+++ b/lib/importenv.pl
@@ -1,4 +1,4 @@
-;# $Header: importenv.pl,v 3.0.1.1 90/08/09 03:56:38 lwall Locked $
+;# $Header: importenv.pl,v 4.0 91/03/20 01:25:28 lwall Locked $
 
 ;# This file, when interpreted, pulls the environment into normal variables.
 ;# Usage:
diff --git a/lib/look.pl b/lib/look.pl
index 6eef43983b..4c14e64727 100644
--- a/lib/look.pl
+++ b/lib/look.pl
@@ -4,7 +4,7 @@
 ;# (stringwise) to $key.  Pass flags for dictionary order and case folding.
 
 sub look {
-    local(*FH,$key,$fold) = @_;
+    local(*FH,$key,$dict,$fold) = @_;
     local($max,$min,$mid,$_);
     local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
        $blksize,$blocks) = stat(FH);
diff --git a/lib/nsyslog.pl b/lib/nsyslog.pl
deleted file mode 100644
index 37f4fe1454..0000000000
--- a/lib/nsyslog.pl
+++ /dev/null
@@ -1,209 +0,0 @@
-#
-# syslog.pl
-#
-# $Log:	nsyslog.pl,v $
-# Revision 3.0.1.1  90/08/09  03:57:17  lwall
-# patch19: Initial revision
-# 
-# Revision 1.2  90/06/11  18:45:30  18:45:30  root ()
-# - Changed 'warn' to 'mail|warning' in test call (to give example of
-#   facility specification, and because 'warn' didn't work on HP-UX).
-# - Fixed typo in &openlog ("ncons" should be "cons").
-# - Added (package-global) $maskpri, and &setlogmask.
-# - In &syslog:
-#   - put argument test ahead of &connect (why waste cycles?),
-#   - allowed facility to be specified in &syslog's first arg (temporarily
-#     overrides any $facility set in &openlog), just as in syslog(3C),
-#   - do a return 0 when bit for $numpri not set in log mask (see syslog(3C)),
-#   - changed $whoami code to use getlogin, getpwuid($<) and 'syslog'
-#     (in that order) when $ident is null,
-#   - made PID logging consistent with syslog(3C) and subject to $lo_pid only,
-#   - fixed typo in "print CONS" statement ($<facility should be <$facility).
-#   - changed \n to \r in print CONS (\r is useful, $message already has a \n).
-# - Changed &xlate to return -1 for an unknown name, instead of croaking.
-# 
-#
-# tom christiansen <tchrist@convex.com>
-# modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
-# NOTE: openlog now takes three arguments, just like openlog(3)
-#
-# call syslog() with a string priority and a list of printf() args
-# like syslog(3)
-#
-#  usage: require 'syslog.pl';
-#
-#  then (put these all in a script to test function)
-#		
-#
-#	do openlog($program,'cons,pid','user');
-#	do syslog('info','this is another test');
-#	do syslog('mail|warning','this is a better test: %d', time);
-#	do closelog();
-#	
-#	do syslog('debug','this is the last test');
-#	do openlog("$program $$",'ndelay','user');
-#	do syslog('notice','fooprogram: this is really done');
-#
-#	$! = 55;
-#	do syslog('info','problem was %m'); # %m == $! in syslog(3)
-
-package syslog;
-
-$host = 'localhost' unless $host;	# set $syslog'host to change
-
-require '/usr/local/lib/perl/syslog.ph';
-
-$maskpri = &LOG_UPTO(&LOG_DEBUG);
-
-sub main'openlog {
-    ($ident, $logopt, $facility) = @_;  # package vars
-    $lo_pid = $logopt =~ /\bpid\b/;
-    $lo_ndelay = $logopt =~ /\bndelay\b/;
-    $lo_cons = $logopt =~ /\bcons\b/;
-    $lo_nowait = $logopt =~ /\bnowait\b/;
-    &connect if $lo_ndelay;
-} 
-
-sub main'closelog {
-    $facility = $ident = '';
-    &disconnect;
-} 
-
-sub main'setlogmask {
-    local($oldmask) = $maskpri;
-    $maskpri = shift;
-    $oldmask;
-}
- 
-sub main'syslog {
-    local($priority) = shift;
-    local($mask) = shift;
-    local($message, $whoami);
-    local(@words, $num, $numpri, $numfac, $sum);
-    local($facility) = $facility;	# may need to change temporarily.
-
-    die "syslog: expected both priority and mask" unless $mask && $priority;
-
-    @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility".
-    undef $numpri;
-    undef $numfac;
-    foreach (@words) {
-	$num = &xlate($_);		# Translate word to number.
-	if (/^kern$/ || $num < 0) {
-	    die "syslog: invalid level/facility: $_\n";
-	}
-	elsif ($num <= &LOG_PRIMASK) {
-	    die "syslog: too many levels given: $_\n" if defined($numpri);
-	    $numpri = $num;
-	    return 0 unless &LOG_MASK($numpri) & $maskpri;
-	}
-	else {
-	    die "syslog: too many facilities given: $_\n" if defined($numfac);
-	    $facility = $_;
-	    $numfac = $num;
-	}
-    }
-
-    die "syslog: level must be given\n" unless defined($numpri);
-
-    if (!defined($numfac)) {	# Facility not specified in this call.
-	$facility = 'user' unless $facility;
-	$numfac = &xlate($facility);
-    }
-
-    &connect unless $connected;
-
-    $whoami = $ident;
-
-    if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) {
-	$whoami = $1;
-	$mask = $2;
-    } 
-
-    unless ($whoami) {
-	($whoami = getlogin) ||
-	    ($whoami = getpwuid($<)) ||
-		($whoami = 'syslog');
-    }
-
-    $whoami .= "[$$]" if $lo_pid;
-
-    $mask =~ s/%m/$!/g;
-    $mask .= "\n" unless $mask =~ /\n$/;
-    $message = sprintf ($mask, @_);
-
-    $sum = $numpri + $numfac;
-    unless (send(SYSLOG,"<$sum>$whoami: $message",0)) {
-	if ($lo_cons) {
-	    if ($pid = fork) {
-		unless ($lo_nowait) {
-		    do {$died = wait;} until $died == $pid || $died < 0;
-		}
-	    }
-	    else {
-		open(CONS,">/dev/console");
-		print CONS "<$facility.$priority>$whoami: $message\r";
-		exit if defined $pid;		# if fork failed, we're parent
-		close CONS;
-	    }
-	}
-    }
-}
-
-sub xlate {
-    local($name) = @_;
-    $name =~ y/a-z/A-Z/;
-    $name = "LOG_$name" unless $name =~ /^LOG_/;
-    $name = "syslog'$name";
-    eval &$name || -1;
-}
-
-sub connect {
-    $pat = 'S n C4 x8';
-
-    $af_unix = 1;
-    $af_inet = 2;
-
-    $stream = 1;
-    $datagram = 2;
-
-    ($name,$aliases,$proto) = getprotobyname('udp');
-    $udp = $proto;
-
-    ($name,$aliase,$port,$proto) = getservbyname('syslog','udp');
-    $syslog = $port;
-
-    if (chop($myname = `hostname`)) {
-	($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($myname);
-	die "Can't lookup $myname\n" unless $name;
-	@bytes = unpack("C4",$addrs[0]);
-    }
-    else {
-	@bytes = (0,0,0,0);
-    }
-    $this = pack($pat, $af_inet, 0, @bytes);
-
-    if ($host =~ /^\d+\./) {
-	@bytes = split(/\./,$host);
-    }
-    else {
-	($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($host);
-	die "Can't lookup $host\n" unless $name;
-	@bytes = unpack("C4",$addrs[0]);
-    }
-    $that = pack($pat,$af_inet,$syslog,@bytes);
-
-    socket(SYSLOG,$af_inet,$datagram,$udp) || die "socket: $!\n";
-    bind(SYSLOG,$this) || die "bind: $!\n";
-    connect(SYSLOG,$that) || die "connect: $!\n";
-
-    local($old) = select(SYSLOG); $| = 1; select($old);
-    $connected = 1;
-}
-
-sub disconnect {
-    close SYSLOG;
-    $connected = 0;
-}
-
-1;
diff --git a/lib/perldb.pl b/lib/perldb.pl
index 4c2f54d499..d7f05bfc82 100644
--- a/lib/perldb.pl
+++ b/lib/perldb.pl
@@ -1,6 +1,6 @@
 package DB;
 
-$header = '$Header: perldb.pl,v 3.0.1.6 91/01/11 18:08:58 lwall Locked $';
+$header = '$Header: perldb.pl,v 4.0 91/03/20 01:25:50 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.6 91/01/11 18:08:58 lwall Locked $';
 # have a breakpoint.  It also inserts a do 'perldb.pl' before the first line.
 #
 # $Log:	perldb.pl,v $
+# Revision 4.0  91/03/20  01:25:50  lwall
+# 4.0 baseline.
+# 
 # Revision 3.0.1.6  91/01/11  18:08:58  lwall
 # patch42: @_ couldn't be accessed from debugger
 # 
@@ -83,23 +86,25 @@ sub DB {
 	print OUT $#stack . " levels deep in subroutine calls!\n"
 	    if $single & 4;
 	$start = $line;
+      CMD:
 	while ((print OUT "  DB<", $#hist+1, "> "), $cmd=&gets) {
-	    $single = 0;
-	    $signal = 0;
-	    $cmd eq '' && exit 0;
-	    chop($cmd);
-	    $cmd =~ s/\\$// && do {
-		print OUT "  cont: ";
-		$cmd .= &gets;
-		redo;
-	    };
-	    $cmd =~ /^q$/ && exit 0;
-	    $cmd =~ /^$/ && ($cmd = $laststep);
-	    push(@hist,$cmd) if length($cmd) > 1;
-	    ($i) = split(/\s+/,$cmd);
-	    eval "\$cmd =~ $alias{$i}", print OUT $@ if $alias{$i};
-	    $cmd =~ /^h$/ && do {
-		print OUT "
+	    {
+		$single = 0;
+		$signal = 0;
+		$cmd eq '' && exit 0;
+		chop($cmd);
+		$cmd =~ s/\\$// && do {
+		    print OUT "  cont: ";
+		    $cmd .= &gets;
+		    redo CMD;
+		};
+		$cmd =~ /^q$/ && exit 0;
+		$cmd =~ /^$/ && ($cmd = $laststep);
+		push(@hist,$cmd) if length($cmd) > 1;
+		($i) = split(/\s+/,$cmd);
+		eval "\$cmd =~ $alias{$i}", print OUT $@ if $alias{$i};
+		$cmd =~ /^h$/ && do {
+		    print OUT "
 T		Stack trace.
 s		Single step.
 n		Next, steps over subroutine calls.
@@ -145,316 +150,317 @@ p expr		Same as \"print DB'OUT expr\" in current package.
 command		Execute as a perl statement in current package.
 
 ";
-		next; };
-	    $cmd =~ /^t$/ && do {
-		$trace = !$trace;
-		print OUT "Trace = ".($trace?"on":"off")."\n";
-		next; };
-	    $cmd =~ /^S$/ && do {
-		foreach $subname (sort(keys %sub)) {
-		    print OUT $subname,"\n";
-		}
-		next; };
-	    $cmd =~ s/^X\b/V $package/;
-	    $cmd =~ /^V$/ && do {
-		$cmd = 'V $package'; };
-	    $cmd =~ /^V\s*(\S+)\s*(.*)/ && do {
-		$packname = $1;
-		@vars = split(' ',$2);
-		do 'dumpvar.pl' unless defined &main'dumpvar;
-		if (defined &main'dumpvar) {
-		    &main'dumpvar($packname,@vars);
-		}
-		else {
-		    print DB'OUT "dumpvar.pl not available.\n";
-		}
-		next; };
-	    $cmd =~ /^f\s*(.*)/ && do {
-		$file = $1;
-		if (!$file) {
-		    print OUT "The old f command is now the r command.\n";
-		    print OUT "The new f command switches filenames.\n";
-		    next;
-		}
-		if (!defined $_main{'_<' . $file}) {
-		    if (($try) = grep(m#^_<.*$file#, keys %_main)) {
-			$file = substr($try,2);
-			print "\n$file:\n";
+		    next CMD; };
+		$cmd =~ /^t$/ && do {
+		    $trace = !$trace;
+		    print OUT "Trace = ".($trace?"on":"off")."\n";
+		    next CMD; };
+		$cmd =~ /^S$/ && do {
+		    foreach $subname (sort(keys %sub)) {
+			print OUT $subname,"\n";
+		    }
+		    next CMD; };
+		$cmd =~ s/^X\b/V $package/;
+		$cmd =~ /^V$/ && do {
+		    $cmd = 'V $package'; };
+		$cmd =~ /^V\b\s*(\S+)\s*(.*)/ && do {
+		    $packname = $1;
+		    @vars = split(' ',$2);
+		    do 'dumpvar.pl' unless defined &main'dumpvar;
+		    if (defined &main'dumpvar) {
+			&main'dumpvar($packname,@vars);
+		    }
+		    else {
+			print DB'OUT "dumpvar.pl not available.\n";
 		    }
-		}
-		if (!defined $_main{'_<' . $file}) {
-		    print OUT "There's no code here anything matching $file.\n";
-		    next;
-		}
-		elsif ($file ne $filename) {
-		    *dbline = "_<$file";
-		    $max = $#dbline;
-		    $filename = $file;
-		    $start = 1;
-		    $cmd = "l";
-		} };
-	    $cmd =~ /^l\s*(['A-Za-z_]['\w]*)/ && do {
-		$subname = $1;
-		$subname = "main'" . $subname unless $subname =~ /'/;
-		$subname = "main" . $subname if substr($subname,0,1) eq "'";
-		($file,$subrange) = split(/:/,$sub{$subname});
-		if ($file ne $filename) {
-		    *dbline = "_<$file";
-		    $max = $#dbline;
-		    $filename = $file;
-		}
-		if ($subrange) {
-		    if (eval($subrange) < -$window) {
-			$subrange =~ s/-.*/+/;
+		    next CMD; };
+		$cmd =~ /^f\b\s*(.*)/ && do {
+		    $file = $1;
+		    if (!$file) {
+			print OUT "The old f command is now the r command.\n";
+			print OUT "The new f command switches filenames.\n";
+			next CMD;
 		    }
-		    $cmd = "l $subrange";
-		} else {
-		    print OUT "Subroutine $1 not found.\n";
-		    next;
-		} };
-	    $cmd =~ /^w\s*(\d*)$/ && do {
-		$incr = $window - 1;
-		$start = $1 if $1;
-		$start -= $preview;
-		$cmd = 'l ' . $start . '-' . ($start + $incr); };
-	    $cmd =~ /^-$/ && do {
-		$incr = $window - 1;
-		$cmd = 'l ' . ($start-$window*2) . '+'; };
-	    $cmd =~ /^l$/ && do {
-		$incr = $window - 1;
-		$cmd = 'l ' . $start . '-' . ($start + $incr); };
-	    $cmd =~ /^l\s*(\d*)\+(\d*)$/ && do {
-		$start = $1 if $1;
-		$incr = $2;
-		$incr = $window - 1 unless $incr;
-		$cmd = 'l ' . $start . '-' . ($start + $incr); };
-	    $cmd =~ /^l\s*(([\d\$\.]+)([-,]([\d\$\.]+))?)?/ && do {
-		$end = (!$2) ? $max : ($4 ? $4 : $2);
-		$end = $max if $end > $max;
-		$i = $2;
-		$i = $line if $i eq '.';
-		$i = 1 if $i < 1;
-		for (; $i <= $end; $i++) {
-		    print OUT "$i:\t", $dbline[$i];
-		    last if $signal;
-		}
-		$start = $i;	# remember in case they want more
-		$start = $max if $start > $max;
-		next; };
-	    $cmd =~ /^D$/ && do {
-		print OUT "Deleting all breakpoints...\n";
-		for ($i = 1; $i <= $max ; $i++) {
-		    if (defined $dbline{$i}) {
-			$dbline{$i} =~ s/^[^\0]+//;
-			if ($dbline{$i} =~ s/^\0?$//) {
-			    delete $dbline{$i};
+		    if (!defined $_main{'_<' . $file}) {
+			if (($try) = grep(m#^_<.*$file#, keys %_main)) {
+			    $file = substr($try,2);
+			    print "\n$file:\n";
 			}
 		    }
-		}
-		next; };
-	    $cmd =~ /^L$/ && do {
-		for ($i = 1; $i <= $max; $i++) {
-		    if (defined $dbline{$i}) {
+		    if (!defined $_main{'_<' . $file}) {
+			print OUT "There's no code here anything matching $file.\n";
+			next CMD;
+		    }
+		    elsif ($file ne $filename) {
+			*dbline = "_<$file";
+			$max = $#dbline;
+			$filename = $file;
+			$start = 1;
+			$cmd = "l";
+		    } };
+		$cmd =~ /^l\b\s*(['A-Za-z_]['\w]*)/ && do {
+		    $subname = $1;
+		    $subname = "main'" . $subname unless $subname =~ /'/;
+		    $subname = "main" . $subname if substr($subname,0,1) eq "'";
+		    ($file,$subrange) = split(/:/,$sub{$subname});
+		    if ($file ne $filename) {
+			*dbline = "_<$file";
+			$max = $#dbline;
+			$filename = $file;
+		    }
+		    if ($subrange) {
+			if (eval($subrange) < -$window) {
+			    $subrange =~ s/-.*/+/;
+			}
+			$cmd = "l $subrange";
+		    } else {
+			print OUT "Subroutine $1 not found.\n";
+			next CMD;
+		    } };
+		$cmd =~ /^w\b\s*(\d*)$/ && do {
+		    $incr = $window - 1;
+		    $start = $1 if $1;
+		    $start -= $preview;
+		    $cmd = 'l ' . $start . '-' . ($start + $incr); };
+		$cmd =~ /^-$/ && do {
+		    $incr = $window - 1;
+		    $cmd = 'l ' . ($start-$window*2) . '+'; };
+		$cmd =~ /^l$/ && do {
+		    $incr = $window - 1;
+		    $cmd = 'l ' . $start . '-' . ($start + $incr); };
+		$cmd =~ /^l\b\s*(\d*)\+(\d*)$/ && do {
+		    $start = $1 if $1;
+		    $incr = $2;
+		    $incr = $window - 1 unless $incr;
+		    $cmd = 'l ' . $start . '-' . ($start + $incr); };
+		$cmd =~ /^l\b\s*(([\d\$\.]+)([-,]([\d\$\.]+))?)?/ && do {
+		    $end = (!$2) ? $max : ($4 ? $4 : $2);
+		    $end = $max if $end > $max;
+		    $i = $2;
+		    $i = $line if $i eq '.';
+		    $i = 1 if $i < 1;
+		    for (; $i <= $end; $i++) {
 			print OUT "$i:\t", $dbline[$i];
-			($stop,$action) = split(/\0/, $dbline{$i});
-			print OUT "  break if (", $stop, ")\n" 
-			    if $stop;
-			print OUT "  action:  ", $action, "\n" 
-			    if $action;
 			last if $signal;
 		    }
-		}
-		next; };
-	    $cmd =~ /^b\s*(['A-Za-z_]['\w]*)\s*(.*)/ && do {
-		$subname = $1;
-		$cond = $2 || '1';
-		$subname = "$package'" . $subname unless $subname =~ /'/;
-		$subname = "main" . $subname if substr($subname,0,1) eq "'";
-		($filename,$i) = split(/[:-]/, $sub{$subname});
-		if ($i) {
-		    *dbline = "_<$filename";
-		    ++$i while $dbline[$i] == 0 && $i < $#dbline;
-		    $dbline{$i} =~ s/^[^\0]*/$cond/;
-		} else {
-		    print OUT "Subroutine $subname not found.\n";
-		}
-		next; };
-	    $cmd =~ /^b\s*(\d*)\s*(.*)/ && do {
-		$i = ($1?$1:$line);
-		$cond = $2 || '1';
-		if ($dbline[$i] == 0) {
-		    print OUT "Line $i not breakable.\n";
-		} else {
-		    $dbline{$i} =~ s/^[^\0]*/$cond/;
-		}
-		next; };
-	    $cmd =~ /^d\s*(\d+)?/ && do {
-		$i = ($1?$1:$line);
-		$dbline{$i} =~ s/^[^\0]*//;
-		delete $dbline{$i} if $dbline{$i} eq '';
-		next; };
-	    $cmd =~ /^A$/ && do {
-		for ($i = 1; $i <= $max ; $i++) {
-		    if (defined $dbline{$i}) {
-			$dbline{$i} =~ s/\0[^\0]*//;
-			delete $dbline{$i} if $dbline{$i} eq '';
+		    $start = $i;	# remember in case they want more
+		    $start = $max if $start > $max;
+		    next CMD; };
+		$cmd =~ /^D$/ && do {
+		    print OUT "Deleting all breakpoints...\n";
+		    for ($i = 1; $i <= $max ; $i++) {
+			if (defined $dbline{$i}) {
+			    $dbline{$i} =~ s/^[^\0]+//;
+			    if ($dbline{$i} =~ s/^\0?$//) {
+				delete $dbline{$i};
+			    }
+			}
+		    }
+		    next CMD; };
+		$cmd =~ /^L$/ && do {
+		    for ($i = 1; $i <= $max; $i++) {
+			if (defined $dbline{$i}) {
+			    print OUT "$i:\t", $dbline[$i];
+			    ($stop,$action) = split(/\0/, $dbline{$i});
+			    print OUT "  break if (", $stop, ")\n" 
+				if $stop;
+			    print OUT "  action:  ", $action, "\n" 
+				if $action;
+			    last if $signal;
+			}
+		    }
+		    next CMD; };
+		$cmd =~ /^b\b\s*(['A-Za-z_]['\w]*)\s*(.*)/ && do {
+		    $subname = $1;
+		    $cond = $2 || '1';
+		    $subname = "$package'" . $subname unless $subname =~ /'/;
+		    $subname = "main" . $subname if substr($subname,0,1) eq "'";
+		    ($filename,$i) = split(/[:-]/, $sub{$subname});
+		    if ($i) {
+			*dbline = "_<$filename";
+			++$i while $dbline[$i] == 0 && $i < $#dbline;
+			$dbline{$i} =~ s/^[^\0]*/$cond/;
+		    } else {
+			print OUT "Subroutine $subname not found.\n";
 		    }
-		}
-		next; };
-	    $cmd =~ /^<\s*(.*)/ && do {
-		$pre = do action($1);
-		next; };
-	    $cmd =~ /^>\s*(.*)/ && do {
-		$post = do action($1);
-		next; };
-	    $cmd =~ /^a\s*(\d+)(\s+(.*))?/ && do {
-		$i = $1;
-		if ($dbline[$i] == 0) {
-		    print OUT "Line $i may not have an action.\n";
-		} else {
-		    $dbline{$i} =~ s/\0[^\0]*//;
-		    $dbline{$i} .= "\0" . do action($3);
-		}
-		next; };
-	    $cmd =~ /^n$/ && do {
-		$single = 2;
-		$laststep = $cmd;
-		last; };
-	    $cmd =~ /^s$/ && do {
-		$single = 1;
-		$laststep = $cmd;
-		last; };
-	    $cmd =~ /^c\s*(\d*)\s*$/ && do {
-		$i = $1;
-		if ($i) {
+		    next CMD; };
+		$cmd =~ /^b\b\s*(\d*)\s*(.*)/ && do {
+		    $i = ($1?$1:$line);
+		    $cond = $2 || '1';
 		    if ($dbline[$i] == 0) {
-		        print OUT "Line $i not breakable.\n";
-			next;
+			print OUT "Line $i not breakable.\n";
+		    } else {
+			$dbline{$i} =~ s/^[^\0]*/$cond/;
 		    }
-		    $dbline{$i} =~ s/(\0|$)/;9$1/;	# add one-time-only b.p.
-		}
-		for ($i=0; $i <= $#stack; ) {
-		    $stack[$i++] &= ~1;
-		}
-		last; };
-	    $cmd =~ /^r$/ && do {
-		$stack[$#stack] |= 2;
-		last; };
-	    $cmd =~ /^T$/ && do {
-		local($p,$f,$l,$s,$h,$a,@a,@sub);
-		for ($i = 1; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) {
-		    @a = @args;
-		    for (@a) {
-			if (/^StB\000/ && length($_) == length($_main{'_main'})) {
-			    $_ = sprintf("%s",$_);
+		    next CMD; };
+		$cmd =~ /^d\b\s*(\d+)?/ && do {
+		    $i = ($1?$1:$line);
+		    $dbline{$i} =~ s/^[^\0]*//;
+		    delete $dbline{$i} if $dbline{$i} eq '';
+		    next CMD; };
+		$cmd =~ /^A$/ && do {
+		    for ($i = 1; $i <= $max ; $i++) {
+			if (defined $dbline{$i}) {
+			    $dbline{$i} =~ s/\0[^\0]*//;
+			    delete $dbline{$i} if $dbline{$i} eq '';
 			}
-			else {
-			    s/'/\\'/g;
-			    s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/;
-			    s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
-			    s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+		    }
+		    next CMD; };
+		$cmd =~ /^<\s*(.*)/ && do {
+		    $pre = do action($1);
+		    next CMD; };
+		$cmd =~ /^>\s*(.*)/ && do {
+		    $post = do action($1);
+		    next CMD; };
+		$cmd =~ /^a\b\s*(\d+)(\s+(.*))?/ && do {
+		    $i = $1;
+		    if ($dbline[$i] == 0) {
+			print OUT "Line $i may not have an action.\n";
+		    } else {
+			$dbline{$i} =~ s/\0[^\0]*//;
+			$dbline{$i} .= "\0" . do action($3);
+		    }
+		    next CMD; };
+		$cmd =~ /^n$/ && do {
+		    $single = 2;
+		    $laststep = $cmd;
+		    last CMD; };
+		$cmd =~ /^s$/ && do {
+		    $single = 1;
+		    $laststep = $cmd;
+		    last CMD; };
+		$cmd =~ /^c\b\s*(\d*)\s*$/ && do {
+		    $i = $1;
+		    if ($i) {
+			if ($dbline[$i] == 0) {
+			    print OUT "Line $i not breakable.\n";
+			    next CMD;
 			}
+			$dbline{$i} =~ s/(\0|$)/;9$1/;	# add one-time-only b.p.
 		    }
-		    $w = $w ? '@ = ' : '$ = ';
-		    $a = $h ? '(' . join(', ', @a) . ')' : '';
-		    push(@sub, "$w&$s$a from file $f line $l\n");
-		    last if $signal;
-		}
-		for ($i=0; $i <= $#sub; $i++) {
-		    last if $signal;
-		    print OUT $sub[$i];
-		}
-	        next; };
-	    $cmd =~ /^\/(.*)$/ && do {
-		$inpat = $1;
-		$inpat =~ s:([^\\])/$:$1:;
-		if ($inpat ne "") {
-		    eval '$inpat =~ m'."\n$inpat\n";	
-		    if ($@ ne "") {
-		    	print OUT "$@";
-		    	next;
+		    for ($i=0; $i <= $#stack; ) {
+			$stack[$i++] &= ~1;
 		    }
-		    $pat = $inpat;
-		}
-		$end = $start;
-		eval '
-		for (;;) {
-		    ++$start;
-		    $start = 1 if ($start > $max);
-		    last if ($start == $end);
-		    if ($dbline[$start] =~ m'."\n$pat\n".'i) {
-			print OUT "$start:\t", $dbline[$start], "\n";
-			last;
+		    last CMD; };
+		$cmd =~ /^r$/ && do {
+		    $stack[$#stack] |= 2;
+		    last CMD; };
+		$cmd =~ /^T$/ && do {
+		    local($p,$f,$l,$s,$h,$a,@a,@sub);
+		    for ($i = 1; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) {
+			@a = @args;
+			for (@a) {
+			    if (/^StB\000/ && length($_) == length($_main{'_main'})) {
+				$_ = sprintf("%s",$_);
+			    }
+			    else {
+				s/'/\\'/g;
+				s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/;
+				s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+				s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+			    }
+			}
+			$w = $w ? '@ = ' : '$ = ';
+			$a = $h ? '(' . join(', ', @a) . ')' : '';
+			push(@sub, "$w&$s$a from file $f line $l\n");
+			last if $signal;
 		    }
-		} ';
-		print OUT "/$pat/: not found\n" if ($start == $end);
-		next; };
-	    $cmd =~ /^\?(.*)$/ && do {
-		$inpat = $1;
-		$inpat =~ s:([^\\])\?$:$1:;
-		if ($inpat ne "") {
-		    eval '$inpat =~ m'."\n$inpat\n";	
-		    if ($@ ne "") {
-		    	print OUT "$@";
-		    	next;
+		    for ($i=0; $i <= $#sub; $i++) {
+			last if $signal;
+			print OUT $sub[$i];
 		    }
-		    $pat = $inpat;
-		}
-		$end = $start;
-		eval '
-		for (;;) {
-		    --$start;
-		    $start = $max if ($start <= 0);
-		    last if ($start == $end);
-		    if ($dbline[$start] =~ m'."\n$pat\n".'i) {
-			print OUT "$start:\t", $dbline[$start], "\n";
-			last;
+		    next CMD; };
+		$cmd =~ /^\/(.*)$/ && do {
+		    $inpat = $1;
+		    $inpat =~ s:([^\\])/$:$1:;
+		    if ($inpat ne "") {
+			eval '$inpat =~ m'."\n$inpat\n";	
+			if ($@ ne "") {
+			    print OUT "$@";
+			    next CMD;
+			}
+			$pat = $inpat;
 		    }
-		} ';
-		print OUT "?$pat?: not found\n" if ($start == $end);
-		next; };
-	    $cmd =~ /^!+\s*(-)?(\d+)?$/ && do {
-		pop(@hist) if length($cmd) > 1;
-		$i = ($1?($#hist-($2?$2:1)):($2?$2:$#hist));
-		$cmd = $hist[$i] . "\n";
-		print OUT $cmd;
-		redo; };
-	    $cmd =~ /^!(.+)$/ && do {
-		$pat = "^$1";
-		pop(@hist) if length($cmd) > 1;
-		for ($i = $#hist; $i; --$i) {
-		    last if $hist[$i] =~ $pat;
-		}
-		if (!$i) {
-		    print OUT "No such command!\n\n";
-		    next;
-		}
-		$cmd = $hist[$i] . "\n";
-		print OUT $cmd;
-		redo; };
-	    $cmd =~ /^H\s*(-(\d+))?/ && do {
-		$end = $2?($#hist-$2):0;
-		$hist = 0 if $hist < 0;
-		for ($i=$#hist; $i>$end; $i--) {
-		    print OUT "$i: ",$hist[$i],"\n"
-			unless $hist[$i] =~ /^.?$/;
-		};
-		next; };
-	    $cmd =~ s/^p( .*)?$/print DB'OUT$1/;
-	    $cmd =~ /^=/ && do {
-		if (local($k,$v) = ($cmd =~ /^=\s*(\S+)\s+(.*)/)) {
-		    $alias{$k}="s~$k~$v~";
-		    print OUT "$k = $v\n";
-		} elsif ($cmd =~ /^=\s*$/) {
-		    foreach $k (sort keys(%alias)) {
-			if (($v = $alias{$k}) =~ s~^s\~$k\~(.*)\~$~$1~) {
-			    print OUT "$k = $v\n";
-			} else {
-			    print OUT "$k\t$alias{$k}\n";
+		    $end = $start;
+		    eval '
+		    for (;;) {
+			++$start;
+			$start = 1 if ($start > $max);
+			last if ($start == $end);
+			if ($dbline[$start] =~ m'."\n$pat\n".'i) {
+			    print OUT "$start:\t", $dbline[$start], "\n";
+			    last;
+			}
+		    } ';
+		    print OUT "/$pat/: not found\n" if ($start == $end);
+		    next CMD; };
+		$cmd =~ /^\?(.*)$/ && do {
+		    $inpat = $1;
+		    $inpat =~ s:([^\\])\?$:$1:;
+		    if ($inpat ne "") {
+			eval '$inpat =~ m'."\n$inpat\n";	
+			if ($@ ne "") {
+			    print OUT "$@";
+			    next CMD;
+			}
+			$pat = $inpat;
+		    }
+		    $end = $start;
+		    eval '
+		    for (;;) {
+			--$start;
+			$start = $max if ($start <= 0);
+			last if ($start == $end);
+			if ($dbline[$start] =~ m'."\n$pat\n".'i) {
+			    print OUT "$start:\t", $dbline[$start], "\n";
+			    last;
+			}
+		    } ';
+		    print OUT "?$pat?: not found\n" if ($start == $end);
+		    next CMD; };
+		$cmd =~ /^!+\s*(-)?(\d+)?$/ && do {
+		    pop(@hist) if length($cmd) > 1;
+		    $i = ($1?($#hist-($2?$2:1)):($2?$2:$#hist));
+		    $cmd = $hist[$i] . "\n";
+		    print OUT $cmd;
+		    redo CMD; };
+		$cmd =~ /^!(.+)$/ && do {
+		    $pat = "^$1";
+		    pop(@hist) if length($cmd) > 1;
+		    for ($i = $#hist; $i; --$i) {
+			last if $hist[$i] =~ $pat;
+		    }
+		    if (!$i) {
+			print OUT "No such command!\n\n";
+			next CMD;
+		    }
+		    $cmd = $hist[$i] . "\n";
+		    print OUT $cmd;
+		    redo CMD; };
+		$cmd =~ /^H\b\s*(-(\d+))?/ && do {
+		    $end = $2?($#hist-$2):0;
+		    $hist = 0 if $hist < 0;
+		    for ($i=$#hist; $i>$end; $i--) {
+			print OUT "$i: ",$hist[$i],"\n"
+			    unless $hist[$i] =~ /^.?$/;
+		    };
+		    next CMD; };
+		$cmd =~ s/^p( .*)?$/print DB'OUT$1/;
+		$cmd =~ /^=/ && do {
+		    if (local($k,$v) = ($cmd =~ /^=\s*(\S+)\s+(.*)/)) {
+			$alias{$k}="s~$k~$v~";
+			print OUT "$k = $v\n";
+		    } elsif ($cmd =~ /^=\s*$/) {
+			foreach $k (sort keys(%alias)) {
+			    if (($v = $alias{$k}) =~ s~^s\~$k\~(.*)\~$~$1~) {
+				print OUT "$k = $v\n";
+			    } else {
+				print OUT "$k\t$alias{$k}\n";
+			    };
 			};
 		    };
-		};
-		next; };
+		    next CMD; };
+	    }
 	    $evalarg = $cmd; &eval;
 	    print OUT "\n";
 	}
diff --git a/lib/pwd.pl b/lib/pwd.pl
index 7abcc1f97d..09ba1d2041 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.2 91/01/11 18:09:24 lwall Locked $
+;# $Header: pwd.pl,v 4.0 91/03/20 01:26:03 lwall Locked $
 ;#
 ;# $Log:	pwd.pl,v $
+;# Revision 4.0  91/03/20  01:26:03  lwall
+;# 4.0 baseline.
+;# 
 ;# Revision 3.0.1.2  91/01/11  18:09:24  lwall
 ;# patch42: some .pl files were missing their trailing 1;
 ;# 
diff --git a/lib/stat.pl b/lib/stat.pl
index df9e1dba5b..9f03cbc161 100644
--- a/lib/stat.pl
+++ b/lib/stat.pl
@@ -1,4 +1,4 @@
-;# $Header: stat.pl,v 3.0.1.1 90/08/09 04:01:34 lwall Locked $
+;# $Header: stat.pl,v 4.0 91/03/20 01:26:16 lwall Locked $
 
 ;# Usage:
 ;#	require 'stat.pl';
diff --git a/lib/syslog.pl b/lib/syslog.pl
index fe9b183be3..d5f9812684 100644
--- a/lib/syslog.pl
+++ b/lib/syslog.pl
@@ -2,12 +2,15 @@
 # syslog.pl
 #
 # $Log:	syslog.pl,v $
+# Revision 4.0  91/03/20  01:26:24  lwall
+# 4.0 baseline.
+# 
 # Revision 3.0.1.4  90/11/10  01:41:11  lwall
 # patch38: syslog.pl was referencing an absolute path
 # 
 # Revision 3.0.1.3  90/10/15  17:42:18  lwall
 # patch29: various portability fixes
-#
+# 
 # Revision 3.0.1.1  90/08/09  03:57:17  lwall
 # patch19: Initial revision
 # 
diff --git a/lib/termcap.pl b/lib/termcap.pl
index d64852667c..46ac858247 100644
--- a/lib/termcap.pl
+++ b/lib/termcap.pl
@@ -1,4 +1,4 @@
-;# $Header: termcap.pl,v 3.0.1.3 90/08/09 04:02:53 lwall Locked $
+;# $Header: termcap.pl,v 4.0 91/03/20 01:26:33 lwall Locked $
 ;#
 ;# Usage:
 ;#	require 'ioctl.pl';
diff --git a/lib/timelocal.pl b/lib/timelocal.pl
new file mode 100644
index 0000000000..a228041637
--- /dev/null
+++ b/lib/timelocal.pl
@@ -0,0 +1,75 @@
+;# timelocal.pl
+;#
+;# Usage:
+;#	$time = timelocal($sec,$min,$hours,$mday,$mon,$year,$junk,$junk,$isdst);
+;#	$time = timegm($sec,$min,$hours,$mday,$mon,$year);
+
+;# These routines are quite efficient and yet are always guaranteed to agree
+;# with localtime() and gmtime().  We manage this by caching the start times
+;# of any months we've seen before.  If we know the start time of the month,
+;# we can always calculate any time within the month.  The start times
+;# themselves are guessed by successive approximation starting at the
+;# current time, since most dates seen in practice are close to the
+;# current date.  Unlike algorithms that do a binary search (calling gmtime
+;# once for each bit of the time value, resulting in 32 calls), this algorithm
+;# calls it at most 6 times, and usually only once or twice.  If you hit
+;# the month cache, of course, it doesn't call it at all.
+
+;# timelocal is implemented using the same cache.  We just assume that we're
+;# translating a GMT time, and then fudge it when we're done for the timezone
+;# and daylight savings arguments.  The timezone is determined by examining
+;# the result of localtime(0) when the package is initialized.  The daylight
+;# savings offset is currently assumed to be one hour.
+
+CONFIG: {
+    package timelocal;
+    
+    @epoch = localtime(0);
+    $tzmin = $epoch[2] * 60 + $epoch[1];	# minutes east of GMT
+    if ($tzmin > 0) {
+	$tzmin = 24 * 60 - $tzmin;		# minutes west of GMT
+	$tzmin -= 24 * 60 if $epoch[5] == 70;	# account for the date line
+    }
+
+    $SEC = 1;
+    $MIN = 60 * $SEC;
+    $HR = 60 * $MIN;
+    $DAYS = 24 * $HR;
+}
+
+sub timegm {
+    package timelocal;
+
+    $ym = pack(C2, @_[5,4]);
+    $cheat = $cheat{$ym} || &cheat;
+    $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAYS;
+}
+
+sub timelocal {
+    package timelocal;
+
+    $ym = pack(C2, @_[5,4]);
+    $cheat = $cheat{$ym} || &cheat;
+    $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAYS
+	+ $tzmin * $MIN - 60 * 60 * ($_[8] != 0);
+}
+
+package timelocal;
+
+sub cheat {
+    $year = $_[5];
+    $month = $_[4];
+    $guess = $^T;
+    @g = gmtime($guess);
+    while ($diff = $year - $g[5]) {
+	$guess += $diff * (364 * $DAYS);
+	@g = gmtime($guess);
+    }
+    while ($diff = $month - $g[4]) {
+	$guess += $diff * (28 * $DAYS);
+	@g = gmtime($guess);
+    }
+    $g[3]--;
+    $guess -= $g[0] * $SEC + $g[1] * $MIN + $g[2] * $HR + $g[3] * $DAYS;
+    $cheat{$ym} = $guess;
+}
diff --git a/lib/validate.pl b/lib/validate.pl
index 07d49d40f6..2c8ee45c1d 100644
--- a/lib/validate.pl
+++ b/lib/validate.pl
@@ -1,4 +1,4 @@
-;# $Header: validate.pl,v 3.0.1.1 90/08/09 04:03:10 lwall Locked $
+;# $Header: validate.pl,v 4.0 91/03/20 01:26:56 lwall Locked $
 
 ;# The validate routine takes a single multiline string consisting of
 ;# lines containing a filename plus a file test to try on it.  (The