layout/data2safety

   1 #!/usr/bin/perl -w
   2
   3 use strict qw(vars);
   4
   5 our ($currentline);
   6
   7 our (%segs);
   8 # $segs{$seg}{Inv}
   9 # $segs{$seg}{BoOb}
  10 # $segs{$seg}{Posns}
  11 # $segs{$seg}{FeatCount}              does not include Fixed
  12 # $segs{$seg}{Feats}{$pt}{Kind}       Point or Fixed
  13 # $segs{$seg}{Feats}{$pt}{Weight}     ) for Point only
  14 # $segs{$seg}{Feats}{$pt}{Posns}      ) for Point only
  15 # $segs{$seg}{Feats}{$pt}{BoOb}       ) for Point only
  16 # $segs{$seg}{Feats}{$pt}{Fixed}      position, for Fixed only
  17 # $segs{$seg}{Ends}[$combpos][$end] = [ $node,$side ]
  18
  19 our (%nodes);
  20 # $nodes{$node}[$side]{Seg}
  21
  22 our ($mode,$invertible);
  23 $mode= 'barf';
  24
  25 sub line_barf () { die; }
  26
  27 sub begin_points () { }
  28 sub line_points () {
  29     my ($seg,$pt,@boob,$bodef);
  30     m,^\s+(\w+)/([A-Za-z]+)\s+((\d+)\.\d+)\s+(\d*\.\d+)$, or die "$_ ?";
  31     ($seg,$pt,$boob[0],$bodef,$boob[1])=($1,$2,$3,$4,$5);
  32     $boob[1] =~ s/^\./$bodef./;
  33     die "$_ ?" unless exists $segs{$seg};
  34     die "$_ ?" if exists $segs{$seg}{Feats}{$pt};
  35     $segs{$seg}{Feats}{$pt}= {
  36         Kind => Point,
  37         Weight => $segs{$seg}{Posns},
  38         Posns => 2,
  39         BoOb => [ @boob ]
  40         };
  41     $segs{$seg}{Posns} *= 2;
  42     $segs{$seg}{FeatCount}++;
  43 }
  44
  45 sub begin_fixed () { }
  46 sub line_fixed () {
  47     my ($seg,$pt,$pos);
  48     m,^\s+(\w+)/([A-Za-z]+)(\d+)$, or die "$_ ?";
  49     ($seg,$pt,$pos)=($1,$2,$3);
  50     die "$_ ?" unless exists $segs{$seg};
  51     die "$_ ?" if exists $segs{$seg}{Feats}{$pt};
  52     $segs{$seg}{Feats}{$pt}= {
  53         Kind => Fixed,
  54         Fixed => $pos
  55         };
  56 }
  57
  58 sub begin_segment () { }
  59 sub line_segment () {
  60     my ($seg,$boob);
  61     m/^\s+(\w+)\s+(\d+\.\d+)$/ or die "$_ ?";
  62     ($seg,$boob)=($1,$2);
  63     die "$_ ?" if exists $segs{$seg};
  64     $segs{$seg}= {
  65         BoOb => $boob,
  66         Inv => $invertible,
  67         Posns => 1,
  68         Feats => { },
  69         FeatCount => 0
  70     };
  71 }
  72
  73 sub begin_endwiring () {
  74 }
  75
  76 #       o("static const SegPosCombInfo spci_${seg}[]= {");
  77 #       $delim='';
  78 #       for ($comb=0; $comb < $segv->{Posns}; $comb++) {
  79 #       }
  80
  81 sub mistake ($) {
  82     my ($m) = @_;
  83     die "mistake: $m\n in \`$currentline'\n";
  84 }
  85
  86 sub line_endwiring () {
  87     my (@ns,$seg,$subspec,$dist);
  88     my ($segr,@subsegil,$feat,$pos,$featr,$combpos,%featposwant);
  89     my ($end,$node,$side,$nsr,$endposr);
  90     m,^\s*segment\s+(\w+\.\d+)\s+(\w+\.\d+)\s+(\w+)(?:/((?:[A-Za-z]+\d+)+)\*\d+)?\s+([0-9.]+)$, or die "$_ ?";
  91     ($ns[0],$ns[1],$seg,$subspec,$dist)=($1,$2,$3,$4,$5);
  92     if (!exists $segs{$seg}) {
  93         print STDERR "ditching unwired $seg$subspec\n";
  94         return;
  95     }
  96     $segr= $segs{$seg};
  97     @subsegil= defined $subspec ? $subspec =~ m/([A-Za-z]+)(\d+)/g : ();
  98     while (@subsegil) {
  99         ($feat,$pos,@subsegil) = @subsegil;
 100         mistake("no wiring for $seg/$feat")
 101             unless exists $segr->{Feats}{$feat};
 102         $featr= $segr->{Feats}{$feat};
 103         if (exists $featr->{Fixed}) {
 104             if ($pos != $featr->{Fixed}) {
 105                 print STDERR "ditching fixed-elsewise $seg$subspec\n";
 106                 return;
 107             }
 108         } else {
 109             die "$pos $featr->{Posns} ?" unless $pos < $featr->{Posns};
 110             $featposwant{$feat}= $pos;
 111         }
 112     }
 113     $combpos= 0;
 114     for $feat (keys %{ $segr->{Feats} }) {
 115         $featr= $segr->{Feats}{$feat};
 116         next if exists $featr->{Fixed};
 117         die "$feat ?" if !exists $featposwant{$feat};
 118         $combpos += $featposwant{$feat} * $featr->{Weight};
 119     }
 120     for ($end=0; $end<2; $end++) {
 121         $ns[$end] =~ m/^([a-z]\w+)\.([01])$/;
 122         ($node,$side)=($1,$2);
 123         $nsr= $nodes{$node}[$side];
 124         if (!exists $nsr->{Seg}) {
 125             $nsr->{Seg}= $seg;
 126         } elsif ($seg ne $nsr->{Seg}) {
 127             die "$seg $nsr->{Seg} ?";
 128         }
 129         $endposr= $segr->{Ends}[$combpos];
 130         die "$seg $combpos ?" if defined $endposr && @$endposr;
 131         $endposr->[$end]= [ $node, $side ];
 132     }
 133 }
 134
 135 sub o ($) {
 136     print STDOUT $_[0] or die $!;
 137 }
 138
 139 sub so_oboob ($) {
 140     my ($obj) = @_;
 141     my ($boob);
 142     $boob= $obj->{BoOb};
 143     $boob =~ m/^([1-9]\d*|0)\.([1-9]\d*|0)$/ or die "$boob ?";
 144     return sprintf "%d,%2d",$1,$2;
 145 }
 146
 147 sub mainread () {
 148     while (<>) {
 149         next if m/^\#/;
 150         chomp;
 151         s/\s+$//;
 152         next unless m/\S/;
 153         last if m/^end$/;
 154         if (m/^(invertible|vanilla|points|fixed|endwiring)$/) {
 155             $mode= $1;
 156             $invertible= ($mode eq 'invertible');
 157             $mode= 'segment' if $mode =~ m/^(?:vanilla|invertible)$/;
 158             &{"begin_$mode"};
 159         } else {
 160             $currentline= $_;
 161             &{"line_$mode"};
 162         }
 163     }
 164 }
 165
 166 sub nummap ($) {
 167     my ($p) = @_;
 168     $p =~ s/\d{1,6}/ sprintf "%06d%d",$&,$& /ge;
 169     return $p;
 170 }
 171
 172 sub writeout () {
 173     my (@segs,$segn,$seg,$segr,$pt,$ptv, $delim);
 174     o("/* autogenerated - do not edit */\n\n".
 175       "#include \"safety.h\"\n\n");
 176     @segs=();
 177     for $seg (sort { nummap($a) cmp nummap($b) } keys %segs) {
 178         $segs{$seg}{Num}= @segs;
 179         push @segs, $seg;
 180     }
 181     foreach $seg (@segs) {
 182         $segr= $segs{$seg};
 183         next unless $segr->{FeatCount};
 184         o("static const MovFeatInfo mfi_${seg}[]= {");
 185         $delim='';
 186         for $pt (keys %{ $segr->{Feats} }) {
 187             $ptv= $segr->{Feats}{$pt};
 188             next if exists $ptv->{Fixed};
 189             o("$delim\n");
 190             o("  { \"$seg/$pt\", $ptv->{Posns}, $ptv->{Weight} }");
 191             $delim=',';
 192         }
 193         o("\n};\n");
 194     }
 195     o("static const SegmentInfo info_segments[".scalar(@segs)."]= {");
 196     $delim= '';
 197     foreach $seg (@segs) {
 198         $segr= $segs{$seg};
 199         o("$delim\n");
 200         o(sprintf "  { %-7s %d, %2d,%-9s %3d,%-9s %-6s }",
 201           "\"$seg\",", $segr->{Inv},
 202           $segr->{FeatCount}, ($segr->{FeatCount} ? "mfi_$seg," : '0,'),
 203           $segr->{Posns}, ($segr->{FeatCount} ? "pci_$seg," : '0,'),
 204           so_oboob($segr));
 205         $delim= ',';
 206     }
 207     o("\n};\n");
 208 }
 209
 210 mainread();
 211 writeout();