Coverity complained colors could be left uninitialized.
[imager.git] / regops.perl
CommitLineData
02d1d628
AMH
1#!perl -w
2use strict;
3use Data::Dumper;
4my $in = shift or die "No input name";
5my $out = shift or die "No output name";
6open(IN, $in) or die "Cannot open input $in: $!";
7open(OUT, "> $out") or die "Cannot create $out: $!";
5e795fcc 8binmode OUT;
02d1d628
AMH
9print OUT <<'EOS';
10# AUTOMATICALLY GENERATED BY regops.perl
11package Imager::Regops;
12use strict;
13require Exporter;
14use vars qw(@ISA @EXPORT @EXPORT_OK %Attr $MaxOperands $PackCode);
15@ISA = qw(Exporter);
16@EXPORT_OK = qw(%Attr $MaxOperands $PackCode);
17
18EOS
19my @ops;
20my %attr;
21my $opcode = 0;
22my $max_opr = 0;
23my $reg_pack;
24while (<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}
47print OUT "\n\@EXPORT = qw(@ops);\n\n";
61c9a3b2
TC
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
52print OUT "%Attr =\n (\n";
53for 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}
75print OUT " );\n";
02d1d628
AMH
76print OUT "\$MaxOperands = $max_opr;\n";
77print OUT qq/\$PackCode = "$reg_pack";\n/;
78print OUT <<'EOS';
791;
80
81__END__
82
83=head1 NAME
84
5715f7c3 85Imager::Regops - generated information about the register based virtual machine
02d1d628
AMH
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
5715f7c3 99This module is generated automatically from F<regmach.h> so we don't need to
02d1d628
AMH
100maintain the same information in at least one extra place.
101
102At least that's the idea.
103
104=head1 AUTHOR
105
106Tony Cook, tony@develop-help.com
107
108=head1 SEE ALSO
109
8f22b8d8 110perl(1), Imager(3), http://imager.perl.org/
02d1d628
AMH
111
112=cut
113
114EOS
115close(OUT) or die "Cannot close $out: $!";
116close IN;