my @A #list A
= (    #init:
    0, #assignment call
    0,0,1,5, # R[0] = 5
    0, #assign
    3,0,1,1, # R[3] = 1
    0, #assign
    4,0,1,1, # R[4] = 1
 
    2, #Flow call
    3000, #iterations --> that's lots of numbers!
    4, #number of function calls (those four assignment calls followin
+g...)
    1000, #skipto effectively ends the program when this is done
    
    0,1,1, #condition statement. returns a '1' which is "true"

    0, #assignment
    1,   1, 1,1, 2,0, 1, #R[1] = R[0] - 1
    0, #assignment
    2,   1, 1,2, 2,0, 1, #R[2] = R[0] - 2
    0, #assignment
    -.1, 1, 2,-1, 2,-2, 0, #R[R[0]] = R[R[2]] + R[R[1]]
    0, #assignment
    0, 1, 2,0, 1,1, 0, #R[0] = R[0] +1

);
[download]

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;





my @R = qw//;
my @A = (
    #init:
    0, #asn
    0,0,1,5,
    0,
    3,0,1,1,
    0,
    4,0,1,1,

    2, #Flow()
    3000, #iterations
    4, #num events
    1000, #skipto
    
    0,1,1,

    0,
    1,   1, 1,1, 2,0, 1,
    0,
    2,   1, 1,2, 2,0, 1,
    0,
    -.1, 1, 2,-1, 2,-2, 0, 
    0,
    0, 1, 2,0, 1,1, 0,



);
    
    



my $ptr = 0;

my $limit = 10000; #kill infinite loops etc.


while (1){
    event();
}

sub event {
    $limit--;
    dump_("LIMIT REACHED") unless $limit;
    my ($choice) = access_A();

    $choice = $choice%3;
    if ($choice == 0) {
        assignment()
    }
    if ($choice == 1){
        go()
    }
    if ($choice == 2){
        flow()

    }
}


sub dump_{

    my $debug = shift;
    print map{$_,"|"}@R;
    print "\ndump_ message is $debug\n";
    die;
}



sub access_A    {

    my $value;
    my $no_R = shift; #if this has a value, then we do not convert neg
+ative numbers from A to R references. This is needed for expressions.
    my $int = shift;

    defined $A[$ptr]?
        $value = $A[$ptr]:
        dump_('end');

    $ptr++;     
    
    unless ($no_R){

        $value =$R [abs($value)] if $value < 0; #to get to R[0] this w
+ay, use -.1 or some similar value


    }
    $value = int($value) if $int;
    return ($value);
}

sub access_R{
    my $ref = shift;
    my $value;
    (defined $R[$ref])?
        ($value = $R[$ref]):
        ($value = 0);

    $value
}


sub flow{

    #    iterations give us if() for() and while() loops all in one.
    #    iterations = 0 gives us a while from the conditional
    #    iterations = 1 gives us an if from conditional
    #    iterations = >1 gives us a for loop from conditional. 
    #        with a conditional of (1) (like while (1)) you end
    #        up with a classic for loop
    #
    #
    #
    my $iterations = access_A(0,'int');
    my $num_events = access_A(0,'int');
    $num_events = 1 unless $num_events;
    my $skipto = access_A(0,'int');
    $skipto += $ptr;
    my $conditional_ptr = $ptr;


    if ($iterations){
        for (1 .. $iterations){
            if (conditional()){

                for (1 .. $num_events){event()}
            }else{last}

            $ptr = $conditional_ptr;
        }
    }else{
        while (conditional()){
            for (1 .. $num_events){event()}
            $ptr = $conditional_ptr;
        }
    }

    $ptr = $skipto;
}





sub conditional{

    my @operators = qw/== < > != <= >= and or xor/;

    my $truthiness = expression(\@operators);
    return $truthiness
}



sub assignment{

    my @operators = qw/+ - * \/ ** %/;
    my $left_val_ref = access_A();
    my $result = expression(\@operators);
    
    $R[$left_val_ref] = $result;
}


####____
#            sub expression has several routines associated with it:
#            rpn()
#            get_operator()
#            get_value()
#            val_or_operator()
#            
#
sub expression {
    my $operator_list = shift;

    my $o = access_A(0,'int');#num of ops

    if ($o == 0){
        return get_value(); 
    }        
    my @a = (get_value(),get_value()); #start with two numbers
    my $v = $o -1; #with the two numbers above.. we reduce the value c
+ount
    while ($o){
        if ($o == $v){
            push @a, get_value();$v--;
            next
        }elsif ($v){
                if (val_or_operator()){
                    push @a, get_value();
                    $v--;
                }else{
                    push @a, get_operator($operator_list);
                    $o--;
                }
                next
            }
        push @a, get_operator($operator_list);
        $o--;
    }
    my $result = rpn(\@a);
    return $result;
}



sub get_operator {
    my $operator_list = shift;    
    my $op = access_A();
    my $operator = $operator_list->[$op % ($#$operator_list+1)];
    return $operator;
}


sub get_value{
    #in which we learn weather or not the next value is a reference to
+ @R
    # then we return the result
    #

    # we don't use the "negative numbers are R refs," becuase negative
+ nums
    # are kinda useful in arithmetic... go figure.
    

    my $val = access_A();
        # $val is the choice between either an A value or an R value

    ($val% 2)?
        ($val = access_A("no R")):
        ($val = access_R(access_A()));
    
        
        # $val is now an arithmetic value

    defined($val)?return $val:return 0;
}

sub val_or_operator{
    my $choice = access_A();

    return $choice%2;
}

sub rpn{
    my $a = shift;
    my @stack;
    for (@$a){
        (/\d/)?
            (push @stack, $_):
            (push @stack, eval ((pop @stack)." $_ ".(pop @stack)));

            dump_("big-ass number") if ($stack[$#stack] =~/e/); #too b
+ig is too big.
            dump_(" DIV by ZERO is a BIG problem") if ($@=~ /Illegal/)
+; #honestly don't need to deal with div by 0
            
            ($stack[$#stack] = 0) unless (defined $stack[$#stack]);
        $stack[$#stack] = 0 if $stack[$#stack] == -0; #wierd... but I 
+have to do it.
    }

    return $stack[0];
}
#    the above ends selections of routines for expression()
###__________


sub go {
    my $loc = access_A();
    my $iterations = access_A(0,'int');

    unless ($iterations){
        $ptr = $loc;
        return
    }

    my $temp = $ptr;
    $ptr = $loc;

    for (0 .. $iterations){
        event()
    }
       $ptr = $temp; 
}
[download]