Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 91 lines (75 sloc) 2.346 kb
02d1d62 Initial revision
Arnar Mar Hrafnkelsson authored
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";
8f22b8d - test t/t35ttfont.t no longer requires TTFONTTEST to be set (and
Tony Cook authored
47 my $dumper = Data::Dumper->new([\%attr],["*Attr"]);
48 $dumper->Sortkeys(1);
49 print OUT $dumper->Dump;
02d1d62 Initial revision
Arnar Mar Hrafnkelsson authored
50 print OUT "\$MaxOperands = $max_opr;\n";
51 print OUT qq/\$PackCode = "$reg_pack";\n/;
52 print OUT <<'EOS';
53 1;
54
55 __END__
56
57 =head1 NAME
58
59 Imager::Regops - generated information about the register based VM
60
61 =head1 SYNOPSIS
62
63 use Imager::Regops;
64 $Imager::Regops::Attr{$opname}->{opcode} # opcode for given operator
65 $Imager::Regops::Attr{$opname}->{parms} # number of parameters
66 $Imager::Regops::Attr{$opname}->{types} # types of parameters
67 $Imager::Regops::Attr{$opname}->{func} # operator is a function
68 $Imager::Regops::Attr{$opname}->{result} # r for numeric, p for pixel result
69 $Imager::Regops::MaxOperands; # maximum number of operands
70
71 =head1 DESCRIPTION
72
73 This module is generated automatically from regmach.h so we don't need to
74 maintain the same information in at least one extra place.
75
76 At least that's the idea.
77
78 =head1 AUTHOR
79
80 Tony Cook, tony@develop-help.com
81
82 =head1 SEE ALSO
83
8f22b8d - test t/t35ttfont.t no longer requires TTFONTTEST to be set (and
Tony Cook authored
84 perl(1), Imager(3), http://imager.perl.org/
02d1d62 Initial revision
Arnar Mar Hrafnkelsson authored
85
86 =cut
87
88 EOS
89 close(OUT) or die "Cannot close $out: $!";
90 close IN;
Something went wrong with that request. Please try again.