toycom

#!/usr/bin/perl

# me@ys.lc (c)

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

### Global
our $addr_map = { };
our $curr_value = 0;
our $debug = 1;
######################

sub dd {
	$debug and say @_;
}

sub make_op_code {
	my ($name, $cb) = @_;
	return { name => $name, cb => $cb };
}

sub get_val_by_addr {
	my ($addr) = @_;
	my $v = $addr_map->{$addr};

	die "ERROR: value at $addr is not defined!" unless defined $v;
	return $v;
};

sub op_ld {
	my ($addr) = @_;

	dd("Loading value at ${addr} to current reg ...");
	$curr_value = get_val_by_addr($addr);
}

sub op_st {
	my ($addr) = @_;

	dd("Saving value at ${addr} to map ...");
	$addr_map->{$addr} = $curr_value;
}

sub op_add {
	my ($addr) = @_;
	my $v = get_val_by_addr($addr);

	dd("ADD: $curr_value + $v");
	$curr_value += $v;
}

sub op_sub {
	my ($addr) = @_;
	my $v = get_val_by_addr($addr);

	dd("SUB: $curr_value - $v");
	$curr_value -= $v;
}

sub op_mul {
	my ($addr) = @_;
	my $v = get_val_by_addr($addr);

	dd("MUL: $curr_value * $v");
	$curr_value *= $v;
}

sub op_div {
	my ($addr) = @_;
	my $v = get_val_by_addr($addr);

	die "ERROR: division by zero detected at line $..\n" unless $v;
	dd("DIV: $curr_value / $v");
	$curr_value = int($curr_value / $v);
}

sub op_in {
	my ($addr) = @_;
	my $v;

	while (not defined $v) {
		print "Enter: ";
		chomp(($v = <STDIN>));
	}

	die "ERROR: '$v' it is not a number!" unless $v =~ m/^-?\d+$/;

	dd("IN: Saving '$v' to $addr ...");
	$addr_map->{$addr} = $v;
}

sub op_out {
	my ($addr) = @_;
	my $v = get_val_by_addr($addr);

	say "OUT: ${v}";
}

### Jump address
my $op_jmp_addr = 0;

sub op_jmp {
	$op_jmp_addr = shift;
}

sub op_jz {
	$op_jmp_addr = shift unless $curr_value;
}

sub op_js {
	$op_jmp_addr = shift if $curr_value < 0;
}

my $op_codes = {
	0 => make_op_code("exit", sub { exit 0 }), # Выход
	1 => make_op_code("ld",  \&op_ld),  # Загрузить аккумулятор
	2 => make_op_code("st",  \&op_st),  # Сохранить аккумулятор
	3 => make_op_code("add", \&op_add), # Сложить с аккумулятором
	4 => make_op_code("sub", \&op_sub), # Вычесть из аккумулятора
	5 => make_op_code("mul", \&op_mul), # Умножить аккумулятор
	6 => make_op_code("div", \&op_div), # Разделить аккумулятор
	7 => make_op_code("in",  \&op_in),  # Ввести данные
	8 => make_op_code("out", \&op_out), # Вывести данные
	9 => make_op_code("jmp", \&op_jmp), # Перейти по адресу
	10 => make_op_code("jz", \&op_jz),  # Перейти по адресу, если аккумулятор == 0
	11 => make_op_code("js", \&op_js),  # Перейти по адресу, если аккумулятор <  0
};

sub do_program {
	my ($prog, $at) = @_;

	$op_jmp_addr = 0;
	for ( sort { $a <=> $b } grep { $_ >= $at } keys $prog) {
		my ($cmd, $addr) = @{$prog->{$_}}{qw(cmd addr)};
		my $f = $op_codes->{$cmd};

		dd("Do command '", $f->{name}, "' from address ", $_);

		# Execute it!
		$f->{cb}($addr);

		# Check jump address
		if ($op_jmp_addr) {
			die "ERROR: unknwon address: $op_jmp_addr\n" unless exists $prog->{$op_jmp_addr};
			dd("Go to addr (line) $op_jmp_addr ...");
			return do_program($prog, $op_jmp_addr);
		}
	}
}


########################################
### START
########################################
die "Usage: $0 <filename>" unless $ARGV[0];

open my $fh, "<", $ARGV[0] or die "$0: Can't open '$ARGV[0]' for reading: $!\n";
my $prog;
dd("Loading program ...");
while (<$fh>) {
	chomp;
	next unless $_;
	next if m/^#/;
	die "ERROR: unknwon code/command: '$_' at line '$.' in file '$ARGV[0]'\n" unless m/^\d+$/;

	my $code = substr $_, 0, 2;
	my $addr = substr $_, 2;

	die "ERROR: unknwon code: '$code' at line '$.' in file '$ARGV[0]'\n" unless exists $op_codes->{int($code)};

	dd("Line $.: $_");
	$prog->{$.} = { cmd => int($code), addr => int($addr) };
}
close $fh;

do_program($prog, 0);