1#!/usr/local/bin/perl 2 3{ 4 package Coro::State; 5 6 use common::sense; 7 8 my @insn; 9 10 $insn[0][1] = "\x0f\xb6"; # movzbl mem -> rax 11 $insn[0][2] = "\x0f\xb7"; # movzwl mem -> rax 12 $insn[0][4] = "\x8b"; # movl mem -> rax 13 $insn[1][1] = "\x88"; # movb al -> mem 14 $insn[1][2] = "\x66\x89"; # movw eax -> mem 15 $insn[1][4] = "\x89"; # movl rax -> mem 16 17 my $modrm_abs = 0x05; 18 my $modrm_disp8 = 0x40; 19 my $modrm_disp32 = 0x80; 20 my $modrm_edx = 0x02; 21 22 my @vars; 23 24 my $mov = sub { 25 my ($size, $mod_rm, $store, $offset) = @_; 26 27 if ($mod_rm == $modrm_abs) { 28 $offset = pack "V", $offset; 29 } else { 30 if ($offset < -128 || $offset > 127) { 31 $mod_rm |= $modrm_disp32; 32 $offset = pack "V", $offset; 33 } elsif ($offset) { 34 $mod_rm |= $modrm_disp8; 35 $offset = pack "c", $offset; 36 } else { 37 $offset = ""; 38 } 39 } 40 41 my $insn = $insn[$store][$size] . (chr $mod_rm) . $offset; 42 43 # some instructions have shorter sequences 44 45 $insn =~ s/^\x8b\x05/\xa1/; 46 $insn =~ s/^\x88\x05/\xa2/; 47 $insn =~ s/^\x66\x89\x05/\x66\xa3/; 48 $insn =~ s/^\x89\x05/\xa3/; 49 50 $insn 51 }; 52 53 my $gencopy = sub { 54 my ($save) = shift; 55 56 my $code = "\x8b\x54\x24\x04"; # mov 4(%esp),%edx 57 58 my $curslot = 0; 59 60 for (@vars) { 61 my ($addr, $asize, $slot, $ssize) = @$_; 62 63 my $slotofs = $slot - $curslot; 64 65 # the sort ensures that this condition and adjustment suffices 66 if ($slotofs > 127) { 67 my $adj = 256; 68 $code .= "\x81\xc2" . pack "V", $adj; # add imm32, %edi 69 $curslot += $adj; 70 $slotofs -= $adj; 71 } 72 73 if ($save) { 74 $code .= $mov->($asize, $modrm_abs, 0, $addr); 75 $code .= $mov->($ssize, $modrm_edx, 1, $slotofs); 76 } else { 77 $code .= $mov->($ssize, $modrm_edx, 0, $slotofs); 78 $code .= $mov->($asize, $modrm_abs, 1, $addr); 79 } 80 } 81 82 $code .= "\xc3"; # retl 83 84 $code 85 }; 86 87 sub _jit { 88 @vars = @_; 89 90 # split 8-byte accesses into two 4-byte accesses 91 # not needed even for 64 bit perls, but you never know 92 for (@vars) { 93 if ($_->[1] == 8) { 94 die "Coro: FATAL - cannot handle size mismatch between 8 and $_->[3] byte slots.\n"; 95 96 $_->[1] = 97 $_->[3] = 4; 98 99 push @vars, 100 [$_->[0] + 4, 4, 101 $_->[1] + 4, 4]; 102 } 103 } 104 105 # sort by slot offset, required by gencopy to work 106 @vars = sort { $a->[2] <=> $b->[2] } @vars; 107 108 # we *could* combine adjacent vars, but this is not very common 109 110 my $load = $gencopy->(0); 111 my $save = $gencopy->(1); 112 113 #open my $fh, ">dat"; syswrite $fh, $save; system "objdump -b binary -m i386 -D dat"; 114 #warn length $load; 115 #warn length $save; 116 117 ($load, $save) 118 } 119} 120 1211 122