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 my $dumper = Data::Dumper->new([\%attr],["*Attr"]);
  48 $dumper->Sortkeys(1);
  49 print OUT $dumper->Dump;
  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
  84 perl(1), Imager(3), http://imager.perl.org/
  85
  86 =cut
  87
  88 EOS
  89 close(OUT) or die "Cannot close $out: $!";
  90 close IN;