diff options
Diffstat (limited to 'regen')
| -rwxr-xr-x | regen/embed.pl | 46 | ||||
| -rwxr-xr-x | regen/keywords.pl | 19 | ||||
| -rwxr-xr-x | regen/opcode.pl | 55 | ||||
| -rw-r--r-- | regen/overload.pl | 50 | ||||
| -rw-r--r-- | regen/reentr.pl | 41 | ||||
| -rw-r--r-- | regen/regcomp.pl | 8 | ||||
| -rw-r--r-- | regen/regen_lib.pl | 51 | ||||
| -rw-r--r-- | regen/warnings.pl | 17 |
8 files changed, 99 insertions, 188 deletions
diff --git a/regen/embed.pl b/regen/embed.pl index 6c60ee1edc..ab098165ec 100755 --- a/regen/embed.pl +++ b/regen/embed.pl @@ -44,40 +44,12 @@ sub do_not_edit ($) { my $file = shift; - my $years = '1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009'; - - $years =~ s/1999,/1999,\n / if length $years > 40; - - my $warning = <<EOW; - -*- buffer-read-only: t -*- - - $file - - Copyright (C) $years, 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 regen/embed.pl from data in embed.fnc, -regen/embed.pl, regen/opcodes intrpvar.h, and perlvars.h. -Any changes made here will be lost! - -Edit those files and run 'make regen_headers' to effect changes. - -EOW - - if ($file =~ m:\.[ch]$:) { - $warning =~ s:^: * :gm; - $warning =~ s: +$::gm; - $warning =~ s: :/:; - $warning =~ s:$:/:; - } - else { - $warning =~ s:^:# :gm; - $warning =~ s: +$::gm; - } - $warning; + return read_only_top(lang => ($file =~ /\.[ch]$/ ? 'C' : 'Perl'), + file => $file, style => '*', by => 'regen/embed.pl', + from => ['data in embed.fnc', 'regen/embed.pl', + 'regen/opcodes', 'intrpvar.h', 'perlvars.h'], + final => "\nEdit those files and run 'make regen_headers' to effect changes.\n", + copyright => [1993 .. 2009]); } # do_not_edit open IN, "embed.fnc" or die $!; @@ -233,7 +205,7 @@ sub walk_table (&@) { # generate proto.h { my $pr = safer_open('proto.h-new'); - print $pr do_not_edit ("proto.h"), "\nSTART_EXTERN_C\n"; + print $pr do_not_edit ("proto.h"), "START_EXTERN_C\n"; my $ret; foreach (@embed) { @@ -448,7 +420,6 @@ sub multoff ($$) { my $em = safer_open('embed.h-new'); print $em do_not_edit ("embed.h"), <<'END'; - /* (Doing namespace management portably in C is really gross.) */ /* By defining PERL_NO_SHORT_NAMES (not done by default) the short forms @@ -611,7 +582,6 @@ rename_if_different('embed.h-new', 'embed.h'); $em = safer_open('embedvar.h-new'); print $em do_not_edit ("embedvar.h"), <<'END'; - /* (Doing namespace management portably in C is really gross.) */ /* @@ -695,7 +665,6 @@ my $capi = safer_open('perlapi.c-new'); my $capih = safer_open('perlapi.h-new'); print $capih do_not_edit ("perlapi.h"), <<'EOT'; - /* declare accessor functions for Perl variables */ #ifndef __perlapi_h__ #define __perlapi_h__ @@ -816,7 +785,6 @@ $warning =~ s! \*/\n! * !; print $capi $warning, <<'EOT'; - #include "EXTERN.h" #include "perl.h" #include "perlapi.h" diff --git a/regen/keywords.pl b/regen/keywords.pl index 381e0985ca..be87d9ef17 100755 --- a/regen/keywords.pl +++ b/regen/keywords.pl @@ -17,22 +17,9 @@ require 'regen/regen_lib.pl'; my $kw = safer_open("keywords.h-new"); select $kw; -print <<EOM; -/* -*- buffer-read-only: t -*- - * - * keywords.h - * - * Copyright (C) 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, 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 regen/keywords.pl from its data. Any changes - * made here will be lost! - */ -EOM +print read_only_top(lang => 'C', by => 'regen/keywords.pl', from => 'its data', + file => 'keywords.h', style => '*', + copyright => [1994 .. 1997, 1999 .. 2002, 2005 .. 2007]); # Read & print data. diff --git a/regen/opcode.pl b/regen/opcode.pl index 4515424fb7..553a3faff2 100755 --- a/regen/opcode.pl +++ b/regen/opcode.pl @@ -141,25 +141,10 @@ foreach my $sock_func (qw(socket bind listen accept shutdown # Emit defines. -print <<"END"; -/* -*- buffer-read-only: t -*- - * - * opcode.h - * - * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, - * 2001, 2002, 2003, 2004, 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 regen/opcode.pl from its data. Any changes made - * here will be lost! - */ - -#ifndef PERL_GLOBAL_STRUCT_INIT - -END +print read_only_top(lang => 'C', by => 'regen/opcode.pl', from => 'its data', + file => 'opcode.h', style => '*', + copyright => [1993 .. 2007]), + "#ifndef PERL_GLOBAL_STRUCT_INIT\n\n"; { my $last_cond = ''; @@ -196,25 +181,10 @@ END unimplemented(); } -print $on <<"END"; -/* -*- buffer-read-only: t -*- - * - * opnames.h - * - * Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, - * 2007, 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 regen/opcode.pl from its data. Any changes made - * here will be lost! - */ - -typedef enum opcode { -END +print $on read_only_top(lang => 'C', by => 'regen/opcode.pl', + from => 'its data', style => '*', + file => 'opnames.h', copyright => [1999 .. 2008]), + "typedef enum opcode {\n"; my $i = 0; for (@ops) { @@ -499,14 +469,7 @@ my $pp_proto_new = 'pp_proto.h-new'; my $pp = safer_open($pp_proto_new); -print $pp <<"END"; -/* -*- buffer-read-only: t -*- - !!!!!!! DO NOT EDIT THIS FILE !!!!!!! - This file is built by opcode.pl from its data. Any changes made here - will be lost! -*/ - -END +print $pp read_only_top(lang => 'C', by => 'opcode.pl', from => 'its data'); { my %funcs; diff --git a/regen/overload.pl b/regen/overload.pl index 1cd07dd954..343629f81c 100644 --- a/regen/overload.pl +++ b/regen/overload.pl @@ -39,22 +39,12 @@ my $p = safer_open('lib/overload/numbers.pm'); select $p; +print read_only_top(lang => 'Perl', by => 'regen/overload.pl', + file => 'lib/overload/numbers.pm', copyright => [2008]); + { 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 regen/overload.pl -# - package overload::numbers; our \@names = qw# @@ -72,35 +62,16 @@ our \@enums = qw# EOF } - -sub print_header { - my $file = shift; - print <<"EOF"; -/* -*- buffer-read-only: t -*- - * - * $file - * - * Copyright (C) 1997, 1998, 2000, 2001, 2005, 2006, 2007, 2011 - * 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 regen/overload.pl - */ -EOF +for ([$c, 'overload.c'], [$h, 'overload.h']) { + my ($handle, $file) = @$_; + print $handle read_only_top(lang => 'C', by => 'regen/overload.pl', + file => $file, style => '*', + copyright => [1997, 1998, 2000, 2001, + 2005 .. 2007, 2011]); } -select $c; -print_header('overload.c'); - select $h; -print_header('overload.h'); -print <<'EOF'; - -enum { -EOF +print "enum {\n"; for (0..$#enums) { my $op = $names[$_]; @@ -123,7 +94,6 @@ print <<'EOF'; EOF print $c <<'EOF'; - #define AMG_id2name(id) (PL_AMG_names[id]+1) #define AMG_id2namelen(id) (PL_AMG_namelens[id]-1) diff --git a/regen/reentr.pl b/regen/reentr.pl index ba0cfdf466..3586bc1348 100644 --- a/regen/reentr.pl +++ b/regen/reentr.pl @@ -54,20 +54,12 @@ my %map = ( # safer_unlink 'reentr.h'; my $h = safer_open("reentr.h-new"); select $h; -print <<EOF; -/* -*- buffer-read-only: t -*- - * - * reentr.h - * - * Copyright (C) 2002, 2003, 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 regen/reentr.pl from data in regen/reentr.pl. - */ +print read_only_top(lang => 'C', by => 'regen/reentr.pl', + from => 'data in regen/reentr.pl', + file => 'reentr.h', style => '*', + copyright => [2002, 2003, 2005 .. 2007]); +print <<EOF; #ifndef REENTR_H #define REENTR_H @@ -803,21 +795,14 @@ rename_if_different('reentr.h-new', 'reentr.h'); # safer_unlink 'reentr.c'; my $c = safer_open("reentr.c-new"); select $c; -print <<EOF; -/* -*- buffer-read-only: t -*- - * - * reentr.c - * - * Copyright (C) 2002, 2003, 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 regen/reentr.pl from data in regen/reentr.pl. - * +my $top = read_only_top(lang => 'C', by => 'regen/reentr.pl', + from => 'data in regen/reentr.pl', + file => 'reentr.c', style => '*', + copyright => [2002, 2003, 2005 .. 2007]); + +$top =~ s! \*/\n! * * "Saruman," I said, standing away from him, "only one hand at a time can - * wield the One, and you know that well, so do not trouble to say we!" + * wield the One, and you know that well, so do not trouble to say we\!" * * This file contains a collection of automatically created wrappers * (created by running reentr.pl) for reentrant (thread-safe) versions of @@ -826,7 +811,9 @@ print <<EOF; * care about the differences between various platforms' idiosyncrasies * regarding these reentrant interfaces. */ +!s; +print $top, <<EOF; #include "EXTERN.h" #define PERL_IN_REENTR_C #include "perl.h" diff --git a/regen/regcomp.pl b/regen/regcomp.pl index 2a1fb037a4..913dda59f6 100644 --- a/regen/regcomp.pl +++ b/regen/regcomp.pl @@ -133,13 +133,9 @@ unlink $tmp_h if -f $tmp_h; my $out = safer_open($tmp_h); +print $out read_only_top(lang => 'C', by => 'regen/regcomp.pl', + from => 'regcomp.sym'); printf $out <<EOP, -/* -*- buffer-read-only: t -*- - !!!!!!! DO NOT EDIT THIS FILE !!!!!!! - This file is built by regen/regcomp.pl from regcomp.sym. - Any changes made here will be lost! -*/ - /* Regops and State definitions */ #define %*s\t%d diff --git a/regen/regen_lib.pl b/regen/regen_lib.pl index 9008629998..4ea2cf6514 100644 --- a/regen/regen_lib.pl +++ b/regen/regen_lib.pl @@ -3,6 +3,7 @@ use strict; use vars qw($Needs_Write $Verbose @Changed $TAP); use File::Compare; use Symbol; +use Text::Wrap; # Common functions needed by the regen scripts @@ -74,4 +75,54 @@ sub safer_close { close $fh or die 'Error closing ' . *{$fh}->{SCALAR} . ": $!"; } +sub read_only_top { + my %args = @_; + die "Missing language argument" unless defined $args{lang}; + die "Unknown language argument '$args{lang}'" + unless $args{lang} eq 'Perl' or $args{lang} eq 'C'; + my $style = $args{style} ? " $args{style} " : ' '; + + my $raw = "-*- buffer-read-only: t -*-\n"; + + if ($args{file}) { + $raw .= "\n $args{file}\n"; + } + if ($args{copyright}) { + local $" = ', '; + local $Text::Wrap::columns = 75; + $raw .= wrap(' ', ' ', <<"EOM") . "\n"; + +Copyright (C) @{$args{copyright}} by\0Larry\0Wall\0and\0others + +You may distribute under the terms of either the GNU General Public +License or the Artistic License, as specified in the README file. +EOM + } + + $raw .= "!!!!!!! DO NOT EDIT THIS FILE !!!!!!!\n"; + + if ($args{by}) { + $raw .= "This file is built by $args{by}"; + if ($args{from}) { + my @from = ref $args{from} eq 'ARRAY' ? @{$args{from}} : $args{from}; + my $last = pop @from; + if (@from) { + $raw .= ' from ' . join (', ', @from) . " and $last"; + } else { + $raw .= " from $last"; + } + } + $raw .= ".\n"; + } + $raw .= "Any changes made here will be lost!\n"; + $raw .= $args{final} if $args{final}; + + local $Text::Wrap::columns = 78; + my $cooked = $args{lang} eq 'Perl' + ? wrap('# ', '# ', $raw) . "\n" : wrap('/* ', $style, $raw) . " */\n\n"; + $cooked =~ tr/\0/ /; # Don't break Larry's name etc + $cooked =~ s/ +$//mg; # Remove all trailing spaces + return $cooked; +} + 1; diff --git a/regen/warnings.pl b/regen/warnings.pl index 0129603d30..63ed6bce68 100644 --- a/regen/warnings.pl +++ b/regen/warnings.pl @@ -265,13 +265,8 @@ if (@ARGV && $ARGV[0] eq "tree") my $warn = safer_open("warnings.h-new"); my $pm = safer_open("lib/warnings.pm-new"); -print $warn <<'EOM' ; -/* -*- buffer-read-only: t -*- - !!!!!!! DO NOT EDIT THIS FILE !!!!!!! - This file is built by regen/warnings.pl - Any changes made here will be lost! -*/ - +print $pm read_only_top(lang => 'Perl', by => 'regen/warnings.pl'); +print $warn read_only_top(lang => 'C', by => 'regen/warnings.pl'), <<'EOM'; #define Off(x) ((x) / 8) #define Bit(x) (1 << ((x) % 8)) @@ -436,15 +431,9 @@ safer_close $pm; rename_if_different("lib/warnings.pm-new", "lib/warnings.pm"); __END__ -# -*- buffer-read-only: t -*- -# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! -# This file was created by regen/warnings.pl -# Any changes made here will be lost. -# - package warnings; -our $VERSION = '1.11'; +our $VERSION = '1.12'; # Verify that we're called correctly so that warnings will work. # see also strict.pm. |