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