From: ian <ian>
Date: Sat, 26 Mar 2005 18:08:19 +0000 (+0000)
Subject: works so far as it goes; must make pci_...
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=commitdiff_plain;h=d4ea5828f9fb28d16d6c01aedf41ab94d0dac9a9;p=trains.git

works so far as it goes; must make pci_...
---

diff --git a/layout/data2safety b/layout/data2safety
index 61cb048..335a065 100755
--- a/layout/data2safety
+++ b/layout/data2safety
@@ -2,6 +2,8 @@
 
 use strict qw(vars);
 
+our ($currentline);
+
 our (%segs);
 # $segs{$seg}{Inv}
 # $segs{$seg}{BoOb}
@@ -13,6 +15,8 @@ our (%segs);
 # $segs{$seg}{Feats}{$pt}{BoOb}       ) for Point only
 # $segs{$seg}{Feats}{$pt}{Fixed}      position, for Fixed only
 # $segs{$seg}{Ends}[$combpos][$end] = [ $node,$side ]
+
+our (%nodes);
 # $nodes{$node}[$side]{Seg}
 
 our ($mode,$invertible);
@@ -74,8 +78,15 @@ sub begin_endwiring () {
 #	for ($comb=0; $comb < $segv->{Posns}; $comb++) {
 #	}
 
+sub mistake ($) {
+    my ($m) = @_;
+    die "mistake: $m\n in \`$currentline'\n";
+}
+
 sub line_endwiring () {
     my (@ns,$seg,$subspec,$dist);
+    my ($segr,@subsegil,$feat,$pos,$featr,$combpos,%featposwant);
+    my ($end,$node,$side,$nsr,$endposr);
     m,^\s*segment\s+(\w+\.\d+)\s+(\w+\.\d+)\s+(\w+)(?:/((?:[A-Za-z]+\d+)+)\*\d+)?\s+([0-9.]+)$, or die "$_ ?";
     ($ns[0],$ns[1],$seg,$subspec,$dist)=($1,$2,$3,$4,$5);
     if (!exists $segs{$seg}) {
@@ -83,13 +94,17 @@ sub line_endwiring () {
 	return;
     }
     $segr= $segs{$seg};
-    @subsegil= $subspec =~ m/([A-Za-z]+)(\d+)/g;
+    @subsegil= defined $subspec ? $subspec =~ m/([A-Za-z]+)(\d+)/g : ();
     while (@subsegil) {
 	($feat,$pos,@subsegil) = @subsegil;
-	die "$feat ?" unless exists $segr->{Feats}{$feat};
+	mistake("no wiring for $seg/$feat")
+	    unless exists $segr->{Feats}{$feat};
 	$featr= $segr->{Feats}{$feat};
 	if (exists $featr->{Fixed}) {
-	    die "$pos $featr->{Fixed} ?" unless $pos == $featr->{Fixed};
+	    if ($pos != $featr->{Fixed}) {
+		print STDERR "ditching fixed-elsewise $seg$subspec\n";
+		return;
+	    }
 	} else {
 	    die "$pos $featr->{Posns} ?" unless $pos < $featr->{Posns};
 	    $featposwant{$feat}= $pos;
@@ -98,12 +113,12 @@ sub line_endwiring () {
     $combpos= 0;
     for $feat (keys %{ $segr->{Feats} }) {
 	$featr= $segr->{Feats}{$feat};
-	next if exists $featr->{Fixed}
+	next if exists $featr->{Fixed};
 	die "$feat ?" if !exists $featposwant{$feat};
 	$combpos += $featposwant{$feat} * $featr->{Weight};
     }
     for ($end=0; $end<2; $end++) {
-	$ns[$end] =~ m/^([a-z]\w+)\.([01])$;
+	$ns[$end] =~ m/^([a-z]\w+)\.([01])$/;
 	($node,$side)=($1,$2);
 	$nsr= $nodes{$node}[$side];
 	if (!exists $nsr->{Seg}) {
@@ -111,8 +126,9 @@ sub line_endwiring () {
 	} elsif ($seg ne $nsr->{Seg}) {
 	    die "$seg $nsr->{Seg} ?";
 	}
-	die "$seg $combpos ?" if @{ $segr->{Ends}[$combpos] };
-	$segr->{Ends}[$combpos][$end]= [ $node, $side ];
+	$endposr= $segr->{Ends}[$combpos];
+	die "$seg $combpos ?" if defined $endposr && @$endposr;
+	$endposr->[$end]= [ $node, $side ];
     }
 }
 
@@ -124,8 +140,8 @@ sub so_oboob ($) {
     my ($obj) = @_;
     my ($boob);
     $boob= $obj->{BoOb};
-    $boob =~ m/^([1-9]\d)*\.([1-9]\d*)$/ or die "$boob ?";
-    return sprintf "%d,%d",$1,$2;
+    $boob =~ m/^([1-9]\d*|0)\.([1-9]\d*|0)$/ or die "$boob ?";
+    return sprintf "%d,%2d",$1,$2;
 }
 
 sub mainread () {
@@ -141,26 +157,34 @@ sub mainread () {
 	    $mode= 'segment' if $mode =~ m/^(?:vanilla|invertible)$/;
 	    &{"begin_$mode"};
 	} else {
+	    $currentline= $_;
 	    &{"line_$mode"};
 	}
     }
 }
 
+sub nummap ($) {
+    my ($p) = @_;
+    $p =~ s/\d{1,6}/ sprintf "%06d%d",$&,$& /ge;
+    return $p;
+}
+
 sub writeout () {
-    my ($seg,$segv,$pt,$ptv, $delim);
-    o("/* autogenerated - do not edit */\n\n");
-    @segs;
-    for $seg (keys %segs) {
+    my (@segs,$segn,$seg,$segr,$pt,$ptv, $delim);
+    o("/* autogenerated - do not edit */\n\n".
+      "#include \"safety.h\"\n\n");
+    @segs=();
+    for $seg (sort { nummap($a) cmp nummap($b) } keys %segs) {
 	$segs{$seg}{Num}= @segs;
 	push @segs, $seg;
     }
-    for ($segn=0; $segn<@segs; $segn++) {
-	$segv= $segs{$seg};
-	next unless $segv->{FeatCount};
+    foreach $seg (@segs) {
+	$segr= $segs{$seg};
+	next unless $segr->{FeatCount};
 	o("static const MovFeatInfo mfi_${seg}[]= {");
 	$delim='';
-	for $pt (keys %{ $segv->{Feats} }) {
-	    $ptv= $segv->{Feats}{$pt};
+	for $pt (keys %{ $segr->{Feats} }) {
+	    $ptv= $segr->{Feats}{$pt};
 	    next if exists $ptv->{Fixed};
 	    o("$delim\n");
 	    o("  { \"$seg/$pt\", $ptv->{Posns}, $ptv->{Weight} }");
@@ -173,10 +197,11 @@ sub writeout () {
     foreach $seg (@segs) {
 	$segr= $segs{$seg};
 	o("$delim\n");
-	o("  { \"$seg\", $segr->{Inv},\n".
-	  "    $segr->{FeatCount}, ".
-	  ($segr->{FeatCount} ? "mfi_${seg}" : 0).",".
-	  " $segr->{Posns}, POSCOMBS, ".so_oboob($segr->{BoOb})." }");
+	o(sprintf "  { %-7s %d, %2d,%-9s %3d,%-9s %-6s }",
+	  "\"$seg\",", $segr->{Inv},
+	  $segr->{FeatCount}, ($segr->{FeatCount} ? "mfi_$seg," : '0,'),
+	  $segr->{Posns}, ($segr->{FeatCount} ? "pci_$seg," : '0,'),
+	  so_oboob($segr));
 	$delim= ',';
     }
     o("\n};\n");
diff --git a/layout/ours.wiring b/layout/ours.wiring
index c3b35b7..b1a5123 100644
--- a/layout/ours.wiring
+++ b/layout/ours.wiring
@@ -31,5 +31,6 @@ fixed
 #	point
 	A6/J0
 	A5/J0
+	A2/P0
 
 endwiring