File Coverage

blib/lib/CPU/Emulator/Z80/ALU.pm
Criterion Covered Total %
statement 87 87 100.0
branch 4 4 100.0
condition 13 17 76.4
subroutine 13 13 100.0
pod 8 8 100.0
total 125 129 96.9


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;