view release on metacpan or  search on metacpan

lib/CPU/x86_64/InstructionWriter.pm  view on Meta::CPAN

	$reg1= ($regnum32{$reg1} // croak("$reg1 is not a 32-bit register"));
	$reg2= ($regnum32{$reg2} // croak("$reg2 is not a 32-bit register"));
	$self->{_buf} .= $self->_encode_op_reg_reg(0, $opcode, $reg1, $reg2);
	$self;
}
sub _append_op32_regnum_reg {
	my ($self, $opcode, $regnum, $reg2)= @_;
	$reg2= ($regnum32{$reg2} // croak("$reg2 is not a 32-bit register"));
	$self->{_buf} .= $self->_encode_op_reg_reg(0, $opcode, $regnum, $reg2);
	$self;
}
sub _append_op16_reg_reg {
	my ($self, $opcode, $reg1, $reg2)= @_;
	$reg1= ($regnum16{$reg1} // croak("$reg1 is not a 16-bit register"));
	$reg2= ($regnum16{$reg2} // croak("$reg2 is not a 16-bit register"));
	$self->{_buf} .= "\x66" . $self->_encode_op_reg_reg(0, $opcode, $reg1, $reg2);
	$self;
}
sub _append_op16_regnum_reg {
	my ($self, $opcode, $regnum, $reg2)= @_;
	$reg2= ($regnum16{$reg2} // croak("$reg2 is not a 16-bit register"));
	$self->{_buf} .= "\x66" . $self->_encode_op_reg_reg(0, $opcode, $regnum, $reg2);
	$self;
}
sub _append_op8_regnum_reg {
	_append_op8_reg_reg(@_, $_[2]);
}
sub _append_op8_reg_reg {
	my ($self, $opcode, $reg1, $reg2, $reg1num)= @_;
	$reg1num //= $regnum8{$reg1} // croak "$reg1 is not a valid 8-bit register";
	my $reg2num= $regnum8{$reg2} // croak "$reg2 is not a valid 8-bit register";
	# special case for the "high byte" registers.  They can't be used in an
	# instruction that uses the REX prefix.
	my $uses_high_byte= ($reg1num|$reg2num)&0x10;
	my $uses_extended_reg= ($reg1num|$reg2num)&0x20;
	my $mod_rm= 0xC0 | (($reg1num & 7) << 3) | ($reg2num & 7);
	if ($uses_extended_reg) {
		croak "Can't combine $reg1 with $reg2 in same instruction"
			if $uses_high_byte;
		$self->{_buf} .= pack('CCC', 0x40|(($reg1num & 8) >> 1) | (($reg2num & 8) >> 3), $opcode, $mod_rm)
	} else {
		$self->{_buf} .= pack('CC', $opcode, $mod_rm);
	}
	$self;
}

sub _append_op128_xreg_xreg {
	my ($self, $prefix, $rex, $opcode, $xreg1, $xreg2)= @_;
	$xreg1= $regnum128{$xreg1} // croak("$xreg1 is not a 128-bit register");
	$xreg2= $regnum128{$xreg2} // croak("$xreg2 is not a 128-bit register");
	$rex |= ($xreg1 & 8) >> 1 | ($xreg2 & 8) >> 3;
	my $modrm= 0xC0 | ($xreg1 & 7) << 3 | ($xreg2 & 7);
	$_[0]{_buf} .= !$rex? pack('a*CCC', $prefix, $opcode >> 8, $opcode & 0xFF, $modrm)
		: pack('a*CCCC', $prefix, 0x40|$rex, $opcode >> 8, $opcode & 0xFF, $modrm);
	$_[0]
}

sub _append_op128_xreg_reg {
	my ($self, $prefix, $rex, $opcode, $xreg, $reg)= @_;
	$xreg= $regnum128{$xreg} // croak("$xreg is not a 128-bit register");
	if (defined(my $regid= $regnum64{$reg})) {
		$rex |= 8;
		$reg= $regid;
	} elsif (defined($regid= $regnum32{$reg})) {
		$reg= $regid;
	} else {
		croak("$reg is not a 32 or 64-bit register");
	}
	$rex |= ($xreg & 8) >> 1 | ($reg & 8) >> 3;
	my $modrm= 0xC0 | ($xreg & 7) << 3 | ($reg & 7);
	$_[0]{_buf} .= !$rex? pack('a*CCC', $prefix, $opcode >> 8, $opcode & 0xFF, $modrm)
		: pack('a*CCCC', $prefix, 0x40|$rex, $opcode >> 8, $opcode & 0xFF, $modrm);
	$_[0]
}

#=head2 _append_op##_reg_mem
#
#Encode standard ##-bit instruction with REX prefix which addresses memory for one of its operands.
#The encoded length might not be resolved until later if an unknown displacement value was given.
#
#=cut

sub _append_op128_xreg_mem {
	my ($self, $prefix, $rex, $opcode, $reg, $mem)= @_;
	$reg= $regnum128{$reg} // croak "$reg is not a valid 128-bit register";
	$self->_append_op_reg_mem($prefix, $rex, $opcode, $reg, $mem);
}

sub _append_op64_reg_mem {
	my ($self, $rex, $opcode, $reg, $mem)= @_;
	$reg= $regnum64{$reg} // croak "$reg is not a valid 64-bit register"
		if defined $reg;
	$self->_append_op_reg_mem(undef, $rex, $opcode, $reg, $mem);
}

sub _append_op32_reg_mem {
	my ($self, $rex, $opcode, $reg, $mem)= @_;
	$reg= $regnum32{$reg} // croak "$reg is not a valid 32-bit register"
		if defined $reg;
	$self->_append_op_reg_mem(undef, $rex, $opcode, $reg, $mem);
}

sub _append_op16_reg_mem {
	my ($self, $rex, $opcode, $reg, $mem)= @_;
	$reg= $regnum16{$reg} // croak "$reg is not a valid 16-bit register"
		if defined $reg;
	$self->_append_op_reg_mem("\x66", $rex, $opcode, $reg, $mem);
}

sub _append_op8_reg_mem {
	my ($self, $rex, $opcode, $reg, $mem)= @_;
	my $regnum= $regnum8{$reg} // croak "$reg is not a valid 8-bit register";
	# special case for needing REX byte for SPL, BPL, DIL, and SIL
	$rex |= 0x40 if $regnum & 0x20;
	# special case for the "high byte" registers
	if ($regnum & 0x10) {
		my ($base_reg, $disp, $index_reg, $scale)= @$mem;
		croak "Cannot use $reg in instruction with REX prefix"
			if $rex || (($regnum64{$base_reg//''}//0) & 8) || (($regnum64{$index_reg//''}//0) & 8);
	}	
	$self->_append_op_reg_mem(undef, $rex, $opcode, $regnum, $mem);
}

sub _append_op_reg_mem {
	my ($self, $prefix, $rex, $opcode, $regnum, $mem)= @_;