#!/usr/bin/perl -w # # Regenerate (overwriting only if changed): # # regnodes.h # # from information stored in # # regcomp.sym # regexp.h # # Accepts the standard regen_lib -q and -v args. # # This script is normally invoked from regen.pl. BEGIN { # Get function prototypes require 'regen/regen_lib.pl'; } use strict; open DESC, 'regcomp.sym'; my $ind = 0; my (@name,@rest,@type,@code,@args,@flags,@longj); my ($desc,$lastregop); while () { s/#.*$//; next if /^\s*$/; chomp; # No \z in 5.004 s/\s*$//; if (/^-+\s*$/) { $lastregop= $ind; next; } unless ($lastregop) { ($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; } else { my ($type,@lists)=split /\s+/, $_; die "No list? $type" if !@lists; foreach my $list (@lists) { my ($names,$special)=split /:/, $list , 2; $special ||= ""; foreach my $name (split /,/,$names) { my $real= $name eq 'resume' ? "resume_$type" : "${type}_$name"; my @suffix; if (!$special) { @suffix=(""); } elsif ($special=~/\d/) { @suffix=(1..$special); } elsif ($special eq 'FAIL') { @suffix=("","_fail"); } else { die "unknown :type ':$special'"; } foreach my $suffix (@suffix) { $name[$ind]="$real$suffix"; $type[$ind]=$type; $rest[$ind]="state for $type"; ++$ind; } } } } } # use fixed width to keep the diffs between regcomp.pl recompiles # as small as possible. my ($width,$rwidth,$twidth)=(22,12,9); $lastregop ||= $ind; my $tot = $ind; close DESC; die "Too many regexp/state opcodes! Maximum is 256, but there are $lastregop in file!" if $lastregop>256; sub process_flags { my ($flag, $varname, $comment) = @_; $comment = '' unless defined $comment; $ind = 0; my @selected; my $bitmap = ''; do { my $set = $flags[$ind] && $flags[$ind] eq $flag ? 1 : 0; # Whilst I could do this with vec, I'd prefer to do longhand the arithmetic # ops in the C code. my $current = do { local $^W; ord do { substr $bitmap, ($ind >> 3); } }; substr($bitmap, ($ind >> 3), 1) = chr($current | ($set << ($ind & 7))); push @selected, $name[$ind] if $set; } while (++$ind < $lastregop); my $out_string = join ', ', @selected, 0; $out_string =~ s/(.{1,70},) /$1\n /g; my $out_mask = join ', ', map {sprintf "0x%02X", ord $_} split '', $bitmap; return $comment . <<"EOP"; #define REGNODE_\U$varname\E(node) (PL_${varname}_bitmask[(node) >> 3] & (1 << ((node) & 7))) #ifndef DOINIT EXTCONST U8 PL_${varname}\[] __attribute__deprecated__; #else EXTCONST U8 PL_${varname}\[] __attribute__deprecated__ = { $out_string }; #endif /* DOINIT */ #ifndef DOINIT EXTCONST U8 PL_${varname}_bitmask[]; #else EXTCONST U8 PL_${varname}_bitmask[] = { $out_mask }; #endif /* DOINIT */ EOP } my $out = open_new('regnodes.h', '>', { by => 'regen/regcomp.pl', from => 'regcomp.sym' }); printf $out < $lastregop - 1, -$width, REGMATCH_STATE_MAX => $tot - 1 ; for ($ind=0; $ind < $lastregop ; ++$ind) { printf $out "#define\t%*s\t%d\t/* %#04x %s */\n", -$width, $name[$ind], $ind, $ind, $rest[$ind]; } print $out "\t/* ------------ States ------------- */\n"; for ( ; $ind < $tot ; $ind++) { printf $out "#define\t%*s\t(REGNODE_MAX + %d)\t/* %s */\n", -$width, $name[$ind], $ind - $lastregop + 1, $rest[$ind]; } print $out <) { # optional leading '_'. Return symbol in $1, and strip it from # rest of line if (s/ \# \s* define \s+ ( _? RXf_ \w+ ) \s+ //xi) { chomp; my $define = $1; s: / \s* \* .*? \* \s* / : :x; # Replace comments by a blank # Replace any prior defined symbols by their values 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; next unless $_ =~ /<