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 90 lines (75 sloc) 2.346 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
#!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";
my $dumper = Data::Dumper->new([\%attr],["*Attr"]);
$dumper->Sortkeys(1);
print OUT $dumper->Dump;
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 VM

=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 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.