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
  16 our ($mode,$invertible);
  17 $mode= 'barf';
  18
  19 sub line_barf () { die; }
  20
  21 sub begin_points () { }
  22 sub line_points () {
  23     my ($seg,$pt,@boob,$bodef);
  24     m,^\s+(\w+)/([A-Za-z]+)\s+((\d+)\.\d+)\s+(\d*\.\d+)$, or die "$_ ?";
  25     ($seg,$pt,$boob[0],$bodef,$boob[1])=($1,$2,$3,$4,$5);
  26     $boob[1] =~ s/^\./$bodef./;
  27     die "$_ ?" unless exists $segs{$seg};
  28     die "$_ ?" if exists $segs{$seg}{Feats}{$pt};
  29     $segs{$seg}{Feats}{$pt}= {
  30         Kind => Point,
  31         Weight => $segs{$seg}{Posns},
  32         Posns => 2,
  33         BoOb => [ @boob ]
  34         };
  35     $segs{$seg}{Posns} *= 2;
  36     $segs{$seg}{FeatCount}++;
  37 }
  38
  39 sub begin_fixed () { }
  40 sub line_fixed () {
  41     my ($seg,$pt,$pos);
  42     m,^\s+(\w+)/([A-Za-z]+)(\d+)$, or die "$_ ?";
  43     ($seg,$pt,$pos)=($1,$2,$3);
  44     die "$_ ?" unless exists $segs{$seg};
  45     die "$_ ?" if exists $segs{$seg}{Feats}{$pt};
  46     $segs{$seg}{Feats}{$pt}= {
  47         Kind => Fixed,
  48         Fixed => $pos
  49         };
  50 }
  51
  52 sub begin_segment () { }
  53 sub line_segment () {
  54     my ($seg,$boob);
  55     m/^\s+(\w+)\s+(\d+\.\d+)$/ or die "$_ ?";
  56     ($seg,$boob)=($1,$2);
  57     die "$_ ?" if exists $segs{$seg};
  58     $segs{$seg}= {
  59         BoOb => $boob,
  60         Inv => $invertible,
  61         Posns => 1,
  62         Feats => { },
  63         FeatCount => 0
  64     };
  65 }
  66
  67 sub begin_endwiring () {
  68 }
  69
  70 #       o("static const SegPosCombInfo spci_${seg}[]= {");
  71 #       $delim='';
  72 #       for ($comb=0; $comb < $segv->{Posns}; $comb++) {
  73 #       }
  74
  75 sub line_endwiring () {
  76     my (@ns,$seg,$subspec,$dist);
  77     m,^\s*segment\s+(\w+\.\d+)\s+(\w+\.\d+)\s+(\w+)((?:/\w+\*\d+)?)\s+([0-9.]+)$, or die "$_ ?";
  78     ($ns[0],$ns[1],$seg,$subspec,$dist)=($1,$2,$3,$4,$5);
  79     if (!exists $segs{$seg}) {
  80         print STDERR "ditching unwired $seg$subspec\n";
  81         return;
  82     }
  83     for ($end=0; $end<2; $end++) {
  84         $ns[$end] =~ m/^([a-z]\w+)\.([01])$;
  85         ($node,$side)=($1,$2);
  86         if (exists $nodes{$node}
  87     }
  88 }
  89
  90 sub o ($) {
  91     print STDOUT $_[0] or die $!;
  92 }
  93
  94 sub so_oboob ($) {
  95     my ($obj) = @_;
  96     my ($boob);
  97     $boob= $obj->{BoOb};
  98     $boob =~ m/^([1-9]\d)*\.([1-9]\d*)$/ or die "$boob ?";
  99     return sprintf "%d,%d",$1,$2;
 100 }
 101
 102 sub mainread () {
 103     while (<>) {
 104         next if m/^\#/;
 105         chomp;
 106         s/\s+$//;
 107         next unless m/\S/;
 108         last if m/^end$/;
 109         if (m/^(invertible|vanilla|points|fixed|endwiring)$/) {
 110             $mode= $1;
 111             $invertible= ($mode eq 'invertible');
 112             $mode= 'segment' if $mode =~ m/^(?:vanilla|invertible)$/;
 113             &{"begin_$mode"};
 114         } else {
 115             &{"line_$mode"};
 116         }
 117     }
 118 }
 119
 120 sub writeout () {
 121     my ($seg,$segv,$pt,$ptv, $delim);
 122     o("/* autogenerated - do not edit */\n\n");
 123     for $seg (keys %segs) {
 124         $segv= $segs{$seg};
 125         next unless $segv->{FeatCount};
 126         o("static const MovFeatInfo mfi_${seg}[]= {");
 127         $delim='';
 128         for $pt (keys %{ $segv->{Feats} }) {
 129             $ptv= $segv->{Feats}{$pt};
 130             next if exists $ptv->{Fixed};
 131             o("$delim\n");
 132             o("  { \"$seg/$pt\", $ptv->{Posns}, $ptv->{Weight} }");
 133             $delim=',';
 134         }
 135         o("\n};\n");
 136     }
 137 }
 138
 139 mainread();
 140 writeout();