#!/usr/bin/perl
-$max=13;
+die unless @ARGV==0 || @ARGV==1 && $ARGV[0] eq 'reversers.net-info';
sub o ($$$@) {
my ($netname, $type, $fmt, @stuff) = @_;
my ($stuff);
$stuff= sprintf $fmt, @stuff;
- print "# $netname $type $stuff\n" or die $!;
- if (exists $net{$netname}) {
+ print "# o $netname $type $stuff\n" or die $!;
+ if (length $type && exists $net{$netname}{Type}) {
die "$netname $type" if $net{$netname}{Type} ne $type;
}
- $net{$netname}{Type}= $type;
$net{$netname}{Stuff}.= " ".$stuff;
+ $net{$netname}{Type}= $type if length $type;
}
-@pinleft= (2..10, 14..17, 19,20);
-@pinright= (22, 24..30, 33..38);
-
-for $wh8 (0..1) {
- next if $wh8*8 > $max;
- o("vrly$wh8", Signal, "CULN%d-2 VRLY%d-1 ULN%d-10",
- $wh8, $wh8, $wh8);
- o("gnd", Signal, "ULN%d-9 CULN%d-1",
- $wh8, $wh8);
- o("vcc", Signal, "RA%d-1",
- $wh8);
+sub unpack_iter_list ($$@) {
+ my ($max,$options,@in) = @_;
+ # options: zero or more characters from
+ # r allow several occurrences of same pin number
+ # p allow only partial specification
+ # o return array of pins (first entry is undef) in order
+ # instead of array of { Pin =>, Action => }
+ my ($currentpin, @expanded, $base,$start,$end,$step,$i, @done,@out);
+ local ($_);
+ @expanded= ();
+ foreach $_ (@in) {
+ if (m/^(\w*[A-Za-z])(\d+)\.\.(\d+)$/) {
+ ($base,$start,$end)=($1,$2,$3);
+ $step= $start<$end ? 1 : $start>$end ? -1 : die;
+ for ($i=$start; $i!=$end+$step; $i+=$step) {
+ push @expanded, $base.$i;
+ }
+ } elsif (m/^(\w+)\*(\d+)/) {
+ ($base,$end)=($1,$2);
+ die unless $end >= 1;
+ for ($i=1; $i<=$end; $i++) {
+ push @expanded, $base;
+ }
+ } else {
+ push @expanded, $_;
+ }
+ }
+ $step= 1;
+ $currentpin= 1;
+ foreach $_ (@expanded) {
+ if (m/^\d+$/) {
+ die "$_ != $currentpin (@in) (@expanded)" if $currentpin ne $&;
+ } elsif (m/^\:(\d+)(?:([-+]\d+)|([-+])|)$/) {
+ $currentpin= $1;
+ $step= length $2 ? $2 : length $3 ? $3.'1' : 1;
+ } else {
+ die "$currentpin<1 $_ (@in) (@expanded)" if $currentpin < 1;
+ die "$currentpin>$max $_ (@in) (@expanded)" if $currentpin > $max;
+ die "already $done[$currentpin] $_ (@in) (@expanded)"
+ if ($options !~ m/r/) && defined $done[$currentpin];
+ push @out, { Pin => $currentpin, Action => $_ };
+ $done[$currentpin]= $_;
+ $currentpin += $step;
+ }
+ }
+ if ($options !~ m/p/) {
+ for ($i=1; $i<$max; $i++) {
+ die "$i missing (@in) (@expanded)" unless defined $done[$i];
+ }
+ }
+ print "# uil $max $options (@in) => (@done)\n";
+ return ($options =~ m/o/) ? @done : @out;
+}
+
+sub definepicpins (@) {
+ my (@l) = unpack_iter_list(40,'o',@_);
+ my ($i);
+ local ($_);
+ for ($i=1; $i<@l; $i++) {
+ $_= $l[$i];
+ if (m/^[A-Z]/) {
+ die "$_ repeated" if exists $picport2pin{$_};
+ $picpin2port{$i}= $_;
+ $pinport2pin{$_}= $i;
+ } else {
+ $picpin2port{$i}= $_;
+ o($_,'',"PIC-$i");
+ }
+ }
}
-
-for $iter (0..13) {
- next if $iter > $max;
- $wh8= $iter >> 3;
- $in8= $iter % 8;
- $wh4= $iter >> 2;
- $in4= $iter % 4;
- $in4r= $iter<8 ? $in4 : 3-$in4;
- $in8r= $iter<8 ? $in8 : 7-$in8;
- @rlycoil= (1,16);
- if ($iter >= 4) { @rlycoil= reverse @rlycoil; }
- o("picout$iter", Signal, "PIC-%d ULN%d-%d",
- $iter < 8 ? $pinleft[$iter] : $pinright[21-$iter],
- $wh8, 8-$in8r);
- o("rlydrv$iter", Signal, "ULN%d-%d RLY%d-%d",
- $wh8, 11+$in8r,
- $iter,
- $rlycoil[0]);
- o("vrly$wh8", Signal, "RLY%d-%d", $iter,
- $rlycoil[1]);
- o("boosta", Fat, "RLY%d-4", $iter);
- o("boostb", Fat, "RLY%d-13", $iter);
- o("trackc$iter", Fat, "RLY%d-6 RLY%d-9 XC%d-1", $iter, $iter, $iter);
- o("shortbr$iter", Fat, "BR%d-1 BR%d-3", $iter, $iter);
- o("befsenx$iter", Fat, "RLY%d-8 RLY%d-11 BR%d-4 OC%d-%d",
- $iter, $iter, $iter, $wh4,$in4r*2+2);
- o("trackx$iter", Fat, "BR%d-2 XX%d-1 RS%d-2",
- $iter, $iter, $iter);
- o("afsenrx$iter", Signal, "RS%d-1 OC%d-%d",
- $iter, $wh4, 1+($in4r*2));
- o("gnd", Signal, "OC%d-%d", $wh4, 15-($in4r*2));
- o("seni$iter", Signal, "OC%d-%d PIC-%d RA%d-%d",
- $wh4, 16-($in4r*2),
- $iter < 7 ? $pinleft[$iter+8] :
- $iter == 7 ? $pinright[0] :
- $pinright[14-$iter],
- $wh8, $in8+2);
+
+definepicpins(qw(1 mclr
+ 2 RA0..5 RE0..2
+ 11 l_vcc l_gnd clock
+ 14 RA6 RC0..3 RD0 RD1
+ 21 RD2 RD3 RC4..7 RD4..7
+ 31 l_gnd l_vcc
+ 33 RB0..7));
+
+sub assignpicpins (@) {
+ my (@l) = unpack_iter_list(40,'o',@_);
+ my ($i, $port);
+ for ($i=1; $i<@l; $i++) {
+ $_= $l[$i];
+ $port= exists $picpin2port{$i} ? $picpin2port{$i} : '';
+ if ($port =~ m/^[a-z]/) {
+ die "$i $_ $port" unless $port eq $_;
+ } else {
+ o($_,'',"PIC-$i");
+ }
+ }
}
-for $pin (7..8) { o("gnd", Signal, "ULN1-%d", $pin); }
-for $pin (1..4, 13..16) { o("gnd", Signal, "OC3-%d", $pin); }
+assignpicpins(qw(1 mclr
+ spare0
+ reverse0..2
+ sense5
+ reverse3..5
+ sense4
+ l_vcc l_gnd clock
+ sense3
+ pt17,booster_dirn
+ pt16,booster_pwm
+ sense2
+ i2c_clock
+ 19 sense1..0
+ :40-
+ pt1,icsp_pc
+ pt0,icsp_pd
+ pt6,cdu_enable
+ pt7,rs232_fcin
+ pt2
+ pt8,booster_retry,
+ pt9,booster_cutout
+ pt10,booster_flag
+ l_vcc
+ l_gnd
+ pt3
+ pt11,spare2
+ pt12,spare1
+ pt4
+ pt13,rs232_rxin
+ pt14,rs232_txout
+ pt15,rs232_fcout
+ i2c_data
+ pt5
+ 21 perpicled));
-foreach $pfet (0..1) {
- $pf= "PFET$pfet";
- o("pfetg$pfet",Signal,"R$pf-2 $pf-1");
- o("pfetd$pfet",Power,"$pf-2 D$pf-2 PT$pfet-1");
- o("cdu",Power,"D$pf-1");
- o("ptgnd",Power,"$pf-3");
+sub assignpins (@) {
+ my ($name,$pins,@il) = @_;
+ my ($e);
+ foreach $e (unpack_iter_list($pins,'p',@il)) {
+ o($e->{Action},'',$name.'-'.$e->{Pin});
+ }
}
-o("cdu",Power,"CDU-1");
-o("ptgnd",Power,"PTGND-1");
-o("gnd", Signal, "GND-1 PIC-12 PIC-31 CPIC0-2 CPIC1-2");
-o("vcc", Signal, "VCC-1 PIC-11 PIC-32 CPIC0-1 CPIC1-1");
-o("boosta", Fat, "BOOSTA-1");
-o("boostb", Fat, "BOOSTB-1");
+assignpins(qw(BUS 32
+ icsp_pdw
+ l_gnd icsp_pdrany
+ l_gnd icsp_pdrall
+ l_gnd clock
+ l_gnd l_vcc mclr
+ l_gnd i2c_clk led_reflow i2c_data led_refhigh
+ rly_gnd rly_v12
+ cdu_gnd cdu_out
+ )); # 32-way ribbon
+
+@indiv= qw(icsp_pc l_gnd led_red led_green);
+
+push @indiv, qw(cdu_enable
+ booster_retry
+ booster_cutout
+ booster_flag
+ booster_dirn
+ booster_pwm
+ spare0
+ spare1
+ spare2
+ rs232_rxin
+ rs232_txout
+ rs232_fcin
+ rs232_fcout
+ );
+
+assignpins('INDIV0',26,@indiv); # 26-way ribbon
+assignpins('INDIV1',25,@indiv); # 25-way D
+
+o('l_gnd', Power, 'CPIC0-1 CPIC1-1');
+o('l_vcc', Power, 'CPIC0-2 CPIC1-2');
+
+assignpins(qw(ULN 18
+ :11 rlydrv..0
+ :8- pt5..0 rly_gnd rly_gnd
+ :9 rly_gnd
+ :10 rly_v12));
+
+assignpins(qw(CULN 2 rly_gnd rly_v12));
+
+sub assignpins_multi ($$@) {
+ my ($line_min, $line_max, $perchip, @il) = @_;
+ my ($chipno, $line_low, $line_high, $linesthischip, @ol);
+ print "# m $line_min $line_max $perchip (@il)\n";
+ for ($chipno=0;
+ ($line_low = $perchip*$chipno) <= $line_max;
+ $chipno++) {
+ $line_high= $line_low + $perchip-1;
+ $line_high= $line_max if $line_high > $line_max;
+ $linesthischip= $line_high - $line_low + 1;
+ @ol= @il;
+ map {
+ s/\@/ $chipno /ge;
+ s/\</ $line_low /ge;
+ s/\>/ $line_high /ge;
+ s/\&/ $linesthischip /ge;
+ $_;
+ } @ol;
+ print "# m$chipno (@ol)\n";
+ assignpins(@ol);
+ }
+}
+
+assignpins_multi(0,5, 4,
+ qw(OC@ 16
+ :1+2 sensei<..>
+ :2+2 q*&
+ :15-2 l_gnd*&
+ :16-2 sense<..>));
+assignpins(qw(RAS 9
+ l_vcc
+ :2 sense0..5));
+
+assignpins_multi(0,5, 1,
+ qw(BR@ 4
+ :1+2 sshort@*2
+ :2 q@
+ :4 q));
+
+assignpins_multi(0,5, 1,
+ qw(RLY@ 16
+ :1 rly_v12
+ :4 q@
+ :6 qmid@
+ :8 t
+ :9 qmid@
+ :11 t
+ :13 t@
+ :16 rlydrv@));
+
+foreach $iter (0..5) {
+ o("t$iter", Fat, '');
+ o("q$iter", Fat, '');
+ o("qmid$iter", Fat, '');
+}
while (<DATA>) {
next if m/^\#/;
chomp;
s/^\s+//;
s/\s+$//;
- m/^(\S+)\s+(\S+)\s+(\S.*\S)$/ or die $1;
+ m/^(\S+)\s+(\S+)(\s+(\S.*\S))?$/ or die $1;
o($1,$2,"%s",$3);
}
-foreach $netname (sort keys %net) {
+# Firstly, assemble
+# $othernames{$sn}{$sn2}=1 iff $sn and $sn2 are mentioned together
+# by iterating over all composite names, and then for each sn
+# in the composite name, to find (at least once) every sn ever
+# mentioned ...
+foreach $compname (keys %net) {
+ foreach $sn (split /\,/, $compname) { # at least once for any $sn
+ next if exists $othernames{$sn}; # already done ?
+ $othernames{$sn}= { };
+ # now look for all names mentioned together with $sn
+ foreach $compname2 (keys %net) {
+ # search all composite names ...
+ @sns2= split /\,/, $compname2; # ... whose mentions ...
+ next unless grep { $_ eq $sn } @sns2; # ... include $sn ...
+ map { $othernames{$sn}{$_}=1; } @sns2; # ... recording mentions.
+ }
+ }
+}
+
+# Process each net exactly once. We go through the singlenames
+# and process each singlename if it's the lexically least singlename
+# for that net.
+foreach $sn (keys %othernames) {
+ @sns= sort { $a cmp $b } keys %{ $othernames{$sn} }; # singlenames in order
+ next unless $sns[0] eq $sn; # is this the lexcially least ?
+ $canon= join '__', @sns;
+ undef $type;
+ foreach $compname (keys %net) {
+ # Find all subnets. A subnet of $canon is a net whose composite name
+ @sns2= keys %{ $othernames{
+ print "# snq $sn $canon $compname (@sns2)\n";
+ next unless grep { $_ eq $sn } @sns2;
+ print "# sna $sn $canon $compname ($net{$compname}{Stuff})\n";
+ if (!exists $net{$compname}{Type}) {
+ } elsif (!defined $type) {
+ $type= $net{$compname}{Type};
+ } elsif ($type ne $net{$compname}{Type}) {
+ die "$compname $canon $type $net{$ccompname}{Type}";
+ }
+ $propernet{$canon}{Stuff} .= $net{$compname}{Stuff};
+ }
+ print "# snr $sn $canon $type (@sns) ($net{$compname}{Stuff})\n";
+ $type= 'Signal' if !defined $type;
+ $propernet{$canon}{Type}= $type;
+}
+
+foreach $canon (sort keys %propernet) {
printf("%s\t%s\t%s\n",
- $netname,
- $net{$netname}{Type},
- $net{$netname}{Stuff})
+ $canon,
+ $propernet{$canon}{Type},
+ $propernet{$canon}{Stuff})
or die $!;
}
__DATA__
-
-picpc Signal PIC-39 RPCQI-2 RPCQG-1 RPFET1-1
-gnd Signal RPCQG-2
-picpcq Signal RPCQI-1 PCQ-1
-picpd Signal PIC-40 DS0-1 DS1-2
-picpdw Signal DS0-2 PDW-1
-picpdr Signal DS1-1 PDR-1
-i2cc Signal PIC-18 I2CC-1
-i2cd Signal PIC-23 I2CD-1
-ledo Signal PIC-30 LEDO-1
-cduena Signal PIC-21 CDUENA-1
-mclr Signal PIC-1 MCLR-1
-picclk Signal PIC-13 CLK-1
-rlydrv4 Signal LINK0A-1 LINK0B-1
+l_gnd Power
+l_vcc Power
+rly_gnd Power
+rly_v12 Power
~ijackson / trains.git / commitdiff