X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/3d7c117d5246fe5390f3fda7bd31308799d54201..dd469d97d90432366e531534b23dd30f1f8a07ca:/regen/regcomp.pl

diff --git a/regen/regcomp.pl b/regen/regcomp.pl
index 94aa572..2eac179 100644
--- a/regen/regcomp.pl
+++ b/regen/regcomp.pl
@@ -49,14 +49,17 @@ use strict;
 # name          Both    Name of op/state
 # id            Both    integer value for this opcode/state
 # optype        Both    Either 'op' or 'state'
-# line_num          Both    line_num number of the input file for this item.
+# line_num      Both    line_num number of the input file for this item.
 # type          Op      Type of node (aka regkind)
-# code          Op      what code is associated with this node (???)
-# args          Op      what type of args the node has (which regnode struct)
-# flags         Op      (???)
-# longj         Op      Whether this node is a longjump
-# comment       Both    Comment about node, if any
+# code          Op      Apparently not used
+# suffix        Op      which regnode struct this uses, so if this is '1', it
+#                       uses 'struct regnode_1'
+# flags         Op      S for simple; V for varies
+# longj         Op      Boolean as to if this node is a longjump
+# comment       Both    Comment about node, if any.  Placed in perlredebguts
+#                       as its description
 # pod_comment   Both    Special comments for pod output (preceding lines in def)
+#                       Such lines begin with '#*'
 
 # Global State
 my @all;    # all opcodes/state
@@ -89,26 +92,23 @@ sub register_node {
     $node->{id}= 0 + @all;
     push @all, $node;
     $all{ $node->{name} }= $node;
+
+    if ($node->{longj} && $node->{longj} != 1) {
+        die "longj field must be in [01] if present in ", Dumper($node);
+    }
+
 }
 
 # Parse and add an opcode definition to the global state.
-# An opcode definition looks like this:
+# What an opcode definition looks like is given in regcomp.sym.
 #
-#                             +- args
-#                             | +- flags
-#                             | | +- longjmp
-# Name        Type       code | | | ; comment
-# --------------------------------------------------------------------------
-# IFMATCH     BRANCHJ,    off 1 . 2 ; Succeeds if the following matches.
-# UNLESSM     BRANCHJ,    off 1 . 2 ; Fails if the following matches.
-# SUSPEND     BRANCHJ,    off 1 V 1 ; "Independent" sub-RE.
-# IFTHEN      BRANCHJ,    off 1 V 1 ; Switch, should be preceded by switcher.
-# GROUPP      GROUPP,     num 1     ; Whether the group matched.
-#
-# Not every opcode definition has all of these. We should maybe make this
-# nicer/easier to read in the future. Also note that the above is tab
+# Not every opcode definition has all of the components. We should maybe make
+# this nicer/easier to read in the future. Also note that the above is tab
 # sensitive.
 
+# Special comments for an entry precede it, and begin with '#*' and are placed
+# in the generated pod file just before the entry.
+
 sub parse_opcode_def {
     my ( $text, $line_num, $pod_comment )= @_;
     my $node= {
@@ -124,10 +124,10 @@ sub parse_opcode_def {
         or die "Failed to match $_";
 
     # the content of the "desc" field from the first step is extracted here:
-    @{$node}{qw(type code args flags longj)}= split /[,\s]\s*/, $node->{desc};
+    @{$node}{qw(type code suffix flags longj)}= split /[,\s]\s*/, $node->{desc};
 
     defined $node->{$_} or $node->{$_} = ""
-        for qw(type code args flags longj);
+        for qw(type code suffix flags longj);
 
     register_node($node); # has to be before the type_alias code below
 
@@ -363,7 +363,7 @@ EOP
 
     foreach my $node (@ops) {
         my $size= 0;
-        $size= "EXTRA_SIZE(struct regnode_$node->{args})" if $node->{args};
+        $size= "EXTRA_SIZE(struct regnode_$node->{suffix})" if $node->{suffix};
 
         printf $out "\t%*s\t/* %*s */\n", -37, "$size,", -$rwidth, $node->{name};
     }
@@ -621,7 +621,7 @@ EOD
     my $old_fh= select($guts);
     $~= "GuTS";
 
-    open my $oldguts, "pod/perldebguts.pod"
+    open my $oldguts, '<', 'pod/perldebguts.pod'
         or die "$0 cannot open pod/perldebguts.pod for reading: $!";
     while (<$oldguts>) {
         print;
@@ -630,11 +630,11 @@ EOD
 
     print <<'END_OF_DESCR';
 
- # TYPE arg-description [num-args] [longjump-len] DESCRIPTION
+ # TYPE arg-description [regnode-struct-suffix] [longjump-len] DESCRIPTION
 END_OF_DESCR
     for my $n (@ops) {
         $node= $n;
-        $code= "$node->{code} " . ( $node->{args} || "" );
+        $code= "$node->{code} " . ( $node->{suffix} || "" );
         $code .= " $node->{longj}" if $node->{longj};
         if ( $node->{pod_comment} ||= "" ) {
 
@@ -649,7 +649,8 @@ END_OF_DESCR
     while (<$oldguts>) {
         last if /=for regcomp.pl end/;
     }
-    do { print } while <$oldguts>;
+    do { print } while <$oldguts>; #win32 can't unlink an open FH
+    close $oldguts or die "Error closing pod/perldebguts.pod: $!";
     select $old_fh;
     close_and_rename($guts);
 }