regops.perl

   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";
  47 print OUT Data::Dumper->Dump([\%attr],["*Attr"]);
  48 print OUT "\$MaxOperands = $max_opr;\n";
  49 print OUT qq/\$PackCode = "$reg_pack";\n/;
  50 print OUT <<'EOS';
  51 1;
  52
  53 __END__
  54
  55 =head1 NAME
  56
  57 Imager::Regops - generated information about the register based VM
  58
  59 =head1 SYNOPSIS
  60
  61   use Imager::Regops;
  62   $Imager::Regops::Attr{$opname}->{opcode} # opcode for given operator
  63   $Imager::Regops::Attr{$opname}->{parms} # number of parameters
  64   $Imager::Regops::Attr{$opname}->{types} # types of parameters
  65   $Imager::Regops::Attr{$opname}->{func} # operator is a function
  66   $Imager::Regops::Attr{$opname}->{result} # r for numeric, p for pixel result
  67   $Imager::Regops::MaxOperands; # maximum number of operands
  68
  69 =head1 DESCRIPTION
  70
  71 This module is generated automatically from regmach.h so we don't need to
  72 maintain the same information in at least one extra place.
  73
  74 At least that's the idea.
  75
  76 =head1 AUTHOR
  77
  78 Tony Cook, tony@develop-help.com
  79
  80 =head1 SEE ALSO
  81
  82 perl(1), Imager(3), http://www.eecs.umich.edu/~addi/perl/Imager/
  83
  84 =cut
  85
  86 EOS
  87 close(OUT) or die "Cannot close $out: $!";
  88 close IN;