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         $argslen= 0;
  68         $vbits= 0;
  69         $ybit= 0;
  70     } else {
  71         $ybit= substr($msg,0,8);
  72         $ybit =~ y/Y01A-Z/10/;
  73         $ybit =~ m/1.*1/ and die "$msg/$ybit?";
  74         $msg =~ s/Y/0/g;
  75         $msg =~ m/[A-UW-Z]/ or die "$msg?";
  76         $oplet= $&;
  77         $msg =~ s/$oplet/_/g;
  78         die "$msg?" if $msg =~ m/[A-UW-Z]/;
  79         die "$msg?" unless $msg =~ m/^(1[01][01V_]{6})0[V_]{7}$/ or
  80             $msg =~ m/^(0[01][01V_]{6})$/;
  81         $opcode= $1;
  82         die if $opcode =~ m/[V_][01]/;
  83         $opcodemask= $opcode;
  84         $opcodemask =~ y/01V_/1100/;
  85         $opcode =~ s/[V_]/0/g;
  86
  87         $argspat= $msg;
  88         $argspat =~ s/[01]//g;
  89         $argslen= length $argspat;
  90         $argspat =~ m/^_*(V*)$/ or die "$msg/$argspat?";
  91         $vbits= length($1);
  92         $ybit= oct("0b$ybit");
  93     }
  94     for $yval (($ybit && $doyn) ? (0,1) : '') {
  95         undef %v;
  96         $v{yn}= $yval;
  97         $v{dname}= $dname;
  98         $v{cname}= $cname;
  99         $v{noiselevel}=
 100             ($cname =~ m/nmradone/ ? 3 :
 101              $cname =~ m/watchdog/ ? 3 :
 102              $cname =~ m/p[io]ng/ ? 2 :
 103              $cname =~ m/detect/ ? 3 :
 104              0);
 105         $v{cnameyn}= $cname.$yval;
 106         $v{cnameynu}= uc($cname.$yval);
 107         $v{opcode}= b2xh($opcode, 0);
 108         $v{opcodeyn}= b2xh($opcode, $ybit * $yval);
 109         $v{opcodemask}= b2xh($opcodemask, 0);
 110         $v{opcodemaskyn}= b2xh($opcodemask, $ybit);
 111         $v{vlen}= $vbits;
 112         $v{argslen}= $argslen;
 113         $v{arglen}= $argslen - $vbits;
 114         $v{nargs}= sprintf "%d", !!$argslen+!!$vbits;
 115         expand_and_write();
 116     }
 117 }
 118
 119 open T, "$templ" or die "$templ $!";
 120 for (;;) {
 121     $templlin= <T>;  last unless length $templlin;
 122     $templlinno= $.;
 123     if ($templlin =~ s/\@L\@//) {
 124         $dolinno= 1;
 125     }
 126     if ($templlin !~ m/\@\w+\@/) {
 127         pln($templlin);
 128     } elsif ($templlin =~ s/\@1\@//) {
 129         undef %v;
 130         $v{skeleton}= 'autogenerated - do not edit';
 131         expand_and_write();
 132     } else {
 133         $doyn= $templlin =~ m/\@[a-z]+yn\@/;
 134         $templlin =~ s/\@h2p\@/\@dname=host2pic\@/;
 135         $templlin =~ s/\@p2h\@/\@dname=pic2host\@/;
 136         open S, "$spec" or die "$spec $!";
 137         while (<S>) {
 138             process_line();
 139         }
 140         S->error and die $!;
 141         close S or die $!;
 142     }
 143 }
 144 T->error and die $!;
 145 close T or die $!;