In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/1028dc3c3b25bebb0a1a079d1d384b6dccc2958b?hp=0bfc72b6d951f71ce7df3c1565981f64980acfc6>
- Log ----------------------------------------------------------------- commit 1028dc3c3b25bebb0a1a079d1d384b6dccc2958b Author: Nicholas Clark <[email protected]> Date: Wed Sep 22 14:21:11 2010 +0100 In embed.pl, refactor walk_table to simplify its arguments. No need to pass in leader and have it default to do_not_edit ($filename), as the only time the leader is needed is for the case of explicit open file by name. Use undef instead of '/dev/null' to signal that no output is desired. M embed.pl commit 916e4025cf76677d80d3543dcfe683347234c30b Author: Nicholas Clark <[email protected]> Date: Wed Sep 22 13:50:20 2010 +0100 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. M embed.pl M opcode.pl M overload.pl M regcomp.pl M regen.pl commit 2f2085406d63a2408b18e7f5a1601606a3540cf4 Author: Nicholas Clark <[email protected]> Date: Wed Sep 22 10:49:24 2010 +0100 In embed.pl's walk_table, the default filename of '-' was never used. Remove it, simplifying the argument passing. M embed.pl commit 7b53c8eedd95a752eb7639bf6dbd9cf3c3ea2dc6 Author: Nicholas Clark <[email protected]> Date: Wed Sep 22 10:03:13 2010 +0100 Programmatically generate the compatibility macros for "misnamed functions". Add a new flag 'O' in embed.fnc to generate a macro mapping perl_$func() to $func(). The macro for call_atexit() is far too special to do this way. M embed.fnc M embed.h M embed.pl ----------------------------------------------------------------------- Summary of changes: embed.fnc | 38 ++++++++++++++++++++--------------- embed.h | 8 +++--- embed.pl | 63 ++++++++++++++++++++++++++-------------------------------- opcode.pl | 4 ++- overload.pl | 14 +++++------- regcomp.pl | 21 +++++++++---------- regen.pl | 2 +- 7 files changed, 74 insertions(+), 76 deletions(-) diff --git a/embed.fnc b/embed.fnc index 71e6e1c..ebe3d7c 100644 --- a/embed.fnc +++ b/embed.fnc @@ -63,6 +63,10 @@ : "#define foo Perl_foo", rather than : "#define foo(a,b,c) Perl_foo(aTHX_ a,b,c) : +: O Has a perl_ compatibility macro. +: +: The really OLD name for API funcs +: : o Has no Perl_foo compatibility macro: : : embed.h: suppress "#define foo Perl_foo" @@ -907,29 +911,31 @@ Ap |void |reentrant_init Ap |void |reentrant_free Anp |void* |reentrant_retry|NN const char *f|... #endif +: "Very" special - can't use the O flag for this one: +: (The rename from perl_atexit to Perl_call_atexit was in 864dbfa3ca8032ef) Ap |void |call_atexit |ATEXIT_t fn|NULLOK void *ptr -Apd |I32 |call_argv |NN const char* sub_name|I32 flags|NN char** argv -Apd |I32 |call_method |NN const char* methname|I32 flags -Apd |I32 |call_pv |NN const char* sub_name|I32 flags -Apd |I32 |call_sv |NN SV* sv|VOL I32 flags +ApdO |I32 |call_argv |NN const char* sub_name|I32 flags|NN char** argv +ApdO |I32 |call_method |NN const char* methname|I32 flags +ApdO |I32 |call_pv |NN const char* sub_name|I32 flags +ApdO |I32 |call_sv |NN SV* sv|VOL I32 flags Ap |void |despatch_signals Ap |OP * |doref |NN OP *o|I32 type|bool set_op_ref -Apd |SV* |eval_pv |NN const char* p|I32 croak_on_error -Apd |I32 |eval_sv |NN SV* sv|I32 flags -Apd |SV* |get_sv |NN const char *name|I32 flags -Apd |AV* |get_av |NN const char *name|I32 flags -Apd |HV* |get_hv |NN const char *name|I32 flags -Apd |CV* |get_cv |NN const char* name|I32 flags +ApdO |SV* |eval_pv |NN const char* p|I32 croak_on_error +ApdO |I32 |eval_sv |NN SV* sv|I32 flags +ApdO |SV* |get_sv |NN const char *name|I32 flags +ApdO |AV* |get_av |NN const char *name|I32 flags +ApdO |HV* |get_hv |NN const char *name|I32 flags +ApdO |CV* |get_cv |NN const char* name|I32 flags Apd |CV* |get_cvn_flags |NN const char* name|STRLEN len|I32 flags -Ap |int |init_i18nl10n |int printwarn -Ap |int |init_i18nl14n |int printwarn -Ap |void |new_collate |NULLOK const char* newcoll -Ap |void |new_ctype |NN const char* newctype -Ap |void |new_numeric |NULLOK const char* newcoll +ApO |int |init_i18nl10n |int printwarn +ApO |int |init_i18nl14n |int printwarn +ApO |void |new_collate |NULLOK const char* newcoll +ApO |void |new_ctype |NN const char* newctype +ApO |void |new_numeric |NULLOK const char* newcoll Ap |void |set_numeric_local Ap |void |set_numeric_radix Ap |void |set_numeric_standard -Apd |void |require_pv |NN const char* pv +ApdO |void |require_pv |NN const char* pv Apd |void |pack_cat |NN SV *cat|NN const char *pat|NN const char *patend \ |NN SV **beglist|NN SV **endlist|NN SV ***next_in_list|U32 flags Apd |void |packlist |NN SV *cat|NN const char *pat|NN const char *patend|NN SV **beglist|NN SV **endlist diff --git a/embed.h b/embed.h index 345c949..8e1ca4e 100644 --- a/embed.h +++ b/embed.h @@ -4985,21 +4985,21 @@ */ # define perl_atexit(a,b) call_atexit(a,b) # define perl_call_argv(a,b,c) call_argv(a,b,c) -# define perl_call_pv(a,b) call_pv(a,b) # define perl_call_method(a,b) call_method(a,b) +# define perl_call_pv(a,b) call_pv(a,b) # define perl_call_sv(a,b) call_sv(a,b) -# define perl_eval_sv(a,b) eval_sv(a,b) # define perl_eval_pv(a,b) eval_pv(a,b) -# define perl_require_pv(a) require_pv(a) +# define perl_eval_sv(a,b) eval_sv(a,b) # define perl_get_sv(a,b) get_sv(a,b) # define perl_get_av(a,b) get_av(a,b) # define perl_get_hv(a,b) get_hv(a,b) # define perl_get_cv(a,b) get_cv(a,b) # define perl_init_i18nl10n(a) init_i18nl10n(a) # define perl_init_i18nl14n(a) init_i18nl14n(a) -# define perl_new_ctype(a) new_ctype(a) # define perl_new_collate(a) new_collate(a) +# define perl_new_ctype(a) new_ctype(a) # define perl_new_numeric(a) new_numeric(a) +# define perl_require_pv(a) require_pv(a) /* varargs functions can't be handled with CPP macros. :-( This provides a set of compatibility functions that don't take diff --git a/embed.pl b/embed.pl index 6df7cb3..ccc6f3a 100755 --- 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 @@ -123,26 +124,22 @@ while (<IN>) { # walk table providing an array of components in each line to # subroutine, printing the result sub walk_table (&@) { - my $function = shift; - my $filename = shift || '-'; - my $leader = shift; - defined $leader or $leader = do_not_edit ($filename); - my $trailer = shift; + my ($function, $filename, $trailer) = @_; my $F; if (ref $filename) { # filehandle $F = $filename; } - else { - # safer_unlink $filename if $filename ne '/dev/null'; + elsif (defined $filename) { $F = safer_open("$filename-new"); + print $F do_not_edit ($filename); } - print $F $leader if $leader; foreach (@embed) { my @outs = &{$function}(@$_); - print $F @outs; # $function->(@args) is not 5.003 + # $function->(@args) is not 5.003 + print $F @outs if $F; } print $F $trailer if $trailer; - unless (ref $filename) { + if (defined $filename && !ref $filename) { safer_close($F); rename_if_different("$filename-new", $filename); } @@ -158,7 +155,7 @@ sub munge_c_files () { if (@_ > 1) { $functions->{$_[2]} = \...@_ if $...@_-1] =~ /\.\.\./; } - } '/dev/null', '', ''; + }; local $^I = '.bak'; while (<>) { s{(\b(\w+)[ \t]*\([ \t]*(?!aTHX))} @@ -230,7 +227,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+// ); @@ -325,11 +321,9 @@ sub write_protos { } } - -our $unflagged_pointers; -walk_table(\&write_protos, "proto.h", undef, "/* ex: set ro: */\n"); +walk_table(\&write_protos, "proto.h", "/* 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"); +walk_table(\&write_global_sym, "global.sym", "# ex: set ro:\n"); # XXX others that may need adding # warnhook @@ -492,7 +486,7 @@ walk_table { # Remember the new state. $ifdef_state = $new_ifdef_state; $ret; -} $em, ""; +} $em; if ($ifdef_state) { print $em "#endif\n"; @@ -570,7 +564,7 @@ walk_table { # Remember the new state. $ifdef_state = $new_ifdef_state; $ret; -} $em, ""; +} $em; if ($ifdef_state) { print $em "#endif\n"; @@ -617,22 +611,21 @@ print $em <<'END'; prefix in previous versions, we provide compatibility macros. */ # define perl_atexit(a,b) call_atexit(a,b) -# define perl_call_argv(a,b,c) call_argv(a,b,c) -# define perl_call_pv(a,b) call_pv(a,b) -# define perl_call_method(a,b) call_method(a,b) -# define perl_call_sv(a,b) call_sv(a,b) -# define perl_eval_sv(a,b) eval_sv(a,b) -# define perl_eval_pv(a,b) eval_pv(a,b) -# define perl_require_pv(a) require_pv(a) -# define perl_get_sv(a,b) get_sv(a,b) -# define perl_get_av(a,b) get_av(a,b) -# define perl_get_hv(a,b) get_hv(a,b) -# define perl_get_cv(a,b) get_cv(a,b) -# define perl_init_i18nl10n(a) init_i18nl10n(a) -# define perl_init_i18nl14n(a) init_i18nl14n(a) -# define perl_new_ctype(a) new_ctype(a) -# define perl_new_collate(a) new_collate(a) -# define perl_new_numeric(a) new_numeric(a) +END + +walk_table { + my ($flags,$retval,$func,@args) = @_; + return unless $func; + return unless $flags =~ /O/; + + my $alist = join ",", @az[0..$#args]; + my $ret = "# define perl_$func($alist)"; + my $t = (length $ret) >> 3; + $ret .= "\t" x ($t < 5 ? 5 - $t : 1); + "$ret$func($alist)\n"; +} $em; + +print $em <<'END'; /* varargs functions can't be handled with CPP macros. :-( This provides a set of compatibility functions that don't take diff --git a/opcode.pl b/opcode.pl index e90c929..8879dd2 100755 --- 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 --- 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 --- 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 --- 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 -- Perl5 Master Repository
