perl5.001 patch.1h: [re-organisations and patch description]

[editor's note: individual patches have been split from this combined
patch]

5 files changed, 2581 insertions, 0 deletions

diff --git a/utils/c2ph.PL b/utils/c2ph.PL
new file mode 100644
index 0000000000..b5049b3d11
--- /dev/null
+++ b/utils/c2ph.PL
@@ -0,0 +1,1184 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# List explicitly here the variables you want Configure to
+# generate.  Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries.  Thus you write
+#  $startperl
+# to ensure Configure will look for $Config{startperl}.
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+	if ($Config{'osname'} eq 'VMS' or
+	    $Config{'osname'} eq 'OS2');  # "case-forgiving"
+
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file (with variable substitutions)\n";
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT <<"!GROK!THIS!";
+$Config{'startperl'}
+    eval 'exec perl -S \$0 "\$@"'
+	if 0;
+!GROK!THIS!
+
+# In the following, perl variables are not expanded during extraction.
+
+print OUT <<'!NO!SUBS!';
+#
+#
+#   c2ph (aka pstruct)
+#   Tom Christiansen, <tchrist@convex.com>
+#   
+#   As pstruct, dump C structures as generated from 'cc -g -S' stabs.
+#   As c2ph, do this PLUS generate perl code for getting at the structures.
+#
+#   See the usage message for more.  If this isn't enough, read the code.
+#
+
+$RCSID = '$Id: c2ph,v 1.7 95/10/28 10:41:47 tchrist Exp Locker: tchrist $';
+
+
+######################################################################
+
+# some handy data definitions.   many of these can be reset later.
+
+$bitorder = 'b';  # ascending; set to B for descending bit fields
+
+%intrinsics = 
+%template = (
+    'char', 			'c',
+    'unsigned char', 		'C',
+    'short',			's',
+    'short int',		's',
+    'unsigned short',		'S',
+    'unsigned short int',	'S',
+    'short unsigned int',	'S',
+    'int',			'i',
+    'unsigned int',		'I',
+    'long',			'l',
+    'long int',			'l',
+    'unsigned long',		'L',
+    'unsigned long',		'L',
+    'long unsigned int',	'L',
+    'unsigned long int',	'L',
+    'long long',		'q',
+    'long long int',		'q',
+    'unsigned long long',	'Q',
+    'unsigned long long int',	'Q',
+    'float',			'f',
+    'double',			'd',
+    'pointer',			'p',
+    'null',			'x',
+    'neganull',			'X',
+    'bit',			$bitorder,
+); 
+
+&buildscrunchlist;
+delete $intrinsics{'neganull'};
+delete $intrinsics{'bit'};
+delete $intrinsics{'null'};
+
+# use -s to recompute sizes
+%sizeof = (
+    'char', 			'1',
+    'unsigned char', 		'1',
+    'short',			'2',
+    'short int',		'2',
+    'unsigned short',		'2',
+    'unsigned short int',	'2',
+    'short unsigned int',	'2',
+    'int',			'4',
+    'unsigned int',		'4',
+    'long',			'4',
+    'long int',			'4',
+    'unsigned long',		'4',
+    'unsigned long int',	'4',
+    'long unsigned int',	'4',
+    'long long',		'8',
+    'long long int',		'8',
+    'unsigned long long',	'8',
+    'unsigned long long int',	'8',
+    'float',			'4',
+    'double',			'8',
+    'pointer',			'4',
+);
+
+($type_width, $member_width, $offset_width, $size_width) = (20, 20, 6, 5);
+
+($offset_fmt, $size_fmt) = ('d', 'd');
+
+$indent = 2;
+
+$CC = 'cc';
+$CFLAGS = '-g -S';
+$DEFINES = '';
+
+$perl++ if $0 =~ m#/?c2ph$#;
+
+require 'getopts.pl';
+
+eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;
+
+&Getopts('aixdpvtnws:') || &usage(0);
+
+$opt_d && $debug++;
+$opt_t && $trace++;
+$opt_p && $perl++;
+$opt_v && $verbose++;
+$opt_n && ($perl = 0);
+
+if ($opt_w) {
+    ($type_width, $member_width, $offset_width) = (45, 35, 8);
+} 
+if ($opt_x) {
+    ($offset_fmt, $offset_width, $size_fmt, $size_width) = ( 'x', '08', 'x', 04 );
+}
+
+eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;
+
+sub PLUMBER {
+    select(STDERR);
+    print "oops, apperent pager foulup\n";
+    $isatty++;
+    &usage(1);
+} 
+
+sub usage {
+    local($oops) = @_;
+    unless (-t STDOUT) {
+	select(STDERR);
+    } elsif (!$oops) {
+	$isatty++;
+	$| = 1;
+	print "hit <RETURN> for further explanation: ";
+	<STDIN>;
+	open (PIPE, "|". ($ENV{PAGER} || 'more'));
+	$SIG{PIPE} = PLUMBER;
+	select(PIPE);
+    } 
+
+    print "usage: $0 [-dpnP] [var=val] [files ...]\n";
+
+    exit unless $isatty;
+
+    print <<EOF;
+
+Options:
+
+-w	wide; short for: type_width=45 member_width=35 offset_width=8
+-x	hex; short for:  offset_fmt=x offset_width=08 size_fmt=x size_width=04
+
+-n  	do not generate perl code  (default when invoked as pstruct)
+-p  	generate perl code         (default when invoked as c2ph)
+-v	generate perl code, with C decls as comments
+
+-i	do NOT recompute sizes for intrinsic datatypes
+-a	dump information on intrinsics also
+
+-t 	trace execution
+-d	spew reams of debugging output
+
+-slist  give comma-separated list a structures to dump
+
+
+Var Name        Default Value    Meaning
+
+EOF
+
+    &defvar('CC', 'which_compiler to call');
+    &defvar('CFLAGS', 'how to generate *.s files with stabs');
+    &defvar('DEFINES','any extra cflags or cpp defines, like -I, -D, -U');
+
+    print "\n";
+
+    &defvar('type_width', 'width of type field   (column 1)');
+    &defvar('member_width', 'width of member field (column 2)');
+    &defvar('offset_width', 'width of offset field (column 3)');
+    &defvar('size_width', 'width of size field   (column 4)');
+
+    print "\n";
+
+    &defvar('offset_fmt', 'sprintf format type for offset');
+    &defvar('size_fmt', 'sprintf format type for size');
+
+    print "\n";
+
+    &defvar('indent', 'how far to indent each nesting level');
+
+   print <<'EOF';
+
+    If any *.[ch] files are given, these will be catted together into
+    a temporary *.c file and sent through:
+	    $CC $CFLAGS $DEFINES 
+    and the resulting *.s groped for stab information.  If no files are
+    supplied, then stdin is read directly with the assumption that it
+    contains stab information.  All other liens will be ignored.  At
+    most one *.s file should be supplied.
+
+EOF
+    close PIPE;
+    exit 1;
+} 
+
+sub defvar {
+    local($var, $msg) = @_;
+    printf "%-16s%-15s  %s\n", $var, eval "\$$var", $msg;
+} 
+
+$recurse = 1;
+
+if (@ARGV) {
+    if (grep(!/\.[csh]$/,@ARGV)) {
+	warn "Only *.[csh] files expected!\n";
+	&usage;
+    } 
+    elsif (grep(/\.s$/,@ARGV)) {
+	if (@ARGV > 1) { 
+	    warn "Only one *.s file allowed!\n";
+	    &usage;
+	}
+    } 
+    elsif (@ARGV == 1 && $ARGV[0] =~ /\.c$/) {
+	local($dir, $file) = $ARGV[0] =~ m#(.*/)?(.*)$#;
+	$chdir = "cd $dir; " if $dir;
+	&system("$chdir$CC $CFLAGS $DEFINES $file") && exit 1;
+	$ARGV[0] =~ s/\.c$/.s/;
+    } 
+    else {
+	$TMP = "/tmp/c2ph.$$.c";
+	&system("cat @ARGV > $TMP") && exit 1;
+	&system("cd /tmp; $CC $CFLAGS $DEFINES $TMP") && exit 1;
+	unlink $TMP;
+	$TMP =~ s/\.c$/.s/;
+	@ARGV = ($TMP);
+    } 
+}
+
+if ($opt_s) {
+    for (split(/[\s,]+/, $opt_s)) {
+	$interested{$_}++;
+    } 
+} 
+
+
+$| = 1 if $debug;
+
+main: {
+
+    if ($trace) {
+	if (-t && !@ARGV) { 
+	    print STDERR "reading from your keyboard: ";
+	} else {
+	    print STDERR "reading from " . (@ARGV ? "@ARGV" : "<STDIN>").": ";
+	}
+    }
+
+STAB: while (<>) {
+	if ($trace && !($. % 10)) {
+	    $lineno = $..'';
+	    print STDERR $lineno, "\b" x length($lineno);
+	} 
+	next unless /^\s*\.stabs\s+/;
+	$line = $_;
+	s/^\s*\.stabs\s+//; 
+	if (s/\\\\"[d,]+$//) {
+	    $saveline .= $line;
+	    $savebar  = $_;
+	    next STAB;
+	} 
+	if ($saveline) {
+	    s/^"//;
+	    $_ = $savebar . $_;
+	    $line = $saveline;
+	} 
+	&stab; 
+	$savebar = $saveline = undef;
+    }
+    print STDERR "$.\n" if $trace;
+    unlink $TMP if $TMP;
+
+    &compute_intrinsics if $perl && !$opt_i;
+
+    print STDERR "resolving types\n" if $trace;
+
+    &resolve_types;
+    &adjust_start_addrs;
+
+    $sum = 2 + $type_width + $member_width;
+    $pmask1 = "%-${type_width}s %-${member_width}s"; 
+    $pmask2 = "%-${sum}s %${offset_width}${offset_fmt}%s %${size_width}${size_fmt}%s";
+
+
+
+    if ($perl) {
+	# resolve template -- should be in stab define order, but even this isn't enough.
+	print STDERR "\nbuilding type templates: " if $trace;
+	for $i (reverse 0..$#type) {
+	    next unless defined($name = $type[$i]);
+	    next unless defined $struct{$name};
+	    ($iname = $name) =~ s/\..*//;
+	    $build_recursed = 0;
+	    &build_template($name) unless defined $template{&psou($name)} ||
+					$opt_s && !$interested{$iname};
+	} 
+	print STDERR "\n\n" if $trace;
+    }
+
+    print STDERR "dumping structs: " if $trace;
+
+    local($iam);
+
+
+
+    foreach $name (sort keys %struct) {
+	($iname = $name) =~ s/\..*//;
+	next if $opt_s && !$interested{$iname};
+	print STDERR "$name " if $trace;
+
+	undef @sizeof;
+	undef @typedef;
+	undef @offsetof;
+	undef @indices;
+	undef @typeof;
+	undef @fieldnames;
+
+	$mname = &munge($name);
+
+	$fname = &psou($name);
+
+	print "# " if $perl && $verbose;
+	$pcode = '';
+	print "$fname {\n" if !$perl || $verbose; 
+	$template{$fname} = &scrunch($template{$fname}) if $perl;
+	&pstruct($name,$name,0); 
+	print "# " if $perl && $verbose;
+	print "}\n" if !$perl || $verbose; 
+	print "\n" if $perl && $verbose;
+
+	if ($perl) {
+	    print "$pcode";
+
+	    printf("\nsub %-32s { %4d; }\n\n", "${mname}'struct", $countof{$name});
+
+	    print <<EOF;
+sub ${mname}'typedef { 
+    local(\$${mname}'index) = shift;
+    defined \$${mname}'index 
+	? \$${mname}'typedef[\$${mname}'index] 
+	: \$${mname}'typedef;
+}
+EOF
+
+	    print <<EOF;
+sub ${mname}'sizeof { 
+    local(\$${mname}'index) = shift;
+    defined \$${mname}'index 
+	? \$${mname}'sizeof[\$${mname}'index] 
+	: \$${mname}'sizeof;
+}
+EOF
+
+	    print <<EOF;
+sub ${mname}'offsetof { 
+    local(\$${mname}'index) = shift;
+    defined \$${mname}index 
+	? \$${mname}'offsetof[\$${mname}'index] 
+	: \$${mname}'sizeof;
+}
+EOF
+
+	    print <<EOF;
+sub ${mname}'typeof { 
+    local(\$${mname}'index) = shift;
+    defined \$${mname}index 
+	? \$${mname}'typeof[\$${mname}'index] 
+	: '$name';
+}
+EOF
+    
+	    print <<EOF;
+sub ${mname}'fieldnames { 
+    \@${mname}'fieldnames; 
+}
+EOF
+
+	$iam = ($isastruct{$name} && 's') || ($isaunion{$name} && 'u');
+    
+	    print <<EOF;
+sub ${mname}'isastruct { 
+    '$iam'; 
+}
+EOF
+
+	    print "\$${mname}'typedef = '" . &scrunch($template{$fname}) 
+		. "';\n";
+
+	    print "\$${mname}'sizeof = $sizeof{$name};\n\n";
+
+
+	    print "\@${mname}'indices = (", &squishseq(@indices), ");\n";
+
+	    print "\n";
+
+	    print "\@${mname}'typedef[\@${mname}'indices] = (",
+			join("\n\t", '', @typedef), "\n    );\n\n";
+	    print "\@${mname}'sizeof[\@${mname}'indices] = (",
+			join("\n\t", '', @sizeof), "\n    );\n\n";
+	    print "\@${mname}'offsetof[\@${mname}'indices] = (",
+			join("\n\t", '', @offsetof), "\n    );\n\n";
+	    print "\@${mname}'typeof[\@${mname}'indices] = (",
+			join("\n\t", '', @typeof), "\n    );\n\n";
+	    print "\@${mname}'fieldnames[\@${mname}'indices] = (",
+			join("\n\t", '', @fieldnames), "\n    );\n\n";
+
+	    $template_printed{$fname}++;
+	    $size_printed{$fname}++;
+	} 
+	print "\n";
+    }
+
+    print STDERR "\n" if $trace;
+
+    unless ($perl && $opt_a) { 
+	print "\n1;\n" if $perl;
+	exit;
+    }
+
+
+
+    foreach $name (sort bysizevalue keys %intrinsics) {
+	next if $size_printed{$name};
+	print '$',&munge($name),"'sizeof = ", $sizeof{$name}, ";\n";
+    }
+
+    print "\n";
+
+    sub bysizevalue { $sizeof{$a} <=> $sizeof{$b}; }
+
+
+    foreach $name (sort keys %intrinsics) {
+	print '$',&munge($name),"'typedef = '", $template{$name}, "';\n";
+    }
+
+    print "\n1;\n" if $perl;
+	
+    exit;
+}
+
+########################################################################################
+
+
+sub stab {
+    next unless $continued || /:[\$\w]+(\(\d+,\d+\))?=[\*\$\w]+/;  # (\d+,\d+) is for sun
+    s/"// 						|| next;
+    s/",([x\d]+),([x\d]+),([x\d]+),.*// 		|| next;
+
+    next if /^\s*$/;
+
+    $size = $3 if $3;
+    $_ = $continued . $_ if length($continued);
+    if (s/\\\\$//) {
+      # if last 2 chars of string are '\\' then stab is continued
+      # in next stab entry
+      chop;
+      $continued = $_;
+      next;
+    }
+    $continued = '';
+
+
+    $line = $_;
+
+    if (($name, $pdecl) = /^([\$ \w]+):[tT]((\d+)(=[rufs*](\d+))+)$/) {
+	print "$name is a typedef for some funky pointers: $pdecl\n" if $debug;
+	&pdecl($pdecl);
+	next;
+    }
+
+
+
+    if (/(([ \w]+):t(\d+|\(\d+,\d+\)))=r?(\d+|\(\d+,\d+\))(;\d+;\d+;)?/) {  
+	local($ident) = $2;
+	push(@intrinsics, $ident);
+	$typeno = &typeno($3);
+	$type[$typeno] = $ident;
+	print STDERR "intrinsic $ident in new type $typeno\n" if $debug; 
+	next;
+    }
+
+    if (($name, $typeordef, $typeno, $extra, $struct, $_) 
+	= /^([\$ \w]+):([ustT])(\d+|\(\d+,\d+\))(=[rufs*](\d+))?(.*)$/) 
+    {
+	$typeno = &typeno($typeno);  # sun foolery
+    } 
+    elsif (/^[\$\w]+:/) {
+	next; # variable
+    }
+    else { 
+	warn "can't grok stab: <$_> in: $line " if $_;
+	next;
+    } 
+
+    #warn "got size $size for $name\n";
+    $sizeof{$name} = $size if $size;
+
+    s/;[-\d]*;[-\d]*;$//;  # we don't care about ranges
+
+    $typenos{$name} = $typeno;
+
+    unless (defined $type[$typeno]) {
+	&panic("type 0??") unless $typeno;
+	$type[$typeno] = $name unless defined $type[$typeno];
+	printf "new type $typeno is $name" if $debug;
+	if ($extra =~ /\*/ && defined $type[$struct]) {
+	    print ", a typedef for a pointer to " , $type[$struct] if $debug;
+	}
+    } else {
+	printf "%s is type %d", $name, $typeno if $debug;
+	print ", a typedef for " , $type[$typeno] if $debug;
+    } 
+    print "\n" if $debug;
+    #next unless $extra =~ /[su*]/;
+
+    #$type[$struct] = $name;
+
+    if ($extra =~ /[us*]/) {
+	&sou($name, $extra);
+	$_ = &sdecl($name, $_, 0);
+    }
+    elsif (/^=ar/) {
+	print "it's a bare array typedef -- that's pretty sick\n" if $debug;
+	$_ = "$typeno$_";
+	$scripts = '';
+	$_ = &adecl($_,1);
+
+    }
+    elsif (s/((\w+):t(\d+|\(\d+,\d+\)))?=r?(;\d+;\d+;)?//) {  # the ?'s are for gcc
+	push(@intrinsics, $2);
+	$typeno = &typeno($3);
+	$type[$typeno] = $2;
+	print STDERR "intrinsic $2 in new type $typeno\n" if $debug; 
+    }
+    elsif (s/^=e//) { # blessed be thy compiler; mine won't do this
+	&edecl;
+    } 
+    else {
+	warn "Funny remainder for $name on line $_ left in $line " if $_;
+    } 
+}
+
+sub typeno {  # sun thinks types are (0,27) instead of just 27
+    local($_) = @_;
+    s/\(\d+,(\d+)\)/$1/;
+    $_;
+} 
+
+sub pstruct {
+    local($what,$prefix,$base) = @_; 
+    local($field, $fieldname, $typeno, $count, $offset, $entry); 
+    local($fieldtype);
+    local($type, $tname); 
+    local($mytype, $mycount, $entry2);
+    local($struct_count) = 0;
+    local($pad, $revpad, $length, $prepad, $lastoffset, $lastlength, $fmt);
+    local($bits,$bytes);
+    local($template);
+
+
+    local($mname) = &munge($name);
+
+    sub munge { 
+	local($_) = @_;
+	s/[\s\$\.]/_/g;
+	$_;
+    }
+
+    local($sname) = &psou($what);
+
+    $nesting++;
+
+    for $field (split(/;/, $struct{$what})) {
+	$pad = $prepad = 0;
+	$entry = ''; 
+	($fieldname, $typeno, $count, $offset, $length) = split(/,/, $field); 
+
+	$type = $type[$typeno];
+
+	$type =~ /([^[]*)(\[.*\])?/;
+	$mytype = $1;
+	$count .= $2;
+	$fieldtype = &psou($mytype);
+
+	local($fname) = &psou($name);
+
+	if ($build_templates) {
+
+	    $pad = ($offset - ($lastoffset + $lastlength))/8 
+		if defined $lastoffset;
+
+	    if (! $finished_template{$sname}) {
+		if ($isaunion{$what}) {
+		    $template{$sname} .= 'X' x $revpad . ' '    if $revpad;
+		} else {
+		    $template{$sname} .= 'x' x $pad    . ' '    if $pad;
+		}
+	    }
+
+	    $template = &fetch_template($type);
+	    &repeat_template($template,$count);
+
+	    if (! $finished_template{$sname}) {
+		$template{$sname} .= $template;
+	    }
+
+	    $revpad = $length/8 if $isaunion{$what};
+
+	    ($lastoffset, $lastlength) = ($offset, $length);
+
+	} else { 
+	    print '# ' if $perl && $verbose;
+	    $entry = sprintf($pmask1,
+			' ' x ($nesting * $indent) . $fieldtype,
+			"$prefix.$fieldname" . $count); 
+
+	    $entry =~ s/(\*+)( )/$2$1/; 
+
+	    printf $pmask2,
+		    $entry,
+		    ($base+$offset)/8,
+		    ($bits = ($base+$offset)%8) ? ".$bits" : "  ",
+		    $length/8,
+		    ($bits = $length % 8) ? ".$bits": ""
+			if !$perl || $verbose;
+
+	    if ($perl) {
+		$template = &fetch_template($type);
+		&repeat_template($template,$count);
+	    }
+
+	    if ($perl && $nesting == 1) {
+
+		push(@sizeof, int($length/8) .",\t# $fieldname");
+		push(@offsetof, int($offset/8) .",\t# $fieldname");
+		local($little) = &scrunch($template);
+		push(@typedef, "'$little', \t# $fieldname");
+		$type =~ s/(struct|union) //;
+		push(@typeof, "'$mytype" . ($count ? $count : '') .
+		    "',\t# $fieldname");
+		push(@fieldnames, "'$fieldname',");
+	    }
+
+	    print '  ', ' ' x $indent x $nesting, $template
+				if $perl && $verbose;
+
+	    print "\n" if !$perl || $verbose;
+
+	}    
+	if ($perl) {
+	    local($mycount) = defined $struct{$mytype} ? $countof{$mytype} : 1;
+	    $mycount *= &scripts2count($count) if $count;
+	    if ($nesting==1 && !$build_templates) {
+		$pcode .= sprintf("sub %-32s { %4d; }\n", 
+			"${mname}'${fieldname}", $struct_count);
+		push(@indices, $struct_count);
+	    }
+	    $struct_count += $mycount;
+	} 
+
+
+	&pstruct($type, "$prefix.$fieldname", $base+$offset) 
+		if $recurse && defined $struct{$type}; 
+    }
+
+    $countof{$what} = $struct_count unless defined $countof{$whati};
+
+    $template{$sname} .= '$' if $build_templates;
+    $finished_template{$sname}++;
+
+    if ($build_templates && !defined $sizeof{$name}) {
+	local($fmt) = &scrunch($template{$sname});
+	print STDERR "no size for $name, punting with $fmt..." if $debug;
+	eval '$sizeof{$name} = length(pack($fmt, ()))';
+	if ($@) {
+	    chop $@;
+	    warn "couldn't get size for \$name: $@";
+	} else {
+	    print STDERR $sizeof{$name}, "\n" if $debUg;
+	}
+    } 
+
+    --$nesting;
+}
+
+
+sub psize {
+    local($me) = @_; 
+    local($amstruct) = $struct{$me} ?  'struct ' : '';
+
+    print '$sizeof{\'', $amstruct, $me, '\'} = '; 
+    printf "%d;\n", $sizeof{$me}; 
+}
+
+sub pdecl {
+    local($pdecl) = @_;
+    local(@pdecls);
+    local($tname);
+
+    warn "pdecl: $pdecl\n" if $debug;
+
+    $pdecl =~ s/\(\d+,(\d+)\)/$1/g;
+    $pdecl =~ s/\*//g; 
+    @pdecls = split(/=/, $pdecl); 
+    $typeno = $pdecls[0];
+    $tname = pop @pdecls;
+
+    if ($tname =~ s/^f//) { $tname = "$tname&"; } 
+    #else { $tname = "$tname*"; } 
+
+    for (reverse @pdecls) {
+	$tname  .= s/^f// ? "&" : "*"; 
+	#$tname =~ s/^f(.*)/$1&/;
+	print "type[$_] is $tname\n" if $debug;
+	$type[$_] = $tname unless defined $type[$_];
+    } 
+}
+
+
+
+sub adecl {
+    ($arraytype, $unknown, $lower, $upper) = ();
+    #local($typeno);
+    # global $typeno, @type
+    local($_, $typedef) = @_;
+
+    while (s/^((\d+|\(\d+,\d+\))=)?ar(\d+|\(\d+,\d+\));//) {
+	($arraytype, $unknown) = ($2, $3); 
+	$arraytype = &typeno($arraytype);
+	$unknown = &typeno($unknown);
+	if (s/^(\d+);(\d+);//) {
+	    ($lower, $upper) = ($1, $2); 
+	    $scripts .= '[' .  ($upper+1) . ']'; 
+	} else {
+	    warn "can't find array bounds: $_"; 
+	} 
+    }
+    if (s/^([(,)\d*f=]*),(\d+),(\d+);//) {
+	($start, $length) = ($2, $3); 
+	$whatis = $1;
+	if ($whatis =~ /^(\d+|\(\d+,\d+\))=/) {
+	    $typeno = &typeno($1);
+	    &pdecl($whatis);
+	} else {
+	    $typeno = &typeno($whatis);
+	}
+    } elsif (s/^(\d+)(=[*suf]\d*)//) {
+	local($whatis) = $2; 
+
+	if ($whatis =~ /[f*]/) {
+	    &pdecl($whatis); 
+	} elsif ($whatis =~ /[su]/) {  # 
+	    print "$prefix.$fieldname is an array$scripts anon structs; disgusting\n" 
+		if $debug;
+	    #$type[$typeno] = $name unless defined $type[$typeno];
+	    ##printf "new type $typeno is $name" if $debug;
+	    $typeno = $1;
+	    $type[$typeno] = "$prefix.$fieldname";
+	    local($name) = $type[$typeno];
+	    &sou($name, $whatis);
+	    $_ = &sdecl($name, $_, $start+$offset);
+	    1;
+	    $start = $start{$name};
+	    $offset = $sizeof{$name};
+	    $length = $offset;
+	} else {
+	    warn "what's this? $whatis in $line ";
+	} 
+    } elsif (/^\d+$/) {
+	$typeno = $_;
+    } else {
+	warn "bad array stab: $_ in $line ";
+	next STAB;
+    } 
+    #local($wasdef) = defined($type[$typeno]) && $debug;
+    #if ($typedef) { 
+	#print "redefining $type[$typeno] to " if $wasdef;
+	#$type[$typeno] = "$whatis$scripts"; # unless defined $type[$typeno];
+	#print "$type[$typeno]\n" if $wasdef;
+    #} else {
+	#$type[$arraytype] = $type[$typeno] unless defined $type[$arraytype];
+    #}
+    $type[$arraytype] = "$type[$typeno]$scripts" if defined $type[$typeno];
+    print "type[$arraytype] is $type[$arraytype]\n" if $debug;
+    print "$prefix.$fieldname is an array of $type[$arraytype]\n" if $debug;
+    $_;
+}
+
+
+
+sub sdecl {
+    local($prefix, $_, $offset) = @_;
+
+    local($fieldname, $scripts, $type, $arraytype, $unknown,
+    $whatis, $pdecl, $upper,$lower, $start,$length) = ();
+    local($typeno,$sou);
+
+
+SFIELD:
+    while (/^([^;]+);/) {
+	$scripts = '';
+	warn "sdecl $_\n" if $debug;
+	if (s/^([\$\w]+)://) { 
+	    $fieldname = $1;
+	} elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { # 
+	    $typeno = &typeno($1);
+	    $type[$typeno] = "$prefix.$fieldname";
+	    local($name) = "$prefix.$fieldname";
+	    &sou($name,$2);
+	    $_ = &sdecl("$prefix.$fieldname", $_, $start+$offset);
+	    $start = $start{$name};
+	    $offset += $sizeof{$name};
+	    #print "done with anon, start is $start, offset is $offset\n";
+	    #next SFIELD;
+	} else  {
+	    warn "weird field $_ of $line" if $debug;
+	    next STAB;
+	    #$fieldname = &gensym;
+	    #$_ = &sdecl("$prefix.$fieldname", $_, $start+$offset);
+	}
+
+	if (/^(\d+|\(\d+,\d+\))=ar/) {
+	    $_ = &adecl($_);
+	}
+	elsif (s/^(\d+|\(\d+,\d+\))?,(\d+),(\d+);//) {
+          ($start, $length) =  ($2, $3);
+          &panic("no length?") unless $length;
+          $typeno = &typeno($1) if $1;
+        }
+        elsif (s/^(\d+)=xs\w+:,(\d+),(\d+);//) {
+	    ($start, $length) =  ($2, $3); 
+	    &panic("no length?") unless $length;
+	    $typeno = &typeno($1) if $1;
+	}
+	elsif (s/^((\d+|\(\d+,\d+\))(=[*f](\d+|\(\d+,\d+\)))+),(\d+),(\d+);//) {
+	    ($pdecl, $start, $length) =  ($1,$5,$6); 
+	    &pdecl($pdecl); 
+	}
+	elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { # the dratted anon struct
+	    ($typeno, $sou) = ($1, $2);
+	    $typeno = &typeno($typeno);
+	    if (defined($type[$typeno])) {
+		warn "now how did we get type $1 in $fieldname of $line?";
+	    } else {
+		print "anon type $typeno is $prefix.$fieldname\n" if $debug;
+		$type[$typeno] = "$prefix.$fieldname" unless defined $type[$typeno];
+	    };
+	    local($name) = "$prefix.$fieldname";
+	    &sou($name,$sou);
+	    print "anon ".($isastruct{$name}) ? "struct":"union"." for $prefix.$fieldname\n" if $debug;
+	    $type[$typeno] = "$prefix.$fieldname";
+	    $_ = &sdecl("$prefix.$fieldname", $_, $start+$offset); 
+	    $start = $start{$name};
+	    $length = $sizeof{$name};
+	}
+	else {
+	    warn "can't grok stab for $name ($_) in line $line "; 
+	    next STAB; 
+	}
+
+	&panic("no length for $prefix.$fieldname") unless $length;
+	$struct{$name} .= join(',', $fieldname, $typeno, $scripts, $start, $length) . ';';
+    }
+    if (s/;\d*,(\d+),(\d+);//) {
+	local($start, $size) = ($1, $2); 
+	$sizeof{$prefix} = $size;
+	print "start of $prefix is $start, size of $sizeof{$prefix}\n" if $debug; 
+	$start{$prefix} = $start; 
+    } 
+    $_;
+}
+
+sub edecl {
+    s/;$//;
+    $enum{$name} = $_;
+    $_ = '';
+} 
+
+sub resolve_types {
+    local($sou);
+    for $i (0 .. $#type) {
+	next unless defined $type[$i];
+	$_ = $type[$i];
+	unless (/\d/) {
+	    print "type[$i] $type[$i]\n" if $debug;
+	    next;
+	}
+	print "type[$i] $_ ==> " if $debug;
+	s/^(\d+)(\**)\&\*(\**)/"$2($3".&type($1) . ')()'/e;
+	s/^(\d+)\&/&type($1)/e; 
+	s/^(\d+)/&type($1)/e; 
+	s/(\*+)([^*]+)(\*+)/$1$3$2/;
+	s/\((\*+)(\w+)(\*+)\)/$3($1$2)/;
+	s/^(\d+)([\*\[].*)/&type($1).$2/e;
+	#s/(\d+)(\*|(\[[\[\]\d\*]+]\])+)/&type($1).$2/ge;
+	$type[$i] = $_;
+	print "$_\n" if $debug;
+    }
+}
+sub type { &psou($type[$_[0]] || "<UNDEFINED>"); } 
+
+sub adjust_start_addrs {
+    for (sort keys %start) {
+	($basename = $_) =~ s/\.[^.]+$//;
+	$start{$_} += $start{$basename};
+	print "start: $_ @ $start{$_}\n" if $debug;
+    }
+}
+
+sub sou {
+    local($what, $_) = @_;
+    /u/ && $isaunion{$what}++;
+    /s/ && $isastruct{$what}++;
+}
+
+sub psou {
+    local($what) = @_;
+    local($prefix) = '';
+    if ($isaunion{$what})  {
+	$prefix = 'union ';
+    } elsif ($isastruct{$what})  {
+	$prefix = 'struct ';
+    }
+    $prefix . $what;
+}
+
+sub scrunch {
+    local($_) = @_;
+
+    return '' if $_ eq '';
+
+    study;
+
+    s/\$//g;
+    s/  / /g;
+    1 while s/(\w) \1/$1$1/g;
+
+    # i wanna say this, but perl resists my efforts:
+    #	   s/(\w)(\1+)/$2 . length($1)/ge;
+
+    &quick_scrunch;
+
+    s/ $//;
+
+    $_;
+}
+
+sub buildscrunchlist {
+    $scrunch_code = "sub quick_scrunch {\n";
+    for (values %intrinsics) {
+        $scrunch_code .= "\ts/(${_}{2,})/'$_' . length(\$1)/ge;\n";
+    } 
+    $scrunch_code .= "}\n";
+    print "$scrunch_code" if $debug;
+    eval $scrunch_code;
+    &panic("can't eval scrunch_code $@ \nscrunch_code") if $@;
+} 
+
+sub fetch_template {
+    local($mytype) = @_;
+    local($fmt);
+    local($count) = 1;
+
+    &panic("why do you care?") unless $perl;
+
+    if ($mytype =~ s/(\[\d+\])+$//) {
+	$count .= $1;
+    } 
+
+    if ($mytype =~ /\*/) {
+	$fmt = $template{'pointer'};
+    } 
+    elsif (defined $template{$mytype}) {
+	$fmt = $template{$mytype};
+    } 
+    elsif (defined $struct{$mytype}) {
+	if (!defined $template{&psou($mytype)}) {
+	    &build_template($mytype) unless $mytype eq $name;
+	} 
+	elsif ($template{&psou($mytype)} !~ /\$$/) {
+	    #warn "incomplete template for $mytype\n";
+	} 
+	$fmt = $template{&psou($mytype)} || '?';
+    } 
+    else {
+	warn "unknown fmt for $mytype\n";
+	$fmt = '?';
+    } 
+
+    $fmt x $count . ' ';
+}
+
+sub compute_intrinsics {
+    local($TMP) = "/tmp/c2ph-i.$$.c";
+    open (TMP, ">$TMP") || die "can't open $TMP: $!";
+    select(TMP);
+
+    print STDERR "computing intrinsic sizes: " if $trace;
+
+    undef %intrinsics;
+
+    print <<'EOF';
+main() {
+    char *mask = "%d %s\n";
+EOF
+
+    for $type (@intrinsics) {
+	next if !type || $type eq 'void' || $type =~ /complex/; # sun stuff
+	print <<"EOF";
+    printf(mask,sizeof($type), "$type");
+EOF
+    } 
+
+    print <<'EOF';
+    printf(mask,sizeof(char *), "pointer");
+    exit(0);
+}
+EOF
+    close TMP;
+
+    select(STDOUT);
+    open(PIPE, "cd /tmp && $CC $TMP && /tmp/a.out|");
+    while (<PIPE>) {
+	chop;
+	split(' ',$_,2);;
+	print "intrinsic $_[1] is size $_[0]\n" if $debug;
+	$sizeof{$_[1]} = $_[0];
+	$intrinsics{$_[1]} = $template{$_[0]};
+    } 
+    close(PIPE) || die "couldn't read intrinsics!";
+    unlink($TMP, '/tmp/a.out');
+    print STDERR "done\n" if $trace;
+} 
+
+sub scripts2count {
+    local($_) = @_;
+
+    s/^\[//;
+    s/\]$//;
+    s/\]\[/*/g;
+    $_ = eval;
+    &panic("$_: $@") if $@;
+    $_;
+}
+
+sub system {
+    print STDERR "@_\n" if $trace;
+    system @_;
+} 
+
+sub build_template { 
+    local($name) = @_;
+
+    &panic("already got a template for $name") if defined $template{$name};
+
+    local($build_templates) = 1;
+
+    local($lparen) = '(' x $build_recursed;
+    local($rparen) = ')' x $build_recursed;
+
+    print STDERR "$lparen$name$rparen " if $trace;
+    $build_recursed++;
+    &pstruct($name,$name,0);
+    print STDERR "TEMPLATE for $name is ", $template{&psou($name)}, "\n" if $debug;
+    --$build_recursed;
+}
+
+
+sub panic {
+
+    select(STDERR);
+
+    print "\npanic: @_\n";
+
+    exit 1 if $] <= 4.003;  # caller broken
+
+    local($i,$_);
+    local($p,$f,$l,$s,$h,$a,@a,@sub);
+    for ($i = 0; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) {
+	@a = @DB'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;
+    }
+    for ($i=0; $i <= $#sub; $i++) {
+	last if $signal;
+	print $sub[$i];
+    }
+    exit 1;
+} 
+
+sub squishseq {
+    local($num);
+    local($last) = -1e8;
+    local($string);
+    local($seq) = '..';
+
+    while (defined($num = shift)) {
+        if ($num == ($last + 1)) {
+            $string .= $seq unless $inseq++;
+            $last = $num;
+            next;
+        } elsif ($inseq) {
+            $string .= $last unless $last == -1e8;
+        }
+
+        $string .= ',' if defined $string;
+        $string .= $num;
+        $last = $num;
+        $inseq = 0;
+    }
+    $string .= $last if $inseq && $last != -e18;
+    $string;
+}
+
+sub repeat_template {
+    #  local($template, $scripts) = @_;  have to change caller's values
+
+    if ( $_[1] ) { 
+	local($ncount) = &scripts2count($_[1]);
+	if ($_[0] =~ /^\s*c\s*$/i) {
+	    $_[0] = "A$ncount ";
+	    $_[1] = '';
+	} else {
+	    $_[0] = $template x $ncount;
+	}
+    }
+}
+!NO!SUBS!
+
+close OUT or die "Can't close $file: $!";
+chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
+unlink 'pstruct';
+link c2ph, pstruct;
+exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
diff --git a/utils/h2ph.PL b/utils/h2ph.PL
new file mode 100644
index 0000000000..58ef8d500e
--- /dev/null
+++ b/utils/h2ph.PL
@@ -0,0 +1,306 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# List explicitly here the variables you want Configure to
+# generate.  Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries.  Thus you write
+#  $startperl
+# to ensure Configure will look for $Config{startperl}.
+# Wanted:  $archlibexp
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+	if ($Config{'osname'} eq 'VMS' or
+	    $Config{'osname'} eq 'OS2');  # "case-forgiving"
+
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file (with variable substitutions)\n";
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT <<"!GROK!THIS!";
+$Config{'startperl'}
+    eval 'exec perl -S \$0 "\$@"'
+	if 0;
+
+'di ';
+'ds 00 \"';
+'ig 00 ';
+
+\$perlincl = "$Config{archlibexp}";
+
+!GROK!THIS!
+
+# In the following, perl variables are not expanded during extraction.
+
+print OUT <<'!NO!SUBS!';
+
+chdir '/usr/include' || die "Can't cd /usr/include";
+
+@isatype = split(' ',<<END);
+	char	uchar	u_char
+	short	ushort	u_short
+	int	uint	u_int
+	long	ulong	u_long
+	FILE
+END
+
+@isatype{@isatype} = (1) x @isatype;
+$inif = 0;
+
+@ARGV = ('-') unless @ARGV;
+
+foreach $file (@ARGV) {
+    if ($file eq '-') {
+	open(IN, "-");
+	open(OUT, ">-");
+    }
+    else {
+	($outfile = $file) =~ s/\.h$/.ph/ || next;
+	print "$file -> $outfile\n";
+	if ($file =~ m|^(.*)/|) {
+	    $dir = $1;
+	    if (!-d "$perlincl/$dir") {
+		mkdir("$perlincl/$dir",0777);
+	    }
+	}
+	open(IN,"$file") || ((warn "Can't open $file: $!\n"),next);
+	open(OUT,">$perlincl/$outfile") || die "Can't create $outfile: $!\n";
+    }
+    while (<IN>) {
+	chop;
+	while (/\\$/) {
+	    chop;
+	    $_ .= <IN>;
+	    chop;
+	}
+	if (s:/\*:\200:g) {
+	    s:\*/:\201:g;
+	    s/\200[^\201]*\201//g;	# delete single line comments
+	    if (s/\200.*//) {		# begin multi-line comment?
+		$_ .= '/*';
+		$_ .= <IN>;
+		redo;
+	    }
+	}
+	if (s/^#\s*//) {
+	    if (s/^define\s+(\w+)//) {
+		$name = $1;
+		$new = '';
+		s/\s+$//;
+		if (s/^\(([\w,\s]*)\)//) {
+		    $args = $1;
+		    if ($args ne '') {
+			foreach $arg (split(/,\s*/,$args)) {
+			    $arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/;
+			    $curargs{$arg} = 1;
+			}
+			$args =~ s/\b(\w)/\$$1/g;
+			$args = "local($args) = \@_;\n$t    ";
+		    }
+		    s/^\s+//;
+		    do expr();
+		    $new =~ s/(["\\])/\\$1/g;
+		    if ($t ne '') {
+			$new =~ s/(['\\])/\\$1/g;
+			print OUT $t,
+			  "eval 'sub $name {\n$t    ${args}eval \"$new\";\n$t}';\n";
+		    }
+		    else {
+			print OUT "sub $name {\n    ${args}eval \"$new\";\n}\n";
+		    }
+		    %curargs = ();
+		}
+		else {
+		    s/^\s+//;
+		    do expr();
+		    $new = 1 if $new eq '';
+		    if ($t ne '') {
+			$new =~ s/(['\\])/\\$1/g;
+			print OUT $t,"eval 'sub $name {",$new,";}';\n";
+		    }
+		    else {
+			print OUT $t,"sub $name {",$new,";}\n";
+		    }
+		}
+	    }
+	    elsif (/^include\s+<(.*)>/) {
+		($incl = $1) =~ s/\.h$/.ph/;
+		print OUT $t,"require '$incl';\n";
+	    }
+	    elsif (/^ifdef\s+(\w+)/) {
+		print OUT $t,"if (defined &$1) {\n";
+		$tab += 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+	    }
+	    elsif (/^ifndef\s+(\w+)/) {
+		print OUT $t,"if (!defined &$1) {\n";
+		$tab += 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+	    }
+	    elsif (s/^if\s+//) {
+		$new = '';
+		$inif = 1;
+		do expr();
+		$inif = 0;
+		print OUT $t,"if ($new) {\n";
+		$tab += 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+	    }
+	    elsif (s/^elif\s+//) {
+		$new = '';
+		$inif = 1;
+		do expr();
+		$inif = 0;
+		$tab -= 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+		print OUT $t,"}\n${t}elsif ($new) {\n";
+		$tab += 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+	    }
+	    elsif (/^else/) {
+		$tab -= 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+		print OUT $t,"}\n${t}else {\n";
+		$tab += 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+	    }
+	    elsif (/^endif/) {
+		$tab -= 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+		print OUT $t,"}\n";
+	    }
+	}
+    }
+    print OUT "1;\n";
+}
+
+sub expr {
+    while ($_ ne '') {
+	s/^(\s+)//		&& do {$new .= ' '; next;};
+	s/^(0x[0-9a-fA-F]+)//	&& do {$new .= $1; next;};
+	s/^(\d+)//		&& do {$new .= $1; next;};
+	s/^("(\\"|[^"])*")//	&& do {$new .= $1; next;};
+	s/^'((\\"|[^"])*)'//	&& do {
+	    if ($curargs{$1}) {
+		$new .= "ord('\$$1')";
+	    }
+	    else {
+		$new .= "ord('$1')";
+	    }
+	    next;
+	};
+	s/^sizeof\s*\(([^)]+)\)/{$1}/ && do {
+	    $new .= '$sizeof';
+	    next;
+	};
+	s/^([_a-zA-Z]\w*)//	&& do {
+	    $id = $1;
+	    if ($id eq 'struct') {
+		s/^\s+(\w+)//;
+		$id .= ' ' . $1;
+		$isatype{$id} = 1;
+	    }
+	    elsif ($id eq 'unsigned') {
+		s/^\s+(\w+)//;
+		$id .= ' ' . $1;
+		$isatype{$id} = 1;
+	    }
+	    if ($curargs{$id}) {
+		$new .= '$' . $id;
+	    }
+	    elsif ($id eq 'defined') {
+		$new .= 'defined';
+	    }
+	    elsif (/^\(/) {
+		s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i;	# cheat
+		$new .= " &$id";
+	    }
+	    elsif ($isatype{$id}) {
+		if ($new =~ /{\s*$/) {
+		    $new .= "'$id'";
+		}
+		elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) {
+		    $new =~ s/\(\s*$//;
+		    s/^[\s*]*\)//;
+		}
+		else {
+		    $new .= $id;
+		}
+	    }
+	    else {
+		if ($inif && $new !~ /defined\($/) {
+		    $new .= '(defined(&' . $id . ') ? &' . $id . ' : 0)';
+		} else { 
+		    $new .= ' &' . $id;
+		}
+	    }
+	    next;
+	};
+	s/^(.)//			&& do {$new .= $1; next;};
+    }
+}
+##############################################################################
+
+	# These next few lines are legal in both Perl and nroff.
+
+.00 ;			# finish .ig
+
+'di			\" finish diversion--previous line must be blank
+.nr nl 0-1		\" fake up transition to first page again
+.nr % 0			\" start at page 1
+'; __END__ ############# From here on it's a standard manual page ############
+.TH H2PH 1 "August 8, 1990"
+.AT 3
+.SH NAME
+h2ph \- convert .h C header files to .ph Perl header files
+.SH SYNOPSIS
+.B h2ph [headerfiles]
+.SH DESCRIPTION
+.I h2ph
+converts any C header files specified to the corresponding Perl header file
+format.
+It is most easily run while in /usr/include:
+.nf
+
+	cd /usr/include; h2ph * sys/*
+
+.fi
+If run with no arguments, filters standard input to standard output.
+.SH ENVIRONMENT
+No environment variables are used.
+.SH FILES
+/usr/include/*.h
+.br
+/usr/include/sys/*.h
+.br
+etc.
+.SH AUTHOR
+Larry Wall
+.SH "SEE ALSO"
+perl(1)
+.SH DIAGNOSTICS
+The usual warnings if it can't read or write the files involved.
+.SH BUGS
+Doesn't construct the %sizeof array for you.
+.PP
+It doesn't handle all C constructs, but it does attempt to isolate
+definitions inside evals so that you can get at the definitions
+that it can translate.
+.PP
+It's only intended as a rough tool.
+You may need to dicker with the files produced.
+.ex
+!NO!SUBS!
+
+close OUT or die "Can't close $file: $!";
+chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
+exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
diff --git a/utils/h2xs.PL b/utils/h2xs.PL
new file mode 100644
index 0000000000..b7bf49654d
--- /dev/null
+++ b/utils/h2xs.PL
@@ -0,0 +1,433 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# List explicitly here the variables you want Configure to
+# generate.  Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries.  Thus you write
+#  $startperl
+# to ensure Configure will look for $Config{startperl}.
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+	if ($Config{'osname'} eq 'VMS' or
+	    $Config{'osname'} eq 'OS2');  # "case-forgiving"
+
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file (with variable substitutions)\n";
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT <<"!GROK!THIS!";
+$Config{'startperl'}
+    eval 'exec perl -S \$0 "\$@"'
+	if 0;
+!GROK!THIS!
+
+# In the following, perl variables are not expanded during extraction.
+
+print OUT <<'!NO!SUBS!';
+
+=head1 NAME
+
+h2xs - convert .h C header files to Perl extensions
+
+=head1 SYNOPSIS
+
+B<h2xs> [B<-Acfh>] [B<-n> module_name] [headerfile [extra_libraries]]
+
+=head1 DESCRIPTION
+
+I<h2xs> builds a Perl extension from any C header file.  The extension will
+include functions which can be used to retrieve the value of any #define
+statement which was in the C header.
+
+The I<module_name> will be used for the name of the extension.  If
+module_name is not supplied then the name of the header file will be used,
+with the first character capitalized.
+
+If the extension might need extra libraries, they should be included
+here.  The extension Makefile.PL will take care of checking whether
+the libraries actually exist and how they should be loaded.
+The extra libraries should be specified in the form -lm -lposix, etc,
+just as on the cc command line.  By default, the Makefile.PL will
+search through the library path determined by Configure.  That path
+can be augmented by including arguments of the form B<-L/another/library/path>
+in the extra-libraries argument.
+
+=head1 OPTIONS
+
+=over 5
+
+=item B<-n> I<module_name>
+
+Specifies a name to be used for the extension, e.g., S<-n RPC::DCE>
+
+=item B<-f>
+
+Allows an extension to be created for a header even if that header is
+not found in /usr/include.
+
+=item B<-c>
+
+Omit C<constant()> from the .xs file and corresponding specialised
+C<AUTOLOAD> from the .pm file.
+
+=item B<-A>
+
+Omit all autoload facilities.  This is the same as B<-c> but also removes the
+S<C<require AutoLoader>> statement from the .pm file.
+
+=back
+
+=head1 EXAMPLES
+
+
+	# Default behavior, extension is Rusers
+	h2xs rpcsvc/rusers
+
+	# Same, but extension is RUSERS
+	h2xs -n RUSERS rpcsvc/rusers
+
+	# Extension is rpcsvc::rusers. Still finds <rpcsvc/rusers.h>
+	h2xs rpcsvc::rusers
+
+	# Extension is ONC::RPC.  Still finds <rpcsvc/rusers.h>
+	h2xs -n ONC::RPC rpcsvc/rusers
+
+	# Without constant() or AUTOLOAD
+	h2xs -c rpcsvc/rusers
+
+	# Creates templates for an extension named RPC
+	h2xs -cfn RPC
+
+	# Extension is ONC::RPC.
+	h2xs -cfn ONC::RPC
+
+	# Makefile.PL will look for library -lrpc in 
+	# additional directory /opt/net/lib
+	h2xs rpcsvc/rusers -L/opt/net/lib -lrpc
+
+
+=head1 ENVIRONMENT
+
+No environment variables are used.
+
+=head1 AUTHOR
+
+Larry Wall and others
+
+=head1 SEE ALSO
+
+L<perl>, L<ExtUtils::MakeMaker>, L<AutoLoader>
+
+=head1 DIAGNOSTICS
+
+The usual warnings if it can't read or write the files involved.
+
+=cut
+
+
+use Getopt::Std;
+
+sub usage{
+	warn "@_\n" if @_;
+    die 'h2xs [-Acfh] [-n module_name] [headerfile [extra_libraries]]
+    -f   Force creation of the extension even if the C header does not exist.
+    -n   Specify a name to use for the extension (recommended).
+    -c   Omit the constant() function and specialised AUTOLOAD from the XS file.
+    -A   Omit all autoloading facilities (implies -c).
+    -h   Display this help message
+extra_libraries
+         are any libraries that might be needed for loading the
+         extension, e.g. -lm would try to link in the math library.
+';
+}
+
+
+getopts("Acfhn:") || usage;
+
+usage if $opt_h;
+$opt_c = 1 if $opt_A;
+
+$path_h    = shift;
+$extralibs = "@ARGV";
+
+usage "Must supply header file or module name\n"
+	unless ($path_h or $opt_n);
+
+
+if( $path_h ){
+    $name = $path_h;
+    if( $path_h =~ s#::#/#g && $opt_n ){
+	warn "Nesting of headerfile ignored with -n\n";
+    }
+    $path_h .= ".h" unless $path_h =~ /\.h$/;
+    $path_h = "/usr/include/$path_h" unless $path_h =~ m#^[./]#;
+    die "Can't find $path_h\n" if ( ! $opt_f && ! -f $path_h );
+
+    # Scan the header file (we should deal with nested header files)
+    # Record the names of simple #define constants into const_names
+    # Function prototypes are not (currently) processed.
+    open(CH, "<$path_h") || die "Can't open $path_h: $!\n";
+    while (<CH>) {
+	if (/^#[ \t]*define\s+(\w+)\b\s*[^("]/) {
+	    $_ = $1;
+	    next if /^_.*_h_*$/i; # special case, but for what?
+	    $const_names{$_}++;
+	}
+    }
+    close(CH);
+    @const_names = sort keys %const_names;
+}
+
+
+$module = $opt_n || do {
+	$name =~ s/\.h$//;
+	if( $name !~ /::/ ){
+		$name =~ s#^.*/##;
+		$name = "\u$name";
+	}
+	$name;
+};
+
+(chdir 'ext', $ext = 'ext/') if -d 'ext';
+
+if( $module =~ /::/ ){
+	$nested = 1;
+	@modparts = split(/::/,$module);
+	$modfname = $modparts[-1];
+	$modpname = join('/',@modparts);
+}
+else {
+	$nested = 0;
+	@modparts = ();
+	$modfname = $modpname = $module;
+}
+
+
+die "Won't overwrite existing $ext$modpname\n" if -e $modpname;
+# quick hack, should really loop over @modparts
+mkdir($modparts[0], 0777) if $nested;
+mkdir($modpname, 0777);
+chdir($modpname) || die "Can't chdir $ext$modpname: $!\n";
+
+open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n";
+open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n";
+
+$" = "\n\t";
+warn "Writing $ext$modpname/$modfname.pm\n";
+
+print PM <<"END";
+package $module;
+
+require Exporter;
+require DynaLoader;
+END
+
+if( ! $opt_A ){
+	print PM <<"END";
+require AutoLoader;
+END
+}
+
+if( $opt_c && ! $opt_A ){
+	# we won't have our own AUTOLOAD(), so we'll inherit it.
+	print PM <<"END";
+
+\@ISA = qw(Exporter AutoLoader DynaLoader);
+END
+}
+else{
+	# 1) we have our own AUTOLOAD(), so don't need to inherit it.
+	# or
+	# 2) we don't want autoloading mentioned.
+	print PM <<"END";
+
+\@ISA = qw(Exporter DynaLoader);
+END
+}
+
+print PM<<"END";
+# Items to export into callers namespace by default. Note: do not export
+# names by default without a very good reason. Use EXPORT_OK instead.
+# Do not simply export all your public functions/methods/constants.
+\@EXPORT = qw(
+	@const_names
+);
+END
+
+print PM <<"END" unless $opt_c;
+sub AUTOLOAD {
+    # This AUTOLOAD is used to 'autoload' constants from the constant()
+    # XS function.  If a constant is not found then control is passed
+    # to the AUTOLOAD in AutoLoader.
+
+    local(\$constname);
+    (\$constname = \$AUTOLOAD) =~ s/.*:://;
+    \$val = constant(\$constname, \@_ ? \$_[0] : 0);
+    if (\$! != 0) {
+	if (\$! =~ /Invalid/) {
+	    \$AutoLoader::AUTOLOAD = \$AUTOLOAD;
+	    goto &AutoLoader::AUTOLOAD;
+	}
+	else {
+	    (\$pack,\$file,\$line) = caller;
+	    die "Your vendor has not defined $module macro \$constname, used at \$file line \$line.\n";
+	}
+    }
+    eval "sub \$AUTOLOAD { \$val }";
+    goto &\$AUTOLOAD;
+}
+
+END
+
+print PM <<"END";
+bootstrap $module;
+
+# Preloaded methods go here.
+
+# Autoload methods go after __END__, and are processed by the autosplit program.
+
+1;
+__END__
+END
+
+close PM;
+
+
+warn "Writing $ext$modpname/$modfname.xs\n";
+
+print XS <<"END";
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#ifdef __cplusplus
+}
+#endif
+
+END
+if( $path_h ){
+	my($h) = $path_h;
+	$h =~ s#^/usr/include/##;
+print XS <<"END";
+#include <$h>
+
+END
+}
+
+if( ! $opt_c ){
+print XS <<"END";
+static int
+not_here(s)
+char *s;
+{
+    croak("$module::%s not implemented on this architecture", s);
+    return -1;
+}
+
+static double
+constant(name, arg)
+char *name;
+int arg;
+{
+    errno = 0;
+    switch (*name) {
+END
+
+my(@AZ, @az, @under);
+
+foreach(@const_names){
+    @AZ = 'A' .. 'Z' if !@AZ && /^[A-Z]/;
+    @az = 'a' .. 'z' if !@az && /^[a-z]/;
+    @under = '_'  if !@under && /^_/;
+}
+
+foreach $letter (@AZ, @az, @under) {
+
+    last if $letter eq 'a' && !@const_names;
+
+    print XS "    case '$letter':\n";
+    my($name);
+    while (substr($const_names[0],0,1) eq $letter) {
+	$name = shift(@const_names);
+	print XS <<"END";
+	if (strEQ(name, "$name"))
+#ifdef $name
+	    return $name;
+#else
+	    goto not_there;
+#endif
+END
+    }
+    print XS <<"END";
+	break;
+END
+}
+print XS <<"END";
+    }
+    errno = EINVAL;
+    return 0;
+
+not_there:
+    errno = ENOENT;
+    return 0;
+}
+
+END
+}
+
+# Now switch from C to XS by issuing the first MODULE declaration:
+print XS <<"END";
+
+MODULE = $module		PACKAGE = $module
+
+END
+
+# If a constant() function was written then output a corresponding
+# XS declaration:
+print XS <<"END" unless $opt_c;
+
+double
+constant(name,arg)
+	char *		name
+	int		arg
+
+END
+
+close XS;
+
+
+warn "Writing $ext$modpname/Makefile.PL\n";
+open(PL, ">Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n";
+
+print PL <<'END';
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+END
+print PL "WriteMakefile(\n";
+print PL "    'NAME'	=> '$module',\n";
+print PL "    'VERSION'	=> '0.1',\n";
+print PL "    'LIBS'	=> ['$extralibs'],   # e.g., '-lm' \n";
+print PL "    'DEFINE'	=> '',     # e.g., '-DHAVE_SOMETHING' \n";
+print PL "    'INC'	=> '',     # e.g., '-I/usr/include/other' \n";
+print PL ");\n";
+
+
+system '/bin/ls > MANIFEST' or system 'ls > MANIFEST';
+!NO!SUBS!
+
+close OUT or die "Can't close $file: $!";
+chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
+exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
diff --git a/utils/perldoc.PL b/utils/perldoc.PL
new file mode 100644
index 0000000000..3e72dad10d
--- /dev/null
+++ b/utils/perldoc.PL
@@ -0,0 +1,336 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# List explicitly here the shell variables you want Configure
+# to look for.
+#  $startperl
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+	if ($Config{'osname'} eq 'VMS' or
+	    $Config{'osname'} eq 'OS2');  # "case-forgiving"
+
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file (with variable substitutions)\n";
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT <<"!GROK!THIS!";	
+$Config{'startperl'}
+    eval 'exec perl -S \$0 "\$@"'
+	if 0;
+!GROK!THIS!
+
+# In the following, perl variables are not expanded during extraction.
+
+print OUT <<'!NO!SUBS!';
+
+#
+# Perldoc revision #1 -- look up a piece of documentation in .pod format that
+# is embedded in the perl installation tree.
+#
+# This is not to be confused with Tom Christianson's perlman, which is a
+# man replacement, written in perl. This perldoc is strictly for reading
+# the perl manuals, though it too is written in perl.
+#
+# Version 1.1: Thu Nov  9 07:23:47 EST 1995
+#		Kenneth Albanowski <kjahds@kjahds.com>
+#	-added VMS support
+#	-added better error recognition (on no found pages, just exit. On
+#	 missing nroff/pod2man, just display raw pod.)
+#	-added recursive/case-insensitive matching (thanks, Andreas). This
+#	 slows things down a bit, unfortunately. Give a precise name, and
+#	 it'll run faster.
+#
+# Version 1.01:	Tue May 30 14:47:34 EDT 1995
+#		Andy Dougherty  <doughera@lafcol.lafayette.edu>
+#   -added pod documentation.
+#   -added PATH searching.
+#   -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
+#    and friends.
+#
+#
+# TODO:
+#
+#	Cache directories read during sloppy match
+#
+
+=head1 NAME
+
+perldoc - Look up Perl documentation in pod format.
+
+=head1 SYNOPSIS
+
+B<perldoc> [B<-h>] [B<-v>] PageName|ModuleName|ProgramName
+
+=head1 DESCRIPTION
+
+I<perldoc> looks up a piece of documentation in .pod format that is
+embedded in the perl installation tree or in a perl script, and displays
+it via pod2man | nroff -man | $PAGER.  This is primarily used for the
+documentation for the perl library modules. 
+
+Your system may also have man pages installed for those modules, in
+which case you can probably just use the man(1) command.
+
+=head1 OPTIONS
+
+=over 5
+
+=item B<-h> help
+
+Prints out a brief help message.
+
+=item B<-v> verbose
+
+Describes search for the item in detail.
+
+=item B<PageName|ModuleName|ProgramName>
+
+The item you want to look up.  Nested modules (such as C<File::Basename>)
+are specified either as C<File::Basename> or C<File/Basename>.  You may also
+give a descriptive name of a page, such as C<perlfunc>. You make also give a
+partial or wrong-case name, such as "basename" for "File::Basename", but
+this will be slower, if there is more then one page with the same partial
+name, you will only get the first one.
+
+=back
+
+=head1 ENVIRONMENT
+
+Any switches in the C<PERLDOC> environment variable will be used before the 
+command line arguments.  C<perldoc> also searches directories
+specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
+defined) and C<PATH> environment variables.
+(The latter is so that embedded pods for executables, such as
+C<perldoc> itself, are available.)
+
+=head1 AUTHOR
+
+Kenneth Albanowski <kjahds@kjahds.com>
+
+Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>
+
+=head1 SEE ALSO
+
+=head1 DIAGNOSTICS
+
+=cut
+
+if(@ARGV<1) {
+	die <<EOF;
+Usage: $0 [-h] [-v] PageName|ModuleName|ProgramName
+
+We suggest you use "perldoc perldoc" to get aquainted 
+with the system.
+EOF
+}
+
+use Getopt::Std;
+
+sub usage{
+        warn "@_\n" if @_;
+    die <<EOF;
+perldoc [-h] [-v] PageName|ModuleName|ProgramName...
+    -h   Display this help message.
+    -v	 Verbosely describe what's going on.
+PageName|ModuleName...
+         is the name of a piece of documentation that you want to look at. You 
+         may either give a descriptive name of the page (as in the case of
+         `perlfunc') the name of a module, either like `Term::Info', 
+         `Term/Info', the partial name of a module, like `info', or 
+         `makemaker', or the name of a program, like `perldoc'.
+         
+Any switches in the PERLDOC environment variable will be used before the 
+command line arguments.
+
+EOF
+}
+
+use Text::ParseWords;
+
+
+unshift(@ARGV,shellwords($ENV{"PERLDOC"}));
+
+getopts("hv") || usage;
+
+usage if $opt_h;
+
+$index = $opt_i;
+@pages = @ARGV;
+
+sub containspod {
+	my($file) = @_;
+	local($_);
+	open(TEST,"<$file");
+	while(<TEST>) {
+		if(/^=head/) {
+			close(TEST);
+			return 1;
+		}
+	}
+	close(TEST);
+	return 0;
+}
+
+ sub minus_f_nocase {
+     my($file) = @_;
+     local *DIR;
+     local($")="/";
+     my(@p,$p,$cip);
+     foreach $p (split(/\//, $file)){
+ 	if (-d ("@p/$p")){
+ 	    push @p, $p;
+ 	} elsif (-f ("@p/$p")) {
+ 	    return "@p/$p";
+ 	} else {
+ 	    my $found=0;
+ 	    my $lcp = lc $p;
+ 	    opendir DIR, "@p";
+ 	    while ($cip=readdir(DIR)) {
+ 		if (lc $cip eq $lcp){
+ 		    $found++;
+ 		    last;
+ 		}
+ 	    }
+ 	    closedir DIR;
+ 	    return "" unless $found;
+ 	    push @p, $cip;
+ 	    return "@p" if -f "@p";
+ 	}
+     }
+     return; # is not a file
+ }
+ 
+  sub searchfor {
+  	my($recurse,$s,@dirs) = @_;
+  	$s =~ s!::!/!g;
+  	printf STDERR "looking for $s in @dirs\n" if $opt_v;
+ 	my $ret;
+ 	my $i;
+ 	my $dir;
+  	for ($i=0;$i<@dirs;$i++) {
+  		$dir = $dirs[$i];
+ 	    if ((    $ret = minus_f_nocase "$dir/$s.pod")
+ 		or ( $ret = minus_f_nocase "$dir/$s.pm"  and containspod($ret))
+ 		or ( $ret = minus_f_nocase "$dir/$s"     and containspod($ret))
+ 		or ( $ret = minus_f_nocase "$dir/pod/$s.pod")
+ 		or ( $ret = minus_f_nocase "$dir/pod/$s" and containspod($ret)))
+ 		{ return $ret; }
+ 		
+ 		if($recurse) {
+			opendir(D,$dir);
+			my(@newdirs) = grep(-d,map("$dir/$_",grep(!/^\.\.?$/,readdir(D))));
+			closedir(D);
+			print STDERR "Also looking in @newdirs\n" if $opt_v;
+			push(@dirs,@newdirs);
+ 		}
+ 	}
+  	return ();
+  }
+
+
+foreach (@pages) {
+	print STDERR "Searching for $_\n" if $opt_v;
+	# We must look both in @INC for library modules and in PATH
+	# for executables, like h2xs or perldoc itself.
+	@searchdirs = @INC;
+	push(@searchdirs, grep(-d, split(':', $ENV{'PATH'})));
+	@files= searchfor(0,$_,@searchdirs);
+	if( @files ) {
+		print STDERR "Found as @files\n" if $opt_v;
+	} else {
+		# no match, try recursive search
+		
+		@searchdirs = grep(!/^\.$/,@INC);
+		
+		
+		@files= searchfor(1,$_,@searchdirs);
+		if( @files ) {
+			print STDERR "Loosly found as @files\n" if $opt_v;
+		} else {
+			print STDERR "No documentation found for '$_'\n";
+		}
+	}
+	push(@found,@files);
+}
+
+if(!@found) {
+	exit 1;
+}
+
+$cmd=$filter="";
+
+if( ! -t STDOUT ) { $opt_f = 1 }
+
+require Config;
+
+$VMS = $Config::Config{'osname'} eq "VMS";
+
+unless($VMS) {
+	$tmp = "/tmp/perldoc1.$$";
+	$tmp2 = "/tmp/perldoc2.$$";
+	$goodresult = 0;
+} else {
+	$tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
+	$tmp2 = 'Sys$Scratch:perldoc.tmp2_'.$$;
+	$goodresult = 1;
+}
+
+foreach (@found) {
+	
+	open(TMP,">>$tmp");
+	$rslt = `pod2man $_ | nroff -man`;
+	if ($VMS) { $err = !($? % 2) || $rslt =~ /IVVERB/; }
+	else      { $err = $?; }
+	print TMP $rslt unless $err;
+	close TMP;
+	                                                
+	1 while unlink($tmp2); # Possibly pointless VMSism
+	
+	if( $err or -z $tmp) {
+		open(OUT,">>$tmp");
+		open(IN,"<$_");
+		print OUT while <IN>;
+		close(IN);
+		close(OUT);
+	}
+}
+
+if( $opt_f ) {
+	open(TMP,"<$tmp");
+	print while <TMP>;
+	close(TMP);
+} else {
+    pager:
+    {
+		if( $ENV{PAGER} and system("$ENV{PAGER} $tmp")==$goodresult) 
+			{ last pager }
+		if( $Config{pager} and system("$Config{pager} $tmp")==$goodresult) 
+			{ last pager }
+		if( system("more $tmp")==$goodresult)
+			{ last pager }
+		if( system("less $tmp")==$goodresult) 
+			{ last pager }
+		if( system("pg $tmp")==$goodresult) 
+			{ last pager }
+		if( system("view $tmp")==$goodresult) 
+			{ last pager }
+	}
+}
+
+1 while unlink($tmp); #Possibly pointless VMSism
+
+exit 0;
+!NO!SUBS!
+
+close OUT or die "Can't close $file: $!";
+chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
+exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
diff --git a/utils/pl2pm.PL b/utils/pl2pm.PL
new file mode 100755
index 0000000000..db4e4ac34e
--- /dev/null
+++ b/utils/pl2pm.PL
@@ -0,0 +1,322 @@
+#!/usr/bin/perl
+
+while (<DATA>) {
+    chop;
+    $keyword{$_} = 1;
+}
+
+undef $/;
+$* = 1;
+while (<>) {
+    $newname = $ARGV;
+    $newname =~ s/\.pl$/.pm/ || next;
+    $newname =~ s#(.*/)?(\w+)#$1\u$2#;
+    if (-f $newname) {
+	warn "Won't overwrite existing $newname\n";
+	next;
+    }
+    $oldpack = $2;
+    $newpack = "\u$2";
+    @export = ();
+    print "$oldpack => $newpack\n" if $verbose;
+
+    s/\bstd(in|out|err)\b/\U$&/g;
+    s/(sub\s+)(\w+)(\s*\{[ \t]*\n)\s*package\s+$oldpack\s*;[ \t]*\n+/${1}main'$2$3/ig;
+    if (/sub\s+main'/) {
+	@export = m/sub\s+main'(\w+)/g;
+	s/(sub\s+)main'(\w+)/$1$2/g;
+    }
+    else {
+	@export = m/sub\s+([A-Za-z]\w*)/g;
+    }
+    @export_ok = grep($keyword{$_}, @export);
+    @export = grep(!$keyword{$_}, @export);
+    @export{@export} = (1) x @export;
+    s/(^\s*);#/$1#/g;
+    s/(#.*)require ['"]$oldpack\.pl['"]/$1use $newpack/;
+    s/(package\s*)($oldpack)\s*;[ \t]*\n+//ig;
+    s/([\$\@%&*])'(\w+)/&xlate($1,"",$2)/eg;
+    s/([\$\@%&*]?)(\w+)'(\w+)/&xlate($1,$2,$3)/eg;
+    if (!/\$\[\s*\)?\s*=\s*[^0\s]/) {
+	s/^\s*(local\s*\()?\s*\$\[\s*\)?\s*=\s*0\s*;[ \t]*\n//g;
+	s/\$\[\s*\+\s*//g;
+	s/\s*\+\s*\$\[//g;
+	s/\$\[/0/g;
+    }
+    s/open\s+(\w+)/open($1)/g;
+ 
+    if (s/\bdie\b/croak/g) {
+	$carp = "use Carp;\n";
+	s/croak "([^"]*)\\n"/croak "$1"/g;
+    }
+    else {
+	$carp = "";
+    }
+    if (@export_ok) {
+	$export_ok = "\@EXPORT_OK = qw(@export_ok);\n";
+    }
+    else {
+	$export_ok = "";
+    }
+
+    open(PM, ">$newname") || warn "Can't create $newname: $!\n";
+    print PM <<"END";
+package $newpack;
+require 5.000;
+require Exporter;
+$carp
+\@ISA = qw(Exporter);
+\@EXPORT = qw(@export);
+$export_ok
+$_
+END
+}
+
+sub xlate {
+    local($prefix, $pack, $ident) = @_;
+    if ($prefix eq '' && $ident =~ /^(t|s|m|d|ing|ll|ed|ve|re)$/) {
+	"${pack}'$ident";
+    }
+    elsif ($pack eq "" || $pack eq "main") {
+	if ($export{$ident}) {
+	    "$prefix$ident";
+	}
+	else {
+	    "$prefix${pack}::$ident";
+	}
+    }
+    elsif ($pack eq $oldpack) {
+	"$prefix${newpack}::$ident";
+    }
+    else {
+	"$prefix${pack}::$ident";
+    }
+}
+__END__
+AUTOLOAD
+BEGIN
+CORE
+DESTROY
+END
+abs
+accept
+alarm
+and
+atan2
+bind
+binmode
+bless
+caller
+chdir
+chmod
+chop
+chown
+chr
+chroot
+close
+closedir
+cmp
+connect
+continue
+cos
+crypt
+dbmclose
+dbmopen
+defined
+delete
+die
+do
+dump
+each
+else
+elsif
+endgrent
+endhostent
+endnetent
+endprotoent
+endpwent
+endservent
+eof
+eq
+eval
+exec
+exit
+exp
+fcntl
+fileno
+flock
+for
+foreach
+fork
+format
+formline
+ge
+getc
+getgrent
+getgrgid
+getgrnam
+gethostbyaddr
+gethostbyname
+gethostent
+getlogin
+getnetbyaddr
+getnetbyname
+getnetent
+getpeername
+getpgrp
+getppid
+getpriority
+getprotobyname
+getprotobynumber
+getprotoent
+getpwent
+getpwnam
+getpwuid
+getservbyname
+getservbyport
+getservent
+getsockname
+getsockopt
+glob
+gmtime
+goto
+grep
+gt
+hex
+if
+index
+int
+ioctl
+join
+keys
+kill
+last
+lc
+lcfirst
+le
+length
+link
+listen
+local
+localtime
+log
+lstat
+lt
+m
+mkdir
+msgctl
+msgget
+msgrcv
+msgsnd
+my
+ne
+next
+no
+not
+oct
+open
+opendir
+or
+ord
+pack
+package
+pipe
+pop
+print
+printf
+push
+q
+qq
+quotemeta
+qw
+qx
+rand
+read
+readdir
+readline
+readlink
+readpipe
+recv
+redo
+ref
+rename
+require
+reset
+return
+reverse
+rewinddir
+rindex
+rmdir
+s
+scalar
+seek
+seekdir
+select
+semctl
+semget
+semop
+send
+setgrent
+sethostent
+setnetent
+setpgrp
+setpriority
+setprotoent
+setpwent
+setservent
+setsockopt
+shift
+shmctl
+shmget
+shmread
+shmwrite
+shutdown
+sin
+sleep
+socket
+socketpair
+sort
+splice
+split
+sprintf
+sqrt
+srand
+stat
+study
+sub
+substr
+symlink
+syscall
+sysread
+system
+syswrite
+tell
+telldir
+tie
+time
+times
+tr
+truncate
+uc
+ucfirst
+umask
+undef
+unless
+unlink
+unpack
+unshift
+untie
+until
+use
+utime
+values
+vec
+wait
+waitpid
+wantarray
+warn
+while
+write
+x
+xor
+y