use strict qw(vars);
+our ($basename);
+$basename= @ARGV ? $ARGV[0] : 'safety';
+die if $basename =~ m/^\-/;
+$basename =~ s/\.wiring$//;
+
our ($mistakes, $currentline);
our (%segs);
# $nodes{$node}[$side]{Seg}
# $nodes{$node}[$side]{End}
+our ($maxptixln2) = 5;
+
+our ($nextboardnum,@boardtype,@sensesin,$maxreverseobjnum);
+our (@reversersboardnum,@sensesbase,@objkinds,%pin_used);
+# $boardtype[$boardnum]
+# $sensesin[$page]
+# $maxreverseobjnum
+# $reversersboardnum[$boardnum] # undef => none; -1 => not yet determined
+# $sensesbase[$boardnum]= ($page << 7) | $baselsbyte
+# $pin_used{$objkind}[$objnum] = [ $boardnum, $pin_info, $objonboard ]
+$nextboardnum= 0;
+$sensesin[0]= 0;
+@objkinds= qw(pt sense reverse);
+
+our (%kind_count,%pin_info); # from BOARD.pin-info
+
our ($mode,$invertible);
$mode= 'barf';
m/^\s+(\w+)\s+(\d+\.\d+)$/ or return syntaxerror();
($seg,$boob)=($1,$2);
mistake("duplicate topology for $seg") if exists $segs{$seg};
+ $boob= pa_boob($boob);
$segs{$seg}= {
- BoOb => pa_boob($boob),
+ BoOb => $boob,
Inv => $invertible,
Posns => 1,
Feats => { },
FeatCount => 0
};
+ &{"line_segment_".($invertible?'invertible':'vanilla')}($boob);
}
sub begin_endwiring () {
}
+sub begin_boards () {
+}
+sub line_boards () {
+ my ($num,$type,$k);
+ m/^\s+(\d+)\s+(\w+)$/ or return syntaxerror();
+ ($num,$type)=($1,$2);
+ mistake("board $num when expected $nextboardnum")
+ if $num != $nextboardnum;
+
+ $nextboardnum++;
+ $boardtype[$num]= $type;
+ require "./$type.pin-info";
+
+ my ($sense_count, $page);
+ $sense_count= $kind_count{$type}{'sense'};
+ for ($page=0;
+ $sensesin[$page] + $sense_count > 128;
+ $page++) {
+ mistake("too many senses for encoding scheme")
+ if $page > 7;
+ push @sensesin, 0
+ if $page > $#sensesin;
+ }
+ $sensesbase[$num]= ($page << 7) | $sensesin[$page];
+ $sensesin[$page] += $sense_count;
+
+ &{"line_boards_$type"}($num);
+}
+
+sub line_boards_reversers { }
+sub line_boards_detectors { }
+sub line_segment_vanilla ($) { }
+sub line_segment_invertible ($) {
+ my ($boob) = @_;
+ $reversersboardnum[$boob->[0]]= -1;
+}
+
sub mistake ($) {
my ($m) = @_;
print STDERR "mistake: $m\n in $mode, \`$currentline'\n";
return [ $1,$2 ];
}
-sub so_boob ($$) {
- my ($k,$bo) = @_;
- return sprintf "%5d /* %d.%-2d*/", $bo->[0] * 1000 + $bo->[1],
- $bo->[0], $bo->[1];
+# boob2objnum_KIND($boardnum,$objnum,$boardtype,$mkused
+# -> global object number
+
+sub boob2objnum_pt {
+ my ($boardnum,$obj)=@_;
+ mistake("point encoding out of range") if
+ $boardnum >= (1 << (10 - $maxptixln2));
+ die if $obj >= (1 << $maxptixln2);
+ return ($boardnum << $maxptixln2) | $obj;
+}
+
+sub boob2objnum_reverse {
+ my ($orgboardnum,$obj,$boardtype)=@_;
+ # Converts board and object number (in canonical pic number plus
+ # and reverse0...reverse5 as seen on pinout diagrams), to the
+ # segment number for POLARITY command numbered as shown in
+ # README.protocol.
+ #
+ # There are three basic stages:
+ #
+ # * We invert the on-board mapping; ie, we untangle the
+ # tangling between the message from master to slave pic
+ # and the actual pins (see reverse.asm, polarity_local_do)
+ #
+ # * We figure out which bit of which message byte the
+ # object corresponds to. (see reverse.asm, command_polarity)
+ #
+ # * We compute the README.protocol segment number.
+
+ my ($cycle,$boardincycle,$cyclebasebyte,$byte,$bit,$boardnum,$rv);
+ $boardnum= $reversersboardnum[$orgboardnum];
+ die "$orgboardnum $boardnum" unless defined $boardnum;
+ die "$orgboardnum $boardnum" unless $boardnum >= 0;
+ die unless $boardtype eq 'reversers';
+ die $obj if $obj > 5;
+#print STDERR "data2safety $boardnum.$obj ";
+ $obj = sprintf '%d', $obj;
+ $obj =~ y/302154/543210/; # mapping due to polarity_do_here
+#print STDERR " obj=$obj";
+ $cycle= int(($boardnum+3) / 7);
+#print STDERR " cycle=$cycle";
+ $boardincycle= ($boardnum+3) - $cycle*7;
+#print STDERR " boardin=$boardincycle";
+ $cyclebasebyte= $cycle*6 - 2;
+#print STDERR " baseby=$cyclebasebyte";
+ if ($boardnum==2 && $obj > 2) {
+ $byte= 0; $bit= $obj-3;
+ $rv= 3 - $bit; # only these three in byte 0, a special case;
+#print STDERR " special bit=$bit => $rv\n";
+ return $rv;
+ } elsif ($boardincycle<5) {
+ $byte= $cyclebasebyte + $boardincycle; $bit= $obj + 1;
+ } elsif ($boardincycle==6) {
+ $byte= $cyclebasebyte + 5; $bit= $obj + 1;
+ } elsif ($boardincycle==5) {
+ $byte= $cyclebasebyte + 5 - $bit; $bit= 0;
+ } else {
+ die;
+ }
+ $rv= $byte*7 + 3 - $bit;
+#print STDERR " ordinary byte=$byte bit=$bit => $rv\n";
+ return $rv;
+}
+
+sub boob2objnum_sense {
+ my ($boardnum,$obj)=@_;
+ my ($inpage);
+ $inpage= $obj + $sensesbase[$boardnum];
+ die if $inpage > 127;
+ return ($boardnum << 7) | $inpage;
+}
+
+sub boob2objnum ($$$$) {
+ my ($boardnum,$obj,$kind,$mkused) = @_;
+ my ($type);
+ $type= $boardtype[$boardnum];
+ return &{"boob2objnum_$kind"}($boardnum,$obj,$type,$mkused);
+}
+
+sub boob_used ($$$) {
+ my ($boardnum,$obj,$kind) = @_;
+ my ($objnum);
+ $objnum= boob2objnum($boardnum, $obj, $kind, 0);
+ return $pin_used{$kind}[$objnum];
+}
+
+sub boob_used_bit ($$$) {
+ my ($boardnum,$obj,$kind) = @_;
+ return defined boob_used($boardnum,$obj,$kind) ? 1 : 0;
+}
+
+sub so_boob ($$$) {
+ my ($kind,$mkused,$bo) = @_;
+ my ($type,$pi);
+ if (defined $bo) {
+ my ($board,$obj)= @$bo;
+ my ($objnum,$type,$pi);
+ mistake("unknown board number $board")
+ unless defined $boardtype[$board];
+ $type= $boardtype[$board];
+ $pi= $pin_info{$type}{$kind};
+ mistake("object reference $kind $board.$obj out of range for".
+ " board type $type")
+ unless defined $pi->[$obj];
+ $objnum= boob2objnum($board,$obj,$kind,$mkused);
+ $pin_used{$kind}[$objnum]= [ $board, $pi->[$obj], $obj ]
+ if $mkused;
+ return sprintf("%4d /* %d.%-2d*/", $objnum, $board, $obj);
+ } else {
+ return " 0 /*none*/ ";
+ }
}
-sub so_oboob ($$) {
- my ($k,$obj) = @_;
- return so_boob($k,$obj->{BoOb});
+sub so_objboob ($$$) {
+ my ($kind,$mkused,$obj) = @_;
+ return so_boob($kind,$mkused, defined $obj ? $obj->{BoOb} : undef);
}
sub mainread () {
s/\s+$//;
next unless m/\S/;
last if m/^end$/;
- if (m/^(invertible|vanilla|points|fixed|endwiring)$/) {
+ if (m/^(invertible|vanilla|points|fixed|endwiring|boards)$/) {
$mode= $1;
$invertible= ($mode eq 'invertible');
$mode= 'segment' if $mode =~ m/^(?:vanilla|invertible)$/;
}
}
+sub redaction () {
+ my ($num,$mappednum,$i,$objnum);
+ $maxreverseobjnum= 0;
+ for ($num=0, $mappednum=0; $num<@boardtype; $num++) {
+ next unless defined $reversersboardnum[$num];
+ die if $reversersboardnum[$num] != -1;
+ $reversersboardnum[$num]= $mappednum;
+ for ($i=0; $i<6; $i++) {
+ $objnum= boob2objnum($mappednum,$i,'reverse',0);
+ $maxreverseobjnum= $objnum+1 if $objnum >= $maxreverseobjnum;
+ }
+ $mappednum++;
+ }
+}
+
sub nummap ($) {
my ($p) = @_;
$p =~ s/\d{1,6}/ sprintf "%06d%d",$&,$& /ge;
push @segs, $seg;
}
o(sprintf
- "#define NUM_TRAINS 1000000\n".
"#define NUM_SEGMENTS %s\n\n".
"#include \"layout-data.h\"\n\n",
scalar @segs);
foreach $seg (@segs) {
$segr= $segs{$seg};
- o("static const SegPosCombInfo spci_${seg}[]= {");
+ o("static const SegPosCombInfo spci_${seg}"."[]= {");
$delim='';
for ($comb=0; $comb < $segr->{Posns}; $comb++) {
$pi='';
}
o("$delim\n");
o(sprintf " { %-8s %4d",
- '"'.$seg.(length $pi ? '/' : '').$pi.'",',
+ '"'.$pi.'",',
$segr->{Dist}[$comb]);
for ($end=0; $end<2; $end++) {
o(", { ");
for $pt (keys %{ $segr->{Feats} }) {
$ptv= $segr->{Feats}{$pt};
next if exists $ptv->{Fixed};
- o("static const BoardObject mfbo_${seg}_${pt}[]= {");
+ o("static const BoardObject mfbo_${seg}_${pt}"."[]= {");
$delim=' ';
foreach $boob (@{ $ptv->{BoOb} }) {
o($delim);
- o(so_boob('pt',$boob));
+ o(so_boob('pt',1, $boob));
$delim= ', ';
}
o(" };\n");
}
- o("static const MovFeatInfo mfi_${seg}[]= {");
+ o("static const MovFeatInfo mfi_${seg}"."[]= {");
$delim='';
for $pt (keys %{ $segr->{Feats} }) {
$ptv= $segr->{Feats}{$pt};
next if exists $ptv->{Fixed};
o("$delim\n");
- o(" { \"$seg/$pt\", mfk_".lc($ptv->{Kind}).",".
+ o(" { \"$pt\", mfk_".lc($ptv->{Kind}).",".
" $ptv->{Posns}, $ptv->{Weight}, mfbo_${seg}_$pt }");
$delim=',';
}
foreach $seg (@segs) {
$segr= $segs{$seg};
o("$delim\n");
- o(sprintf " { %-7s %d, %2d,%-9s %3d,%-10s %-6s }",
+ o(sprintf " { %-7s %d, %2d,%-9s %3d,%-10s %-6s,%-6s }",
"\"$seg\",", $segr->{Inv},
$segr->{FeatCount}, ($segr->{FeatCount} ? "mfi_$seg," : '0,'),
$segr->{Posns}, "spci_$seg,",
- so_oboob('sense',$segr), so_oboob('reverse',$segr));
+ so_objboob('sense',1, $segr),
+ so_objboob('reverse',1, $segr->{Inv} ? $segr : undef));
$delim= ',';
}
o("\n};\n");
+ o("const BoardObject info_maxreverse= $maxreverseobjnum;\n");
+}
+
+# writeasm_KIND()
+
+sub o_section ($$) {
+ my ($sec,$docstring) = @_;
+ o("\n;----------\n".
+ " org $sec\n");
+ o($docstring);
+}
+sub o_section_end_fill ($$$) {
+ my ($lastnumdone, $fillvalue, $entrysize) = @_;
+ if ($entrysize == 1 and $lastnumdone & 1) {
+ o(", $fillvalue & 0xff\n");
+ $lastnumdone++;
+ } else {
+ o("\n");
+ }
+ o(sprintf " fill %s, %d*(maxpics-%d)\n\n",
+ $fillvalue, $entrysize, $lastnumdone);
+}
+
+sub o_db ($;$) {
+ my ($ix,$every) = @_;
+ $every=16 unless defined $every;
+ o(($every ? $ix % $every : $ix) ? ',' : "\n db ");
+}
+
+sub writeasm_sense {
+ my ($num, $base);
+ o_section('pic2detinfo',<<'END');
+; Table indexed by pic no., giving information about sensing
+; Each element is two bytes:
+; 1st byte bit 7 Set iff this board exists for the purposes of sensing
+; bits 6-3 Not used, set to zero
+; bits 2-0 Top 3 bits of sense segment numbers on this board
+; 2nd byte bit 7 Set iff this board is a Detectors board
+; bits 6-0 Base for bottom 7 bits of segment number
+; (per-board segment no. is added to this; carry
+; to upper 3 bits is not permitted)
+END
+ o("SenseExists equ 0x80\n".
+ "Detectors equ 0x80\n".
+ "Reversers equ 0x00\n\n");
+ for ($num=0; $num<@boardtype; $num++) {
+ if (!defined $boardtype[$num]) { o(" dw 0\t\t\t\t; $num\n"); next; }
+ $base= $sensesbase[$num];
+ o(sprintf " db SenseExists | 0x%02x, %12s | 0x%02x\t; %d\n",
+ $base >> 7, ucfirst($boardtype[$num]), $base & 0x7f, $num);
+ }
+ o_section_end_fill($num, 0, 2);
+}
+
+sub writeasm_pt {
+ my ($num, $elemsize, $byte, $bit, $objnum);
+ o_section('picno2ptmap',<<'END');
+; Bitmap indexed first by pic no, and then by point no. on that board,
+; saying whether the point is present or not. Each pic has 4 bytes,
+; ie 32 bits. First byte is points 0 to 7, in bits 0 to 7 respectively
+; so that MSbit of byte 3 (4th byte) is point no.31. Unused boards
+; or boards with no points are all-bits-0.
+END
+ for ($num=0; $num<@boardtype; $num++) {
+ if (!defined $boardtype[$num]) { o(" dw 0\t\t\t\t; $num"); next; }
+ die if $maxptixln2 < 4; # must be whole no. of 16-bit words
+ $elemsize= 1 << ($maxptixln2-3);
+ for ($byte=0; $byte < $elemsize; $byte++) {
+ o_db($byte, 0);
+ o("b'");
+ for ($bit=7; $bit>=0; $bit--) {
+ o(boob_used_bit($num, $byte*8 + $bit, 'pt'));
+ }
+ o("'");
+ }
+ o(" ; $num");
+ }
+ o("\n");
+ o_section_end_fill($num, 0, $elemsize);
+
+ my($typeix,$type,$pt,$pi);
+ o_section('bkptix2portnumbitnum',<<"END");
+; Table giving physical ports and pins for points for each
+; kind of board. Index is point number (for reversers boards)
+; or point number + 2^$maxptixln2 (for detectors boards).
+; Value is one byte, either 0xff meaning that board type has
+; no such point, or top nybble being port number (0 for A, 1 for B,
+; etc.) and bottom nybble being bit number. Ie,
+; Index: 00Dppppp where D is 1 iff detectors board and p is pt ix
+; Value: 0ppp0bbb where p is port num and b is bit num; or 0xff
+END
+ o(" radix hex\n");
+ for ($typeix=0; $typeix<2; $typeix++) {
+ $type= qw(reversers detectors)[$typeix];
+ die $type unless $pin_info{$type};
+ o("; $type:");
+ for ($pt=0; $pt < (1 << $maxptixln2); $pt++) {
+ o_db($pt);
+ $pi= $pin_info{$type}{'pt'}[$pt];
+ if (defined $pi) {
+ $pi =~ m/^(\d)\,(\d)\,/ or die;
+ o($1.$2);
+ } else {
+ o('ff');
+ }
+ }
+ o("\n");
+ }
+ o(" radix dec\n\n");
}
+sub writeasm_reverse {
+ my ($num,$kc,$bit, @portae,$pu);
+ o_section('picno2revmasks',<<END);
+; Table listing which reversers are connected/enabled. Index is pic
+; number. Each entry is 2 bytes: mask for port A followed by mask for
+; port E. A 1 bit is a connected reverser. Both masks are 0 for
+; non-reversers boards.
+END
+ for ($num=0; $num<@boardtype; $num++) {
+ @portae= ([],[]);
+ $kc= $kind_count{$boardtype[$num]}{'reverse'};
+ for ($bit= $kc-1; $bit>=0; $bit--) {
+ $pu= boob_used($num, $bit, 'reverse');
+ next unless $pu;
+ $pu->[1] =~ m/^([04])\,\d,(0x\w{2})$/ or die;
+ push @{ $portae[!!$1] }, $2;
+ }
+ o(' db ');
+ o(join(', ', map { @$_ ? join('|',@$_) : '0' } @portae));
+ o(sprintf " ; %d\n",$num);
+ }
+ o_section_end_fill($num, '0x0000', 2);
+}
+
+sub writeasm () {
+ my ($k,$w,$i,@d,$or,$p,$portnum,$bit,$each);
+ close STDOUT or die $!;
+ open STDOUT, ">$basename+pindata.asm" or die $!;
+ o("; autogenerated - do not edit\n");
+ o(" include pindata.inc\n".
+ " radix dec\n".
+ "ff equ 0xff\n");
+ $each= 10;
+ for $k (@objkinds) {
+ &{"writeasm_$k"}();
+ }
+ o("\n end\n");
+}
mainread();
+redaction();
writeout();
+writeasm();
~ijackson / trains.git / blobdiff