#!/usr/bin/perl
# bfi.pl - Don Yang (uguu.org)
#
# BF interpretor, infinite tape.
#
# Usage:
#
#   bfi [BF program] [BF stdin] [BF stdout]
#
#   Argument count:   BF program  stdin       stdout
#   0                 stdin       unavailable stdout
#   1                 arg1        stdin       stdout
#   2                 arg1        arg2        stdout
#   3                 arg1        arg2        arg3
#
# For any program and any given input, interpretor will try to detect
# infinite loops, and terminate program early.
#
#  - Chances of false positives are as low as chances for MD5
#    collisions.
#
#  - Chances of missed infinite loops depends on sanity of the
#    programmer, "+[>+]" is easily an undetected infinite loop.  Hard
#    to detect those with an infinite data tape, though the
#    interpretor should eventually crash (run out of core) with those
#    programs.
#
# "We all know Linux is great... it does infinite loops in 5 seconds."
#  - Linus Torvalds
#
# 09/06/04


use strict;
use Digest::MD5 qw(md5);
my (@Opcode, @Operand, %Loop, $CodeSize, @Data);


sub LoadBF
{
   local (*INFILE);
   my ($op, $lastop, $line, $l);
   my (@loopstack);

   open INFILE, (($#ARGV > -1) ? "< $ARGV[0]" : "<&STDIN") or die $!;

   $CodeSize = 0;
   @Opcode = ();
   @Operand = ();
   @Data = ();
   @loopstack = ();
   $lastop = undef;
   while( $line = <INFILE> )
   {
      foreach $op (unpack "C*", $line)
      {
         $CodeSize++;
         $op = chr $op;
         if( $op eq '+' || $op eq '-' || $op eq '<' || $op eq '>' )
         {
            if( $op eq $lastop )
            {
               $Operand[$#Operand]++;
            }
            else
            {
               push @Opcode, $op;
               push @Operand, 1;
               $lastop = $op;
            }
         }
         elsif( $op eq '.' )
         {
            push @Opcode, $op;
            push @Operand, 1;
            $lastop = undef;
         }
         elsif( $op eq ',' )
         {
            push @Opcode, $op;
            push @Operand, 1;
            $lastop = undef;
         }
         elsif( $op eq '[' )
         {
            push @Opcode, $op;
            push @Operand, 1;
            push @loopstack, $#Opcode;
            $lastop = undef;
         }
         elsif( $op eq ']' )
         {
            die "[] unbalanced\n" if( $#loopstack < 0 );
            push @Opcode, $op;
            push @Operand, 1;
            $l = pop @loopstack;
            $Loop{$l} = $#Opcode;
            $Loop{$#Opcode} = $l - 1;
            $lastop = undef;
            if( $Opcode[$#Opcode - 1] eq '-' &&
                $Opcode[$#Opcode - 2] eq '[' )
            {
               pop @Opcode;   pop @Operand;
               pop @Opcode;   pop @Operand;
               $Opcode[$#Opcode] = '0';
            }
         }
         else
         {
            $CodeSize--;
         }
      }
   }
   close INFILE;
   die "[] unbalanced\n" if( $#loopstack != -1 );
}

sub RunBF
{
   my ($x, $c, $i, %state);
   local (*INPUT, *OUTPUT);

   open INPUT, (($#ARGV > 0) ? "< $ARGV[1]" : "<&STDIN") or die $!;
   open OUTPUT, (($#ARGV > 1) ? "> $ARGV[2]" : ">&STDOUT") or die $!;
   for($c = $x = 0; $c <= $#Opcode; $c++)
   {
      $i = $Opcode[$c];
      if( $i eq '+' )
      {
         $Data[$x] += $Operand[$c];
      }
      elsif( $i eq '-' )
      {
         $Data[$x] -= $Operand[$c];
      }
      elsif( $i eq '<' )
      {
         if( ($x -= $Operand[$c]) < 0 )
         {
            print "past left end of data tape\n";
            last;
         }
      }
      elsif( $i eq '>' )
      {
         $x += $Operand[$c];
      }
      elsif( $i eq '[' )
      {
         if( $Data[$x] == 0 )
         {
            $c = $Loop{$c};
         }
         else
         {
            $i = md5($x, @Data);
            if( $state{$c}{$i}++ )
            {
               print "infinite loop detected\n";
               last;
            }
         }
      }
      elsif( $i eq ']' )
      {
         $c = $Loop{$c};
      }
      elsif( $i eq '0' )
      {
         $Data[$x] = 0;
      }
      elsif( $i eq '.' )
      {
         print OUTPUT chr $Data[$x];
      }
      else
      {
         if( defined ($i = getc INPUT) )
         {
            $Data[$x] = ord $i;
            %state = ();
         }
         else
         {
            $Data[$x] = -1;
         }
      }
   }

   close INPUT;
   close OUTPUT;
}

sub DumpParseTree
{
   my ($index, $depth, $indent);

   $indent = "   ";
   for($index = $depth = 0; $index <= $#Opcode; $index++)
   {
      if( $Opcode[$index] eq '[' )
      {
         print (($indent x $depth++), "[\n");
      }
      elsif( $Opcode[$index] eq ']' )
      {
         print (($indent x --$depth), "]\n");
      }
      elsif( $Opcode[$index] eq ',' || $Opcode[$index] eq '.' ||
             $Opcode[$index] eq '0' )
      {
         print (($indent x $depth), $Opcode[$index], "\n");
      }
      else
      {
         print +(($indent x $depth), $Opcode[$index], " * ",
                                     $Operand[$index], "\n");
      }
   }
}

LoadBF();
#DumpParseTree();
RunBF();
print STDERR "code = ", $#Opcode + 1, "/$CodeSize, data = ", $#Data + 1, "\n";