File Coverage

blib/lib/Device/Chip/Base/RegisteredI2C.pm
Criterion Covered Total %
statement 123 123 100.0
branch 13 18 72.2
condition 15 18 83.3
subroutine 17 17 100.0
pod 5 6 83.3
total 173 182 95.0


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, 2015-2022 -- leonerd@leonerd.org.uk
5              
6 1     1   583 use v5.26;
  1         3  
7 1     1   5 use Object::Pad 0.66; # field
  1         12  
  1         5  
8              
9             package Device::Chip::Base::RegisteredI2C 0.25;
10             class Device::Chip::Base::RegisteredI2C :isa(Device::Chip);
11              
12 1     1   313 use utf8;
  1         3  
  1         7  
13              
14 1     1   35 use Future::AsyncAwait 0.38; # async method
  1         12  
  1         6  
15              
16 1     1   50 use Carp;
  1         3  
  1         64  
17              
18 1     1   6 use constant PROTOCOL => "I2C";
  1         2  
  1         96  
19              
20 1     1   7 use constant REG_ADDR_SIZE => 8;
  1         2  
  1         53  
21 1     1   6 use constant REG_DATA_SIZE => 8;
  1         2  
  1         171  
22              
23             =encoding UTF-8
24              
25             =head1 NAME
26              
27             C - base class for drivers of register-oriented I²C chips
28              
29             =head1 DESCRIPTION
30              
31             This subclass of L provides some handy utility methods to
32             implement a chip driver that supports a chip which (largely) operates on the
33             common pattern of registers; that is, that writes to and reads from the chip
34             are performed on numerically-indexed register locations, holding independent
35             values. This is a common pattern that a lot of I²C chips adhere to.
36              
37             =cut
38              
39             =head1 CONSTANTS
40              
41             =cut
42              
43             =head2 REG_DATA_SIZE
44              
45             Gives the number of bits of data each register occupies. Normally this value
46             is 8, but sometimes chips like high-resolution ADCs and DACs might work with a
47             larger size like 16 or 24. This value ought to be a multiple of 8.
48              
49             Overriding this constant to a different value will affect the interpretation
50             of the C<$len> parameter to the register reading and writing methods.
51              
52             =cut
53              
54 2         4 method REG_DATA_BYTES ()
  2         3  
55 2     2 0 6 {
56 2         16 my $bytes = int( ( $self->REG_DATA_SIZE + 7 ) / 8 );
57              
58             # cache it for next time
59 2   33     7 my $pkg = ref $self || $self;
60 1     1   7 { no strict 'refs'; *{"${pkg}::REG_DATA_BYTES"} = method () { $bytes }; }
  1     60   2  
  1         2234  
  2         4  
  2         10  
  2         22  
  60         125  
  60         81  
  60         73  
  60         201  
61              
62 2         8 return $bytes;
63             }
64              
65             =head1 METHODS
66              
67             The following methods documented in an C expression return L
68             instances.
69              
70             =cut
71              
72             field @_regcache;
73              
74             =head2 read_reg
75              
76             $val = await $chip->read_reg( $reg, $len );
77              
78             Performs a C I²C transaction, sending the register number as
79             a single byte value, then attempts to read the given number of register slots.
80              
81             =cut
82              
83 8         13 async method read_reg ( $reg, $len, $__forcecache = 0 )
  8         11  
  8         14  
  8         12  
  8         23  
84 8         21 {
85 8 50       28 $self->REG_ADDR_SIZE == 8 or
86             croak "TODO: Currently unable to cope with REG_ADDR_SIZE != 8";
87              
88 8         26 my $f = $self->protocol->write_then_read( pack( "C", $reg ), $len * $self->REG_DATA_BYTES );
89              
90 8         8984 foreach my $offs ( 0 .. $len-1 ) {
91 8         13 $__forcecache || $_regcache[$reg + $offs] and
92 8     8   1637 $_regcache[$reg + $offs] = $f->then( async sub ( $bytes ) {
  8         13  
  8         12  
93 8         18 return substr $bytes, $offs * $self->REG_DATA_BYTES, $self->REG_DATA_BYTES
94 10 100 100     255 });
95             }
96              
97 8         591 return await $f;
98 8     8 1 51 }
99              
100             =head2 write_reg
101              
102             await $chip->write_reg( $reg, $val );
103              
104             Performs a C I²C transaction, sending the register number as a single
105             byte value followed by the data to write into it.
106              
107             =cut
108              
109 9         14 async method write_reg ( $reg, $val, $__forcecache = 0 )
  9         15  
  9         18  
  9         12  
  9         27  
110 9         26 {
111 9 50       34 $self->REG_ADDR_SIZE == 8 or
112             croak "TODO: Currently unable to cope with REG_ADDR_SIZE != 8";
113              
114 9         29 my $len = length( $val ) / $self->REG_DATA_BYTES;
115              
116 9         29 foreach my $offs ( 0 .. $len-1 ) {
117 12 100 100     99 $__forcecache || defined $_regcache[$reg + $offs] and
118             $_regcache[$reg + $offs] = Future->done(
119             my $bytes = substr $val, $offs * $self->REG_DATA_BYTES, $self->REG_DATA_BYTES
120             );
121             }
122              
123 9         184 await $self->protocol->write( pack( "C", $reg ) . $val );
124 9     9 1 163 }
125              
126             =head2 cached_read_reg
127              
128             $val = await $chip->cached_read_reg( $reg, $len );
129              
130             Implements a cache around the given register location. Returns the last value
131             known to have been read from or written to the register; or reads it from the
132             actual chip if no interaction has yet been made. Once a cache slot has been
133             created for the register by calling this method, the L and
134             L methods will also keep it updated.
135              
136             This method should be used by chip drivers for interacting with
137             configuration-style registers; that is, registers that the chip itself will
138             treat as simple storage of values. It is not suitable for registers that the
139             chip itself will update.
140              
141             =cut
142              
143 10         16 async method cached_read_reg ( $reg, $len )
  10         16  
  10         14  
  10         14  
144 10         34 {
145 10         14 my @f;
146              
147 10         19 my $endreg = $reg + $len;
148              
149 10         27 while( $reg < $endreg ) {
150 19 100       42 if( defined $_regcache[$reg] ) {
151 14         34 push @f, $_regcache[$reg++];
152             }
153             else {
154 5         9 $len = 1;
155 5   100     26 $len++ while $reg + $len < $endreg and
156             !defined $_regcache[ $reg + $len ];
157              
158 5         6 my $thisreg = $reg;
159 5         14 push @f, $self->read_reg( $reg, $len, "forcecache" );
160              
161 5         261 $reg += $len;
162             }
163             }
164              
165 10         41 return join "", await Future->needs_all( @f );
166 10     10 1 1951 }
167              
168             =head2 cached_write_reg
169              
170             await $chip->cached_write_reg( $reg, $val );
171              
172             Optionally writes a new value for the given register location. This method
173             will invoke C except if the register already exists in the cache
174             and already has the given value according to the cache.
175              
176             This method should be used by chip drivers for interacting with
177             configuration-style registers; that is, registers that the chip itself will
178             treat as simple storage of values. It is not suitable for registers that the
179             chip itself will update.
180              
181             =cut
182              
183 8         15 async method cached_write_reg ( $reg, $val )
  8         12  
  8         17  
  8         9  
184 8         26 {
185 8         24 my $len = length( $val ) / ( my $datasize = $self->REG_DATA_BYTES );
186              
187             my @current = await Future->needs_all(
188             map {
189 8         27 $_regcache[$reg + $_] // Future->done( "" )
190             } 0 .. $len-1
191             );
192              
193 8         1162 my @want = $val =~ m/(.{$datasize})/sg;
194              
195             # Determine chunks that need rewriting
196 8         17 my @f;
197 8         15 my $offs = 0;
198 8         27 while( $offs < $len ) {
199 15 100       1179 $offs++, next if $current[$offs] eq $want[$offs];
200              
201 6         12 my $startoffs = $offs++;
202 6   100     27 $offs++ while $offs < $len and
203             $current[$offs] ne $want[$offs];
204              
205 6         32 push @f, $self->write_reg( $reg + $startoffs,
206             join( "", @want[$startoffs..$offs-1] ), "forcecache" );
207             }
208              
209 8         5715 await Future->needs_all( @f );
210 8     8 1 873 }
211              
212             =head2 cached_write_reg_masked
213              
214             await $chip->cached_write_reg_masked( $reg, $val, $mask );
215              
216             Performs a read-modify-write operation to update the given register location.
217             This method will first read the current value of the register for the length
218             of the value and mask. It will then modify this value, taking bits from the
219             value given by I<$val> where the corresponding bit in I<$mask> is set, or
220             leaving them unchanged where the I<$mask> bit is clear. This updated value is
221             then written back.
222              
223             Both the initial read and the subsequent write operation will pass through the
224             cache as for L and L.
225              
226             The length of I<$mask> must equal the length of I<$val>. A mask value with all
227             bits set is equivalent to just calling L. A mask value with
228             all bits clear is equivalent to no update (except that the chip registers may
229             still be read to fill the cache.
230              
231             This method should be used by chip drivers for interacting with
232             configuration-style registers; that is, registers that the chip itself will
233             treat as simple storage of values. It is not suitable for registers that the
234             chip itself will update.
235              
236             =cut
237              
238 1         2 async method cached_write_reg_masked ( $reg, $val, $mask )
  1         2  
  1         4  
  1         2  
  1         2  
239 1         4 {
240 1 50       5 length $mask == length $val or
241             croak "Require length(mask) == length(val)";
242              
243 1         2 my $readreg = $reg;
244 1         4 my $readlen = ( length $val ) / ( my $datasize = $self->REG_DATA_BYTES );
245 1         2 my $wasval = "";
246              
247 1         5 pos( $mask ) = 0;
248 1   66     41 while( $readlen and $mask =~ m/\G\xFF{$datasize}/g ) {
249 1         5 $readreg++, $readlen--;
250 1         8 $wasval .= "\0" x $datasize;
251             }
252              
253 1 50       23 if( $mask =~ m/(\xFF{$datasize})+$/ ) {
254 1         7 $readlen -= ( $+[0] - $-[0] ) / $datasize;
255             }
256              
257 1 50       7 $wasval .= await $self->cached_read_reg( $readreg, $readlen ) if $readlen > 0;
258              
259 1         325 $val &= $mask;
260 1         5 $val |= ( $wasval & ~$mask );
261              
262 1         5 await $self->cached_write_reg( $reg, $val );
263 1     1 1 39 }
264              
265             =head1 AUTHOR
266              
267             Paul Evans
268              
269             =cut
270              
271             0x55AA;