avoid a possible sign-extension for offsets/sizes in SGI
[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 binmode OUT;
9 print OUT <<'EOS';
10 # AUTOMATICALLY GENERATED BY regops.perl
11 package Imager::Regops;
12 use strict;
13 require Exporter;
14 use vars qw(@ISA @EXPORT @EXPORT_OK %Attr $MaxOperands $PackCode);
15 @ISA = qw(Exporter);
16 @EXPORT_OK = qw(%Attr $MaxOperands $PackCode);
17
18 EOS
19 my @ops;
20 my %attr;
21 my $opcode = 0;
22 my $max_opr = 0;
23 my $reg_pack;
24 while (<IN>) {
25   if (/^\s*rbc_(\w+)/) {
26     my $op = $1;
27     push(@ops, uc "RBC_$op");
28     # each line has a comment with the registers used - find the maximum
29     # I could probably do this as one line, but let's not
30     my @parms = /\b([rp][a-z])\b/g;
31     $max_opr = @parms if @parms > $max_opr;
32     my $types = join("", map {substr($_,0,1)} @parms);
33     my ($result) = /->\s*([rp])/;
34     $attr{$op} = { parms=>scalar @parms,
35                    types=>$types,
36                    func=>/\w+\(/?1:0,
37                    opcode=>$opcode,
38                    result=>$result
39                  };
40     print OUT "use constant RBC_\U$op\E => $opcode;\n";
41     ++$opcode;
42   }
43   if (/^\#define RM_WORD_PACK \"(.)\"/) {
44     $reg_pack = $1; 
45   }
46 }
47 print OUT "\n\@EXPORT = qw(@ops);\n\n";
48 # previously we used Data::Dumper, with Sortkeys() 
49 # to make sure the generated code only changed when the data
50 # changed.  Unfortunately Sortkeys isn't supported in some versions of
51 # perl we try to support, so we now generate this manually
52 print OUT "%Attr =\n  (\n";
53 for my $opname (sort keys %attr) {
54   my $op = $attr{$opname};
55   print OUT "  '$opname' =>\n    {\n";
56   for my $attrname (sort keys %$op) {
57     my $attr = $op->{$attrname};
58     print OUT "    '$attrname' => ";
59     if (defined $attr) {
60       if ($attr =~ /^\d+$/) {
61         print OUT $attr;
62       }
63       else {
64         print OUT "'$attr'";
65       }
66     }
67     else {
68       print OUT "undef";
69     }
70
71     print OUT ",\n";
72   }
73   print OUT "    },\n";
74 }
75 print OUT "  );\n";
76 print OUT "\$MaxOperands = $max_opr;\n";
77 print OUT qq/\$PackCode = "$reg_pack";\n/;
78 print OUT <<'EOS';
79 1;
80
81 __END__
82
83 =head1 NAME
84
85 Imager::Regops - generated information about the register based virtual machine
86
87 =head1 SYNOPSIS
88
89   use Imager::Regops;
90   $Imager::Regops::Attr{$opname}->{opcode} # opcode for given operator
91   $Imager::Regops::Attr{$opname}->{parms} # number of parameters
92   $Imager::Regops::Attr{$opname}->{types} # types of parameters
93   $Imager::Regops::Attr{$opname}->{func} # operator is a function
94   $Imager::Regops::Attr{$opname}->{result} # r for numeric, p for pixel result
95   $Imager::Regops::MaxOperands; # maximum number of operands
96
97 =head1 DESCRIPTION
98
99 This module is generated automatically from F<regmach.h> so we don't need to
100 maintain the same information in at least one extra place.
101
102 At least that's the idea.
103
104 =head1 AUTHOR
105
106 Tony Cook, tony@develop-help.com
107
108 =head1 SEE ALSO
109
110 perl(1), Imager(3), http://imager.perl.org/
111
112 =cut
113
114 EOS
115 close(OUT) or die "Cannot close $out: $!";
116 close IN;