pcb/points-pin-alloc-gen

   1 #!/usr/bin/perl -w
   2
   3 use strict qw(refs vars);
   4
   5 use POSIX;
   6 use IO::Handle;
   7
   8 our @pin2otherdesc;
   9 while (<DATA>) {
  10     m/^(\d+)\t(\S.*\S)\s+/ or die;
  11     $pin2otherdesc[$1]= $2;
  12 }
  13
  14 our @boards;
  15 foreach (@ARGV) {
  16     m/^(\w+)\:(\d+)$/ or die "$_ ?";
  17     foreach (my $i=0; $i<$2; $i++) { push @boards, $1; }
  18 }
  19
  20 our %boardpin2point;
  21 our %boardpin2indiv;
  22 our @pinboard2other;
  23 foreach my $board (0..$#boards) {
  24     my $bkind= $boards[$board];
  25     next if exists $boardpin2point{$bkind};
  26
  27     open NI, "$bkind.net-info" or die "$bkind $!";
  28     while (<NI>) {
  29         next if m/^\#/;
  30         while (s/\\\n$//) { $_ .= <NI>; }
  31         next unless m/\S/;
  32         chomp;
  33         my ($netname, $type, $pins) = m/^(\w+)\s+(\w+)\s+(\S.*)?$/
  34             or die "$_ ?";
  35         next unless defined $pins;
  36
  37         $pins= " $pins ";
  38         $pins =~ m/\sPIC-(\d+)\s/ or next;
  39         my $pin= $1;
  40
  41         my $indivpin;
  42         $indivpin=$1 if $pins =~ m/\sINDIV0-(\d+)\s/;
  43
  44         $netname= "__${netname}__";
  45         $netname =~ s/__pt(\d+)__/__/ or next;
  46         my $point= $1;
  47
  48         $netname =~ s/^__//;
  49         $netname =~ s/__$//;
  50         $netname =~ s,__,/,g;
  51         $boardpin2point{$bkind}[$pin]= $point;
  52         $boardpin2indiv{$bkind}[$pin]= $indivpin;
  53         $pinboard2other[$pin]{$bkind}= $netname;
  54     }
  55     NI->error and die "$bkind $!";
  56     close NI;
  57 }
  58
  59 print <<END;
  60 \@SysInclude { tbl }
  61 \@Include { points-pin-alloc.setup }
  62 \@Doc \@Text \@Begin
  63 END
  64
  65 print "\@Tbl\n";
  66
  67 my (@formats,@cells);
  68 my %formats;
  69 my $body='';
  70 my $cellix;
  71 my $nextformat= 'a';
  72
  73 sub startrow () {
  74     $cellix= "A";
  75 }
  76
  77 sub endrow () {
  78     my $format= join ' | ', @formats;
  79     my $formatname= $formats{$format};
  80     if (!defined $formatname) {
  81         $formatname= $nextformat++;
  82         $formats{$format}= $formatname;
  83         print " ${formatname}format { $format }\n";
  84     }
  85     $body .= "\@Row${formatname}\n ".join("\n ", @cells)."\n";
  86     @formats= @cells= ();
  87 }
  88
  89 sub cell ($$) {
  90     my ($fmt, $data) = @_;
  91     my $ix= $cellix++; #"C".scalar @cells;
  92     push @formats, '@Cell rule { yes } '.$fmt." $ix";
  93     push @cells, "$ix { $data }";
  94 }
  95
  96 startrow();
  97 cell('', '');
  98 cell('indent { right }', '@B "board"');
  99 foreach my $board (0..$#boards) { cell('',''); }
 100 cell('', '');
 101 endrow();
 102
 103 startrow();
 104 cell('', '@B pin');
 105 cell('', '@B { alternative uses }');
 106 foreach my $board (0..$#boards) {
 107     cell('', "$boards[$board]");
 108 }
 109 cell('', '@B pin');
 110 endrow();
 111
 112 our @outrows;
 113 foreach my $pin (0..$#pinboard2other) {
 114     my $netnames= $pinboard2other[$pin];
 115     next unless $netnames;
 116     my %netnames;
 117     $netnames{$_}=1 foreach grep { /\S/ && !m/^icsp_/ } values %$netnames;
 118     $netnames= join '/', sort keys %netnames;
 119     push @outrows, { Pin => $pin, Others => $netnames,
 120                  Priority =>
 121                      ($netnames !~ /\S/ ? -10 :
 122                       -($netnames =~ m/spare/g))
 123                  };
 124 }
 125
 126 foreach my $outrow (sort { $a->{Priority} <=> $b->{Priority}
 127                            || $a->{Others} cmp $b->{Others}
 128                            || $a->{Pin} <=> $b->{Pin}
 129                        } @outrows) {
 130     my $pin= $outrow->{Pin};
 131     my $netnames= $outrow->{Others};
 132     startrow();
 133     cell('indent { right }', $pin);
 134     my $desc= $pin2otherdesc[$pin];
 135     my $cell= "{Courier Base} \@Font \"$netnames\"";
 136     $cell .= "//1fx \"$desc\"" if $netnames =~ /\S/ && defined $desc;
 137     cell('margin { 0.1f }', "10p \@Font {$cell}");
 138     foreach my $board (0..$#boards) {
 139         my $bkind= $boards[$board];
 140         my $point= $boardpin2point{$bkind}[$pin];
 141         my $indivpin= $boardpin2indiv{$bkind}[$pin];
 142         my $rhs= defined($indivpin) ? "I.$indivpin" : '"*"';
 143         if (!defined $point) {
 144             cell('paint { lightgrey }', '');
 145         } else {
 146             cell('margin { 0.1f }', "10p \@Font { PT$point //1vx $rhs }");
 147         }
 148     }
 149     cell('indent { right }', $pin);
 150     endrow();
 151 }
 152 print "{\n",$body,"}\n";
 153
 154 my $revid= `../.git-revid`;
 155 chomp($revid) or die $?;
 156 $revid =~ s/[\"\\]/\\$&/g;
 157
 158 print <<END;
 159 //1vx
 160 10p \@Font "$revid"
 161 \@End \@Text
 162 END
 163
 164 STDOUT->error and die $!;
 165
 166 __DATA__
 167 40      (useable for point only)
 168 39      (useable for point only)
 169 36      (GPIO)
 170 24      (GPIO)
 171 38      (Interrupt on change)
 172 37      (Interrupt on change)
 173 35      External Interrupt 2
 174 34      External Interrupt 1
 175 33      External Interrupt 0
 176 30      ECCP1 PWM output D
 177 29      ECCP1 PWM output C
 178 28      ECCP1 PWM output B
 179 27      ECCP1 PWM output A
 180 26      RS232 RX
 181 25      RS232 TX
 182 22      Comparator 2 input
 183 2       Analogue in 0 / Comparator ref out
 184 3       Analogue in 1
 185 15      Timer 1 osc out / Timer 1,3 ext clock in
 186 16      Timer 1 osc in