chiark / gitweb /
1698ebab49f899f0f25c00868ce834cd2dbf6b57
[trains.git] / hostside / parse-proto-spec
1 #!/usr/bin/perl
2
3 use IO::Handle;
4
5 @ARGV==2 or die;
6
7 sub begin ($) {
8     $dname= $_[0];
9 }
10
11 ($spec,$templ)=@ARGV;
12
13 $linexpect= -1;
14
15 sub pln ($) {
16     if ($dolinno && $linexpect != $templlinno) {
17         print "# $templlinno \"$templ\"\n" or die $!;
18     }
19     print $_[0] or die $!;
20     $linexpect= $templlinno+1;
21 }
22
23 sub expand_and_write () {
24     $templl= $templlin;
25     $templl =~ s/\@([a-z]+)\=(\w*)\@/
26         die "$1=$2 in $templl ?" unless exists $v{$1};
27         $v{$1} eq $2  ? '' : '@SKIP@'
28     /ge;
29     $templl =~ m/\@SKIP\@/
30         and next;
31     $templl =~ s/\@([a-z]+)\@/
32         die $1 unless exists $v{$1};
33         $v{$1}
34     /ge;
35     pln($templl);
36 }
37
38 sub b2xh ($$) {
39     my ($bin,$orin) = @_;
40     return sprintf "0x%02x", (oct("0b$bin") | $orin);
41 }
42
43 sub process_line () {
44     chomp;
45     $origprotoline= $_;
46     if (m/^From host to PIC/) {
47         $dirn= '>'; begin("host2pic");
48     } elsif (m/^From PIC to host/) {
49         $dirn= '<'; begin("pic2host");
50     } elsif (m/^\S/) {
51         $dirn= undef;
52     }
53     next unless defined $dirn;
54     next unless m/^ ([<>]) / && $1 eq $dirn;
55     die if m/\t/;
56     die unless
57  m/^ [<>] ([01A-Za-z. ]+?)(?:   +|\s+\([+? A-Z0-9a-z]+\)\s+)([^() \t\n].*)$/;
58     $msg= $1; $rhs= $2;
59     next if $rhs =~ m/^\}/;
60     next if $msg =~ m/\.\.\./;
61     $rhs =~ m/^([A-Z]+)\s/ or die "$rhs?";
62     $cname= lc $1;
63     $msg =~ s/ //g;
64     if ($msg =~ m/^0[01]{7}$/) {
65         $opcode= $&;
66         $opcodemask= '11111111';
67         $arglen= 0;
68         $ybit= 0;
69     } else {
70         $ybit= substr($msg,0,8);
71         $ybit =~ y/Y01A-Z/10/;
72         $ybit =~ m/1.*1/ and die "$msg/$ybit?";
73         $msg =~ s/Y/0/g;
74         $msg =~ m/[A-Z]/ or die "$msg?";
75         $oplet= $&;
76         $msg =~ s/$oplet/_/g;
77         die "$msg?" if $msg =~ m/[A-Z]/;
78         die "$msg?" unless $msg =~ m/^(1[01][01_]{6})0_{7}$/ or
79             $msg =~ m/^(0[01][01_]{6})$/;
80         $opcode= $1;
81         die if $opcode =~ m/_[01]/;
82         $opcodemask= $opcode;
83         $opcodemask =~ y/01_/110/;
84         $opcode =~ s/_/0/g;
85         $arglen= $msg;
86         $arglen =~ s/[01]//g;
87         $arglen= length $arglen;
88         $ybit= oct("0b$ybit");
89     }
90     for $yval (($ybit && $doyn) ? (0,1) : '') {
91         undef %v;
92         $v{yn}= $yval;
93         $v{dname}= $dname;
94         $v{cname}= $cname;
95         $v{cnameyn}= $cname.$yval;
96         $v{opcode}= b2xh($opcode, 0);
97         $v{opcodeyn}= b2xh($opcode, $ybit * $yval);
98         $v{opcodemask}= b2xh($opcodemask, 0);
99         $v{opcodemaskyn}= b2xh($opcodemask, $ybit);
100         $v{arglen}= $arglen;
101         $v{arglentf}= sprintf "%d", !!$arglen;
102         expand_and_write();
103     }
104 }
105
106 open T, "$templ" or die "$templ $!";
107 for (;;) {
108     $templlin= <T>;  last unless length $templlin;
109     $templlinno= $.;
110     if ($templlin =~ s/\@L\@//) {
111         $dolinno= 1;
112     }
113     if ($templlin !~ m/\@\w+\@/) {
114         pln($templlin);
115     } elsif ($templlin =~ s/\@1\@//) {
116         undef %v;
117         $v{skeleton}= 'autogenerated - do not edit';
118         expand_and_write();
119     } else {
120         $doyn= $templlin =~ m/\@[a-z]+yn\@/;
121         $templlin =~ s/\@h2p\@/\@dname=host2pic\@/;
122         $templlin =~ s/\@p2h\@/\@dname=pic2host\@/;
123         open S, "$spec" or die "$spec $!";
124         while (<S>) {
125             process_line();
126         }
127         S->error and die $!;
128         close S or die $!;
129     }
130 }
131 T->error and die $!;
132 close T or die $!;