use strict qw(vars);
+our ($currentline);
+
our (%segs);
# $segs{$seg}{Inv}
# $segs{$seg}{BoOb}
# $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);
# 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}) {
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;
$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}) {
} 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 ];
}
}
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 () {
$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} }");
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");