BEGIN {
# Get function prototypes
- require 'regen/regen_lib.pl';
+ require './regen/regen_lib.pl';
}
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
$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= {
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
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};
}
while (<$in_fh>) {
# optional leading '_'. Return symbol in $1, and strip it from
- # comment of line
+ # comment of line. Currently doesn't handle comments running onto
+ # next line
if (s/^ \# \s* define \s+ ( _? RXf_ \w+ ) \s+ //xi) {
chomp;
my $define= $1;
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;
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} ||= "" ) {
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);
}