line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package VIC::PIC::Functions::ECCP; |
2
|
31
|
|
|
31
|
|
20377
|
use strict; |
|
31
|
|
|
|
|
58
|
|
|
31
|
|
|
|
|
806
|
|
3
|
31
|
|
|
31
|
|
132
|
use warnings; |
|
31
|
|
|
|
|
62
|
|
|
31
|
|
|
|
|
669
|
|
4
|
31
|
|
|
31
|
|
125
|
use bigint; |
|
31
|
|
|
|
|
50
|
|
|
31
|
|
|
|
|
148
|
|
5
|
|
|
|
|
|
|
our $VERSION = '0.32'; |
6
|
|
|
|
|
|
|
$VERSION = eval $VERSION; |
7
|
31
|
|
|
31
|
|
17233
|
use Carp; |
|
31
|
|
|
|
|
56
|
|
|
31
|
|
|
|
|
1376
|
|
8
|
31
|
|
|
31
|
|
164
|
use POSIX (); |
|
31
|
|
|
|
|
55
|
|
|
31
|
|
|
|
|
581
|
|
9
|
31
|
|
|
31
|
|
134
|
use Moo::Role; |
|
31
|
|
|
|
|
47
|
|
|
31
|
|
|
|
|
177
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
#FIXME: C2OUT and P1B may be conflicting. check datasheet |
12
|
|
|
|
|
|
|
sub _pwm_details { |
13
|
6
|
|
|
6
|
|
17
|
my ($self, $pwm_frequency, $duty, $type, @pins) = @_; |
14
|
6
|
50
|
|
|
|
14
|
return unless $self->doesrole('Chip'); |
15
|
6
|
50
|
|
|
|
27
|
unless (exists $self->registers->{CCP1CON}) { |
16
|
0
|
|
|
|
|
0
|
carp $self->type, " does not have CCP1CON for ECCP features"; |
17
|
0
|
|
|
|
|
0
|
return; |
18
|
|
|
|
|
|
|
} |
19
|
31
|
|
|
31
|
|
12821
|
no bigint; |
|
31
|
|
|
|
|
55
|
|
|
31
|
|
|
|
|
156
|
|
20
|
|
|
|
|
|
|
#pulse_width = $duty / $pwm_frequency; |
21
|
|
|
|
|
|
|
# timer2 prescaler |
22
|
6
|
|
|
|
|
10
|
my $prescaler = 1; # can be 1, 4 or 16 |
23
|
|
|
|
|
|
|
# Tosc = 1 / Fosc |
24
|
6
|
|
|
|
|
109
|
my $f_osc = $self->f_osc; |
25
|
6
|
|
|
|
|
34
|
my $pr2 = POSIX::ceil(($f_osc / 4) / $pwm_frequency); # assume prescaler = 1 here |
26
|
6
|
50
|
|
|
|
15
|
if (($pr2 - 1) <= 0xFF) { |
27
|
0
|
|
|
|
|
0
|
$prescaler = 1; # prescaler stays 1 |
28
|
|
|
|
|
|
|
} else { |
29
|
6
|
|
|
|
|
12
|
$pr2 = POSIX::ceil($pr2 / 4); # prescaler is 4 or 16 |
30
|
6
|
50
|
|
|
|
23
|
$prescaler = (($pr2 - 1) <= 0xFF) ? 4 : 16; |
31
|
|
|
|
|
|
|
} |
32
|
6
|
|
|
|
|
57
|
my $t2con = q{b'00000100'}; # prescaler is 1 or anything else |
33
|
6
|
50
|
|
|
|
17
|
$t2con = q{b'00000101'} if $prescaler == 4; |
34
|
6
|
50
|
|
|
|
10
|
$t2con = q{b'00000111'} if $prescaler == 16; |
35
|
|
|
|
|
|
|
# readjusting PR2 as per supported pre-scalers |
36
|
6
|
|
|
|
|
16
|
$pr2 = POSIX::ceil((($f_osc / 4) / $pwm_frequency) / $prescaler); |
37
|
6
|
|
|
|
|
9
|
$pr2--; |
38
|
6
|
|
|
|
|
9
|
$pr2 &= 0xFF; |
39
|
6
|
|
|
|
|
16
|
my $ccpr1l_ccp1con54 = POSIX::ceil(($duty * 4 * ($pr2)) / 100.0); |
40
|
6
|
|
|
|
|
9
|
my $ccp1con5 = ($ccpr1l_ccp1con54 & 0x02); #bit 5 |
41
|
6
|
|
|
|
|
10
|
my $ccp1con4 = ($ccpr1l_ccp1con54 & 0x01); #bit 4 |
42
|
6
|
|
|
|
|
9
|
my $ccpr1l = ($ccpr1l_ccp1con54 >> 2) & 0xFF; |
43
|
6
|
|
|
|
|
19
|
my $ccpr1l_x = sprintf "0x%02X", $ccpr1l; |
44
|
6
|
|
|
|
|
13
|
my $pr2_x = sprintf "0x%02X", ($pr2 - 1); ##HACK |
45
|
6
|
100
|
|
|
|
16
|
my $p1m = '00' if $type eq 'single'; |
46
|
6
|
100
|
|
|
|
21
|
$p1m = '01' if $type eq 'full_forward'; |
47
|
6
|
100
|
|
|
|
12
|
$p1m = '10' if $type eq 'half'; |
48
|
6
|
100
|
|
|
|
12
|
$p1m = '11' if $type eq 'full_reverse'; |
49
|
6
|
50
|
|
|
|
9
|
$p1m = '00' unless defined $p1m; |
50
|
6
|
|
|
|
|
17
|
my $ccp1con = sprintf "b'%s%d%d1100'", $p1m, $ccp1con5, $ccp1con4; |
51
|
6
|
|
|
|
|
20
|
my %str = (CCP1 => 0, P1D => 0, P1C => 0, P1B => 0, P1A => 0); # default all are port pins |
52
|
6
|
|
|
|
|
8
|
my %trisc = (); |
53
|
6
|
|
|
|
|
11
|
foreach my $pin (@pins) { |
54
|
16
|
50
|
|
|
|
35
|
unless (exists $self->pins->{$pin}) { |
55
|
0
|
|
|
|
|
0
|
carp "$pin is not a valid pin on the microcontroller. Ignoring\n"; |
56
|
0
|
|
|
|
|
0
|
next; |
57
|
|
|
|
|
|
|
} |
58
|
16
|
|
|
|
|
27
|
my $pinno = $self->pins->{$pin}; |
59
|
16
|
|
|
|
|
22
|
my $allpins = $self->pins->{$pinno}; |
60
|
16
|
|
|
|
|
18
|
my $pwm_pin; |
61
|
16
|
|
|
|
|
22
|
foreach (@$allpins) { |
62
|
48
|
100
|
|
|
|
77
|
next unless exists $self->eccp_pins->{$_}; |
63
|
16
|
|
|
|
|
18
|
$pwm_pin = $_; |
64
|
16
|
|
|
|
|
18
|
last; |
65
|
|
|
|
|
|
|
} |
66
|
16
|
50
|
|
|
|
22
|
next unless defined $pwm_pin; |
67
|
|
|
|
|
|
|
# the user may use say RC5 instead of CCP1 and we still want the |
68
|
|
|
|
|
|
|
# CCP1 name which should really be returned as P1A here |
69
|
|
|
|
|
|
|
# pulse steering only needed in Single mode |
70
|
16
|
|
|
|
|
15
|
my ($p0, $trisp, $portpin) = @{$self->eccp_pins->{$pwm_pin}}; |
|
16
|
|
|
|
|
30
|
|
71
|
16
|
100
|
|
|
|
35
|
$str{$pwm_pin} = 1 if $type eq 'single'; |
72
|
16
|
|
|
|
|
31
|
$trisc{$portpin} = $trisp; |
73
|
|
|
|
|
|
|
} |
74
|
6
|
|
66
|
|
|
24
|
my $p1a = $str{P1A} || $str{CCP1}; |
75
|
6
|
|
|
|
|
16
|
my $pstrcon = sprintf "b'0001%d%d%d%d'", $str{P1D}, $str{P1C}, $str{P1B}, $p1a; |
76
|
6
|
|
|
|
|
10
|
my $trisc_bsf = ''; |
77
|
6
|
|
|
|
|
7
|
my $trisc_bcf = ''; |
78
|
6
|
|
|
|
|
21
|
foreach (sort (keys %trisc)) { |
79
|
16
|
|
|
|
|
22
|
my $trisp = $trisc{$_}; |
80
|
16
|
|
|
|
|
29
|
$trisc_bsf .= "\tbsf $trisp, $trisp$_\n"; |
81
|
16
|
|
|
|
|
36
|
$trisc_bcf .= "\tbcf $trisp, $trisp$_\n"; |
82
|
|
|
|
|
|
|
} |
83
|
6
|
|
|
|
|
10
|
my $pstrcon_code = ''; |
84
|
6
|
100
|
|
|
|
13
|
if ($type eq 'single') { |
85
|
3
|
|
|
|
|
7
|
$pstrcon_code = << "..."; |
86
|
|
|
|
|
|
|
\tbanksel PSTRCON |
87
|
|
|
|
|
|
|
\tmovlw $pstrcon |
88
|
|
|
|
|
|
|
\tmovwf PSTRCON |
89
|
|
|
|
|
|
|
... |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
return ( |
92
|
|
|
|
|
|
|
# actual register values |
93
|
6
|
|
|
|
|
87
|
CCP1CON => $ccp1con, |
94
|
|
|
|
|
|
|
PR2 => $pr2_x, |
95
|
|
|
|
|
|
|
T2CON => $t2con, |
96
|
|
|
|
|
|
|
CCPR1L => $ccpr1l_x, |
97
|
|
|
|
|
|
|
PSTRCON => $pstrcon, |
98
|
|
|
|
|
|
|
PSTRCON_CODE => $pstrcon_code, |
99
|
|
|
|
|
|
|
# no ECCPAS |
100
|
|
|
|
|
|
|
PWM1CON => '0x80', # default |
101
|
|
|
|
|
|
|
# code to be added |
102
|
|
|
|
|
|
|
TRISC_BSF => $trisc_bsf, |
103
|
|
|
|
|
|
|
TRISC_BCF => $trisc_bcf, |
104
|
|
|
|
|
|
|
# general comments |
105
|
|
|
|
|
|
|
CCPR1L_CCP1CON54 => $ccpr1l_ccp1con54, |
106
|
|
|
|
|
|
|
FOSC => $f_osc, |
107
|
|
|
|
|
|
|
PRESCALER => $prescaler, |
108
|
|
|
|
|
|
|
PWM_FREQUENCY => $pwm_frequency, |
109
|
|
|
|
|
|
|
DUTYCYCLE => $duty, |
110
|
|
|
|
|
|
|
PINS => \@pins, |
111
|
|
|
|
|
|
|
TYPE => $type, |
112
|
|
|
|
|
|
|
); |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
sub _pwm_code { |
116
|
5
|
|
|
5
|
|
11
|
my $self = shift; |
117
|
5
|
|
|
|
|
42
|
my %details = @_; |
118
|
5
|
|
|
|
|
12
|
my @pins = @{$details{PINS}}; |
|
5
|
|
|
|
|
18
|
|
119
|
5
|
|
|
|
|
88
|
return << "..."; |
120
|
|
|
|
|
|
|
;;; PWM Type: $details{TYPE} |
121
|
|
|
|
|
|
|
;;; PWM Frequency = $details{PWM_FREQUENCY} Hz |
122
|
|
|
|
|
|
|
;;; Duty Cycle = $details{DUTYCYCLE} / 100 |
123
|
|
|
|
|
|
|
;;; CCPR1L:CCP1CON<5:4> = $details{CCPR1L_CCP1CON54} |
124
|
|
|
|
|
|
|
;;; CCPR1L = $details{CCPR1L} |
125
|
|
|
|
|
|
|
;;; CCP1CON = $details{CCP1CON} |
126
|
|
|
|
|
|
|
;;; T2CON = $details{T2CON} |
127
|
|
|
|
|
|
|
;;; PR2 = $details{PR2} |
128
|
|
|
|
|
|
|
;;; PSTRCON = $details{PSTRCON} |
129
|
|
|
|
|
|
|
;;; PWM1CON = $details{PWM1CON} |
130
|
|
|
|
|
|
|
;;; Prescaler = $details{PRESCALER} |
131
|
|
|
|
|
|
|
;;; Fosc = $details{FOSC} |
132
|
|
|
|
|
|
|
;;; disable the PWM output driver for @pins by setting the associated TRIS bit |
133
|
|
|
|
|
|
|
\tbanksel TRISC |
134
|
|
|
|
|
|
|
$details{TRISC_BSF} |
135
|
|
|
|
|
|
|
;;; set PWM period by loading PR2 |
136
|
|
|
|
|
|
|
\tbanksel PR2 |
137
|
|
|
|
|
|
|
\tmovlw $details{PR2} |
138
|
|
|
|
|
|
|
\tmovwf PR2 |
139
|
|
|
|
|
|
|
;;; configure the CCP module for the PWM mode by setting CCP1CON |
140
|
|
|
|
|
|
|
\tbanksel CCP1CON |
141
|
|
|
|
|
|
|
\tmovlw $details{CCP1CON} |
142
|
|
|
|
|
|
|
\tmovwf CCP1CON |
143
|
|
|
|
|
|
|
;;; set PWM duty cycle |
144
|
|
|
|
|
|
|
\tmovlw $details{CCPR1L} |
145
|
|
|
|
|
|
|
\tmovwf CCPR1L |
146
|
|
|
|
|
|
|
;;; configure and start TMR2 |
147
|
|
|
|
|
|
|
;;; - clear TMR2IF flag of PIR1 register |
148
|
|
|
|
|
|
|
\tbanksel PIR1 |
149
|
|
|
|
|
|
|
\tbcf PIR1, TMR2IF |
150
|
|
|
|
|
|
|
\tmovlw $details{T2CON} |
151
|
|
|
|
|
|
|
\tmovwf T2CON |
152
|
|
|
|
|
|
|
;;; enable PWM output after a new cycle has started |
153
|
|
|
|
|
|
|
\tbtfss PIR1, TMR2IF |
154
|
|
|
|
|
|
|
\tgoto \$ - 1 |
155
|
|
|
|
|
|
|
\tbcf PIR1, TMR2IF |
156
|
|
|
|
|
|
|
;;; enable @pins pin output driver by clearing the associated TRIS bit |
157
|
|
|
|
|
|
|
$details{PSTRCON_CODE} |
158
|
|
|
|
|
|
|
;;; disable auto-shutdown mode |
159
|
|
|
|
|
|
|
\tbanksel ECCPAS |
160
|
|
|
|
|
|
|
\tclrf ECCPAS |
161
|
|
|
|
|
|
|
;;; set PWM1CON if half bridge mode |
162
|
|
|
|
|
|
|
\tbanksel PWM1CON |
163
|
|
|
|
|
|
|
\tmovlw $details{PWM1CON} |
164
|
|
|
|
|
|
|
\tmovwf PWM1CON |
165
|
|
|
|
|
|
|
\tbanksel TRISC |
166
|
|
|
|
|
|
|
$details{TRISC_BCF} |
167
|
|
|
|
|
|
|
... |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
sub pwm_single { |
171
|
2
|
|
|
2
|
0
|
16
|
my ($self, $pwm_frequency, $duty, @pins) = @_; |
172
|
2
|
50
|
|
|
|
9
|
return unless $self->doesrole('ECCP'); |
173
|
2
|
50
|
|
|
|
11
|
unless (exists $self->eccp_pins->{P1A}) { |
174
|
0
|
0
|
|
|
|
0
|
if (exists $self->eccp_pins->{CCP1}) { |
175
|
|
|
|
|
|
|
# override the pins to CCP1 |
176
|
0
|
|
|
|
|
0
|
@pins = qw(CCP1); |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
} |
179
|
2
|
|
|
|
|
15
|
my %details = $self->_pwm_details($pwm_frequency, $duty, 'single', @pins); |
180
|
|
|
|
|
|
|
# pulse steering automatically taken care of |
181
|
2
|
|
|
|
|
18
|
return $self->_pwm_code(%details); |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
sub pwm_halfbridge { |
185
|
1
|
|
|
1
|
0
|
7
|
my ($self, $pwm_frequency, $duty, $deadband, @pins) = @_; |
186
|
1
|
50
|
|
|
|
3
|
return unless $self->doesrole('ECCP'); |
187
|
1
|
50
|
33
|
|
|
7
|
if (exists $self->eccp_pins->{P1A} and exists $self->eccp_pins->{P1B}) { |
188
|
|
|
|
|
|
|
# we ignore the @pins that comes in |
189
|
1
|
|
|
|
|
3
|
@pins = qw(P1A P1B); |
190
|
|
|
|
|
|
|
} else { |
191
|
0
|
|
|
|
|
0
|
carp $self->type, " has no Enhanced PWM capabilities"; |
192
|
0
|
|
|
|
|
0
|
return; |
193
|
|
|
|
|
|
|
} |
194
|
1
|
|
|
|
|
4
|
my %details = $self->_pwm_details($pwm_frequency, $duty, 'half', @pins); |
195
|
|
|
|
|
|
|
# override PWM1CON |
196
|
1
|
50
|
33
|
|
|
9
|
if (defined $deadband and $deadband > 0) { |
197
|
1
|
|
|
|
|
61
|
my $fosc = $details{FOSC}; |
198
|
1
|
|
|
|
|
3
|
my $pwm1con = $deadband * $fosc / 4e6; # $deadband is in microseconds |
199
|
1
|
|
|
|
|
144
|
$pwm1con &= 0x7F; # 6-bits only |
200
|
1
|
|
|
|
|
132
|
$pwm1con |= 0x80; # clear PRSEN bit |
201
|
1
|
|
|
|
|
114
|
$details{PWM1CON} = sprintf "0x%02X", $pwm1con; |
202
|
|
|
|
|
|
|
} |
203
|
1
|
|
|
|
|
25
|
return $self->_pwm_code(%details); |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
sub pwm_fullbridge { |
207
|
2
|
|
|
2
|
0
|
14
|
my ($self, $direction, $pwm_frequency, $duty, @pins) = @_; |
208
|
2
|
50
|
|
|
|
5
|
return unless $self->doesrole('ECCP'); |
209
|
2
|
50
|
33
|
|
|
9
|
if (defined $direction and ref $direction eq 'HASH') { |
210
|
2
|
|
|
|
|
4
|
$direction = $direction->{string}; |
211
|
|
|
|
|
|
|
} |
212
|
2
|
|
|
|
|
3
|
my $type = 'full_forward'; |
213
|
2
|
100
|
|
|
|
9
|
$type = 'full_reverse' if $direction =~ /reverse|backward|no?|0/i; |
214
|
2
|
50
|
33
|
|
|
18
|
if (exists $self->eccp_pins->{P1A} and exists $self->eccp_pins->{P1B} and |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
215
|
|
|
|
|
|
|
exists $self->eccp_pins->{P1C} and exists $self->eccp_pins->{P1D}) { |
216
|
|
|
|
|
|
|
# we ignore the @pins that comes in |
217
|
2
|
|
|
|
|
13
|
@pins = qw(P1A P1B P1C P1D); |
218
|
|
|
|
|
|
|
} else { |
219
|
0
|
|
|
|
|
0
|
carp $self->type, " has no Enhanced PWM capabilities"; |
220
|
0
|
|
|
|
|
0
|
return; |
221
|
|
|
|
|
|
|
} |
222
|
2
|
|
|
|
|
7
|
my %details = $self->_pwm_details($pwm_frequency, $duty, $type, @pins); |
223
|
2
|
|
|
|
|
8
|
return $self->_pwm_code(%details); |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
sub pwm_update { |
227
|
1
|
|
|
1
|
0
|
8
|
my ($self, $pwm_frequency, $duty) = @_; |
228
|
1
|
50
|
|
|
|
4
|
return unless $self->doesrole('ECCP'); |
229
|
|
|
|
|
|
|
# hack into the existing functions to update only what we need |
230
|
1
|
|
|
|
|
2
|
my @pins = qw(CCP1); |
231
|
1
|
50
|
33
|
|
|
13
|
if (exists $self->eccp_pins->{P1A} and exists $self->eccp_pins->{P1B} and |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
232
|
|
|
|
|
|
|
exists $self->eccp_pins->{P1C} and exists $self->eccp_pins->{P1D}) { |
233
|
|
|
|
|
|
|
# we ignore the @pins that comes in |
234
|
1
|
|
|
|
|
3
|
@pins = qw(P1A P1B P1C P1D); |
235
|
|
|
|
|
|
|
} |
236
|
1
|
|
|
|
|
3
|
my %details = $self->_pwm_details($pwm_frequency, $duty, 'single', @pins); |
237
|
1
|
|
|
|
|
3
|
my ($ccp1con5, $ccp1con4); |
238
|
1
|
|
|
|
|
3
|
$ccp1con4 = $details{CCPR1L_CCP1CON54} & 0x0001; |
239
|
1
|
|
|
|
|
206
|
$ccp1con5 = ($details{CCPR1L_CCP1CON54} >> 1) & 0x0001; |
240
|
1
|
50
|
|
|
|
277
|
if ($ccp1con4) { |
241
|
1
|
|
|
|
|
23
|
$ccp1con4 = "\tbsf CCP1CON, DC1B0"; |
242
|
|
|
|
|
|
|
} else { |
243
|
0
|
|
|
|
|
0
|
$ccp1con4 = "\tbcf CCP1CON, DC1B0"; |
244
|
|
|
|
|
|
|
} |
245
|
1
|
50
|
|
|
|
3
|
if ($ccp1con5) { |
246
|
0
|
|
|
|
|
0
|
$ccp1con5 = "\tbsf CCP1CON, DC1B1"; |
247
|
|
|
|
|
|
|
} else { |
248
|
1
|
|
|
|
|
19
|
$ccp1con5 = "\tbcf CCP1CON, DC1B1"; |
249
|
|
|
|
|
|
|
} |
250
|
1
|
|
|
|
|
11
|
return << "..."; |
251
|
|
|
|
|
|
|
;;; updating PWM duty cycle for a given frequency |
252
|
|
|
|
|
|
|
;;; PWM Frequency = $details{PWM_FREQUENCY} Hz |
253
|
|
|
|
|
|
|
;;; Duty Cycle = $details{DUTYCYCLE} / 100 |
254
|
|
|
|
|
|
|
;;; CCPR1L:CCP1CON<5:4> = $details{CCPR1L_CCP1CON54} |
255
|
|
|
|
|
|
|
;;; CCPR1L = $details{CCPR1L} |
256
|
|
|
|
|
|
|
;;; update CCPR1L and CCP1CON<5:4> or the DC1B[01] bits |
257
|
|
|
|
|
|
|
$ccp1con4 |
258
|
|
|
|
|
|
|
$ccp1con5 |
259
|
|
|
|
|
|
|
\tmovlw $details{CCPR1L} |
260
|
|
|
|
|
|
|
\tmovwf CCPR1L |
261
|
|
|
|
|
|
|
... |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
1; |
267
|
|
|
|
|
|
|
__END__ |