Good day everybody. Over the past couple of months, I decided to try my hand at building an
The sourcecode for a fibonacci number generator is built into the array @A in the script below. Just run the critter and have fun.
Here is a commented version of the "source code"::
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
);
And, here is the script:
#!/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;
}
BTW- look at sub rpn. I had to change -0 to 0 on occasion (don't recall the specific conditions). Now, what could that mean?
