Ensure regen.pl and the scripts that it calls can be run by older perls.

As the internal comments state, they may be all that is available, particularly
if trying to port something to an obscure platform. There's not that much that
needs changing to get back to 5.005, or from there to 5.004, but beyond there
is hard work, and really not worth it.

diff --git a/embed.pl b/embed.pl
index b10cbe3..ebb1a86 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -22,7 +22,7 @@
 #
 # This script is normally invoked from regen.pl.
 
-require 5.003; # keep this compatible, an old perl is all we may have before
+require 5.004; # keep this compatible, an old perl is all we may have before
                 # we build the new one
 
 use strict;
@@ -33,6 +33,7 @@ BEGIN {
 }
 
 my $SPLINT = 0; # Turn true for experimental splint support http://www.splint.org
+my $unflagged_pointers;
 
 #
 # See database of global and static function prototypes in embed.fnc
@@ -227,7 +228,6 @@ sub write_protos {
                ++$n;
                if ( $arg =~ /\*/ && $arg !~ /\b(NN|NULLOK)\b/ ) {
                    warn "$func: $arg needs NN or NULLOK\n";
-                   our $unflagged_pointers;
                    ++$unflagged_pointers;
                }
                my $nn = ( $arg =~ s/\s*\bNN\b\s+// );
@@ -322,8 +322,6 @@ sub write_protos {
   }
 }
 
-
-our $unflagged_pointers;
 walk_table(\&write_protos,     "proto.h", undef, "/* ex: set ro: */\n");
 warn "$unflagged_pointers pointer arguments to clean up\n" if $unflagged_pointers;
 walk_table(\&write_global_sym, "global.sym", undef, "# ex: set ro:\n");

diff --git a/opcode.pl b/opcode.pl
index e90c929..8879dd2 100755 (executable)
--- a/opcode.pl
+++ b/opcode.pl
@@ -109,7 +109,9 @@ my @raw_alias = (
                );
 
 while (my ($func, $names) = splice @raw_alias, 0, 2) {
-    $alias{$_} = $func for @$names;
+    foreach (@$names) {
+       $alias{$_} = $func;
+    }
 }
 
 # Emit defines.

diff --git a/overload.pl b/overload.pl
index d4ba9a7..1c9a0b3 100644 (file)
--- a/overload.pl
+++ b/overload.pl
@@ -21,8 +21,6 @@ BEGIN {
 
 use strict;
 
-use File::Spec::Functions qw(catdir catfile);;
-
 my (@enums, @names);
 while (<DATA>) {
   next if /^#/;
@@ -32,11 +30,11 @@ while (<DATA>) {
   push @names, $name;
 }
 
-safer_unlink (catfile(qw(lib overload numbers.pm)));
+safer_unlink ('lib/overload/numbers.pm');
 my $c = safer_open("overload.c-new");
 my $h = safer_open("overload.h-new");
-mkdir("lib/overload") unless -d catdir(qw(lib overload));
-my $p = safer_open(catfile(qw(lib overload numbers.pm)));
+mkdir("lib/overload", 0777) unless -d 'lib/overload';
+my $p = safer_open('lib/overload/numbers.pm');
 
 
 select $p;
@@ -104,7 +102,7 @@ print <<'EOF';
 enum {
 EOF
 
-print "    ${_}_amg,\n", foreach @enums;
+print map "    ${_}_amg,\n", @enums;
 
 print <<'EOF';
     max_amg_code
@@ -125,7 +123,7 @@ EOF
 
 my $last = pop @names;
 
-print $c "    $_,\n" foreach map { length $_ } @names;
+print $c map { "    " . (length $_) . ",\n" } @names;
 
 my $lastlen = length $last;
 print $c <<"EOT";
@@ -140,7 +138,7 @@ static const char * const PL_AMG_names[NofAMmeth] = {
      overload.pm.  */
 EOT
 
-print $c "    \"$_\",\n" foreach map { s/(["\\"])/\\$1/g; $_ } @names;
+print $c map { s/(["\\"])/\\$1/g; "    \"$_\",\n" } @names;
 
 print $c <<"EOT";
     "$last"

diff --git a/regcomp.pl b/regcomp.pl
index d85482c..f652f1c 100644 (file)
--- a/regcomp.pl
+++ b/regcomp.pl
@@ -1,4 +1,4 @@
-#!/usr/bin/perl
+#!/usr/bin/perl -w
 # 
 # Regenerate (overwriting only if changed):
 #
@@ -19,7 +19,6 @@ BEGIN {
 }
 #use Fatal qw(open close rename chmod unlink);
 use strict;
-use warnings;
 
 open DESC, 'regcomp.sym';
 
@@ -29,7 +28,8 @@ my ($desc,$lastregop);
 while (<DESC>) {
     s/#.*$//;
     next if /^\s*$/;
-    s/\s*\z//;
+    chomp; # No \z in 5.004
+    s/\s*$//;
     if (/^-+\s*$/) {
         $lastregop= $ind;
         next;
@@ -91,13 +91,12 @@ sub process_flags {
     # Whilst I could do this with vec, I'd prefer to do longhand the arithmetic
     # ops in the C code.
     my $current = do {
-      no warnings 'uninitialized';
+      local $^W;
       ord do {
-       no warnings 'substr';
        substr $bitmap, ($ind >> 3);
       }
     };
-    substr $bitmap, ($ind >> 3), 1, chr($current | ($set << ($ind & 7)));
+    substr($bitmap, ($ind >> 3), 1) = chr($current | ($set << ($ind & 7)));
 
     push @selected, $name[$ind] if $set;
   } while (++$ind < $lastregop);
@@ -110,9 +109,9 @@ sub process_flags {
 #define REGNODE_\U$varname\E(node) (PL_${varname}_bitmask[(node) >> 3] & (1 << ((node) & 7)))
 
 #ifndef DOINIT
-EXTCONST U8 PL_${varname}[] __attribute__deprecated__;
+EXTCONST U8 PL_${varname}\[] __attribute__deprecated__;
 #else
-EXTCONST U8 PL_${varname}[] __attribute__deprecated__ = {
+EXTCONST U8 PL_${varname}\[] __attribute__deprecated__ = {
     $out_string
 };
 #endif /* DOINIT */
@@ -261,8 +260,8 @@ my %definitions;    # Remember what the symbol definitions are
 my $val = 0;
 my %reverse;
 foreach my $file ("op_reg_common.h", "regexp.h") {
-    open my $fh,"<", $file or die "Can't read $file: $!";
-    while (<$fh>) {
+    open FH,"<$file" or die "Can't read $file: $!";
+    while (<FH>) {
 
         # optional leading '_'.  Return symbol in $1, and strip it from
         # rest of line
@@ -290,7 +289,7 @@ foreach my $file ("op_reg_common.h", "regexp.h") {
     }
 }
 my %vrxf=reverse %rxfv;
-printf $out "\t/* Bits in extflags defined: %032b */\n",$val;
+printf $out "\t/* Bits in extflags defined: %s */\n", unpack 'B*', pack 'N', $val;
 for (0..31) {
     my $n=$vrxf{2**$_}||"UNUSED_BIT_$_";
     $n=~s/^RXf_(PMf_)?//;

diff --git a/regen.pl b/regen.pl
index 3fb25c1..f97a618 100644 (file)
--- a/regen.pl
+++ b/regen.pl
@@ -2,7 +2,7 @@
 #
 # regen.pl - a wrapper that runs all *.pl scripts to to autogenerate files
 
-require 5.003; # keep this compatible, an old perl is all we may have before
+require 5.004; # keep this compatible, an old perl is all we may have before
                 # we build the new one
 
 # The idea is to move the regen_headers target out of the Makefile so that