sub follow_paths { my ($x_s,$y_s,$s_s,$paths,$regs) = @_; my $branches = $paths->[$x_s][$y_s][$s_s]; unless (defined $branches) { # pad endpoint (base case)} return [[[$x_s,$y_s,$s_s,'pad']]]; } if (exists $regs->{$x_s}{$y_s}{$s_s}) { # register endpoint (base case) return [[[$x_s,$y_s,$s_s,'reg']]]; } my @current; foreach my $branch (@$branches) { my $branch_paths = follow_paths(@$branch,$paths,$regs); push @current, map { unshift @$_, [$x_s,$y_s,$s_s]; $_ } @$branch_paths; } return \@current; } #### regs = 1,0,0 paths = 0,0,0 => 3,0,0 0,1,0 => 0,2,0 1,0,0 => 0,3,0 3,0,0 => 0,1,0 1,0,0 #### [[3,0,0] [0,1,0] [0,2,0,'pad'] ], [[3,0,0] [1,0,0,'reg'] ] #### sub follow_paths_unrolled { my ($x_s,$y_s,$s_s,$paths,$regs) = @_; my $cur_x = $x_s; my $cur_y = $y_s; my $cur_s = $s_s; my $index = 0; my $current = []; my @STACK; my $RETURN; my $BRANCH = 0; NEWCALL: while(1) { my $branches = $paths->[$cur_x][$cur_y][$cur_s]; if (not defined $branches) { # pad endpoint (base case)} $RETURN = [[[$x_s,$y_s,$s_s,'pad']]]; } elsif (exists $regs->{$x_s}{$y_s}{$s_s}) { # register endpoint (base case) $RETURN = [[[$x_s,$y_s,$s_s,'reg']]]; } else { for (my $i=$index; $i < @$branches; $i++) { if ($BRANCH == 0) { my $branch = $branches->[$i]; # push @STACK $BRANCH = 1; push @STACK, [$cur_x,$cur_y,$cur_s,$i,$current,$BRANCH]; # set new values ($cur_x,$cur_y,$cur_s) = @$branch; $index = 0; $current = []; $BRANCH = 0; next NEWCALL; } else { my $branch_paths = $RETURN; push @$current, map { unshift @$_, [$cur_x,$cur_y,$cur_s]; $_ } @$branch_paths; $BRANCH = 0; } } $RETURN = $current; } return $RETURN unless @STACK; ($cur_x,$cur_y,$cur_s,$index,$current,$BRANCH) = @{pop @STACK}; } }