chiark / gitweb /
provide info_segmentmap
[trains.git] / layout / data2safety
index e84539a83002cc6482d7b8571132127c63c58a29..5c7df3702d3637d3f3f83d2857059d413f2f3acd 100755 (executable)
@@ -28,14 +28,17 @@ our (%nodes);
 # $nodes{$node}[$side]{Seg}
 # $nodes{$node}[$side]{End}
 
-our ($nextboardnum,@boardtype,%numboards,$nreverses,@sensesin,@sensesbase);
-# @boardtype[$boardnum]
-# $numboards{$type}
-# $nreverses
+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;
-$nreverses= 0;
 $sensesin[0]= 0;
 @objkinds= qw(pt sense reverse);
 
@@ -100,13 +103,15 @@ sub line_segment () {
     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 () {
@@ -123,7 +128,6 @@ sub line_boards () {
 
     $nextboardnum++;
     $boardtype[$num]= $type;
-    $numboards{$type}++;
     require "./$type.pin-info";
 
     my ($sense_count, $page);
@@ -139,16 +143,15 @@ sub line_boards () {
     $sensesbase[$num]= ($page << 7) | $sensesin[$page];
     $sensesin[$page] += $sense_count;
 
-    &{"line_board_$type"}($num);
+    &{"line_boards_$type"}($num);
 }
 
-sub line_board_reversers ($) {
-    my ($num) = @_;
-    my ($i,$objnum);
-    for ($i=0; $i<5; $i++) {
-       $objnum= so_boob('reverse', [ $num,$i ]);
-       $nreverses= $objnum+1 if $objnum >= $nreverses;
-    }
+sub line_boards_reversers { }
+sub line_boards_detectors { }
+sub line_segment_vanilla ($) { }
+sub line_segment_invertible ($) {
+    my ($boob) = @_;
+    $reversersboardnum[$boob->[0]]= -1;
 }
 
 sub mistake ($) {
@@ -230,58 +233,71 @@ sub pa_boob ($) {
     return [ $1,$2 ];
 }
 
-# so_boob_KIND($boardnum,$objnum,$boardtype,$pininfo) -> global object number
+# boob2objnum_KIND($boardnum,$objnum,$boardtype,$mkused
+#  -> global object number
 
-sub so_boob_pt {
+sub boob2objnum_pt {
     my ($boardnum,$obj)=@_;
-    mistake("point encoding out of range") if $boardnum>31;
-    die if $obj > 31;
-    return ($boardnum << 5) | $obj;
+    mistake("point encoding out of range") if
+       $boardnum >= (1 << (10 - $maxptixln2));
+    die if $obj >= (1 << $maxptixln2);
+    return ($boardnum << $maxptixln2) | $obj;
 }
 
-sub so_boob_reverse {
-    my ($boardnum,$obj,$boardtype)=@_;
-
+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
-    # object number for POLARITY command numbered as shown in
+    # 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_do_here)
+    #    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, polarity_decode_message)
+    #    object corresponds to.  (see reverse.asm, command_polarity)
     #
-    #  * We compute the README.protocol bit and byte number.
+    #  * We compute the README.protocol segment number.
     
-    my ($cycle,$boardincycle,$cyclebasebyte,$byte,$bit);
+    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 if $obj > 5;
+    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;
-       return 3 - $bit; # only these three in byte 0, a special case
+       $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;
+       $byte= $cyclebasebyte + $boardincycle; $bit= $obj + 1;
     } elsif ($boardincycle==6) {
-       $byte= $cyclebasebyte + 5; $bit= $obj;
+       $byte= $cyclebasebyte + 5; $bit= $obj + 1;
     } elsif ($boardincycle==5) {
-       $byte= $cyclebasebyte + 5 - $bit; $bit= 6;
+       $byte= $cyclebasebyte + 5 - $bit; $bit= 0;
     } else {
        die;
     }
-    return $byte*7 + 3 - $bit;
+    $rv= $byte*7 + 3 - $bit;
+#print STDERR " ordinary byte=$byte bit=$bit => $rv\n";
+    return $rv;
 }
 
-sub so_boob_sense($$$) {
+sub boob2objnum_sense {
     my ($boardnum,$obj)=@_;
     my ($inpage);
     $inpage= $obj + $sensesbase[$boardnum];
@@ -289,8 +305,28 @@ sub so_boob_sense($$$) {
     return ($boardnum << 7) | $inpage;
 }    
 
-sub so_boob ($$) {
-    my ($kind,$bo) = @_;
+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, $objnum_rr) = @_;
+    my ($type,$pi);
     if (defined $bo) {
        my ($board,$obj)= @$bo;
        my ($objnum,$type,$pi);
@@ -301,17 +337,26 @@ sub so_boob ($$) {
        mistake("object reference $kind $board.$obj out of range for".
                " board type $type")
            unless defined $pi->[$obj];
-       $objnum= &{"so_boob_$kind"}($board,$obj,$type,$pi);
-       $pin_used{$kind}[$objnum]= [ $board, $pi->[$obj], $obj ];
-       return sprintf("%4d /* %d.%-2d*/", $objnum, $board, $obj);
+       $objnum= boob2objnum($board,$obj,$kind,$mkused);
+#print "so_boob >$objnum_rr|$$objnum_rr< = $objnum\n";
+       $$objnum_rr= $objnum;
+       $pin_used{$kind}[$objnum]= [ $board, $pi->[$obj], $obj ]
+           if $mkused;
+       return sprintf("%#5x /* %d.%-2d*/", $objnum, $board, $obj);
     } else {
+#print "so_boob >$objnum_rr|$$objnum_rr< -\n";
        return "   0 /*none*/ ";
     }
 }
 
-sub so_oboob ($$) {
-    my ($kind,$obj) = @_;
-    return so_boob($kind, defined $obj ? $obj->{BoOb} : undef);
+sub so_objboob ($$$;$) {
+    my ($kind,$mkused,$obj, $objnum_rr) = @_;
+#    return so_boob($kind,$mkused, defined $obj ? $obj->{BoOb} : undef );
+#print "so_objboob >$objnum_rr|$$objnum_rr<\n";
+    return so_boob($kind,$mkused,
+                  defined $obj ? $obj->{BoOb} : undef
+                  , $objnum_rr
+                  );
 }
 
 sub mainread () {
@@ -334,6 +379,21 @@ sub mainread () {
     }
 }
 
+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;
@@ -351,7 +411,6 @@ sub writeout () {
        push @segs, $seg;
     }
     o(sprintf
-      "#define NUM_TRAINS 1000000\n".
       "#define NUM_SEGMENTS %s\n\n".
       "#include \"layout-data.h\"\n\n",
       scalar @segs);
@@ -370,7 +429,7 @@ sub writeout () {
            }
            o("$delim\n");
            o(sprintf "  { %-8s %4d",
-             '"'.$seg.(length $pi ? '/' : '').$pi.'",',
+             '"'.$pi.'",',
              $segr->{Dist}[$comb]);
            for ($end=0; $end<2; $end++) {
                o(", { ");
@@ -406,7 +465,7 @@ sub writeout () {
            $delim=' ';
            foreach $boob (@{ $ptv->{BoOb} }) {
                o($delim);
-               o(so_boob('pt',$boob));
+               o(so_boob('pt',1, $boob));
                $delim= ', ';
            }
            o(" };\n");
@@ -418,7 +477,7 @@ sub writeout () {
            $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=',';
        }
@@ -426,7 +485,9 @@ sub writeout () {
     }
     o("const SegmentNum info_nsegments=NUM_SEGMENTS;\n");
     o("const SegmentInfo info_segments[NUM_SEGMENTS]= {");
+    my (@sensemap,$segnum,$sensenum,$i,$j);
     $delim= '';
+    $segnum= 0;
     foreach $seg (@segs) {
        $segr= $segs{$seg};
        o("$delim\n");
@@ -434,94 +495,176 @@ sub writeout () {
          "\"$seg\",", $segr->{Inv},
          $segr->{FeatCount}, ($segr->{FeatCount} ? "mfi_$seg," : '0,'),
          $segr->{Posns}, "spci_$seg,",
-         so_oboob('sense',$segr),
-         so_oboob('reverse', $segr->{Inv} ? $segr : undef));
+         so_objboob('sense',1, $segr, \$sensenum),
+         so_objboob('reverse',1, $segr->{Inv} ? $segr : undef));
        $delim= ',';
+       o("/* sensmap[$sensenum]=$segnum */");
+       $sensemap[$sensenum]= $segnum++;
     }
     o("\n};\n");
+    o("const BoardObject info_maxreverse= $maxreverseobjnum;\n");
+    o("#define U -1\n");
+    o("const SegmentNumInMap info_segmentmap[]= {\n");
+    $i=0; $j=0;
+    foreach $seg (@sensemap) {
+       o(!$i ? ' ' :
+         (grep { $i == $_ } @sensesbase) ? ($j=0,"\n ") :
+         !(++$j % 30) ? ",\n  " :
+         ",");
+       o($seg || 'U');
+       $i++;
+    }
+    o("\n};\n".
+      "const int info_segmentmaplen= ".scalar(@sensemap).";\n");
 }
 
 # writeasm_KIND()
 
-sub o_section ($) {
-    my ($sec) = @_;
-    o("$sec code ${sec}_start");
+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 {
-    o_section("pindata_pic2detinfo");
-    o("Exists equ 0x8000\n".
-      "Detectors equ 0x0080\n".
-      "Reversers equ 0x0000\n");
+    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\n"); next; }
+       if (!defined $boardtype[$num]) { o("  dw  0\t\t\t\t; $num\n"); next; }
        $base= $sensesbase[$num];
-       o(sprintf " dw  Exists | %-10s | 0x%02x%02x\n",
-         ucfirst($boardtype[$num]), $base >> 7, $base & 0x7f);
+       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(sprintf " fill 0, maxboards_count-%d\n", $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);
 }
 
-#      for $w (qw(pic port bit)) {
-#          @d=();
-#          o("\n");
-#          o("${k}_${w}_data_section  org  ${k}_${w}_data\n");
-#          for ($i=0; $i<@{ $pin_used{$k} }; $i++) {
-#              $or= $pin_used{$k}[$i];
-#              if (defined $or) {
-#                  $or->[1] =~ m/^(\d+)\,\d+,(\w+)$/;
-#                  ($portnum,$bit)= ($1,$2);
-#                  $portnum= sprintf "%02x", $portnum + 0x89; # 89=LATA
-#                  $bit= sprintf "%02x", hex $bit;
-#              } else {
-#                  $portnum=$bit='00';
-#              }
-#              if ($w eq 'pic') {
-#                  if (defined $or) {
-#                      push @d, $or->[0];
-#                  } else {
-#                      push @d, 'X',
-#                  }
-#              } elsif ($w eq 'port') {
-#                  push @d, $portnum;
-#              } elsif ($w eq 'bit') {
-#                  push @d, $bit;
-#              } else {
-#                  die;
-#              }
-#          }
-#          push @d, 'X' if @d^1;
-#          @d= map { s/^[a-f]/0$&/; sprintf "%3s", $_ } @d;
-#          for (;;) {
-#              $d[$each/2] = " $d[$each/2]" if $#d >= $each/2;
-#              last if @d <= $each;
-#              o("        db      ". join(',',@d[0..($each-1)]). "\n");
-#              @d= @d[$each..$#d];
-#          }
-#          o("        db      ".join(',',@d)."\n");
-#          if ($w eq 'pic') {
-#              o("        if \$ > ${k}_pic_data + ${k}_num_max\n".
-#                "         error \"too much ${k}_picdata\"\n".
-#                "        endif\n".
-#                "        fill 0xffff, ${k}_pic_data + ${k}_num_max - \$\n");
-#          }
-#      }
-#     }
 sub writeasm () {
     my ($k,$w,$i,@d,$or,$p,$portnum,$bit,$each);
     close STDOUT or die $!;
-    open STDOUT, ">$basename-pindata.asm" or die $!;
+    open STDOUT, ">$basename+pindata.asm" or die $!;
     o("; autogenerated - do not edit\n");
-    o("        include pindata.inc\n".
-      "        radix dec\n".
-      "X       equ 0xff\n");
+    o("  include pindata.inc\n".
+      "  radix dec\n".
+      "ff equ 0xff\n");
     $each= 10;
     for $k (@objkinds) {
        &{"writeasm_$k"}();
     }
-    o("\n        end\n");
+    o("\n  end\n");
 }
 mainread();
+redaction();
 writeout();
 writeasm();