view release on metacpan or  search on metacpan

lib/Silicon/Chip.pm  view on Meta::CPAN

       }
     }

    my @hc = (stroke => "darkgreen", stroke_width => Fw);                       # Horizontal line color
    my @vc = (stroke => "darkgreen", stroke_width => Fw);                       # Vertical   line color

    for my $i(keys @f)                                                          # Draw horizontal and vertical bars with a minimal number of lines otherwise the svg files get very big
     {for my $j(keys $f[$i]->@*)
       {if (defined(my $h = $H[$i][$j]))                                        # Horizontal
         {my $e = $i;
          for my $I($i..$#f)                                                    # Go as far right as possible
           {my $H = \$H[$I][$j];
            last unless $$H and $$H eq $h;                                      # Still in line
            $$H = undef;                                                        # Erase line as no longer needed
            $e  = $I;                                                           # Current known end of the line
           }
          $svg->line(x1=>$i, y1=>$j+1/2, x2=>$e+1, y2=>$j+1/2, @hc);            # Draw horizontal line
         }
        if (defined(my $v = $V[$i][$j]))                                        # Vertical
         {my $e = $j;
          for my $J($j..$f[$i]->$#*)                                            # Go as far down as possible
           {my $V = \$V[$i][$J];
            last unless $$V and $$V eq $v;                                      # Still in line
            $$V = undef;                                                        # Erase line as no longer needed
            $e  = $J;                                                           # Current known end of the line
           }
          $svg->line(x1=>$i+1/2, y1=>$j, x2=>$i+1/2, y2=>$e+1, @vc);            # Draw vertical line
         }
       }
     }
   }

  my $t = $svg->print;                                                          # Text of svg
  my $f = $options{svg};                                                        # Svg file
  return owf(fpe($f, q(svg)), $t) if $f;                                        # Draw bundle as an svg drawing
  $t
 }

my %drawMask;                                                                   # Track masks drawn so we can complain about duplicates

my sub drawMask($%)                                                             # Draw a mask for the gates.
 {my ($chip, %options) = @_;                                                    # Chip, options
  my $s = $options{svg};
  $drawMask{$s}++ and confess <<"END" =~ s/\n(.)/ $1/gsr;                       # Complain about duplicate mask names
Duplicate mask name: $s specified
END
  my $layout = layoutAsFiberBundle($chip, %options);                            # Gates on chip
     $layout->draw(%options);                                                   # Draw mask
 }

#D1 Basic Circuits                                                              # Some well known basic circuits.

sub n(*$)                                                                       # Gate name from single index.
 {my ($c, $i) = @_;                                                             # Gate name, bit number
  !@_ or !ref($_[0]) or confess <<"END";
Call as a sub not as a method
END
  "${c}_$i"
 }

sub nn(*$$)                                                                     # Gate name from double index.
 {my ($c, $i, $j) = @_;                                                         # Gate name, word number, bit number
  !@_ or !ref($_[0]) or confess confess <<"END";
Call as a sub not as a method
END
 "${c}_${i}_$j"
 }

#D2 Comparisons                                                                 # Compare unsigned binary integers of specified bit widths.

sub compareEq($$$$%)                                                            # Compare two unsigned binary integers of a specified width returning B<1> if they are equal else B<0>.
 {my ($chip, $output, $a, $b, %options) = @_;                                   # Chip, name of component also the output bus, first integer, second integer, options
  @_ >= 4 or confess "Four or more parameters";
  my $o  = $output;
  my $A = sizeBits($chip, $a);
  my $B = sizeBits($chip, $b);
  $A == $B or confess <<"END" =~ s/\n(.)/ $1/gsr;
Input $a has width $A but input $b has width $B
END
  $chip->nxor(n("$o.e", $_), n($a, $_), n($b, $_)) for 1..$B;                   # Test each bit pair for equality
  $chip->andBits($o, "$o.e", bits=>$B);                                         # All bits must be equal

  $chip
 }

sub compareGt($$$$%)                                                            # Compare two unsigned binary integers and return B<1> if the first integer is more than B<b> else B<0>.
 {my ($chip, $output, $a, $b, %options) = @_;                                   # Chip, name of component also the output bus, first integer, second integer, options
  @_ >= 4 or confess "Four or more parameters";
  my $o  = $output;
  my $A = sizeBits($chip, $a);
  my $B = sizeBits($chip, $b);
  $A == $B or confess <<"END" =~ s/\n(.)/ $1/gsr;
Input $a has width $A but input $b has width $B
END
  $chip->nxor (n("$o.e", $_), n($a, $_), n($b, $_)) for 2..$B;                  # Test all but the lowest bit pair for equality
  $chip->gt   (n("$o.g", $_), n($a, $_), n($b, $_)) for 1..$B;                  # Test each bit pair for more than

  for my $b(2..$B)                                                              # More than on one bit and all preceding bits are equal
   {$chip->and(n("$o.c", $b),
     {(map {$_=>n("$o.e", $_)} $b..$B), ($b-1)=>n("$o.g", $b-1)});
   }

  $chip->or   ($o, {$B=>n("$o.g", $B),  (map {($_-1)=>n("$o.c", $_)} 2..$B)});  # Any set bit indicates that B<a> is more than B<b>

  $chip
 }

sub compareLt($$$$%)                                                            # Compare two unsigned binary integers B<a>, B<b> of a specified width. Output B<out> is B<1> if B<a> is less than B<b> else B<0>.
 {my ($chip, $output, $a, $b, %options) = @_;                                   # Chip, name of component also the output bus, first integer, second integer, options
  @_ >= 4 or confess "Four or more parameters";

  my $A = sizeBits($chip, $a);
  my $B = sizeBits($chip, $b);
  $A == $B or confess <<"END" =~ s/\n(.)/ $1/gsr;
Input $a has width $A but input $b has width $B
END

  my $o = $output;

  $chip->nxor (n("$o.e", $_), n($a, $_), n($b, $_)) for 2..$B;                  # Test all but the lowest bit pair for equality
  $chip->lt   (n("$o.l", $_), n($a, $_), n($b, $_)) for 1..$B;                  # Test each bit pair for less than