line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package VIC::PIC::Functions::CodeGen; |
2
|
31
|
|
|
31
|
|
19036
|
use strict; |
|
31
|
|
|
|
|
46
|
|
|
31
|
|
|
|
|
857
|
|
3
|
31
|
|
|
31
|
|
110
|
use warnings; |
|
31
|
|
|
|
|
38
|
|
|
31
|
|
|
|
|
1598
|
|
4
|
|
|
|
|
|
|
our $VERSION = '0.31'; |
5
|
|
|
|
|
|
|
$VERSION = eval $VERSION; |
6
|
31
|
|
|
31
|
|
116
|
use Carp; |
|
31
|
|
|
|
|
41
|
|
|
31
|
|
|
|
|
1796
|
|
7
|
31
|
|
|
31
|
|
529
|
use POSIX (); |
|
31
|
|
|
|
|
4284
|
|
|
31
|
|
|
|
|
649
|
|
8
|
31
|
|
|
31
|
|
107
|
use Moo::Role; |
|
31
|
|
|
|
|
39
|
|
|
31
|
|
|
|
|
210
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
# default |
11
|
|
|
|
|
|
|
has org => (is => 'ro', default => 0); |
12
|
|
|
|
|
|
|
has code_config => (is => 'rw', default => sub { |
13
|
|
|
|
|
|
|
{ |
14
|
|
|
|
|
|
|
debounce => { |
15
|
|
|
|
|
|
|
count => 5, |
16
|
|
|
|
|
|
|
delay => 1000, # in microseconds |
17
|
|
|
|
|
|
|
}, |
18
|
|
|
|
|
|
|
adc => { |
19
|
|
|
|
|
|
|
right_justify => 1, |
20
|
|
|
|
|
|
|
vref => 0, |
21
|
|
|
|
|
|
|
internal => 0, |
22
|
|
|
|
|
|
|
}, |
23
|
|
|
|
|
|
|
variable => { |
24
|
|
|
|
|
|
|
bits => 8, # bits. same as register_size |
25
|
|
|
|
|
|
|
export => 0, # do not export variables |
26
|
|
|
|
|
|
|
}, |
27
|
|
|
|
|
|
|
string => { |
28
|
|
|
|
|
|
|
size => 32, # character allocation of null strings |
29
|
|
|
|
|
|
|
}, |
30
|
|
|
|
|
|
|
uart => { |
31
|
|
|
|
|
|
|
baud => 9600, # baud rate |
32
|
|
|
|
|
|
|
bit9 => 0, # allow 9 bits |
33
|
|
|
|
|
|
|
}, |
34
|
|
|
|
|
|
|
usart => { |
35
|
|
|
|
|
|
|
baud => 9600, # baud rate |
36
|
|
|
|
|
|
|
bit9 => 0, # allow 9 bits |
37
|
|
|
|
|
|
|
}, |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
}); |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
sub validate { |
42
|
227
|
|
|
227
|
0
|
1078
|
my ($self, $var) = @_; |
43
|
227
|
50
|
|
|
|
441
|
return undef unless defined $var; |
44
|
227
|
100
|
|
|
|
777
|
return 0 if $var =~ /^\d+$/; |
45
|
216
|
50
|
|
|
|
952
|
return 0 unless $self->doesrole('Chip'); |
46
|
216
|
100
|
|
|
|
1462
|
return 1 if exists $self->pins->{$var}; |
47
|
75
|
100
|
|
|
|
576
|
return 1 if exists $self->registers->{$var}; |
48
|
30
|
50
|
33
|
|
|
80
|
return 1 if ($self->doesrole('Timer', 1) and exists $self->timer_pins->{$var}); |
49
|
30
|
100
|
33
|
|
|
70
|
return 1 if ($self->doesrole('Timer', 1) and exists $self->wdt_prescaler->{$var}); |
50
|
29
|
100
|
33
|
|
|
108
|
return 1 if ($self->doesrole('USART', 1) and exists $self->usart_pins->{$var}); |
51
|
9
|
|
|
|
|
36
|
return 0; |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
sub validate_operator { |
55
|
133
|
|
|
133
|
0
|
524
|
my ($self, $op) = @_; |
56
|
133
|
50
|
|
|
|
499
|
my $vop = "op_$op" if $op =~ /^ |
57
|
|
|
|
|
|
|
LE | GE | GT | LT | EQ | NE | |
58
|
|
|
|
|
|
|
ADD | SUB | MUL | DIV | MOD | |
59
|
|
|
|
|
|
|
BXOR | BOR | BAND | AND | OR | SHL | SHR | |
60
|
|
|
|
|
|
|
ASSIGN | INC | DEC | NOT | COMP | |
61
|
|
|
|
|
|
|
TBLIDX | ARRIDX | STRIDX |
62
|
|
|
|
|
|
|
/x; |
63
|
133
|
50
|
|
|
|
379
|
return lc $vop if defined $vop; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
sub validate_modifier_operator { |
67
|
16
|
|
|
16
|
0
|
103
|
my ($self, $mod) = @_; |
68
|
16
|
100
|
|
|
|
88
|
my $vmod = "op_$mod" if $mod =~ /^ |
69
|
|
|
|
|
|
|
SQRT | HIGH | LOW |
70
|
|
|
|
|
|
|
/x; |
71
|
16
|
100
|
|
|
|
112
|
return lc $vmod if defined $vmod; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
sub update_code_config { |
75
|
20
|
|
|
20
|
0
|
107
|
my ($self, $grp, $key, $val) = @_; |
76
|
20
|
50
|
|
|
|
170
|
return unless $self->doesrole('CodeGen'); |
77
|
20
|
50
|
|
|
|
58
|
return unless defined $grp; |
78
|
20
|
|
|
|
|
33
|
$grp = lc $grp; # force lower case in case of usage for things like SPI/UART/I2C |
79
|
20
|
100
|
|
|
|
91
|
$self->code_config->{$grp} = {} unless exists $self->code_config->{$grp}; |
80
|
20
|
|
|
|
|
45
|
my $grpref = $self->code_config->{$grp}; |
81
|
20
|
100
|
|
|
|
52
|
if ($key eq 'bits') { |
82
|
2
|
50
|
|
|
|
6
|
$val = 8 unless defined $val; |
83
|
2
|
50
|
|
|
|
4
|
$val = 8 if $val <= 8; |
84
|
2
|
50
|
33
|
|
|
7
|
$val = 16 if ($val > 8 and $val <= 16); |
85
|
2
|
50
|
33
|
|
|
7
|
$val = 32 if ($val > 16 and $val <= 32); |
86
|
2
|
50
|
|
|
|
5
|
carp "$val-bits is not supported. Maximum supported size is 64-bit" |
87
|
|
|
|
|
|
|
if $val > 64; |
88
|
2
|
50
|
|
|
|
4
|
$val = 64 if $val > 32; |
89
|
|
|
|
|
|
|
} |
90
|
20
|
100
|
|
|
|
40
|
$val = 1 unless defined $val; |
91
|
20
|
50
|
|
|
|
53
|
if (ref $grpref eq 'HASH') { |
92
|
20
|
|
|
|
|
38
|
$grpref->{$key} = $val; |
93
|
|
|
|
|
|
|
} else { |
94
|
0
|
|
|
|
|
0
|
$self->code_config->{$grp} = { $key => $val }; |
95
|
|
|
|
|
|
|
} |
96
|
20
|
|
|
|
|
36
|
1; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
sub address_bits { |
100
|
257
|
|
|
257
|
0
|
1419
|
my ($self, $varname) = @_; |
101
|
257
|
50
|
|
|
|
494
|
return unless $self->doesrole('CodeGen'); |
102
|
257
|
|
|
|
|
588
|
my $bits = $self->code_config->{variable}->{bits}; |
103
|
257
|
50
|
|
|
|
411
|
return $bits unless $varname; |
104
|
257
|
|
33
|
|
|
1047
|
$bits = $self->code_config->{lc $varname}->{bits} || $bits; |
105
|
257
|
|
|
|
|
556
|
return $bits; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub is_variable { |
109
|
5
|
|
|
5
|
0
|
7
|
my ($self, $varname) = @_; |
110
|
5
|
50
|
|
|
|
13
|
return unless $varname; |
111
|
5
|
50
|
|
|
|
27
|
return unless $self->doesrole('CodeGen'); |
112
|
5
|
100
|
|
|
|
36
|
return 1 if defined $self->code_config->{lc $varname}; |
113
|
1
|
|
|
|
|
7
|
return 0; |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
1; |
118
|
|
|
|
|
|
|
__END__ |