Initial revision
[imager.git] / regops.perl
1 #!perl -w
2 use strict;
3 use Data::Dumper;
4 my $in = shift or die "No input name";
5 my $out = shift or die "No output name";
6 open(IN, $in) or die "Cannot open input $in: $!";
7 open(OUT, "> $out") or die "Cannot create $out: $!";
8 print OUT <<'EOS';
9 # AUTOMATICALLY GENERATED BY regops.perl
10 package Imager::Regops;
11 use strict;
12 require Exporter;
13 use vars qw(@ISA @EXPORT @EXPORT_OK %Attr $MaxOperands $PackCode);
14 @ISA = qw(Exporter);
15 @EXPORT_OK = qw(%Attr $MaxOperands $PackCode);
16
17 EOS
18 my @ops;
19 my %attr;
20 my $opcode = 0;
21 my $max_opr = 0;
22 my $reg_pack;
23 while (<IN>) {
24   if (/^\s*rbc_(\w+)/) {
25     my $op = $1;
26     push(@ops, uc "RBC_$op");
27     # each line has a comment with the registers used - find the maximum
28     # I could probably do this as one line, but let's not
29     my @parms = /\b([rp][a-z])\b/g;
30     $max_opr = @parms if @parms > $max_opr;
31     my $types = join("", map {substr($_,0,1)} @parms);
32     my ($result) = /->\s*([rp])/;
33     $attr{$op} = { parms=>scalar @parms,
34                    types=>$types,
35                    func=>/\w+\(/?1:0,
36                    opcode=>$opcode,
37                    result=>$result
38                  };
39     print OUT "use constant RBC_\U$op\E => $opcode;\n";
40     ++$opcode;
41   }
42   if (/^\#define RM_WORD_PACK \"(.)\"/) {
43     $reg_pack = $1; 
44   }
45 }
46 print OUT "\n\@EXPORT = qw(@ops);\n\n";
47 print OUT Data::Dumper->Dump([\%attr],["*Attr"]);
48 print OUT "\$MaxOperands = $max_opr;\n";
49 print OUT qq/\$PackCode = "$reg_pack";\n/;
50 print OUT <<'EOS';
51 1;
52
53 __END__
54
55 =head1 NAME
56
57 Imager::Regops - generated information about the register based VM
58
59 =head1 SYNOPSIS
60
61   use Imager::Regops;
62   $Imager::Regops::Attr{$opname}->{opcode} # opcode for given operator
63   $Imager::Regops::Attr{$opname}->{parms} # number of parameters
64   $Imager::Regops::Attr{$opname}->{types} # types of parameters
65   $Imager::Regops::Attr{$opname}->{func} # operator is a function
66   $Imager::Regops::Attr{$opname}->{result} # r for numeric, p for pixel result
67   $Imager::Regops::MaxOperands; # maximum number of operands
68
69 =head1 DESCRIPTION
70
71 This module is generated automatically from regmach.h so we don't need to 
72 maintain the same information in at least one extra place.
73
74 At least that's the idea.
75
76 =head1 AUTHOR
77
78 Tony Cook, tony@develop-help.com
79
80 =head1 SEE ALSO
81
82 perl(1), Imager(3), http://www.eecs.umich.edu/~addi/perl/Imager/
83
84 =cut
85
86 EOS
87 close(OUT) or die "Cannot close $out: $!";
88 close IN;