layout/data2safety

   1 #!/usr/bin/perl -w
   2
   3 use strict qw(vars);
   4
   5 our ($basename);
   6 $basename= @ARGV ? $ARGV[0] : 'safety';
   7 die if $basename =~ m/^\-/;
   8 $basename =~ s/\.wiring$//;
   9
  10 our ($mistakes, $currentline);
  11
  12 our (%segs);
  13 # $segs{$seg}{Inv}
  14 # $segs{$seg}{BoOb}
  15 # $segs{$seg}{Posns}
  16 # $segs{$seg}{FeatCount}              does not include Fixed
  17 # $segs{$seg}{Feats}{$pt}{Kind}       Point or Fixed
  18 # $segs{$seg}{Feats}{$pt}{Weight}     ) for Point only
  19 # $segs{$seg}{Feats}{$pt}{Posns}      ) for Point only
  20 # $segs{$seg}{Feats}{$pt}{BoOb}[]     ) for Point only
  21 # $segs{$seg}{Feats}{$pt}{Fixed}      position, for Fixed only
  22
  23 # $segs{$seg}{Num}
  24 # $segs{$seg}{Ends}[$combpos][$end] = [ $node,$side ]
  25 # $segs{$seg}{Dist}[$combpos]
  26
  27 our (%nodes);
  28 # $nodes{$node}[$side]{Seg}
  29 # $nodes{$node}[$side]{End}
  30
  31 our ($maxptixln2) = 5;
  32
  33 our ($nextboardnum,@boardtype,%numboards,$nreverses,@sensesin,@sensesbase);
  34 our (@objkinds,%pin_used);
  35 # @boardtype[$boardnum]
  36 # $numboards{$type}
  37 # $nreverses
  38 # $sensesin[$page]
  39 # $sensesbase[$boardnum]= ($page << 7) | $baselsbyte
  40 # %pin_used{$objkind}[$objnum] = [ $boardnum, $pin_info, $objonboard ]
  41 $nextboardnum= 0;
  42 $nreverses= 0;
  43 $sensesin[0]= 0;
  44 @objkinds= qw(pt sense reverse);
  45
  46 our (%kind_count,%pin_info); # from BOARD.pin-info
  47
  48 our ($mode,$invertible);
  49 $mode= 'barf';
  50
  51 sub line_barf () {
  52     return if $mistakes;
  53     mistake("first input line does not determine phase");
  54 }
  55
  56 sub syntaxerror () {
  57     our (%syntaxerror_once);
  58     return if exists $syntaxerror_once{$mode};
  59     $syntaxerror_once{$mode}= 1;
  60     mistake("syntax error");
  61     return undef;
  62 }
  63
  64 sub ditch ($) {
  65     my ($m) = @_;
  66     print STDERR "ditching $m\n";
  67 }
  68
  69 sub begin_points () { }
  70 sub line_points () {
  71     my ($seg,$pt,@boob,$bodef);
  72     m,^\s+(\w+)/([A-Za-z]+)\s+((\d+)\.\d+)\s+(\d*\.\d+)$, or
  73         return syntaxerror();
  74     ($seg,$pt,$boob[0],$bodef,$boob[1])=($1,$2,$3,$4,$5);
  75     $boob[1] =~ s/^\./$bodef./;
  76     mistake("unknown wiring for $seg in $seg/$pt") unless exists $segs{$seg};
  77     mistake("duplicate wiring for $seg/$pt") if exists $segs{$seg}{Feats}{$pt};
  78     $segs{$seg}{Feats}{$pt}= {
  79         Kind => Point,
  80         Weight => $segs{$seg}{Posns},
  81         Posns => 2,
  82         BoOb => [ map { pa_boob($_) } @boob ]
  83         };
  84     $segs{$seg}{Posns} *= 2;
  85     $segs{$seg}{FeatCount}++;
  86 }
  87
  88 sub begin_fixed () { }
  89 sub line_fixed () {
  90     my ($seg,$pt,$pos);
  91     m,^\s+(\w+)/([A-Za-z]+)(\d+)$, or return syntaxerror();
  92     ($seg,$pt,$pos)=($1,$2,$3);
  93     mistake("unknown wiring for $seg in $seg/$pt") unless exists $segs{$seg};
  94     mistake("duplicate fixed $seg/$pt") if exists $segs{$seg}{Feats}{$pt};
  95     $segs{$seg}{Feats}{$pt}= {
  96         Kind => Fixed,
  97         Fixed => $pos
  98         };
  99 }
 100
 101 sub begin_segment () { }
 102 sub line_segment () {
 103     my ($seg,$boob);
 104     m/^\s+(\w+)\s+(\d+\.\d+)$/ or return syntaxerror();
 105     ($seg,$boob)=($1,$2);
 106     mistake("duplicate topology for $seg") if exists $segs{$seg};
 107     $segs{$seg}= {
 108         BoOb => pa_boob($boob),
 109         Inv => $invertible,
 110         Posns => 1,
 111         Feats => { },
 112         FeatCount => 0
 113     };
 114 }
 115
 116 sub begin_endwiring () {
 117 }
 118
 119 sub begin_boards () {
 120 }
 121 sub line_boards () {
 122     my ($num,$type,$k);
 123     m/^\s+(\d+)\s+(\w+)$/ or return syntaxerror();
 124     ($num,$type)=($1,$2);
 125     mistake("board $num when expected $nextboardnum")
 126         if $num != $nextboardnum;
 127
 128     $nextboardnum++;
 129     $boardtype[$num]= $type;
 130     $numboards{$type}++;
 131     require "./$type.pin-info";
 132
 133     my ($sense_count, $page);
 134     $sense_count= $kind_count{$type}{'sense'};
 135     for ($page=0;
 136          $sensesin[$page] + $sense_count > 128;
 137          $page++) {
 138         mistake("too many senses for encoding scheme")
 139             if $page > 7;
 140         push @sensesin, 0
 141             if $page > $#sensesin;
 142     }
 143     $sensesbase[$num]= ($page << 7) | $sensesin[$page];
 144     $sensesin[$page] += $sense_count;
 145
 146     &{"line_boards_$type"}($num);
 147 }
 148
 149 sub line_boards_reversers {
 150     my ($num) = @_;
 151     my ($i,$objnum);
 152     for ($i=0; $i<6; $i++) {
 153         $objnum= boob2objnum($num,$i,'reverse',0);
 154         $nreverses= $objnum+1 if $objnum >= $nreverses;
 155     }
 156 }
 157 sub line_boards_detectors { }
 158
 159 sub mistake ($) {
 160     my ($m) = @_;
 161     print STDERR "mistake: $m\n in $mode, \`$currentline'\n";
 162     $mistakes++;
 163 }
 164
 165 sub line_endwiring () {
 166     my (@ns,$seg,$subspec,$dist);
 167     my ($segr,@subsegil,$feat,$pos,$featr,$combpos,%featposwant);
 168     my ($end,$node,$side,$nsr,$endposr);
 169     m,^\s*segment\s+(\w+\.\d+)\s+(\w+\.\d+)\s+(\w+)(?:/((?:[A-Za-z]+\d+)+)\*\d+)?\s+([0-9.]+)$, or return syntaxerror();
 170     ($ns[0],$ns[1],$seg,$subspec,$dist)=($1,$2,$3,$4,$5);
 171     if (!exists $segs{$seg}) {
 172         ditch("unwired $seg$subspec");
 173         return;
 174     }
 175     $segr= $segs{$seg};
 176     @subsegil= defined $subspec ? $subspec =~ m/([A-Za-z]+)(\d+)/g : ();
 177     while (@subsegil) {
 178         ($feat,$pos,@subsegil) = @subsegil;
 179         if (!exists $segr->{Feats}{$feat}) {
 180             mistake("no wiring for $seg/$feat");
 181             next;
 182         }
 183         $featr= $segr->{Feats}{$feat};
 184         if (exists $featr->{Fixed}) {
 185             if ($pos != $featr->{Fixed}) {
 186                 ditch("fixed-elsewise $seg$subspec");
 187                 return;
 188             }
 189         } else {
 190             mistake("position $seg/$feat$pos exceeds wiring")
 191                 unless $pos < $featr->{Posns};
 192             $featposwant{$feat}= $pos;
 193         }
 194     }
 195     $combpos= 0;
 196     for $feat (keys %{ $segr->{Feats} }) {
 197         $featr= $segr->{Feats}{$feat};
 198         next if exists $featr->{Fixed};
 199         mistake("wiring $seg/$feat not covered by $seg/$subspec")
 200             if !exists $featposwant{$feat};
 201         $combpos += $featposwant{$feat} * $featr->{Weight};
 202     }
 203     mistake("duplicate topology for $seg/$subspec")
 204         if defined $segs{$seg}{Dist}[$combpos];
 205     $segs{$seg}{Dist}[$combpos]= $dist;
 206     $endposr= $segr->{Ends}[$combpos];
 207     die "$seg $combpos @$endposr ?" if defined $endposr && @$endposr;
 208     for ($end=0; $end<2; $end++) {
 209         $ns[$end] =~ m/^([a-z]\w+)\.([01])$/;
 210         ($node,$side)=($1,$2);
 211         $nsr= $nodes{$node}[$side];
 212         if (!exists $nsr->{Seg}) {
 213             $nodes{$node}[$side]= { Seg => $seg, End => $end };
 214         } else {
 215             $seg eq $nsr->{Seg} or
 216                 mistake("topology for $node.$side both $seg and $nsr->{Seg}");
 217             $end == $nsr->{End} or
 218                 mistake("topology for $node.$side $seg both ends ($end".
 219                         " and also $nsr->{End})");
 220         }
 221         $segr->{Ends}[$combpos][$end]= [ $node, $side ];
 222     }
 223 }
 224
 225 sub o ($) {
 226     print STDOUT $_[0] or die $!;
 227 }
 228
 229 sub pa_boob ($) {
 230     my ($boob) = @_;
 231     if ($boob !~ m/^([1-9]\d*|0)\.([1-9]\d*|0)$/) {
 232         mistake("invalid board object $boob");
 233         return [ 0,0 ];
 234     }
 235     return [ $1,$2 ];
 236 }
 237
 238 # boob2objnum_KIND($boardnum,$objnum,$boardtype,$mkused
 239 #  -> global object number
 240
 241 sub boob2objnum_pt {
 242     my ($boardnum,$obj)=@_;
 243     mistake("point encoding out of range") if
 244         $boardnum >= (1 << (10 - $maxptixln2));
 245     die if $obj >= (1 << $maxptixln2);
 246     return ($boardnum << $maxptixln2) | $obj;
 247 }
 248
 249 sub boob2objnum_reverse {
 250     my ($boardnum,$obj,$boardtype)=@_;
 251
 252     # Converts board and object number (in canonical pic number plus
 253     # and reverse0...reverse5 as seen on pinout diagrams), to
 254     # object number for POLARITY command numbered as shown in
 255     # README.protocol.
 256     #
 257     # There are three basic stages:
 258     #
 259     #  * We invert the on-board mapping; ie, we untangle the
 260     #    tangling between the message from master to slave pic
 261     #    and the actual pins (see reverse.asm, polarity_do_here)
 262     #
 263     #  * We figure out which bit of which message byte the
 264     #    object corresponds to.  (see reverse.asm, polarity_decode_message)
 265     #
 266     #  * We compute the README.protocol bit and byte number.
 267
 268     my ($cycle,$boardincycle,$cyclebasebyte,$byte,$bit);
 269     die unless $boardtype eq 'reversers';
 270     die $obj if $obj > 5;
 271     $obj = sprintf '%d', $obj;
 272     $obj =~ y/302154/543210/; # mapping due to polarity_do_here
 273     $cycle= int(($boardnum+3) / 7);
 274     $boardincycle= ($boardnum+3) - $cycle*7;
 275     $cyclebasebyte= $cycle*6 - 2;
 276     if ($boardnum==2 && $obj > 2) {
 277         $byte= 0; $bit= $obj-3;
 278         return 3 - $bit; # only these three in byte 0, a special case
 279     } elsif ($boardincycle<5) {
 280         $byte= $cyclebasebyte + $boardincycle; $bit= $obj;
 281     } elsif ($boardincycle==6) {
 282         $byte= $cyclebasebyte + 5; $bit= $obj;
 283     } elsif ($boardincycle==5) {
 284         $byte= $cyclebasebyte + 5 - $bit; $bit= 6;
 285     } else {
 286         die;
 287     }
 288     return $byte*7 + 3 - $bit;
 289 }
 290
 291 sub boob2objnum_sense {
 292     my ($boardnum,$obj)=@_;
 293     my ($inpage);
 294     $inpage= $obj + $sensesbase[$boardnum];
 295     die if $inpage > 127;
 296     return ($boardnum << 7) | $inpage;
 297 }
 298
 299 sub boob2objnum ($$$$) {
 300     my ($boardnum,$obj,$kind,$mkused) = @_;
 301     my ($type);
 302     $type= $boardtype[$boardnum];
 303     return &{"boob2objnum_$kind"}($boardnum,$obj,$type,$mkused);
 304 }
 305
 306 sub boob_used_bit ($$$) {
 307     my ($boardnum,$obj,$kind) = @_;
 308     my ($objnum);
 309     $objnum= boob2objnum($boardnum, $obj, $kind, 0);
 310     return defined $pin_used{$kind}[$objnum] ? 1 : 0;
 311 }
 312
 313 sub so_boob ($$$) {
 314     my ($kind,$mkused,$bo) = @_;
 315     my ($type,$pi);
 316     if (defined $bo) {
 317         my ($board,$obj)= @$bo;
 318         my ($objnum,$type,$pi);
 319         mistake("unknown board number $board")
 320             unless defined $boardtype[$board];
 321         $type= $boardtype[$board];
 322         $pi= $pin_info{$type}{$kind};
 323         mistake("object reference $kind $board.$obj out of range for".
 324                 " board type $type")
 325             unless defined $pi->[$obj];
 326         $objnum= boob2objnum($board,$obj,$kind,$mkused);
 327         $pin_used{$kind}[$objnum]= [ $board, $pi->[$obj], $obj ]
 328             if $mkused;
 329         return sprintf("%4d /* %d.%-2d*/", $objnum, $board, $obj);
 330     } else {
 331         return "   0 /*none*/ ";
 332     }
 333 }
 334
 335 sub so_objboob ($$$) {
 336     my ($kind,$mkused,$obj) = @_;
 337     return so_boob($kind,$mkused, defined $obj ? $obj->{BoOb} : undef);
 338 }
 339
 340 sub mainread () {
 341     $mistakes= 0;
 342     while (<>) {
 343         next if m/^\#/;
 344         chomp;
 345         s/\s+$//;
 346         next unless m/\S/;
 347         last if m/^end$/;
 348         if (m/^(invertible|vanilla|points|fixed|endwiring|boards)$/) {
 349             $mode= $1;
 350             $invertible= ($mode eq 'invertible');
 351             $mode= 'segment' if $mode =~ m/^(?:vanilla|invertible)$/;
 352             &{"begin_$mode"};
 353         } else {
 354             $currentline= $_;
 355             &{"line_$mode"};
 356         }
 357     }
 358 }
 359
 360 sub nummap ($) {
 361     my ($p) = @_;
 362     $p =~ s/\d{1,6}/ sprintf "%06d%d",$&,$& /ge;
 363     return $p;
 364 }
 365
 366 sub writeout () {
 367     my (@segs,$segn,$seg,$segr,$pt,$ptv, $delim);
 368     my ($comb,$pi,$feat,$featr,$end,$boob);
 369     my ($node,$side,$otherend,$nodeotherside,$otherseg,$otherbackrelus);
 370     o("/* autogenerated - do not edit */\n\n");
 371     @segs=();
 372     for $seg (sort { nummap($a) cmp nummap($b) } keys %segs) {
 373         $segs{$seg}{Num}= @segs;
 374         push @segs, $seg;
 375     }
 376     o(sprintf
 377       "#define NUM_TRAINS 1000000\n".
 378       "#define NUM_SEGMENTS %s\n\n".
 379       "#include \"layout-data.h\"\n\n",
 380       scalar @segs);
 381     foreach $seg (@segs) {
 382         $segr= $segs{$seg};
 383
 384         o("static const SegPosCombInfo spci_${seg}"."[]= {");
 385         $delim='';
 386         for ($comb=0; $comb < $segr->{Posns}; $comb++) {
 387             $pi='';
 388             foreach $feat (keys %{ $segr->{Feats} }) {
 389                 $featr= $segr->{Feats}{$feat};
 390                 next if exists $featr->{Fixed};
 391                 $pi.= sprintf("%s%d", $feat,
 392                               ($comb / $featr->{Weight}) % $featr->{Posns});
 393             }
 394             o("$delim\n");
 395             o(sprintf "  { %-8s %4d",
 396               '"'.$seg.(length $pi ? '/' : '').$pi.'",',
 397               $segr->{Dist}[$comb]);
 398             for ($end=0; $end<2; $end++) {
 399                 o(", { ");
 400                 $otherend= $segr->{Ends}[$comb][$end];
 401                 defined $otherend or die "$seg $comb $end ?";
 402                 ($node,$side) = @$otherend;
 403                 $nodeotherside= $nodes{$node}[1-$side];
 404                 if (defined $nodeotherside) {
 405                     $otherseg= $nodeotherside->{Seg};
 406                     $otherbackrelus= $nodeotherside->{End} ^ $end ^ 1;
 407                     o(sprintf "/*%5s.%d %-5s*/ %d,%3d",
 408                       $node,$side,
 409                       ($otherbackrelus?'-':' ').$otherseg,
 410                       $otherbackrelus,
 411                       $segs{$otherseg}{Num});
 412                 } else {
 413                     o(sprintf "/*%5s.%d*/ 0,NOTA(Segment)",
 414                       $node,$side);
 415                 }
 416                 o(" }");
 417             }
 418             o(sprintf " }");
 419             $delim= ',';
 420         }
 421         o("\n};\n");
 422
 423         next unless $segr->{FeatCount};
 424
 425         for $pt (keys %{ $segr->{Feats} }) {
 426             $ptv= $segr->{Feats}{$pt};
 427             next if exists $ptv->{Fixed};
 428             o("static const BoardObject mfbo_${seg}_${pt}"."[]= {");
 429             $delim=' ';
 430             foreach $boob (@{ $ptv->{BoOb} }) {
 431                 o($delim);
 432                 o(so_boob('pt',1, $boob));
 433                 $delim= ', ';
 434             }
 435             o(" };\n");
 436         }
 437
 438         o("static const MovFeatInfo mfi_${seg}"."[]= {");
 439         $delim='';
 440         for $pt (keys %{ $segr->{Feats} }) {
 441             $ptv= $segr->{Feats}{$pt};
 442             next if exists $ptv->{Fixed};
 443             o("$delim\n");
 444             o("  { \"$seg/$pt\", mfk_".lc($ptv->{Kind}).",".
 445               " $ptv->{Posns}, $ptv->{Weight}, mfbo_${seg}_$pt }");
 446             $delim=',';
 447         }
 448         o("\n};\n");
 449     }
 450     o("const SegmentNum info_nsegments=NUM_SEGMENTS;\n");
 451     o("const SegmentInfo info_segments[NUM_SEGMENTS]= {");
 452     $delim= '';
 453     foreach $seg (@segs) {
 454         $segr= $segs{$seg};
 455         o("$delim\n");
 456         o(sprintf "  { %-7s %d, %2d,%-9s %3d,%-10s %-6s,%-6s }",
 457           "\"$seg\",", $segr->{Inv},
 458           $segr->{FeatCount}, ($segr->{FeatCount} ? "mfi_$seg," : '0,'),
 459           $segr->{Posns}, "spci_$seg,",
 460           so_objboob('sense',1, $segr),
 461           so_objboob('reverse',1, $segr->{Inv} ? $segr : undef));
 462         $delim= ',';
 463     }
 464     o("\n};\n");
 465 }
 466
 467 # writeasm_KIND()
 468
 469 sub o_section ($$) {
 470     my ($sec,$docstring) = @_;
 471     o("\n;----------\n".
 472       " org $sec\n");
 473     o($docstring);
 474 }
 475 sub o_section_end_fill ($$$) {
 476     my ($lastnumdone, $fillvalue, $entrysize) = @_;
 477     if ($entrysize == 1 and $lastnumdone & 1) {
 478         o(", $fillvalue & 0xff\n");
 479         $lastnumdone++;
 480     } else {
 481         o("\n");
 482     }
 483     o(sprintf " fill %s, %d*(maxpic-%d)\n\n",
 484       $fillvalue, $entrysize, $lastnumdone);
 485 }
 486
 487 sub o_db ($;$) {
 488     my ($ix,$every) = @_;
 489     $every=16 unless defined $every;
 490     o(($every ? $ix % $every : $ix) ? ',' : "\n db ");
 491 }
 492
 493 sub writeasm_sense {
 494     my ($num, $base);
 495     o_section('pic2detinfo',<<'END');
 496 ; Table indexed by pic no., giving information about sensing
 497 ; Each element is two bytes:
 498 ;  1st byte   bit 7     Set iff this board exists for the purposes of sensing
 499 ;             bits 6-3  Not used, set to zero
 500 ;             bits 2-0  Top 3 bits of sense segment numbers on this board
 501 ;  2nd byte   bit 7     Set iff this board is a Detectors board
 502 ;             bits 6-0  Base for bottom 7 bits of segment number
 503 ;                       (per-board segment no. is added to this; carry
 504 ;                        to upper 3 bits is not permitted)
 505 END
 506     o("SenseExists equ 0x80\n".
 507       "Detectors equ 0x80\n".
 508       "Reversers equ 0x00\n\n");
 509     for ($num=0; $num<@boardtype; $num++) {
 510         if (!defined $boardtype[$num]) { o(" dw  0\t\t\t\t; $num\n"); next; }
 511         $base= $sensesbase[$num];
 512         o(sprintf " db  SenseExists | 0x%02x, %12s | 0x%02x\t; %d\n",
 513           $base >> 7, ucfirst($boardtype[$num]), $base & 0x7f, $num);
 514     }
 515     o_section_end_fill($num, 0, 2);
 516 }
 517
 518 sub writeasm_pt {
 519     my ($num, $elemsize, $byte, $bit, $objnum);
 520     o_section('picno2ptmap',<<'END');
 521 ; Bitmap indexed first by pic no, and then by point no. on that board,
 522 ; saying whether the point is present or not.  Each pic has 4 bytes,
 523 ; ie 32 bits.  First byte is points 0 to 7, in bits 0 to 7 respectively
 524 ; so that MSbit of byte 3 (4th byte) is point no.31.  Unused boards
 525 ; or boards with no points are all-bits-0.
 526 END
 527     for ($num=0; $num<@boardtype; $num++) {
 528         if (!defined $boardtype[$num]) { o(" dw  0\t\t\t\t; $num"); next; }
 529         die if $maxptixln2 < 4; # must be whole no. of 16-bit words
 530         $elemsize= 1 << ($maxptixln2-3);
 531         for ($byte=0; $byte < $elemsize; $byte++) {
 532             o_db($byte, 0);
 533             o("b'");
 534             for ($bit=7; $bit>=0; $bit--) {
 535                 o(boob_used_bit($num, $byte*8 + $bit, 'pt'));
 536             }
 537             o("'");
 538         }
 539         o(" ; $num");
 540     }
 541     o("\n");
 542     o_section_end_fill($num, 0, $elemsize);
 543
 544     my($typeix,$type,$pt,$pi);
 545     o_section('bkptix2portnumbitnum',<<"END");
 546 ; Table giving physical ports and pins for points for each
 547 ; kind of board.  Index is point number (for reversers boards)
 548 ; or point number + 2^$maxptixln2 (for detectors boards).
 549 ; Value is one byte, either 0xff meaning that board type has
 550 ; no such point, or top nybble being port number (0 for A, 1 for B,
 551 ; etc.) and bottom nybble being bit number.  Ie,
 552 ;   Index:  00Dppppp    where D is 1 iff detectors board and p is pt ix
 553 ;   Value:  0ppp0bbb    where p is port num and b is bit num; or 0xff
 554 END
 555     o(" radix hex\n");
 556     for ($typeix=0; $typeix<2; $typeix++) {
 557         $type= qw(reversers detectors)[$typeix];
 558         die $type unless $pin_info{$type};
 559         o("; $type:");
 560         for ($pt=0; $pt < (1 << $maxptixln2); $pt++) {
 561             o_db($pt);
 562             $pi= $pin_info{$type}{'pt'}[$pt];
 563             if (defined $pi) {
 564                 $pi =~ m/^(\d)\,(\d)\,/ or die;
 565                 o($1.$2);
 566             } else {
 567                 o('ff');
 568             }
 569         }
 570         o("\n");
 571     }
 572     o(" radix dec\n\n");
 573 }
 574
 575 sub writeasm_reverse {
 576     my ($num,$kc,$bit);
 577     o_section('picno2revbits',<<END);
 578 ; Table listing which reversers are connected/enabled.
 579 ; Index is pic number.  Value is 0xff for non-reversers boards,
 580 ; or bitmap of connected reversers.  LSbit is reverse 0, etc.
 581 END
 582     for ($num=0; $num<@boardtype; $num++) {
 583         o_db($num, 4);
 584         $kc= $kind_count{$boardtype[$num]}{'reverse'};
 585         if ($kc) {
 586             die if $kc > 7;
 587             o("b'");
 588             for ($bit= $kc-1; $bit>=0; $bit--) {
 589                 o(boob_used_bit($num, $bit, 'reverse'));
 590             }
 591             o("'");
 592         } else {
 593             o('0xff');
 594         }
 595     }
 596     o_section_end_fill($num, '0xffff', 1);
 597 }
 598
 599 sub writeasm () {
 600     my ($k,$w,$i,@d,$or,$p,$portnum,$bit,$each);
 601     close STDOUT or die $!;
 602     open STDOUT, ">$basename+pindata.asm" or die $!;
 603     o("; autogenerated - do not edit\n");
 604     o("        include pindata.inc\n".
 605       "        radix dec\n".
 606       "ff equ 0xff\n");
 607     $each= 10;
 608     for $k (@objkinds) {
 609         &{"writeasm_$k"}();
 610     }
 611     o("\n        end\n");
 612 }
 613 mainread();
 614 writeout();
 615 writeasm();