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; |