This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regen/regcomp.pl: Allow ';' in comments
[perl5.git] / regen / regcomp.pl
index 45ec9ac..eef5533 100644 (file)
@@ -17,7 +17,6 @@ BEGIN {
     # Get function prototypes
     require 'regen/regen_lib.pl';
 }
-#use Fatal qw(open close rename chmod unlink);
 use strict;
 
 open DESC, 'regcomp.sym';
@@ -35,7 +34,7 @@ while (<DESC>) {
         next;
     }
     unless ($lastregop) {
-        ($name[$ind], $desc, $rest[$ind]) = /^(\S+)\s+([^\t]+)\s*;\s*(.*)/;
+        ($name[$ind], $desc, $rest[$ind]) = /^(\S+)\s+([^\t]+?)\s*;\s*(.*)/;
         ($type[$ind], $code[$ind], $args[$ind], $flags[$ind], $longj[$ind])
           = split /[,\s]\s*/, $desc;
         ++$ind;
@@ -123,23 +122,12 @@ EXTCONST U8 PL_${varname}_bitmask[] = {
     $out_mask
 };
 #endif /* DOINIT */
-
 EOP
 }
 
-my $tmp_h = 'regnodes.h-new';
-
-unlink $tmp_h if -f $tmp_h;
-
-my $out = safer_open($tmp_h);
-
+my $out = open_new('regnodes.h', '>',
+                  { by => 'regen/regcomp.pl', from => 'regcomp.sym' });
 printf $out <<EOP,
-/* -*- buffer-read-only: t -*-
-   !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
-   This file is built by regcomp.pl from regcomp.sym.
-   Any changes made here will be lost!
-*/
-
 /* Regops and State definitions */
 
 #define %*s\t%d
@@ -274,6 +262,10 @@ foreach my $file ("op_reg_common.h", "regexp.h") {
             foreach my $key (keys %definitions) {
                 s/\b$key\b/$definitions{$key}/g;
             }
+
+           # Remove the U suffix from unsigned int literals
+           s/\b([0-9]+)U\b/$1/g;
+
             my $newval = eval $_;   # Get numeric definition
 
             $definitions{$define} = $newval;
@@ -291,10 +283,32 @@ foreach my $file ("op_reg_common.h", "regexp.h") {
 my %vrxf=reverse %rxfv;
 printf $out "\t/* Bits in extflags defined: %s */\n", unpack 'B*', pack 'N', $val;
 for (0..31) {
-    my $n=$vrxf{2**$_}||"UNUSED_BIT_$_";
+    my $power_of_2 = 2**$_;
+    my $n=$vrxf{$power_of_2};
+    if (! $n) {
+
+        # Here, there was no name that matched exactly the bit.  It could be
+        # either that it is unused, or the name matches multiple bits.
+        if (! ($val & $power_of_2)) {
+            $n = "UNUSED_BIT_$_";
+        }
+        else {
+
+            # Here, must be because it matches multiple bits.  Look through
+            # all possibilities until find one that matches this one.  Use
+            # that name, and all the bits it matches
+            foreach my $name (keys %rxfv) {
+                if ($rxfv{$name} & $power_of_2) {
+                    $n = $name;
+                    $power_of_2 = $rxfv{$name};
+                    last;
+                }
+            }
+        }
+    }
     $n=~s/^RXf_(PMf_)?//;
     printf $out qq(\t%-20s/* 0x%08x */\n), 
-        qq("$n",),2**$_;
+        qq("$n",),$power_of_2;
 }  
  
 print $out <<EOP;
@@ -308,13 +322,9 @@ print $out process_flags('V', 'varies', <<'EOC');
 EOC
 
 print $out process_flags('S', 'simple', <<'EOC');
+
 /* The following always have a length of 1. U8 we can do strchr() on it. */
 /* (Note that length 1 means "one character" under UTF8, not "one octet".) */
 EOC
 
-print $out <<EOP;
-/* ex: set ro: */
-EOP
-safer_close($out);
-
-rename_if_different $tmp_h, 'regnodes.h';
+read_only_bottom_close_and_rename($out);