File Coverage

blib/lib/Coro/jit-amd64-unix.pl
Criterion Covered Total %
statement 3 3 100.0
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 4 4 100.0


line stmt bran cond sub pod time code
1             #!/opt/bin/perl
2              
3             {
4             package Coro::State;
5              
6 21     21   5688 use common::sense;
  21         45  
  21         98  
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[0][8] = "\x48\x8b"; # movq mem -> rax
14             $insn[1][1] = "\x88"; # movb al -> mem
15             $insn[1][2] = "\x66\x89"; # movw ax -> mem
16             $insn[1][4] = "\x89"; # movl eax -> mem
17             $insn[1][8] = "\x48\x89"; # movq rax -> mem
18              
19             my $modrm_disp8 = 0x40;
20             my $modrm_disp32 = 0x80;
21             my $modrm_rsi = 0x06;
22             my $modrm_rdi = 0x07;
23              
24             my @vars;
25              
26             my $mov_ind = sub {
27             my ($size, $mod_rm, $store, $offset) = @_;
28              
29             if ($offset < -128 || $offset > 127) {
30             $mod_rm |= $modrm_disp32;
31             $offset = pack "V", $offset;
32             } elsif ($offset) {
33             $mod_rm |= $modrm_disp8;
34             $offset = pack "c", $offset;
35             } else {
36             $offset = "";
37             }
38              
39             $insn[$store][$size] . (chr $mod_rm) . $offset
40             };
41              
42             my $gencopy = sub {
43             my ($save) = shift;
44              
45             my $curbase = undef;
46              
47             my $code;
48              
49             my $curslot = 0;
50              
51             for (@vars) {
52             my ($addr, $asize, $slot, $ssize) = @$_;
53              
54             if (!defined $curbase || abs ($curbase - $addr) > 0x7ffffff) {
55             $curbase = $addr + 128;
56             $code .= "\x48\xbe" . pack "Q", $curbase; # mov imm64, %rsi
57             }
58              
59             my $slotofs = $slot - $curslot;
60              
61             # the sort ensures that this condition and adjustment suffices
62             if ($slotofs > 127) {
63             my $adj = 256;
64             $code .= "\x48\x81\xc7" . pack "i", $adj; # addq imm32, %rdi
65             $curslot += $adj;
66             $slotofs -= $adj;
67             }
68              
69             if ($save) {
70             $code .= $mov_ind->($asize, $modrm_rsi, 0, $addr - $curbase);
71             $code .= $mov_ind->($ssize, $modrm_rdi, 1, $slotofs);
72             } else {
73             $code .= $mov_ind->($ssize, $modrm_rdi, 0, $slotofs);
74             $code .= $mov_ind->($asize, $modrm_rsi, 1, $addr - $curbase);
75             }
76             }
77              
78             $code .= "\xc3"; # retq
79              
80             $code
81             };
82              
83             sub _jit {
84             @vars = @_;
85              
86             # sort all variables into 256 byte blocks, biased by -128
87             # so gencopy can += 256 occasionally. within those blocks,
88             # sort by address so we can play further tricks.
89             @vars = sort {
90             (($a->[2] + 128) & ~255) <=> (($b->[2] + 128) & ~255)
91             or $a->[0] <=> $b->[0]
92             } @vars;
93              
94             # we *could* combine adjacent vars, but this is not very common
95              
96             my $load = $gencopy->(0);
97             my $save = $gencopy->(1);
98              
99             #open my $fh, ">dat"; syswrite $fh, $save; system "objdump -b binary -m i386 -M x86-64 -D dat";#d#
100             #warn length $load;#d#
101             #warn length $save;#d#
102              
103             ($load, $save)
104             }
105             }
106              
107             1