File Coverage

blib/lib/CPU/x86_64/InstructionWriter.pm
Criterion Covered Total %
statement 823 1010 81.4
branch 282 404 69.8
condition 98 258 37.9
subroutine 431 551 78.2
pod 102 464 21.9
total 1736 2687 64.6


line stmt bran cond sub pod time code
1             package CPU::x86_64::InstructionWriter;
2             our $VERSION = '0.001'; # VERSION
3 17     17   1625530 use v5.10;
  17         236  
4 17     17   9572 use Moo 2;
  17         194956  
  17         108  
5 17     17   25062 use Carp;
  17         37  
  17         999  
6 17     17   108 use Scalar::Util 'looks_like_number';
  17         32  
  17         701  
7 17     17   150 use Exporter 'import';
  17         39  
  17         428  
8 17     17   7779 use CPU::x86_64::InstructionWriter::Unknown;
  17         64  
  17         540  
9 17     17   7786 use CPU::x86_64::InstructionWriter::Label;
  17         48  
  17         918  
10              
11             # ABSTRACT: Assemble x86-64 instructions using a pure-perl API
12              
13              
14             (0x7FFFFFFE << 31) > 0 && (0x7FFFFFFE << 63) == 0
15             or die "Author is lazy and requires 64-bit perl integers\n";
16 17     17   117 no warnings 'portable';
  17         33  
  17         2607  
17              
18             my @byte_registers= qw( AH AL BH BL CH CL DH DL SPL BPL SIL DIL R8B R9B R10B R11B R12B R13B R14B R15B );
19             my %byte_register_alias= ( map {; "R${_}L" => "R${_}B" } 8..15 );
20             my @word_registers= qw( AX BX CX DX SI DI SP BP R8W R9W R10W R11W R12W R13W R14W R15W );
21             my @long_registers= qw( EAX EBX ECX EDX ESI EDI ESP EBP R8D R9D R10D R11D R12D R13D R14D R15D );
22             my @quad_registers= qw( RAX RBX RCX RDX RSI RDI RSP RBP R8 R9 R10 R11 R12 R13 R14 R15 RIP RFLAGS );
23             my @registers= ( @byte_registers, @word_registers, @long_registers, @quad_registers );
24             {
25             # Create a constant for each register name
26 17     17   146 no strict 'refs';
  17         32  
  17         38577  
27             eval 'sub '.$_.' { \''.$_.'\' } 1' || croak $@
28 0     0 0 0 for @registers;
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
  0     0 0 0  
29             *{__PACKAGE__."::$_"}= *{__PACKAGE__."::$byte_register_alias{$_}"}
30             for keys %byte_register_alias;
31             }
32              
33             # Map 64-bit register names to the numeric register number
34             my %regnum64= (
35             RAX => 0, RCX => 1, RDX => 2, RBX => 3,
36             rax => 0, rcx => 1, rdx => 2, rbx => 3,
37             RSP => 4, RBP => 5, RSI => 6, RDI => 7,
38             rsp => 4, rbp => 5, rsi => 6, rdi => 7,
39             map { $_ => $_, "R$_" => $_, "r$_" => $_ } 0..15
40             );
41              
42             my %regnum32= (
43             EAX => 0, ECX => 1, EDX => 2, EBX => 3,
44             eax => 0, ecx => 1, edx => 2, ebx => 3,
45             ESP => 4, EBP => 5, ESI => 6, EDI => 7,
46             esp => 4, ebp => 5, esi => 6, edi => 7,
47             map { $_ => $_, "R${_}D" => $_, "r${_}d" => $_ } 0..15
48             );
49              
50             my %regnum16= (
51             AX => 0, CX => 1, DX => 2, BX => 3,
52             ax => 0, cx => 1, dx => 2, bx => 3,
53             SP => 4, BP => 5, SI => 6, DI => 7,
54             sp => 4, bp => 5, si => 6, di => 7,
55             map { $_ => $_, "R${_}W" => $_, "r${_}w" => $_ } 0..15
56             );
57              
58             my %regnum8= (
59             AL => 0, CL => 1, DL => 2, BL => 3,
60             al => 0, cl => 1, dl => 2, bl => 3,
61             SPL => 4, BPL => 5, SIL => 6, DIL => 7,
62             spl => 4, bpl => 5, sil => 6, dil => 7,
63             map { $_ => $_, "R${_}B" => $_, "r${_}b" => $_, "R${_}L" => $_, "r${_}l" => $_ } 0..15
64             );
65             my %regnum8_high= (
66             AH => 4, CH => 5, DH => 6, BH => 7,
67             ah => 4, ch => 5, dh => 6, bh => 7,
68             );
69             my %register_bits= (
70             (map { $_ => 64 } keys %regnum64),
71             (map { $_ => 32 } keys %regnum32),
72             (map { $_ => 16 } keys %regnum16),
73             (map { $_ => 8 } keys %regnum8),
74             );
75              
76 8     8 0 24 sub unknown { CPU::x86_64::InstructionWriter::Unknown->new(name => $_[0]); }
77 0     0 0 0 sub unknown8 { CPU::x86_64::InstructionWriter::Unknown->new(bits => 8, name => $_[0]); }
78 0     0 0 0 sub unknown16 { CPU::x86_64::InstructionWriter::Unknown->new(bits => 16, name => $_[0]); }
79 0     0 0 0 sub unknown32 { CPU::x86_64::InstructionWriter::Unknown->new(bits => 32, name => $_[0]); }
80 54807     54807 0 178467 sub unknown64 { CPU::x86_64::InstructionWriter::Unknown->new(bits => 64, name => $_[0]); }
81 0     0 0 0 sub unknown7 { CPU::x86_64::InstructionWriter::Unknown->new(bits => 7, name => $_[0]); }
82 0     0 0 0 sub unknown15 { CPU::x86_64::InstructionWriter::Unknown->new(bits => 15, name => $_[0]); }
83 0     0 0 0 sub unknown31 { CPU::x86_64::InstructionWriter::Unknown->new(bits => 31, name => $_[0]); }
84 0     0 0 0 sub unknown63 { CPU::x86_64::InstructionWriter::Unknown->new(bits => 63, name => $_[0]); }
85              
86             our %EXPORT_TAGS= (
87             registers => \@registers,
88             unknown => [qw( unknown unknown8 unknown16 unknown32 unknown64 unknown7 unknown15 unknown31 unknown63 )],
89             );
90             our @EXPORT_OK= ( map { @{$_} } values %EXPORT_TAGS );
91              
92              
93             has start_address => ( is => 'rw', default => sub { unknown64() } );
94             has debug => ( is => 'rw' );
95              
96             has _buf => ( is => 'rw', default => sub { '' } );
97             has _unresolved => ( is => 'rw', default => sub { [] } );
98              
99              
100             has labels => ( is => 'rw', default => sub {; {} } );
101              
102              
103             sub get_label {
104 139     139 1 237 my ($self, $name)= @_;
105 139         264 my $labels= $self->labels;
106 139 100 66     482 unless (defined $name && defined $labels->{$name}) {
107 61         179 my $label= bless { relative_to => $self->start_address }, __PACKAGE__.'::Label';
108 61 50       129 $name= "$label" unless defined $name;
109 61         110 $label->{name}= $name;
110 61         140 $labels->{$name}= $label;
111             }
112 139         261 $labels->{$name};
113             }
114              
115              
116             sub label {
117 61 50   61 1 147 @_ == 2 or croak "Invalid arguments to 'mark'";
118            
119             # If they gave an undefined label, we auto-populate it, which modifies
120             # the variable they passed to this function.
121 61 50       123 $_[1]= $_[0]->get_label
122             unless defined $_[1];
123            
124 61         113 my ($self, $label)= @_;
125             # If they give a label by name, auto-inflate it
126 61 50       149 $label= $self->get_label($label)
127             unless ref $label;
128            
129             # A label can only exist once
130 61 50       135 defined $label->{offset} and croak "Can't mark label '$label->{name}' twice";
131            
132             # Set the label's current location
133 61         107 $label->{offset}= length($self->{_buf});
134 61         98 $label->{len}= 0;
135            
136             # Add it to the list of unresolved things, so its position can be updated
137 61         94 push @{ $self->_unresolved }, $label;
  61         120  
138 61         136 return $self;
139             }
140              
141              
142             sub bytes {
143 54830     54830 1 96711 my $self= shift;
144 54830         134743 $self->_resolve;
145 54830         255558 return $self->_buf;
146             }
147              
148              
149 1     1 1 9 sub data { $_[0]{_buf} .= $_[1] }
150 2     2 1 13 sub data_i8 { $_[0]{_buf} .= chr($_[1]) }
151 1     1 1 15 sub data_i16 { $_[0]{_buf} .= pack('v', $_[1]) }
152 1     1 1 11 sub data_i32 { $_[0]{_buf} .= pack('V', $_[1]) }
153 0     0 1 0 sub data_i64 { $_[0]{_buf} .= pack('
154              
155              
156 0     0 1 0 sub data_f32 { $_[0]{_buf} .= pack('f', $_[1]) }
157 0     0 1 0 sub data_f64 { $_[0]{_buf} .= pack('d', $_[1]) }
158              
159              
160             sub align { # ( self, bytes, fill_byte)
161 1     1 1 5 my ($self, $bytes, $fill)= @_;
162 1 50       4 ($bytes & ($bytes-1))
163             and croak "Bytes must be a power of 2";
164 1         6 $self->_align(~($bytes-1), $fill);
165             }
166             sub _align {
167 4     4   13 my ($self, $mask, $fill)= @_;
168 4   100     19 $fill //= "\x90";
169 4 50       12 length($fill) == 1 or croak "Fill byte must be 1 byte long";
170             $self->_mark_unresolved(
171             0,
172             encode => sub {
173             #warn "start=$_[1]{start}, mask=$mask, ~mask=${\~$mask} ".((($_[1]{start} + ~$mask) & $mask) - $_[1]{start})."\n";
174             $fill x ((($_[1]{offset} + ~$mask) & $mask) - $_[1]{offset})
175 20     20   55 }
176 4         27 );
177             }
178 1     1 0 10 sub align2 { splice @_, 1, 0, ~1; &_align; }
  1         3  
179 1     1 0 5 sub align4 { splice @_, 1, 0, ~3; &_align; }
  1         4  
180 1     1 0 6 sub align8 { splice @_, 1, 0, ~7; &_align; }
  1         3  
181              
182              
183             sub _autodetect_signature_dst_src {
184 9     9   24 my ($self, $opname, $dst, $src, $bits)= @_;
185 9 50 66     53 $bits ||= $register_bits{$dst} || $register_bits{$src}
      33        
186             or croak "Can't determine bit-width of ".uc($opname)." instruction. "
187             ."Use ->$opname(\$dst, \$src, \$bits) to clarify, when there is no register";
188             my $dst_type= looks_like_number($dst)? 'imm'
189             : ref $dst eq 'ARRAY'? 'mem'
190             : ref $dst && ref($dst)->can('value')? 'imm'
191 9 50 33     57 : $register_bits{$dst}? 'reg'
    50          
    100          
    50          
192             : croak "Can't identify type of destination operand $dst";
193             my $src_type= looks_like_number($src)? 'imm'
194             : ref $src eq 'ARRAY'? 'mem'
195             : ref $src && ref($src)->can('value')? 'imm'
196 9 50 33     44 : $register_bits{$src}? 'reg'
    50          
    100          
    100          
197             : croak "Can't identify type of source operand $src";
198 9         22 my $method= "$opname${bits}_${dst_type}_${src_type}";
199 9   33     57 ($self->can($method) || croak "No ".uc($opname)." variant $method available")
200             ->($self, $dst, $src);
201             }
202              
203             sub _autodetect_signature_1op {
204 0     0   0 my ($self, $opname, $operand, $bits)= @_;
205 0         0 my $opr_type= $register_bits{$operand};
206 0 0 0     0 $bits ||= $opr_type
207             or croak "Can't determine bit-width of ".uc($opname)." instruction. "
208             ."Use ->$opname(\$arg, \$bits) to clarify, when \$arg is not a register";
209 0 0       0 $opr_type= $opr_type? 'reg'
    0          
    0          
210             : ref $operand eq 'ARRAY'? 'mem'
211             : looks_like_number($operand)? 'imm'
212             : croak "Can't identify type of operand $operand";
213 0         0 my $method= "$opname${bits}_${opr_type}";
214 0   0     0 ($self->can($method) || croak "No ".uc($opname)." variant $method available")
215             ->($self, $operand);
216             }
217              
218              
219             sub nop {
220 117 100   117 1 413 $_[0]{_buf} .= (defined $_[1]? "\x90" x $_[1] : "\x90");
221 117         296 $_[0];
222             }
223              
224             sub pause {
225 0 0   0 1 0 $_[0]{_buf} .= (defined $_[1]? "\xF3\x90" x $_[1] : "\xF3\x90");
226 0         0 $_[0]
227             }
228              
229              
230             sub call_label {
231 2 50   2 1 9 @_ == 2 or croak "Wrong arguments";
232 2 50       10 $_[1]= $_[0]->get_label
233             unless defined $_[1];
234 2         5 my ($self, $label)= @_;
235 17     17   9177 use integer;
  17         256  
  17         87  
236 2 50       10 $label= $self->get_label($label)
237             unless ref $label;
238             $self->_mark_unresolved(
239             5, # estimated length
240             encode => sub {
241 2     2   7 my ($self, $params)= @_;
242 2 50       7 defined $label->{offset} or croak "Label $label is not marked";
243 2         9 my $ofs= $label->{offset} - ($params->{offset}+$params->{len});
244 2 50       8 ($ofs >> 31) == ($ofs >> 32) or croak "Offset must be within 31 bits";
245 2         14 return pack('CV', 0xE8, $ofs);
246             }
247 2         15 );
248 2         10 $self;
249             }
250              
251             sub call_rel {
252 0     0 1 0 my ($self, $immed)= @_;
253 0 0       0 $self->{_buf} .= pack('CV', 0xE8, ref $immed? 0 : $immed);
254 0 0       0 $self->_mark_unresolved(-4, encode => '_repack', bits => 32, value => $immed)
255             if ref $immed;
256 0         0 $self;
257             }
258              
259             sub call_abs_reg {
260 7     7 1 16 my ($self, $reg)= @_;
261             $self->{_buf} .= $self->_encode_op_reg_reg(0, 0xFF, 2,
262 7   33     33 $regnum64{$reg} // croak("$reg is not a 64-bit register"),
263             );
264 7         18 $self;
265             }
266              
267 63     63 1 162 sub call_abs_mem { $_[0]->_append_op64_reg_mem(0, 0xFF, 2, $_[1]) }
268              
269              
270             sub ret {
271 3     3 0 8 my ($self, $pop_bytes)= @_;
272 3 100       11 if ($pop_bytes) {
273 2 50       16 $self->{_buf} .= pack('Cv', 0xC2, ref $pop_bytes? 0 : $pop_bytes);
274 2 50       6 $self->_mark_unresolved(-2, encode => '_repack', bits => 16, value => $pop_bytes)
275             if ref $pop_bytes;
276             }
277             else {
278 1         4 $self->{_buf} .= "\xC3";
279             }
280 3         8 $self;
281             }
282              
283              
284             sub jmp {
285 4 50   4 1 30 @_ == 2 or croak "Wrong arguments";
286 4 50       10 $_[1]= $_[0]->get_label
287             unless defined $_[1];
288 4         9 my ($self, $label)= @_;
289 17     17   8614 use integer;
  17         40  
  17         65  
290 4 50       13 $label= $self->get_label($label)
291             unless ref $label;
292             $self->_mark_unresolved(
293             2, # estimated length
294             encode => sub {
295 10     10   18 my ($self, $params)= @_;
296 10 50       21 defined $label->{offset} or croak "Label $label is not marked";
297 10         22 my $ofs= $label->{offset} - ($params->{offset}+$params->{len});
298 10         20 my $short= (($ofs>>7) == ($ofs>>8));
299 10 100       39 return $short?
300             pack('Cc', 0xEB, $ofs)
301             : pack('CV', 0xE9, $ofs);
302             }
303 4         23 );
304 4         15 $self;
305             }
306              
307              
308             sub jmp_abs_reg {
309 7     7 1 15 my ($self, $reg)= @_;
310             $self->{_buf} .= $self->_encode_op_reg_reg(0, 0xFF, 4,
311 7   33     30 $regnum64{$reg} // croak("$reg is not a 64-bit register"),
312             );
313 7         17 $self;
314             }
315              
316              
317             sub jmp_abs_mem {
318 63     63 1 154 $_[0]->_append_op64_reg_mem(0, 0xFF, 4, $_[1]);
319             }
320              
321              
322 4     4 1 22 sub jmp_if_eq { shift->_append_jmp_cond(4, shift) }
323             *jz= *jmp_if_eq;
324             *je= *jmp_if_eq;
325              
326 4     4 1 20 sub jmp_if_ne { shift->_append_jmp_cond(5, shift) }
327             *jne= *jmp_if_ne;
328             *jnz= *jmp_if_ne;
329              
330              
331 4     4 1 16 sub jmp_if_unsigned_lt { shift->_append_jmp_cond(2, shift) }
332             *jb= *jmp_if_unsigned_lt;
333             *jc= *jmp_if_unsigned_lt;
334              
335 4     4 1 19 sub jmp_if_unsigned_gt { shift->_append_jmp_cond(7, shift) }
336             *ja= *jmp_if_unsigned_gt;
337              
338 4     4 1 20 sub jmp_if_unsigned_le { shift->_append_jmp_cond(6, shift) }
339             *jbe= *jmp_if_unsigned_le;
340              
341 4     4 1 20 sub jmp_if_unsigned_ge { shift->_append_jmp_cond(3, shift) }
342             *jae= *jmp_if_unsigned_ge;
343             *jnc= *jmp_if_unsigned_ge;
344              
345              
346 4     4 1 34 sub jmp_if_signed_lt { shift->_append_jmp_cond(12, shift) }
347             *jl= *jmp_if_signed_lt;
348              
349 4     4 1 20 sub jmp_if_signed_gt { shift->_append_jmp_cond(15, shift) }
350             *jg= *jmp_if_signed_gt;
351              
352 4     4 1 17 sub jmp_if_signed_le { shift->_append_jmp_cond(14, shift) }
353             *jle= *jmp_if_signed_le;
354              
355 4     4 1 17 sub jmp_if_signed_ge { shift->_append_jmp_cond(13, shift) }
356             *jge= *jmp_if_signed_ge;
357              
358              
359 4     4 1 20 sub jmp_if_sign { shift->_append_jmp_cond(8, shift) }
360             *js= *jmp_if_sign;
361              
362 4     4 1 18 sub jmp_unless_sign { shift->_append_jmp_cond(9, shift) }
363             *jns= *jmp_unless_sign;
364              
365 4     4 1 19 sub jmp_if_overflow { shift->_append_jmp_cond(0, shift) }
366             *jo= *jmp_if_overflow;
367              
368 4     4 1 34 sub jmp_unless_overflow { shift->_append_jmp_cond(1, shift) }
369             *jno= *jmp_unless_overflow;
370              
371 4     4 1 17 sub jmp_if_parity_even { shift->_append_jmp_cond(10, shift) }
372             *jpe= *jmp_if_parity_even;
373             *jp= *jmp_if_parity_even;
374              
375 4     4 1 19 sub jmp_if_parity_odd { shift->_append_jmp_cond(11, shift) }
376             *jpo= *jmp_if_parity_odd;
377             *jnp= *jmp_if_parity_odd;
378              
379              
380 2     2 1 10 sub jmp_cx_zero { shift->_append_jmp_cx(0xE3, shift) }
381             *jrcxz= *jmp_cx_zero;
382              
383 2     2 1 8 sub loop { shift->_append_jmp_cx(0xE2, shift) }
384              
385 2     2 1 7 sub loopz { shift->_append_jmp_cx(0xE1, shift) }
386             *loope= *loopz;
387              
388 2     2 1 7 sub loopnz { shift->_append_jmp_cx(0xE0, shift) }
389             *loopne= *loopnz;
390              
391              
392 6     6 1 21 sub mov { splice(@_,1,0,'mov'); &_autodetect_signature_dst_src }
  6         13  
393              
394              
395 49     49 1 120 sub mov64_reg_reg { shift->_append_op64_reg_reg(0x89, $_[1], $_[0]) }
396 1     1 0 6 sub mov32_reg_reg { shift->_append_op32_reg_reg(0x89, $_[1], $_[0]) }
397 0     0 0 0 sub mov16_reg_reg { shift->_append_op16_reg_reg(0x89, $_[1], $_[0]) }
398 0     0 0 0 sub mov8_reg_reg { shift->_append_op8_reg_reg (0x89, $_[1], $_[0]) }
399              
400              
401 443     443 0 1135 sub mov64_mem_reg { $_[0]->_append_mov_reg_mem($_[2], $_[1], 64, 0x89, 0xA3); }
402 445     445 0 1089 sub mov64_reg_mem { $_[0]->_append_mov_reg_mem($_[1], $_[2], 64, 0x8B, 0xA1); }
403 442     442 0 1122 sub mov32_mem_reg { $_[0]->_append_mov_reg_mem($_[2], $_[1], 32, 0x89, 0xA3); }
404 446     446 0 1096 sub mov32_reg_mem { $_[0]->_append_mov_reg_mem($_[1], $_[2], 32, 0x8B, 0xA1); }
405 442     442 0 1089 sub mov16_mem_reg { $_[0]->_append_mov_reg_mem($_[2], $_[1], 16, 0x89, 0xA3); }
406 444     444 0 1065 sub mov16_reg_mem { $_[0]->_append_mov_reg_mem($_[1], $_[2], 16, 0x8B, 0xA1); }
407 442     442 0 1112 sub mov8_mem_reg { $_[0]->_append_mov_reg_mem($_[2], $_[1], 8, 0x88, 0xA2); }
408 444     444 0 1161 sub mov8_reg_mem { $_[0]->_append_mov_reg_mem($_[1], $_[2], 8, 0x8A, 0xA0); }
409              
410             sub _append_mov_reg_mem {
411 3548     3548   6942 my ($self, $reg, $mem, $bits, $opcode, $ax_opcode)= @_;
412             # AX is allowed to load/store 64-bit addresses, if the address is a single constant
413 3548 100 100     10980 if (!defined $mem->[0] && $mem->[1] && !defined $mem->[2] && ($mem->[1] > 0x7FFFFFFF || ref $mem->[1])) {
      100        
      100        
      100        
414 16         32 my $disp= $mem->[1];
415 16 100       78 if (lc($reg) eq ($bits == 64? 'rax' : $bits == 32? 'eax' : $bits == 16? 'ax' : 'al')) {
    100          
    100          
    50          
416 16         111 my $opstr= chr($ax_opcode);
417 16 100       59 $opstr= "\x48".$opstr if $bits == 64;
418 16 100       39 $opstr= "\x66".$opstr if $bits == 16;
419             # Do the dance for values which haven't been resolved yet
420 16 100       46 my $val= ref $disp? $disp->value : $disp;
421 16 100       37 if (!defined $val) {
422             $self->_mark_unresolved(
423             10, # longest instruction possible, not the greatest guess.
424             encode => sub {
425 14     14   32 my $v= $disp->value;
426 14 50       29 defined $v or croak "Placeholder $disp has not been assigned";
427 14 100       62 return $v > 0x7FFFFFFF? $opstr . pack('Q<', $v)
    100          
    100          
428             : ($bits == 16? "\x66":'')
429             . $_[0]->_encode_op_reg_mem($bits == 64? 8 : 0, $opcode, 0, undef, $v);
430             }
431 8         44 );
432             } else {
433 8         31 $self->{_buf} .= $opstr . pack('Q<', $val);
434             }
435 16         124 return $self;
436             }
437             }
438             # Else normal encoding for reg,mem
439 3532 100       8160 return $self->_append_op64_reg_mem(8, $opcode, $reg, $mem) if $bits == 64;
440 2648 100       5559 return $self->_append_op32_reg_mem(0, $opcode, $reg, $mem) if $bits == 32;
441 1764 100       3867 return $self->_append_op16_reg_mem(0, $opcode, $reg, $mem) if $bits == 16;
442 882 50       2430 return $self->_append_op8_reg_mem (0, $opcode, $reg, $mem) if $bits == 8;
443             }
444              
445              
446              
447             sub mov64_reg_imm {
448 63     63 1 137 my ($self, $reg, $immed)= @_;
449 63   33     152 $reg= $regnum64{$reg} // croak("$reg is not a 64-bit register");
450 63         193 $self->_append_possible_unknown('_encode_mov64_imm', [$reg, $immed], 1, 10);
451             }
452             sub _encode_mov64_imm {
453 63     63   123 my ($self, $reg, $immed)= @_;
454 17     17   28665 use integer;
  17         53  
  17         82  
455             # If the number fits in 32-bits, encode as the classic instruction
456 63 100       138 if (!($immed >> 32)) {
    100          
457 28 100       123 return $reg > 7? # need REX byte if extended register
458             pack('CCL<', 0x41, 0xB8 + ($reg&7), $immed)
459             : pack('CL<', 0xB8 + $reg, $immed);
460             }
461             # If the number can sign-extend from 32-bits, encode as 32-bit sign-extend
462             elsif (($immed >> 31) == -1) {
463 21         97 return pack('CCCl<', 0x48 | (($reg & 8) >> 3), 0xC7, 0xC0 + ($reg & 7), $immed);
464             }
465             # else encode as new 64-bit immediate
466             else {
467 14         67 return pack('CCQ<', 0x48 | (($reg & 8) >> 3), 0xB8 + ($reg & 7), $immed);
468             }
469             }
470             sub mov32_reg_imm {
471 57     57 0 127 my ($self, $reg, $immed)= @_;
472 57   33     153 $reg= $regnum32{$reg} // croak("$reg is not a 32-bit register");
473 57 100       136 $self->{_buf} .= "\x41" if $reg > 7;
474 57         165 $self->{_buf} .= pack('C' , 0xB8 | ($reg & 7));
475 57     57   235 $self->_append_possible_unknown(sub { pack('V', $_[1]) }, [$immed], 0, 4);
  57         155  
476             }
477             sub mov16_reg_imm {
478 49     49 0 106 my ($self, $reg, $immed)= @_;
479 49   33     145 $reg= $regnum16{$reg} // croak("$reg is not a 16-bit register");
480 49         93 $self->{_buf} .= "\x66";
481 49 100       108 $self->{_buf} .= "\x41" if $reg > 7;
482 49         128 $self->{_buf} .= pack('C', 0xB8 | ($reg & 7));
483 49     49   194 $self->_append_possible_unknown(sub { pack('v', $_[1]) }, [$immed], 0, 2);
  49         128  
484             }
485             sub mov8_reg_imm {
486 55     55 0 118 my ($self, $reg, $immed)= @_;
487 55         125 $reg= $regnum8{$reg};
488             # Special case for the high-byte registers available without the REX prefix
489 55 100       108 if (!defined $reg) {
490 20   33     51 $reg= $regnum8_high{$_[1]} // croak("$_[1] is not a 8-bit register");
491             } else {
492 35 100       122 $self->{_buf} .= pack('C', 0x40|(($reg&8)>>3)) if $reg > 3;
493             }
494 55         143 $self->{_buf} .= pack('C', 0xB0 | ($reg & 7));
495 55     55   230 $self->_append_possible_unknown(sub { pack('C', $_[1]&0xFF) }, [$immed], 0, 1);
  55         151  
496             }
497              
498              
499 63     63 0 164 sub mov64_mem_imm { $_[0]->_append_op64_const_to_mem(0xC7, 0, $_[2], $_[1]) }
500 63     63 0 151 sub mov32_mem_imm { $_[0]->_append_op32_const_to_mem(0xC7, 0, $_[2], $_[1]) }
501 63     63 0 542 sub mov16_mem_imm { $_[0]->_append_op16_const_to_mem(0xC7, 0, $_[2], $_[1]) }
502 63     63 0 152 sub mov8_mem_imm { $_[0]->_append_op8_const_to_mem (0xC6, 0, $_[2], $_[1]) }
503              
504              
505 3     3 1 12 sub lea { splice(@_,1,0,'lea'); &_autodetect_signature_dst_src }
  3         8  
506              
507 0     0 1 0 sub lea16_reg_reg { $_[0]->_append_op16_reg_reg( 0x8D, $_[1], $_[2]) }
508 441     441 1 1051 sub lea16_reg_mem { $_[0]->_append_op16_reg_mem(0, 0x8D, $_[1], $_[2]) }
509 1     1 1 6 sub lea32_reg_reg { $_[0]->_append_op32_reg_reg( 0x8D, $_[1], $_[2]) }
510 443     443 1 1131 sub lea32_reg_mem { $_[0]->_append_op32_reg_mem(0, 0x8D, $_[1], $_[2]) }
511 0     0 1 0 sub lea64_reg_reg { $_[0]->_append_op64_reg_reg( 0x8D, $_[1], $_[2]) }
512 441     441 1 1069 sub lea64_reg_mem { $_[0]->_append_op64_reg_mem(8, 0x8D, $_[1], $_[2]) }
513              
514              
515 0     0 1 0 sub add { splice(@_,1,0,'add'); &_autodetect_signature_dst_src }
  0         0  
516              
517 49     49 0 111 sub add64_reg_reg { $_[0]->_append_op64_reg_reg(0x01, $_[2], $_[1]) }
518 49     49 0 115 sub add32_reg_reg { $_[0]->_append_op32_reg_reg(0x01, $_[2], $_[1]) }
519 49     49 0 120 sub add16_reg_reg { $_[0]->_append_op16_reg_reg(0x01, $_[2], $_[1]) }
520 49     49 0 115 sub add8_reg_reg { $_[0]->_append_op8_reg_reg (0x00, $_[2], $_[1]) }
521              
522 441     441 0 1121 sub add64_reg_mem { $_[0]->_append_op64_reg_mem(8, 0x03, $_[1], $_[2]); }
523 441     441 0 1068 sub add32_reg_mem { $_[0]->_append_op32_reg_mem(0, 0x03, $_[1], $_[2]); }
524 441     441 0 1172 sub add16_reg_mem { $_[0]->_append_op16_reg_mem(0, 0x03, $_[1], $_[2]); }
525 441     441 0 1190 sub add8_reg_mem { $_[0]->_append_op8_reg_mem (0, 0x02, $_[1], $_[2]); }
526              
527 441     441 0 1086 sub add64_mem_reg { $_[0]->_append_op64_reg_mem(8, 0x01, $_[2], $_[1]); }
528 441     441 0 1146 sub add32_mem_reg { $_[0]->_append_op32_reg_mem(0, 0x01, $_[2], $_[1]); }
529 441     441 0 1167 sub add16_mem_reg { $_[0]->_append_op16_reg_mem(0, 0x01, $_[2], $_[1]); }
530 441     441 0 1165 sub add8_mem_reg { $_[0]->_append_op8_reg_mem (0, 0x00, $_[2], $_[1]); }
531              
532 56     56 0 143 sub add64_reg_imm { shift->_append_mathop64_const(0x05, 0x83, 0x81, 0, @_) }
533 56     56 0 156 sub add32_reg_imm { shift->_append_mathop32_const(0x05, 0x83, 0x81, 0, @_) }
534 49     49 0 126 sub add16_reg_imm { shift->_append_mathop16_const(0x05, 0x83, 0x81, 0, @_) }
535 35     35 0 99 sub add8_reg_imm { shift->_append_mathop8_const (0x04, 0x80, 0, @_) }
536              
537 504     504 0 1309 sub add64_mem_imm { $_[0]->_append_mathop64_const_to_mem(0x83, 0x81, 0, $_[2], $_[1]) }
538 504     504 0 1296 sub add32_mem_imm { $_[0]->_append_mathop32_const_to_mem(0x83, 0x81, 0, $_[2], $_[1]) }
539 441     441 0 1149 sub add16_mem_imm { $_[0]->_append_mathop16_const_to_mem(0x83, 0x81, 0, $_[2], $_[1]) }
540 315     315 0 779 sub add8_mem_imm { $_[0]->_append_mathop8_const_to_mem (0x80, 0, $_[2], $_[1]) }
541              
542              
543 0     0 1 0 sub addcarry { splice(@_,1,0,'addcarry'); &_autodetect_signature_dst_src }
  0         0  
544             *adc= *addcarry;
545              
546 49     49 0 115 sub addcarry64_reg_reg { $_[0]->_append_op64_reg_reg(0x11, $_[2], $_[1]) }
547 49     49 0 109 sub addcarry32_reg_reg { $_[0]->_append_op32_reg_reg(0x11, $_[2], $_[1]) }
548 49     49 0 124 sub addcarry16_reg_reg { $_[0]->_append_op16_reg_reg(0x11, $_[2], $_[1]) }
549 49     49 0 117 sub addcarry8_reg_reg { $_[0]->_append_op8_reg_reg (0x10, $_[2], $_[1]) }
550              
551 441     441 0 1148 sub addcarry64_reg_mem { $_[0]->_append_op64_reg_mem(8, 0x13, $_[1], $_[2]); }
552 441     441 0 1087 sub addcarry32_reg_mem { $_[0]->_append_op32_reg_mem(0, 0x13, $_[1], $_[2]); }
553 441     441 0 1127 sub addcarry16_reg_mem { $_[0]->_append_op16_reg_mem(0, 0x13, $_[1], $_[2]); }
554 441     441 0 1181 sub addcarry8_reg_mem { $_[0]->_append_op8_reg_mem (0, 0x12, $_[1], $_[2]); }
555              
556 441     441 0 1173 sub addcarry64_mem_reg { $_[0]->_append_op64_reg_mem(8, 0x11, $_[2], $_[1]); }
557 441     441 0 1118 sub addcarry32_mem_reg { $_[0]->_append_op32_reg_mem(0, 0x11, $_[2], $_[1]); }
558 441     441 0 1133 sub addcarry16_mem_reg { $_[0]->_append_op16_reg_mem(0, 0x11, $_[2], $_[1]); }
559 441     441 0 1096 sub addcarry8_mem_reg { $_[0]->_append_op8_reg_mem (0, 0x10, $_[2], $_[1]); }
560              
561 56     56 0 144 sub addcarry64_reg_imm { shift->_append_mathop64_const(0x15, 0x83, 0x81, 2, @_) }
562 56     56 0 145 sub addcarry32_reg_imm { shift->_append_mathop32_const(0x15, 0x83, 0x81, 2, @_) }
563 49     49 0 122 sub addcarry16_reg_imm { shift->_append_mathop16_const(0x15, 0x83, 0x81, 2, @_) }
564 35     35 0 80 sub addcarry8_reg_imm { shift->_append_mathop8_const (0x14, 0x80, 2, @_) }
565              
566 504     504 0 1355 sub addcarry64_mem_imm { $_[0]->_append_mathop64_const_to_mem(0x83, 0x81, 2, $_[2], $_[1]) }
567 504     504 0 1295 sub addcarry32_mem_imm { $_[0]->_append_mathop32_const_to_mem(0x83, 0x81, 2, $_[2], $_[1]) }
568 441     441 0 1130 sub addcarry16_mem_imm { $_[0]->_append_mathop16_const_to_mem(0x83, 0x81, 2, $_[2], $_[1]) }
569 315     315 0 764 sub addcarry8_mem_imm { $_[0]->_append_mathop8_const_to_mem (0x80, 2, $_[2], $_[1]) }
570              
571              
572 0     0 1 0 sub sub { splice(@_,1,0,'sub'); &_autodetect_signature_dst_src }
  0         0  
573              
574 49     49 0 112 sub sub64_reg_reg { $_[0]->_append_op64_reg_reg(0x29, $_[2], $_[1]) }
575 49     49 0 120 sub sub32_reg_reg { $_[0]->_append_op32_reg_reg(0x29, $_[2], $_[1]) }
576 49     49 0 130 sub sub16_reg_reg { $_[0]->_append_op16_reg_reg(0x29, $_[2], $_[1]) }
577 49     49 0 116 sub sub8_reg_reg { $_[0]->_append_op8_reg_reg (0x28, $_[2], $_[1]) }
578              
579 441     441 0 1124 sub sub64_reg_mem { $_[0]->_append_op64_reg_mem(8, 0x2B, $_[1], $_[2]); }
580 441     441 0 1130 sub sub32_reg_mem { $_[0]->_append_op32_reg_mem(0, 0x2B, $_[1], $_[2]); }
581 441     441 0 1461 sub sub16_reg_mem { $_[0]->_append_op16_reg_mem(0, 0x2B, $_[1], $_[2]); }
582 441     441 0 1107 sub sub8_reg_mem { $_[0]->_append_op8_reg_mem (0, 0x2A, $_[1], $_[2]); }
583              
584 441     441 0 1145 sub sub64_mem_reg { $_[0]->_append_op64_reg_mem(8, 0x29, $_[2], $_[1]); }
585 441     441 0 1153 sub sub32_mem_reg { $_[0]->_append_op32_reg_mem(0, 0x29, $_[2], $_[1]); }
586 441     441 0 1102 sub sub16_mem_reg { $_[0]->_append_op16_reg_mem(0, 0x29, $_[2], $_[1]); }
587 441     441 0 1075 sub sub8_mem_reg { $_[0]->_append_op8_reg_mem (0, 0x28, $_[2], $_[1]); }
588              
589 56     56 0 151 sub sub64_reg_imm { shift->_append_mathop64_const(0x2D, 0x83, 0x81, 5, @_) }
590 56     56 0 145 sub sub32_reg_imm { shift->_append_mathop32_const(0x2D, 0x83, 0x81, 5, @_) }
591 49     49 0 134 sub sub16_reg_imm { shift->_append_mathop16_const(0x2D, 0x83, 0x81, 5, @_) }
592 35     35 0 87 sub sub8_reg_imm { shift->_append_mathop8_const (0x2C, 0x80, 5, @_) }
593              
594 504     504 0 1319 sub sub64_mem_imm { $_[0]->_append_mathop64_const_to_mem(0x83, 0x81, 5, $_[2], $_[1]) }
595 504     504 0 1334 sub sub32_mem_imm { $_[0]->_append_mathop32_const_to_mem(0x83, 0x81, 5, $_[2], $_[1]) }
596 441     441 0 1106 sub sub16_mem_imm { $_[0]->_append_mathop16_const_to_mem(0x83, 0x81, 5, $_[2], $_[1]) }
597 315     315 0 834 sub sub8_mem_imm { $_[0]->_append_mathop8_const_to_mem (0x80, 5, $_[2], $_[1]) }
598              
599              
600 0     0 1 0 sub and { splice(@_,1,0,'and'); &_autodetect_signature_dst_src }
  0         0  
601              
602 49     49 0 118 sub and64_reg_reg { $_[0]->_append_op64_reg_reg(0x21, $_[2], $_[1]) }
603 49     49 0 117 sub and32_reg_reg { $_[0]->_append_op32_reg_reg(0x21, $_[2], $_[1]) }
604 49     49 0 115 sub and16_reg_reg { $_[0]->_append_op16_reg_reg(0x21, $_[2], $_[1]) }
605 49     49 0 113 sub and8_reg_reg { $_[0]->_append_op8_reg_reg (0x20, $_[2], $_[1]) }
606              
607 441     441 0 1181 sub and64_reg_mem { $_[0]->_append_op64_reg_mem(8, 0x23, $_[1], $_[2]); }
608 441     441 0 1174 sub and32_reg_mem { $_[0]->_append_op32_reg_mem(0, 0x23, $_[1], $_[2]); }
609 441     441 0 1056 sub and16_reg_mem { $_[0]->_append_op16_reg_mem(0, 0x23, $_[1], $_[2]); }
610 441     441 0 1142 sub and8_reg_mem { $_[0]->_append_op8_reg_mem (0, 0x22, $_[1], $_[2]); }
611              
612 441     441 0 1138 sub and64_mem_reg { $_[0]->_append_op64_reg_mem(8, 0x21, $_[2], $_[1]); }
613 441     441 0 1471 sub and32_mem_reg { $_[0]->_append_op32_reg_mem(0, 0x21, $_[2], $_[1]); }
614 441     441 0 1067 sub and16_mem_reg { $_[0]->_append_op16_reg_mem(0, 0x21, $_[2], $_[1]); }
615 441     441 0 1176 sub and8_mem_reg { $_[0]->_append_op8_reg_mem (0, 0x20, $_[2], $_[1]); }
616              
617 56     56 0 145 sub and64_reg_imm { shift->_append_mathop64_const(0x25, 0x83, 0x81, 4, @_) }
618 56     56 0 147 sub and32_reg_imm { shift->_append_mathop32_const(0x25, 0x83, 0x81, 4, @_) }
619 49     49 0 127 sub and16_reg_imm { shift->_append_mathop16_const(0x25, 0x83, 0x81, 4, @_) }
620 35     35 0 93 sub and8_reg_imm { shift->_append_mathop8_const (0x24, 0x80, 4, @_) }
621              
622 504     504 0 1266 sub and64_mem_imm { $_[0]->_append_mathop64_const_to_mem(0x83, 0x81, 4, $_[2], $_[1]) }
623 504     504 0 1271 sub and32_mem_imm { $_[0]->_append_mathop32_const_to_mem(0x83, 0x81, 4, $_[2], $_[1]) }
624 441     441 0 1121 sub and16_mem_imm { $_[0]->_append_mathop16_const_to_mem(0x83, 0x81, 4, $_[2], $_[1]) }
625 315     315 0 832 sub and8_mem_imm { $_[0]->_append_mathop8_const_to_mem (0x80, 4, $_[2], $_[1]) }
626              
627              
628 0     0 1 0 sub or { splice(@_,1,0,'or'); &_autodetect_signature_dst_src }
  0         0  
629              
630 49     49 0 117 sub or64_reg_reg { $_[0]->_append_op64_reg_reg(0x09, $_[2], $_[1]) }
631 49     49 0 107 sub or32_reg_reg { $_[0]->_append_op32_reg_reg(0x09, $_[2], $_[1]) }
632 49     49 0 106 sub or16_reg_reg { $_[0]->_append_op16_reg_reg(0x09, $_[2], $_[1]) }
633 49     49 0 107 sub or8_reg_reg { $_[0]->_append_op8_reg_reg (0x08, $_[2], $_[1]) }
634              
635 441     441 0 1171 sub or64_reg_mem { $_[0]->_append_op64_reg_mem(8, 0x0B, $_[1], $_[2]); }
636 441     441 0 1064 sub or32_reg_mem { $_[0]->_append_op32_reg_mem(0, 0x0B, $_[1], $_[2]); }
637 441     441 0 1043 sub or16_reg_mem { $_[0]->_append_op16_reg_mem(0, 0x0B, $_[1], $_[2]); }
638 441     441 0 1114 sub or8_reg_mem { $_[0]->_append_op8_reg_mem (0, 0x0A, $_[1], $_[2]); }
639              
640 441     441 0 1133 sub or64_mem_reg { $_[0]->_append_op64_reg_mem(8, 0x09, $_[2], $_[1]); }
641 441     441 0 1086 sub or32_mem_reg { $_[0]->_append_op32_reg_mem(0, 0x09, $_[2], $_[1]); }
642 441     441 0 1078 sub or16_mem_reg { $_[0]->_append_op16_reg_mem(0, 0x09, $_[2], $_[1]); }
643 441     441 0 1151 sub or8_mem_reg { $_[0]->_append_op8_reg_mem (0, 0x08, $_[2], $_[1]); }
644              
645 56     56 0 149 sub or64_reg_imm { shift->_append_mathop64_const(0x0D, 0x83, 0x81, 1, @_) }
646 56     56 0 141 sub or32_reg_imm { shift->_append_mathop32_const(0x0D, 0x83, 0x81, 1, @_) }
647 49     49 0 120 sub or16_reg_imm { shift->_append_mathop16_const(0x0D, 0x83, 0x81, 1, @_) }
648 35     35 0 93 sub or8_reg_imm { shift->_append_mathop8_const (0x0C, 0x80, 1, @_) }
649              
650 504     504 0 1286 sub or64_mem_imm { $_[0]->_append_mathop64_const_to_mem(0x83, 0x81, 1, $_[2], $_[1]) }
651 504     504 0 1332 sub or32_mem_imm { $_[0]->_append_mathop32_const_to_mem(0x83, 0x81, 1, $_[2], $_[1]) }
652 441     441 0 1133 sub or16_mem_imm { $_[0]->_append_mathop16_const_to_mem(0x83, 0x81, 1, $_[2], $_[1]) }
653 315     315 0 794 sub or8_mem_imm { $_[0]->_append_mathop8_const_to_mem (0x80, 1, $_[2], $_[1]) }
654              
655              
656 0     0 1 0 sub xor { splice(@_,1,0,'xor'); &_autodetect_signature_dst_src }
  0         0  
657              
658 49     49 0 112 sub xor64_reg_reg { $_[0]->_append_op64_reg_reg(0x31, $_[2], $_[1]) }
659 49     49 0 116 sub xor32_reg_reg { $_[0]->_append_op32_reg_reg(0x31, $_[2], $_[1]) }
660 49     49 0 111 sub xor16_reg_reg { $_[0]->_append_op16_reg_reg(0x31, $_[2], $_[1]) }
661 49     49 0 110 sub xor8_reg_reg { $_[0]->_append_op8_reg_reg (0x30, $_[2], $_[1]) }
662              
663 441     441 0 1099 sub xor64_reg_mem { $_[0]->_append_op64_reg_mem(8, 0x33, $_[1], $_[2]); }
664 441     441 0 1043 sub xor32_reg_mem { $_[0]->_append_op32_reg_mem(0, 0x33, $_[1], $_[2]); }
665 441     441 0 1061 sub xor16_reg_mem { $_[0]->_append_op16_reg_mem(0, 0x33, $_[1], $_[2]); }
666 441     441 0 1114 sub xor8_reg_mem { $_[0]->_append_op8_reg_mem (0, 0x32, $_[1], $_[2]); }
667              
668 441     441 0 1062 sub xor64_mem_reg { $_[0]->_append_op64_reg_mem(8, 0x31, $_[2], $_[1]); }
669 441     441 0 1036 sub xor32_mem_reg { $_[0]->_append_op32_reg_mem(0, 0x31, $_[2], $_[1]); }
670 441     441 0 1067 sub xor16_mem_reg { $_[0]->_append_op16_reg_mem(0, 0x31, $_[2], $_[1]); }
671 441     441 0 1103 sub xor8_mem_reg { $_[0]->_append_op8_reg_mem (0, 0x30, $_[2], $_[1]); }
672              
673 56     56 0 150 sub xor64_reg_imm { shift->_append_mathop64_const(0x35, 0x83, 0x81, 6, @_) }
674 56     56 0 145 sub xor32_reg_imm { shift->_append_mathop32_const(0x35, 0x83, 0x81, 6, @_) }
675 49     49 0 130 sub xor16_reg_imm { shift->_append_mathop16_const(0x35, 0x83, 0x81, 6, @_) }
676 35     35 0 93 sub xor8_reg_imm { shift->_append_mathop8_const (0x34, 0x80, 6, @_) }
677              
678 504     504 0 1319 sub xor64_mem_imm { $_[0]->_append_mathop64_const_to_mem(0x83, 0x81, 6, $_[2], $_[1]) }
679 504     504 0 1344 sub xor32_mem_imm { $_[0]->_append_mathop32_const_to_mem(0x83, 0x81, 6, $_[2], $_[1]) }
680 441     441 0 1186 sub xor16_mem_imm { $_[0]->_append_mathop16_const_to_mem(0x83, 0x81, 6, $_[2], $_[1]) }
681 315     315 0 779 sub xor8_mem_imm { $_[0]->_append_mathop8_const_to_mem (0x80, 6, $_[2], $_[1]) }
682              
683              
684 0     0 1 0 sub shl { splice(@_,1,0,'shl'); &_autodetect_signature_dst_src }
  0         0  
685              
686 77     77 0 205 sub shl64_reg_imm { $_[0]->_append_shiftop_reg_imm(64, 0xD1, 0xC1, 4, $_[1], $_[2]) }
687 63     63 0 161 sub shl32_reg_imm { $_[0]->_append_shiftop_reg_imm(32, 0xD1, 0xC1, 4, $_[1], $_[2]) }
688 49     49 0 119 sub shl16_reg_imm { $_[0]->_append_shiftop_reg_imm(16, 0xD1, 0xC1, 4, $_[1], $_[2]) }
689 55     55 0 139 sub shl8_reg_imm { $_[0]->_append_shiftop_reg_imm( 8, 0xD0, 0xC0, 4, $_[1], $_[2]) }
690              
691 7     7 0 17 sub shl64_reg_cl { $_[0]->_append_op64_reg_reg(0xD3, 4, $_[1]) }
692 7     7 0 17 sub shl32_reg_cl { $_[0]->_append_op32_reg_reg(0xD3, 4, $_[1]) }
693 7     7 0 19 sub shl16_reg_cl { $_[0]->_append_op16_reg_reg(0xD3, 4, $_[1]) }
694 11     11 0 28 sub shl8_reg_cl { $_[0]->_append_op8_opreg_reg(0xD2, 4, $_[1]) }
695              
696 315     315 0 838 sub shl64_mem_imm { $_[0]->_append_shiftop_mem_imm(64, 0xD1, 0xC1, 4, $_[1], $_[2]) }
697 315     315 0 792 sub shl32_mem_imm { $_[0]->_append_shiftop_mem_imm(32, 0xD1, 0xC1, 4, $_[1], $_[2]) }
698 315     315 0 807 sub shl16_mem_imm { $_[0]->_append_shiftop_mem_imm(16, 0xD1, 0xC1, 4, $_[1], $_[2]) }
699 315     315 0 824 sub shl8_mem_imm { $_[0]->_append_shiftop_mem_imm( 8, 0xD0, 0xC0, 4, $_[1], $_[2]) }
700              
701 63     63 0 160 sub shl64_mem_cl { $_[0]->_append_op64_reg_mem(8, 0xD3, 4, $_[1]) }
702 63     63 0 163 sub shl32_mem_cl { $_[0]->_append_op32_reg_mem(0, 0xD3, 4, $_[1]) }
703 63     63 0 161 sub shl16_mem_cl { $_[0]->_append_op16_reg_mem(0, 0xD3, 4, $_[1]) }
704 63     63 0 153 sub shl8_mem_cl { $_[0]->_append_op8_opreg_mem(0, 0xD2, 4, $_[1]) }
705              
706              
707 0     0 1 0 sub shr { splice(@_,1,0,'shr'); &_autodetect_signature_dst_src }
  0         0  
708              
709 77     77 0 197 sub shr64_reg_imm { $_[0]->_append_shiftop_reg_imm(64, 0xD1, 0xC1, 5, $_[1], $_[2]) }
710 63     63 0 147 sub shr32_reg_imm { $_[0]->_append_shiftop_reg_imm(32, 0xD1, 0xC1, 5, $_[1], $_[2]) }
711 49     49 0 115 sub shr16_reg_imm { $_[0]->_append_shiftop_reg_imm(16, 0xD1, 0xC1, 5, $_[1], $_[2]) }
712 55     55 0 132 sub shr8_reg_imm { $_[0]->_append_shiftop_reg_imm( 8, 0xD0, 0xC0, 5, $_[1], $_[2]) }
713              
714 7     7 0 20 sub shr64_reg_cl { $_[0]->_append_op64_reg_reg(0xD3, 5, $_[1]) }
715 7     7 0 21 sub shr32_reg_cl { $_[0]->_append_op32_reg_reg(0xD3, 5, $_[1]) }
716 7     7 0 18 sub shr16_reg_cl { $_[0]->_append_op16_reg_reg(0xD3, 5, $_[1]) }
717 11     11 0 26 sub shr8_reg_cl { $_[0]->_append_op8_opreg_reg(0xD2, 5, $_[1]) }
718              
719 315     315 0 793 sub shr64_mem_imm { $_[0]->_append_shiftop_mem_imm(64, 0xD1, 0xC1, 5, $_[1], $_[2]) }
720 315     315 0 808 sub shr32_mem_imm { $_[0]->_append_shiftop_mem_imm(32, 0xD1, 0xC1, 5, $_[1], $_[2]) }
721 315     315 0 799 sub shr16_mem_imm { $_[0]->_append_shiftop_mem_imm(16, 0xD1, 0xC1, 5, $_[1], $_[2]) }
722 315     315 0 869 sub shr8_mem_imm { $_[0]->_append_shiftop_mem_imm( 8, 0xD0, 0xC0, 5, $_[1], $_[2]) }
723              
724 63     63 0 166 sub shr64_mem_cl { $_[0]->_append_op64_reg_mem(8, 0xD3, 5, $_[1]) }
725 63     63 0 164 sub shr32_mem_cl { $_[0]->_append_op32_reg_mem(0, 0xD3, 5, $_[1]) }
726 63     63 0 160 sub shr16_mem_cl { $_[0]->_append_op16_reg_mem(0, 0xD3, 5, $_[1]) }
727 63     63 0 145 sub shr8_mem_cl { $_[0]->_append_op8_opreg_mem(0, 0xD2, 5, $_[1]) }
728              
729              
730 0     0 1 0 sub sar { splice(@_,1,0,'sar'); &_autodetect_signature_dst_src }
  0         0  
731              
732 77     77 0 215 sub sar64_reg_imm { $_[0]->_append_shiftop_reg_imm(64, 0xD1, 0xC1, 7, $_[1], $_[2]) }
733 63     63 0 157 sub sar32_reg_imm { $_[0]->_append_shiftop_reg_imm(32, 0xD1, 0xC1, 7, $_[1], $_[2]) }
734 49     49 0 119 sub sar16_reg_imm { $_[0]->_append_shiftop_reg_imm(16, 0xD1, 0xC1, 7, $_[1], $_[2]) }
735 55     55 0 138 sub sar8_reg_imm { $_[0]->_append_shiftop_reg_imm( 8, 0xD0, 0xC0, 7, $_[1], $_[2]) }
736              
737 7     7 0 20 sub sar64_reg_cl { $_[0]->_append_op64_reg_reg(0xD3, 7, $_[1]) }
738 7     7 0 19 sub sar32_reg_cl { $_[0]->_append_op32_reg_reg(0xD3, 7, $_[1]) }
739 7     7 0 17 sub sar16_reg_cl { $_[0]->_append_op16_reg_reg(0xD3, 7, $_[1]) }
740 11     11 0 28 sub sar8_reg_cl { $_[0]->_append_op8_opreg_reg(0xD2, 7, $_[1]) }
741              
742 315     315 0 870 sub sar64_mem_imm { $_[0]->_append_shiftop_mem_imm(64, 0xD1, 0xC1, 7, $_[1], $_[2]) }
743 315     315 0 805 sub sar32_mem_imm { $_[0]->_append_shiftop_mem_imm(32, 0xD1, 0xC1, 7, $_[1], $_[2]) }
744 315     315 0 786 sub sar16_mem_imm { $_[0]->_append_shiftop_mem_imm(16, 0xD1, 0xC1, 7, $_[1], $_[2]) }
745 315     315 0 813 sub sar8_mem_imm { $_[0]->_append_shiftop_mem_imm( 8, 0xD0, 0xC0, 7, $_[1], $_[2]) }
746              
747 63     63 0 204 sub sar64_mem_cl { $_[0]->_append_op64_reg_mem(8, 0xD3, 7, $_[1]) }
748 63     63 0 158 sub sar32_mem_cl { $_[0]->_append_op32_reg_mem(0, 0xD3, 7, $_[1]) }
749 63     63 0 157 sub sar16_mem_cl { $_[0]->_append_op16_reg_mem(0, 0xD3, 7, $_[1]) }
750 63     63 0 144 sub sar8_mem_cl { $_[0]->_append_op8_opreg_mem(0, 0xD2, 7, $_[1]) }
751              
752              
753 0     0 1 0 sub cmp { splice(@_,1,0,'cmp'); &_autodetect_signature_dst_src }
  0         0  
754              
755 49     49 0 106 sub cmp64_reg_reg { $_[0]->_append_op64_reg_reg(0x39, $_[2], $_[1]) }
756 49     49 0 112 sub cmp32_reg_reg { $_[0]->_append_op32_reg_reg(0x39, $_[2], $_[1]) }
757 49     49 0 113 sub cmp16_reg_reg { $_[0]->_append_op16_reg_reg(0x39, $_[2], $_[1]) }
758 49     49 0 110 sub cmp8_reg_reg { $_[0]->_append_op8_reg_reg (0x38, $_[2], $_[1]) }
759              
760 441     441 0 1166 sub cmp64_reg_mem { $_[0]->_append_op64_reg_mem(8, 0x3B, $_[1], $_[2]); }
761 441     441 0 1095 sub cmp32_reg_mem { $_[0]->_append_op32_reg_mem(0, 0x3B, $_[1], $_[2]); }
762 441     441 0 1071 sub cmp16_reg_mem { $_[0]->_append_op16_reg_mem(0, 0x3B, $_[1], $_[2]); }
763 441     441 0 1115 sub cmp8_reg_mem { $_[0]->_append_op8_reg_mem (0, 0x3A, $_[1], $_[2]); }
764              
765 0     0 0 0 sub cmp64_mem_reg { $_[0]->_append_op64_reg_mem(8, 0x39, $_[2], $_[1]); }
766 0     0 0 0 sub cmp32_mem_reg { $_[0]->_append_op32_reg_mem(0, 0x39, $_[2], $_[1]); }
767 0     0 0 0 sub cmp16_mem_reg { $_[0]->_append_op16_reg_mem(0, 0x39, $_[2], $_[1]); }
768 0     0 0 0 sub cmp8_mem_reg { $_[0]->_append_op8_reg_mem (0, 0x38, $_[2], $_[1]); }
769              
770 56     56 0 137 sub cmp64_reg_imm { shift->_append_mathop64_const(0x3D, 0x83, 0x81, 7, @_) }
771 56     56 0 149 sub cmp32_reg_imm { shift->_append_mathop32_const(0x3D, 0x83, 0x81, 7, @_) }
772 49     49 0 112 sub cmp16_reg_imm { shift->_append_mathop16_const(0x3D, 0x83, 0x81, 7, @_) }
773 35     35 0 83 sub cmp8_reg_imm { shift->_append_mathop8_const (0x3C, 0x80, 7, @_) }
774              
775 504     504 0 1346 sub cmp64_mem_imm { $_[0]->_append_mathop64_const_to_mem(0x83, 0x81, 7, $_[2], $_[1]) }
776 504     504 0 1210 sub cmp32_mem_imm { $_[0]->_append_mathop32_const_to_mem(0x83, 0x81, 7, $_[2], $_[1]) }
777 441     441 0 1126 sub cmp16_mem_imm { $_[0]->_append_mathop16_const_to_mem(0x83, 0x81, 7, $_[2], $_[1]) }
778 315     315 0 753 sub cmp8_mem_imm { $_[0]->_append_mathop8_const_to_mem (0x80, 7, $_[2], $_[1]) }
779              
780              
781 0     0 1 0 sub test { splice(@_,1,0,'test'); &_autodetect_signature_dst_src }
  0         0  
782              
783 49     49 0 106 sub test64_reg_reg { $_[0]->_append_op64_reg_reg(0x85, $_[2], $_[1]) }
784 49     49 0 114 sub test32_reg_reg { $_[0]->_append_op32_reg_reg(0x85, $_[2], $_[1]) }
785 49     49 0 120 sub test16_reg_reg { $_[0]->_append_op16_reg_reg(0x85, $_[2], $_[1]) }
786 49     49 0 118 sub test8_reg_reg { $_[0]->_append_op8_reg_reg (0x84, $_[2], $_[1]) }
787              
788 441     441 0 1072 sub test64_reg_mem { $_[0]->_append_op64_reg_mem(8, 0x85, $_[1], $_[2]); }
789 441     441 0 1083 sub test32_reg_mem { $_[0]->_append_op32_reg_mem(0, 0x85, $_[1], $_[2]); }
790 441     441 0 1097 sub test16_reg_mem { $_[0]->_append_op16_reg_mem(0, 0x85, $_[1], $_[2]); }
791 441     441 0 1057 sub test8_reg_mem { $_[0]->_append_op8_reg_mem (0, 0x84, $_[1], $_[2]); }
792              
793 56     56 0 136 sub test64_reg_imm { $_[0]->_append_mathop64_const(0xA9, undef, 0xF7, 0, $_[1], $_[2]) }
794 56     56 0 139 sub test32_reg_imm { $_[0]->_append_mathop32_const(0xA9, undef, 0xF7, 0, $_[1], $_[2]) }
795 49     49 0 113 sub test16_reg_imm { $_[0]->_append_mathop16_const(0xA9, undef, 0xF7, 0, $_[1], $_[2]) }
796 35     35 0 99 sub test8_reg_imm { $_[0]->_append_mathop8_const (0xA8, 0xF6, 0, $_[1], $_[2]) }
797              
798 504     504 0 1324 sub test64_mem_imm { $_[0]->_append_mathop64_const_to_mem(undef, 0xF7, 0, $_[2], $_[1]) }
799 504     504 0 1236 sub test32_mem_imm { $_[0]->_append_mathop32_const_to_mem(undef, 0xF7, 0, $_[2], $_[1]) }
800 441     441 0 1167 sub test16_mem_imm { $_[0]->_append_mathop16_const_to_mem(undef, 0xF7, 0, $_[2], $_[1]) }
801 315     315 0 754 sub test8_mem_imm { $_[0]->_append_mathop8_const_to_mem (0xF6, 0, $_[2], $_[1]) }
802              
803              
804 0     0 1 0 sub dec { splice(@_,1,0,'dec'); &_autodetect_signature_1op; }
  0         0  
805              
806 7     7 0 21 sub dec64_reg { $_[0]->_append_op64_reg_reg(0xFF, 1, $_[1]) }
807 7     7 0 17 sub dec32_reg { $_[0]->_append_op32_reg_reg(0xFF, 1, $_[1]) }
808 7     7 0 17 sub dec16_reg { $_[0]->_append_op16_reg_reg(0xFF, 1, $_[1]) }
809 7     7 0 21 sub dec8_reg { $_[0]->_append_op8_reg_reg (0xFE, 1, $_[1]) }
810              
811 63     63 0 143 sub dec64_mem { $_[0]->_append_op64_reg_mem(8, 0xFF, 1, $_[1]) }
812 63     63 0 150 sub dec32_mem { $_[0]->_append_op32_reg_mem(0, 0xFF, 1, $_[1]) }
813 63     63 0 160 sub dec16_mem { $_[0]->_append_op16_reg_mem(0, 0xFF, 1, $_[1]) }
814 63     63 0 202 sub dec8_mem { $_[0]->_append_op8_reg_mem (0, 0xFE, 1, $_[1]) }
815              
816              
817 0     0 1 0 sub inc { splice(@_,1,0,'inc'); &_autodetect_signature_1op; }
  0         0  
818              
819 7     7 0 20 sub inc64_reg { $_[0]->_append_op64_reg_reg(0xFF, 0, $_[1]) }
820 7     7 0 18 sub inc32_reg { $_[0]->_append_op32_reg_reg(0xFF, 0, $_[1]) }
821 7     7 0 18 sub inc16_reg { $_[0]->_append_op16_reg_reg(0xFF, 0, $_[1]) }
822 7     7 0 20 sub inc8_reg { $_[0]->_append_op8_reg_reg (0xFE, 0, $_[1]) }
823              
824 63     63 0 158 sub inc64_mem { $_[0]->_append_op64_reg_mem(8, 0xFF, 0, $_[1]) }
825 63     63 0 189 sub inc32_mem { $_[0]->_append_op32_reg_mem(0, 0xFF, 0, $_[1]) }
826 63     63 0 175 sub inc16_mem { $_[0]->_append_op16_reg_mem(0, 0xFF, 0, $_[1]) }
827 63     63 0 157 sub inc8_mem { $_[0]->_append_op8_reg_mem (0, 0xFE, 0, $_[1]) }
828              
829              
830 0     0 0 0 sub not { splice(@_,1,0,'not'); &_autodetect_signature_1op; }
  0         0  
831              
832 7     7 0 18 sub not64_reg { $_[0]->_append_op64_reg_reg(0xF7, 2, $_[1]) }
833 7     7 0 21 sub not32_reg { $_[0]->_append_op32_reg_reg(0xF7, 2, $_[1]) }
834 7     7 0 20 sub not16_reg { $_[0]->_append_op16_reg_reg(0xF7, 2, $_[1]) }
835 7     7 0 21 sub not8_reg { $_[0]->_append_op8_reg_reg (0xF6, 2, $_[1]) }
836              
837 63     63 0 171 sub not64_mem { $_[0]->_append_op64_reg_mem(8, 0xF7, 2, $_[1]) }
838 63     63 0 158 sub not32_mem { $_[0]->_append_op32_reg_mem(0, 0xF7, 2, $_[1]) }
839 63     63 0 158 sub not16_mem { $_[0]->_append_op16_reg_mem(0, 0xF7, 2, $_[1]) }
840 63     63 0 150 sub not8_mem { $_[0]->_append_op8_reg_mem (0, 0xF6, 2, $_[1]) }
841              
842              
843 0     0 0 0 sub neg { splice(@_,1,0,'neg'); &_autodetect_signature_1op; }
  0         0  
844              
845 7     7 0 25 sub neg64_reg { $_[0]->_append_op64_reg_reg(0xF7, 3, $_[1]) }
846 7     7 0 22 sub neg32_reg { $_[0]->_append_op32_reg_reg(0xF7, 3, $_[1]) }
847 7     7 0 20 sub neg16_reg { $_[0]->_append_op16_reg_reg(0xF7, 3, $_[1]) }
848 7     7 0 20 sub neg8_reg { $_[0]->_append_op8_reg_reg (0xF6, 3, $_[1]) }
849              
850 63     63 0 154 sub neg64_mem { $_[0]->_append_op64_reg_mem(8, 0xF7, 3, $_[1]) }
851 63     63 0 164 sub neg32_mem { $_[0]->_append_op32_reg_mem(0, 0xF7, 3, $_[1]) }
852 63     63 0 148 sub neg16_mem { $_[0]->_append_op16_reg_mem(0, 0xF7, 3, $_[1]) }
853 63     63 0 148 sub neg8_mem { $_[0]->_append_op8_reg_mem (0, 0xF6, 3, $_[1]) }
854              
855              
856 0     0 0 0 sub div { splice(@_,1,0,'div' ); &_autodetect_signature_1op; }
  0         0  
857 0     0 0 0 sub idiv { splice(@_,1,0,'idiv'); &_autodetect_signature_1op; }
  0         0  
858              
859 7     7 0 20 sub div64_reg { $_[0]->_append_op64_reg_reg (0xF7, 6, $_[1]) }
860 7     7 0 22 sub div32_reg { $_[0]->_append_op32_reg_reg (0xF7, 6, $_[1]) }
861 7     7 0 23 sub div16_reg { $_[0]->_append_op16_reg_reg (0xF7, 6, $_[1]) }
862 7     7 0 18 sub div8_reg { $_[0]->_append_op8_opreg_reg(0xF6, 6, $_[1]) }
863              
864 63     63 0 168 sub div64_mem { $_[0]->_append_op64_reg_mem (8, 0xF7, 6, $_[1]) }
865 63     63 0 164 sub div32_mem { $_[0]->_append_op32_reg_mem (0, 0xF7, 6, $_[1]) }
866 63     63 0 162 sub div16_mem { $_[0]->_append_op16_reg_mem (0, 0xF7, 6, $_[1]) }
867 63     63 0 155 sub div8_mem { $_[0]->_append_op8_opreg_mem(0, 0xF6, 6, $_[1]) }
868              
869 7     7 0 18 sub idiv64_reg { $_[0]->_append_op64_reg_reg (0xF7, 7, $_[1]) }
870 7     7 0 18 sub idiv32_reg { $_[0]->_append_op32_reg_reg (0xF7, 7, $_[1]) }
871 7     7 0 30 sub idiv16_reg { $_[0]->_append_op16_reg_reg (0xF7, 7, $_[1]) }
872 7     7 0 19 sub idiv8_reg { $_[0]->_append_op8_opreg_reg(0xF6, 7, $_[1]) }
873              
874 63     63 0 164 sub idiv64_mem { $_[0]->_append_op64_reg_mem (8, 0xF7, 7, $_[1]) }
875 63     63 0 161 sub idiv32_mem { $_[0]->_append_op32_reg_mem (0, 0xF7, 7, $_[1]) }
876 63     63 0 171 sub idiv16_mem { $_[0]->_append_op16_reg_mem (0, 0xF7, 7, $_[1]) }
877 63     63 0 157 sub idiv8_mem { $_[0]->_append_op8_opreg_mem(0, 0xF6, 7, $_[1]) }
878              
879              
880             #=item mul64_reg
881             #
882             #=item mul32_reg
883             #
884             #=item mul16_reg
885             #
886             #=item mul64_mem
887             #
888             #=item mul32_mem
889             #
890             #=item mul16_mem
891             #
892             #=item mul64_reg_imm
893             #
894             #=item mul32_reg_imm
895             #
896             #=item mul16_reg_imm
897             #
898             #=item mul64_mem_imm
899             #
900             #=item mul32_mem_imm
901             #
902             #=item mul16_mem_imm
903              
904 0     0 1 0 sub mul64_dxax_reg { shift->_append_op64_reg_reg(8, 0xF7, 5, @_) }
905 0     0 1 0 sub mul32_dxax_reg { shift->_append_op32_reg_reg(0, 0xF7, 5, @_) }
906 0     0 1 0 sub mul16_dxax_reg { shift->_append_op16_reg_reg(0, 0xF7, 5, @_) }
907 0     0 1 0 sub mul8_ax_reg { shift->_append_op8_reg_reg (0, 0xF6, 5, @_) }
908              
909             #sub mul64s_reg { shift->_append_op64_reg_reg(8,
910              
911              
912 1     1 1 5 sub sign_extend_al_ax { $_[0]{_buf} .= "\x66\x98"; $_[0] }
  1         3  
913             *cbw= *sign_extend_al_ax;
914              
915 1     1 1 8 sub sign_extend_ax_eax { $_[0]{_buf} .= "\x98"; $_[0] }
  1         2  
916             *cwde= *sign_extend_ax_eax;
917              
918 1     1 1 44 sub sign_extend_eax_rax { $_[0]{_buf} .= "\x48\x98"; $_[0] }
  1         6  
919             *cdqe= *sign_extend_eax_rax;
920              
921 1     1 1 5 sub sign_extend_ax_dx { $_[0]{_buf} .= "\x66\x99"; $_[0] }
  1         3  
922             *cwd= *sign_extend_ax_dx;
923              
924 1     1 1 5 sub sign_extend_eax_edx { $_[0]{_buf} .= "\x99"; $_[0] }
  1         3  
925             *cdq= *sign_extend_eax_edx;
926              
927 1     1 1 6 sub sign_extend_rax_rdx { $_[0]{_buf} .= "\x48\x99"; $_[0] }
  1         2  
928             *cqo= *sign_extend_rax_rdx;
929              
930              
931             my @_carry_flag_op= ( "\xF5", "\xF8", "\xF9" );
932 3     3 1 8 sub flag_carry { $_[0]{_buf} .= $_carry_flag_op[$_[1] + 1]; $_[0] }
  3         8  
933 1     1 1 5 sub clc { $_[0]{_buf} .= "\xF8"; $_[0] }
  1         4  
934 1     1 1 4 sub cmc { $_[0]{_buf} .= "\xF5"; $_[0] }
  1         3  
935 1     1 1 5 sub stc { $_[0]{_buf} .= "\xF9"; $_[0] }
  1         2  
936              
937              
938             # wait til late in compilation to avoid name clash hassle
939 17     17 1 983 END { eval q|sub push { splice(@_,1,0,'push' ); &_autodetect_signature_1op; }| };
  0     0   0  
  0         0  
940              
941             sub push_reg {
942 7     7 0 18 my ($self, $reg)= @_;
943 7   33     25 $reg= ($regnum64{$reg} // croak("$reg is not a 64-bit register"));
944 7 100       29 $self->{_buf} .= $reg > 7? pack('CC', 0x41, 0x50+($reg&7)) : pack('C', 0x50+($reg&7));
945 7         18 $self;
946             }
947              
948             sub push_imm {
949 8     8 0 17 my ($self, $imm)= @_;
950 17     17   154989 use integer;
  17         53  
  17         98  
951 8 50       36 my $val= ref $imm? 0x7FFFFFFF : $imm;
952 8 100       30 $self->{_buf} .= (($val >> 7) == ($val >> 8))? pack('Cc', 0x6A, $val) : pack('CV', 0x68, $val);
953 8 50       21 $self->_mark_unresolved(-4, encode => '_repack', bits => 32, value => $imm)
954             if ref $imm;
955 8         18 $self;
956             }
957              
958 63     63 0 155 sub push_mem { shift->_append_op64_reg_mem(0, 0xFF, 6, shift) }
959              
960              
961             # wait til late in compilation to avoid name clash hassle
962 17     17 1 57174 END { eval q|sub pop { splice(@_,1,0,'pop' ); &_autodetect_signature_1op; }| };
  0     0   0  
  0         0  
963              
964             sub pop_reg {
965 7     7 1 20 my ($self, $reg)= @_;
966 7   33     23 $reg= ($regnum64{$reg} // croak("$reg is not a 64-bit register"));
967 7 100       33 $self->{_buf} .= $reg > 7? pack('CC', 0x41, 0x58+($reg&7)) : pack('C', 0x58+($reg&7));
968 7         16 $self;
969             }
970              
971 63     63 1 150 sub pop_mem { shift->_append_op64_reg_mem(0, 0x8F, 0, shift) }
972              
973              
974             sub enter {
975 28     28 0 62 my ($self, $varspace, $nesting)= @_;
976 28   50     63 $nesting //= 0;
977 28 50 33     105 if (!ref $varspace && !ref $nesting) {
978 28         83 $self->{_buf} .= pack('CvC', 0xC8, $varspace, $nesting);
979             }
980             else {
981 0 0       0 $self->{_buf} .= pack('Cv', 0xC8, ref $varspace? 0 : $varspace);
982 0 0       0 $self->_mark_unresolved(-2, encode => '_repack', bits => 16, value => $varspace)
983             if ref $varspace;
984 0 0       0 $self->{_buf} .= pack('C', ref $nesting? 0 : $nesting);
985 0 0       0 $self->_mark_unresolved(-1, encode => '_repack', bits => 8, value => $nesting)
986             if ref $nesting;
987             }
988 28         94 $self
989             }
990              
991              
992 1     1 0 4 sub leave { $_[0]{_buf} .= "\xC9"; $_[0] }
  1         3  
993              
994              
995             sub syscall {
996 0     0 1 0 $_[0]{_buf} .= "\x0F\x05";
997 0         0 $_[0];
998             }
999              
1000              
1001 24     24 1 58 sub rep { $_[0]{_buf} .= "\xF3"; $_[0] }
  24         52  
1002             *repe= *repz= *rep;
1003              
1004 24     24 1 57 sub repnz { $_[0]{_buf} .= "\xF2"; $_[0] }
  24         102  
1005             *repne= *repnz;
1006              
1007              
1008             my @_direction_flag_op= ( "\xFC", "\xFD" );
1009 2     2 1 6 sub flag_direction { $_[0]{_buf} .= $_direction_flag_op[0+!!$_[1]]; $_[0] }
  2         5  
1010 1     1 1 4 sub cld { $_[0]{_buf} .= "\xFC"; $_[0] }
  1         4  
1011 1     1 1 5 sub std { $_[0]{_buf} .= "\xFD"; $_[0] }
  1         6  
1012              
1013              
1014 4     4 1 8 sub movs64 { $_[0]{_buf} .= "\x48\xA5"; $_[0] }
  4         9  
1015             *movsq= *movs64;
1016              
1017 4     4 1 13 sub movs32 { $_[0]{_buf} .= "\xA5"; $_[0] }
  4         7  
1018             *movsd= *movs32;
1019              
1020 4     4 1 9 sub movs16 { $_[0]{_buf} .= "\x66\xA5"; $_[0] }
  4         6  
1021             *movsw= *movs16;
1022              
1023 4     4 1 7 sub movs8 { $_[0]{_buf} .= "\xA4"; $_[0] }
  4         9  
1024             *movsb= *movs8;
1025              
1026              
1027 4     4 1 7 sub cmps64 { $_[0]{_buf}.= "\x48\xA7"; $_[0] }
  4         11  
1028             *cmpsq= *cmps64;
1029              
1030 4     4 1 8 sub cmps32 { $_[0]{_buf}.= "\xA7"; $_[0] }
  4         22  
1031             *cmpsd= *cmps32;
1032              
1033 4     4 1 9 sub cmps16 { $_[0]{_buf}.= "\x66\xA7"; $_[0] }
  4         7  
1034             *cmpsw= *cmps16;
1035              
1036 4     4 1 8 sub cmps8 { $_[0]{_buf}.= "\xA6"; $_[0] }
  4         9  
1037             *cmpsb= *cmps8;
1038              
1039              
1040 4     4 1 8 sub scas64 { $_[0]{_buf} .= "\x48\xAF"; $_[0] }
  4         9  
1041             *scasq= *scas64;
1042              
1043 4     4 1 14 sub scas32 { $_[0]{_buf} .= "\xAF"; $_[0] }
  4         16  
1044             *scasd= *scas32;
1045              
1046 4     4 1 27 sub scas16 { $_[0]{_buf} .= "\x66\xAF"; $_[0] }
  4         8  
1047             *scasw= *scas16;
1048              
1049 4     4 1 7 sub scas8 { $_[0]{_buf} .= "\xAE"; $_[0] }
  4         9  
1050             *scasb= *scas8;
1051              
1052              
1053             sub mfence {
1054 0     0 1 0 $_[0]{_buf} .= "\x0F\xAE\xF0";
1055 0         0 $_[0];
1056             }
1057             sub lfence {
1058 0     0 1 0 $_[0]{_buf} .= "\x0F\xAE\xE8";
1059 0         0 $_[0];
1060             }
1061             sub sfence {
1062 0     0 1 0 $_[0]{_buf} .= "\x0F\xAE\xF8";
1063 0         0 $_[0];
1064             }
1065              
1066             #sub cache_flush {
1067             # ...;
1068             #}
1069             #*clflush= *cache_flush;
1070              
1071              
1072             #=head2 _encode_op_reg_reg
1073             #
1074             #Encode standard instruction with REX prefix which refers only to registers.
1075             #This skips all the memory addressing logic since it is only operating on registers,
1076             #and always produces known-length encodings.
1077             #
1078             #=cut
1079              
1080             sub _encode_op_reg_reg {
1081 14     14   35 my ($self, $rex, $opcode, $reg1, $reg2, $immed_pack, $immed)= @_;
1082 17     17   21553 use integer;
  17         50  
  17         110  
1083 14         31 $rex |= (($reg1 & 8) >> 1) | (($reg2 & 8) >> 3);
1084 14 50       84 return $rex?
    50          
    100          
1085             (defined $immed?
1086             pack('CCC'.$immed_pack, 0x40|$rex, $opcode, 0xC0 | (($reg1 & 7) << 3) | ($reg2 & 7), $immed)
1087             : pack('CCC', 0x40|$rex, $opcode, 0xC0 | (($reg1 & 7) << 3) | ($reg2 & 7))
1088             )
1089             : (defined $immed?
1090             pack('CC'.$immed_pack, $opcode, 0xC0 | (($reg1 & 7) << 3) | ($reg2 & 7), $immed)
1091             : pack('CC', $opcode, 0xC0 | (($reg1 & 7) << 3) | ($reg2 & 7))
1092             );
1093             }
1094              
1095             sub _append_op64_reg_reg {
1096 735     735   1405 my ($self, $opcode, $reg1, $reg2)= @_;
1097 735   33     1947 $reg1= ($regnum64{$reg1} // croak("$reg1 is not a 64-bit register"));
1098 735   33     1611 $reg2= ($regnum64{$reg2} // croak("$reg2 is not a 64-bit register"));
1099 17     17   4148 use integer;
  17         156  
  17         78  
1100 735         2782 $self->{_buf} .= pack('CCC',
1101             0x48 | (($reg1 & 8) >> 1) | (($reg2 & 8) >> 3),
1102             $opcode, 0xC0 | (($reg1 & 7) << 3) | ($reg2 & 7));
1103 735         1632 $self;
1104             }
1105             sub _append_op32_reg_reg {
1106 646     646   1301 my ($self, $opcode, $reg1, $reg2)= @_;
1107 646   33     1702 $reg1= ($regnum32{$reg1} // croak("$reg1 is not a 32-bit register"));
1108 646   33     1447 $reg2= ($regnum32{$reg2} // croak("$reg2 is not a 32-bit register"));
1109 17     17   2406 use integer;
  17         47  
  17         62  
1110 646         1298 my $rex= (($reg1 & 8) >> 1) | (($reg2 & 8) >> 3);
1111 646 100       2345 $self->{_buf} .= $rex?
1112             pack('CCC', 0x40|$rex, $opcode, 0xC0 | (($reg1 & 7) << 3) | ($reg2 & 7))
1113             : pack('CC', $opcode, 0xC0 | (($reg1 & 7) << 3) | ($reg2 & 7));
1114 646         1385 $self;
1115             }
1116             sub _append_op16_reg_reg {
1117 602     602   1197 my ($self, $opcode, $reg1, $reg2)= @_;
1118 602   33     1632 $reg1= ($regnum16{$reg1} // croak("$reg1 is not a 16-bit register"));
1119 602   33     1315 $reg2= ($regnum16{$reg2} // croak("$reg2 is not a 16-bit register"));
1120 17     17   2843 use integer;
  17         59  
  17         95  
1121 602         1169 my $rex= (($reg1 & 8) >> 1) | (($reg2 & 8) >> 3);
1122 602 100       2264 $self->{_buf} .= $rex?
1123             pack('CCCC', 0x66, 0x40|$rex, $opcode, 0xC0 | (($reg1 & 7) << 3) | ($reg2 & 7))
1124             : pack('CCC', 0x66, $opcode, 0xC0 | (($reg1 & 7) << 3) | ($reg2 & 7));
1125 602         1309 $self;
1126             }
1127             sub _append_op8_reg_reg {
1128 420     420   818 my ($self, $opcode, $reg1, $reg2)= @_;
1129 17     17   2095 use integer;
  17         48  
  17         75  
1130 420         837 $reg1= $regnum8{$reg1};
1131 420         711 $reg2= $regnum8{$reg2};
1132             # special case for the "high byte" registers. They can't be used in an
1133             # instruction that uses the REX prefix.
1134 420 50 33     1499 if (!defined $reg1 || !defined $reg2) {
1135 0         0 my $old_reg1= $reg1;
1136 0         0 my $old_reg2= $reg2;
1137 0   0     0 $reg1= $regnum8_high{$_[2]} // croak "$_[2] is not a valid 8-bit register";
1138 0   0     0 $reg2= $regnum8_high{$_[3]} // croak "$_[3] is not a valid 8-bit register";
1139 0 0 0     0 if (($old_reg1 && $old_reg1 > 3) || ($old_reg2 && $old_reg2 > 3)) {
      0        
      0        
1140 0         0 croak "Can't combine $_[2] with $_[3] in same instruction";
1141             }
1142 0         0 $self->{_buf} .= pack('CC', $opcode, 0xC0 | ($reg1 << 3) | $reg2);
1143             }
1144             else {
1145 420 100 100     2104 $self->{_buf} .= ($reg1 > 3 || $reg2 > 3)?
1146             pack('CCC', 0x40|(($reg1 & 8) >> 1) | (($reg2 & 8) >> 3), $opcode, 0xC0 | (($reg1 & 7) << 3) | ($reg2 & 7))
1147             : pack('CC', $opcode, 0xC0 | ($reg1 << 3) | $reg2);
1148             }
1149 420         987 $self;
1150             }
1151              
1152             # Like above, but the first register argument isn't really a register argument
1153             # and therefore doesn't require a 0x40 prefix for values > 3
1154             sub _append_op8_opreg_reg {
1155 212     212   405 my ($self, $opcode, $opreg, $reg2)= @_;
1156 17     17   4528 use integer;
  17         39  
  17         92  
1157 212         373 $reg2= $regnum8{$reg2};
1158             # special case for the "high byte" registers. They can't be used in an
1159             # instruction that uses the REX prefix.
1160 212 100       405 if (!defined $reg2) {
1161 72         102 my $old_reg2= $reg2;
1162 72   33     181 $reg2= $regnum8_high{$_[3]} // croak "$_[3] is not a valid 8-bit register";
1163 72         237 $self->{_buf} .= pack('CC', $opcode, 0xC0 | ($opreg << 3) | $reg2);
1164             }
1165             else {
1166 140 100       565 $self->{_buf} .= ($reg2 > 3)?
1167             pack('CCC', 0x40| (($reg2 & 8) >> 3), $opcode, 0xC0 | ($opreg << 3) | ($reg2 & 7))
1168             : pack('CC', $opcode, 0xC0 | ($opreg << 3) | $reg2);
1169             }
1170 212         383 $self;
1171             }
1172              
1173             #=head2 _append_op##_reg_mem
1174             #
1175             #Encode standard ##-bit instruction with REX prefix which addresses memory for one of its operands.
1176             #The encoded length might not be resolved until later if an unknown displacement value was given.
1177             #
1178             #=cut
1179              
1180             sub _append_op64_reg_mem {
1181 9263     9263   18406 my ($self, $rex, $opcode, $reg, $mem)= @_;
1182 9263         18924 my ($base_reg, $disp, $index_reg, $scale)= @$mem;
1183 9263 50 33     28410 $reg= $regnum64{$reg} // croak "$reg is not a valid 64-bit register"
1184             if defined $reg;
1185 9263 100 33     24818 $base_reg= $regnum64{$base_reg} // croak "$base_reg is not a valid 64-bit register"
1186             if defined $base_reg;
1187 9263 100 33     22861 $index_reg= $regnum64{$index_reg} // croak "$index_reg is not a valid 64-bit register"
1188             if defined $index_reg;
1189 9263         33134 $self->_append_possible_unknown('_encode_op_reg_mem', [$rex, $opcode, $reg, $base_reg, $disp, $index_reg, $scale], 4, 7);
1190 9263         24688 $self;
1191             }
1192              
1193             sub _append_op32_reg_mem {
1194 9013     9013   17986 my ($self, $rex, $opcode, $reg, $mem)= @_;
1195 9013         18027 my ($base_reg, $disp, $index_reg, $scale)= @$mem;
1196 9013 50 33     27553 $reg= $regnum32{$reg} // croak "$reg is not a valid 32-bit register"
1197             if defined $reg;
1198 9013 100 33     22261 $base_reg= $regnum64{$base_reg} // croak "$base_reg is not a valid 64-bit register"
1199             if defined $base_reg;
1200 9013 100 33     22131 $index_reg= $regnum64{$index_reg} // croak "$index_reg is not a valid 64-bit register"
1201             if defined $index_reg;
1202 9013         27489 $self->_append_possible_unknown('_encode_op_reg_mem', [$rex, $opcode, $reg, $base_reg, $disp, $index_reg, $scale], 4, 7);
1203             }
1204              
1205             sub _append_op16_reg_mem {
1206 9009     9009   17825 my ($self, $rex, $opcode, $reg, $mem)= @_;
1207 9009         18123 my ($base_reg, $disp, $index_reg, $scale)= @$mem;
1208 9009 50 33     28085 $reg= $regnum16{$reg} // croak "$reg is not a valid 16-bit register"
1209             if defined $reg;
1210 9009 100 33     22835 $base_reg= $regnum64{$base_reg} // croak "$base_reg is not a valid 64-bit register"
1211             if defined $base_reg;
1212 9009 100 33     21672 $index_reg= $regnum64{$index_reg} // croak "$index_reg is not a valid 64-bit register"
1213             if defined $index_reg;
1214 9009         18297 $self->{_buf} .= "\x66";
1215 9009         27609 $self->_append_possible_unknown('_encode_op_reg_mem', [$rex, $opcode, $reg, $base_reg, $disp, $index_reg, $scale], 4, 7);
1216             }
1217              
1218             sub _append_op8_reg_mem {
1219 7308     7308   15816 my ($self, $rex, $opcode, $reg, $mem)= @_;
1220 7308         14794 my ($base_reg, $disp, $index_reg, $scale)= @$mem;
1221 7308 100 33     21466 $base_reg= $regnum64{$base_reg} // croak "$base_reg is not a valid 64-bit register"
1222             if defined $base_reg;
1223 7308 100 33     18522 $index_reg= $regnum64{$index_reg} // croak "$index_reg is not a valid 64-bit register"
1224             if defined $index_reg;
1225 7308         12770 $reg= $regnum8{$reg};
1226             # special case for the "high byte" registers
1227 7308 50       18831 if (!defined $reg) {
    100          
1228 0   0     0 $reg= $regnum8_high{$_[3]} // croak "$_[3] is not a valid 8-bit register";
1229 0 0 0     0 !$rex && ($base_reg//0) < 8 && ($index_reg//0) < 8
      0        
      0        
      0        
1230             or croak "Cannot use $_[3] in instruction with REX prefix";
1231             }
1232             # special case for needing REX byte for SPL, BPL, DIL, and SIL
1233             elsif ($reg > 3) {
1234 5040         8440 $rex |= 0x40;
1235             }
1236 7308         22662 $self->_append_possible_unknown('_encode_op_reg_mem', [$rex, $opcode, $reg, $base_reg, $disp, $index_reg, $scale], 4, 7);
1237             }
1238             # Like above, but the first register is a constant and don't need to test it for
1239             # requiring a REX prefix if >3.
1240             sub _append_op8_opreg_mem {
1241 1260     1260   2370 my ($self, $rex, $opcode, $opreg, $mem)= @_;
1242 1260         2562 my ($base_reg, $disp, $index_reg, $scale)= @$mem;
1243 1260 100 33     3552 $base_reg= $regnum64{$base_reg} // croak "$base_reg is not a valid 64-bit register"
1244             if defined $base_reg;
1245 1260 100 33     3165 $index_reg= $regnum64{$index_reg} // croak "$index_reg is not a valid 64-bit register"
1246             if defined $index_reg;
1247 1260         3866 $self->_append_possible_unknown('_encode_op_reg_mem', [$rex, $opcode, $opreg, $base_reg, $disp, $index_reg, $scale], 4, 7);
1248             }
1249              
1250             #=head2 _append_op##_const_to_mem
1251             #
1252             #Encode standard ##-bit instruction with REX prefix which operates on a constant and then
1253             #writes to a memory location.
1254             #
1255             #=cut
1256              
1257             sub _append_op8_const_to_mem {
1258 63     63   125 my ($self, $opcode, $opreg, $value, $mem)= @_;
1259 63         125 my ($base_reg, $disp, $index_reg, $scale)= @$mem;
1260 63 100 33     202 $base_reg= ($regnum64{$base_reg} // croak "$base_reg is not a 64-bit register")
1261             if defined $base_reg;
1262 63 100 33     333 $index_reg= ($regnum64{$index_reg} // croak "$index_reg is not a 64-bit register")
1263             if defined $index_reg;
1264 63 50       259 $self->_append_possible_unknown('_encode_op_reg_mem', [ 0, $opcode, $opreg, $base_reg, $disp, $index_reg, $scale, 'C', $value ], ref $disp? 4 : 8, defined $disp? 16:12);
    50          
1265             }
1266             sub _append_op16_const_to_mem {
1267 63     63   124 my ($self, $opcode, $opreg, $value, $mem)= @_;
1268 63         126 my ($base_reg, $disp, $index_reg, $scale)= @$mem;
1269 63 100 33     194 $base_reg= ($regnum64{$base_reg} // croak "$base_reg is not a 64-bit register")
1270             if defined $base_reg;
1271 63 100 33     162 $index_reg= ($regnum64{$index_reg} // croak "$index_reg is not a 64-bit register")
1272             if defined $index_reg;
1273 63         117 $self->{_buf} .= "\x66";
1274 63 50       254 $self->_append_possible_unknown('_encode_op_reg_mem', [ 0, $opcode, $opreg, $base_reg, $disp, $index_reg, $scale, 'v', $value ], ref $disp? 4 : 8, defined $disp? 16:12);
    50          
1275             }
1276             sub _append_op32_const_to_mem {
1277 63     63   120 my ($self, $opcode, $opreg, $value, $mem)= @_;
1278 63         133 my ($base_reg, $disp, $index_reg, $scale)= @$mem;
1279 63 100 33     194 $base_reg= ($regnum64{$base_reg} // croak "$base_reg is not a 64-bit register")
1280             if defined $base_reg;
1281 63 100 33     172 $index_reg= ($regnum64{$index_reg} // croak "$index_reg is not a 64-bit register")
1282             if defined $index_reg;
1283 63 50       245 $self->_append_possible_unknown('_encode_op_reg_mem', [ 0, $opcode, $opreg, $base_reg, $disp, $index_reg, $scale, 'V', $value ], ref $disp? 4 : 8, defined $disp? 16:12);
    50          
1284             }
1285             sub _append_op64_const_to_mem {
1286 63     63   119 my ($self, $opcode, $opreg, $value, $mem)= @_;
1287 63         130 my ($base_reg, $disp, $index_reg, $scale)= @$mem;
1288 63 100 33     189 $base_reg= ($regnum64{$base_reg} // croak "$base_reg is not a 64-bit register")
1289             if defined $base_reg;
1290 63 100 33     158 $index_reg= ($regnum64{$index_reg} // croak "$index_reg is not a 64-bit register")
1291             if defined $index_reg;
1292 63 50       244 $self->_append_possible_unknown('_encode_op_reg_mem', [ 8, $opcode, $opreg, $base_reg, $disp, $index_reg, $scale, 'V', $value ], ref $disp? 4 : 8, defined $disp? 16:12);
    50          
1293             }
1294              
1295              
1296             # scale values for the SIB byte
1297             my %SIB_scale= (
1298             1 => 0x00,
1299             2 => 0x40,
1300             4 => 0x80,
1301             8 => 0xC0
1302             );
1303              
1304             sub _encode_op_reg_mem {
1305 50225     50225   113825 my ($self, $rex, $opcode, $reg, $base_reg, $disp, $index_reg, $scale, $immed_pack, $immed)= @_;
1306 17     17   24092 use integer;
  17         45  
  17         77  
1307 50225         94227 $rex |= ($reg & 8) >> 1;
1308            
1309 50225         74108 my $tail;
1310 50225 100       92101 if (defined $base_reg) {
1311 38261         58364 $rex |= ($base_reg & 8) >> 3;
1312            
1313             # RBP,R13 always gets mod_rm displacement to differentiate from Null base register
1314 38261 100       132033 my ($mod_rm, $suffix)= !$disp? ( ($base_reg&7) == 5? (0x40, "\0") : (0x00, '') )
    50          
    100          
    100          
1315             : (($disp >> 7) == ($disp >> 8))? (0x40, pack('c', $disp))
1316             : (($disp >> 31) == ($disp >> 32))? (0x80, pack('V', $disp))
1317             : croak "address displacement out of range: $disp";
1318            
1319 38261 100       75513 if (defined $index_reg) {
    100          
1320 28694   50     79686 my $scale= $SIB_scale{$scale // 1} // croak "invalid index multiplier $scale";
      33        
1321 28694 50       58710 $index_reg != 4 or croak "RSP cannot be used as index register";
1322 28694         46168 $rex |= ($index_reg & 8) >> 2;
1323 28694         82761 $tail= pack('CC', $mod_rm | (($reg & 7) << 3) | 4, $scale | (($index_reg & 7) << 3) | ($base_reg & 7)) . $suffix;
1324             }
1325             # RSP,R12 always gets a SIB byte
1326             elsif (($base_reg&7) == 4) {
1327 3188         8921 $tail= pack('CC', $mod_rm | (($reg & 7) << 3) | 4, 0x24) . $suffix;
1328             }
1329             else {
1330             # Null index register is encoded as RSP
1331 6379         17431 $tail= pack('C', $mod_rm | (($reg & 7) << 3) | ($base_reg & 7)) . $suffix;
1332             }
1333             } else {
1334             # Null base register is encoded as RBP + 32bit displacement
1335            
1336 11964 50       27504 (($disp >> 31) == ($disp >> 32))
1337             or croak "address displacement out of range: $disp";
1338            
1339 11964 100       21860 if (defined $index_reg) {
1340 9564   50     27111 my $scale= $SIB_scale{$scale // 1} // croak "invalid index multiplier $scale";
      33        
1341 9564 50       19277 $index_reg != 4 or croak "RSP cannot be used as index register";
1342 9564         15639 $rex |= ($index_reg & 8) >> 2;
1343 9564         30800 $tail= pack('CCV', (($reg & 7) << 3) | 4, $scale | (($index_reg & 7) << 3) | 5, $disp);
1344             }
1345             else {
1346             # Null index register is encoded as RSP
1347 2400         7581 $tail= pack('CCV', (($reg & 7) << 3) | 4, 0x25, $disp);
1348             }
1349             }
1350 50225 100       108138 $tail .= pack($immed_pack, $immed)
1351             if defined $immed;
1352            
1353 50225 100       175154 return $rex?
1354             pack('CC', ($rex|0x40), $opcode) . $tail
1355             : pack('C', $opcode) . $tail;
1356             }
1357              
1358             #=head2 _append_mathopNN_const
1359             #
1360             #This is so bizarre I don't even know where to start. Most "math-like" instructions have an opcode
1361             #for an immediate the size of the register (except 64-bit which only gets a 32-bit immediate), an
1362             #opcode for an 8-bit immediate, and another opcode specifically for the AX register which is a byte
1363             #shorter than the normal, which is the only redeeming reason to bother using it.
1364             #Also, there is a constant stored in the 3 bits of the unused register in the ModRM byte which acts
1365             #as an extension of the opcode.
1366             #
1367             #These 4 methods are the generic implementation for encoding this mess.
1368             #Each implementation also handles the possibility that the immediate value is an unknown variable
1369             #resolved while the instructions are assembled.
1370             #
1371             #=over
1372             #
1373             #=item C<_append_mathop64_const($opcodeAX32, $opcode8, $opcode32, $opcode_reg, $reg, $immed)>
1374             #
1375             #This one is annoying because it only gets a sign-extended 32-bit value, so you actually only get
1376             #31 bits of an immediate value for a 64-bit instruction.
1377             #
1378             #=cut
1379              
1380             sub _append_mathop64_const {
1381 448     448   1147 my ($self, @args)= @_; # $opcodeAX32, $opcode8, $opcode32, $opcode_reg, $reg, $immed
1382 448   33     1240 $args[4]= $regnum64{$args[4]} // croak("$args[4] is not a 64-bit register");
1383 448         995 $self->_append_possible_unknown('_encode_mathop64_imm', \@args, 5, 7);
1384             }
1385             sub _encode_mathop64_imm {
1386 448     448   937 my ($self, $opcodeAX32, $opcode8, $opcode32, $opcode_reg, $reg, $value)= @_;
1387 17     17   8734 use integer;
  17         42  
  17         75  
1388 448         887 my $rex= 0x48 | (($reg & 8)>>3);
1389 448 100 100     2763 defined $opcode8 && (($value >> 7) == ($value >> 8))?
    50          
    100          
1390             pack('CCCc', $rex, $opcode8, 0xC0 | ($opcode_reg << 3) | ($reg & 7), $value)
1391             : (($value >> 31) == ($value >> 32))? (
1392             # Ops on AX get encoded as a special instruction
1393             $reg? pack('CCCV', $rex, $opcode32, 0xC0 | ($opcode_reg << 3) | ($reg & 7), $value)
1394             : pack('CCV', $rex, $opcodeAX32, $value)
1395             )
1396             # 64-bit only supports 32-bit sign-extend immediate
1397             : croak "$value is wider than 32-bit";
1398             }
1399              
1400             #=item C<_append_mathop32_const($opcodeAX32, $opcode8, $opcode32, $opcode_reg, $reg, $immed)>
1401             #
1402             #=cut
1403              
1404             sub _append_mathop32_const {
1405 448     448   1120 my ($self, @args)= @_; # $opcodeAX32, $opcode8, $opcode32, $opcode_reg, $reg, $immed
1406 448   33     1235 $args[4]= $regnum32{$args[4]} // croak("$args[4] is not a 32-bit register");
1407 448         970 $self->_append_possible_unknown('_encode_mathop32_imm', \@args, 5, 7);
1408             }
1409             sub _encode_mathop32_imm {
1410 448     448   929 my ($self, $opcodeAX32, $opcode8, $opcode32, $opcode_reg, $reg, $value)= @_;
1411 17     17   4164 use integer;
  17         47  
  17         83  
1412 448         772 my $rex= (($reg & 8)>>3);
1413 448 100 100     3289 defined $opcode8 && (($value >> 7) == ($value >> 8) or ($value >> 8 == 0xFFFFFF))?
    100          
    100          
    50          
    100          
1414             ( $rex? pack('CCCC', 0x40|$rex, $opcode8, 0xC0 | ($opcode_reg << 3) | ($reg & 7), $value&0xFF)
1415             : pack('CCC', $opcode8, 0xC0 | ($opcode_reg << 3) | ($reg & 7), $value&0xFF)
1416             )
1417             : (($value >> 32) == ($value >> 33))? (
1418             # Ops on AX get encoded as a special instruction
1419             $rex? pack('CCCV', 0x40|$rex, $opcode32, 0xC0 | ($opcode_reg << 3) | ($reg & 7), $value)
1420             : $reg? pack('CCV', $opcode32, 0xC0 | ($opcode_reg << 3) | ($reg & 7), $value)
1421             : pack('CV', $opcodeAX32, $value)
1422             )
1423             : croak "$value is wider than 32-bit";
1424             }
1425              
1426             #=item C<_append_mathop16_const($opcodeAX16, $opcode8, $opcode16, $opcode_reg, $reg, $immed)>
1427             #
1428             #=cut
1429              
1430             sub _append_mathop16_const {
1431 392     392   1038 my ($self, @args)= @_; # $opcodeAX16, $opcode8, $opcode16, $opcode_reg, $reg, $immed
1432 392   33     1069 $args[4]= $regnum16{$args[4]} // croak("$args[4] is not a 16-bit register");
1433 392         843 $self->_append_possible_unknown('_encode_mathop16_imm', \@args, 5, 8);
1434             }
1435             sub _encode_mathop16_imm {
1436 392     392   812 my ($self, $opcodeAX16, $opcode8, $opcode16, $opcode_reg, $reg, $value)= @_;
1437 17     17   4265 use integer;
  17         40  
  17         84  
1438 392         1057 my $rex= (($reg & 8)>>3);
1439 392 100 100     3048 defined $opcode8 && (($value >> 7) == ($value >> 8) or ($value >> 8 == 0xFF))?
    100          
    100          
    50          
    100          
1440             ( $rex? pack('CCCCC', 0x66, 0x40|$rex, $opcode8, 0xC0 | ($opcode_reg << 3) | ($reg & 7), $value&0xFF)
1441             : pack('CCCC', 0x66, $opcode8, 0xC0 | ($opcode_reg << 3) | ($reg & 7), $value&0xFF)
1442             )
1443             : (($value >> 16) == ($value >> 17))? (
1444             # Ops on AX get encoded as a special instruction
1445             $rex? pack('CCCCv', 0x66, 0x40|$rex, $opcode16, 0xC0 | ($opcode_reg << 3) | ($reg & 7), $value&0xFFFF)
1446             : $reg? pack('CCCv', 0x66, $opcode16, 0xC0 | ($opcode_reg << 3) | ($reg & 7), $value&0xFFFF)
1447             : pack('CCv', 0x66, $opcodeAX16, $value)
1448             )
1449             : croak "$value is wider than 16-bit";
1450             }
1451              
1452             #=item C<_append_mathop8_const($opcodeAX8, $opcode8, $opcode_reg, $reg, $immed)>
1453             #
1454             #On the upside, this one only has one bit width, so the length of the instruction is known even if
1455             #the immediate value isn't.
1456             #
1457             #However, we also have to handle the case where "dil", "sil", etc need a REX prefix but AH, BH, etc
1458             #can't have one.
1459             #
1460             #=back
1461             #
1462             #=cut
1463              
1464             sub _append_mathop8_const {
1465 280     280   596 my ($self, $opcodeAX8, $opcode8, $opcode_reg, $reg, $immed)= @_;
1466 17     17   3623 use integer;
  17         47  
  17         99  
1467 280         514 $reg= $regnum8{$reg};
1468 280 50       581 my $value= ref $immed? 0x00 : $immed;
1469 280 50       670 (($value >> 8) == ($value >> 9)) or croak "$value is wider than 8 bits";
1470 280 50       808 if (!defined $reg) {
    100          
    100          
1471 0   0     0 $reg= $regnum8_high{$_[1]} // croak("$reg is not a 8-bit register");
1472 0         0 $self->{_buf} .= pack('CCC', $opcode8, 0xC0 | ($opcode_reg<<3) | ($reg & 7), $value&0xFF);
1473             } elsif (!$reg) {
1474 40         147 $self->{_buf} .= pack('CC', $opcodeAX8, $value&0xFF);
1475             } elsif ($reg > 3) {
1476 200         756 $self->{_buf} .= pack('CCCC', 0x40|(($reg & 8)>>3), $opcode8, 0xC0 | ($opcode_reg << 3) | ($reg & 7), $value&0xFF);
1477             } else {
1478 40         203 $self->{_buf} .= pack('CCC', $opcode8, 0xC0 | ($opcode_reg << 3) | ($reg & 7), $value&0xFF);
1479             }
1480 280 50       597 $self->_mark_unresolved(-1, encode => '_repack', bits => 8, value => $immed)
1481             if ref $immed;
1482 280         614 $self;
1483             }
1484              
1485             sub _append_mathop64_const_to_mem {
1486 4032     4032   8603 my ($self, $opcode8, $opcode32, $opcode_reg, $value, $mem)= @_;
1487 4032         8293 my ($base_reg, $disp, $index_reg, $scale)= @$mem;
1488 4032 100 33     12456 $base_reg= ($regnum64{$base_reg} // croak "$base_reg is not a 64-bit register")
1489             if defined $base_reg;
1490 4032 100 33     10627 $index_reg= ($regnum64{$index_reg} // croak "$index_reg is not a 64-bit register")
1491             if defined $index_reg;
1492 4032 50       16760 $self->_append_possible_unknown('_encode_mathop64_mem_immed', [ $opcode8, $opcode32, $opcode_reg, $value, $base_reg, $disp, $index_reg, $scale ], 3, defined $disp? 9:12);
1493             }
1494             sub _encode_mathop64_mem_immed {
1495 4032     4032   8838 my ($self, $opcode8, $opcode32, $opcode_reg, $value, $base_reg, $disp, $index_reg, $scale)= @_;
1496 17     17   6892 use integer;
  17         62  
  17         83  
1497 4032 50 100     18831 defined $opcode8 && (($value >> 7) == ($value >> 8))?
    100          
1498             $self->_encode_op_reg_mem(8, $opcode8, $opcode_reg, $base_reg, $disp, $index_reg, $scale, 'C', $value&0xFF)
1499             : (($value >> 31) == ($value >> 32))?
1500             $self->_encode_op_reg_mem(8, $opcode32, $opcode_reg, $base_reg, $disp, $index_reg, $scale, 'V', $value&0xFFFFFFFF)
1501             : croak "$value is wider than 31-bit";
1502             }
1503              
1504             sub _append_mathop32_const_to_mem {
1505 4032     4032   9090 my ($self, $opcode8, $opcode32, $opcode_reg, $value, $mem)= @_;
1506 4032         8224 my ($base_reg, $disp, $index_reg, $scale)= @$mem;
1507 4032 100 33     11808 $base_reg= ($regnum64{$base_reg} // croak "$base_reg is not a 64-bit register")
1508             if defined $base_reg;
1509 4032 100 33     10466 $index_reg= ($regnum64{$index_reg} // croak "$index_reg is not a 64-bit register")
1510             if defined $index_reg;
1511 4032 50       14287 $self->_append_possible_unknown('_encode_mathop32_mem_immed', [ $opcode8, $opcode32, $opcode_reg, $value, $base_reg, $disp, $index_reg, $scale ], 3, defined $disp? 12:8);
1512             }
1513             sub _encode_mathop32_mem_immed {
1514 4032     4032   8736 my ($self, $opcode8, $opcode32, $opcode_reg, $value, $base_reg, $disp, $index_reg, $scale)= @_;
1515 17     17   4323 use integer;
  17         41  
  17         64  
1516 4032 50 100     20007 defined $opcode8 && (($value >> 7) == ($value >> 8) or ($value >> 8 == 0xFFFFFF))?
    100          
1517             $self->_encode_op_reg_mem(0, $opcode8, $opcode_reg, $base_reg, $disp, $index_reg, $scale).pack('C',$value&0xFF)
1518             : (($value >> 32) == ($value >> 33))?
1519             $self->_encode_op_reg_mem(0, $opcode32, $opcode_reg, $base_reg, $disp, $index_reg, $scale).pack('V', $value&0xFFFFFFFF)
1520             : croak "$value is wider than 32-bit";
1521             }
1522              
1523             sub _append_mathop16_const_to_mem {
1524 3528     3528   7256 my ($self, $opcode8, $opcode16, $opcode_reg, $value, $mem)= @_;
1525 3528         7139 my ($base_reg, $disp, $index_reg, $scale)= @$mem;
1526 3528 100 33     10354 $base_reg= ($regnum64{$base_reg} // croak "$base_reg is not a 64-bit register")
1527             if defined $base_reg;
1528 3528 100 33     9141 $index_reg= ($regnum64{$index_reg} // croak "$index_reg is not a 64-bit register")
1529             if defined $index_reg;
1530 3528         7139 $self->{_buf} .= "\x66";
1531 3528 50       12602 $self->_append_possible_unknown('_encode_mathop16_mem_immed', [ $opcode8, $opcode16, $opcode_reg, $value, $base_reg, $disp, $index_reg, $scale ], 3, defined $disp? 10:6);
1532             }
1533             sub _encode_mathop16_mem_immed {
1534 3528     3528   7757 my ($self, $opcode8, $opcode16, $opcode_reg, $value, $base_reg, $disp, $index_reg, $scale)= @_;
1535 17     17   4749 use integer;
  17         53  
  17         87  
1536 3528 50 100     17667 defined $opcode8 && (($value >> 7) == ($value >> 8) or ($value >> 8 == 0xFF))?
    100          
1537             $self->_encode_op_reg_mem(0, $opcode8, $opcode_reg, $base_reg, $disp, $index_reg, $scale).pack('C',$value&0xFF)
1538             : (($value >> 16) == ($value >> 17))?
1539             $self->_encode_op_reg_mem(0, $opcode16, $opcode_reg, $base_reg, $disp, $index_reg, $scale).pack('v', $value&0xFFFF)
1540             : croak "$value is wider than 16-bit";
1541             }
1542              
1543             sub _append_mathop8_const_to_mem {
1544 2520     2520   5187 my ($self, $opcode8, $opcode_reg, $value, $mem)= @_;
1545 2520         4961 my ($base_reg, $disp, $index_reg, $scale)= @$mem;
1546 2520 100 33     7484 $base_reg= ($regnum64{$base_reg} // croak "$base_reg is not a 64-bit register")
1547             if defined $base_reg;
1548 2520 100 33     6609 $index_reg= ($regnum64{$index_reg} // croak "$index_reg is not a 64-bit register")
1549             if defined $index_reg;
1550 2520 50       8835 $self->_append_possible_unknown('_encode_mathop8_mem_immed', [ $opcode8, $opcode_reg, $value, $base_reg, $disp, $index_reg, $scale ], 2, defined $disp? 10:6);
1551             }
1552             sub _encode_mathop8_mem_immed {
1553 2520     2520   5419 my ($self, $opcode8, $opcode_reg, $value, $base_reg, $disp, $index_reg, $scale)= @_;
1554 17     17   4259 use integer;
  17         39  
  17         81  
1555 2520 50       5663 (($value >> 8) == ($value >> 9)) or croak "$value is wider than 8 bit";
1556 2520         5694 $self->_encode_op_reg_mem(0, $opcode8, $opcode_reg, $base_reg, $disp, $index_reg, $scale).pack('C',$value&0xFF);
1557             }
1558              
1559             #=head2 C<_append_shiftop_reg_imm( $bitwidth, $opcode_1, $opcode_imm, $opreg, $reg, $immed )>
1560             #
1561             #Shift instructions often have a special case for shifting by 1. This utility method
1562             #selects that opcode if the immediate value is 1.
1563             #
1564             #It also allows the immediate to be an expression, though I doubt that will ever happen...
1565             #Immediate values are always a single byte, and the processor masks them to 0..63
1566             #so the upper bits are irrelevant.
1567             #
1568             #=cut
1569              
1570             sub _append_shiftop_reg_imm {
1571 732     732   1586 my ($self, $bits, $opcode_sh1, $opcode_imm, $opreg, $reg, $immed)= @_;
1572            
1573             # Select appropriate opcode
1574 732 100       1507 my $op= $immed eq 1? $opcode_sh1 : $opcode_imm;
1575            
1576 732 100       2367 $bits == 64? $self->_append_op64_reg_reg($op, $opreg, $reg)
    100          
    100          
1577             : $bits == 32? $self->_append_op32_reg_reg($op, $opreg, $reg)
1578             : $bits == 16? $self->_append_op16_reg_reg($op, $opreg, $reg)
1579             : $self->_append_op8_opreg_reg($op, $opreg, $reg);
1580            
1581             # If not using the shift-one opcode, append an immediate byte.
1582 732 100       1558 unless ($immed eq 1) {
1583 636 50       1446 $self->{_buf} .= pack('C', ref $immed? 0 : $immed);
1584 636 50       1302 $self->_mark_unresolved(-1, encode => '_repack', bits => 8, value => $immed)
1585             if ref $immed;
1586             }
1587            
1588 732         1585 $self;
1589             }
1590              
1591             #=head2 _append_shiftop_mem_imm
1592             #
1593             #Same as above, for memory locations
1594             #
1595             #=cut
1596              
1597             sub _append_shiftop_mem_imm {
1598 3780     3780   7951 my ($self, $bits, $opcode_sh1, $opcode_imm, $opreg, $mem, $immed)= @_;
1599              
1600             # Select appropriate opcode
1601 3780 100       8041 my $op= $immed eq 1? $opcode_sh1 : $opcode_imm;
1602            
1603 3780 100       13174 $bits == 64? $self->_append_op64_reg_mem(8, $op, $opreg, $mem)
    100          
    100          
1604             : $bits == 32? $self->_append_op32_reg_mem(0, $op, $opreg, $mem)
1605             : $bits == 16? $self->_append_op16_reg_mem(0, $op, $opreg, $mem)
1606             : $self->_append_op8_opreg_mem(0, $op, $opreg, $mem);
1607            
1608             # If not using the shift-one opcode, append an immediate byte.
1609 3780 100       9204 unless ($immed eq 1) {
1610 3024 50       7369 $self->{_buf} .= pack('C', ref $immed? 0 : $immed);
1611 3024 50       6328 $self->_mark_unresolved(-1, encode => '_repack', bits => 8, value => $immed)
1612             if ref $immed;
1613             }
1614            
1615 3780         8687 $self;
1616             }
1617              
1618             #=head2 C<_append_jmp_cond($cond_code, $label)>
1619             #
1620             #Appends a conditional jump instruction, which is either the short 2-byte form for 8-bit offsets,
1621             #or 6 bytes for jumps of 32-bit offsets. The implementation optimistically assumes the 2-byte
1622             #length until L is called, when the actual length will be determined.
1623             #
1624             #Returns $self, for chaining.
1625             #
1626             #=cut
1627              
1628             sub _append_jmp_cond {
1629 64 50   64   141 $_[2]= $_[0]->get_label unless defined $_[2];
1630            
1631 64         121 my ($self, $cond, $label)= @_;
1632 17     17   7127 use integer;
  17         34  
  17         105  
1633 64 50       151 $label= $self->get_label($label)
1634             unless ref $label;
1635             $self->_mark_unresolved(
1636             2, # estimated length
1637             encode => sub {
1638 160     160   283 my ($self, $params)= @_;
1639 160 50       306 defined $label->{offset} or croak "Label $label is not marked";
1640 160         273 my $ofs= $label->{offset} - ($params->{offset}+$params->{len});
1641 160         284 my $short= (($ofs>>7) == ($ofs>>8));
1642 160 100       483 return $short?
1643             pack('Cc', 0x70 + $cond, $ofs)
1644             : pack('CCV', 0x0F, 0x80 + $cond, $ofs);
1645             }
1646 64         340 );
1647 64         163 $self;
1648             }
1649              
1650             #=head2 C<_append_jmp_cx($opcode, $label)>
1651             #
1652             #Appends one of the special CX-related jumps (like L). These can only have an 8-bit offset
1653             #and are fixed-length.
1654             #
1655             #=cut
1656              
1657             sub _append_jmp_cx {
1658 8     8   18 my ($self, $op, $label)= @_;
1659 17     17   3630 use integer;
  17         38  
  17         67  
1660 8 50       23 $label= $self->get_label($label)
1661             unless ref $label;
1662             $self->_mark_unresolved(
1663             2, # estimated length
1664             encode => sub {
1665 8     8   18 my ($self, $params)= @_;
1666 8 50       36 defined $label->{offset} or croak "Label $label is not marked";
1667 8         20 my $ofs= $label->{offset} - ($params->{offset}+$params->{len});
1668 8 50       19 (($ofs>>7) == ($ofs>>8)) or croak "Label too far, can only short-jump";
1669 8         29 return pack('Cc', $op, $ofs);
1670             }
1671 8         44 );
1672 8         23 return $self;
1673             }
1674              
1675             sub _append_possible_unknown {
1676 51729     51729   100665 my ($self, $encoder, $encoder_args, $unknown_pos, $estimated_length)= @_;
1677 51729         89264 my $u= $encoder_args->[$unknown_pos];
1678 51729 50 33     125088 if (ref $u && ref $u ne 'SCALAR') {
1679 0 0       0 ref($u)->can('value')
1680             or croak "Expected object with '->value' method";
1681             $self->_mark_unresolved(
1682             $estimated_length,
1683             encode => sub {
1684 0     0   0 my $self= shift;
1685 0         0 my @args= @$encoder_args;
1686 0   0     0 $args[$unknown_pos]= $u->value
1687             // croak "Value '$u->{name}' is still unresolved";
1688 0         0 $self->$encoder(@args);
1689             },
1690 0         0 );
1691             }
1692             else {
1693 51729         140003 $self->{_buf} .= $self->$encoder(@$encoder_args);
1694             }
1695 51729         155861 $self;
1696             }
1697              
1698             #=head2 C<_mark_unresolved($location, encode => sub {...}, %other)>
1699             #
1700             #Creates a new unresolved marker in the instruction stream, indicating things which can't be known
1701             #until the entire instruction stream is written. (such as jump instructions).
1702             #
1703             #The parameters 'offset' and 'len' will be filled in automatically based on the $location parameter.
1704             #If C<$location> is negative, it indicates offset is that many bytes backward from the end of the
1705             #buffer. If C<$location> is positive, it means the unresolved symbol hasn't been written yet and
1706             #the 'offset' will be the current end of the buffer and 'len' is the value of $location.
1707             #
1708             #The other usual (but not required) parameter is 'encode'. This references a method callback which
1709             #will return the encoded instruction (or die, if there is still not enough information to do so).
1710             #
1711             #All C<%other> parameters are passed to the callback as a HASHREF.
1712             #
1713             #=cut
1714              
1715             sub _mark_unresolved {
1716 90     90   185 my ($self, $location)= (shift, shift);
1717 90         166 my $offset= length($self->{_buf});
1718            
1719             # If location is negative, move the 'offset' back that many bytes.
1720             # The length is the abs of location.
1721 90 50       197 if ($location < 0) {
1722 0         0 $location= -$location;
1723 0         0 $offset -= $location;
1724             }
1725             # If the location is positive, offset is the end of the string.
1726             # Add padding bytes for the length of the instruction.
1727             else {
1728 90         204 $self->{_buf} .= "\0" x $location;
1729             }
1730            
1731 90 50       194 if ($self->{debug}) {
1732 0         0 my ($i, @caller);
1733             # Walk up stack until the entry-point method
1734 0         0 while (@caller= caller(++$i)) {
1735 0 0       0 last if $caller[0] ne __PACKAGE__;
1736             }
1737 0         0 push @_, caller => \@caller;
1738             }
1739             #print "Unresolved at $offset ($location)\n";
1740 90         128 push @{ $self->_unresolved }, { offset => $offset, len => $location, @_ };
  90         315  
1741             }
1742              
1743             sub _repack {
1744 0     0   0 my ($self, $params)= @_;
1745 17     17   9654 use integer;
  17         52  
  17         66  
1746 0         0 my $v= $params->{value}->value;
1747 0 0       0 defined $v or croak "Placeholder $params->{value} has not been assigned";
1748 0         0 my $bits= $params->{bits};
1749 0 0       0 my $pack= $bits <= 8? 'C' : $bits <= 16? 'v' : $bits <= 32? 'V' : $bits <= 64? 'Q<' : die "Unhandled bits $bits\n";
    0          
    0          
    0          
1750 0 0 0     0 $bits == 64 || (($v >> $bits) == ($v >> ($bits+1))) or croak "$v is wider than $bits bits";
1751 0         0 return pack($pack, $v & ~(~0 << $bits));
1752             }
1753              
1754             #=head2 C<_resovle>
1755             #
1756             #This is the algorithm that resolves the unresolved instructions. It takes an iterative approach
1757             #that is relatively efficient as long as the predicted lengths of the unresolved instructions are
1758             #correct. If many instructions guess the wrong length then this could get slow for very long
1759             #instruction strings.
1760             #
1761             #=cut
1762              
1763             sub _resolve {
1764 54830     54830   82674 my $self= shift;
1765            
1766             # We repeat the process any time something changed length
1767 54830         81758 my $changed_len= 1;
1768 54830         113029 while ($changed_len) {
1769 54874         78916 $changed_len= 0;
1770            
1771             # Track the amount we have shifted the current instruction in $ofs
1772 54874         79194 my $ofs= 0;
1773 54874         80119 for my $p (@{ $self->_unresolved }) {
  54874         184918  
1774             #print "Shifting $p by $ofs\n" if $ofs;
1775 343 100       637 $p->{offset} += $ofs if $ofs;
1776            
1777             # Ignore things without an 'encode' callback (like labels)
1778             my $fn= $p->{encode}
1779 343 100       736 or next;
1780            
1781             # Get new encoding, then replace those bytes in the instruction string
1782 214         316 eval {
1783 214         373 my $enc= $self->$fn($p);
1784 214         470 substr($self->{_buf}, $p->{offset}, $p->{len})= $enc;
1785            
1786             # If the length changed, update $ofs and current ->len
1787 214 100       512 if (length($enc) != $p->{len}) {
1788             #print "New size is ".length($enc)."\n";
1789 44         70 $changed_len= 1;
1790 44         79 $ofs += (length($enc) - $p->{len});
1791 44         79 $p->{len}= length($enc);
1792             }
1793             };
1794 214 50       515 if ($@) {
1795 0 0         if ($p->{caller}) {
1796 0           croak "Failed to encode instruction $p->{caller}[3] from $p->{caller}[1] line $p->{caller}[2]:\n $@";
1797             } else {
1798 0           croak "Failed to encode instruction (enable diagnostics with ->debug(1) ): $@";
1799             }
1800             }
1801             }
1802             }
1803             }
1804              
1805             1;
1806              
1807             __END__