Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
116 lines (99 sloc) 2.9 KB
#!perl -w
use strict;
use Data::Dumper;
my $in = shift or die "No input name";
my $out = shift or die "No output name";
open(IN, $in) or die "Cannot open input $in: $!";
open(OUT, "> $out") or die "Cannot create $out: $!";
print OUT <<'EOS';
package Imager::Regops;
use strict;
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %Attr $MaxOperands $PackCode);
@ISA = qw(Exporter);
@EXPORT_OK = qw(%Attr $MaxOperands $PackCode);
my @ops;
my %attr;
my $opcode = 0;
my $max_opr = 0;
my $reg_pack;
while (<IN>) {
if (/^\s*rbc_(\w+)/) {
my $op = $1;
push(@ops, uc "RBC_$op");
# each line has a comment with the registers used - find the maximum
# I could probably do this as one line, but let's not
my @parms = /\b([rp][a-z])\b/g;
$max_opr = @parms if @parms > $max_opr;
my $types = join("", map {substr($_,0,1)} @parms);
my ($result) = /->\s*([rp])/;
$attr{$op} = { parms=>scalar @parms,
print OUT "use constant RBC_\U$op\E => $opcode;\n";
if (/^\#define RM_WORD_PACK \"(.)\"/) {
$reg_pack = $1;
print OUT "\n\@EXPORT = qw(@ops);\n\n";
# previously we used Data::Dumper, with Sortkeys()
# to make sure the generated code only changed when the data
# changed. Unfortunately Sortkeys isn't supported in some versions of
# perl we try to support, so we now generate this manually
print OUT "%Attr =\n (\n";
for my $opname (sort keys %attr) {
my $op = $attr{$opname};
print OUT " '$opname' =>\n {\n";
for my $attrname (sort keys %$op) {
my $attr = $op->{$attrname};
print OUT " '$attrname' => ";
if (defined $attr) {
if ($attr =~ /^\d+$/) {
print OUT $attr;
else {
print OUT "'$attr'";
else {
print OUT "undef";
print OUT ",\n";
print OUT " },\n";
print OUT " );\n";
print OUT "\$MaxOperands = $max_opr;\n";
print OUT qq/\$PackCode = "$reg_pack";\n/;
print OUT <<'EOS';
=head1 NAME
Imager::Regops - generated information about the register based VM
use Imager::Regops;
$Imager::Regops::Attr{$opname}->{opcode} # opcode for given operator
$Imager::Regops::Attr{$opname}->{parms} # number of parameters
$Imager::Regops::Attr{$opname}->{types} # types of parameters
$Imager::Regops::Attr{$opname}->{func} # operator is a function
$Imager::Regops::Attr{$opname}->{result} # r for numeric, p for pixel result
$Imager::Regops::MaxOperands; # maximum number of operands
This module is generated automatically from regmach.h so we don't need to
maintain the same information in at least one extra place.
At least that's the idea.
=head1 AUTHOR
Tony Cook,
=head1 SEE ALSO
perl(1), Imager(3),
close(OUT) or die "Cannot close $out: $!";
close IN;
Jump to Line
Something went wrong with that request. Please try again.