From: ian <ian>
Date: Sun, 11 May 2008 21:20:08 +0000 (+0000)
Subject: detect duplicate pin use
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=commitdiff_plain;h=11708096d3fe2863041f3ed9d666bc9594819fb8;p=trains.git

detect duplicate pin use
---

diff --git a/layout/data2safety b/layout/data2safety
index c090387..fa336be 100755
--- a/layout/data2safety
+++ b/layout/data2safety
@@ -119,15 +119,16 @@ sub seg_wiring ($$$) {
 
 sub begin_points () { }
 sub line_points () {
-    my ($seg,$pt,@boobstr,$bodef);
+    my ($seg,$pt,@boobstr,$bodef,@boobs);
     m,^\s+(\w+)/([A-Za-z]+)\s+((\d+)\.\d+)\s+(\d*\.\d+)$, or
 	return syntaxerror();
     ($seg,$pt,$boobstr[0],$bodef,$boobstr[1])=($1,$2,$3,$4,$5);
     $boobstr[1] =~ s/^\./$bodef./;
+    @boobs= map { pa_boob('pt',$_) } @boobstr;
     seg_wiring($seg,$pt, {
 	Kind => Point,
 	Posns => 2,
-	BoObs => [ map { pa_boob('pt',$_) } @boobstr ],
+	BoObs => [ @boobs ],
     });
 }
 
@@ -516,6 +517,30 @@ sub redact_indir ($$) {
     }
 }
 
+sub record_phys_pin_used ($$) {
+    my ($r,$whatfor) = @_;
+    my ($board,$obj,$kind,$type,$pi);
+    our (%phys_pin_used);
+    $obj= $r->{Obj};
+    return if $obj==0 && $mistakes; # false positives, otherwise
+    $board= $r->{Board};
+    $kind= kind2genkind($r->{Kind});
+    $type= $boardtype[$board];
+    $whatfor .= " ($r->{Kind} $kind $obj)";
+    $pi= $pin_info{$type}{$kind}[$obj];
+    $pi =~ m/^([01234]),(\d),/ or die $!;
+    my ($port,$bit)=($1,$2);
+    if (exists $phys_pin_used{$board,$pi} &&
+	$phys_pin_used{$board,$pi} ne $whatfor) {
+	mistake("board $board physical pin ".
+		"R".(qw(A B C D E)[$port]).$bit.
+		" ($pi) used more than once:\n".
+		"  $phys_pin_used{$board,$pi};\n".
+		"  $whatfor");
+    }
+    $phys_pin_used{$board,$pi}= $whatfor;
+}
+
 sub redaction () {
     my ($num,$mappednum,$i,$objnum);
     $maxreverseobjnum= 0;
@@ -531,17 +556,19 @@ sub redaction () {
 	}
 	$mappednum++;
     }
-    my ($seg,$segr,$feat,$featr,$board,$indir,$boardtype);
+    my ($seg,$segr,$feat,$featr,$board,$indir,$boardtype,$why);
     foreach $seg (keys %segs) {
 	$segr= $segs{$seg};
 	foreach $feat (keys %{ $segr->{Feats} }) {
 	    $featr= $segr->{Feats}{$feat};
 	    map {
-		redact_indir($_,"segment $featr->{Kind} $seg/$feat");
+		$why= "segment $featr->{Kind} $seg/$feat";
+		redact_indir($_,$why);
+		record_phys_pin_used($_, $why);
 	    } @{ $featr->{BoObs} };
 	}
     }
-}    
+}
 
 sub nummap ($) {
     my ($p) = @_;
@@ -787,6 +814,7 @@ sub writeasm_ptwag ($$) {
     my $bitmapbitsperpic= 1<<$maxthingixln2;
     my $bitmapbytesperpic= 1<<($maxthingixln2-3);
     my ($num, $elemsize, $byte, $bit, $objnum);
+    
     o_section("picno2${ptwag}map",<<"END");
 ; Bitmap indexed first by pic no, and then by thing no. on that board,
 ; saying whether the thing is present or not.  Each pic has