From: ian Date: Sat, 26 Mar 2005 18:43:37 +0000 (+0000) Subject: segposcombinfo wip X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=commitdiff_plain;h=0bf4709506d6fe3ca4f784e4390a043fadace8f3;p=trains.git segposcombinfo wip --- diff --git a/layout/data2safety b/layout/data2safety index 335a065..d5db4d0 100755 --- a/layout/data2safety +++ b/layout/data2safety @@ -2,7 +2,7 @@ use strict qw(vars); -our ($currentline); +our ($mistakes, $currentline); our (%segs); # $segs{$seg}{Inv} @@ -14,7 +14,10 @@ our (%segs); # $segs{$seg}{Feats}{$pt}{Posns} ) for Point only # $segs{$seg}{Feats}{$pt}{BoOb} ) for Point only # $segs{$seg}{Feats}{$pt}{Fixed} position, for Fixed only + +# $segs{$seg}{Num} # $segs{$seg}{Ends}[$combpos][$end] = [ $node,$side ] +# $segs{$seg}{Dist}[$combpos] our (%nodes); # $nodes{$node}[$side]{Seg} @@ -22,21 +25,38 @@ our (%nodes); our ($mode,$invertible); $mode= 'barf'; -sub line_barf () { die; } +sub line_barf () { + return if $mistakes; + mistake("first input line does not determine phase"); +} + +sub syntaxerror () { + our (%syntaxerror_once); + return if exists $syntaxerror_once{$mode}; + $syntaxerror_once{$mode}= 1; + mistake("syntax error"); + return undef; +} + +sub ditch ($) { + my ($m) = @_; + print STDERR "ditching $m\n"; +} sub begin_points () { } sub line_points () { my ($seg,$pt,@boob,$bodef); - m,^\s+(\w+)/([A-Za-z]+)\s+((\d+)\.\d+)\s+(\d*\.\d+)$, or die "$_ ?"; + m,^\s+(\w+)/([A-Za-z]+)\s+((\d+)\.\d+)\s+(\d*\.\d+)$, or + return syntaxerror(); ($seg,$pt,$boob[0],$bodef,$boob[1])=($1,$2,$3,$4,$5); $boob[1] =~ s/^\./$bodef./; - die "$_ ?" unless exists $segs{$seg}; - die "$_ ?" if exists $segs{$seg}{Feats}{$pt}; + mistake("unknown wiring for $seg in $seg/$pt") unless exists $segs{$seg}; + mistake("duplicate wiring for $seg/$pt") if exists $segs{$seg}{Feats}{$pt}; $segs{$seg}{Feats}{$pt}= { Kind => Point, Weight => $segs{$seg}{Posns}, Posns => 2, - BoOb => [ @boob ] + BoOb => [ map { pa_boob($_) } @boob ] }; $segs{$seg}{Posns} *= 2; $segs{$seg}{FeatCount}++; @@ -45,10 +65,10 @@ sub line_points () { sub begin_fixed () { } sub line_fixed () { my ($seg,$pt,$pos); - m,^\s+(\w+)/([A-Za-z]+)(\d+)$, or die "$_ ?"; + m,^\s+(\w+)/([A-Za-z]+)(\d+)$, or return syntaxerror(); ($seg,$pt,$pos)=($1,$2,$3); - die "$_ ?" unless exists $segs{$seg}; - die "$_ ?" if exists $segs{$seg}{Feats}{$pt}; + mistake("unknown wiring for $seg in $seg/$pt") unless exists $segs{$seg}; + mistake("duplicate fixed $seg/$pt") if exists $segs{$seg}{Feats}{$pt}; $segs{$seg}{Feats}{$pt}= { Kind => Fixed, Fixed => $pos @@ -58,11 +78,11 @@ sub line_fixed () { sub begin_segment () { } sub line_segment () { my ($seg,$boob); - m/^\s+(\w+)\s+(\d+\.\d+)$/ or die "$_ ?"; + m/^\s+(\w+)\s+(\d+\.\d+)$/ or return syntaxerror(); ($seg,$boob)=($1,$2); - die "$_ ?" if exists $segs{$seg}; + mistake("duplicate topology for $seg") if exists $segs{$seg}; $segs{$seg}= { - BoOb => $boob, + BoOb => pa_boob($boob), Inv => $invertible, Posns => 1, Feats => { }, @@ -73,40 +93,39 @@ sub line_segment () { sub begin_endwiring () { } -# o("static const SegPosCombInfo spci_${seg}[]= {"); -# $delim=''; -# for ($comb=0; $comb < $segv->{Posns}; $comb++) { -# } - sub mistake ($) { my ($m) = @_; - die "mistake: $m\n in \`$currentline'\n"; + print STDERR "mistake: $m\n in $mode, \`$currentline'\n"; + $mistakes++; } 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 "$_ ?"; + m,^\s*segment\s+(\w+\.\d+)\s+(\w+\.\d+)\s+(\w+)(?:/((?:[A-Za-z]+\d+)+)\*\d+)?\s+([0-9.]+)$, or return syntaxerror(); ($ns[0],$ns[1],$seg,$subspec,$dist)=($1,$2,$3,$4,$5); if (!exists $segs{$seg}) { - print STDERR "ditching unwired $seg$subspec\n"; + ditch("unwired $seg$subspec"); return; } $segr= $segs{$seg}; @subsegil= defined $subspec ? $subspec =~ m/([A-Za-z]+)(\d+)/g : (); while (@subsegil) { ($feat,$pos,@subsegil) = @subsegil; - mistake("no wiring for $seg/$feat") - unless exists $segr->{Feats}{$feat}; + if (!exists $segr->{Feats}{$feat}) { + mistake("no wiring for $seg/$feat"); + next; + } $featr= $segr->{Feats}{$feat}; if (exists $featr->{Fixed}) { if ($pos != $featr->{Fixed}) { - print STDERR "ditching fixed-elsewise $seg$subspec\n"; + ditch("fixed-elsewise $seg$subspec"); return; } } else { - die "$pos $featr->{Posns} ?" unless $pos < $featr->{Posns}; + mistake("position $seg/$feat$pos exceeds wiring") + unless $pos < $featr->{Posns}; $featposwant{$feat}= $pos; } } @@ -114,9 +133,13 @@ sub line_endwiring () { for $feat (keys %{ $segr->{Feats} }) { $featr= $segr->{Feats}{$feat}; next if exists $featr->{Fixed}; - die "$feat ?" if !exists $featposwant{$feat}; + mistake("wiring $seg/$feat not covered by $seg/$subspec") + if !exists $featposwant{$feat}; $combpos += $featposwant{$feat} * $featr->{Weight}; } + mistake("duplicate topology for $seg/$subspec") + if defined $segs{$seg}{Dist}[$combpos]; + $segs{$seg}{Dist}[$combpos]= $dist; for ($end=0; $end<2; $end++) { $ns[$end] =~ m/^([a-z]\w+)\.([01])$/; ($node,$side)=($1,$2); @@ -124,7 +147,7 @@ sub line_endwiring () { if (!exists $nsr->{Seg}) { $nsr->{Seg}= $seg; } elsif ($seg ne $nsr->{Seg}) { - die "$seg $nsr->{Seg} ?"; + mistake("topology for $node.$side both $seg and $nsr->{Seg}"); } $endposr= $segr->{Ends}[$combpos]; die "$seg $combpos ?" if defined $endposr && @$endposr; @@ -136,15 +159,22 @@ sub o ($) { print STDOUT $_[0] or die $!; } +sub pa_boob ($) { + my ($boob) = @_; + if ($boob !~ m/^([1-9]\d*|0)\.([1-9]\d*|0)$/) { + mistake("invalid board object $boob"); + return [ 0,0 ]; + } + return sprintf "%d,%2d", $1,$2; +} + sub so_oboob ($) { my ($obj) = @_; - my ($boob); - $boob= $obj->{BoOb}; - $boob =~ m/^([1-9]\d*|0)\.([1-9]\d*|0)$/ or die "$boob ?"; - return sprintf "%d,%2d",$1,$2; + return $obj->{BoOb}; } sub mainread () { + $mistakes= 0; while (<>) { next if m/^\#/; chomp; @@ -171,6 +201,7 @@ sub nummap ($) { sub writeout () { my (@segs,$segn,$seg,$segr,$pt,$ptv, $delim); + my ($comb,$pi,$feat,$featr,$end); o("/* autogenerated - do not edit */\n\n". "#include \"safety.h\"\n\n"); @segs=(); @@ -191,16 +222,46 @@ sub writeout () { $delim=','; } o("\n};\n"); + o("static const SegPosCombInfo spci_${seg}[]= {"); + $delim=''; + for ($comb=0; $comb < $segr->{Posns}; $comb++) { + $pi=''; + foreach $feat (keys %{ $segr->{Feats} }) { + $featr= $segr->{Feats}{$feat}; + next if exists $featr->{Fixed}; + $pi.= sprintf("%s%d", $feat, + ($comb / $featr->{Weight}) % $featr->{Posns}); + } + o("$delim\n"); + o(sprintf " %s {", + "/*$pi*/"); + for ($end=0; $end<2; $end++) { + $other= $segs{$seg}{Ends}[$combpos][$end]; + o(" { "); + if (defined $other) { + ($node,$side) = @$other; + + o(sprintf "/*%5s.%d %-6s*/ %d,%3d", + "/* $other*/", $ + } else { + + ); +o(" },"); + } + o(sprintf " }"); + $delim= ','; + } + o("\n};\n"); } o("static const SegmentInfo info_segments[".scalar(@segs)."]= {"); $delim= ''; foreach $seg (@segs) { $segr= $segs{$seg}; o("$delim\n"); - o(sprintf " { %-7s %d, %2d,%-9s %3d,%-9s %-6s }", + o(sprintf " { %-7s %d, %2d,%-9s %3d,%-10s %-6s }", "\"$seg\",", $segr->{Inv}, $segr->{FeatCount}, ($segr->{FeatCount} ? "mfi_$seg," : '0,'), - $segr->{Posns}, ($segr->{FeatCount} ? "pci_$seg," : '0,'), + $segr->{Posns}, ($segr->{FeatCount} ? "spci_$seg," : '0,'), so_oboob($segr)); $delim= ','; }