File Coverage

blib/lib/VIC/PIC/Functions/ISR.pm
Criterion Covered Total %
statement 89 100 89.0
branch 32 54 59.2
condition 6 15 40.0
subroutine 10 10 100.0
pod 0 5 0.0
total 137 184 74.4


line stmt bran cond sub pod time code
1             package VIC::PIC::Functions::ISR;
2 31     31   15212 use strict;
  31         46  
  31         766  
3 31     31   109 use warnings;
  31         38  
  31         1275  
4             our $VERSION = '0.31';
5             $VERSION = eval $VERSION;
6 31     31   113 use Carp;
  31         45  
  31         1358  
7 31     31   120 use POSIX ();
  31         36  
  31         361  
8 31     31   84 use Moo::Role;
  31         29  
  31         152  
9              
10             sub isr_var {
11 5     5 0 23 my $self = shift;
12 5 50       12 return unless $self->doesroles(qw(Chip ISR));
13 5         7 my @common = @{$self->banks->{common}};
  5         30  
14 5         11 my ($cb_start, $cb_end) = @common;
15 5 50       26 if (ref $cb_start eq 'ARRAY') {
16 0         0 ($cb_start, $cb_end) = @$cb_start;
17             }
18 5 50       11 $cb_start = 0x70 unless $cb_start;
19 5         18 $cb_start = sprintf "0x%02X", $cb_start;
20 5         21 return << "...";
21             cblock $cb_start ;; unbanked RAM that is common across all banks
22             ISR_STATUS
23             ISR_W
24             endc
25             ...
26             }
27              
28             sub isr_entry {
29 5     5 0 28 my $self = shift;
30 5 50       15 return unless $self->doesroles(qw(Chip ISR));
31 5 50       27 unless (exists $self->registers->{STATUS}) {
32 0         0 carp $self->type, " has no register named STATUS";
33 0         0 return;
34             }
35             #TODO: high/low address ?
36 5         26 my $isr_addr = $self->address->{isr}->[0];
37 5         16 my $reset_addr = $self->address->{reset}->[0];
38 5         8 my $count = $isr_addr - $reset_addr - 1;
39 5         10 my $nops = '';
40 5         12 for my $i (1 .. $count) {
41 15         18 $nops .= "\tnop\n";
42             }
43 5         21 return << "...";
44             $nops
45             \torg $isr_addr
46             ISR:
47             _isr_entry:
48             \tmovwf ISR_W
49             \tmovf STATUS, W
50             \tmovwf ISR_STATUS
51             ...
52             }
53              
54             sub isr_exit {
55 5     5 0 21 my $self = shift;
56 5 50       14 return unless $self->doesroles(qw(Chip ISR));
57 5 50       22 unless (exists $self->registers->{STATUS}) {
58 0         0 carp $self->type, " has no register named STATUS";
59 0         0 return;
60             }
61 5         10 return << "...";
62             _isr_exit:
63             \tmovf ISR_STATUS, W
64             \tmovwf STATUS
65             \tswapf ISR_W, F
66             \tswapf ISR_W, W
67             \tretfie
68             ...
69             }
70              
71             sub isr_timer {
72 2     2 0 3 my $self = shift;
73 2 50       4 return unless $self->doesroles(qw(Chip ISR));
74 2         2 my $th = shift;
75 2 50 33     22 return unless (defined $th and ref $th eq 'HASH');
76 2         3 my $freg = $th->{freg};
77 2         3 my $ereg = $th->{ereg};
78 2 50 33     11 unless (exists $self->registers->{$freg} and exists $self->registers->{$ereg}) {
79 0         0 carp $self->type, " has no register named $freg or $ereg";
80 0         0 return;
81             }
82 2         1 my $tflag = $th->{flag};
83 2         2 my $tenable = $th->{enable};
84 2 50       4 my $treg = (ref $th->{reg} eq 'ARRAY') ? $th->{reg}->[0] : $th->{reg};
85 2         4 my %isr = @_;
86 2 100       4 if (%isr) {
87 1         2 my $action_label = $isr{ISR};
88 1         1 my $end_label = $isr{END};
89 1 50       2 return unless $action_label;
90 1 50       5 return unless $end_label;
91 1         2 my $isr_label = '_isr_' . lc($treg);
92             return << "..."
93             $isr_label:
94             \tbtfss $freg, $tflag
95             \tgoto $end_label
96             \tbcf $freg, $tflag
97             \tgoto $action_label
98             $end_label:
99             ...
100 1         7 } else {
101 1 50 33     5 if ($freg eq 'INTCON' and $ereg eq 'INTCON') {
102 1         7 return << "...";
103             ;; enable interrupt servicing for $treg
104             \tbanksel $freg
105             \tbsf INTCON, GIE
106             \tbcf $freg, $tflag
107             \tbsf $ereg, $tenable
108             ;; end of interrupt servicing
109             ...
110             } else {
111 0         0 return << "...";
112             ;; enable interrupt servicing for $treg
113             \tbanksel INTCON
114             \tbsf INTCON, GIE
115             \tbanksel $freg
116             \tbcf $freg, $tflag
117             \tbanksel $ereg
118             \tbsf $ereg, $tenable
119             ;; end of interrupt servicing
120             ...
121              
122             }
123             }
124             }
125              
126             sub isr_ioc {
127 6     6 0 6 my $self = shift;
128 6 50       13 return unless $self->doesroles(qw(Chip ISR));
129 6 50       18 unless (exists $self->registers->{INTCON}) {
130 0         0 carp $self->type, " has no register named INTCON";
131 0         0 return;
132             }
133 6         7 my $ioch = shift;
134 6         7 my $ipin = shift;
135 6 50 33     25 return unless (defined $ioch and ref $ioch eq 'HASH');
136 6 50       14 return unless defined $ipin;
137 6         8 my $ioc_reg = $ioch->{reg};
138 6         10 my $ioc_bit = $ioch->{bit};
139 6         8 my $ioc_flag = $ioch->{flag};
140 6         8 my $ioc_enable = $ioch->{enable};
141 6 100       11 if (@_) {
142 3         19 my ($var, $port, $portbit, %isr) = @_;
143 3         6 my $action_label = $isr{ISR};
144 3         3 my $end_label = $isr{END};
145 3 50       9 return unless $action_label;
146 3 50       5 return unless $end_label;
147 3         4 my $isr_label;
148 3 100       9 if (defined $ioc_bit) {
    50          
149 2         4 $isr_label = '_isr_' . lc($ioc_bit);
150             } elsif (defined $ioc_reg) {
151 1         1 $isr_label = '_isr_' .lc($ioc_reg);
152             } else {
153 0         0 $isr_label = '_isr_' . lc($ipin);
154             }
155 3         5 my $code_ioc = '';
156 3 100       14 if (defined $portbit) {
157 2         6 $code_ioc = "\tbtfsc $port, $portbit\n\taddlw 0x01";
158             } else {
159 1         3 $code_ioc = "\tmovf $port, W";
160             }
161             return << "..."
162             $isr_label:
163             \tbtfss INTCON, $ioc_flag
164             \tgoto $end_label
165             \tbcf INTCON, $ioc_flag
166             \tbanksel $port
167             $code_ioc
168             \tbanksel $var
169             \tmovwf $var
170             \tgoto $action_label
171             $end_label:
172             ...
173              
174 3         25 } else {
175 3         6 my $code_en = '';
176 3 100 66     13 if (defined $ioc_bit and defined $ioc_reg) {
    50          
177 2         8 $code_en = "\tbanksel $ioc_reg\n\tbsf $ioc_reg, $ioc_bit";
178             } elsif (defined $ioc_reg) {
179 1         4 $code_en = "\tbanksel $ioc_reg\n\tclrf $ioc_reg\n\tcomf $ioc_reg, F";
180             } else {
181             # if ioc_reg/ioc_bit is not defined just move on
182             }
183 3         17 return << "...";
184             ;; enable interrupt-on-change setup for $ipin
185             \tbanksel INTCON
186             \tbcf INTCON, $ioc_flag
187             \tbsf INTCON, GIE
188             \tbsf INTCON, $ioc_enable
189             $code_en
190             ;; end of interrupt-on-change setup
191             ...
192             }
193             }
194              
195              
196             1;
197             __END__