layout/data2safety

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