File Coverage

blib/lib/CPU/Emulator/Memory.pm
Criterion Covered Total %
statement 63 63 100.0
branch 30 32 93.7
condition 12 13 92.3
subroutine 13 13 100.0
pod 7 7 100.0
total 125 128 97.6


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