pcb/netlist-expand

   1 #!/usr/bin/perl
   2
   3 # script for expanding condensed netlist format
   4
   5 # Syntax:
   6 #
   7 # netspec Type CHIP-pin ...
   8 #
   9 # CHIP npins ...pin-spec-item...
  10 #            ...pin-spec-item...
  11 #   defines some pins from CHIP which has pins 1..npins
  12 #
  13 # minline-maxline/perchip CHIP pins ...pin-spec-item...
  14 #                                   ...pin-spec-item...
  15 #   Defines some pins from several chips.  See assignpins_multi comment.
  16 #
  17 # !PIC picpinlist
  18 #   Defines PIC pins - see assignpicpins
  19 #
  20 # !type Type ...netspec/netrange...
  21 #            ...netspec/netrange...   [see below for netrange]
  22
  23
  24 # CHIP is [A-Z][A-Z0-9]*
  25 #
  26 # netspec is net[,net]* and indicates that all the nets are aliases for same
  27 #   net even if not mentioned together anywhere else
  28 #
  29 # net is [a-z][a-z0-9_]*
  30 #
  31 # pin-spec-item is one of
  32 #
  33 #      netspec       assigns next pin to netspec
  34 #
  35 #      net{ fornet }{ usegate }
  36 #                    remapping specification:
  37 #                    every time net\d+ would be assigned instead,
  38 #                    this remapping table is consulted.  fornet
  39 #                    and usegate are lists of net assignments or
  40 #                    just digits (which are taken to mean net\d+);
  41 #                    they must be of equal length and will be taken
  42 #                    pairwise as instructions that each time an entry in
  43 #                    usegate is to be assigned, the corresponding entry
  44 #                    from fornet will be used instead.
  45 #
  46 #      net\d+..\d+   netrange: specifies sequentially named nets
  47 #                    nets will be net\d+ where numbers will go from first
  48 #                    \d+ to 2nd \d+ in pin-spec-item inclusive (whether
  49 #                    up or down)
  50 #
  51 #      pin           asserts that next pin number to assign would be pin
  52 #
  53 #      :start[step][%jump/modulo][,number,:start[step]...]
  54 #                    specifies that the next pin to assign will be start,
  55 #                    and what the following pin will be to assign, and so
  56 #                    on in arithmetic sequence indefinitely until the
  57 #                    next :start[... etc.
  58 #                      start can be pin (meaning to start with pin)
  59 #                            or -backpin meaning to start with npins-backpin
  60 #                      step can be + or - to indicate +1 or -1 or
  61 #                            a possibly negative number
  62 #                      %jump/modulo means don't generate a simple
  63 #                            arithmetic sequence; instead, generate
  64 #                            modulo arithmetic sequences starting at
  65 #                            start, start+jump, ... start+(modulo-1)*jump
  66 #                            and then interleave the sequences to
  67 #                            generate the sequence of pins to assign
  68 #                      :number:start...
  69 #                            means to assign only number pins in this
  70 #                            way and then to start with a new (set of)
  71 #                            sequences as defined by :start etc.
  72 #      : stuff things etc ... :
  73 #                    is as if you wrote   :stuff:things:etc...
  74
  75 die if $ARGV[0] =~ m/^\-/;
  76
  77 sub o ($$$) {
  78     my ($netname, $type, $stuff) = @_;
  79     print "# o $netname $type $stuff\n" or die $!;
  80     if (length $type && exists $net{$netname}{Type}) {
  81         die "$netname $type" if $net{$netname}{Type} ne $type;
  82     }
  83     $net{$netname}{Stuff}.= " ".$stuff;
  84     $net{$netname}{Type}= $type if length $type;
  85 }
  86
  87 sub expand_netranges (@) {
  88     my (@in) = @_;
  89     local ($_);
  90     my (@expanded) = ();
  91     foreach $_ (@in) {
  92         if (m/^(\w*[A-Za-z])(\d+)\.\.(\d+)$/) {
  93             my ($base,$start,$end)=($1,$2,$3);
  94             my ($step)= $start<=$end ? 1 : -1;
  95             for ($i=$start; $i!=$end+$step; $i+=$step) {
  96                 push @expanded, $base.$i;
  97             }
  98         } elsif (m/^(\w+)\*(\d+)/) {
  99             my ($base,$end)=($1,$2);
 100             die unless $end >= 1;
 101             for ($i=1; $i<=$end; $i++) {
 102                 push @expanded, $base;
 103             }
 104         } else {
 105             push @expanded, $_;
 106         }
 107     }
 108     return @expanded;
 109 }
 110
 111 sub unpack_iter_list ($$@) {
 112     my ($max,$options,@in) = @_;
 113     # options: zero or more characters from
 114     #     r   allow several occurrences of same pin number
 115     #     p   allow only partial specification
 116     #     o   return array of pins (first entry is undef) in order
 117     #           instead of array of  { Pin =>, Action => }
 118     my (@expanded, @done, @out);
 119     my ($i);
 120     local ($_);
 121
 122     @expanded= expand_netranges(@in);
 123
 124     my $start= 1;
 125     my $step= 1;
 126     my $jump= 0;
 127     my $modulo= '';
 128     my $counter= 0;
 129     my $limitcounter= '';
 130     my ($usepin, $remainder, $quotient, $afterlimit);
 131     my (@toprocess) = @expanded;
 132     my (%gatemap);
 133     while (@toprocess) {
 134         $_= shift @toprocess;
 135         if (!length $modulo) {
 136             $remainder= 0;
 137             $quotient= $counter;
 138         } else {
 139             $remainder= $counter % $modulo;
 140             $quotient= ($counter-$remainder) / $modulo;
 141         }
 142         $usepin=
 143             ($start +
 144              $step * $quotient +
 145              $jump * $remainder);
 146         if (m/^(\w+)\{$/) {
 147             my ($netbase) = $1;
 148             my (@fornet,@usegate,$i);
 149             my ($current) = \@fornet;
 150             for (;;) {
 151                 die unless @toprocess;
 152                 $_= shift @toprocess;
 153                 if (m/^\}\{$/) {
 154                     die unless $current==\@fornet;
 155                     $current= \@usegate;
 156                 } elsif (m/^\}$/) {
 157                     die unless $current==\@usegate;
 158                     last;
 159                 } elsif (m/^(?:[a-z]\w*|\-)$/) {
 160                     push @$current, $&;
 161                 } elsif (m/^\d+$/) {
 162                     push @$current, $netbase.$&;
 163                 } else {
 164                     die "$_ (@in) (@expanded)";
 165                 }
 166             }
 167             die "(@fornet) (@usegate (@in) (@expanded)"
 168                 unless @fornet == @usegate;
 169             for ($i=0; $i<@fornet; $i++) {
 170                 $gatemap{$fornet[$i]}= $usegate[$i];
 171             }
 172         } elsif (m/^\d+$/) {
 173             die "$_ != $usepin $max (@in) (@expanded)"
 174                 if $usepin ne $&;
 175         } elsif (
 176  m/^\:(\-?)(\d+)(?:([-+]\d+)|([-+])|)(?:\%(\-?\d+)\/(\d+))?(?:\:(\d+)\:(.*))?$/
 177                  ) {
 178             my ($back,$base,$stepval,$sign)=($1,$2,$3,$4);
 179             ($jump,$modulo,$limitcounter,$afterlimit)=($5,$6,$7,$8);
 180             $start= length $back ? $max-$base : $base;
 181             $step= length $stepval ? $stepval : length $sign ? $sign.'1' : 1;
 182             $counter= 0;
 183         } elsif (m/^\:$/) {
 184             my ($accum) = '';
 185             for (;;) {
 186                 die "end (@in) (@expanded)" unless @toprocess;
 187                 $_= shift @toprocess;
 188                 last if m/^\:$/ && length $accum;
 189                 die "$_ (@in) (@expanded)" if m/\:/;
 190                 $accum .= ':'.$_;
 191             }
 192             unshift @toprocess, $accum;
 193         } elsif (m/^\:/) {
 194             die "$_ (@in) (@expanded)";
 195         } else {
 196             if ($_ ne '-') {
 197                 die "$usepin<1 $_ $max (@in) (@expanded)"
 198                     if $usepin < 1;
 199                 die "$usepin>$max $_ $max (@in) (@expanded)"
 200                     if $usepin > $max;
 201                 die "already $done[$usepin] $_ $max (@in) (@expanded)"
 202                     if ($options !~ m/r/) && defined $done[$usepin];
 203                 $_= $gatemap{$_} if exists $gatemap{$_};
 204                 push @out, { Pin => $usepin, Action => $_ };
 205                 $done[$usepin]= $_;
 206             }
 207             $counter++;
 208             if (length $limitcounter && $counter == $limitcounter) {
 209                 unshift @toprocess, ":$afterlimit";
 210             }
 211         }
 212     }
 213     if ($options !~ m/p/) {
 214         for ($i=1; $i<$max; $i++) {
 215             die "$i missing $max (@in) (@expanded)" unless defined $done[$i];
 216         }
 217     }
 218     print "# uil $max $options $max (@in) => (@done)\n";
 219     return ($options =~ m/o/) ? @done : @out;
 220 }
 221
 222 sub definepicpins (@) {
 223     die if defined $numpicpins;
 224     die unless @_;
 225     $numpicpins = shift @_;
 226     my (@l) = unpack_iter_list($numpicpins,'o',@_);
 227     my ($i);
 228     local ($_);
 229     for ($i=1; $i<@l; $i++) {
 230         $_= $l[$i];
 231         if (m/^[A-Z]/) {
 232             die "$_ repeated" if exists $picport2pin{$_};
 233             $picpin2port{$i}= $_;
 234             $pinport2pin{$_}= $i;
 235         } else {
 236             $picpin2port{$i}= $_;
 237             o($_,'',"PIC-$i");
 238         }
 239     }
 240 }
 241
 242 sub assignpicpins (@) {
 243     die unless defined $numpicpins;
 244     my (@l) = unpack_iter_list($numpicpins,'o',@_);
 245     my ($i, $port);
 246     for ($i=1; $i<@l; $i++) {
 247         $_= $l[$i];
 248         $port= exists $picpin2port{$i} ? $picpin2port{$i} : '';
 249         if ($port =~ m/^[a-z]/) {
 250             die "$i $_ $port" unless $port eq $_;
 251         } else {
 252             o($_,'',"PIC-$i");
 253         }
 254     }
 255 }
 256
 257 sub assignpins (@) {
 258     my ($name,$pins,@il) = @_;
 259     my ($e);
 260     foreach $e (unpack_iter_list($pins,'p',@il)) {
 261         o($e->{Action},'',$name.'-'.$e->{Pin});
 262     }
 263 }
 264
 265 sub assignpins_multi ($$@) {
 266     # Args are  linemin linemax linesperchip  and a list like for assignpins
 267     # assignpins is done several times to handle all of the lines.
 268     # Each iteration (aka `chip') handles (up to) linesperchip
 269     # lines, starting at linemin for the first chip.  The last
 270     # chip may be partial.
 271     # List may contain extra characters, which are substituted:
 272     #   @      chip number (starts at 0)
 273     #   &      lines handled by this chip (linesperchip except for last chip)
 274     #   <      first line handled by this chip
 275     #   >      last line handled by this chip
 276     #   X@@Y   X for all `full' chips, Y for any incomplete chip
 277     my ($line_min, $line_max, $perchip, @il) = @_;
 278     my ($chipno, $line_low, $line_high, $linesthischip, @ol, $full_chip);
 279     print "# m $line_min $line_max $perchip (@il)\n";
 280     for ($chipno=0;
 281          ($line_low = $line_min + $perchip*$chipno) <= $line_max;
 282          $chipno++) {
 283         $line_high= $line_low + $perchip-1;
 284         $full_chip= $line_high <= $line_max;
 285         $line_high= $line_max if !$full_chip;
 286         $linesthischip= $line_high - $line_low + 1;
 287         @ol= @il;
 288         map {
 289             s/^(.*)\=\=(.*)$/ $full_chip ? $1 : $2 /ge;
 290             s/\=/ $chipno /ge;
 291             s/\</ $line_low /ge;
 292             s/\>/ $line_high /ge;
 293             s/\&/ $linesthischip /ge;
 294             $_;
 295         } @ol;
 296         print "# m$chipno (@ol)\n";
 297         assignpins(@ol);
 298     }
 299 }
 300
 301 sub data_fin () {
 302     return if !length $data_accum;
 303     local ($_);
 304     my (@s) = split /\s+/, $data_accum;
 305     if ($data_accum =~ s,^(\d+)\-(\d+)/(\d+)\s+,,) {
 306         @s= split /\s+/, $data_accum;
 307         assignpins_multi($1,$2,$3, @s);
 308     } elsif ($data_accum =~ m/^\!PIC\-ASSIGN\s/) {
 309         shift @s;
 310         assignpicpins(@s);
 311     } elsif ($data_accum =~ m/^\!PIC\-DEFINE\s/) {
 312         shift @s;
 313         definepicpins(@s);
 314     } elsif ($data_accum =~ m/^\!type\s+[A-Z]\w+\s+/) {
 315         shift @s;
 316         my ($type) = shift @s;
 317         map { o($_,$type,''); } expand_netranges(@s);
 318     } elsif ($data_accum =~ m/^\!/) {
 319         die "bad directive $data_accum";
 320     } else {
 321         assignpins(@s);
 322     }
 323     undef $data_accum;
 324 }
 325
 326 while (<>) {
 327     next if m/^\#/;
 328     next unless m/\S/;
 329     chomp;
 330     s/\s+$//;
 331     if (s/^\s+//) {
 332         die unless length $data_accum;
 333         $data_accum .= " ".$_;
 334         next;
 335     }
 336     data_fin();
 337     if (m/^([a-z]\S+)\s+(\S+)(\s+(\S.*\S))?$/) {
 338         o($1,$2,$3);
 339     } elsif (m/^\!/ || m/^[A-Z].*/ || m,^\d+\-\d+/\d+\s+[A-Z],) {
 340         $data_accum= $_;
 341     } else {
 342         die "$_ ?";
 343     }
 344 }
 345 data_fin();
 346
 347 # Firstly, assemble
 348 #   $othernames{$sn}{$sn2}=1 iff $sn and $sn2 are mentioned together
 349 # by iterating over all composite names, and then for each sn
 350 # in the composite name, to find (at least once) every sn ever
 351 # mentioned ...
 352 foreach $compname (keys %net) {
 353     foreach $sn (split /\,/, $compname) { # at least once for any $sn
 354         next if exists $othernames{$sn}; # already done ?
 355         $othernames{$sn}= { };
 356         # now look for all names mentioned together with $sn
 357         foreach $compname2 (keys %net) {
 358             # search all composite names ...
 359             @sns2= split /\,/, $compname2; # ... whose mentions ...
 360             next unless grep { $_ eq $sn } @sns2; # ... include $sn ...
 361             map { $othernames{$sn}{$_}=1; } @sns2; # ... recording mentions.
 362         }
 363     }
 364 }
 365
 366 sub add_other_sn($$$) {
 367     my ($stack,$me,$ofthis) = @_;
 368     my (@others,$other);
 369     return if $othernames{$me}{$ofthis} == 2;
 370     $othernames{$me}{$ofthis}= 2;
 371     @others= keys %{ $othernames{$me} };
 372     print "# tc $stack (@others)\n";
 373     foreach $other (@others) {
 374         add_other_sn($stack.">$other",$me,$other);
 375         add_other_sn($stack."<$other",$other,$me);
 376     }
 377 }
 378
 379 # Now compute the transitive closure of %othernames
 380 foreach $sn (keys %othernames) {
 381     add_other_sn($sn,$sn,$sn);
 382 }
 383
 384 # Process each net exactly once.  We go through the singlenames
 385 # and process each singlename if it's the lexically least singlename
 386 # for that net.
 387 foreach $sn (keys %othernames) {
 388     @sns= sort { $a cmp $b } keys %{ $othernames{$sn} }; # singlenames in order
 389     next unless $sns[0] eq $sn; # is this the lexcially least ?
 390     $canon= join '__', @sns;
 391     undef $type;
 392     $stuff= '';
 393     foreach $compname (keys %net) {
 394         @sns2= split /\,/, $compname;
 395         print "# snq $sn $canon $compname (@sns2)\n";
 396         next unless exists $othernames{$sn}{$sns2[0]};
 397         print "# sna $sn $canon $compname ($net{$compname}{Stuff})\n";
 398         if (!exists $net{$compname}{Type}) {
 399         } elsif (!defined $type) {
 400             $type= $net{$compname}{Type};
 401         } elsif ($type ne $net{$compname}{Type}) {
 402             die "$compname $canon $type $net{$ccompname}{Type}";
 403         }
 404         $stuff .= $net{$compname}{Stuff};
 405     }
 406     print "# snr $sn $canon $type (@sns) ($stuff)\n";
 407     map {
 408         if (length) {
 409             $pinuse{$_}++;
 410             m/\-/ or die "$_ ?";
 411             $chipuse{$`}++;
 412         }
 413     } split /\s+/, $stuff;
 414     $type= 'Signal' if !defined $type;
 415     $propernet{$canon}{Type}= $type;
 416     $propernet{$canon}{Stuff}= $stuff;
 417 }
 418
 419 foreach $pinuse (sort keys %pinuse) {
 420     print "# pin $pinuse $pinuse{$pinuse}\n";
 421 }
 422 foreach $chipuse (sort keys %chipuse) {
 423     print "# chip $chipuse $chipuse{$chipuse}\n";
 424 }
 425
 426 foreach $canon (sort keys %propernet) {
 427     @stuff= sort { $a cmp $b } split /\s+/, $propernet{$canon}{Stuff};
 428     $output= sprintf("%s\t%s\t%s\n",
 429                      $canon,
 430                      $propernet{$canon}{Type},
 431                      join ' ', @stuff);
 432     while ($output =~ m/.{80,}/m) {
 433         $lhs= $`;
 434         $rhs= $';
 435         $mid= $&;
 436         $mid =~ s/^(.{1,60})[\t ]/$1\\\n\t\t/m
 437             or die "overlong $output ($lhs|$mid|$rhs)";
 438         $output = $lhs.$mid.$rhs;
 439     }
 440     print $output
 441         or die $!;
 442 }