]>
Commit | Line | Data |
---|---|---|
02d1d628 AMH |
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: $!"; | |
5e795fcc | 8 | binmode OUT; |
02d1d628 AMH |
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"; | |
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 | |
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"; | |
02d1d628 AMH |
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 | ||
5715f7c3 | 85 | Imager::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 | 99 | This module is generated automatically from F<regmach.h> so we don't need to |
02d1d628 AMH |
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 | ||
8f22b8d8 | 110 | perl(1), Imager(3), http://imager.perl.org/ |
02d1d628 AMH |
111 | |
112 | =cut | |
113 | ||
114 | EOS | |
115 | close(OUT) or die "Cannot close $out: $!"; | |
116 | close IN; |