6 $basename= @ARGV ? $ARGV[0] : 'safety';
7 die if $basename =~ m/^\-/;
8 $basename =~ s/\.wiring$//;
10 our ($mistakes, $currentline);
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
24 # $segs{$seg}{Ends}[$combpos][$end] = [ $node,$side ]
25 # $segs{$seg}{Dist}[$combpos]
28 # $nodes{$node}[$side]{Seg}
29 # $nodes{$node}[$side]{End}
31 our ($maxptixln2) = 5;
33 our ($nextboardnum,@boardtype,@sensesin,$maxreverseobjnum);
34 our (@reversersboardnum,@sensesbase,@objkinds,%pin_used);
35 # $boardtype[$boardnum]
38 # $reversersboardnum[$boardnum] # undef => none; -1 => not yet determined
39 # $sensesbase[$boardnum]= ($page << 7) | $baselsbyte
40 # $pin_used{$objkind}[$objnum] = [ $boardnum, $pin_info, $objonboard ]
43 @objkinds= qw(pt sense reverse);
45 our (%kind_count,%pin_info); # from BOARD.pin-info
47 our ($mode,$invertible);
52 mistake("first input line does not determine phase");
56 our (%syntaxerror_once);
57 return if exists $syntaxerror_once{$mode};
58 $syntaxerror_once{$mode}= 1;
59 mistake("syntax error");
65 print STDERR "ditching $m\n";
68 sub begin_points () { }
70 my ($seg,$pt,@boob,$bodef);
71 m,^\s+(\w+)/([A-Za-z]+)\s+((\d+)\.\d+)\s+(\d*\.\d+)$, or
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}= {
79 Weight => $segs{$seg}{Posns},
81 BoOb => [ map { pa_boob($_) } @boob ]
83 $segs{$seg}{Posns} *= 2;
84 $segs{$seg}{FeatCount}++;
87 sub begin_fixed () { }
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}= {
100 sub begin_segment () { }
101 sub line_segment () {
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);
114 &{"line_segment_".($invertible?'invertible':'vanilla')}($boob);
117 sub begin_endwiring () {
120 sub begin_boards () {
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;
130 $boardtype[$num]= $type;
131 require "./$type.pin-info";
133 my ($sense_count, $page);
134 $sense_count= $kind_count{$type}{'sense'};
136 $sensesin[$page] + $sense_count > 128;
138 mistake("too many senses for encoding scheme")
141 if $page > $#sensesin;
143 $sensesbase[$num]= ($page << 7) | $sensesin[$page];
144 $sensesin[$page] += $sense_count;
146 &{"line_boards_$type"}($num);
149 sub line_boards_reversers { }
150 sub line_boards_detectors { }
151 sub line_segment_vanilla ($) { }
152 sub line_segment_invertible ($) {
154 $reversersboardnum[$boob->[0]]= -1;
159 print STDERR "mistake: $m\n in $mode, \`$currentline'\n";
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");
174 @subsegil= defined $subspec ? $subspec =~ m/([A-Za-z]+)(\d+)/g : ();
176 ($feat,$pos,@subsegil) = @subsegil;
177 if (!exists $segr->{Feats}{$feat}) {
178 mistake("no wiring for $seg/$feat");
181 $featr= $segr->{Feats}{$feat};
182 if (exists $featr->{Fixed}) {
183 if ($pos != $featr->{Fixed}) {
184 ditch("fixed-elsewise $seg$subspec");
188 mistake("position $seg/$feat$pos exceeds wiring")
189 unless $pos < $featr->{Posns};
190 $featposwant{$feat}= $pos;
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};
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 };
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})");
219 $segr->{Ends}[$combpos][$end]= [ $node, $side ];
224 print STDOUT $_[0] or die $!;
229 if ($boob !~ m/^([1-9]\d*|0)\.([1-9]\d*|0)$/) {
230 mistake("invalid board object $boob");
236 # boob2objnum_KIND($boardnum,$objnum,$boardtype,$mkused
237 # -> global object number
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;
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
254 # There are three basic stages:
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)
260 # * We figure out which bit of which message byte the
261 # object corresponds to. (see reverse.asm, command_polarity)
263 # * We compute the README.protocol segment number.
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";
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;
295 $rv= $byte*7 + 3 - $bit;
296 #print STDERR " ordinary byte=$byte bit=$bit => $rv\n";
300 sub boob2objnum_sense {
301 my ($boardnum,$obj)=@_;
303 $inpage= $obj + $sensesbase[$boardnum];
304 die if $inpage > 127;
305 return ($boardnum << 7) | $inpage;
308 sub boob2objnum ($$$$) {
309 my ($boardnum,$obj,$kind,$mkused) = @_;
311 $type= $boardtype[$boardnum];
312 return &{"boob2objnum_$kind"}($boardnum,$obj,$type,$mkused);
315 sub boob_used ($$$) {
316 my ($boardnum,$obj,$kind) = @_;
318 $objnum= boob2objnum($boardnum, $obj, $kind, 0);
319 return $pin_used{$kind}[$objnum];
322 sub boob_used_bit ($$$) {
323 my ($boardnum,$obj,$kind) = @_;
324 return defined boob_used($boardnum,$obj,$kind) ? 1 : 0;
328 my ($kind,$mkused,$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".
339 unless defined $pi->[$obj];
340 $objnum= boob2objnum($board,$obj,$kind,$mkused);
341 $pin_used{$kind}[$objnum]= [ $board, $pi->[$obj], $obj ]
343 return sprintf("%4d /* %d.%-2d*/", $objnum, $board, $obj);
345 return " 0 /*none*/ ";
349 sub so_objboob ($$$) {
350 my ($kind,$mkused,$obj) = @_;
351 return so_boob($kind,$mkused, defined $obj ? $obj->{BoOb} : undef);
362 if (m/^(invertible|vanilla|points|fixed|endwiring|boards)$/) {
364 $invertible= ($mode eq 'invertible');
365 $mode= 'segment' if $mode =~ m/^(?:vanilla|invertible)$/;
375 my ($num,$mappednum,$i,$objnum);
376 $maxreverseobjnum= 0;
377 for ($num=0, $mappednum=0; $num<@boardtype; $num++) {
378 next unless defined $reversersboardnum[$num];
379 die if $reversersboardnum[$num] != -1;
380 $reversersboardnum[$num]= $mappednum;
381 for ($i=0; $i<6; $i++) {
382 $objnum= boob2objnum($mappednum,$i,'reverse',0);
383 $maxreverseobjnum= $objnum+1 if $objnum >= $maxreverseobjnum;
391 $p =~ s/\d{1,6}/ sprintf "%06d%d",$&,$& /ge;
396 my (@segs,$segn,$seg,$segr,$pt,$ptv, $delim);
397 my ($comb,$pi,$feat,$featr,$end,$boob);
398 my ($node,$side,$otherend,$nodeotherside,$otherseg,$otherbackrelus);
399 o("/* autogenerated - do not edit */\n\n");
401 for $seg (sort { nummap($a) cmp nummap($b) } keys %segs) {
402 $segs{$seg}{Num}= @segs;
406 "#define NUM_SEGMENTS %s\n\n".
407 "#include \"layout-data.h\"\n\n",
409 foreach $seg (@segs) {
412 o("static const SegPosCombInfo spci_${seg}"."[]= {");
414 for ($comb=0; $comb < $segr->{Posns}; $comb++) {
416 foreach $feat (keys %{ $segr->{Feats} }) {
417 $featr= $segr->{Feats}{$feat};
418 next if exists $featr->{Fixed};
419 $pi.= sprintf("%s%d", $feat,
420 ($comb / $featr->{Weight}) % $featr->{Posns});
423 o(sprintf " { %-8s %4d",
425 $segr->{Dist}[$comb]);
426 for ($end=0; $end<2; $end++) {
428 $otherend= $segr->{Ends}[$comb][$end];
429 defined $otherend or die "$seg $comb $end ?";
430 ($node,$side) = @$otherend;
431 $nodeotherside= $nodes{$node}[1-$side];
432 if (defined $nodeotherside) {
433 $otherseg= $nodeotherside->{Seg};
434 $otherbackrelus= $nodeotherside->{End} ^ $end ^ 1;
435 o(sprintf "/*%5s.%d %-5s*/ %d,%3d",
437 ($otherbackrelus?'-':' ').$otherseg,
439 $segs{$otherseg}{Num});
441 o(sprintf "/*%5s.%d*/ 0,NOTA(Segment)",
451 next unless $segr->{FeatCount};
453 for $pt (keys %{ $segr->{Feats} }) {
454 $ptv= $segr->{Feats}{$pt};
455 next if exists $ptv->{Fixed};
456 o("static const BoardObject mfbo_${seg}_${pt}"."[]= {");
458 foreach $boob (@{ $ptv->{BoOb} }) {
460 o(so_boob('pt',1, $boob));
466 o("static const MovFeatInfo mfi_${seg}"."[]= {");
468 for $pt (keys %{ $segr->{Feats} }) {
469 $ptv= $segr->{Feats}{$pt};
470 next if exists $ptv->{Fixed};
472 o(" { \"$pt\", mfk_".lc($ptv->{Kind}).",".
473 " $ptv->{Posns}, $ptv->{Weight}, mfbo_${seg}_$pt }");
478 o("const SegmentNum info_nsegments=NUM_SEGMENTS;\n");
479 o("const SegmentInfo info_segments[NUM_SEGMENTS]= {");
481 foreach $seg (@segs) {
484 o(sprintf " { %-7s %d, %2d,%-9s %3d,%-10s %-6s,%-6s }",
485 "\"$seg\",", $segr->{Inv},
486 $segr->{FeatCount}, ($segr->{FeatCount} ? "mfi_$seg," : '0,'),
487 $segr->{Posns}, "spci_$seg,",
488 so_objboob('sense',1, $segr),
489 so_objboob('reverse',1, $segr->{Inv} ? $segr : undef));
493 o("const BoardObject info_maxreverse= $maxreverseobjnum;\n");
499 my ($sec,$docstring) = @_;
504 sub o_section_end_fill ($$$) {
505 my ($lastnumdone, $fillvalue, $entrysize) = @_;
506 if ($entrysize == 1 and $lastnumdone & 1) {
507 o(", $fillvalue & 0xff\n");
512 o(sprintf " fill %s, %d*(maxpics-%d)\n\n",
513 $fillvalue, $entrysize, $lastnumdone);
517 my ($ix,$every) = @_;
518 $every=16 unless defined $every;
519 o(($every ? $ix % $every : $ix) ? ',' : "\n db ");
524 o_section('pic2detinfo',<<'END');
525 ; Table indexed by pic no., giving information about sensing
526 ; Each element is two bytes:
527 ; 1st byte bit 7 Set iff this board exists for the purposes of sensing
528 ; bits 6-3 Not used, set to zero
529 ; bits 2-0 Top 3 bits of sense segment numbers on this board
530 ; 2nd byte bit 7 Set iff this board is a Detectors board
531 ; bits 6-0 Base for bottom 7 bits of segment number
532 ; (per-board segment no. is added to this; carry
533 ; to upper 3 bits is not permitted)
535 o("SenseExists equ 0x80\n".
536 "Detectors equ 0x80\n".
537 "Reversers equ 0x00\n\n");
538 for ($num=0; $num<@boardtype; $num++) {
539 if (!defined $boardtype[$num]) { o(" dw 0\t\t\t\t; $num\n"); next; }
540 $base= $sensesbase[$num];
541 o(sprintf " db SenseExists | 0x%02x, %12s | 0x%02x\t; %d\n",
542 $base >> 7, ucfirst($boardtype[$num]), $base & 0x7f, $num);
544 o_section_end_fill($num, 0, 2);
548 my ($num, $elemsize, $byte, $bit, $objnum);
549 o_section('picno2ptmap',<<'END');
550 ; Bitmap indexed first by pic no, and then by point no. on that board,
551 ; saying whether the point is present or not. Each pic has 4 bytes,
552 ; ie 32 bits. First byte is points 0 to 7, in bits 0 to 7 respectively
553 ; so that MSbit of byte 3 (4th byte) is point no.31. Unused boards
554 ; or boards with no points are all-bits-0.
556 for ($num=0; $num<@boardtype; $num++) {
557 if (!defined $boardtype[$num]) { o(" dw 0\t\t\t\t; $num"); next; }
558 die if $maxptixln2 < 4; # must be whole no. of 16-bit words
559 $elemsize= 1 << ($maxptixln2-3);
560 for ($byte=0; $byte < $elemsize; $byte++) {
563 for ($bit=7; $bit>=0; $bit--) {
564 o(boob_used_bit($num, $byte*8 + $bit, 'pt'));
571 o_section_end_fill($num, 0, $elemsize);
573 my($typeix,$type,$pt,$pi);
574 o_section('bkptix2portnumbitnum',<<"END");
575 ; Table giving physical ports and pins for points for each
576 ; kind of board. Index is point number (for reversers boards)
577 ; or point number + 2^$maxptixln2 (for detectors boards).
578 ; Value is one byte, either 0xff meaning that board type has
579 ; no such point, or top nybble being port number (0 for A, 1 for B,
580 ; etc.) and bottom nybble being bit number. Ie,
581 ; Index: 00Dppppp where D is 1 iff detectors board and p is pt ix
582 ; Value: 0ppp0bbb where p is port num and b is bit num; or 0xff
585 for ($typeix=0; $typeix<2; $typeix++) {
586 $type= qw(reversers detectors)[$typeix];
587 die $type unless $pin_info{$type};
589 for ($pt=0; $pt < (1 << $maxptixln2); $pt++) {
591 $pi= $pin_info{$type}{'pt'}[$pt];
593 $pi =~ m/^(\d)\,(\d)\,/ or die;
604 sub writeasm_reverse {
605 my ($num,$kc,$bit, @portae,$pu);
606 o_section('picno2revmasks',<<END);
607 ; Table listing which reversers are connected/enabled. Index is pic
608 ; number. Each entry is 2 bytes: mask for port A followed by mask for
609 ; port E. A 1 bit is a connected reverser. Both masks are 0 for
610 ; non-reversers boards.
612 for ($num=0; $num<@boardtype; $num++) {
614 $kc= $kind_count{$boardtype[$num]}{'reverse'};
615 for ($bit= $kc-1; $bit>=0; $bit--) {
616 $pu= boob_used($num, $bit, 'reverse');
618 $pu->[1] =~ m/^([04])\,\d,(0x\w{2})$/ or die;
619 push @{ $portae[!!$1] }, $2;
622 o(join(', ', map { @$_ ? join('|',@$_) : '0' } @portae));
623 o(sprintf " ; %d\n",$num);
625 o_section_end_fill($num, '0x0000', 2);
629 my ($k,$w,$i,@d,$or,$p,$portnum,$bit,$each);
630 close STDOUT or die $!;
631 open STDOUT, ">$basename+pindata.asm" or die $!;
632 o("; autogenerated - do not edit\n");
633 o(" include pindata.inc\n".