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