Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 115 lines (99 sloc) 2.971 kb
02d1d628 » Arnar Mar Hrafnkelsson
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 » Tony Cook
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 » Arnar Mar Hrafnkelsson
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
84 Imager::Regops - generated information about the register based VM
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
98 This module is generated automatically from regmach.h so we don't need to
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 » Tony Cook
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 » Arnar Mar Hrafnkelsson
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.