http://qs1969.pair.com?node_id=190798
Category: Miscellaneous
Author/Contact Info PM me, or look at my user page.
Description:

I made this after reading this post about using a simple stack-based language. The author described the language, but didn't provide any code, and I thought I could write some code quickly, so I did.

It's not very fancy, but it does seem to work. It's also not well-tested yet, but I don't expect to encounter serious bugs. :: crosses fingers :: ;-)

It's been updated a couple of times now :-)

#!/usr/bin/perl -w
use strict;
srand;

use constant STACKSIZE => 128;
use constant CODESIZE => 128;
use constant SKIPAMOUNT => 2 + int rand 6;
use constant REPEATAMOUNT => 2 + int rand 10;

use constant NOP => 0;
use constant SKIP => 1;
use constant REPEAT => 2;
use constant NOT => 3;
use constant GO => 4;
use constant TURN => 5;
use constant LOOK => 6;
use constant EAT => 7;
use constant RESET => 8;

use constant MAXOPCODE => 8;

my @code = ();
foreach(0..CODESIZE-1) {
    $code[$_] = RESET;
}


my @opcode = qw(NOP SKIP REPEAT NOT GO TURN LOOK EAT RESET);


my @world = ();
use constant WORLDWIDTH => 16;
use constant WORLDHEIGHT => 16;
use constant EMPTY => 0;
use constant OBSTACLE => 1;
use constant FOOD => 2;
use constant PATH => 3;

foreach my $y (0..WORLDHEIGHT) {
    foreach my $x (0..WORLDWIDTH) {
        $world[$y][$x] = EMPTY;
        unless(int rand 4) {
            $world[$y][$x] = FOOD;
        }
    }
}

foreach (1..sqrt(WORLDHEIGHT*WORLDWIDTH)) {
    my $x = int rand WORLDWIDTH;
    my $y = int rand WORLDHEIGHT;
    $world[$y][$x] = OBSTACLE;
}

my %tiletochar = (
    EMPTY, " ",
    FOOD, "+",
    OBSTACLE, "#",
    PATH, "@",
);

foreach my $y (0..WORLDHEIGHT-1) {
    foreach my $x (0..WORLDWIDTH-1) {
        print  $tiletochar{$world[$y][$x]};
    }
    print "\n";
}
print "Press Enter to generate programming."; <>; print "\n";
foreach(0..int rand CODESIZE-1) {
    my $thisopcode = int rand MAXOPCODE;
    $code[$_] = $thisopcode;
    print "Opcode \#$_: $thisopcode ($opcode[$thisopcode])\n";
}

my $x = -1;
my $y = -1;
while($x < 0 or $y < 0 or $x >= WORLDWIDTH or $y >= WORLDHEIGHT or $wo
+rld[$y][$x] == OBSTACLE) {
    $x = int rand WORLDWIDTH;
    $y = int rand WORLDHEIGHT;
}
my @histx = ();
my @histy = ();
my @histh = ();

my $heading = int rand 4;
my @headings = qw(north east south west);
use constant NORTH => 0;
use constant EAST => 1;
use constant SOUTH => 2;
use constant WEST => 3;

my $food = 0;
my $alive = 1;
my $pc = 0;    # Program Counter
my $turn = 0;

print "Repeatamount:\t", REPEATAMOUNT, "\n";
print "Skipamount:\t", SKIPAMOUNT, "\n";
print "Press Enter to start simulation: "; <>; print "\n";

{
    my @stack = ();
    foreach(0..STACKSIZE-1) {
        $stack[$_] = 0;
    }
    my $sp = 0;    # Stack Pointer, keeps track of stack size
    sub _pop {
        my $bit = pop @stack;
        $sp--;
        $sp = 0 if $sp < 0;
        $bit = 0 unless defined $bit;
        return $bit;
    }

    sub _push {
        my ($bit) = @_;
        if($sp < STACKSIZE) {
            push @stack, $bit;
            $sp++;
        }
    }
    sub _reset {
        @stack = ();
        $sp = 0;
    }
}

while($alive) {
    $turn++;
    printf "Turn \#% 4d\t", $turn;

    push @histx, $x;
    push @histy, $y;
    push @histh, $heading;

    $pc = 0 if $pc < 0;
    $pc = CODESIZE - 1 if $pc >= CODESIZE;

    my $ci = $code[$pc];    # Current Instruction
    print $opcode[$ci], "\t";

    $pc++;    # Just like CPUs do

    if($ci == NOP) {
        # Do nothing
        print "Doing nothing.\n";
    } elsif($ci == SKIP) {
        my $bit = _pop;
        if($bit) {
            $pc += SKIPAMOUNT;
            print "Skipped ahead " . SKIPAMOUNT . " instructions.\n";
        } else {
            print "Not skipped.\n";
        }
    } elsif($ci == REPEAT) {
        my $bit = _pop;
        if($bit) {
            $pc -= REPEATAMOUNT;
            print "Repeating previous " . REPEATAMOUNT . " instruction
+s.\n";
        } else {
            print "Not repeating.\n";
        }
    } elsif($ci == NOT) {
        my $bit = _pop;
        print $bit, " => ";
        $bit = $bit ? 0 : 1;
        _push $bit;
        print "$bit\n";
    } elsif($ci == RESET) {
        _reset;
        $pc = 0;
        print "\n";
#        $alive = 0;
    } elsif($ci == GO) {
        my $nx = $x;
        my $ny = $y;
        if($heading == NORTH) {
            $ny--;
        } elsif($heading == EAST) {
            $nx++;
        } elsif($heading == SOUTH) {
            $ny++;
        } elsif($heading == WEST) {
            $nx--;
        }
        if(    $nx < 0 or $ny < 0 or
            $nx >= WORLDWIDTH or $ny >= WORLDHEIGHT or
            $world[$ny][$ny] == OBSTACLE
        ) {
            _push 0;
            print "Could not move.\n";
        } else {
            $x = $nx;
            $y = $ny;
            _push 1;
            print "Moved $headings[$heading].\n";
        }
    } elsif($ci == TURN) {
        $heading++;
        $heading = 0 if $heading > 3;
        print "Turned to $headings[$heading].\n";
    } elsif($ci == LOOK) {
        my $nx = $x;
        my $ny = $y;
        if($heading == NORTH) {
            $ny--;
        } elsif($heading == EAST) {
            $nx++;
        } elsif($heading == SOUTH) {
            $ny++;
        } elsif($heading == WEST) {
            $nx--;
        }
        if($world[$ny][$nx] == FOOD) {
            _push 1;
            print "Saw food ahead!\n";
        } else {
            _push 0;
            print "No food ahead.\n";
        }
    } elsif($ci == EAT) {
        if($world[$y][$x] == FOOD) {
            _push 1;
            $world[$y][$x] = EMPTY;
            $food++;
            print "Eaten food.\n";
        } else {
            _push 0;
            print "Could not eat.\n";
        }
    }
    $pc++;
    $alive = 0 if $turn > 1000;
}

print "Finished. Food accumulated: $food.\n";

while($turn--) {
    my $x = pop @histx;
    my $y = pop @histy;
    $world[$y][$x] = PATH;
}

foreach my $y (0..WORLDHEIGHT-1) {
    foreach my $x (0..WORLDWIDTH-1) {
        print $tiletochar{$world[$y][$x]};
    }
    print "\n";
}