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";
}
Replies are listed 'Best First'.
Re: Very Simple Stack-based Language
by Aristotle (Chancellor) on Aug 18, 2002 at 00:13 UTC
    It would be more elegant if, rather than a huge if elsif construct, you used an array with subroutine references. The main loop would shrink to
    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 $microcode[$ci]->(@some_params); $pc++; $alive = 0 if $turn > 1000; }
    which makes the main loop easier to understand and the individual instructions' code easier to find. Also, I don't see any reason why you do while($alive) { ... ; $alive = 0 if $turn > 1000; } rather than just while($turn <= 1000).

    Makeshifts last the longest.

      Well, the main reason for the lack of optimization is that I created it rather quickly :-).

      Originally, I wrote the loop without knowing what would be at the end, so that is one of the reasons the statements are as they are. Another reason, is that you might not want to use a 1000-turn limit, and indeed want to use $alive to control how long the program runs. In fact, I added the $turn comparison on later after I discovered that endless loops were quite common.

      The suggestion about the subroutine references is interesting, though. I'll see what I can do about that some time. Thanks for your comments!

      Lur: "But if this cape shrinks, consider your species extinct!"