view release on metacpan or  search on metacpan

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

my sub layoutAsFiberBundle($%)                                                  # Layout the gates as a fiber bundle collapsed down to as close to the gates as possible.  The returned information is sufficient to draw an svg image of the fiber bundle...
 {my ($chip, %options) = @_;                                                    # Chip, options
  my %gates   = $chip->gates->%*;                                               # Gates on chip
  my $changed = $options{changed};                                              # Step at which gate last changed in simulation
  my $values  = $options{values};                                               # Values of each gate if known

  my @gates = sort {$gates{$a}->seq <=> $gates{$b}->seq} keys %gates;           # Gates in definition order
  if (my $c = $options{changed})                                                # Order non IO gates by last change time during simulation if possible
   {@gates = sort {($$c{$a}//0) <=> ($$c{$b}//0)} @gates;
   }

  my @fibers;                                                                   # Squares of the page, each of which can either be undefined or contain the name of the fiber crossing it from left to right or up and down
  my @inPlay;                                                                   # Squares of the page in play
  my @positions;                                                                # Position of each gate indexed by position in layout
  my %positions;                                                                # Position of each gate indexed by gate name
  my $width  = 1;                                                               # Width of page consumed so far until it becomes the page width.
  my $height = 0;                                                               # Height of page consumed so far until it becomes the page height

  for my $i(keys @gates)                                                        # Position each gate
   {my $g = $gates{$gates[$i]};                                                 # Gate details
    my $s = $g->type =~ m(\A(input|one|output|zero)\Z);                         # These gates can be positioned without consuming more horizontal space
    my %i = $g->inputs->%*;                                                     # Inputs hash for gate
    my @i = sort keys %i;                                                       # Connections to each gate in pin order
    my $w = $s ? 1 : scalar(@i);                                                # Width of this gate
    my $n = $g->output;                                                         # Name of gate

    my sub color()                                                              # Color of gate
     {return "red"  if $g->io == gateOuterOutput;
      return "blue" if $g->io == gateOuterInput;
      "green"
     }

    my $x = $width; $x-- if $s;                                                 # Position of gate
    my $y = $i;

    my $p = genHash(__PACKAGE__."::GatePosition",
      output      => $g->output,                                                # Gate name
      x           => $x,                                                        # Gate x position
      y           => $y,                                                        # Gate y position
      width       => $w,                                                        # Width of gate
      fiber       => 0,                                                         # Number of fibers running past this gate
      position    => $i,                                                        # Number of fibers running past this gate
      type        => $g->type,                                                  # Type of gate
      value       => $$values {$g->output},                                     # Value of gate if known
      changed     => $$changed{$g->output},                                     # Last change time of gate if known
      inputs      => [map {$i{$_}}       @i],                                   # Names of gates driving input pins on this gate
      inputValues => [map {$$values{$i{$_}}} @i],                               # Values on input pins if known
      color       => color,                                                     # Color of gate
      inPin       => $g->io == gateOuterInput,                                  # Input pin for  chip
      outPin      => $g->io == gateOuterOutput,                                 # Output pin for  chip
     );

    $positions[$i] = $p;  $positions{$p->output} = $p;                          # Index the gates
    $width += $w unless $s;                                                     # Io gates are tucked in in such way that they do not contribute to the width
    $height++    unless $g->io == gateOuterOutput;                              # Output gates do not contribute to the height of the mask
   }

  for my $i(keys @positions)                                                    # Position output pins along bottom of mask
   {my $p = $positions[$i];
    next unless $p->outPin;
    my ($D) = $p->inputs->@*;                                                   # An output gate only has one input so we can safe relocate it next to the single gate that produces that output
    my  $d  = $positions{$D};                                                   # Driving gate
    $p->x = $d->x - 1;                                                          # Reposition output gate
    $p->y = $d->y;
   }

  for my $p(@positions)                                                         # Connect gates loosely
   {my $g = $gates{$p->output};                                                 # Detail for this gate
    my @i = $p->inputs->@*;                                                     # Connections to each gate
    for my $i(keys @i)                                                          # Connections to each gate
     {my $D = $i[$i];                                                           # Driving gate name
      my $d = $positions{$D};                                                   # Driving gate position
      my $X = $p->x+$i;                                                         # X position of input pin to gate
      my $Y = $p->y;                                                            # Y position of input pin to gate
      $fibers[$_][$d->y][0] = $D for $d->x+$d->width..$X;                       # Horizontal line
      $fibers[$X][$_]   [1] = $D for $d->y..$Y-1;                               # Vertical line
      if (!$g->io)                                                              # Mark column as in play
       {for my $j(0..$Y-1)
         {$inPlay[$X][$j] = 1;
         }
       }
     }
   }

  my sub collapseFibers()                                                       # Perform one collapse pass of the fibers returning the number of collapses performed
   {my $changes = 0;                                                            # Number of changes made in this pass

    my sub removeOrphans($)                                                     # Remove any vertical orphans in the specified column
     {my ($i) = @_;                                                             # Column to check
      for my $j(keys $fibers[$i]->@*)
       {my $h = $fibers[$i][$j][0];                                             # Horizontal line
        my $v = $fibers[$i][$j][1];                                             # Vertical line
        last if defined($h) and defined($v) and $h eq $v;                       # Found the vertical so we can stop
        $fibers[$i][$j][1] = undef;                                             # Remove vertical as it never meets a corresponding horizontal and so is of no use
       }
     }

    for my $i(keys @fibers)                                                     # Examine each cell for a corner that we can collapse either left or down
     {for my $j(keys $fibers[$i]->@*)
       {my sub i() {$i}
        my sub j() {$j}
        my sub h($$) :lvalue {my ($i, $j) = @_; return undef unless $i >= 0 and $j >= 0 and $inPlay[$i][$j]; $fibers[$i][$j][0]} # A horizontal element relative to the current corner
        my sub v($$) :lvalue {my ($i, $j) = @_; return undef unless $i >= 0 and $j >= 0 and $inPlay[$i][$j]; $fibers[$i][$j][1]} # A vertical   element relative to the current corner

        my $a = h(i-1, j+0); my sub a() {$a}
        my $b = h(i+0, j+0);
        my $B = v(i+0, j+0);
        my $C = v(i+0, j+1);
        my $D = v(i+0, j-1);
        my $e = h(i+1, j+0);
        next unless defined($a) and defined($b) and defined($B) and defined($C);# Possible corner
        next unless $a eq $b and $b eq $B and $B eq $C;                         # Confirm corner
        next if defined($D) and $D eq $a;                                       # If it is a corner it points north east.
        next if defined($e) and $e eq $a;                                       # If it is a corner it points north east.

        my $wentLeft;                                                           # If we collapsed left we made a change and so need to come around again before attempting to collapse down
        if (1)                                                                  # Collapse left
         {my $k; my sub k() :lvalue {$k}                                        # Position of new corner going left
          for my $I(reverse 0..i-1)                                             # Look for an opposite corner
           {last if $j+2 >= $fibers[$I]->$#*;
            last   unless defined(h($I, j)) and h($I, j) eq $a;                 # Make sure horizontal is occupied with expected bus line