#
# 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;
}
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
++$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+// );
}
}
-
-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");
);
while (my ($func, $names) = splice @raw_alias, 0, 2) {
- $alias{$_} = $func for @$names;
+ foreach (@$names) {
+ $alias{$_} = $func;
+ }
}
# Emit defines.
use strict;
-use File::Spec::Functions qw(catdir catfile);;
-
my (@enums, @names);
while (<DATA>) {
next if /^#/;
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;
enum {
EOF
-print " ${_}_amg,\n", foreach @enums;
+print map " ${_}_amg,\n", @enums;
print <<'EOF';
max_amg_code
my $last = pop @names;
-print $c " $_,\n" foreach map { length $_ } @names;
+print $c map { " " . (length $_) . ",\n" } @names;
my $lastlen = length $last;
print $c <<"EOT";
overload.pm. */
EOT
-print $c " \"$_\",\n" foreach map { s/(["\\"])/\\$1/g; $_ } @names;
+print $c map { s/(["\\"])/\\$1/g; " \"$_\",\n" } @names;
print $c <<"EOT";
"$last"
-#!/usr/bin/perl
+#!/usr/bin/perl -w
#
# Regenerate (overwriting only if changed):
#
}
#use Fatal qw(open close rename chmod unlink);
use strict;
-use warnings;
open DESC, 'regcomp.sym';
while (<DESC>) {
s/#.*$//;
next if /^\s*$/;
- s/\s*\z//;
+ chomp; # No \z in 5.004
+ s/\s*$//;
if (/^-+\s*$/) {
$lastregop= $ind;
next;
# 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);
#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 */
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
}
}
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_)?//;
#
# 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