File Coverage

blib/lib/VIC.pm
Criterion Covered Total %
statement 64 160 40.0
branch 12 106 11.3
condition 3 27 11.1
subroutine 19 26 73.0
pod 0 13 0.0
total 98 332 29.5


line stmt bran cond sub pod time code
1             package VIC;
2 33     33   1118189 use strict;
  33         59  
  33         838  
3 33     33   130 use warnings;
  33         44  
  33         976  
4              
5 33     33   25409 use Env qw(@PATH);
  33         69579  
  33         163  
6 33     33   4435 use File::Spec;
  33         46  
  33         689  
7 33     33   14576 use File::Which qw(which);
  33         23597  
  33         1808  
8 33     33   810 use Capture::Tiny ':all';
  33         39109  
  33         4415  
9 33     33   11067 use VIC::Parser;
  33         75  
  33         1062  
10 33     33   13932 use VIC::Grammar;
  33         82  
  33         267  
11 33     33   19077 use VIC::Receiver;
  33         1662  
  33         1238  
12 33     33   214 use base qw(Exporter);
  33         43  
  33         52992  
13              
14             our @EXPORT = qw(
15             compile
16             assemble
17             simulate
18             supported_chips
19             supported_simulators
20             gpasm
21             gplink
22             gputils
23             bindir
24             is_chip_supported
25             is_simulator_supported
26             list_chip_features
27             );
28              
29             our $Debug = 0;
30             our $Verbose = 0;
31             our $Intermediate = 0;
32             our $GPASM;
33             our $GPLINK;
34             our $GPUTILSDIR;
35              
36             our $VERSION = '0.31';
37             $VERSION = eval $VERSION;
38              
39             sub compile {
40 33     33 0 5541 my ($input, $pic) = @_;
41              
42 33 50       118 die "No code given to compile\n" unless $input;
43 33         353 my $parser = VIC::Parser->new(
44             grammar => VIC::Grammar->new,
45             receiver => VIC::Receiver->new(
46             pic_override => $pic,
47             intermediate_inline => $Intermediate,
48             ),
49             debug => $Debug,
50             throw_on_error => 1,
51             );
52              
53 33         6163 my $output = $parser->parse($input);
54 31         782 my $chip = $parser->receiver->current_chip();
55 31         612 my $sim = $parser->receiver->current_simulator();
56 31 50       13311 return wantarray ? ($output, $chip, $sim) : $output;
57             }
58              
59 1     1 0 6 sub supported_chips { return VIC::Receiver::supported_chips(); }
60              
61 1     1 0 3 sub supported_simulators { return VIC::Receiver::supported_simulators(); }
62              
63 19     19 0 4814 sub is_chip_supported { return VIC::Receiver::is_chip_supported(@_) };
64              
65 0     0 0 0 sub is_simulator_supported { return VIC::Receiver::is_simulator_supported(@_) };
66              
67 0     0 0 0 sub list_chip_features { return VIC::Receiver::list_chip_features(@_) };
68              
69 0     0 0 0 sub print_pinout { return VIC::Receiver::print_pinout(@_) };
70              
71             sub _load_gputils {
72 3     3   4 my ($gpasm, $gplink, $bindir);
73             my ($stdo, $stde) = capture {
74 3     3   2190 my $alien;
75 3 50       196 eval q{
76             require Alien::gputils;
77             $alien = Alien::gputils->new();
78             } or warn "Cannot find Alien::gputils. Ignoring\n";
79 3 50       15 if ($alien) {
80 0 0       0 print "Looking for gpasm and gplink using Alien::gputils\n" if $Verbose;
81 0 0       0 $gpasm = $alien->gpasm() if $alien->can('gpasm');
82 0 0       0 $gplink = $alien->gplink() if $alien->can('gplink');
83 0 0       0 $bindir = $alien->bin_dir() if $alien->can('bin_dir');
84             }
85 3 50 33     7 unless (defined $gpasm and defined $gplink) {
86 3 50       5 print "Looking for gpasm and gplink in \$ENV{PATH}\n" if $Verbose;
87 3         9 $gpasm = which('gpasm');
88 3         314 $gplink = which('gplink');
89             }
90 3 50       264 unless (defined $bindir) {
91 3 50       14 if ($gpasm) {
92 0         0 my @dirs = File::Spec->splitpath($gpasm);
93 0 0       0 pop @dirs if @dirs;
94 0 0       0 $bindir = File::Spec->catdir(@dirs) if @dirs;
95             }
96             }
97 3         79 };
98 3 50       1371 if ($Verbose) {
99 0 0       0 print $stdo if $stdo;
100 0 0       0 print STDERR $stde if $stde;
101 0 0       0 print "Using gpasm: $gpasm\n" if $gpasm;
102 0 0       0 print "Using gplink: $gplink\n" if $gplink;
103 0 0       0 print "gputils installed in: $bindir\n" if $bindir;
104             }
105 3         3 $GPASM = $gpasm;
106 3         5 $GPLINK = $gplink;
107 3         3 $GPUTILSDIR = $bindir;
108 3 50       10 return wantarray ? ($gpasm, $gplink, $bindir) : [$gpasm, $gplink, $bindir];
109             }
110              
111             sub _load_simulator {
112 0     0   0 my $simtype = shift;
113 0         0 my $simexe;
114 0 0       0 die "Simulator type $simtype not supported yet\n" unless $simtype eq 'gpsim';
115 0 0       0 if ($^O =~ /mswin32/i) {
116 0         0 foreach (qw{PROGRAMFILES ProgramFiles PROGRAMFILES(X86)
117             ProgramFiles(X86) ProgamFileW6432 PROGRAMFILESW6432}) {
118 0 0       0 next unless exists $ENV{$_};
119 0 0       0 my $dir = ($ENV{$_} =~ /\s+/) ? Win32::GetShortPathName($ENV{$_}) : $ENV{$_};
120 0 0       0 push @PATH, File::Spec->catdir($dir, $simtype, 'bin') if $dir;
121             }
122 0         0 $simexe = which("$simtype.exe");
123 0 0       0 $simexe = which($simtype) unless $simexe;
124             } else {
125 0         0 $simexe = which($simtype);
126             }
127 0 0 0     0 print "$simtype found at $simexe\n" if ($Verbose and $simexe);
128 0 0       0 warn "$simtype not found\n" unless $simexe;
129 0         0 return $simexe;
130             }
131              
132             sub gputils {
133 1 0 33 1 0 5784 return ($GPASM, $GPLINK, $GPUTILSDIR) if (defined $GPASM and defined $GPLINK
      33        
134             and defined $GPUTILSDIR);
135 1         3 return &_load_gputils();
136             }
137              
138             sub gpasm {
139 1 50   1 0 89 return $GPASM if defined $GPASM;
140 1         2 my @out = &_load_gputils();
141 1         4 return $out[0];
142             }
143              
144             sub gplink {
145 1 50   1 0 4 return $GPLINK if defined $GPLINK;
146 1         2 my @out = &_load_gputils();
147 1         4 return $out[1];
148             }
149              
150             sub bindir {
151 0 0   0 0   return $GPUTILSDIR if defined $GPUTILSDIR;
152 0           my @out = &_load_gputils();
153 0           return $out[2];
154             }
155              
156             sub assemble($$) {
157 0     0 0   my ($chip, $output) = @_;
158 0 0         return unless defined $chip;
159 0 0         return unless defined $output;
160 0           my $hexfile = $output;
161 0           my $objfile = $output;
162 0           my $codfile = $output;
163 0           my $stcfile = $output;
164 0 0         if ($output =~ /\.asm$/) {
165 0           $hexfile =~ s/\.asm$/\.hex/g;
166 0           $objfile =~ s/\.asm$/\.o/g;
167 0           $codfile =~ s/\.asm$/\.cod/g;
168 0           $stcfile =~ s/\.asm$/\.stc/g;
169             } else {
170 0           $hexfile = $output . '.hex';
171 0           $objfile = $output . '.o';
172 0           $codfile = $output . '.hex';
173 0           $stcfile = $output . '.o';
174             }
175 0           my ($gpasm, $gplink, $bindir) = VIC::gputils();
176 0 0 0       unless (defined $gpasm and defined $gplink and -e $gpasm and -e $gplink) {
      0        
      0        
177 0           die "Cannot find gpasm/gplink to compile $output into a hex file $hexfile.";
178             }
179 0           my ($inc1, $inc2) = ('', '');
180 0 0         if (defined $bindir) {
181 0           my @dirs = File::Spec->splitdir($bindir);
182 0 0         my $l = pop @dirs if @dirs;
183 0 0 0       if (defined $l and $l ne 'bin') {
184 0           push @dirs, $l; # return the last directory
185             }
186 0           my @includes = ();
187 0           my @linkers = ();
188 0           push @includes, File::Spec->catdir(@dirs, 'header');
189 0           push @linkers, File::Spec->catdir(@dirs, 'lkr');
190 0           push @includes, File::Spec->catdir(@dirs, 'share', 'gputils', 'header');
191 0           push @linkers, File::Spec->catdir(@dirs, 'share', 'gputils', 'lkr');
192 0           foreach (@includes) {
193 0 0         $inc1 .= " -I $_ " if -d $_;
194             }
195 0           foreach (@linkers) {
196 0 0         $inc2 .= " -I $_ " if -d $_;
197             }
198             }
199 0           $codfile = File::Spec->rel2abs($codfile);
200 0           $stcfile = File::Spec->rel2abs($stcfile);
201 0           $hexfile = File::Spec->rel2abs($hexfile);
202 0           $objfile = File::Spec->rel2abs($objfile);
203 0           my $gpasm_cmd = "$gpasm $inc1 -p $chip -M -c $output";
204 0           my $gplink_cmd = "$gplink $inc2 -q -m -o $hexfile $objfile ";
205 0 0         print "$gpasm_cmd\n" if $Verbose;
206 0 0         system($gpasm_cmd) == 0 or die "Unable to run '$gpasm_cmd': $?";
207 0 0         print "$gplink_cmd\n" if $Verbose;
208 0 0         system($gplink_cmd) == 0 or die "Unable to run '$gplink_cmd': $?";
209 0           my $fh;
210 0 0         open $fh, ">$stcfile" or die "Unable to write $stcfile: $?";
211 0           print $fh "load s '$codfile'\n";
212 0           close $fh;
213 0           return { hex => $hexfile, obj => $objfile, cod => $codfile, stc => $stcfile };
214             }
215              
216             sub simulate {
217 0     0 0   my ($sim, $hh) = @_;
218 0           my $stc;
219 0 0         if (ref $hh eq 'HASH') {
    0          
220 0           $stc = $hh->{stc};
221             } elsif (ref $hh eq 'ARRAY') {
222 0           ($stc) = grep {/\.stc$/} @$hh;
  0            
223             } else {
224 0           $stc = $hh;
225             }
226 0 0 0       die "Cannot find $stc to run the simulator $sim on\n" unless (defined $stc and -e $stc);
227 0           my $simexe = &_load_simulator($sim);
228 0 0         die "$sim is not present in your system PATH for simulation\n" unless $simexe;
229 0           my $sim_cmd = "$simexe $stc";
230 0 0         print "$sim_cmd\n" if $Verbose;
231 0 0         system($sim_cmd) == 0 or die "Unable to run '$sim_cmd': $?";
232 0           1;
233             }
234              
235             1;
236              
237             =encoding utf8
238              
239             =head1 NAME
240              
241             VIC - A Viciously Simple Syntax for PIC Microcontrollers
242              
243             =head1 SYNOPSIS
244              
245             $ vic program.vic -o program.asm
246              
247             $ vic -h
248              
249             =head1 DESCRIPTION
250              
251             Refer documentation at L.
252              
253             =head1 AUTHOR
254              
255             Vikas N Kumar
256              
257             =head1 COPYRIGHT
258              
259             Copyright (c) 2014-2016. Vikas N Kumar
260              
261             This program is free software; you can redistribute it and/or modify it
262             under the same terms as Perl itself.
263              
264             See http://www.perl.com/perl/misc/Artistic.html
265              
266             =cut