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.

18 files changed, 735 insertions, 170 deletions

diff --git a/x2p/EXTERN.h b/x2p/EXTERN.h
index fc98380c94..4a2d360203 100644
--- a/x2p/EXTERN.h
+++ b/x2p/EXTERN.h
@@ -1,4 +1,4 @@
-/* $Header: EXTERN.h,v 3.0 89/10/18 15:33:37 lwall Locked $
+/* $Header: EXTERN.h,v 4.0 91/03/20 01:56:53 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,8 +6,8 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	EXTERN.h,v $
- * Revision 3.0  89/10/18  15:33:37  lwall
- * 3.0 baseline
+ * Revision 4.0  91/03/20  01:56:53  lwall
+ * 4.0 baseline.
  * 
  */
 
diff --git a/x2p/INTERN.h b/x2p/INTERN.h
index d2a3033134..bbb54626af 100644
--- a/x2p/INTERN.h
+++ b/x2p/INTERN.h
@@ -1,4 +1,4 @@
-/* $Header: INTERN.h,v 3.0 89/10/18 15:33:45 lwall Locked $
+/* $Header: INTERN.h,v 4.0 91/03/20 01:56:58 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,8 +6,8 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	INTERN.h,v $
- * Revision 3.0  89/10/18  15:33:45  lwall
- * 3.0 baseline
+ * Revision 4.0  91/03/20  01:56:58  lwall
+ * 4.0 baseline.
  * 
  */
 
diff --git a/x2p/Makefile.SH b/x2p/Makefile.SH
index 4ab3ec9c12..82b14239ad 100644
--- a/x2p/Makefile.SH
+++ b/x2p/Makefile.SH
@@ -9,7 +9,7 @@ case $CONFIG in
 	ln ../../config.sh . || \
 	ln ../../../config.sh . || \
 	(echo "Can't find config.sh."; exit 1)
-    fi
+    fi 2>/dev/null
     . ./config.sh
     ;;
 esac
@@ -19,44 +19,11 @@ case "$mallocsrc" in
 esac
 echo "Extracting x2p/Makefile (with variable substitutions)"
 cat >Makefile <<!GROK!THIS!
-# $Header: Makefile.SH,v 3.0.1.8 91/01/11 18:34:40 lwall Locked $
+# $Header: Makefile.SH,v 4.0 91/03/20 01:57:03 lwall Locked $
 #
 # $Log:	Makefile.SH,v $
-# Revision 3.0.1.8  91/01/11  18:34:40  lwall
-# patch42: x2p/Makefile.SH blew up on /afs misfeature
-# 
-# Revision 3.0.1.7  90/11/10  02:20:15  lwall
-# patch38: random cleanup
-# 
-# Revision 3.0.1.6  90/10/16  11:28:18  lwall
-# patch29: various portability fixes
-# 
-# Revision 3.0.1.5  90/08/13  22:41:05  lwall
-# patch28: shift/reduce count was off for a2p's Makefile
-# 
-# Revision 3.0.1.4  90/03/01  10:28:09  lwall
-# patch9: a2p didn't allow logical expressions everywhere it should
-# 
-# Revision 3.0.1.3  89/12/21  20:29:00  lwall
-# patch7: Configure now lets you pick between yacc or bison
-# 
-# Revision 3.0.1.2  89/11/17  15:49:55  lwall
-# patch: in x2p/Makefile.SH, removed reference to nm library
-# 
-# Revision 3.0.1.1  89/10/26  23:29:11  lwall
-# patch1: in x2p/Makefile.SH, added dependency on ../config.sh
-# 
-# Revision 3.0  89/10/18  15:33:52  lwall
-# 3.0 baseline
-# 
-# Revision 2.0.1.2  88/09/07  17:13:30  lwall
-# patch14: added redirection of stderr to /dev/null
-# 
-# Revision 2.0.1.1  88/07/11  23:13:39  root
-# patch2: now expects more shift/reduce errors
-# 
-# Revision 2.0  88/06/05  00:15:31  root
-# Baseline version 2.0.
+# Revision 4.0  91/03/20  01:57:03  lwall
+# 4.0 baseline.
 # 
 # 
 
@@ -78,7 +45,7 @@ libs = $libs
 
 cat >>Makefile <<'!NO!SUBS!'
 
-public = a2p s2p
+public = a2p s2p find2perl
 
 private = 
 
diff --git a/x2p/a2p.h b/x2p/a2p.h
index 6b6c410967..7b6f0d48a7 100644
--- a/x2p/a2p.h
+++ b/x2p/a2p.h
@@ -1,4 +1,4 @@
-/* $Header: a2p.h,v 3.0.1.3 90/03/01 10:29:29 lwall Locked $
+/* $Header: a2p.h,v 4.0 91/03/20 01:57:07 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,27 +6,18 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	a2p.h,v $
- * Revision 3.0.1.3  90/03/01  10:29:29  lwall
- * patch9: a2p.h had bzero() definition depending on BCOPY
- * 
- * Revision 3.0.1.2  89/12/21  20:30:29  lwall
- * patch7: arranged so a2p has a chance of running on a 286
- * 
- * Revision 3.0.1.1  89/11/11  05:07:00  lwall
- * patch2: Configure may now set -DDEBUGGING
- * 
- * Revision 3.0  89/10/18  15:34:14  lwall
- * 3.0 baseline
+ * Revision 4.0  91/03/20  01:57:07  lwall
+ * 4.0 baseline.
  * 
  */
 
 #define VOIDUSED 1
 #include "../config.h"
 
-#ifndef BCOPY
+#ifndef HAS_BCOPY
 #   define bcopy(s1,s2,l) memcpy(s2,s1,l)
 #endif
-#ifndef BZERO
+#ifndef HAS_BZERO
 #   define bzero(s,l) memset(s,0,l)
 #endif
 
@@ -265,12 +256,12 @@ void str_free();
 EXT int line INIT(0);
 
 EXT FILE *rsfp;
-EXT char buf[1024];
+EXT char buf[2048];
 EXT char *bufptr INIT(buf);
 
 EXT STR *linestr INIT(Nullstr);
 
-EXT char tokenbuf[256];
+EXT char tokenbuf[2048];
 EXT int expectterm INIT(TRUE);
 
 #ifdef DEBUGGING
diff --git a/x2p/a2p.man b/x2p/a2p.man
index 45d8ea93bb..47515261d5 100644
--- a/x2p/a2p.man
+++ b/x2p/a2p.man
@@ -1,7 +1,10 @@
 .rn '' }`
-''' $Header: a2p.man,v 3.0 89/10/18 15:34:22 lwall Locked $
+''' $Header: a2p.man,v 4.0 91/03/20 01:57:11 lwall Locked $
 ''' 
 ''' $Log:	a2p.man,v $
+''' Revision 4.0  91/03/20  01:57:11  lwall
+''' 4.0 baseline.
+''' 
 ''' Revision 3.0  89/10/18  15:34:22  lwall
 ''' 3.0 baseline
 ''' 
diff --git a/x2p/a2p.y b/x2p/a2p.y
index 1a1e61e372..8b3dc8ba4f 100644
--- a/x2p/a2p.y
+++ b/x2p/a2p.y
@@ -1,5 +1,5 @@
 %{
-/* $Header: a2p.y,v 3.0.1.3 91/01/11 18:35:57 lwall Locked $
+/* $Header: a2p.y,v 4.0 91/03/20 01:57:21 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -7,18 +7,8 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	a2p.y,v $
- * Revision 3.0.1.3  91/01/11  18:35:57  lwall
- * patch42: a2p didn't recognize split with regular expression
- * patch42: a2p didn't handle > redirection right
- * 
- * Revision 3.0.1.2  90/08/09  05:47:26  lwall
- * patch19: a2p didn't handle {foo = (bar == 123)}
- * 
- * Revision 3.0.1.1  90/03/01  10:30:08  lwall
- * patch9: a2p didn't allow logical expressions everywhere it should
- * 
- * Revision 3.0  89/10/18  15:34:29  lwall
- * 3.0 baseline
+ * Revision 4.0  91/03/20  01:57:21  lwall
+ * 4.0 baseline.
  * 
  */
 
diff --git a/x2p/a2py.c b/x2p/a2py.c
index 836d17604c..bfdf6f037c 100644
--- a/x2p/a2py.c
+++ b/x2p/a2py.c
@@ -1,4 +1,4 @@
-/* $Header: a2py.c,v 3.0.1.2 90/10/16 11:30:34 lwall Locked $
+/* $Header: a2py.c,v 4.0 91/03/20 01:57:26 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,14 +6,8 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	a2py.c,v $
- * Revision 3.0.1.2  90/10/16  11:30:34  lwall
- * patch29: various portability fixes
- * 
- * Revision 3.0.1.1  90/08/09  05:48:53  lwall
- * patch19: a2p didn't emit a chop when NF was referenced though split needs it
- * 
- * Revision 3.0  89/10/18  15:34:35  lwall
- * 3.0 baseline
+ * Revision 4.0  91/03/20  01:57:26  lwall
+ * 4.0 baseline.
  * 
  */
 
@@ -1115,7 +1109,10 @@ STR *str;
 		    d--;
 	    }
 	    if (d > t+3) {
-		*d = '\0';
+                char save[2048];
+                strcpy(save, d);
+		*d = '\n';
+                d[1] = '\0';
 		putone();
 		putchar('\n');
 		if (d[-1] != ';' && !(newpos % 4)) {
@@ -1123,7 +1120,7 @@ STR *str;
 		    *t++ = ' ';
 		    newpos += 2;
 		}
-		strcpy(t,d+1);
+		strcpy(t,save+1);
 		newpos += strlen(t);
 		d = t + strlen(t);
 		pos = newpos;
diff --git a/x2p/find2perl.SH b/x2p/find2perl.SH
new file mode 100644
index 0000000000..56983f35d1
--- /dev/null
+++ b/x2p/find2perl.SH
@@ -0,0 +1,664 @@
+case $CONFIG in
+'')
+    if test ! -f config.sh; then
+	ln ../config.sh . || \
+	ln ../../config.sh . || \
+	ln ../../../config.sh . || \
+	(echo "Can't find config.sh."; exit 1)
+    fi
+    . config.sh
+    ;;
+esac
+: This forces SH files to create target in same directory as SH file.
+: This is so that make depend always knows where to find SH derivatives.
+case "$0" in
+*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
+esac
+echo "Extracting find2perl (with variable substitutions)"
+: This section of the file will have variable substitutions done on it.
+: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
+: Protect any dollar signs and backticks that you do not want interpreted
+: by putting a backslash in front.  You may delete these comments.
+$spitshell >find2perl <<!GROK!THIS!
+#!$bin/perl
+
+\$bin = "$bin";
+
+!GROK!THIS!
+
+: In the following dollars and backticks do not need the extra backslash.
+$spitshell >>find2perl <<'!NO!SUBS!'
+
+while ($ARGV[0] =~ /^[^-!(]/) {
+    push(@roots, shift);
+}
+@roots = ('.') unless @roots;
+for (@roots) { $_ = &quote($_); }
+$roots = join(',', @roots);
+
+$indent = 1;
+
+while (@ARGV) {
+    $_ = shift;
+    s/^-// || /^[()!]/ || die "Unrecognized switch: $_\n";
+    if ($_ eq '(') {
+	$out .= &tab . "(\n";
+	$indent++;
+	next;
+    }
+    elsif ($_ eq ')') {
+	$indent--;
+	$out .= &tab . ")";
+    }
+    elsif ($_ eq '!') {
+	$out .= &tab . "!";
+	next;
+    }
+    elsif ($_ eq 'name') {
+	$out .= &tab;
+	$pat = &fileglob_to_re(shift);
+	$out .= '/' . $pat . "/";
+    }
+    elsif ($_ eq 'perm') {
+	$onum = shift;
+	die "Malformed -perm argument: $onum\n" unless $onum =~ /^-?[0-7]+$/;
+	if ($onum =~ s/^-//) {
+	    $onum = '0' . sprintf("%o", oct($onum) & 017777);	# s/b 07777 ?
+	    $out .= &tab . "(\$mode & $onum) == $onum";
+	}
+	else {
+	    $onum = '0' . $onum unless $onum =~ /^0/;
+	    $out .= &tab . "(\$mode & 0777) == $onum";
+	}
+    }
+    elsif ($_ eq 'type') {
+	($filetest = shift) =~ tr/s/S/;
+	$out .= &tab . "-$filetest _";
+    }
+    elsif ($_ eq 'print') {
+	$out .= &tab . 'print("$name\n")';
+    }
+    elsif ($_ eq 'print0') {
+	$out .= &tab . 'print("$name\0")';
+    }
+    elsif ($_ eq 'fstype') {
+	$out .= &tab;
+	$type = shift;
+	if ($type eq 'nfs')
+	    { $out .= '$dev < 0'; }
+	else
+	    { $out .= '$dev >= 0'; }
+    }
+    elsif ($_ eq 'user') {
+	$uname = shift;
+	$out .= &tab . "\$uid == \$uid{'$uname'}";
+	$inituser++;
+    }
+    elsif ($_ eq 'group') {
+	$gname = shift;
+	$out .= &tab . "\$gid == \$gid('$gname')";
+	$initgroup++;
+    }
+    elsif ($_ eq 'nouser') {
+	$out .= &tab . '!defined $uid{$uid}';
+	$inituser++;
+    }
+    elsif ($_ eq 'nogroup') {
+	$out .= &tab . '!defined $gid{$gid}';
+	$initgroup++;
+    }
+    elsif ($_ eq 'links') {
+	$out .= &tab . '$nlink ' . &n(shift);
+    }
+    elsif ($_ eq 'inum') {
+	$out .= &tab . '$ino ' . &n(shift);
+    }
+    elsif ($_ eq 'size') {
+	$out .= &tab . 'int((-s _ + 511) / 512) ' . &n(shift);
+    }
+    elsif ($_ eq 'atime') {
+	$out .= &tab . 'int(-A _) ' . &n(shift);
+    }
+    elsif ($_ eq 'mtime') {
+	$out .= &tab . 'int(-M _) ' . &n(shift);
+    }
+    elsif ($_ eq 'ctime') {
+	$out .= &tab . 'int(-C _) ' . &n(shift);
+    }
+    elsif ($_ eq 'exec') {
+	for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
+	shift;
+	for (@cmd) { s/'/\\'/g; }
+	$" = "','";
+	$out .= &tab . "&exec(0, '@cmd')";
+	$" = ' ';
+	$initexec++;
+    }
+    elsif ($_ eq 'ok') {
+	for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
+	shift;
+	for (@cmd) { s/'/\\'/g; }
+	$" = "','";
+	$out .= &tab . "&exec(1, '@cmd')";
+	$" = ' ';
+	$initexec++;
+    }
+    elsif ($_ eq 'prune') {
+	$out .= &tab . '($prune = 1)';
+    }
+    elsif ($_ eq 'xdev') {
+	$out .= &tab . '(($prune |= ($dev != $topdev)),1)';
+    }
+    elsif ($_ eq 'newer') {
+	$out .= &tab;
+	$file = shift;
+	$newername = 'AGE_OF' . $file;
+	$newername =~ s/[^\w]/_/g;
+	$newername = '$' . $newername;
+	$out .= "-M _ < $newername";
+	$initnewer .= "$newername = -M " . &quote($file) . ";\n";
+    }
+    elsif ($_ eq 'eval') {
+	$prog = &quote(shift);
+	$out .= &tab . "eval $prog";
+    }
+    elsif ($_ eq 'depth') {
+	$depth++;
+	next;
+    }
+    elsif ($_ eq 'ls') {
+	$out .= &tab . "&ls";
+	$initls++;
+    }
+    elsif ($_ eq 'tar') {
+	$out .= &tab;
+	die "-tar must have a filename argument\n" unless @ARGV;
+	$file = shift;
+	$fh = 'FH' . $file;
+	$fh =~ s/[^\w]/_/g;
+	$out .= "&tar($fh)";
+	$file = '>' . $file;
+	$initfile .= "open($fh, " . &quote($file) .
+	  qq{) || die "Can't open $fh: \$!\\n";\n};
+	$inittar++;
+	$flushall = "\n&tflushall;\n";
+    }
+    elsif (/^n?cpio$/) {
+	$depth++;
+	$out .= &tab;
+	die "-$_ must have a filename argument\n" unless @ARGV;
+	$file = shift;
+	$fh = 'FH' . $file;
+	$fh =~ s/[^\w]/_/g;
+	$out .= "&cpio('" . substr($_,0,1) . "', $fh)";
+	$file = '>' . $file;
+	$initfile .= "open($fh, " . &quote($file) .
+	  qq{) || die "Can't open $fh: \$!\\n";\n};
+	$initcpio++;
+	$flushall = "\n&flushall;\n";
+    }
+    else {
+	die "Unrecognized switch: -$_\n";
+    }
+    if (@ARGV) {
+	if ($ARGV[0] eq '-o') {
+	    local($indent) = $indent - 4;
+	    $out .= "\n" . &tab . "||\n";
+	    shift;
+	}
+	else {
+	    $out .= " &&" unless $ARGV[0] eq ')';
+	    $out .= "\n";
+	    shift if $ARGV[0] eq '-a';
+	}
+    }
+}
+
+print <<"END";
+#!$bin/perl
+
+END
+
+if ($initls) {
+    print <<'END';
+@rwx = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
+@moname = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);
+
+END
+}
+
+if ($inituser || $initls) {
+    print 'while (($name, $pw, $uid) = getpwent) {', "\n";
+    print '    $uid{$name} = $uid{$uid} = $uid;', "\n" if $inituser;
+    print '    $user{$uid} = $name unless $user{$uid};', "\n" if $initls;
+    print "}\n\n";
+}
+
+if ($initgroup || $initls) {
+    print 'while (($name, $pw, $gid) = getgrent) {', "\n";
+    print '    $gid{$name} = $gid{$gid} = $gid;', "\n" if $initgroup;
+    print '    $group{$gid} = $name unless $group{$gid};', "\n" if $initls;
+    print "}\n\n";
+}
+
+print $initnewer, "\n" if $initnewer;
+
+print $initfile, "\n" if $initfile;
+
+print <<"END";
+# Traverse desired filesystems
+
+&dodirs($roots);
+$flushall
+exit;
+
+sub wanted {
+$out;
+}
+
+END
+
+print <<'END';
+sub dodirs {
+    chop($cwd = `pwd`);
+    foreach $topdir (@_) {
+	(($topdev,$topino,$topmode,$topnlink) = stat($topdir))
+	  || (warn("Can't stat $topdir: $!\n"), next);
+	if (-d _) {
+	    if (chdir($topdir)) {
+END
+if ($depth) {
+    print <<'END';
+		$topdir = '' if $topdir eq '/';
+		&dodir($topdir,$topnlink);
+		($dir,$_) = ($topdir,'.');
+		$name = $topdir;
+		&wanted;
+END
+}
+else {
+    print <<'END';
+		($dir,$_) = ($topdir,'.');
+		$name = $topdir;
+		&wanted;
+		$topdir = '' if $topdir eq '/';
+		&dodir($topdir,$topnlink);
+END
+}
+print <<'END';
+	    }
+	    else {
+		warn "Can't cd to $topdir: $!\n";
+	    }
+	}
+	else {
+	    unless (($dir,$_) = $topdir =~ m#^(.*/)(.*)$#) {
+		($dir,$_) = ('.', $topdir);
+	    }
+	    chdir $dir && &wanted;
+	}
+	chdir $cwd;
+    }
+}
+
+sub dodir {
+    local($dir,$nlink) = @_;
+    local($dev,$ino,$mode,$subcount);
+    local($name);
+
+    # Get the list of files in the current directory.
+
+    opendir(DIR,'.') || warn "Can't open $dir: $!\n";
+    local(@filenames) = readdir(DIR);
+    closedir(DIR);
+
+    if ($nlink == 2) {        # This dir has no subdirectories.
+	for (@filenames) {
+	    next if $_ eq '.';
+	    next if $_ eq '..';
+	    $name = "$dir/$_";
+	    &wanted;
+	}
+    }
+    else {                    # This dir has subdirectories.
+	$subcount = $nlink - 2;
+	for (@filenames) {
+	    next if $_ eq '.';
+	    next if $_ eq '..';
+	    $nlink = $prune = 0;
+	    $name = "$dir/$_";
+END
+print <<'END' unless $depth;
+	    &wanted;
+END
+print <<'END';
+	    if ($subcount > 0) {    # Seen all the subdirs?
+
+		# Get link count and check for directoriness.
+
+		($dev,$ino,$mode,$nlink) = lstat($_) unless $nlink;
+		
+		if (-d _) {
+
+		    # It really is a directory, so do it recursively.
+
+		    if (!$prune && chdir $_) {
+			&dodir($name,$nlink);
+			chdir '..';
+		    }
+		    --$subcount;
+		}
+	    }
+END
+print <<'END' if $depth;
+	    &wanted;
+END
+print <<'END';
+	}
+    }
+}
+
+END
+
+if ($initexec) {
+    print <<'END';
+sub exec {
+    local($ok, @cmd) = @_;
+    foreach $word (@cmd) {
+	$word =~ s#{}#$name#g;
+    }
+    if ($ok) {
+	local($old) = select(STDOUT);
+	$| = 1;
+	print "@cmd";
+	select($old);
+	return 0 unless <STDIN> =~ /^y/;
+    }
+    chdir $cwd;		# sigh
+    system @cmd;
+    chdir $dir;
+    return !$?;
+}
+
+END
+}
+
+if ($initls) {
+    print <<'END';
+sub ls {
+    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
+      $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
+
+    $pname = $name;
+
+    if (defined $blocks) {
+	$blocks = int(($blocks + 1) / 2);
+    }
+    else {
+	$blocks = int(($size + 1023) / 1024);
+    }
+
+    if    (-f _) { $perms = '-'; }
+    elsif (-d _) { $perms = 'd'; }
+    elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
+    elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
+    elsif (-p _) { $perms = 'p'; }
+    elsif (-S _) { $perms = 's'; }
+    else         { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
+
+    $tmpmode = $mode;
+    $tmp = $rwx[$tmpmode & 7];
+    $tmpmode >>= 3;
+    $tmp = $rwx[$tmpmode & 7] . $tmp;
+    $tmpmode >>= 3;
+    $tmp = $rwx[$tmpmode & 7] . $tmp;
+    substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
+    substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
+    substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
+    $perms .= $tmp;
+
+    $user = $user{$uid} || $uid;
+    $group = $group{$gid} || $gid;
+
+    ($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
+    $moname = $moname[$mon];
+    if (-M _ > 365.25 / 2) {
+	$timeyear = '19' . $year;
+    }
+    else {
+	$timeyear = sprintf("%02d:%02d", $hour, $min);
+    }
+
+    printf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
+	    $ino,
+		 $blocks,
+		      $perms,
+			    $nlink,
+				$user,
+				     $group,
+					  $sizemm,
+					      $moname,
+						 $mday,
+						     $timeyear,
+							 $pname;
+    1;
+}
+
+sub sizemm {
+    sprintf("%3d, %3d", ($rdev >> 8) & 255, $rdev & 255);
+}
+
+END
+}
+
+if ($initcpio) {
+print <<'END';
+sub cpio {
+    local($nc,$fh) = @_;
+    local($text);
+
+    if ($name eq 'TRAILER!!!') {
+	$text = '';
+	$size = 0;
+    }
+    else {
+	($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+	  $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
+	if (-f _) {
+	    open(IN, $_) || do {
+		warn "Couldn't open $name: $!\n";
+		return;
+	    };
+	}
+	else {
+	    $text = readlink($_);
+	    $size = 0 unless defined $text;
+	}
+    }
+
+    ($nm = $name) =~ s#^\./##;
+    $nc{$fh} = $nc;
+    if ($nc eq 'n') {
+	$cpout{$fh} .=
+	  sprintf("%06o%06o%06o%06o%06o%06o%06o%06o%011lo%06o%011lo%s\0",
+	    070707,
+	    $dev & 0777777,
+	    $ino & 0777777,
+	    $mode & 0777777,
+	    $uid & 0777777,
+	    $gid & 0777777,
+	    $nlink & 0777777,
+	    $rdev & 0177777,
+	    $mtime,
+	    length($nm)+1,
+	    $size,
+	    $nm);
+    }
+    else {
+	$cpout{$fh} .= "\0" if length($cpout{$fh}) & 1;
+	$cpout{$fh} .= pack("SSSSSSSSLSLa*",
+	    070707, $dev, $ino, $mode, $uid, $gid, $nlink, $rdev, $mtime,
+	    length($nm)+1, $size, $nm . (length($nm) & 1 ? "\0" : "\0\0"));
+    }
+    if ($text ne '') {
+	$cpout{$fh} .= $text;
+    }
+    elsif ($size) {
+	&flush($fh) while ($l = length($cpout{$fh})) >= 5120;
+	while (sysread(IN, $cpout{$fh}, 5120 - $l, $l)) {
+	    &flush($fh);
+	    $l = length($cpout{$fh});
+	}
+    }
+    close IN;
+}
+
+sub flush {
+    local($fh) = @_;
+
+    while (length($cpout{$fh}) >= 5120) {
+	syswrite($fh,$cpout{$fh},5120);
+	++$blocks{$fh};
+	substr($cpout{$fh}, 0, 5120) = '';
+    }
+}
+
+sub flushall {
+    $name = 'TRAILER!!!';
+    foreach $fh (keys %cpout) {
+	&cpio($nc{$fh},$fh);
+	$cpout{$fh} .= "0" x (5120 - length($cpout{$fh}));
+	&flush($fh);
+	print $blocks{$fh} * 10, " blocks\n";
+    }
+}
+
+END
+}
+
+if ($inittar) {
+print <<'END';
+sub tar {
+    local($fh) = @_;
+    local($linkname,$header,$l,$slop);
+    local($linkflag) = "\0";
+
+    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+      $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
+    $nm = $name;
+    if ($nlink > 1) {
+	if ($linkname = $linkseen{$fh,$dev,$ino}) {
+	    $linkflag = 1;
+	}
+	else {
+	    $linkseen{$fh,$dev,$ino} = $nm;
+	}
+    }
+    if (-f _) {
+	open(IN, $_) || do {
+	    warn "Couldn't open $name: $!\n";
+	    return;
+	};
+	$size = 0 if $linkflag ne "\0";
+    }
+    else {
+	$linkname = readlink($_);
+	$linkflag = 2 if defined $linkname;
+	$nm .= '/' if -d _;
+	$size = 0;
+    }
+
+    $header = pack("a100a8a8a8a12a12a8a1a100",
+	$nm,
+	sprintf("%6o ", $mode & 0777),
+	sprintf("%6o ", $uid & 0777777),
+	sprintf("%6o ", $gid & 0777777),
+	sprintf("%11o ", $size),
+	sprintf("%11o ", $mtime),
+	"        ",
+	$linkflag,
+	$linkname);
+    $l = length($header) % 512;
+    substr($header, 148, 6) = sprintf("%6o", unpack("%16C*", $header));
+    substr($header, 154, 1) = "\0";  # blech
+    $tarout{$fh} .= $header;
+    $tarout{$fh} .= "\0" x (512 - $l) if $l;
+    if ($size) {
+	&tflush($fh) while ($l = length($tarout{$fh})) >= 10240;
+	while (sysread(IN, $tarout{$fh}, 10240 - $l, $l)) {
+	    $slop = length($tarout{$fh}) % 512;
+	    $tarout{$fh} .= "\0" x (512 - $slop) if $slop;
+	    &tflush($fh);
+	    $l = length($tarout{$fh});
+	}
+    }
+    close IN;
+}
+
+sub tflush {
+    local($fh) = @_;
+
+    while (length($tarout{$fh}) >= 10240) {
+	syswrite($fh,$tarout{$fh},10240);
+	++$blocks{$fh};
+	substr($tarout{$fh}, 0, 10240) = '';
+    }
+}
+
+sub tflushall {
+    local($len);
+
+    foreach $fh (keys %tarout) {
+	$len = 10240 - length($tarout{$fh});
+	$len += 10240 if $len < 1024;
+	$tarout{$fh} .= "\0" x $len;
+	&tflush($fh);
+    }
+}
+
+END
+}
+
+exit;
+
+############################################################################
+
+sub tab {
+    local($tabstring);
+
+    $tabstring = "\t" x ($indent / 2) . ' ' x ($indent % 2 * 4);
+    if ($_ !~ /^(name|print)/) {
+	if (!$statdone) {
+	    $tabstring .= <<'ENDOFSTAT' . $tabstring;
+(($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
+ENDOFSTAT
+	    $statdone = 1;
+	}
+    }
+    $tabstring =~ s/^\s+/ / if $out =~ /!$/;
+    $tabstring;
+}
+
+sub fileglob_to_re {
+    local($tmp) = @_;
+
+    $tmp =~ s/([.^\$()])/\\$1/g;
+    $tmp =~ s/([?*])/.$1/g;
+    "^$tmp$";
+}
+
+sub n {
+    local($n) = @_;
+
+    $n =~ s/^-0*/< / || $n =~ s/^\+0*/> / || $n =~ s/^0*/== /;
+    $n;
+}
+
+sub quote {
+    local($string) = @_;
+    $string =~ s/'/\\'/;
+    "'$string'";
+}
+!NO!SUBS!
+chmod 755 find2perl
+$eunicefix find2perl
diff --git a/x2p/handy.h b/x2p/handy.h
index 80a9afbbdf..84e0c3de6e 100644
--- a/x2p/handy.h
+++ b/x2p/handy.h
@@ -1,4 +1,4 @@
-/* $Header: handy.h,v 3.0 89/10/18 15:34:44 lwall Locked $
+/* $Header: handy.h,v 4.0 91/03/20 01:57:45 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,8 +6,8 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	handy.h,v $
- * Revision 3.0  89/10/18  15:34:44  lwall
- * 3.0 baseline
+ * Revision 4.0  91/03/20  01:57:45  lwall
+ * 4.0 baseline.
  * 
  */
 
diff --git a/x2p/hash.c b/x2p/hash.c
index a89b6511e4..fd92045bc3 100644
--- a/x2p/hash.c
+++ b/x2p/hash.c
@@ -1,4 +1,4 @@
-/* $Header: hash.c,v 3.0 89/10/18 15:34:50 lwall Locked $
+/* $Header: hash.c,v 4.0 91/03/20 01:57:49 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,8 +6,8 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	hash.c,v $
- * Revision 3.0  89/10/18  15:34:50  lwall
- * 3.0 baseline
+ * Revision 4.0  91/03/20  01:57:49  lwall
+ * 4.0 baseline.
  * 
  */
 
@@ -73,10 +73,12 @@ STR *val;
 	    continue;
 	if (strNE(entry->hent_key,key))	/* is this it? */
 	    continue;
+	/*NOSTRICT*/
 	safefree((char*)entry->hent_val);
 	entry->hent_val = val;
 	return TRUE;
     }
+    /*NOSTRICT*/
     entry = (HENT*) safemalloc(sizeof(HENT));
 
     entry->hent_key = savestr(key);
diff --git a/x2p/hash.h b/x2p/hash.h
index 1a67ae8b73..14d2069362 100644
--- a/x2p/hash.h
+++ b/x2p/hash.h
@@ -1,4 +1,4 @@
-/* $Header: hash.h,v 3.0 89/10/18 15:34:57 lwall Locked $
+/* $Header: hash.h,v 4.0 91/03/20 01:57:53 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,8 +6,8 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	hash.h,v $
- * Revision 3.0  89/10/18  15:34:57  lwall
- * 3.0 baseline
+ * Revision 4.0  91/03/20  01:57:53  lwall
+ * 4.0 baseline.
  * 
  */
 
diff --git a/x2p/s2p.SH b/x2p/s2p.SH
index 36eab5e11e..c059481a18 100644
--- a/x2p/s2p.SH
+++ b/x2p/s2p.SH
@@ -11,7 +11,7 @@ case $CONFIG in
 	ln ../../config.sh . || \
 	ln ../../../config.sh . || \
 	(echo "Can't find config.sh."; exit 1)
-    fi
+    fi 2>/dev/null
     . ./config.sh
     ;;
 esac
@@ -29,40 +29,11 @@ $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.7 91/01/11 18:36:44 lwall Locked $
+# $Header: s2p.SH,v 4.0 91/03/20 01:57:59 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"
-# 
-# Revision 3.0.1.5  90/10/16  11:32:40  lwall
-# patch29: s2p modernized
-# 
-# Revision 3.0.1.4  90/08/09  05:50:43  lwall
-# patch19: s2p didn't translate \n right
-# 
-# Revision 3.0.1.3  90/03/01  10:31:21  lwall
-# patch9: s2p didn't handle \< and \>
-# 
-# Revision 3.0.1.2  89/11/17  15:51:27  lwall
-# patch5: in s2p, line labels without a subsequent statement were done wrong
-# patch5: s2p left residue in /tmp
-# 
-# Revision 3.0.1.1  89/11/11  05:08:25  lwall
-# patch2: in s2p, + within patterns needed backslashing
-# patch2: s2p was printing out some debugging info to the output file
-# 
-# Revision 3.0  89/10/18  15:35:02  lwall
-# 3.0 baseline
-# 
-# Revision 2.0.1.1  88/07/11  23:26:23  root
-# patch2: s2p didn't put a proper prologue on output script
-# 
-# Revision 2.0  88/06/05  00:15:55  root
-# Baseline version 2.0.
+# Revision 4.0  91/03/20  01:57:59  lwall
+# 4.0 baseline.
 # 
 #
 
diff --git a/x2p/s2p.man b/x2p/s2p.man
index be5ef6130c..1017d37626 100644
--- a/x2p/s2p.man
+++ b/x2p/s2p.man
@@ -1,7 +1,10 @@
 .rn '' }`
-''' $Header: s2p.man,v 3.0 89/10/18 15:35:09 lwall Locked $
+''' $Header: s2p.man,v 4.0 91/03/20 01:58:07 lwall Locked $
 ''' 
 ''' $Log:	s2p.man,v $
+''' Revision 4.0  91/03/20  01:58:07  lwall
+''' 4.0 baseline.
+''' 
 ''' Revision 3.0  89/10/18  15:35:09  lwall
 ''' 3.0 baseline
 ''' 
diff --git a/x2p/str.c b/x2p/str.c
index 94aeab1c93..f928b77931 100644
--- a/x2p/str.c
+++ b/x2p/str.c
@@ -1,4 +1,4 @@
-/* $Header: str.c,v 3.0 89/10/18 15:35:18 lwall Locked $
+/* $Header: str.c,v 4.0 91/03/20 01:58:15 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,8 +6,8 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	str.c,v $
- * Revision 3.0  89/10/18  15:35:18  lwall
- * 3.0 baseline
+ * Revision 4.0  91/03/20  01:58:15  lwall
+ * 4.0 baseline.
  * 
  */
 
@@ -419,7 +419,7 @@ register STR *str;
 /* make a string that will exist for the duration of the expression eval */
 
 STR *
-str_static(oldstr)
+str_mortal(oldstr)
 STR *oldstr;
 {
     register STR *str = str_new(0);
diff --git a/x2p/str.h b/x2p/str.h
index 66225abb26..62c44a0863 100644
--- a/x2p/str.h
+++ b/x2p/str.h
@@ -1,4 +1,4 @@
-/* $Header: str.h,v 3.0 89/10/18 15:35:27 lwall Locked $
+/* $Header: str.h,v 4.0 91/03/20 01:58:21 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,8 +6,8 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	str.h,v $
- * Revision 3.0  89/10/18  15:35:27  lwall
- * 3.0 baseline
+ * Revision 4.0  91/03/20  01:58:21  lwall
+ * 4.0 baseline.
  * 
  */
 
@@ -34,7 +34,7 @@ EXT long tmps_max INIT(-1);
 
 char *str_2ptr();
 double str_2num();
-STR *str_static();
+STR *str_mortal();
 STR *str_make();
 STR *str_nmake();
 char *str_gets();
diff --git a/x2p/util.c b/x2p/util.c
index 07f19a3715..d1ba317677 100644
--- a/x2p/util.c
+++ b/x2p/util.c
@@ -1,4 +1,4 @@
-/* $Header: util.c,v 3.0.1.1 90/10/16 11:34:06 lwall Locked $
+/* $Header: util.c,v 4.0 91/03/20 01:58:25 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,11 +6,8 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	util.c,v $
- * Revision 3.0.1.1  90/10/16  11:34:06  lwall
- * patch29: removed #ifdef undef
- * 
- * Revision 3.0  89/10/18  15:35:35  lwall
- * 3.0 baseline
+ * Revision 4.0  91/03/20  01:58:25  lwall
+ * 4.0 baseline.
  * 
  */
 
diff --git a/x2p/util.h b/x2p/util.h
index f36c27cfa0..d682ee1d4b 100644
--- a/x2p/util.h
+++ b/x2p/util.h
@@ -1,4 +1,4 @@
-/* $Header: util.h,v 3.0 89/10/18 15:35:41 lwall Locked $
+/* $Header: util.h,v 4.0 91/03/20 01:58:29 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,8 +6,8 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	util.h,v $
- * Revision 3.0  89/10/18  15:35:41  lwall
- * 3.0 baseline
+ * Revision 4.0  91/03/20  01:58:29  lwall
+ * 4.0 baseline.
  * 
  */
 
diff --git a/x2p/walk.c b/x2p/walk.c
index 555e13c1a3..3dd4a1a266 100644
--- a/x2p/walk.c
+++ b/x2p/walk.c
@@ -1,4 +1,4 @@
-/* $Header: walk.c,v 3.0.1.6 90/10/16 11:35:51 lwall Locked $
+/* $Header: walk.c,v 4.0 91/03/20 01:58:36 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,28 +6,8 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	walk.c,v $
- * Revision 3.0.1.6  90/10/16  11:35:51  lwall
- * patch29: a2p mistranslated certain weird field separators
- * 
- * Revision 3.0.1.5  90/08/09  05:55:01  lwall
- * patch19: a2p emited local($_) without a semicolon
- * patch19: a2p didn't make explicit split on whitespace skip leading whitespace
- * patch19: foreach on a normal array was iterating on values instead of indexes
- * 
- * Revision 3.0.1.4  90/03/01  10:32:45  lwall
- * patch9: a2p didn't put a $ on ExitValue
- * 
- * Revision 3.0.1.3  89/12/21  20:32:35  lwall
- * patch7: in a2p, user-defined functions didn't work on some machines
- * 
- * Revision 3.0.1.2  89/11/17  15:53:00  lwall
- * patch5: on Pyramids, index(s, '}' + 128) doesn't find meta-}
- * 
- * Revision 3.0.1.1  89/11/11  05:09:33  lwall
- * patch2: in a2p, awk script with no line actions still needs main loop
- * 
- * Revision 3.0  89/10/18  15:35:48  lwall
- * 3.0 baseline
+ * Revision 4.0  91/03/20  01:58:36  lwall
+ * 4.0 baseline.
  * 
  */
 
@@ -938,7 +918,7 @@ sub Pick {\n\
 		s = "\"";
 		*d++ = *t++ + 128;
 		switch (*t) {
-		case '\\': case '"': case 'n': case 't':
+		case '\\': case '"': case 'n': case 't': case '$':
 		    break;
 		default:	/* hide this from perl */
 		    *d++ = '\\' + 128;
@@ -1290,7 +1270,7 @@ sub Pick {\n\
 	    tmpstr = walk(1,level,ops[node+1].ival,&numarg,P_MIN);
 	else
 	    tmpstr = str_new(0);;
-	if (!*tmpstr->str_ptr) {
+	if (!tmpstr->str_ptr || !*tmpstr->str_ptr) {
 	    if (lval_field) {
 		t = saw_OFS ? "$," : "' '";
 		if (split_to_array) {