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