File Coverage

blib/lib/CPU/Emulator/Memory.pm
Criterion Covered Total %
statement 59 60 98.3
branch 27 30 90.0
condition 14 16 87.5
subroutine 13 13 100.0
pod 7 7 100.0
total 120 126 95.2


line stmt bran cond sub pod time code
1             package CPU::Emulator::Memory;
2              
3 7     7   101786 use strict;
  7         17  
  7         248  
4 7     7   37 use warnings;
  7         12  
  7         187  
5              
6 7     7   36 use vars qw($VERSION);
  7         18  
  7         6558  
7              
8             $VERSION = '1.1003';
9              
10             =head1 NAME
11              
12             CPU::Emulator::Memory - memory for a CPU emulator
13              
14             =head1 SYNOPSIS
15              
16             my $memory = CPU::Emulator::Memory->new();
17             $memory->poke(0xBEEF, ord('s'));
18            
19             my $value = $memory->peek(0xBEEF); # 115 == ord('s')
20              
21             =head1 DESCRIPTION
22              
23             This class provides a flat array of values which you can 'peek'
24             and 'poke'.
25              
26             =head1 METHODS
27              
28             =head2 new
29              
30             The constructor returns an object representing a flat memory
31             space addressable by byte. It takes four optional named parameters:
32              
33             =over
34              
35             =item file
36              
37             if provided, will provide a disc-based backup of the
38             RAM represented. This file will be read when the object is created
39             (if it exists) and written whenever anything is altered. If no
40             file exists or no filename is provided, then memory is initialised
41             to all zeroes. If the file exists it must be writeable and of the
42             correct size.
43              
44             =item endianness
45              
46             defaults to LITTLE, can be set to BIG. This matters for the peek16
47             and poke16 methods.
48              
49             =item size
50              
51             the size of the memory to emulate. This defaults to 64K (65536 bytes),
52             or to the length of the string passed to C.
53             Note that this does *not* have to be a power of two.
54              
55             =item bytes
56              
57             A string of characters with which to initialise the memory. Note that
58             the length must match the size parameter.
59              
60             =back
61              
62             =cut
63              
64             sub new {
65 13     13 1 24648 my($class, %params) = @_;
66 13 100 66     103 $params{size} ||=
67             exists($params{bytes})
68             ? length($params{bytes})
69             : 0x10000;
70 13 100       49 if(!exists($params{bytes})) {
71 10         613 $params{bytes} = chr(0) x $params{size};
72             }
73 13 100       76 die("bytes and size don't match\n")
74             if(length($params{bytes}) != $params{size});
75              
76 12 100       41 if(exists($params{file})) {
77 3 100       34 if(-e $params{file}) {
78 1         7 $params{bytes} = $class->_readRAM($params{file}, $params{size});
79             } else {
80 2         16 $class->_writeRAM($params{file}, $params{bytes})
81             }
82             }
83 12 100 100     160 return bless(
84             {
85             contents => $params{bytes},
86             size => $params{size},
87             ($params{file} ? (file => $params{file}) : ()),
88             endianness => $params{endianness} || 'LITTLE'
89             },
90             $class
91             );
92             }
93              
94             =head2 peek, peek8
95              
96             This method takes a single parameter, an address from 0 the memory size - 1.
97             It returns the value stored at that address, taking account of what
98             secondary memory banks are active. 'peek8' is simply another name
99             for the same function, the suffix indicating that it returns an 8
100             bit (ie one byte) value.
101              
102             =head2 peek16
103              
104             As peek and peek8, except it returns a 16 bit value. This is where
105             endianness matters.
106              
107             =cut
108              
109             sub peek8 {
110 3     3 1 8 my($self, $addr) = @_;
111 3         8 $self->peek($addr);
112             }
113             sub peek16 {
114 2     2 1 8 my($self, $address) = @_;
115             # assume little-endian
116 2         9 my $r = $self->peek($address) + 256 * $self->peek($address + 1);
117             # swap bytes if necessary
118 2 50       15 if($self->{endianness} eq 'BIG') {
119 0         0 $r = (($r & 0xFF) << 8) + int($r / 256);
120             }
121 2         11 return $r;
122             }
123             sub peek {
124 22     22 1 1190 my($self, $addr) = @_;
125 22 100 100     189 die("Address $addr out of range") if($addr< 0 || $addr > $self->{size} - 1);
126 19         93 return ord(substr($self->{contents}, $addr, 1));
127             }
128              
129             =head2 poke, poke8
130              
131             This method takes two parameters, an address and a byte value.
132             The value is written to the address.
133              
134             It returns 1 if something was written, or 0 if nothing was written.
135              
136             =head2 poke16
137              
138             This method takes two parameters, an address and a 16-bit value.
139             The value is written to memory as two bytes at the address specified
140             and the following one. This is where endianness matters.
141              
142             Return values are undefined.
143              
144             =cut
145              
146             sub poke8 {
147 1     1 1 3 my($self, $addr, $value) = @_;
148 1         3 $self->poke($addr, $value);
149             }
150             sub poke16 {
151 2     2 1 18 my($self, $addr, $value) = @_;
152             # if BIGendian, swap bytes, ...
153 2 100       10 if($self->{endianness} eq 'BIG') {
154 1         4 $value = (($value & 0xFF) << 8) + int($value / 256);
155             }
156             # write in little-endian order
157 2         9 $self->poke($addr, $value & 0xFF);
158 2         6 $self->poke($addr + 1, ($value >> 8));
159             }
160             sub poke {
161 13     13 1 945 my($self, $addr, $value) = @_;
162 13 100 100     73 die("Value $value out of range") if($value < 0 || $value > 255);
163 11 100 100     67 die("Address $addr out of range") if($addr< 0 || $addr > $self->{size} - 1);
164 9         14 $value = chr($value);
165 9         20 substr($self->{contents}, $addr, 1) = $value;
166 9 100       28 $self->_writeRAM($self->{file}, $self->{contents})
167             if(exists($self->{file}));
168 9         19 return 1;
169             }
170              
171             # input: filename, required size
172             # output: file contents, or fatal error
173             sub _read_file {
174 10     10   26 my($self, $file, $size) = @_;
175 10         28 local $/ = undef;
176 10 50       370 open(my $fh, $file) || die("Couldn't read $file\n");
177             # Win32 is stupid, see RT 62379
178 10         54 binmode($fh);
179 10         351 my $contents = <$fh>;
180 10 100       58 die("$file is wrong size\n") unless(length($contents) == $size);
181 9         105 close($fh);
182 9         65 return $contents;
183             }
184              
185             # input: filename, required size
186             # output: file contents, or fatal error
187             sub _readRAM {
188 1     1   2 my($self, $file, $size) = @_;
189 1         6 my $contents = $self->_read_file($file, $size);
190 1         7 $self->_writeRAM($file, $contents);
191 1         4 return $contents;
192             }
193              
194             # input: filename, data
195             # output: none, fatal on error
196             sub _writeRAM {
197 9     9   16 my($self, $file, $contents) = @_;
198 9 50       928 open(my $fh, '>', $file) || die("Can't write $file\n");
199 9         20 binmode($fh);
200 9   50     2971 print $fh $contents || die("Can't write $file\n");
201 9         118 close($fh);
202             }
203              
204             =head1 SUBCLASSING
205              
206             Most useful emulators will need a subclass of this module. For an example,
207             look at the CPU::Emulator::Memory::Banked module bundled with it, which
208             adds some methods of its own, and overrides the peek and poke methods.
209             Note that {peek,poke}{8,16} are *not* overridden but still get all the
210             extra magic, as they are simple wrappers around the peek and poke methods.
211              
212             You may use the _readRAM and _writeRAM methods for disk-backed RAM, and
213             _read_file may be useful for ROM. These
214             are only useful for subclasses:
215              
216             =over
217              
218             =item _read_file
219              
220             Takes a filename and the required size, returns the file's contents
221              
222             =item _readRAM
223              
224             Takes a filename and the required size, returns the file's contents and
225             checks that the file is writeable.
226              
227             =item _writeRAM
228              
229             Takes a filename and a chunk of data, writes the data to the file.
230              
231             =back
232              
233             =head1 BUGS/WARNINGS/LIMITATIONS
234              
235             It is assumed that the emulated memory will fit in the host's memory.
236              
237             When memory is disk-backed, the entire memory is written to disk on each
238             poke().
239              
240             The size of a byte in the emulated memory is the same as that of a char
241             on the host machine. Perl only runs on machines with 8 bit bytes.
242              
243             If you find any others, please report them using L or by email to Ebug-CPU-Emulator-Memory@rt.cpan.orgE.
244              
245             =head1 FEEDBACK
246              
247             I welcome feedback about my code, including constructive criticism
248             and bug reports. The best bug reports include files that I can add
249             to the test suite, which fail with the current code in CVS and will
250             pass once I've fixed the bug.
251              
252             Feature requests are far more likely to get implemented if you submit
253             a patch yourself.
254              
255             =head1 SOURCE CODE REPOSITORY
256              
257             L
258              
259             =head1 THANKS TO
260              
261             Paulo Custodio for finding and fixing some bugs on Win32, see RT 62375,
262             62379
263              
264             =head1 AUTHOR, LICENCE and COPYRIGHT
265              
266             Copyright 2008 David Cantrell EFE
267              
268             This module is free-as-in-speech software, and may be used,
269             distributed, and modified under the same terms as Perl itself.
270              
271             =head1 CONSPIRACY
272              
273             This module is also free-as-in-mason software.
274              
275             =cut
276              
277             1;