{
package Coro::State;
use common::sense;
my @insn;
$insn[0][1] = "\x0f\xb6"; # movzbl mem -> rax
$insn[0][2] = "\x0f\xb7"; # movzwl mem -> rax
$insn[0][4] = "\x8b"; # movl mem -> rax
$insn[1][1] = "\x88"; # movb al -> mem
$insn[1][2] = "\x66\x89"; # movw eax -> mem
$insn[1][4] = "\x89"; # movl rax -> mem
my $modrm_abs = 0x05;
my $modrm_disp8 = 0x40;
my $modrm_disp32 = 0x80;
my $modrm_edx = 0x02;
my @vars;
my $mov = sub {
my ($size, $mod_rm, $store, $offset) = @_;
if ($mod_rm == $modrm_abs) {
$offset = pack "V", $offset;
} else {
if ($offset < -128 || $offset > 127) {
$mod_rm |= $modrm_disp32;
$offset = pack "V", $offset;
} elsif ($offset) {
$mod_rm |= $modrm_disp8;
$offset = pack "c", $offset;
} else {
$offset = "";
}
}
my $insn = $insn[$store][$size] . (chr $mod_rm) . $offset;
# some instructions have shorter sequences
$insn =~ s/^\x8b\x05/\xa1/;
$insn =~ s/^\x88\x05/\xa2/;
$insn =~ s/^\x66\x89\x05/\x66\xa3/;
$insn =~ s/^\x89\x05/\xa3/;
$insn
};
my $gencopy = sub {
my ($save) = shift;
my $code = "\x8b\x54\x24\x04"; # mov 4(%esp),%edx
my $curslot = 0;
for (@vars) {
my ($addr, $asize, $slot, $ssize) = @$_;
my $slotofs = $slot - $curslot;
# the sort ensures that this condition and adjustment suffices
if ($slotofs > 127) {
my $adj = 256;
$code .= "\x81\xc2" . pack "V", $adj; # add imm32, %edi
$curslot += $adj;
$slotofs -= $adj;
}
if ($save) {
$code .= $mov->($asize, $modrm_abs, 0, $addr);
$code .= $mov->($ssize, $modrm_edx, 1, $slotofs);
} else {
$code .= $mov->($ssize, $modrm_edx, 0, $slotofs);
$code .= $mov->($asize, $modrm_abs, 1, $addr);
}
}
$code .= "\xc3"; # retl
$code
};
sub _jit {
@vars = @_;
# split 8-byte accesses into two 4-byte accesses
# not needed even for 64 bit perls, but you never know
for (@vars) {
if ($_->[1] == 8) {
die "Coro: FATAL - cannot handle size mismatch between 8 and $_->[3] byte slots.\n";
$_->[1] =
$_->[3] = 4;
push @vars,
[$_->[0] + 4, 4,
$_->[1] + 4, 4];
}
}
# sort by slot offset, required by gencopy to work
@vars = sort { $a->[2] <=> $b->[2] } @vars;
# we *could* combine adjacent vars, but this is not very common
my $load = $gencopy->(0);
my $save = $gencopy->(1);
#open my $fh, ">dat"; syswrite $fh, $save; system "objdump -b binary -m i386 -D dat";
#warn length $load;
#warn length $save;
($load, $save)
}
}
1