File Coverage

blib/lib/Device/AVR/Info.pm
Criterion Covered Total %
statement 21 120 17.5
branch 0 10 0.0
condition 0 22 0.0
subroutine 7 37 18.9
pod 16 16 100.0
total 44 205 21.4


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2014 -- leonerd@leonerd.org.uk
5              
6             package Device::AVR::Info;
7              
8 1     1   550 use strict;
  1         2  
  1         35  
9 1     1   4 use warnings;
  1         1  
  1         24  
10 1     1   31 use 5.010;
  1         2  
  1         38  
11              
12             our $VERSION = '0.01';
13              
14 1     1   4 use Carp;
  1         1  
  1         69  
15              
16 1     1   666 use XML::Smart;
  1         19318  
  1         57  
17 1     1   700 use Struct::Dumb 'readonly_struct';
  1         868  
  1         10  
18              
19 1     1   460 use Device::AVR::Info::Module;
  1         2  
  1         1429  
20              
21             =head1 NAME
22              
23             C - load data from F F device files
24              
25             =head1 SYNOPSIS
26              
27             use Device::AVR::Info;
28              
29             my $avr = Device::AVR::Info->new_from_file( "devices/ATtiny84.xml" );
30              
31             printf "The signature of %s is %s\n",
32             $avr->name, $avr->signature;
33              
34             =head1 DESCRIPTION
35              
36             This module loads an parses "part info" XML files as supplied with F's
37             F, and provides convenient access to the data stored inside them.
38              
39             =cut
40              
41             =head1 CONSTRUCTORS
42              
43             =cut
44              
45             =head2 $avr = Device::AVR::Info->new_from_file( $filename )
46              
47             Loads the device information from the given XML file.
48              
49             =cut
50              
51             sub new_from_file
52             {
53 0     0 1   my $class = shift;
54 0           my ( $filename ) = @_;
55              
56 0           my $root = XML::Smart->new( $filename );
57              
58 0           my $devices = $root->{"avr-tools-device-file"}{devices};
59 0 0         @$devices == 1 or
60             croak "Expected only one device, found " . scalar(@$devices);
61              
62 0           bless {
63             _device => $devices->[0]{device},
64             _modules => $root->{"avr-tools-device-file"}{modules}{module},
65             }, $class;
66             }
67              
68             sub _module_by_name
69             {
70 0     0     my $self = shift;
71 0           my ( $name ) = @_;
72              
73 0           foreach ( @{ $self->{_modules} } ) {
  0            
74 0 0         return Device::AVR::Info::Module->_new( $_ ) if $_->{name} eq $name;
75             }
76              
77 0           croak "No module named '$name' is defined";
78             }
79              
80             =head1 ACCESSORS
81              
82             =cut
83              
84             =head2 $name = $avr->name
85              
86             The device name (e.g. "ATtiny84")
87              
88             =head2 $architecture = $avr->architecture
89              
90             The device architecture (e.g. "AVR8")
91              
92             =head2 $family = $avr->family
93              
94             The device family (e.g. "tinyAVR")
95              
96             =cut
97              
98 0     0 1   sub name { shift->{_device}{name} }
99 0     0 1   sub architecture { shift->{_device}{architecture} }
100 0     0 1   sub family { shift->{_device}{family} }
101              
102             =head2 @ifaces = $avr->interfaces
103              
104             =head2 $iface = $avr->interface( $name )
105              
106             Returns a list of interface instances, or a single one having the given name,
107             representing the programming interfaces supported by the device.
108              
109             Each is a structure of the following fields.
110              
111             $iface->name
112             $iface->type
113              
114             =cut
115              
116             readonly_struct Interface => [qw( type name )];
117              
118             sub interfaces
119             {
120 0     0 1   my $self = shift;
121 0           return @{ $self->{interfaces} //= [ map {
  0            
122 0           Interface( "$_->{type}", "$_->{name}" )
123 0   0       } @{ $self->{_device}{interfaces}{interface} } ] };
124             }
125              
126             sub interface
127             {
128 0     0 1   my $self = shift;
129 0           my ( $name ) = @_;
130 0   0       $_->name eq $name and return $_ for $self->interfaces;
131 0           return;
132             }
133              
134             =head2 @memories = $avr->memories
135              
136             =head2 $memory = $avr->memory( $name )
137              
138             Returns a list of memory instances, or a single one having the given name,
139             representing the available memories on the device.
140              
141             Each is a structure of the following fields.
142              
143             $memory->name
144             $memory->id
145             $memory->endianness
146             $memory->start # in bytes
147             $memory->size # in bytes
148             @segments = $memory->segments
149              
150             The C field returns a list of structures of the following fields:
151              
152             $seg->start
153             $seg->size
154             $seg->name
155             $seg->type
156             $seg->can_read
157             $seg->can_write
158             $seg->can_exec
159             $seg->pagesize
160              
161             Note that all sizes are given in bytes; for memories of 16-bit word-size,
162             divide this by 2 to obtain the size in words.
163              
164             =cut
165              
166             {
167             # Can't quite use Struct::Dumb because of list return inflation of 'segments'
168             package
169             Device::AVR::Info::_Memory;
170              
171 0     0     sub name { shift->[0] }
172 0     0     sub id { shift->[1] }
173 0     0     sub endianness { shift->[2] }
174 0     0     sub start { shift->[3] }
175 0     0     sub size { shift->[4] }
176 0     0     sub segments { @{ shift->[5] } }
  0            
177             }
178              
179             readonly_struct MemorySegment => [qw( start size name type can_read can_write can_exec pagesize )];
180              
181             sub memories
182             {
183 0     0 1   my $self = shift;
184 0           return @{ $self->{memories} //= [ map {
  0            
185 0           my @segments = exists $_->{"memory-segment"} ? map {
186 0           my $rw = $_->{rw};
187 0           MemorySegment( hex "$_->{start}", hex "$_->{size}", "$_->{name}", "$_->{type}",
188             scalar $rw =~ m/R/, scalar $rw =~ m/W/, !!"$_->{exec}", hex "$_->{pagesize}" );
189 0 0         } @{ $_->{"memory-segment"} } : ();
190              
191 0           bless [ "$_->{name}", "$_->{id}", "$_->{endianness}",
192             hex "$_->{start}", hex "$_->{size}", \@segments ], "Device::AVR::Info::_Memory";
193 0   0       } @{ $self->{_device}{"address-spaces"}{"address-space"} } ] };
194             }
195              
196             sub memory
197             {
198 0     0 1   my $self = shift;
199 0           my ( $name ) = @_;
200 0   0       $_->name eq $name and return $_ for $self->memories;
201 0           return;
202             }
203              
204             sub _memory_by_id
205             {
206 0     0     my $self = shift;
207 0           my ( $id ) = @_;
208 0   0       $_->id eq $id and return $_ for $self->memories;
209 0           return;
210             }
211              
212             =head2 @ints = $avr->interrupts
213              
214             =head2 $int = $avr->interrupt( $name )
215              
216             Returns a list of interrupt instances, or a single one having the given name,
217             representing the interrupt sources available on the device.
218              
219             Each is a structure of the following fields.
220              
221             $int->name
222             $int->index
223             $int->caption
224              
225             =cut
226              
227             readonly_struct Interrupt => [qw( name index caption )];
228              
229             sub interrupts
230             {
231 0     0 1   my $self = shift;
232 0           return @{ $self->{interrupts} //= [ map {
  0            
233 0           Interrupt( "$_->{name}", "$_->{index}", "$_->{caption}" )
234 0   0       } @{ $self->{_device}{interrupts}{interrupt} } ] };
235             }
236              
237             sub interrupt
238             {
239 0     0 1   my $self = shift;
240 0           my ( $name ) = @_;
241 0   0       $_->name eq $name and return $_ for $self->interrupts;
242 0           return;
243             }
244              
245             =head2 @periphs = $avr->peripherals
246              
247             =head2 $periph = $avr->peripheral( $name )
248              
249             Returns a list of peripheral instances, or a single one having the given name,
250             representing the peripherals or other miscellaneous information available on
251             the device.
252              
253             Each is a structure of the following fields.
254              
255             $periph->name
256             $periph->module # instance of Device::AVR::Info::Module
257             $periph->regname
258             $periph->regspace # instance of $memory
259              
260             @registers = $periph->registers
261             # instances of $register from Device::AVR::Info::Module
262              
263             =cut
264              
265             {
266             package
267             Device::AVR::Info::_Peripheral;
268              
269 0     0     sub name { shift->[0] }
270 0     0     sub module { shift->[1] }
271 0     0     sub regname { shift->[2] }
272 0     0     sub regoffset { shift->[3] }
273 0     0     sub regspace { shift->[4] }
274              
275             sub registers {
276 0     0     my $self = shift;
277 0           $self->module->_registers_offset( $self->regname, $self->regoffset );
278             }
279             }
280              
281             sub peripherals
282             {
283 0     0 1   my $self = shift;
284 0           return @{ $self->{peripherals} //= [ map {
  0            
285 0           my $module = $self->_module_by_name( "$_->{name}" );
286 0           map {
287 0           my $reggroup = $_->{"register-group"}[0];
288 0           bless [ "$_->{name}", $module,
289             "$reggroup->{'name-in-module'}", hex "$reggroup->{offset}",
290             $self->_memory_by_id( $reggroup->{"address-space"} ) ], "Device::AVR::Info::_Peripheral";
291 0           } @{ $_->{instance} };
292 0   0       } @{ $self->{_device}{peripherals}{module} } ] };
293             }
294              
295             sub peripheral
296             {
297 0     0 1   my $self = shift;
298 0           my ( $name ) = @_;
299              
300 0           $self->peripherals;
301              
302 0   0       $_->name eq $name and return $_ for @{ $self->{peripherals} };
  0            
303 0           return;
304             }
305              
306             =head2 @group_names = $avr->property_groups
307              
308             Returns (in no particular order) the names of the defined property groups.
309              
310             =head2 \%values = $avr->property_group( $group_name )
311              
312             Returns a HASH reference of all the properties in the given property group.
313              
314             =head2 $value = $avr->property( $group_name, $prop_name )
315              
316             Returns a single value of a property in the given property group.
317              
318             Any value given in the XML file in the form of a single hexadecimal numerical
319             constant is automatically converted into the appropriate integer. Strings of
320             multiple numbers (such as the HVSP and HVPP control stacks) are not converted.
321              
322             =cut
323              
324             sub property_groups
325             {
326 0     0 1   my $self = shift;
327 0           $self->{property_groups} //= { map {
328 0           +( "$_->{name}", $_->{property} )
329 0   0       } @{ $self->{_device}{"property-groups"}{"property-group"} } };
330 0           return keys %{ $self->{property_groups} };
  0            
331             }
332              
333             sub property_group
334             {
335 0     0 1   my $self = shift;
336 0           my ( $group ) = @_;
337              
338 0           $self->property_groups;
339 0 0         my $properties = $self->{property_groups}{$group} or
340             croak "No such property group '$group'";
341              
342 0           return $self->{properties}{$group} //= { map {
343 0   0       my $value = $_->{value};
344 0 0         $value = hex $value if $value =~ m/^0x[[:xdigit:]]+$/;
345              
346 0           +( "$_->{name}", "$value" )
347             } @$properties };
348             }
349              
350             sub property
351             {
352 0     0 1   my $self = shift;
353 0           my ( $group, $prop ) = @_;
354              
355 0           return $self->property_group( $group )->{$prop};
356             }
357              
358             =head1 DERIVED METHODS
359              
360             These methods wrap information provided by the basic accessors.
361              
362             =cut
363              
364             =head2 $sig = $avr->signature
365              
366             Returns a 6-character hexadecimal string consisting of the three bytes of the
367             device signature.
368              
369             =cut
370              
371             sub signature
372             {
373 0     0 1   my $self = shift;
374 0           return sprintf "%02x%02x%02x",
375 0           map { $self->property( SIGNATURES => "SIGNATURE$_" ) } 0 .. 2;
376             }
377              
378             =head1 AUTHOR
379              
380             Paul Evans
381              
382             =cut
383              
384             0x55AA;