line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# $Id: ALU.pm,v 1.9 2008/02/24 23:52:05 drhyde Exp $ |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
package CPU::Emulator::Z80::ALU; |
4
|
|
|
|
|
|
|
|
5
|
17
|
|
|
17
|
|
95
|
use strict; |
|
17
|
|
|
|
|
32
|
|
|
17
|
|
|
|
|
756
|
|
6
|
17
|
|
|
17
|
|
85
|
use warnings; |
|
17
|
|
|
|
|
173
|
|
|
17
|
|
|
|
|
567
|
|
7
|
|
|
|
|
|
|
|
8
|
17
|
|
|
17
|
|
83
|
use base qw(Exporter); |
|
17
|
|
|
|
|
29
|
|
|
17
|
|
|
|
|
1682
|
|
9
|
17
|
|
|
17
|
|
145
|
use vars qw(@EXPORT); |
|
17
|
|
|
|
|
28
|
|
|
17
|
|
|
|
|
899
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
{ # find and export ALU_* |
12
|
17
|
|
|
17
|
|
83
|
no strict 'refs'; |
|
17
|
|
|
|
|
76
|
|
|
17
|
|
|
|
|
21481
|
|
13
|
|
|
|
|
|
|
while(my($k, $v) = each(%{__PACKAGE__.'::'})) { |
14
|
|
|
|
|
|
|
push @EXPORT, $k if(defined(&{$v}) && $k =~ /^ALU_/); |
15
|
|
|
|
|
|
|
} |
16
|
|
|
|
|
|
|
} |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 NAME |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
CPU::Emulator::Z80::ALU |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 DESCRIPTION |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
This mix-in provides functions for addition and subtraction on a |
25
|
|
|
|
|
|
|
Z80, settings flags and doing twos-complement jibber-jabber. |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
=head1 FUNCTIONS |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
All functions are |
30
|
|
|
|
|
|
|
exported. They all take a |
31
|
|
|
|
|
|
|
reference to the Flags register as the first parameter in addition |
32
|
|
|
|
|
|
|
to the parameters listed, unless otherwise stated: |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head2 ALU_add8/ALU_add16 |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
Takes two 8/16-bit values and returns their 8/16-bit sum, and for |
37
|
|
|
|
|
|
|
add16, a |
38
|
|
|
|
|
|
|
third parameter indicating whether this was really called as ADC. |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
add16 doesn't frob the S, Z or P flags unless that extra parameter |
41
|
|
|
|
|
|
|
is true. |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=cut |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
sub ALU_add8 { |
46
|
46
|
|
|
46
|
1
|
104
|
my($flags, $op1, $op2) = @_; |
47
|
46
|
|
|
|
|
162
|
my $halfcarry = (($op1 & 0b00001111) + ($op2 & 0b00001111)) & 0x10; |
48
|
46
|
|
|
|
|
108
|
my $carry6to7 = (($op1 & 0b01111111) + ($op2 & 0b01111111)) & 0x80; |
49
|
46
|
|
|
|
|
94
|
my $result = $op1 + $op2; |
50
|
46
|
|
|
|
|
4616
|
$flags->setC($result & 0x100); |
51
|
46
|
|
|
|
|
126
|
$result &= 0xFF; |
52
|
46
|
|
|
|
|
254
|
$flags->resetN(); |
53
|
46
|
|
|
|
|
318
|
$flags->setZ($result == 0); |
54
|
46
|
|
|
|
|
287
|
$flags->set3($result & 0b1000); |
55
|
46
|
|
|
|
|
304
|
$flags->setH($halfcarry); |
56
|
46
|
|
|
|
|
714
|
$flags->set5($result & 0b100000); |
57
|
46
|
|
|
|
|
293
|
$flags->setS($result & 0b10000000); |
58
|
46
|
|
66
|
|
|
243
|
$flags->setP( |
59
|
|
|
|
|
|
|
(!$flags->getC() && $carry6to7) || |
60
|
|
|
|
|
|
|
($flags->getC() && !$carry6to7) |
61
|
|
|
|
|
|
|
); |
62
|
46
|
|
|
|
|
203
|
return $result; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
sub ALU_add16 { |
65
|
20
|
|
|
20
|
1
|
46
|
my($flags, $op1, $op2, $adc) = @_; |
66
|
20
|
|
|
|
|
47
|
my $halfcarry = (($op1 & 0x0FFF) + ($op2 & 0x0FFF)) & 0x1000; |
67
|
20
|
|
|
|
|
40
|
my $result = $op1 + $op2; |
68
|
20
|
|
|
|
|
198
|
$flags->setC($result & 0x10000); |
69
|
20
|
|
|
|
|
41
|
$result &= 0xFFFF; |
70
|
20
|
|
|
|
|
119
|
$flags->resetN(); |
71
|
20
|
|
|
|
|
119
|
$flags->set3($result & 0x800); |
72
|
20
|
|
|
|
|
124
|
$flags->setH($halfcarry); |
73
|
20
|
|
|
|
|
118
|
$flags->set5($result & 0x2000); |
74
|
|
|
|
|
|
|
|
75
|
20
|
100
|
|
|
|
64
|
if($adc) { # only update these if this is really ADC |
76
|
4
|
|
|
|
|
14
|
my $carry14to15 = |
77
|
|
|
|
|
|
|
(($op1 & 0b0111111111111111) + ($op2 & 0b0111111111111111)) & |
78
|
|
|
|
|
|
|
0b1000000000000000; |
79
|
4
|
|
66
|
|
|
26
|
$flags->setP( |
80
|
|
|
|
|
|
|
(!$flags->getC() && $carry14to15) || |
81
|
|
|
|
|
|
|
($flags->getC() && !$carry14to15) |
82
|
|
|
|
|
|
|
); |
83
|
4
|
|
|
|
|
28
|
$flags->setZ($result == 0); |
84
|
4
|
|
|
|
|
24
|
$flags->setS($result & 0x8000); |
85
|
|
|
|
|
|
|
} |
86
|
20
|
|
|
|
|
84
|
return $result; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=head2 ALU_sub8/ALU_sub16 |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
Takes two 8/16-bit values and subtracts the second from the first, |
92
|
|
|
|
|
|
|
returning the result. |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=cut |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
sub ALU_sub8 { |
97
|
108
|
|
|
108
|
1
|
268
|
my($flags, $op1, $op2) = @_; |
98
|
108
|
|
|
|
|
203
|
my $result = ($op1 - $op2) & 0xFF; |
99
|
108
|
|
|
|
|
781
|
$flags->setN(); |
100
|
108
|
|
|
|
|
812
|
$flags->setZ($result == 0); |
101
|
108
|
|
|
|
|
929
|
$flags->setC($op2 > $op1); |
102
|
108
|
|
|
|
|
651
|
$flags->set3($result & 0b1000); |
103
|
108
|
|
|
|
|
742
|
$flags->setH(($op2 & 0b1111) > ($op1 & 0b1111)); |
104
|
108
|
|
66
|
|
|
1802
|
$flags->setP( |
105
|
|
|
|
|
|
|
(!$flags->getC() && (($op2 & 0b1111111) > ($op1 & 0b1111111))) || |
106
|
|
|
|
|
|
|
($flags->getC() && !(($op2 & 0b1111111) > ($op1 & 0b1111111))) |
107
|
|
|
|
|
|
|
); |
108
|
108
|
|
|
|
|
1176
|
$flags->set5($result & 0b100000); |
109
|
108
|
|
|
|
|
939
|
$flags->setS($result & 0b10000000); |
110
|
108
|
|
|
|
|
613
|
return $result; |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
sub ALU_sub16 { |
114
|
31
|
|
|
31
|
1
|
62
|
my($flags, $op1, $op2) = @_; |
115
|
31
|
|
|
|
|
60
|
my $result = ($op1 - $op2) & 0xFFFF; |
116
|
31
|
|
|
|
|
182
|
$flags->setN(); |
117
|
31
|
|
|
|
|
159
|
$flags->setZ($result == 0); |
118
|
31
|
|
|
|
|
240
|
$flags->setC($op2 > $op1); |
119
|
31
|
|
|
|
|
166
|
$flags->set3($result & 0b100000000000); |
120
|
31
|
|
|
|
|
5904
|
$flags->setH(($op2 & 0b111111111111) > ($op1 & 0b111111111111)); |
121
|
31
|
|
66
|
|
|
160
|
$flags->setP( |
122
|
|
|
|
|
|
|
(!$flags->getC() && (($op2 & 0b111111111111111) > ($op1 & 0b111111111111111))) || |
123
|
|
|
|
|
|
|
($flags->getC() && !(($op2 & 0b111111111111111) > ($op1 & 0b111111111111111))) |
124
|
|
|
|
|
|
|
); |
125
|
31
|
|
|
|
|
220
|
$flags->set5($result & 0b10000000000000); |
126
|
31
|
|
|
|
|
166
|
$flags->setS($result & 0b1000000000000000); |
127
|
31
|
|
|
|
|
124
|
return $result; |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=head2 ALU_inc8/ALU_dec8 |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
Take a single 8-bit value and incremement/decrement it, returning |
133
|
|
|
|
|
|
|
the result. They're just wrappers around add8/sub8 that preserve |
134
|
|
|
|
|
|
|
the C flag. |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=cut |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
sub ALU_dec8 { |
139
|
40
|
|
|
40
|
1
|
67
|
my($flags, $op) = @_; |
140
|
40
|
|
|
|
|
306
|
my $c = $flags->getC(); |
141
|
40
|
|
|
|
|
98
|
my $s = $op & 0x80; |
142
|
40
|
|
|
|
|
114
|
my $result = ALU_sub8($flags, $op, 1); |
143
|
40
|
|
|
|
|
212
|
$flags->setC($c); |
144
|
40
|
|
100
|
|
|
371
|
$flags->setP($s && !($result & 0x80)); |
145
|
40
|
|
|
|
|
156
|
return $result; |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
sub ALU_inc8 { |
148
|
15
|
|
|
15
|
1
|
51
|
my($flags, $op) = @_; |
149
|
15
|
|
|
|
|
160
|
my $c = $flags->getC(); |
150
|
15
|
|
|
|
|
38
|
my $s = $op & 0x80; |
151
|
15
|
|
|
|
|
50
|
my $result = ALU_add8($flags, $op, 1); |
152
|
15
|
|
|
|
|
80
|
$flags->setC($c); |
153
|
|
|
|
|
|
|
#$flags->setP(!$s && ($result & 0x80)); |
154
|
15
|
|
|
|
|
1609
|
return $result; |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=head2 ALU_parity |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
Returns the parity of its operand. No flags register is passed, |
160
|
|
|
|
|
|
|
as this does *not* update the register. |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=cut |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
sub ALU_parity { |
165
|
271
|
|
|
271
|
1
|
9281
|
my($v, $p) = (@_, 1); |
166
|
271
|
|
|
|
|
743
|
$p = !$p foreach(grep { $v & 2**$_ } 0 .. 15); |
|
4336
|
|
|
|
|
16837
|
|
167
|
271
|
|
|
|
|
2559
|
$p; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=head2 ALU_getsigned |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
Takes two parameters, a value and a number of bits. Decodes |
173
|
|
|
|
|
|
|
the value 2s-complement-ly for the appropriate number of bits, |
174
|
|
|
|
|
|
|
returning a signed value. undef is turned into 0. |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
No flags reigster needed |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=cut |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
sub ALU_getsigned { |
181
|
1949
|
|
|
1949
|
1
|
15937
|
my($value, $bits) = @_; |
182
|
1949
|
|
100
|
|
|
19811
|
$value ||= 0; # turn undef into 0 |
183
|
|
|
|
|
|
|
# if MSB == 0, just return the value |
184
|
1949
|
100
|
|
|
|
18953
|
return $value unless($value & (2 ** ($bits - 1))); |
185
|
|
|
|
|
|
|
# algorithm is: |
186
|
|
|
|
|
|
|
# flip all bits |
187
|
|
|
|
|
|
|
# add 1 |
188
|
|
|
|
|
|
|
# negate |
189
|
590
|
|
|
|
|
2721
|
return -1 * (($value ^ ((2 ** $bits) - 1)) + 1); |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=head1 BUGS/WARNINGS/LIMITATIONS |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
None known |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
=head1 FEEDBACK |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
I welcome feedback about my code, including constructive criticism and bug reports. The best bug reports include files that I can add to the test suite, which fail with the current code in CVS and will pass once I've fixed the bug. |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
Feature requests are far more likely to get implemented if you submit a patch yourself. |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=head1 CVS |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
L |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=head1 AUTHOR, COPYRIGHT and LICENCE |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
Copyright 2008 David Cantrell EFE |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
This software is free-as-in-speech software, and may be used, |
211
|
|
|
|
|
|
|
distributed, and modified under the terms of either the GNU |
212
|
|
|
|
|
|
|
General Public Licence version 2 or the Artistic Licence. It's |
213
|
|
|
|
|
|
|
up to you which one you use. The full text of the licences can |
214
|
|
|
|
|
|
|
be found in the files GPL2.txt and ARTISTIC.txt, respectively. |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
=head1 CONSPIRACY |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
This module is also free-as-in-mason software. |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
=cut |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
1; |