File Coverage

blib/lib/VIC/PIC/Functions/Timer.pm
Criterion Covered Total %
statement 66 98 67.3
branch 30 58 51.7
condition 10 35 28.5
subroutine 9 10 90.0
pod 0 3 0.0
total 115 204 56.3


line stmt bran cond sub pod time code
1             package VIC::PIC::Functions::Timer;
2 31     31   14473 use strict;
  31         47  
  31         772  
3 31     31   107 use warnings;
  31         38  
  31         1233  
4             our $VERSION = '0.29';
5             $VERSION = eval $VERSION;
6 31     31   100 use Carp;
  31         36  
  31         1378  
7 31     31   123 use POSIX ();
  31         37  
  31         464  
8 31     31   108 use Moo::Role;
  31         52  
  31         187  
9              
10             sub _get_timer_prescaler {
11 2     2   3 my ($self, $freq) = @_;
12 2         9 my $f_osc = $self->f_osc;
13 2         14 my $scale = POSIX::ceil(($f_osc / 4) / $freq); # assume prescaler = 1 here
14 2 50 33     89 if ($scale <=2) {
    50 33        
    50 33        
    50 33        
    50 33        
    50 33        
    50 33        
    50          
15 0         0 $scale = 2;
16             } elsif ($scale > 2 && $scale <= 4) {
17 0         0 $scale = 4;
18             } elsif ($scale > 4 && $scale <= 8) {
19 0         0 $scale = 8;
20             } elsif ($scale > 8 && $scale <= 16) {
21 0         0 $scale = 16;
22             } elsif ($scale > 16 && $scale <= 32) {
23 0         0 $scale = 32;
24             } elsif ($scale > 32 && $scale <= 64) {
25 0         0 $scale = 64;
26             } elsif ($scale > 64 && $scale <= 128) {
27 0         0 $scale = 128;
28             } elsif ($scale > 128 && $scale <= 256) {
29 2         3 $scale = 256;
30             } else {
31 0         0 $scale = 256;
32             }
33 2   33     16 my $psx = $self->timer_prescaler->{$scale} || $self->timer_prescaler->{256};
34 2         5 return $psx;
35             }
36              
37             sub _get_wdt_prescaler {
38 1     1   1 my ($self, $period) = @_;
39 1         3 my $lfintosc = $self->wdt_prescaler->{LFINTOSC};
40             #period is in microseconds. convert to seconds
41 1         3 $period = ($period * 1.0) / 1.0e6;
42 1         15 my $scale = POSIX::floor($lfintosc * $period);
43 1         3 my $wdtps = $self->wdt_prescaler->{WDT};
44 1         6 my @psv = sort { $a <=> $b } keys %$wdtps;
  29         21  
45 1         2 my $minscale = $psv[0];
46 1         2 foreach (@psv) {
47             ## if the scale is 25% above the level, just use the lower level instead
48             #of the higher level
49 5 100       10 if ($scale <= ($_ + $_ / 4)) {
50 1 50       8 return wantarray ? ($_, $wdtps->{$_}) : $wdtps->{$_};
51             }
52             }
53 0         0 my $maxscale = pop @psv;
54 0 0       0 return wantarray ? ($maxscale, $wdtps->{$maxscale}) : $wdtps->{$maxscale};
55             }
56              
57             sub timer_enable {
58 3     3 0 25 my ($self, $tmr, $freq, %isr) = @_;
59 3 50       13 return unless $self->doesroles(qw(Timer Chip));
60 3         23 my ($code, $funcs, $macros) = ('', {}, {});
61 3 100       12 if ($tmr eq 'WDT') {
62 1 50       4 unless (exists $self->registers->{WDTCON}) {
63 0         0 carp $self->type, " does not have the register WDTCON";
64 0         0 return;
65             }
66 1 50       7 if (defined $self->chip_config->{on_off}) {
67 1         2 foreach (keys %{$self->chip_config->{on_off}}) {
  1         5  
68 7 100       13 $self->chip_config->{on_off}->{$_} = 1 if $_ =~ /WDT/;
69             }
70             }
71 1         4 my ($wdtps, $wdtpsbits) = $self->_get_wdt_prescaler($freq);
72 1         4 $code = << "...";
73             ;;; Period is $freq us so scale is 1:$wdtps
74             \tclrwdt
75             \tclrw
76             \tbanksel WDTCON
77             \tiorlw B'000${wdtpsbits}1'
78             \tmovwf WDTCON
79             ...
80             } else {
81 2 50       16 unless (exists $self->timer_pins->{$tmr}) {
82 0         0 carp "$tmr is not a timer.";
83 0         0 return;
84             }
85 2 50       16 unless (exists $self->registers->{OPTION_REG}) {
86 0         0 carp $self->type, " does not have the register OPTION_REG";
87 0         0 return;
88             }
89 2         10 my $psx = $self->_get_timer_prescaler($freq);
90 2         6 my $th = $self->timer_pins->{$tmr};
91 2 50       11 unless (ref $th eq 'HASH') {
92 0         0 carp "$tmr does not have a HASH ref as its value";
93 0         0 return;
94             }
95 2         5 $code = << "...";
96             ;; timer prescaling
97             \tbanksel OPTION_REG
98             \tclrw
99             \tiorlw B'00000$psx'
100             \tmovwf OPTION_REG
101             ...
102 2         5 my $end_code = << "...";
103             ;; clear the timer
104             \tbanksel $tmr
105             \tclrf $tmr
106             ...
107 2 100       8 if (%isr) {
108 1         7 $code .= $self->isr_timer($th);
109             }
110 2         6 $code .= "\n$end_code\n";
111 2 100       5 if (%isr) {
112 1         4 $funcs->{isr_timer} = $self->isr_timer($th, %isr);
113             }
114             }
115 3 50       14 return wantarray ? ($code, $funcs, $macros) : $code;
116             }
117              
118             sub timer_disable {
119 0     0 0 0 my ($self, $tmr) = @_;
120 0 0       0 return unless $self->doesroles(qw(Timer Chip));
121 0 0       0 unless (exists $self->timer_pins->{$tmr}) {
122 0         0 carp "$tmr is not a timer.";
123 0         0 return;
124             }
125 0 0 0     0 unless (exists $self->registers->{OPTION_REG} and
126             exists $self->registers->{INTCON}) {
127 0         0 carp $self->type, " does not have the register OPTION_REG/INTCON";
128 0         0 return;
129             }
130 0         0 my $th = $self->timer_pins->{$tmr};
131 0   0     0 my $tm_en = $th->{enable} || 'T0IE';
132 0   0     0 my $tm_ereg = $th->{ereg} || 'INTCON';
133 0         0 return << "...";
134             \tbanksel $tm_ereg
135             \tbcf $tm_ereg, $tm_en ;; disable only the timer bit
136             \tbanksel OPTION_REG
137             \tmovlw B'00001000'
138             \tmovwf OPTION_REG
139             \tbanksel $tmr
140             \tclrf $tmr
141             ...
142              
143             }
144              
145             sub timer {
146 1     1 0 8 my ($self, $tmr, %action) = @_;
147 1 50       4 return unless exists $action{ACTION};
148 1 50       3 return unless $self->doesroles(qw(Timer Chip));
149 1 50       2 return unless exists $action{END};
150 1 50       8 unless (exists $self->registers->{INTCON}) {
151 0         0 carp $self->type, " does not have the register INTCON";
152 0         0 return;
153             }
154 1         3 my $th = $self->timer_pins->{$tmr};
155 1   50     5 my $tm_f = $th->{flag} || 'T0IF';
156 1   50     3 my $tm_freg = $th->{freg} || 'INTCON';
157 1         7 return << "...";
158             \tbtfss $tm_freg, $tm_f
159             \tgoto $action{END}
160             \tbcf $tm_freg, $tm_f
161             \tgoto $action{ACTION}
162             $action{END}:
163             ...
164             }
165              
166             1;
167             __END__