Asm-X86
view release on metacpan or search on metacpan
lib/Asm/X86.pm view on Meta::CPAN
=cut
# =head2 _add_percent
#
# PRIVATE SUBROUTINE.
# Add a percent character ('%') in front of each element in the array given as a parameter.
# Returns the new array.
#
# =cut
sub _add_percent(@) {
my @result = ();
foreach (@_) {
push @result, "%$_";
}
return @result;
}
# =head2 _remove_duplicates
#
# PRIVATE SUBROUTINE.
# Returns an array of the provided arguments with duplicate entries removed.
#
# =cut
#
sub _remove_duplicates(@) {
# Use a hash to remove the duplicates:
my %new_hash;
foreach (@_) {
$new_hash{$_} = 1;
}
return keys %new_hash;
}
# =head2 _nopluses
#
# PRIVATE SUBROUTINE.
# Removes unnecessary '+' characters from the beginning of the given string.
# Returns the resulting string (or '+' if it was empty).
#
# =cut
#
sub _nopluses($) {
my $elem = shift;
$elem =~ s/^\s*\++//o;
$elem = '+' if $elem eq '';
return $elem;
}
# =head2 _is_in_array
#
# PRIVATE SUBROUTINE.
# Checks if the given element (1st parameter) is a simple word and is present
# in the array (passed by reference as the 2nd parameter),
# case-insensitive.
# Returns 1 if yes.
#
# =cut
#
sub _is_in_array($@) {
my $elem = shift;
my $arr = shift;
return 0 unless $elem =~ /^\w+$/o;
foreach (@$arr) {
return 1 if /^$elem$/i;
}
return 0;
}
# =head2 _is_in_array_att
#
# PRIVATE SUBROUTINE.
# Checks if the given element (1st parameter) is a simple word beginning
# with '%' and is present in the array (passed by reference as the 2nd
# parameter), case-insensitive.
# Returns 1 if yes.
#
# =cut
#
sub _is_in_array_att($@) {
my $elem = shift;
my $arr = shift;
return 0 unless $elem =~ /^\%\w+$/o;
foreach (@$arr) {
return 1 if /^$elem$/i;
}
return 0;
}
sub add_att_suffix_instr(@);
=head2 @regs8_intel
A list of 8-bit registers (as strings) in Intel syntax.
=cut
our @regs8_intel = (
'al', 'bl', 'cl', 'dl', 'r8b', 'r9b', 'r10b', 'r11b',
'r12b', 'r13b', 'r14b', 'r15b', 'sil', 'dil', 'spl', 'bpl',
lib/Asm/X86.pm view on Meta::CPAN
=head1 FUNCTIONS
=head2 is_reg_intel
Checks if the given string parameter is a valid x86 register (any size) in Intel syntax.
Returns 1 if yes.
=cut
sub is_reg_intel($) {
return _is_in_array (shift, \@regs_intel);
}
=head2 is_reg_att
Checks if the given string parameter is a valid x86 register (any size) in AT&T syntax.
Returns 1 if yes.
=cut
sub is_reg_att($) {
return _is_in_array_att (shift, \@regs_att);
}
=head2 is_reg
Checks if the given string parameter is a valid x86 register (any size).
Returns 1 if yes.
=cut
sub is_reg($) {
my $elem = shift;
return is_reg_intel ($elem) | is_reg_att ($elem);
}
=head2 is_reg8_intel
Checks if the given string parameter is a valid x86 8-bit register in Intel syntax.
Returns 1 if yes.
=cut
sub is_reg8_intel($) {
return _is_in_array (shift, \@regs8_intel);
}
=head2 is_reg8_att
Checks if the given string parameter is a valid x86 8-bit register in AT&T syntax.
Returns 1 if yes.
=cut
sub is_reg8_att($) {
return _is_in_array_att (shift, \@regs8_att);
}
=head2 is_reg8
Checks if the given string parameter is a valid x86 8-bit register.
Returns 1 if yes.
=cut
sub is_reg8($) {
my $elem = shift;
return is_reg8_intel ($elem) | is_reg8_att ($elem);
}
=head2 is_reg16_intel
Checks if the given string parameter is a valid x86 16-bit register in Intel syntax.
Returns 1 if yes.
=cut
sub is_reg16_intel($) {
return _is_in_array (shift, \@regs16_intel);
}
=head2 is_reg16_att
Checks if the given string parameter is a valid x86 16-bit register in AT&T syntax.
Returns 1 if yes.
=cut
sub is_reg16_att($) {
return _is_in_array_att (shift, \@regs16_att);
}
=head2 is_reg16
Checks if the given string parameter is a valid x86 16-bit register.
Returns 1 if yes.
=cut
sub is_reg16($) {
my $elem = shift;
return is_reg16_intel ($elem) | is_reg16_att ($elem);
}
=head2 is_segreg_intel
Checks if the given string parameter is a valid x86 segment register in Intel syntax.
Returns 1 if yes.
=cut
sub is_segreg_intel($) {
return _is_in_array (shift, \@segregs_intel);
}
=head2 is_segreg_att
Checks if the given string parameter is a valid x86 segment register in AT&T syntax.
Returns 1 if yes.
=cut
sub is_segreg_att($) {
return _is_in_array_att (shift, \@segregs_att);
}
=head2 is_segreg
Checks if the given string parameter is a valid x86 segment register.
Returns 1 if yes.
=cut
sub is_segreg($) {
my $elem = shift;
return is_segreg_intel ($elem) | is_segreg_att ($elem);
}
=head2 is_reg32_intel
Checks if the given string parameter is a valid x86 32-bit register in Intel syntax.
Returns 1 if yes.
=cut
sub is_reg32_intel($) {
return _is_in_array (shift, \@regs32_intel);
}
=head2 is_reg32_att
Checks if the given string parameter is a valid x86 32-bit register in AT&T syntax.
Returns 1 if yes.
=cut
sub is_reg32_att($) {
return _is_in_array_att (shift, \@regs32_att);
}
=head2 is_reg32
Checks if the given string parameter is a valid x86 32-bit register.
Returns 1 if yes.
=cut
sub is_reg32($) {
my $elem = shift;
return is_reg32_intel ($elem) | is_reg32_att ($elem);
}
=head2 is_addressable32_intel
Checks if the given string parameter is a valid x86 32-bit register which can be used
for addressing in Intel syntax.
Returns 1 if yes.
=cut
sub is_addressable32_intel($) {
return _is_in_array (shift, \@addressable32);
}
=head2 is_addressable32_att
Checks if the given string parameter is a valid x86 32-bit register which can be used
for addressing in AT&T syntax.
Returns 1 if yes.
=cut
sub is_addressable32_att($) {
return _is_in_array_att (shift, \@addressable32_att);
}
=head2 is_addressable32
Checks if the given string parameter is a valid x86 32-bit register which can be used
for addressing.
Returns 1 if yes.
=cut
sub is_addressable32($) {
my $elem = shift;
return is_addressable32_intel ($elem) | is_addressable32_att ($elem);
}
=head2 is_r32_in64_intel
Checks if the given string parameter is a valid x86 32-bit register which can only be used
in 64-bit mode (that is, checks if the given string parameter is a 32-bit
subregister of a 64-bit register).
Returns 1 if yes.
=cut
sub is_r32_in64_intel($) {
return _is_in_array (shift, \@r32_in64);
}
=head2 is_r32_in64_att
Checks if the given string parameter is a valid x86 32-bit register in Intel syntax
which can only be used in 64-bit mode (that is, checks if the given string
parameter is a 32-bit subregister of a 64-bit register).
Returns 1 if yes.
=cut
sub is_r32_in64_att($) {
return _is_in_array_att (shift, \@r32_in64_att);
}
=head2 is_r32_in64
Checks if the given string parameter is a valid x86 32-bit register in AT&T syntax
which can only be used in 64-bit mode (that is, checks if the given string
parameter is a 32-bit subregister of a 64-bit register).
Returns 1 if yes.
=cut
sub is_r32_in64($) {
my $elem = shift;
return is_r32_in64_intel ($elem) | is_r32_in64_att ($elem);
}
=head2 is_reg64_intel
Checks if the given string parameter is a valid x86 64-bit register in Intel syntax.
Returns 1 if yes.
=cut
sub is_reg64_intel($) {
return _is_in_array (shift, \@regs64_intel);
}
=head2 is_reg64_att
Checks if the given string parameter is a valid x86 64-bit register in AT&T syntax.
Returns 1 if yes.
=cut
sub is_reg64_att($) {
return _is_in_array_att (shift, \@regs64_att);
}
=head2 is_reg64
Checks if the given string parameter is a valid x86 64-bit register.
Returns 1 if yes.
=cut
sub is_reg64($) {
my $elem = shift;
return is_reg64_intel ($elem) | is_reg64_att ($elem);
}
=head2 is_reg_mm_intel
Checks if the given string parameter is a valid x86 multimedia (MMX/3DNow!/SSEn)
register in Intel syntax.
Returns 1 if yes.
=cut
sub is_reg_mm_intel($) {
return _is_in_array (shift, \@regs_mm_intel);
}
=head2 is_reg_mm_att
Checks if the given string parameter is a valid x86 multimedia (MMX/3DNow!/SSEn)
register in AT&T syntax.
Returns 1 if yes.
=cut
sub is_reg_mm_att($) {
return _is_in_array_att (shift, \@regs_mm_att);
}
=head2 is_reg_mm
Checks if the given string parameter is a valid x86 multimedia (MMX/3DNow!/SSEn) register.
Returns 1 if yes.
=cut
sub is_reg_mm($) {
my $elem = shift;
return is_reg_mm_intel ($elem) | is_reg_mm_att ($elem);
}
=head2 is_reg_fpu_intel
Checks if the given string parameter is a valid x86 FPU register in Intel syntax.
Returns 1 if yes.
=cut
sub is_reg_fpu_intel($) {
return _is_in_array (shift, \@regs_fpu_intel);
}
=head2 is_reg_fpu_att
Checks if the given string parameter is a valid x86 FPU register in AT&T syntax.
Returns 1 if yes.
=cut
sub is_reg_fpu_att($) {
return _is_in_array_att (shift, \@regs_fpu_att);
}
=head2 is_reg_fpu
Checks if the given string parameter is a valid x86 FPU register.
Returns 1 if yes.
=cut
sub is_reg_fpu($) {
my $elem = shift;
return is_reg_fpu_intel ($elem) | is_reg_fpu_att ($elem);
}
=head2 is_reg_opmask_intel
Checks if the given string parameter is a valid x86 opmask register in Intel syntax.
Returns 1 if yes.
=cut
sub is_reg_opmask_intel($) {
return _is_in_array (shift, \@regs_opmask_intel);
}
=head2 is_reg_opmask_att
Checks if the given string parameter is a valid x86 opmask register in AT&T syntax.
Returns 1 if yes.
=cut
sub is_reg_opmask_att($) {
return _is_in_array_att (shift, \@regs_opmask_att);
}
=head2 is_reg_opmask
Checks if the given string parameter is a valid x86 opmask register.
Returns 1 if yes.
=cut
sub is_reg_opmask($) {
my $elem = shift;
return is_reg_opmask_intel ($elem) | is_reg_opmask_att ($elem);
}
=head2 is_reg_bound_intel
Checks if the given string parameter is a valid x86 bound register in Intel syntax.
Returns 1 if yes.
=cut
sub is_reg_bound_intel($) {
return _is_in_array (shift, \@regs_bound_intel);
}
=head2 is_reg_bound_att
Checks if the given string parameter is a valid x86 bound register in AT&T syntax.
Returns 1 if yes.
=cut
sub is_reg_bound_att($) {
return _is_in_array_att (shift, \@regs_bound_att);
}
=head2 is_reg_bound
Checks if the given string parameter is a valid x86 bound register.
Returns 1 if yes.
=cut
sub is_reg_bound($) {
my $elem = shift;
return is_reg_bound_intel ($elem) | is_reg_bound_att ($elem);
}
=head2 is_instr_intel
Checks if the given string parameter is a valid x86 instruction in Intel syntax.
Returns 1 if yes.
=cut
sub is_instr_intel($) {
return _is_in_array (shift, \@instr_intel);
}
=head2 is_instr_att
Checks if the given string parameter is a valid x86 instruction in AT&T syntax.
Returns 1 if yes.
=cut
sub is_instr_att($) {
return _is_in_array (shift, \@instr_att);
}
=head2 is_instr
Checks if the given string parameter is a valid x86 instruction in any syntax.
Returns 1 if yes.
=cut
sub is_instr($) {
my $elem = shift;
return is_instr_intel ($elem) | is_instr_att ($elem);
}
##############################################################################
# =head2 _is_valid_16bit_addr_reg_intel
#
# PRIVATE SUBROUTINE.
# Checks if the given register can be used in x86 16-bit addressing
# mode in Intel syntax.
# Returns 1 if yes.
#
# =cut
#
sub _is_valid_16bit_addr_reg_intel($) {
my $reg = shift;
return 1 if $reg =~ /^bx$/io || $reg =~ /^bp$/io
|| $reg =~ /^si$/io || $reg =~ /^di$/io;
return 0;
}
# =head2 _is_same_type_16bit_addr_reg_intel
#
# PRIVATE SUBROUTINE.
# Checks if the 2 given registers cannot be used in x86 16-bit addressing
# mode in Intel syntax at the same time because they're of the same type.
# Returns 1 if yes.
#
# =cut
#
sub _is_same_type_16bit_addr_reg_intel($$) {
my $reg1 = shift;
my $reg2 = shift;
return 1 if ($reg1 =~ /^b.$/io && $reg2 =~ /^b.$/io)
|| ($reg1 =~ /^.i$/io && $reg2 =~ /^.i$/io);
return 0;
}
# =head2 _validate_16bit_addr_parts_intel
#
# PRIVATE SUBROUTINE.
# Checks if the given address components give a valid x86 32-bit addressing
# mode in Intel syntax.
# Returns 1 if yes.
#
# =cut
#
sub _validate_16bit_addr_parts_intel($$$$$$$) {
my $seg_reg = shift;
my $reg1_sign = shift;
my $reg1 = shift;
my $reg2_sign = shift;
my $reg2 = shift;
my $disp_sign = shift;
my $disp = shift;
return 0 if defined $seg_reg && ! is_segreg_intel($seg_reg);
lib/Asm/X86.pm view on Meta::CPAN
=head2 is_valid_16bit_addr_intel
Checks if the given string parameter (must contain the square braces)
is a valid x86 16-bit addressing mode in Intel syntax.
Works best after any pre-processing of the input, i.e. after all macros,
constants, etc. have been replaced by the real values.
Returns 1 if yes.
=cut
sub is_valid_16bit_addr_intel($) {
my $elem = shift;
if ( $elem =~ /^(\w+):\s*\[\s*([\+\-]*)\s*(\w+)\s*\]$/o
|| $elem =~ /^\[\s*(\w+)\s*:\s*([\+\-]*)\s*(\w+)\s*\]$/o ) {
return _validate_16bit_addr_parts_intel ($1, $2, $3, undef, undef, undef, undef);
}
elsif ( $elem =~ /^(\w+):\s*\[\s*([\+\-]*)\s*(\w+)\s*([\+\-]+)\s*(\w+)\s*\]$/o
|| $elem =~ /^\[\s*(\w+)\s*:\s*([\+\-]*)\s*(\w+)\s*([\+\-]+)\s*(\w+)\s*\]$/o ) {
lib/Asm/X86.pm view on Meta::CPAN
# =head2 _is_valid_16bit_addr_reg_att
#
# PRIVATE SUBROUTINE.
# Checks if the given register can be used in x86 16-bit addressing
# mode in AT&T syntax.
# Returns 1 if yes.
#
# =cut
#
sub _is_valid_16bit_addr_reg_att($) {
my $reg = shift;
return 1 if $reg =~ /^%bx$/io || $reg =~ /^%bp$/io
|| $reg =~ /^%si$/io || $reg =~ /^%di$/io;
return 0;
}
# =head2 _is_same_type_16bit_addr_reg_att
#
# PRIVATE SUBROUTINE.
# Checks if the 2 given registers cannot be used in x86 16-bit addressing
# mode in AT&T syntax at the same time because they're of the same type.
# Returns 1 if yes.
#
# =cut
#
sub _is_same_type_16bit_addr_reg_att($$) {
my $reg1 = shift;
my $reg2 = shift;
return 1 if ($reg1 =~ /^%b.$/io && $reg2 =~ /^%b.$/io)
|| ($reg1 =~ /^%.i$/io && $reg2 =~ /^%.i$/io);
return 0;
}
# =head2 _validate_16bit_addr_parts_att
#
# PRIVATE SUBROUTINE.
# Checks if the given address components give a valid x86 32-bit addressing
# mode in AT&T syntax.
# Returns 1 if yes.
#
# =cut
#
sub _validate_16bit_addr_parts_att($$$$$$) {
my $seg_reg = shift;
#my $base_reg_sign = shift; # not allowed in the syntax at all
my $base_reg = shift;
#my $index_reg_sign = shift; # not allowed in the syntax at all
my $index_reg = shift;
my $scale = shift;
my $disp_sign = shift;
my $disp = shift;
lib/Asm/X86.pm view on Meta::CPAN
=head2 is_valid_16bit_addr_att
Checks if the given string parameter (must contain the parentheses)
is a valid x86 16-bit addressing mode in AT&T syntax.
Works best after any pre-processing of the input, i.e. after all macros,
constants, etc. have been replaced by the real values.
Returns 1 if yes.
=cut
sub is_valid_16bit_addr_att($) {
my $elem = shift;
if ( $elem =~ /^([%\w]+):\s*\(\s*([%\w]+)\s*\)$/o ) {
return _validate_16bit_addr_parts_att ($1, $2, undef, undef, undef, undef);
}
elsif ( $elem =~ /^([%\w]+):\s*\(\s*([%\w]+)\s*,\s*([%\w]+)\s*\)$/ ) {
return _validate_16bit_addr_parts_att ($1, $2, $3, undef, undef, undef);
}
lib/Asm/X86.pm view on Meta::CPAN
=head2 is_valid_16bit_addr
Checks if the given string parameter (must contain the parentheses)
is a valid x86 16-bit addressing mode in AT&T or Intel syntax.
Works best after any pre-processing of the input, i.e. after all macros,
constants, etc. have been replaced by the real values.
Returns 1 if yes.
=cut
sub is_valid_16bit_addr($) {
my $elem = shift;
return is_valid_16bit_addr_intel ($elem)
| is_valid_16bit_addr_att ($elem);
}
# =head2 _validate_32bit_addr_parts_intel
#
# PRIVATE SUBROUTINE.
# Checks if the given address components give a valid x86 32-bit addressing
# mode in Intel syntax.
# Returns 1 if yes.
#
# =cut
sub _validate_32bit_addr_parts_intel($$$$$$$$) {
my $seg_reg = shift;
my $base_reg_sign = shift;
my $base_reg = shift;
my $index_reg_sign = shift;
my $index_reg = shift;
my $scale = shift;
my $disp_sign = shift;
my $disp = shift;
lib/Asm/X86.pm view on Meta::CPAN
=head2 is_valid_32bit_addr_intel
Checks if the given string parameter (must contain the square braces)
is a valid x86 32-bit addressing mode in Intel syntax.
Works best after any pre-processing of the input, i.e. after all macros,
constants, etc. have been replaced by the real values.
Returns 1 if yes.
=cut
sub is_valid_32bit_addr_intel($) {
my $elem = shift;
# [seg:base+index*scale+disp]
if ( $elem =~ /^\[\s*(\w+)\s*:\s*([\+\-\(\)]*)\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*\*\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*(\)*)\s*\]$/o
|| $elem =~ /^(\w+)\s*:\s*\[\s*([\+\-\(\)]*)\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*\*\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*(\)*)\s*\]$/o) {
return _validate_32bit_addr_parts_intel ($1, $2, $3, $4, $5, $6, $7, $8);
}
elsif ( $elem =~ /^\[\s*(\w+)\s*:\s*([\+\-\(\)]*)\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*\*\s*(\w+)\s*(\)*)\s*\]$/o
|| $elem =~ /^(\w+)\s*:\s*\[\s*([\+\-\(\)]*)\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*\*\s*(\w+)\s*(\)*)\s*\]$/o) {
lib/Asm/X86.pm view on Meta::CPAN
}
# =head2 _validate_32bit_addr_parts_att
#
# PRIVATE SUBROUTINE.
# Checks if the given address components give a valid x86 32-bit addressing
# mode in AT&T syntax.
# Returns 1 if yes.
#
# =cut
sub _validate_32bit_addr_parts_att($$$$$$) {
my $seg_reg = shift;
#my $base_reg_sign = shift; # not allowed in the syntax at all
my $base_reg = shift;
#my $index_reg_sign = shift; # not allowed in the syntax at all
my $index_reg = shift;
my $scale = shift;
my $disp_sign = shift;
my $disp = shift;
lib/Asm/X86.pm view on Meta::CPAN
=head2 is_valid_32bit_addr_att
Checks if the given string parameter (must contain the parentheses)
is a valid x86 32-bit addressing mode in AT&T syntax.
Works best after any pre-processing of the input, i.e. after all macros,
constants, etc. have been replaced by the real values.
Returns 1 if yes.
=cut
sub is_valid_32bit_addr_att($) {
my $elem = shift;
if ( $elem =~ /^([%\w]+):\s*\(\s*([%\w]+)\s*\)$/o ) {
return _validate_32bit_addr_parts_att ($1, $2, undef, undef, undef, undef);
}
elsif ( $elem =~ /^([%\w]+):\s*\(\s*([%\w]+)\s*,\s*([%\w]+)\s*\)$/o ) {
return _validate_32bit_addr_parts_att ($1, $2, $3, undef, undef, undef);
}
lib/Asm/X86.pm view on Meta::CPAN
=head2 is_valid_32bit_addr
Checks if the given string parameter (must contain the parentheses)
is a valid x86 32-bit addressing mode in AT&T or Intel syntax.
Works best after any pre-processing of the input, i.e. after all macros,
constants, etc. have been replaced by the real values.
Returns 1 if yes.
=cut
sub is_valid_32bit_addr($) {
my $elem = shift;
return is_valid_32bit_addr_intel ($elem)
| is_valid_32bit_addr_att ($elem);
}
# =head2 _is_valid_64bit_addr_reg_att
#
# PRIVATE SUBROUTINE.
# Checks if the given register can be used in x86 64-bit addressing
# mode in Intel syntax.
# Returns 1 if yes.
#
# =cut
#
sub _is_valid_64bit_addr_reg_intel($) {
my $reg = shift;
return 1 if is_reg64_intel($reg) || is_r32_in64_intel($reg) || is_addressable32_intel($reg);
return 0;
}
# =head2 _validate_64bit_addr_parts_intel
#
# PRIVATE SUBROUTINE.
# Checks if the given address components give a valid x86 64-bit addressing
# mode in Intel syntax.
# Returns 1 if yes.
#
# =cut
sub _validate_64bit_addr_parts_intel($$$$$$$$) {
my $seg_reg = shift;
my $base_reg_sign = shift;
my $base_reg = shift;
my $index_reg_sign = shift;
my $index_reg = shift;
my $scale = shift;
my $disp_sign = shift;
my $disp = shift;
my $was64 = 0;
lib/Asm/X86.pm view on Meta::CPAN
=head2 is_valid_64bit_addr_intel
Checks if the given string parameter (must contain the square braces)
is a valid x86 64-bit addressing mode in Intel syntax.
Works best after any pre-processing of the input, i.e. after all macros,
constants, etc. have been replaced by the real values.
Returns 1 if yes.
=cut
sub is_valid_64bit_addr_intel($) {
my $elem = shift;
# [seg:base+index*scale+disp]
if ( $elem =~ /^\[\s*(\w+)\s*:\s*([\+\-\(\)]*)\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*\*\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*(\)*)\s*\]$/o
|| $elem =~ /^(\w+)\s*:\s*\[\s*([\+\-\(\)]*)\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*\*\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*(\)*)\s*\]$/o) {
return _validate_64bit_addr_parts_intel ($1, $2, $3, $4, $5, $6, $7, $8);
}
elsif ( $elem =~ /^\[\s*(\w+)\s*:\s*([\+\-\(\)]*)\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*\*\s*(\w+)\s*(\)*)\s*\]$/o
|| $elem =~ /^(\w+)\s*:\s*\[\s*([\+\-\(\)]*)\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*\*\s*(\w+)\s*(\)*)\s*\]$/o) {
lib/Asm/X86.pm view on Meta::CPAN
# =head2 _is_valid_64bit_addr_reg_att
#
# PRIVATE SUBROUTINE.
# Checks if the given register can be used in x86 64-bit addressing
# mode in AT&T syntax.
# Returns 1 if yes.
#
# =cut
#
sub _is_valid_64bit_addr_reg_att($) {
my $reg = shift;
return 1 if is_reg64_att($reg) || is_r32_in64_att($reg) || is_addressable32_att($reg);
return 0;
}
# =head2 _validate_64bit_addr_parts_att
#
# PRIVATE SUBROUTINE.
# Checks if the given address components give a valid x86 64-bit addressing
# mode in AT&T syntax.
# Returns 1 if yes.
#
# =cut
sub _validate_64bit_addr_parts_att($$$$$$) {
my $seg_reg = shift;
#my $base_reg_sign = shift; # not allowed in the syntax at all
my $base_reg = shift;
#my $index_reg_sign = shift; # not allowed in the syntax at all
my $index_reg = shift;
my $scale = shift;
my $disp_sign = shift;
my $disp = shift;
my $was64 = 0;
lib/Asm/X86.pm view on Meta::CPAN
=head2 is_valid_64bit_addr_att
Checks if the given string parameter (must contain the parentheses)
is a valid x86 64-bit addressing mode in AT&T syntax.
Works best after any pre-processing of the input, i.e. after all macros,
constants, etc. have been replaced by the real values.
Returns 1 if yes.
=cut
sub is_valid_64bit_addr_att($) {
my $elem = shift;
if ( $elem =~ /^([%\w]+):\s*\(\s*([%\w]+)\s*\)$/o ) {
return _validate_64bit_addr_parts_att ($1, $2, undef, undef, undef, undef);
}
elsif ( $elem =~ /^([%\w]+):\s*\(\s*([%\w]+)\s*,\s*([%\w]+)\s*\)$/o ) {
return _validate_64bit_addr_parts_att ($1, $2, $3, undef, undef, undef);
}
lib/Asm/X86.pm view on Meta::CPAN
=head2 is_valid_64bit_addr
Checks if the given string parameter (must contain the parentheses)
is a valid x86 64-bit addressing mode in AT&T or Intel syntax.
Works best after any pre-processing of the input, i.e. after all macros,
constants, etc. have been replaced by the real values.
Returns 1 if yes.
=cut
sub is_valid_64bit_addr($) {
my $elem = shift;
return is_valid_64bit_addr_intel ($elem)
| is_valid_64bit_addr_att ($elem);
}
=head2 is_valid_addr_intel
Checks if the given string parameter (must contain the square braces)
is a valid x86 addressing mode in Intel syntax.
Works best after any pre-processing of the input, i.e. after all macros,
constants, etc. have been replaced by the real values.
Returns 1 if yes.
=cut
sub is_valid_addr_intel($) {
my $elem = shift;
return is_valid_16bit_addr_intel ($elem)
| is_valid_32bit_addr_intel ($elem)
| is_valid_64bit_addr_intel ($elem);
}
=head2 is_valid_addr_att
Checks if the given string parameter (must contain the braces)
is a valid x86 addressing mode in AT&T syntax.
Works best after any pre-processing of the input, i.e. after all macros,
constants, etc. have been replaced by the real values.
Returns 1 if yes.
=cut
sub is_valid_addr_att($) {
my $elem = shift;
return is_valid_16bit_addr_att($elem)
| is_valid_32bit_addr_att($elem)
| is_valid_64bit_addr_att($elem);
}
=head2 is_valid_addr
Checks if the given string parameter (must contain the square braces)
is a valid x86 addressing mode (Intel or AT&T syntax).
Works best after any pre-processing of the input, i.e. after all macros,
constants, etc. have been replaced by the real values.
Returns 1 if yes.
=cut
sub is_valid_addr($) {
my $elem = shift;
return is_valid_addr_intel($elem)
| is_valid_addr_att($elem);
}
=head2 is_att_suffixed_instr
Tells if the given instruction is suffixed in AT&T syntax.
Returns 1 if yes.
=cut
sub is_att_suffixed_instr($) {
return _is_in_array (shift, \@att_suff_instr);
}
=head2 is_att_suffixed_instr_fpu
Tells if the given FPU non-integer instruction is suffixed in AT&T syntax.
Returns 1 if yes
=cut
sub is_att_suffixed_instr_fpu($) {
return _is_in_array (shift, \@att_suff_instr_fpu);
}
=head2 add_att_suffix_instr
Creates the AT&T syntax instruction array from the Intel-syntax array.
Returns the new array.
=cut
sub add_att_suffix_instr(@) {
my @result = ();
foreach (@_) {
if ( is_att_suffixed_instr ($_) ) {
push @result, $_.'b';
push @result, $_.'w';
push @result, $_.'l';
push @result, $_.'q';
}
lib/Asm/X86.pm view on Meta::CPAN
=head2 conv_att_addr_to_intel
Converts the given string representing a valid AT&T addressing mode to Intel syntax.
Works best after any pre-processing of the input, i.e. after all macros,
constants, etc. have been replaced by the real values.
Returns the resulting string.
=cut
sub conv_att_addr_to_intel($) {
my $par = shift;
$par =~ s/%([a-zA-Z]+)/$1/go;
# seg: disp(base, index, scale)
$par =~ s/(\w+\s*:\s*)([\w\+\-\(\)]+)\s*\(\s*(\w+)\s*,\s*(\w+)\s*,\s*(\d)\s*\)/[$1$3+$5*$4+$2]/o;
$par =~ s/(\w+\s*:\s*)([\w\+\-\(\)]+)\s*\(\s*(\w+)\s*,\s*(\w+)\s*,?\s*\)/[$1$3+$4+$2]/o;
$par =~ s/(\w+\s*:\s*)\(\s*(\w+)\s*,\s*(\w+)\s*,\s*(\d)\s*\)/[$1$2+$3*$4]/o;
$par =~ s/(\w+\s*:\s*)\(\s*(\w+)\s*,\s*(\w+)\s*,?\s*\)/[$1$2+$3]/o;
$par =~ s/(\w+\s*:\s*)([\w\+\-\(\)]+)\s*\(\s*,\s*1\s*\)/[$1$2]/o;
$par =~ s/(\w+\s*:\s*)([\w\+\-\(\)]+)\s*\(\s*,\s*(\w+)\s*,\s*(\d)\s*\)/[$1$3*$4+$2]/o;
lib/Asm/X86.pm view on Meta::CPAN
=head2 conv_intel_addr_to_att
Converts the given string representing a valid Intel addressing mode to AT&T syntax.
Works best after any pre-processing of the input, i.e. after all macros,
constants, etc. have been replaced by the real values.
Returns the resulting string.
=cut
sub conv_intel_addr_to_att($) {
my $par = shift;
my ($z1, $z2, $z3);
# seg: disp(base, index, scale)
# [seg:base+index*scale+disp]
my $a_seg_base_index_scale_disp = qr/\[\s*(\w+)\s*:\s*([\+\-\(\)]*)\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*\*\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*(\)*)\s*\]/o;
my $a_seg_base_disp_index_scale = qr/\[\s*(\w+)\s*:\s*([\+\-\(\)]*)\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*\*\s*(\w+)\s*(\)*)\s*\]/o;
my $a_seg_index_scale_base_disp = qr/\[\s*(\w+)\s*:\s*([\+\-\(\)]*)\s*(\w+)\s*\*\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*(\)*)\s*\]/o;
my $a_seg_base_index_disp = qr/\[\s*(\w+)\s*:\s*([\+\-\(\)]*)\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*(\)*)\s*\]/o;
my $a_seg_base_index_scale = qr/\[\s*(\w+)\s*:\s*([\+\-\(\)]*)\s*(\w+)\s*([\+\-\(\)]+)\s*(\w+)\s*\*\s*(\w+)\s*(\)*)\s*\]/o;
lib/Asm/X86.pm view on Meta::CPAN
# =head2 _change_to_intel_addr_if_applicable
#
# PRIVATE SUBROUTINE.
# If the parameter is applicable to be an address (i.e. not a variable,
# register or a label), returns its value in square brackets (intel-syntax
# memory reference).
#
# =cut
#
sub _change_to_intel_addr_if_applicable($) {
my $par = shift;
# (we mustn't change digits and %st(n), skip also labels)
if ( $par !~ /\$/o && $par !~ /\%/o && $par !~ /_L\d+/o && $par =~ /[a-zA-Z_\.]/o ) {
return "[$par]";
}
return $par;
}
=head2 conv_att_instr_to_intel
Converts the given string representing a valid AT&T instruction to Intel syntax.
Works best after any pre-processing of the input, i.e. after all macros,
constants, etc. have been replaced by the real values.
Returns the resulting string.
=cut
sub conv_att_instr_to_intel($) {
my $par = shift;
# process "jmp cs,sth" early so that it doesn't get substituted
my $jmp_2arg = qr/^\s*l?(jmp|call)\s*(\w+)\s*,\s*(\w+)\s*$/io;
if ( $par =~ /$jmp_2arg/ ) {
$par =~ s/$jmp_2arg/\t$1\t$2:$3/;
}
# (changing "xxx" to "[xxx]", if there's no '$' or '%')
lib/Asm/X86.pm view on Meta::CPAN
# =head2 _remove_size_qualifiers_add_dollar_add_dollar
#
# PRIVATE SUBROUTINE.
# Returns the parameter after removing any size qualifiers (byte, word,
# dword, etc.) and any leading and trailing whitespace.
# If the parameter is not a memory reference or a register, prefixes it with
# a dollar-sign.
#
# =cut
#
sub _remove_size_qualifiers_add_dollar($) {
my $par = shift;
$par =~ s/\s+$//o;
$par =~ s/(t?byte|[dqpftoyz]?word)//io;
$par =~ s/^\s+//o;
if ( $par !~ /\[/o && !is_reg($par) )
{
$par = "\$$par";
}
return $par;
lib/Asm/X86.pm view on Meta::CPAN
=head2 conv_intel_instr_to_att
Converts the given string representing a valid Intel instruction to AT&T syntax.
Works best after any pre-processing of the input, i.e. after all macros,
constants, etc. have been replaced by the real values.
Returns the resulting string.
=cut
sub conv_intel_instr_to_att($) {
my $par = shift;
my ($a1, $a2, $a3, $a4);
$par =~ s/ptr//gi;
# (add the suffix)
foreach my $i (@att_suff_instr) {
if ( $par =~ /^\s*$i\s+([^,]+)/i ) {
t/zz_addr_att.t view on Meta::CPAN
is_valid_16bit_addr_att
is_valid_32bit_addr_att
is_valid_64bit_addr_att
is_valid_addr_att
is_valid_16bit_addr
is_valid_32bit_addr
is_valid_64bit_addr
is_valid_addr
);
sub permute3_att($$$$$$$) {
my $basereg_sign = shift;
my $basereg = shift;
my $indexreg_sign = shift;
my $indexreg = shift;
my $scale = shift;
my $disp_sign = shift;
my $disp = shift;
my @result = ();
t/zz_addr_att.t view on Meta::CPAN
if ( $disp_sign eq '+' ) {
push @result, "$disp(, 1)";
}
}
return @result;
}
sub permute_att_segreg($$$$$$$$) {
my $segreg = shift;
my $basereg_sign = shift;
my $basereg = shift;
my $indexreg_sign = shift;
my $indexreg = shift;
my $scale = shift;
my $disp_sign = shift;
my $disp = shift;
t/zz_addr_att.t view on Meta::CPAN
}
} # defined $segreg
else {
@result = permute3_att ($basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, $disp_sign, $disp);
}
return @result;
}
sub permute_att($$$$$$$) {
my $basereg_sign = shift;
my $basereg = shift;
my $indexreg_sign = shift;
my $indexreg = shift;
my $scale = shift;
my $disp_sign = shift;
my $disp = shift;
my @result = permute_att_segreg (undef, $basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, $disp_sign, $disp);
push @result, permute_att_segreg ('%ds', $basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, $disp_sign, $disp);
return @result;
}
sub permute_disp_att($$$$$$) {
my $basereg_sign = shift;
my $basereg = shift;
my $indexreg_sign = shift;
my $indexreg = shift;
my $scale = shift;
my $disp = shift;
my @result = permute_att ($basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, '', $disp);
if ( $disp ne '' ) {
push @result, permute_att ($basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, '-', $disp);
push @result, permute_att ($basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, '', "-$disp");
}
return @result;
}
sub permute_disp_att_all($$$$$$) {
my $basereg_sign = shift;
my $basereg = shift;
my $indexreg_sign = shift;
my $indexreg = shift;
my $scale = shift;
my $disp = shift;
my @result = permute_att ($basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, '', '');
push @result, permute_disp_att ($basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, $disp);
return @result;
}
sub permute_disp_att_segreg($$$$$$$) {
my $segreg = shift;
my $basereg_sign = shift;
my $basereg = shift;
my $indexreg_sign = shift;
my $indexreg = shift;
my $scale = shift;
my $disp = shift;
my @result = permute_att_segreg ($segreg, $basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, '', $disp);
if ( $disp ne '' ) {
push @result, permute_att_segreg ($segreg, $basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, '-', $disp);
push @result, permute_att_segreg ($segreg, $basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, '', "-$disp");
}
return @result;
}
sub permute_disp_att_segreg_all($$$$$$$) {
my $segreg = shift;
my $basereg_sign = shift;
my $basereg = shift;
my $indexreg_sign = shift;
my $indexreg = shift;
my $scale = shift;
my $disp = shift;
my @result = permute_att_segreg ($segreg, $basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, '', '');
push @result, permute_disp_att_segreg ($segreg, $basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, $disp);
return @result;
}
sub permute_two_reg32_invalid_att($$$$) {
my $basereg_sign = shift;
my $basereg = shift;
my $indexreg_sign = shift;
my $indexreg = shift;
my @result = permute_disp_att ($basereg_sign, $basereg, $indexreg_sign, $indexreg, '', '1');
push @result, permute_disp_att ($basereg_sign, $basereg, $indexreg_sign, $indexreg, '2', '1');
push @result, permute_disp_att ($basereg_sign, $basereg, $indexreg_sign, $indexreg, '2', 'varname');
push @result, permute_disp_att ($basereg_sign, $basereg, $indexreg_sign, $indexreg, '2', '%ebx');
t/zz_addr_att.t view on Meta::CPAN
push @result, permute_disp_att ($basereg_sign, $basereg, $indexreg_sign, $indexreg, '%edx', 'varname');
push @result, permute_disp_att ($basereg_sign, $basereg, $indexreg_sign, $indexreg, '%edx', '%ebx');
push @result, permute_disp_att ($basereg_sign, $basereg, $indexreg_sign, $indexreg, '%ds', '1');
push @result, permute_disp_att ($basereg_sign, $basereg, $indexreg_sign, $indexreg, '%ds', 'varname');
push @result, permute_disp_att ($basereg_sign, $basereg, $indexreg_sign, $indexreg, '%ds', '%ebx');
return @result;
}
sub permute_reg32_invalid_att($) {
my $reg = shift;
my @result = permute_two_reg32_invalid_att ('', '%eax', '', $reg);
push @result, permute_two_reg32_invalid_att ('-', '%eax', '', $reg);
push @result, permute_two_reg32_invalid_att ('', '%eax', '-', $reg);
push @result, permute_two_reg32_invalid_att ('-', '%eax', '-', $reg);
push @result, permute_two_reg32_invalid_att ('', '', '', $reg);
push @result, permute_two_reg32_invalid_att ('', '', '-', $reg);
t/zz_addr_att.t view on Meta::CPAN
push @result, permute_two_reg32_invalid_att ('-', $reg, '', '');
push @result, permute_two_reg32_invalid_att ('', $reg, '', '%eax');
push @result, permute_two_reg32_invalid_att ('-', $reg, '', '%eax');
push @result, permute_two_reg32_invalid_att ('', $reg, '-', '%eax');
push @result, permute_two_reg32_invalid_att ('-', $reg, '-', '%eax');
return @result;
}
sub permute_two_reg64_invalid_att($$$$) {
my $basereg_sign = shift;
my $basereg = shift;
my $indexreg_sign = shift;
my $indexreg = shift;
my @result = permute_disp_att ($basereg_sign, $basereg, $indexreg_sign, $indexreg, '', '1');
push @result, permute_disp_att ($basereg_sign, $basereg, $indexreg_sign, $indexreg, '2', '1');
push @result, permute_disp_att ($basereg_sign, $basereg, $indexreg_sign, $indexreg, '2', 'varname');
push @result, permute_disp_att ($basereg_sign, $basereg, $indexreg_sign, $indexreg, '2', '%rbx');
t/zz_addr_att.t view on Meta::CPAN
push @result, permute_disp_att ($basereg_sign, $basereg, $indexreg_sign, $indexreg, '%rdx', 'varname');
push @result, permute_disp_att ($basereg_sign, $basereg, $indexreg_sign, $indexreg, '%rdx', '%rbx');
push @result, permute_disp_att ($basereg_sign, $basereg, $indexreg_sign, $indexreg, '%ds', '1');
push @result, permute_disp_att ($basereg_sign, $basereg, $indexreg_sign, $indexreg, '%ds', 'varname');
push @result, permute_disp_att ($basereg_sign, $basereg, $indexreg_sign, $indexreg, '%ds', '%rbx');
return @result;
}
sub permute_reg64_invalid_att($) {
my $reg = shift;
my @result = permute_two_reg64_invalid_att ('', '%rax', '', $reg);
push @result, permute_two_reg64_invalid_att ('-', '%rax', '', $reg);
push @result, permute_two_reg64_invalid_att ('', '%rax', '-', $reg);
push @result, permute_two_reg64_invalid_att ('-', '%rax', '-', $reg);
push @result, permute_two_reg64_invalid_att ('', '', '', $reg);
push @result, permute_two_reg64_invalid_att ('', '', '-', $reg);
t/zz_addr_att.t view on Meta::CPAN
push @result, permute_two_reg64_invalid_att ('-', $reg, '', '');
push @result, permute_two_reg64_invalid_att ('', $reg, '', '%rax');
push @result, permute_two_reg64_invalid_att ('-', $reg, '', '%rax');
push @result, permute_two_reg64_invalid_att ('', $reg, '-', '%rax');
push @result, permute_two_reg64_invalid_att ('-', $reg, '-', '%rax');
return @result;
}
sub permute_sign_disp_att_all($$$$) {
my $basereg = shift;
my $indexreg = shift;
my $scale = shift;
my $disp = shift;
my @result = permute_disp_att_all ('', $basereg, '', $indexreg, $scale, $disp);
push @result, permute_disp_att_all ('', $basereg, '-', $indexreg, $scale, $disp);
push @result, permute_disp_att_all ('-', $basereg, '', $indexreg, $scale, $disp);
push @result, permute_disp_att_all ('-', $basereg, '-', $indexreg, $scale, $disp);
return @result;
}
sub permute_sign_disp_att_segreg_all($$$$$) {
my $segreg = shift;
my $basereg = shift;
my $indexreg = shift;
my $scale = shift;
my $disp = shift;
my @result = permute_disp_att_segreg_all ($segreg, '', $basereg, '', $indexreg, $scale, $disp);
push @result, permute_disp_att_segreg_all ($segreg, '', $basereg, '-', $indexreg, $scale, $disp);
push @result, permute_disp_att_segreg_all ($segreg, '-', $basereg, '', $indexreg, $scale, $disp);
t/zz_addr_intel.t view on Meta::CPAN
is_valid_16bit_addr_att
is_valid_32bit_addr_att
is_valid_64bit_addr_att
is_valid_addr_att
is_valid_16bit_addr
is_valid_32bit_addr
is_valid_64bit_addr
is_valid_addr
);
sub permute3_intel($$$$$$$) {
my $basereg_sign = shift;
my $basereg = shift;
my $indexreg_sign = shift;
my $indexreg = shift;
my $scale = shift;
my $disp_sign = shift;
my $disp = shift;
my @result = ();
t/zz_addr_intel.t view on Meta::CPAN
if ( $disp_sign eq '+' ) {
# same thing, just skip the leading sign
push @result, "[$disp]";
}
}
return @result;
}
sub permute_intel_segreg($$$$$$$$) {
my $segreg = shift;
my $basereg_sign = shift;
my $basereg = shift;
my $indexreg_sign = shift;
my $indexreg = shift;
my $scale = shift;
my $disp_sign = shift;
my $disp = shift;
t/zz_addr_intel.t view on Meta::CPAN
}
} # defined $segreg
else {
@result = permute3_intel ($basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, $disp_sign, $disp);
}
return @result;
}
sub permute_intel($$$$$$$) {
my $basereg_sign = shift;
my $basereg = shift;
my $indexreg_sign = shift;
my $indexreg = shift;
my $scale = shift;
my $disp_sign = shift;
my $disp = shift;
my @result = permute_intel_segreg (undef, $basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, $disp_sign, $disp);
push @result, permute_intel_segreg ('ds', $basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, $disp_sign, $disp);
return @result;
}
sub permute_disp_intel($$$$$$) {
my $basereg_sign = shift;
my $basereg = shift;
my $indexreg_sign = shift;
my $indexreg = shift;
my $scale = shift;
my $disp = shift;
my @result = ();
push @result, permute_intel ($basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, '', $disp);
if ( $disp ne '' ) {
push @result, permute_intel ($basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, '-', $disp);
push @result, permute_intel ($basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, '', "-$disp");
}
return @result;
}
sub permute_disp_intel_all($$$$$$) {
my $basereg_sign = shift;
my $basereg = shift;
my $indexreg_sign = shift;
my $indexreg = shift;
my $scale = shift;
my $disp = shift;
my @result = ();
push @result, permute_intel ($basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, '', '');
push @result, permute_disp_intel ($basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, $disp);
return @result;
}
sub permute_disp_intel_segreg($$$$$$$) {
my $segreg = shift;
my $basereg_sign = shift;
my $basereg = shift;
my $indexreg_sign = shift;
my $indexreg = shift;
my $scale = shift;
my $disp = shift;
my @result = ();
t/zz_addr_intel.t view on Meta::CPAN
push @result, permute_intel_segreg ($segreg, $basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, '', $disp);
if ( $disp ne '' ) {
push @result, permute_intel_segreg ($segreg, $basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, '-', $disp);
push @result, permute_intel_segreg ($segreg, $basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, '', "-$disp");
}
return @result;
}
sub permute_disp_intel_segreg_all($$$$$$$) {
my $segreg = shift;
my $basereg_sign = shift;
my $basereg = shift;
my $indexreg_sign = shift;
my $indexreg = shift;
my $scale = shift;
my $disp = shift;
my @result = ();
push @result, permute_intel_segreg ($segreg, $basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, '', '');
push @result, permute_disp_intel_segreg ($segreg, $basereg_sign, $basereg, $indexreg_sign, $indexreg, $scale, $disp);
return @result;
}
sub permute_two_reg32_invalid_intel($$$$) {
my $basereg_sign = shift;
my $basereg = shift;
my $indexreg_sign = shift;
my $indexreg = shift;
my @result = ();
push @result, permute_disp_intel ($basereg_sign, $basereg, $indexreg_sign, $indexreg, '', '1');
push @result, permute_disp_intel ($basereg_sign, $basereg, $indexreg_sign, $indexreg, '2', '1');
t/zz_addr_intel.t view on Meta::CPAN
push @result, permute_disp_intel ($basereg_sign, $basereg, $indexreg_sign, $indexreg, 'edx', '1');
push @result, permute_disp_intel ($basereg_sign, $basereg, $indexreg_sign, $indexreg, 'edx', 'ebx');
push @result, permute_disp_intel ($basereg_sign, $basereg, $indexreg_sign, $indexreg, 'ds', '1');
push @result, permute_disp_intel ($basereg_sign, $basereg, $indexreg_sign, $indexreg, 'ds', 'ebx');
return @result;
}
sub permute_reg32_invalid_intel($) {
my $reg = shift;
my @result = ();
push @result, permute_two_reg32_invalid_intel ('', 'eax', '', $reg);
push @result, permute_two_reg32_invalid_intel ('-', 'eax', '', $reg);
push @result, permute_two_reg32_invalid_intel ('', 'eax', '-', $reg);
push @result, permute_two_reg32_invalid_intel ('-', 'eax', '-', $reg);
push @result, permute_two_reg32_invalid_intel ('', '', '', $reg);
t/zz_addr_intel.t view on Meta::CPAN
push @result, permute_two_reg32_invalid_intel ('-', $reg, '', '');
push @result, permute_two_reg32_invalid_intel ('', $reg, '', 'eax');
push @result, permute_two_reg32_invalid_intel ('-', $reg, '', 'eax');
push @result, permute_two_reg32_invalid_intel ('', $reg, '-', 'eax');
push @result, permute_two_reg32_invalid_intel ('-', $reg, '-', 'eax');
return @result;
}
sub permute_two_reg64_invalid_intel($$$$) {
my $basereg_sign = shift;
my $basereg = shift;
my $indexreg_sign = shift;
my $indexreg = shift;
my @result = ();
push @result, permute_disp_intel ($basereg_sign, $basereg, $indexreg_sign, $indexreg, '', '1');
push @result, permute_disp_intel ($basereg_sign, $basereg, $indexreg_sign, $indexreg, '2', '1');
t/zz_addr_intel.t view on Meta::CPAN
push @result, permute_disp_intel ($basereg_sign, $basereg, $indexreg_sign, $indexreg, 'rdx', '1');
push @result, permute_disp_intel ($basereg_sign, $basereg, $indexreg_sign, $indexreg, 'rdx', 'rbx');
push @result, permute_disp_intel ($basereg_sign, $basereg, $indexreg_sign, $indexreg, 'ds', '1');
push @result, permute_disp_intel ($basereg_sign, $basereg, $indexreg_sign, $indexreg, 'ds', 'rbx');
return @result;
}
sub permute_reg64_invalid_intel($) {
my $reg = shift;
my @result = ();
push @result, permute_two_reg64_invalid_intel ('', 'rax', '', $reg);
push @result, permute_two_reg64_invalid_intel ('-', 'rax', '', $reg);
push @result, permute_two_reg64_invalid_intel ('', 'rax', '-', $reg);
push @result, permute_two_reg64_invalid_intel ('-', 'rax', '-', $reg);
push @result, permute_two_reg64_invalid_intel ('', '', '', $reg);
t/zz_addr_intel.t view on Meta::CPAN
push @result, permute_two_reg64_invalid_intel ('-', $reg, '', '');
push @result, permute_two_reg64_invalid_intel ('', $reg, '', 'rax');
push @result, permute_two_reg64_invalid_intel ('-', $reg, '', 'rax');
push @result, permute_two_reg64_invalid_intel ('', $reg, '-', 'rax');
push @result, permute_two_reg64_invalid_intel ('-', $reg, '-', 'rax');
return @result;
}
sub permute_sign_disp_intel_all($$$$) {
my $basereg = shift;
my $indexreg = shift;
my $scale = shift;
my $disp = shift;
my @result = permute_disp_intel_all ('', $basereg, '', $indexreg, $scale, $disp);
push @result, permute_disp_intel_all ('', $basereg, '-', $indexreg, $scale, $disp);
push @result, permute_disp_intel_all ('-', $basereg, '', $indexreg, $scale, $disp);
push @result, permute_disp_intel_all ('-', $basereg, '-', $indexreg, $scale, $disp);
return @result;
}
sub permute_sign_disp_intel_segreg_all($$$$$) {
my $segreg = shift;
my $basereg = shift;
my $indexreg = shift;
my $scale = shift;
my $disp = shift;
my @result = permute_disp_intel_segreg_all ($segreg, '', $basereg, '', $indexreg, $scale, $disp);
push @result, permute_disp_intel_segreg_all ($segreg, '', $basereg, '-', $indexreg, $scale, $disp);
push @result, permute_disp_intel_segreg_all ($segreg, '-', $basereg, '', $indexreg, $scale, $disp);
t/zz_conv.t view on Meta::CPAN
}
foreach my $expr (keys %att_addr_to_intel) {
my $res = conv_att_addr_to_intel ($expr);
like ($res, $att_addr_to_intel{$expr},
"The result of conv_att_addr_to_intel ($expr) should match '$att_addr_to_intel{$expr}', but was '$res'.");
}
# -----------
sub arr_contains($$) {
my $arr = shift;
my $key = shift;
foreach (@$arr) {
return 1 if $_ =~ /^$key$/i;
}
return 0;
}
my @converted = add_att_suffix_instr (
t/zz_duplicates.t view on Meta::CPAN
use strict;
use warnings;
use Test::More tests => 19;
use Asm::X86 qw(@regs8_intel @regs16_intel @segregs_intel @regs32_intel @regs64_intel @regs_mm_intel
@regs_intel @regs_fpu_intel
@regs8_att @regs16_att @segregs_att @regs32_att @regs64_att @regs_mm_att
@regs_att @regs_fpu_att
@instr_intel @instr_att @instr);
sub find_duplicates($$) {
my $arr = shift;
my %arr_hash;
my $arr_name = shift;
my %dupli;
foreach (@{$arr}) {
$dupli{$_} = 1 if defined $arr_hash{$_};
$arr_hash{$_} = 1;
t/zz_regs_att.t view on Meta::CPAN
cmp_ok ( $#regs_opmask_att,'>', 0, 'Non-empty AT&T opmask register list' );
cmp_ok ( $#regs_bound_att,'>', 0, 'Non-empty AT&T bound register list' );
cmp_ok ( $#regs_att, '>', 0, 'Non-empty AT&T register list' );
my ($name_reg, $name_reg8, $name_reg16, $name_reg32, $name_reg64,
$name_reg_mm, $name_reg_seg, $name_reg_fpu, $name_reg_opmask,
$name_reg_add32, $name_reg32_64, $name_reg_bound)
= ('reg', 'reg8', 'reg16', 'reg32', 'reg64', 'regmm', 'segreg', 'fpureg',
'opmaskreg', 'reg_address32', 'reg32_in_64', 'boundreg');
sub check_reg_att($$) {
my $regs = shift;
my $types = shift;
foreach my $r (@$regs) {
is ( is_reg_att ($r), $$types{$name_reg}, "'$r' is a valid AT&T-syntax register" ) if defined $$types{$name_reg};
is ( is_reg8_att ($r), $$types{$name_reg8}, "'$r' is a valid AT&T-syntax 8-bit register" ) if defined $$types{$name_reg8};
is ( is_reg16_att ($r), $$types{$name_reg16}, "'$r' is a valid AT&T-syntax 16-bit register" ) if defined $$types{$name_reg16};
is ( is_reg32_att ($r), $$types{$name_reg32}, "'$r' is a valid AT&T-syntax 32-bit register" ) if defined $$types{$name_reg32};
is ( is_reg64_att ($r), $$types{$name_reg64}, "'$r' is a valid AT&T-syntax 64-bit register" ) if defined $$types{$name_reg64};
t/zz_regs_intel.t view on Meta::CPAN
cmp_ok ( $#regs_opmask_intel,'>', 0, 'Non-empty opmask register list' );
cmp_ok ( $#regs_bound_intel,'>', 0, 'Non-empty bound register list' );
cmp_ok ( $#regs_intel, '>', 0, 'Non-empty register list' );
my ($name_reg, $name_reg8, $name_reg16, $name_reg32, $name_reg64,
$name_reg_mm, $name_reg_seg, $name_reg_fpu, $name_reg_opmask,
$name_reg_add32, $name_reg32_64, $name_reg_bound)
= ('reg', 'reg8', 'reg16', 'reg32', 'reg64', 'regmm', 'segreg', 'fpureg',
'opmaskreg', 'reg_address32', 'reg32_in_64', 'boundreg');
sub check_reg_intel($$) {
my $regs = shift;
my $types = shift;
foreach my $r (@$regs) {
is ( is_reg_intel ($r), $$types{$name_reg}, "'$r' is a valid Intel-syntax register" ) if defined $$types{$name_reg};
is ( is_reg8_intel ($r), $$types{$name_reg8}, "'$r' is a valid Intel-syntax 8-bit register" ) if defined $$types{$name_reg8};
is ( is_reg16_intel ($r), $$types{$name_reg16}, "'$r' is a valid Intel-syntax 16-bit register" ) if defined $$types{$name_reg16};
is ( is_reg32_intel ($r), $$types{$name_reg32}, "'$r' is a valid Intel-syntax 32-bit register" ) if defined $$types{$name_reg32};
is ( is_reg64_intel ($r), $$types{$name_reg64}, "'$r' is a valid Intel-syntax 64-bit register" ) if defined $$types{$name_reg64};
( run in 0.656 second using v1.01-cache-2.11-cpan-65fba6d93b7 )