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