Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

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