perl/lib/Nasm/Regs.pm

   1 =head1 NAME
   2
   3 Nasm::Regs
   4
   5 =cut
   6
   7 package Nasm::Regs;
   8 use strict;
   9 use warnings;
  10
  11 require Nasm::Regs::Register;
  12 require Nasm::Regs::Format;
  13
  14 sub new{
  15   my($class,$filename) = @_;
  16   my $self = bless {}, $class;
  17
  18   if( @_ > 1 and $filename ){
  19     $self->ProcessFile($filename);
  20   }
  21
  22   return $self;
  23 }
  24
  25
  26
  27
  28 sub ProcessFile{
  29   my($self,$filename) = @_;
  30   my $file;
  31
  32   if( $filename eq '-'){
  33     $file = *{STDIN}{IO};
  34   }else{
  35     open $file, '<', $filename or die;
  36   }
  37   $self->{filename} = $filename;
  38
  39   my %current =( line_number => -1 );
  40
  41   while( my $line = <$file> ){
  42     $current{line_number}++;
  43     chomp $line;
  44     $line =~ s/\s*(?:\#.*)?$//;
  45     next unless length $line;
  46
  47     $current{line} = $line;
  48     $self->ProcessLine(\%current);
  49   }
  50
  51   close $file;
  52   return $self;
  53 }
  54
  55
  56
  57
  58 sub ProcessLine{
  59   my($self,$current) = @_;
  60
  61   unless( $current->{line} =~ /^\s*(\S+)\s*(\S+)\s*(\S+)\s*([0-9]+)$/ ){
  62     die;
  63   }
  64
  65   my ($register,$a_class,$d_classes,$x86regno) = ($1,$2,$3,$4);
  66
  67   my @reg_list;
  68
  69   if ( $register =~ m{
  70     ^
  71     (.*?)  (\d+)  -  (\d+)  (.*)
  72     $
  73   }x) {
  74     for my $i ($2..$3){
  75       push @reg_list, $1. $i . $4
  76     }
  77   } else {
  78
  79     @reg_list = $register;
  80   }
  81
  82   # force numeric conversion
  83   $x86regno += 0;
  84
  85   my @d_classes = split ',', $d_classes;
  86   #my %d_is_class;
  87
  88   for my $register(@reg_list){
  89     my $reg_obj = Nasm::Regs::Register->new($register,$a_class,[@d_classes],$x86regno);
  90     $self->{register}{$register} = $reg_obj;
  91
  92     for my $class (@d_classes){
  93       $self->{disassembler}{$class}[$x86regno] = $reg_obj
  94     }
  95
  96     $x86regno++;
  97   }
  98 }
  99
 100
 101
 102
 103 sub names{
 104   my($self) = @_;
 105   # deprecated
 106   return $self->RegisterNames;
 107 }
 108 sub RegisterNames{
 109   my($self) = @_;
 110   my @keys = sort grep { length $_ } keys %{$self->{register}};
 111
 112   return  @keys if wantarray;
 113   return \@keys;
 114 }
 115
 116
 117
 118 sub Register{
 119   my($self,$key) = @_;
 120   return $self->{register}{$key};
 121 }
 122 sub DisassemblerClasses{
 123   my($self) = @_;
 124   my @return = sort keys %{$self->{disassembler}};
 125   return  @return if wantarray;
 126   return \@return;
 127 }
 128 sub DisassemblerClass{
 129   my($self,$class) = @_;
 130   my $return = $self->{disassembler}{$class};
 131   return @$return if wantarray;
 132   return  $return;
 133 }
 134
 135
 136 sub format{
 137   my($self,$fmt) = @_;
 138   Nasm::Regs::Format::format($self,$fmt);
 139 }
 140
 141
 142 sub filename{
 143   my($self) = @_;
 144   return $self->{filename};
 145 }
 146
 147
 148
 149 1;