use strict;
+use File::Spec::Functions qw(catdir catfile);;
+
my (@enums, @names);
while (<DATA>) {
next if /^#/;
push @names, $name;
}
-safer_unlink 'overload.h';
-die "overload.h: $!" unless open(H, ">overload.h");
-binmode H;
-select H;
-print <<'EOF';
+safer_unlink ('overload.h', 'overload.c', catfile(qw(lib overload numbers.pm)));
+my $c = safer_open("overload.c");
+my $h = safer_open("overload.h");
+mkdir("lib/overload") unless -d catdir(qw(lib overload));
+my $p = safer_open(catfile(qw(lib overload numbers.pm)));
+
+
+select $p;
+
+{
+local $" = "\n ";
+print <<"EOF";
+# -*- buffer-read-only: t -*-
+#
+# lib/overload/numbers.pm
+#
+# Copyright (C) 2008 by Larry Wall and others
+#
+# You may distribute under the terms of either the GNU General Public
+# License or the Artistic License, as specified in the README file.
+#
+# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+# This file is built by overload.pl
+#
+
+package overload::numbers;
+
+our \@names = qw#
+ @names
+#;
+
+our \@enums = qw#
+ @enums
+#;
+
+{ my \$i; our %names = map { \$_ => ++\$i } \@names }
+
+{ my \$i; our %enums = map { \$_ => ++\$i } \@enums }
+
+EOF
+}
+
+
+sub print_header {
+ my $file = shift;
+ print <<"EOF";
/* -*- buffer-read-only: t -*-
*
- * overload.h
+ * $file
*
- * Copyright (C) 1997, 1998, 2000, 2001, 2005 and 2006 by Larry Wall and
- * others
+ * Copyright (C) 1997, 1998, 2000, 2001, 2005, 2006, 2007 by Larry Wall
+ * and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
* This file is built by overload.pl
*/
+EOF
+}
+
+select $c;
+print_header('overload.c');
+
+select $h;
+print_header('overload.h');
+print <<'EOF';
enum {
EOF
/* Do not leave a trailing comma here. C9X allows it, C89 doesn't. */
};
-
#define NofAMmeth max_amg_code
+
+EOF
+
+print $c <<'EOF';
+
#define AMG_id2name(id) (PL_AMG_names[id]+1)
+#define AMG_id2namelen(id) (PL_AMG_namelens[id]-1)
-#ifdef DOINIT
-EXTCONST char * const PL_AMG_names[NofAMmeth] = {
+static const U8 PL_AMG_namelens[NofAMmeth] = {
+EOF
+
+my $last = pop @names;
+
+print $c " $_,\n" foreach map { length $_ } @names;
+
+my $lastlen = length $last;
+print $c <<"EOT";
+ $lastlen
+};
+
+static const char * const PL_AMG_names[NofAMmeth] = {
/* Names kept in the symbol table. fallback => "()", the rest has
"(" prepended. The only other place in perl which knows about
this convention is AMG_id2name (used for debugging output and
'nomethod' only), the only other place which has it hardwired is
overload.pm. */
-EOF
+EOT
-my $last = pop @names;
-print " \"$_\",\n" foreach map { s/(["\\"])/\\$1/g; $_ } @names;
+print $c " \"$_\",\n" foreach map { s/(["\\"])/\\$1/g; $_ } @names;
-print <<"EOT";
+print $c <<"EOT";
"$last"
};
-#else
-EXTCONST char * PL_AMG_names[NofAMmeth];
-#endif /* def INITAMAGIC */
EOT
-close H or die $!;
+safer_close($h);
+safer_close($c);
+safer_close($p);
__DATA__
# Fallback should be the first