Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

file 115 lines (99 sloc) 2.986 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115
#!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';
# AUTOMATICALLY GENERATED BY regops.perl
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);

EOS
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,
types=>$types,
func=>/\w+\(/?1:0,
opcode=>$opcode,
result=>$result
};
    print OUT "use constant RBC_\U$op\E => $opcode;\n";
    ++$opcode;
  }
  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';
1;

__END__

=head1 NAME

Imager::Regops - generated information about the register based virtual machine

=head1 SYNOPSIS

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

=head1 DESCRIPTION

This module is generated automatically from F<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, tony@develop-help.com

=head1 SEE ALSO

perl(1), Imager(3), http://imager.perl.org/

=cut

EOS
close(OUT) or die "Cannot close $out: $!";
close IN;
Something went wrong with that request. Please try again.