From 5e5de8283ce76f3490563ba17850daa8bf602a4f Mon Sep 17 00:00:00 2001 From: Brad Gilbert Date: Sun, 12 Apr 2009 14:52:51 -0500 Subject: [PATCH] Added New regs.pl, and associated modules --- perl/README | 12 ++ perl/lib/Nasm/Regs.pm | 141 ++++++++++++++++ perl/lib/Nasm/Regs/Format.pm | 29 ++++ perl/lib/Nasm/Regs/Format/C.pm | 27 +++ perl/lib/Nasm/Regs/Format/DC.pm | 55 ++++++ perl/lib/Nasm/Regs/Format/DH.pm | 47 ++++++ perl/lib/Nasm/Regs/Format/FC.pm | 46 +++++ perl/lib/Nasm/Regs/Format/H.pm | 78 +++++++++ perl/lib/Nasm/Regs/Format/ORDER.pm | 11 ++ perl/lib/Nasm/Regs/Format/VC.pm | 43 +++++ perl/lib/Nasm/Regs/Format/YAML.pm | 26 +++ perl/lib/Nasm/Regs/Register.pm | 41 +++++ perl/lib/Nasm/Utils.pm | 31 ++++ perl/lib/{nasm => Nasm}/crc64.pm | 0 perl/lib/Nasm/insns.pm | 87 ++++++++++ perl/lib/Nasm/insns/Flags.pm | 162 ++++++++++++++++++ perl/lib/Nasm/insns/Operands.pm | 35 ++++ perl/regs.pl | 41 +++++ perl/t/regs/basic.t | 296 +++++++++++++++++++++++++++++++++ perl/t/regs/list.t | 115 +++++++++++++ perl/t/regs/order.t | 138 +++++++++++++++ perl/t/version/dump.t | 4 +- perl/t/version/{input.yml => input.pm} | 121 ++++++++++++++ 23 files changed, 1585 insertions(+), 1 deletion(-) create mode 100644 perl/lib/Nasm/Regs.pm create mode 100644 perl/lib/Nasm/Regs/Format.pm create mode 100644 perl/lib/Nasm/Regs/Format/C.pm create mode 100644 perl/lib/Nasm/Regs/Format/DC.pm create mode 100644 perl/lib/Nasm/Regs/Format/DH.pm create mode 100644 perl/lib/Nasm/Regs/Format/FC.pm create mode 100644 perl/lib/Nasm/Regs/Format/H.pm create mode 100644 perl/lib/Nasm/Regs/Format/ORDER.pm create mode 100644 perl/lib/Nasm/Regs/Format/VC.pm create mode 100644 perl/lib/Nasm/Regs/Format/YAML.pm create mode 100644 perl/lib/Nasm/Regs/Register.pm create mode 100644 perl/lib/Nasm/Utils.pm rename perl/lib/{nasm => Nasm}/crc64.pm (100%) create mode 100644 perl/lib/Nasm/insns.pm create mode 100644 perl/lib/Nasm/insns/Flags.pm create mode 100644 perl/lib/Nasm/insns/Operands.pm create mode 100755 perl/regs.pl create mode 100644 perl/t/regs/basic.t create mode 100644 perl/t/regs/list.t create mode 100644 perl/t/regs/order.t rename perl/t/version/{input.yml => input.pm} (51%) diff --git a/perl/README b/perl/README index d98aa169..646b8710 100644 --- a/perl/README +++ b/perl/README @@ -1,2 +1,14 @@ cd $dir; prove -r; + +Finished / Usable +version.pl +regs.pl + +Incomplete +insns.pl + + +version.pl has good test coverage + +regs.pl has some test coverage diff --git a/perl/lib/Nasm/Regs.pm b/perl/lib/Nasm/Regs.pm new file mode 100644 index 00000000..119300ef --- /dev/null +++ b/perl/lib/Nasm/Regs.pm @@ -0,0 +1,141 @@ +package Nasm::Regs; +use strict; +use warnings; + +require Nasm::Regs::Register; +require Nasm::Regs::Format; + +sub new{ + my($class,$filename) = @_; + my $self = bless {}, $class; + + if( @_ > 1 and $filename ){ + $self->ProcessFile($filename); + } + + return $self; +} + + + + +sub ProcessFile{ + my($self,$filename) = @_; + my $file; + + if( $filename eq '-'){ + $file = *{STDIN}{IO}; + }else{ + open $file, '<', $filename or die; + } + $self->{filename} = $filename; + + my %current =( line_number => -1 ); + + while( my $line = <$file> ){ + $current{line_number}++; + chomp $line; + $line =~ s/\s*(?:\#.*)?$//; + next unless length $line; + + $current{line} = $line; + $self->ProcessLine(\%current); + } + + close $file; + return $self; +} + + + + +sub ProcessLine{ + my($self,$current) = @_; + + unless( $current->{line} =~ /^\s*(\S+)\s*(\S+)\s*(\S+)\s*([0-9]+)$/ ){ + die; + } + + my ($register,$a_class,$d_classes,$x86regno) = ($1,$2,$3,$4); + + my @reg_list; + + if ( $register =~ m{ + ^ + (.*?) (\d+) - (\d+) (.*) + $ + }x) { + for my $i ($2..$3){ + push @reg_list, $1. $i . $4 + } + } else { + + @reg_list = $register; + } + + # force numeric conversion + $x86regno += 0; + + my @d_classes = split ',', $d_classes; + #my %d_is_class; + + for my $register(@reg_list){ + my $reg_obj = Nasm::Regs::Register->new($register,$a_class,[@d_classes],$x86regno); + $self->{register}{$register} = $reg_obj; + + for my $class (@d_classes){ + $self->{disassembler}{$class}[$x86regno] = $reg_obj + } + + $x86regno++; + } +} + + + + +sub names{ + my($self) = @_; + # deprecated + return $self->RegisterNames; +} +sub RegisterNames{ + my($self) = @_; + my @keys = sort grep { length $_ } keys %{$self->{register}}; + + return @keys if wantarray; + return \@keys; +} + + + +sub Register{ + my($self,$key) = @_; + return $self->{register}{$key}; +} +sub DisassemblerClasses{ + my($self) = @_; + return sort keys %{$self->{disassembler}}; +} +sub DisassemblerClass{ + my($self,$class) = @_; + my $return = $self->{disassembler}{$class}; + return @$return if wantarray; + return $return; +} + + +sub format{ + my($self,$fmt) = @_; + Nasm::Regs::Format::format($self,$fmt); +} + + +sub filename{ + my($self) = @_; + return $self->{filename}; +} + + + +1; diff --git a/perl/lib/Nasm/Regs/Format.pm b/perl/lib/Nasm/Regs/Format.pm new file mode 100644 index 00000000..d95ec1b7 --- /dev/null +++ b/perl/lib/Nasm/Regs/Format.pm @@ -0,0 +1,29 @@ +use strict; +use warnings; +package Nasm::Regs::Format; + +#our @list = qw'h c fc vc dc dh'; + + +sub format{ + my($regs,$fmt) = @_; + no strict 'refs'; + + my $package = __PACKAGE__.'::'.uc($fmt); + eval "require $package;"; + if($@){ + die qq[Failed to load format "$fmt"\n]; + } + + my $return; + + eval{ + $return = *{$package.'::format'}{CODE}->($regs); + }; + if($@){ + die qq[Problem with format plugin "$fmt":\n\t$@]; + } + return $return; +} + +1; diff --git a/perl/lib/Nasm/Regs/Format/C.pm b/perl/lib/Nasm/Regs/Format/C.pm new file mode 100644 index 00000000..5967a36e --- /dev/null +++ b/perl/lib/Nasm/Regs/Format/C.pm @@ -0,0 +1,27 @@ +use strict; +use warnings; +package Nasm::Regs::Format::C; + +sub format{ + my($regs) = @_; + my $filename = $regs->filename; + + my $out = <names; + + $out .= qq[ "]; + $out .= join qq[",\n "], @names; + + $out .= qq["\n};\n]; + + return $out; +} + +1; diff --git a/perl/lib/Nasm/Regs/Format/DC.pm b/perl/lib/Nasm/Regs/Format/DC.pm new file mode 100644 index 00000000..4640acca --- /dev/null +++ b/perl/lib/Nasm/Regs/Format/DC.pm @@ -0,0 +1,55 @@ +use strict; +use warnings; +package Nasm::Regs::Format::DC; + +sub format{ + my($regs) = @_; + my $filename = $regs->filename; + + my $out = <DisassemblerClasses; + + for my $class (@classes){ + my @regs = $regs->DisassemblerClass($class); + $out .= sprintf( + "const enum reg_enum nasm_rd_%-8s[%2d] = {", + $class, + scalar @regs + ); + + my @cc = map { 'R_'.uc($_->RegisterName) } @regs; + + $out .= join ',', @cc; + $out .= "};\n"; + } + + + return $out; +} + +1; +__END__ + +# Output regdis.c +print "/* automatically generated from $file - do not edit */\n\n"; +print "#include \"regdis.h\"\n\n"; +foreach $class ( sort(keys(%disclass)) ) { + printf "const enum reg_enum nasm_rd_%-8s[%2d] = {", + $class, scalar @{$disclass{$class}}; + @foo = @{$disclass{$class}}; + @bar = (); + for ( $i = 0 ; $i < scalar(@foo) ; $i++ ) { + if (defined($foo[$i])) { + push(@bar, "R_\U$foo[$i]\E"); + } else { + die "$0: No register name for class $class, value $i\n"; + } + } + print join(',', @bar), "};\n"; +} diff --git a/perl/lib/Nasm/Regs/Format/DH.pm b/perl/lib/Nasm/Regs/Format/DH.pm new file mode 100644 index 00000000..d636a1c9 --- /dev/null +++ b/perl/lib/Nasm/Regs/Format/DH.pm @@ -0,0 +1,47 @@ +use strict; +use warnings; +package Nasm::Regs::Format::DH; + +sub format{ + my($regs) = @_; + my $filename = $regs->filename; + + my $out = <DisassemblerClasses; + + for my $class (@classes){ + my @regs = $regs->DisassemblerClass($class); + $out .= sprintf( + "extern const enum reg_enum nasm_rd_%-8s[%2d];\n", + $class, + scalar @regs + ); + } + + $out .= "\n#endif /* NASM_REGDIS_H */\n"; + + return $out; +} + +1; +__END__ + +# Output regdis.h +print "/* automatically generated from $file - do not edit */\n\n"; +print "#ifndef NASM_REGDIS_H\n"; +print "#define NASM_REGDIS_H\n\n"; +print "#include \"regs.h\"\n\n"; +foreach $class ( sort(keys(%disclass)) ) { + printf "extern const enum reg_enum nasm_rd_%-8s[%2d];\n", + $class, scalar @{$disclass{$class}}; +} +print "\n#endif /* NASM_REGDIS_H */\n"; diff --git a/perl/lib/Nasm/Regs/Format/FC.pm b/perl/lib/Nasm/Regs/Format/FC.pm new file mode 100644 index 00000000..38d76e82 --- /dev/null +++ b/perl/lib/Nasm/Regs/Format/FC.pm @@ -0,0 +1,46 @@ +use strict; +use warnings; +package Nasm::Regs::Format::FC; + +sub format{ + my($regs) = @_; + my $filename = $regs->filename; + + my $out = <names; + + #$out .= qq[ "]; + for my $name (@names){ + my $reg = $regs->Register($name)->AssemblerClass; + $out .= sprintf(" %-15s /* %-5s */\n", $reg, $name) + } + + $out .= "};\n"; + + return $out; +} + +1; + +__END__ +# Output regflags.c +print "/* automatically generated from $file - do not edit */\n\n"; +print "#include \"tables.h\"\n"; +print "#include \"nasm.h\"\n\n"; +print "const int32_t nasm_reg_flags[] = {\n"; +printf " 0,\n"; # Dummy entry for 0 +foreach $reg ( sort(keys(%regs)) ) { +# Print the class of the register +printf " %-15s /* %-5s */\n", +$regs{$reg}.',', $reg; +} +print "};\n"; diff --git a/perl/lib/Nasm/Regs/Format/H.pm b/perl/lib/Nasm/Regs/Format/H.pm new file mode 100644 index 00000000..3920a7c9 --- /dev/null +++ b/perl/lib/Nasm/Regs/Format/H.pm @@ -0,0 +1,78 @@ +use strict; +use warnings; +package Nasm::Regs::Format::H; + + +sub format{ + my($regs) = @_; + my $filename = $regs->filename; + my $out = <names ){ + next unless $name; + my $reg = $regs->{$name}; + $out .= ' R_'.uc($name).$append.",\n"; + + $append = '' if $append; + $count++; + } + $count--; + + $out .= <names ) { + my $register = $regs->Register($name); + + $out .= sprintf + "#define %-15s %2d\n", + 'REG_NUM_'.uc($name), + $register->x86RegisterNumber; + } + return $out; +} + +1; diff --git a/perl/lib/Nasm/Regs/Format/ORDER.pm b/perl/lib/Nasm/Regs/Format/ORDER.pm new file mode 100644 index 00000000..99295675 --- /dev/null +++ b/perl/lib/Nasm/Regs/Format/ORDER.pm @@ -0,0 +1,11 @@ +use strict; +use warnings; +package Nasm::Regs::Format::ORDER; + + +sub format{ + my($regs) = @_; + + join "\n", $regs->RegisterNames; +} +1; diff --git a/perl/lib/Nasm/Regs/Format/VC.pm b/perl/lib/Nasm/Regs/Format/VC.pm new file mode 100644 index 00000000..8ef05141 --- /dev/null +++ b/perl/lib/Nasm/Regs/Format/VC.pm @@ -0,0 +1,43 @@ +use strict; +use warnings; +package Nasm::Regs::Format::VC; + +sub format{ + my($regs) = @_; + my $filename = $regs->filename; + + my $out = <names; + + #$out .= qq[ "]; + for my $name (@names){ + my $reg = $regs->Register($name)->x86RegisterNumber; + $out .= sprintf(" %2d, /* %-5s */\n", $reg, $name) + } + + $out .= "};\n"; + + return $out; +} + +1; +__END__ + +# Output regvals.c +print "/* automatically generated from $file - do not edit */\n\n"; +print "#include \"tables.h\"\n\n"; +print "const int nasm_regvals[] = {\n"; +print " -1,\n"; # Dummy entry for 0 +foreach $reg ( sort(keys(%regs)) ) { + # Print the x86 value of the register + printf " %2d, /* %-5s */\n", $regvals{$reg}, $reg; +} +print "};\n"; diff --git a/perl/lib/Nasm/Regs/Format/YAML.pm b/perl/lib/Nasm/Regs/Format/YAML.pm new file mode 100644 index 00000000..6c6efb21 --- /dev/null +++ b/perl/lib/Nasm/Regs/Format/YAML.pm @@ -0,0 +1,26 @@ +use strict; +use warnings; +package Nasm::Regs::Format::YAML; + +use YAML::XS; + +sub format{ + my($regs) = @_; + + my @names = $regs->RegisterNames; + my %data; + + my $count = 1; + for my $name (@names){ + my $reg = $regs->Register($name); + $data{$name} = { + AssemblerClass => $reg->AssemblerClass, + DisassemberClasses => [$reg->DisassemberClasses], + x86RegisterNumber => $reg->x86RegisterNumber, + Index => $count++ + } + } + + Dump \%data +} +1; diff --git a/perl/lib/Nasm/Regs/Register.pm b/perl/lib/Nasm/Regs/Register.pm new file mode 100644 index 00000000..04ee8814 --- /dev/null +++ b/perl/lib/Nasm/Regs/Register.pm @@ -0,0 +1,41 @@ +use strict; +use warnings; + +package Nasm::Regs::Register; + +sub new{ + my($class,@v) = @_; + $v[0] =~ s/^\s+|\s+$//g; + + my $self = bless \@v, $class; + + return $self; +} + +BEGIN{ + my $i = -1; + for my $sub_name(qw'RegisterName AssemblerClass',undef,'x86RegisterNumber'){ + no strict 'refs'; + $i++; + my $i = $i; + next unless $sub_name; + *$sub_name = sub{ + my($self) = @_; + return $self->[$i]; + } + } +} + +sub DisassemberClasses{ + my($self) = @_; + my @classes; + if( ref $self->[2] ){ + @classes = @{$self->[2]} + }else{ + @classes = $self->[2] + } + return @classes if wantarray; + return \@classes; +} + +1; diff --git a/perl/lib/Nasm/Utils.pm b/perl/lib/Nasm/Utils.pm new file mode 100644 index 00000000..a2723f41 --- /dev/null +++ b/perl/lib/Nasm/Utils.pm @@ -0,0 +1,31 @@ +use strict; +use warnings; +package Nasm::Utils; + +use base 'Exporter'; + +our @EXPORT_OK = qw{ + str2hex + addprefix +}; + + +# Turn a numeric list into a hex string +sub str2hex(@){ + my @return = map {sprintf("%02X", $_)} @_; + + return @return if wantarray; + return join '', @return; +} + +sub addprefix ($@) { + my ($prefix, @list) = @_; + my @return = map { + sprintf("%s%02X", $prefix, $_) + } @list; + + return @return if wantarray; + die "Don't know what to do in scalar context."; +} + +1; diff --git a/perl/lib/nasm/crc64.pm b/perl/lib/Nasm/crc64.pm similarity index 100% rename from perl/lib/nasm/crc64.pm rename to perl/lib/Nasm/crc64.pm diff --git a/perl/lib/Nasm/insns.pm b/perl/lib/Nasm/insns.pm new file mode 100644 index 00000000..b4845906 --- /dev/null +++ b/perl/lib/Nasm/insns.pm @@ -0,0 +1,87 @@ +package Nasm::insns; +use strict; +use warnings; + +use base 'Exporter'; + +require Nasm::insns::Operands; +require Nasm::insns::Flags; + +# Opcode prefixes which need their own opcode tables +# LONGER PREFIXES FIRST! +our @disasm_prefixes = qw(0F24 0F25 0F38 0F3A 0F7A 0FA6 0FA7 0F); + +# This should match MAX_OPERANDS from nasm.h +our $MAX_OPERANDS = 5; + +# Add VEX prefixes +our @vexlist; +for( my $m = 0; $m < 32; $m++ ){ + for( my $lp = 0; $lp < 8; $lp++ ){ + push(@vexlist, sprintf("VEX%02X%01X", $m, $lp)); + } +} +@disasm_prefixes = (@vexlist, @disasm_prefixes); + +our @bytecode_count = (0) x 256; + +sub new{ + my($class,$filename) = @_; + + my $self = bless {}, $class; + + if($filename){ + $self->ProcessFile($filename); + } + + return $self; +} + +sub ProcessFile{ + my( $self, $filename ) = @_; + open( my $file, '<', $filename ) || die "unable to open $filename"; + + $self->{filename} = $filename; + + my $line_number = 0; + while( my $line = <$file> ){ + $line_number++; + chomp $line; + + # /^\s*(?:;\#)(.*)$/ # special lines + next if $line =~ /^\s*(?:;|$)/ ; # comments or blank lines + + $self->ProcessLine($line,$line_number); + } +} + +sub ProcessLine{ + my( $self, $line, $line_number ) = @_; + + unless( $line =~ m{ + ^\s*+ + (\S+)\s++ + (\S+)\s++ + ( + \[.*?\] | + \S+ + )\s++ + (\S++)\s*+ + $ + }x){ + die; + } + + my($name,$operands,$code_string,$flags) = ($1,$2,$3,$4); + + my $op_obj = Nasm::insns::Operands->new($operands); + my $flag_obj = Nasm::insns::Flags->new($flags); + + my $ref = $self->{ops}{$name.':'.$op_obj->string} = { + operands => $op_obj, + flags => $flag_obj, + codestring => $code_string + }; +} + +1; diff --git a/perl/lib/Nasm/insns/Flags.pm b/perl/lib/Nasm/insns/Flags.pm new file mode 100644 index 00000000..9a7ad9c4 --- /dev/null +++ b/perl/lib/Nasm/insns/Flags.pm @@ -0,0 +1,162 @@ +package Nasm::insns::Flags; +use strict; +use warnings; +use YAML::XS ':all'; + +#our @arch = qw{ +# AMD +# 8086 186 286 386 486 +# X64 X86_64 PENT CYRIX P6 IA64 +# PRESCOTT +# FPU +# MMX SSE SSE2 3DNOW +#}; + +our( %map2id, %also_enable, @arch); + +# load up variables from the data below __DATA__ +{ + my @yaml_streams; + { + open( my $data, '<&DATA' ) or die; + seek( $data, 0, 0 ); + + { + # seek to end of Perl code + local $/ = "\n__DATA__\n"; + scalar <$data>; + } + { + # split the embedded YAML code on '...' + local $/ = "\n...\n"; + @yaml_streams = <$data>; + } + close $data; + } + + use Data::Dump 'dump'; + use 5.010; + use Scalar::Util qw'reftype'; + + my $dir = Load $yaml_streams[0]; + for my $variable_name ( keys %$dir ){ + my $index = $dir->{$variable_name}; + + $variable_name =~ s/^([%@\$])//; + my $type = $1; + + no strict qw'refs'; + no warnings qw'once'; + + # load on demand + my $ref = Load $yaml_streams[$index] or + warn "unable to load YAML item \"$variable_name\"\n"; + + my $reftype = reftype $ref; + my %type_map = ( + HASH => '%', + ARRAY => '@' + ); + + $type ||= $type_map{$reftype}; + + if( $type eq '%' ){ + die unless $reftype eq 'HASH'; + %{*$variable_name} = %$ref; + }elsif( $type eq '@' ){ + die unless $reftype eq 'ARRAY'; + @{*$variable_name} = @$ref; + } + } +} + +#use 5.010; +#use Data::Dump 'dump'; +# +#say dump $_ for ( \%map2id, \%also_enable, \@arch); +# end of initialization + + + + + + +sub new{ + my( $class, $string ) = @_; + + my $self = bless [], $class; + + $string =~ s/^ \s+ //gx; + $string =~ s/ \s+ $//gx; + + return $self unless $string; + return $self if $string eq 'ignore'; + + @$self = split ',', $string; + + return $self; +} + +1; + +# +# All YAML streams must be seperated by a single "..." line +# +# The first YAML stream should start immediately after the __DATA__ line +# +# The first YAML stream is the dir stream, it is used to map the global variable +# to the YAML stream +# +__DATA__ +--- +# "global variable": "YAML stream number" +# all of the following global variables should have been +# defined with "our %global" at the top of the file +# +# any stream not referenced here will not be loaded +"%map2id": 1 +"%also_enable": 3 +"@arch": 4 +... +--- +# "external name": "internal id" +PENT: Pentium +80186: 186 +80286: 286 +80386: 386 +... +--- +# "internal id": "external name" +# if an internal id is not in this stream +# then use the internal id for external name +Pentium: PENT +... +--- +# when Pentium is enabled: 486 is also enabled +# which then enables 386, etc +Pentium: +- 486 +486: +- 386 +386: +- 286 +286: +- 186 +186: +- 8086 +... +--- +- KATMAI +- PRESCOTT +- NEHALEM +- WILLAMETTE +- WESTMERE +- SANDYBRIDGE +- SSE +- SSE2 +- SSE3 +- SSE4A +- SSE41 +- SSE42 +- SSE5 +... diff --git a/perl/lib/Nasm/insns/Operands.pm b/perl/lib/Nasm/insns/Operands.pm new file mode 100644 index 00000000..0b3e8806 --- /dev/null +++ b/perl/lib/Nasm/insns/Operands.pm @@ -0,0 +1,35 @@ +package Nasm::insns::Operands; +use strict; +use warnings; +use Scalar::Util 'reftype'; + +sub new{ + my( $class, $string ) = @_; + $string =~ s/^ \s+ //gx; + $string =~ s/ \s+ $//gx; + + if( $string eq 'ignore' ){ + return bless \$string, $class; + } + + my $self = bless [], $class; + + + return $self unless $string; + return $self if $string eq 'void'; + + @$self = split ',', $string; + + return $self; +} + +sub string{ + my( $self ) = @_; + + return '' if reftype $self eq 'SCALAR'; + return '' if reftype $self eq 'REF'; + + #return '()' unless @$self; + return '('.join(',',@$self).')'; +} +1; diff --git a/perl/regs.pl b/perl/regs.pl new file mode 100755 index 00000000..83af05ab --- /dev/null +++ b/perl/regs.pl @@ -0,0 +1,41 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use lib 'lib'; + +=head + +reads a file with columns: + +register name, assembler class, disassembler class(es), x86 register number + + +outputs in formats: + +h c fc vc dc dh + + +regs.pl [output format] [input filename] + +=cut + +use Nasm::Regs; + +my ($format,$filename) = @ARGV; +$filename ||= 'regs.dat'; + +unless($format){ + print help(); + exit; +} + +my $self = Nasm::Regs->new($filename); + +my $str = $self->format($format); +print $str; +print "\n" unless $str =~ /\n\Z/; + +sub help{ + "$0 [output format] [input filename]\n" +} diff --git a/perl/t/regs/basic.t b/perl/t/regs/basic.t new file mode 100644 index 00000000..a7b4af20 --- /dev/null +++ b/perl/t/regs/basic.t @@ -0,0 +1,296 @@ +use strict; +use warnings; +use YAML::XS ':all'; + +use Test::More tests => 1; +#eval "use Test::More 'tests' => ".(3 * scalar keys %test); +die $@ if $@; + +my($yaml_cmp,$dat_stream); +{ + my $yaml_stream; + local $/ = "\n...\n"; + ($dat_stream,$yaml_stream) = ; + chomp $dat_stream; + $yaml_cmp = Load($yaml_stream); +} + +my $got_yaml = Load( scalar `echo "$dat_stream" | perl regs.pl yaml -` ); + + +#my( $dat_file, $yamlfile ); +#($dat_file = $0) =~ s/\.t$/.dat/; +#($yamlfile = $0) =~ s/\.t$/.yml/; +# +#my $str = `perl regs.pl yaml $dat_file`; +#my $yaml = Load $str; + +for my $elem (values %$got_yaml){ + delete $elem->{Index}; +} + +is_deeply( $got_yaml, $yaml_cmp); + +__DATA__ +# General-purpose registers +al REG_AL reg8,reg8_rex 0 +ah REG_HIGH reg8 4 +ax REG_AX reg16 0 +eax REG_EAX reg32 0 +rax REG_RAX reg64 0 +bl REG8NA reg8,reg8_rex 3 +bh REG_HIGH reg8 7 +bx REG16NA reg16 3 +ebx REG32NA reg32 3 +rbx REG64NA reg64 3 +cl REG_CL reg8,reg8_rex 1 +ch REG_HIGH reg8 5 +cx REG_CX reg16 1 +ecx REG_ECX reg32 1 +rcx REG_RCX reg64 1 +dl REG_DL reg8,reg8_rex 2 +dh REG_HIGH reg8 6 +dx REG_DX reg16 2 +edx REG_EDX reg32 2 +rdx REG_RDX reg64 2 +spl REG8NA reg8_rex 4 +sp REG16NA reg16 4 +esp REG32NA reg32 4 +rsp REG64NA reg64 4 +bpl REG8NA reg8_rex 5 +bp REG16NA reg16 5 +ebp REG32NA reg32 5 +rbp REG64NA reg64 5 +sil REG8NA reg8_rex 6 +si REG16NA reg16 6 +esi REG32NA reg32 6 +rsi REG64NA reg64 6 +dil REG8NA reg8_rex 7 +di REG16NA reg16 7 +edi REG32NA reg32 7 +rdi REG64NA reg64 7 + +# Segment registers +cs REG_CS sreg 1 +ds REG_DESS sreg 3 +es REG_DESS sreg 0 +ss REG_DESS sreg 2 +fs REG_FSGS sreg 4 +gs REG_FSGS sreg 5 +... +--- +ah: + AssemblerClass: REG_HIGH + DisassemberClasses: + - reg8 + x86RegisterNumber: 4 +al: + AssemblerClass: REG_AL + DisassemberClasses: + - reg8 + - reg8_rex + x86RegisterNumber: 0 +ax: + AssemblerClass: REG_AX + DisassemberClasses: + - reg16 + x86RegisterNumber: 0 +bh: + AssemblerClass: REG_HIGH + DisassemberClasses: + - reg8 + x86RegisterNumber: 7 +bl: + AssemblerClass: REG8NA + DisassemberClasses: + - reg8 + - reg8_rex + x86RegisterNumber: 3 +bp: + AssemblerClass: REG16NA + DisassemberClasses: + - reg16 + x86RegisterNumber: 5 +bpl: + AssemblerClass: REG8NA + DisassemberClasses: + - reg8_rex + x86RegisterNumber: 5 +bx: + AssemblerClass: REG16NA + DisassemberClasses: + - reg16 + x86RegisterNumber: 3 +ch: + AssemblerClass: REG_HIGH + DisassemberClasses: + - reg8 + x86RegisterNumber: 5 +cl: + AssemblerClass: REG_CL + DisassemberClasses: + - reg8 + - reg8_rex + x86RegisterNumber: 1 +cs: + AssemblerClass: REG_CS + DisassemberClasses: + - sreg + x86RegisterNumber: 1 +cx: + AssemblerClass: REG_CX + DisassemberClasses: + - reg16 + x86RegisterNumber: 1 +dh: + AssemblerClass: REG_HIGH + DisassemberClasses: + - reg8 + x86RegisterNumber: 6 +di: + AssemblerClass: REG16NA + DisassemberClasses: + - reg16 + x86RegisterNumber: 7 +dil: + AssemblerClass: REG8NA + DisassemberClasses: + - reg8_rex + x86RegisterNumber: 7 +dl: + AssemblerClass: REG_DL + DisassemberClasses: + - reg8 + - reg8_rex + x86RegisterNumber: 2 +ds: + AssemblerClass: REG_DESS + DisassemberClasses: + - sreg + x86RegisterNumber: 3 +dx: + AssemblerClass: REG_DX + DisassemberClasses: + - reg16 + x86RegisterNumber: 2 +eax: + AssemblerClass: REG_EAX + DisassemberClasses: + - reg32 + x86RegisterNumber: 0 +ebp: + AssemblerClass: REG32NA + DisassemberClasses: + - reg32 + x86RegisterNumber: 5 +ebx: + AssemblerClass: REG32NA + DisassemberClasses: + - reg32 + x86RegisterNumber: 3 +ecx: + AssemblerClass: REG_ECX + DisassemberClasses: + - reg32 + x86RegisterNumber: 1 +edi: + AssemblerClass: REG32NA + DisassemberClasses: + - reg32 + x86RegisterNumber: 7 +edx: + AssemblerClass: REG_EDX + DisassemberClasses: + - reg32 + x86RegisterNumber: 2 +es: + AssemblerClass: REG_DESS + DisassemberClasses: + - sreg + x86RegisterNumber: 0 +esi: + AssemblerClass: REG32NA + DisassemberClasses: + - reg32 + x86RegisterNumber: 6 +esp: + AssemblerClass: REG32NA + DisassemberClasses: + - reg32 + x86RegisterNumber: 4 +fs: + AssemblerClass: REG_FSGS + DisassemberClasses: + - sreg + x86RegisterNumber: 4 +gs: + AssemblerClass: REG_FSGS + DisassemberClasses: + - sreg + x86RegisterNumber: 5 +rax: + AssemblerClass: REG_RAX + DisassemberClasses: + - reg64 + x86RegisterNumber: 0 +rbp: + AssemblerClass: REG64NA + DisassemberClasses: + - reg64 + x86RegisterNumber: 5 +rbx: + AssemblerClass: REG64NA + DisassemberClasses: + - reg64 + x86RegisterNumber: 3 +rcx: + AssemblerClass: REG_RCX + DisassemberClasses: + - reg64 + x86RegisterNumber: 1 +rdi: + AssemblerClass: REG64NA + DisassemberClasses: + - reg64 + x86RegisterNumber: 7 +rdx: + AssemblerClass: REG_RDX + DisassemberClasses: + - reg64 + x86RegisterNumber: 2 +rsi: + AssemblerClass: REG64NA + DisassemberClasses: + - reg64 + x86RegisterNumber: 6 +rsp: + AssemblerClass: REG64NA + DisassemberClasses: + - reg64 + x86RegisterNumber: 4 +si: + AssemblerClass: REG16NA + DisassemberClasses: + - reg16 + x86RegisterNumber: 6 +sil: + AssemblerClass: REG8NA + DisassemberClasses: + - reg8_rex + x86RegisterNumber: 6 +sp: + AssemblerClass: REG16NA + DisassemberClasses: + - reg16 + x86RegisterNumber: 4 +spl: + AssemblerClass: REG8NA + DisassemberClasses: + - reg8_rex + x86RegisterNumber: 4 +ss: + AssemblerClass: REG_DESS + DisassemberClasses: + - sreg + x86RegisterNumber: 2 +... diff --git a/perl/t/regs/list.t b/perl/t/regs/list.t new file mode 100644 index 00000000..915468e3 --- /dev/null +++ b/perl/t/regs/list.t @@ -0,0 +1,115 @@ +use strict; +use warnings; +use YAML::XS ':all'; + + +use Test::More tests => 1; +#eval "use Test::More 'tests' => ".(3 * scalar keys %test); +die $@ if $@; + + +my $reference; +my $dat_string; +{ + local $/ = "...\n"; + my $datastream; + + ($datastream,$dat_string) = ; + $reference = Load($datastream); +} + +my $got_str = `echo "$dat_string" | perl regs.pl yaml -`; + +my $yaml = Load $got_str; + +for my $elem (values %$yaml){ + delete $elem->{Index}; +} + +is_deeply $yaml, $reference; + +__DATA__ +--- +xmm0: + AssemblerClass: XMM0 + DisassemberClasses: + - xmmreg + x86RegisterNumber: 0 +xmm1: + AssemblerClass: XMMREG + DisassemberClasses: + - xmmreg + x86RegisterNumber: 1 +xmm10: + AssemblerClass: XMMREG + DisassemberClasses: + - xmmreg + x86RegisterNumber: 10 +xmm11: + AssemblerClass: XMMREG + DisassemberClasses: + - xmmreg + x86RegisterNumber: 11 +xmm12: + AssemblerClass: XMMREG + DisassemberClasses: + - xmmreg + x86RegisterNumber: 12 +xmm13: + AssemblerClass: XMMREG + DisassemberClasses: + - xmmreg + x86RegisterNumber: 13 +xmm14: + AssemblerClass: XMMREG + DisassemberClasses: + - xmmreg + x86RegisterNumber: 14 +xmm15: + AssemblerClass: XMMREG + DisassemberClasses: + - xmmreg + x86RegisterNumber: 15 +xmm2: + AssemblerClass: XMMREG + DisassemberClasses: + - xmmreg + x86RegisterNumber: 2 +xmm3: + AssemblerClass: XMMREG + DisassemberClasses: + - xmmreg + x86RegisterNumber: 3 +xmm4: + AssemblerClass: XMMREG + DisassemberClasses: + - xmmreg + x86RegisterNumber: 4 +xmm5: + AssemblerClass: XMMREG + DisassemberClasses: + - xmmreg + x86RegisterNumber: 5 +xmm6: + AssemblerClass: XMMREG + DisassemberClasses: + - xmmreg + x86RegisterNumber: 6 +xmm7: + AssemblerClass: XMMREG + DisassemberClasses: + - xmmreg + x86RegisterNumber: 7 +xmm8: + AssemblerClass: XMMREG + DisassemberClasses: + - xmmreg + x86RegisterNumber: 8 +xmm9: + AssemblerClass: XMMREG + DisassemberClasses: + - xmmreg + x86RegisterNumber: 9 +... +xmm0 XMM0 xmmreg 0 +xmm1-15 XMMREG xmmreg 1 diff --git a/perl/t/regs/order.t b/perl/t/regs/order.t new file mode 100644 index 00000000..7b91c12e --- /dev/null +++ b/perl/t/regs/order.t @@ -0,0 +1,138 @@ +use strict; +use warnings; +use YAML::XS ':all'; + +use Test::More tests => 5; +#eval "use Test::More 'tests' => ".(3 * scalar keys %test); +die $@ if $@; + + +my($dat_stream,@array); +{ + local $/ = "\n...\n"; + my $array; + ($array,$dat_stream) = ; + chomp $dat_stream; + chomp $array; + $array =~ s/^\s+//; + + (@array) = split '\s+', $array; +} + +for( 1..5 ){ + my @order = split '\n', `echo "$dat_stream" | perl regs.pl order -`; + is_deeply \@order, \@array; +} +__DATA__ + ah al ax bh bl bp bpl bx ch cl + cr0 cr1 cr10 cr11 cr12 cr13 cr14 cr15 cr2 cr3 cr4 cr5 cr6 cr7 cr8 cr9 + cs cx dh di dil dl + dr0 dr1 dr10 dr11 dr12 dr13 dr14 dr15 dr2 dr3 dr4 dr5 dr6 dr7 dr8 dr9 + ds dx + eax ebp ebx ecx edi edx es esi esp + fs gs + mm0 mm1 mm2 mm3 mm4 mm5 mm6 mm7 + r10 r10b r10d r10w + r11 r11b r11d r11w + r12 r12b r12d r12w + r13 r13b r13d r13w + r14 r14b r14d r14w + r15 r15b r15d r15w + r8 r8b r8d r8w + r9 r9b r9d r9w + rax rbp rbx rcx rdi rdx rsi rsp + segr6 segr7 + si sil sp spl ss + st0 st1 st2 st3 st4 st5 st6 st7 + tr0 tr1 tr2 tr3 tr4 tr5 tr6 tr7 + xmm0 xmm1 xmm10 xmm11 xmm12 xmm13 xmm14 xmm15 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7 xmm8 xmm9 + ymm0 ymm1 ymm10 ymm11 ymm12 ymm13 ymm14 ymm15 ymm2 ymm3 ymm4 ymm5 ymm6 ymm7 ymm8 ymm9 +... +# +# List of registers and their classes; classes are defined in nasm.h +# +# The columns are: +# +# register name, assembler class, disassembler class(es), x86 register number +# +# If the register name ends in two numbers separated by a dash, then it is +# repeated as many times as indicated, and the register number is +# updated with it. +# + +# General-purpose registers +al REG_AL reg8,reg8_rex 0 +ah REG_HIGH reg8 4 +ax REG_AX reg16 0 +eax REG_EAX reg32 0 +rax REG_RAX reg64 0 +bl REG8NA reg8,reg8_rex 3 +bh REG_HIGH reg8 7 +bx REG16NA reg16 3 +ebx REG32NA reg32 3 +rbx REG64NA reg64 3 +cl REG_CL reg8,reg8_rex 1 +ch REG_HIGH reg8 5 +cx REG_CX reg16 1 +ecx REG_ECX reg32 1 +rcx REG_RCX reg64 1 +dl REG_DL reg8,reg8_rex 2 +dh REG_HIGH reg8 6 +dx REG_DX reg16 2 +edx REG_EDX reg32 2 +rdx REG_RDX reg64 2 +spl REG8NA reg8_rex 4 +sp REG16NA reg16 4 +esp REG32NA reg32 4 +rsp REG64NA reg64 4 +bpl REG8NA reg8_rex 5 +bp REG16NA reg16 5 +ebp REG32NA reg32 5 +rbp REG64NA reg64 5 +sil REG8NA reg8_rex 6 +si REG16NA reg16 6 +esi REG32NA reg32 6 +rsi REG64NA reg64 6 +dil REG8NA reg8_rex 7 +di REG16NA reg16 7 +edi REG32NA reg32 7 +rdi REG64NA reg64 7 +r8-15b REG8NA reg8_rex 8 +r8-15w REG16NA reg16 8 +r8-15d REG32NA reg32 8 +r8-15 REG64NA reg64 8 + +# Segment registers +cs REG_CS sreg 1 +ds REG_DESS sreg 3 +es REG_DESS sreg 0 +ss REG_DESS sreg 2 +fs REG_FSGS sreg 4 +gs REG_FSGS sreg 5 +segr6-7 REG_SEG67 sreg 6 + +# Control registers +cr0-15 REG_CREG creg 0 + +# Debug registers +dr0-15 REG_DREG dreg 0 + +# Test registers +tr0-7 REG_TREG treg 0 + +# Floating-point registers +st0 FPU0 fpureg 0 +st1-7 FPUREG fpureg 1 + +# MMX registers +mm0-7 MMXREG mmxreg 0 + +# SSE registers +xmm0 XMM0 xmmreg 0 +xmm1-15 XMMREG xmmreg 1 + +# AVX registers +ymm0 YMM0 ymmreg 0 +ymm1-15 YMMREG ymmreg 1 +... + diff --git a/perl/t/version/dump.t b/perl/t/version/dump.t index cd5fdf93..f6f5e6da 100644 --- a/perl/t/version/dump.t +++ b/perl/t/version/dump.t @@ -5,7 +5,7 @@ use warnings; use lib qw't ..'; use version::input; -our %test = version::input::load( +our %test = load( 'all' ); @@ -29,3 +29,5 @@ for my $test ( sort keys %test ){ chomp $xid; is $xid, $expected->{xid}, $test.'->{xid}'; } +__DATA__ +1234 diff --git a/perl/t/version/input.yml b/perl/t/version/input.pm similarity index 51% rename from perl/t/version/input.yml rename to perl/t/version/input.pm index 0eaa584a..6eeb6e32 100644 --- a/perl/t/version/input.yml +++ b/perl/t/version/input.pm @@ -1,3 +1,122 @@ +package version::input; +use strict; +use warnings; +use YAML::XS ':all'; + +use base 'Exporter'; +our @EXPORT = 'load'; + + +BEGIN{ + eval{ require feature; feature->import('switch') } or + eval{ require Switch; Switch->import('Perl6')} or + die "can't find module for 'given' 'when'"; + + use Scalar::Util 'reftype'; +} + + +our( %test ); +{ + # reopen file handle; + open DATA_DUP, '<&DATA'; + seek( DATA_DUP, 0, 0 ); + + { + # seek to end of Perl code + local $/ = "\n__DATA__\n"; + scalar ; + } + + my $yaml_stream = do{ + # read the embedded YAML code + local $/ = "\n...\n"; + scalar ; + }; + close DATA_DUP; + + %test = %{Load($yaml_stream)}; +} + +# load add => {key=>'default'}, map=>{}, filter=>[] +sub load{ + local( $_, %_ ); + #my($add,$filter,$map,$all); + my( @filter, %map, $all ); + + my %return; + while( my $next = shift ){ + given( $next ){ + when( 'map' ){ + my $hashref = shift; + my @keys = keys %$hashref; + @map{@keys} = @$hashref{@keys}; + } + when( 'filter' ){ push @filter, @{shift @_} } + when( 'all' ){ $all = 1; last } + default{ die } + } + } + + for my $version(keys %test){ + my %details = %{$test{$version}}; + + + if($all){ + # if $all is set, the caller wanted everything + $return{$version} = {%details}; + }else{ + # initialize $current; + my $current = $return{$version} = {}; + + # pseudo element {version} + $details{version} = $version; + + # filter + # + # any element listed here will be added to the output + for my $add (@filter){ + if('+' eq substr $add, 0, 1){ + # forced to exist + $add = substr $add, 1; + $current->{$add} = $details{$add} + }else{ + # pass it on only if the element is defined + $current->{$add} = $details{$add} if defined $details{$add}; + } + } + + # map + for my $id( keys %map ){ + my $ref = $map{$id}; + + given( reftype $ref ){ + when(undef){ $current->{$id} = $details{$ref} } + when('CODE'){ + %_ = %details; + local $_ = $details{$id}; + + my $return = $ref->( + $id, + $details{$id}, + $version, + {%details} + ); + + $current->{$id} = $return; + } + default{ die } + } + } + } + } + + + return %return if wantarray; + return \%return; +} +1; +__DATA__ --- # currently must only have what would be output with version.pl dump 0.98.09b: @@ -145,4 +264,6 @@ patchlevel: 98 rc: 8 subminor: 99 +... + -- 2.11.4.GIT