perl/lib/Nasm/Regs.pm

   1 =head1 NAME
   2
   3 Nasm::Regs
   4
   5 =head1 DESCRIPTION
   6
   7 =head1 Subroutines
   8
   9 =cut
  10
  11 package Nasm::Regs;
  12 use strict;
  13 use warnings;
  14
  15 require Nasm::Regs::Register;
  16 require Nasm::Regs::Format;
  17
  18 =head2 new
  19
  20 Creates Nasm::Regs object
  21
  22 =cut
  23 sub new{
  24   my($class,$filename) = @_;
  25   my $self = bless {}, $class;
  26
  27   if( @_ > 1 and $filename ){
  28     $self->ProcessFile($filename);
  29   }
  30
  31   return $self;
  32 }
  33
  34
  35 =head2 ProcessFile
  36
  37 Loads the file
  38
  39 =cut
  40 sub ProcessFile{
  41   my($self,$filename) = @_;
  42   my $file;
  43
  44   if( $filename eq '-'){
  45     $file = *{STDIN}{IO};
  46   }else{
  47     open $file, '<', $filename or die;
  48   }
  49   $self->{filename} = $filename;
  50
  51   my %current =( line_number => -1 );
  52
  53   while( my $line = <$file> ){
  54     $current{line_number}++;
  55     chomp $line;
  56     $line =~ s/\s*(?:\#.*)?$//;
  57     next unless length $line;
  58
  59     $current{line} = $line;
  60     $self->_ProcessLine(\%current);
  61   }
  62
  63   close $file;
  64   return $self;
  65 }
  66
  67
  68
  69 sub _ProcessLine{
  70   my($self,$current) = @_;
  71
  72   unless( $current->{line} =~ /^\s*(\S+)\s*(\S+)\s*(\S+)\s*([0-9]+)$/ ){
  73     die;
  74   }
  75
  76   my ($register,$a_class,$d_classes,$x86regno) = ($1,$2,$3,$4);
  77
  78   my @reg_list;
  79
  80   if ( $register =~ m{
  81     ^
  82     (.*?)  (\d+)  -  (\d+)  (.*)
  83     $
  84   }x) {
  85     for my $i ($2..$3){
  86       push @reg_list, $1. $i . $4
  87     }
  88   } else {
  89
  90     @reg_list = $register;
  91   }
  92
  93   # force numeric conversion
  94   $x86regno += 0;
  95
  96   my @d_classes = split ',', $d_classes;
  97   #my %d_is_class;
  98
  99   for my $register(@reg_list){
 100     my $reg_obj = Nasm::Regs::Register->new($register,$a_class,[@d_classes],$x86regno);
 101     $self->{register}{$register} = $reg_obj;
 102
 103     for my $class (@d_classes){
 104       $self->{disassembler}{$class}[$x86regno] = $reg_obj
 105     }
 106
 107     $x86regno++;
 108   }
 109 }
 110
 111
 112
 113
 114 =head2 names
 115
 116 Returns a sorted list of RegisterNames
 117
 118 =cut
 119 sub names{
 120   my($self) = @_;
 121   # deprecated
 122   return $self->RegisterNames;
 123 }
 124
 125 =head2 RegisterNames
 126
 127 Returns a sorted list of RegisterNames
 128
 129 =cut
 130 sub RegisterNames{
 131   my($self) = @_;
 132   my @keys = sort grep { length $_ } keys %{$self->{register}};
 133
 134   return  @keys if wantarray;
 135   return \@keys;
 136 }
 137
 138
 139
 140 =head2 Register( $register_name )
 141
 142 Returns a Register object
 143
 144 =cut
 145 sub Register{
 146   my($self,$register_name) = @_;
 147   return $self->{register}{$register_name};
 148 }
 149
 150 =head2 DisassemblerClasses
 151
 152 Returns a sorted list of DisassemblerClasses
 153
 154 =cut
 155 sub DisassemblerClasses{
 156   my($self) = @_;
 157   my @return = sort keys %{$self->{disassembler}};
 158
 159   return  @return if wantarray;
 160   return \@return;
 161 }
 162
 163 =head2 DisassemblerClass( $class )
 164
 165
 166
 167 =cut
 168 sub DisassemblerClass{
 169   my($self,$class) = @_;
 170   my $return = $self->{disassembler}{$class};
 171   return @$return if wantarray;
 172   return  $return;
 173 }
 174
 175
 176 =head2 format( $format_type )
 177
 178 Returns regs info in a given format
 179
 180 =cut
 181 sub format{
 182   my($self,$fmt) = @_;
 183   require Nasm::Regs::Format;
 184   Nasm::Regs::Format::format($self,$fmt);
 185 }
 186
 187
 188 =head2 filename
 189
 190 Returns the name of the file the data was loaded from
 191
 192 =cut
 193 sub filename{
 194   my($self) = @_;
 195   return $self->{filename};
 196 }
 197
 198
 199
 200 1;