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