segposcombinfo wip

diff --git a/layout/data2safety b/layout/data2safety
index 335a065303685730de3572bb5f28fb5a856fd247..d5db4d080d7ddb7b0bc00a734b829f33b6e21d22 100755 (executable)
--- a/layout/data2safety
+++ b/layout/data2safety
@@ -2,7 +2,7 @@
 
 use strict qw(vars);
 
-our ($currentline);
+our ($mistakes, $currentline);
 
 our (%segs);
 # $segs{$seg}{Inv}
@@ -14,7 +14,10 @@ our (%segs);
 # $segs{$seg}{Feats}{$pt}{Posns}      ) for Point only
 # $segs{$seg}{Feats}{$pt}{BoOb}       ) for Point only
 # $segs{$seg}{Feats}{$pt}{Fixed}      position, for Fixed only
+
+# $segs{$seg}{Num}
 # $segs{$seg}{Ends}[$combpos][$end] = [ $node,$side ]
+# $segs{$seg}{Dist}[$combpos]
 
 our (%nodes);
 # $nodes{$node}[$side]{Seg}
@@ -22,21 +25,38 @@ our (%nodes);
 our ($mode,$invertible);
 $mode= 'barf';
 
-sub line_barf () { die; }
+sub line_barf () {
+    return if $mistakes;
+    mistake("first input line does not determine phase");
+}
+
+sub syntaxerror () {
+    our (%syntaxerror_once);
+    return if exists $syntaxerror_once{$mode};
+    $syntaxerror_once{$mode}= 1;
+    mistake("syntax error");
+    return undef;
+}
+
+sub ditch ($) {
+    my ($m) = @_;
+    print STDERR "ditching $m\n";
+}
 
 sub begin_points () { }
 sub line_points () {
     my ($seg,$pt,@boob,$bodef);
-    m,^\s+(\w+)/([A-Za-z]+)\s+((\d+)\.\d+)\s+(\d*\.\d+)$, or die "$_ ?";
+    m,^\s+(\w+)/([A-Za-z]+)\s+((\d+)\.\d+)\s+(\d*\.\d+)$, or
+       return syntaxerror();
     ($seg,$pt,$boob[0],$bodef,$boob[1])=($1,$2,$3,$4,$5);
     $boob[1] =~ s/^\./$bodef./;
-    die "$_ ?" unless exists $segs{$seg};
-    die "$_ ?" if exists $segs{$seg}{Feats}{$pt};
+    mistake("unknown wiring for $seg in $seg/$pt") unless exists $segs{$seg};
+    mistake("duplicate wiring for $seg/$pt") if exists $segs{$seg}{Feats}{$pt};
     $segs{$seg}{Feats}{$pt}= {
        Kind => Point,
        Weight => $segs{$seg}{Posns},
        Posns => 2,
-       BoOb => [ @boob ]
+       BoOb => [ map { pa_boob($_) } @boob ]
        };
     $segs{$seg}{Posns} *= 2;
     $segs{$seg}{FeatCount}++;
@@ -45,10 +65,10 @@ sub line_points () {
 sub begin_fixed () { }
 sub line_fixed () {
     my ($seg,$pt,$pos);
-    m,^\s+(\w+)/([A-Za-z]+)(\d+)$, or die "$_ ?";
+    m,^\s+(\w+)/([A-Za-z]+)(\d+)$, or return syntaxerror();
     ($seg,$pt,$pos)=($1,$2,$3);
-    die "$_ ?" unless exists $segs{$seg};
-    die "$_ ?" if exists $segs{$seg}{Feats}{$pt};
+    mistake("unknown wiring for $seg in $seg/$pt") unless exists $segs{$seg};
+    mistake("duplicate fixed $seg/$pt") if exists $segs{$seg}{Feats}{$pt};
     $segs{$seg}{Feats}{$pt}= {
        Kind => Fixed,
        Fixed => $pos
@@ -58,11 +78,11 @@ sub line_fixed () {
 sub begin_segment () { }
 sub line_segment () {
     my ($seg,$boob);
-    m/^\s+(\w+)\s+(\d+\.\d+)$/ or die "$_ ?";
+    m/^\s+(\w+)\s+(\d+\.\d+)$/ or return syntaxerror();
     ($seg,$boob)=($1,$2);
-    die "$_ ?" if exists $segs{$seg};
+    mistake("duplicate topology for $seg") if exists $segs{$seg};
     $segs{$seg}= {
-       BoOb => $boob,
+       BoOb => pa_boob($boob),
        Inv => $invertible,
        Posns => 1,
        Feats => { },
@@ -73,40 +93,39 @@ sub line_segment () {
 sub begin_endwiring () {
 }
 
-#      o("static const SegPosCombInfo spci_${seg}[]= {");
-#      $delim='';
-#      for ($comb=0; $comb < $segv->{Posns}; $comb++) {
-#      }
-
 sub mistake ($) {
     my ($m) = @_;
-    die "mistake: $m\n in \`$currentline'\n";
+    print STDERR "mistake: $m\n in $mode, \`$currentline'\n";
+    $mistakes++;
 }
 
 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 "$_ ?";
+    m,^\s*segment\s+(\w+\.\d+)\s+(\w+\.\d+)\s+(\w+)(?:/((?:[A-Za-z]+\d+)+)\*\d+)?\s+([0-9.]+)$, or return syntaxerror();
     ($ns[0],$ns[1],$seg,$subspec,$dist)=($1,$2,$3,$4,$5);
     if (!exists $segs{$seg}) {
-       print STDERR "ditching unwired $seg$subspec\n";
+       ditch("unwired $seg$subspec");
        return;
     }
     $segr= $segs{$seg};
     @subsegil= defined $subspec ? $subspec =~ m/([A-Za-z]+)(\d+)/g : ();
     while (@subsegil) {
        ($feat,$pos,@subsegil) = @subsegil;
-       mistake("no wiring for $seg/$feat")
-           unless exists $segr->{Feats}{$feat};
+       if (!exists $segr->{Feats}{$feat}) {
+           mistake("no wiring for $seg/$feat");
+           next;
+       }
        $featr= $segr->{Feats}{$feat};
        if (exists $featr->{Fixed}) {
            if ($pos != $featr->{Fixed}) {
-               print STDERR "ditching fixed-elsewise $seg$subspec\n";
+               ditch("fixed-elsewise $seg$subspec");
                return;
            }
        } else {
-           die "$pos $featr->{Posns} ?" unless $pos < $featr->{Posns};
+           mistake("position $seg/$feat$pos exceeds wiring")
+               unless $pos < $featr->{Posns};
            $featposwant{$feat}= $pos;
        }
     }
@@ -114,9 +133,13 @@ sub line_endwiring () {
     for $feat (keys %{ $segr->{Feats} }) {
        $featr= $segr->{Feats}{$feat};
        next if exists $featr->{Fixed};
-       die "$feat ?" if !exists $featposwant{$feat};
+       mistake("wiring $seg/$feat not covered by $seg/$subspec")
+           if !exists $featposwant{$feat};
        $combpos += $featposwant{$feat} * $featr->{Weight};
     }
+    mistake("duplicate topology for $seg/$subspec")
+       if defined $segs{$seg}{Dist}[$combpos];
+    $segs{$seg}{Dist}[$combpos]= $dist;
     for ($end=0; $end<2; $end++) {
        $ns[$end] =~ m/^([a-z]\w+)\.([01])$/;
        ($node,$side)=($1,$2);
@@ -124,7 +147,7 @@ sub line_endwiring () {
        if (!exists $nsr->{Seg}) {
            $nsr->{Seg}= $seg;
        } elsif ($seg ne $nsr->{Seg}) {
-           die "$seg $nsr->{Seg} ?";
+           mistake("topology for $node.$side both $seg and $nsr->{Seg}");
        }
        $endposr= $segr->{Ends}[$combpos];
        die "$seg $combpos ?" if defined $endposr && @$endposr;
@@ -136,15 +159,22 @@ sub o ($) {
     print STDOUT $_[0] or die $!;
 }
 
+sub pa_boob ($) {
+    my ($boob) = @_;
+    if ($boob !~ m/^([1-9]\d*|0)\.([1-9]\d*|0)$/) {
+       mistake("invalid board object $boob");
+       return [ 0,0 ];
+    }
+    return sprintf "%d,%2d", $1,$2;
+}
+
 sub so_oboob ($) {
     my ($obj) = @_;
-    my ($boob);
-    $boob= $obj->{BoOb};
-    $boob =~ m/^([1-9]\d*|0)\.([1-9]\d*|0)$/ or die "$boob ?";
-    return sprintf "%d,%2d",$1,$2;
+    return $obj->{BoOb};
 }
 
 sub mainread () {
+    $mistakes= 0;
     while (<>) {
        next if m/^\#/;
        chomp;
@@ -171,6 +201,7 @@ sub nummap ($) {
 
 sub writeout () {
     my (@segs,$segn,$seg,$segr,$pt,$ptv, $delim);
+    my ($comb,$pi,$feat,$featr,$end);
     o("/* autogenerated - do not edit */\n\n".
       "#include \"safety.h\"\n\n");
     @segs=();
@@ -191,16 +222,46 @@ sub writeout () {
            $delim=',';
        }
        o("\n};\n");
+       o("static const SegPosCombInfo spci_${seg}[]= {");
+       $delim='';
+       for ($comb=0; $comb < $segr->{Posns}; $comb++) {
+           $pi='';
+           foreach $feat (keys %{ $segr->{Feats} }) {
+               $featr= $segr->{Feats}{$feat};
+               next if exists $featr->{Fixed};
+               $pi.= sprintf("%s%d", $feat,
+                             ($comb / $featr->{Weight}) % $featr->{Posns});
+           }
+           o("$delim\n");
+           o(sprintf "  %s {",
+             "/*$pi*/");
+           for ($end=0; $end<2; $end++) {
+               $other= $segs{$seg}{Ends}[$combpos][$end];
+               o(" { ");
+               if (defined $other) {
+                   ($node,$side) = @$other;
+                   
+                   o(sprintf "/*%5s.%d %-6s*/ %d,%3d",
+                     "/* $other*/", $
+               } else {
+                 
+                 );
+o(" },");
+           }
+           o(sprintf " }");
+           $delim= ',';
+       }
+       o("\n};\n");
     }
     o("static const SegmentInfo info_segments[".scalar(@segs)."]= {");
     $delim= '';
     foreach $seg (@segs) {
        $segr= $segs{$seg};
        o("$delim\n");
-       o(sprintf "  { %-7s %d, %2d,%-9s %3d,%-9s %-6s }",
+       o(sprintf "  { %-7s %d, %2d,%-9s %3d,%-10s %-6s }",
          "\"$seg\",", $segr->{Inv},
          $segr->{FeatCount}, ($segr->{FeatCount} ? "mfi_$seg," : '0,'),
-         $segr->{Posns}, ($segr->{FeatCount} ? "pci_$seg," : '0,'),
+         $segr->{Posns}, ($segr->{FeatCount} ? "spci_$seg," : '0,'),
          so_oboob($segr));
        $delim= ',';
     }