chiark / gitweb /
works so far as it goes; must make pci_...
authorian <ian>
Sat, 26 Mar 2005 18:08:19 +0000 (18:08 +0000)
committerian <ian>
Sat, 26 Mar 2005 18:08:19 +0000 (18:08 +0000)
layout/data2safety
layout/ours.wiring

index 61cb0489ea29e3ca8148b600f2f41479875e8a2c..335a065303685730de3572bb5f28fb5a856fd247 100755 (executable)
@@ -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");
index c3b35b74e075e75c4a0a89e4bab2d5e6098d4528..b1a5123cc054c181a78ce531e50ada6bf3494511 100644 (file)
@@ -31,5 +31,6 @@ fixed
 #      point
        A6/J0
        A5/J0
+       A2/P0
 
 endwiring