From 0a275c6ae1ed1d6de807f0dc8c2d29fe222140c0 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Thu, 5 Apr 2012 11:25:12 -0500 Subject: initial implementation --- lib/Games/Emulation/DCPU16.pm | 529 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 529 insertions(+) (limited to 'lib/Games') diff --git a/lib/Games/Emulation/DCPU16.pm b/lib/Games/Emulation/DCPU16.pm index e69de29..dd0855c 100644 --- a/lib/Games/Emulation/DCPU16.pm +++ b/lib/Games/Emulation/DCPU16.pm @@ -0,0 +1,529 @@ +package Games::Emulation::DCPU16; +use strict; +use warnings; + +use integer; + +use constant { + STATE_NEW_OP => 0, + STATE_READ_ARG_1 => 1, + STATE_READ_ARG_2 => 2, + STATE_OP_EXECUTE => 3, + TIME_TAKEN_NONE => 0, + TIME_TAKEN_DELAY => 1, + TIME_TAKEN_WORK => 2, +}; + +sub new { + my $class = shift; + + bless { + memory => [(0x0000) x 0x10000], + registers => [(0x0000) x 8], + PC => 0x0000, + SP => 0xffff, + O => 0x0000, + + halt => undef, + delay => 0, + time_taken => TIME_TAKEN_NONE, + state => STATE_NEW_OP, + has_delayed => undef, + + current_op => undef, + lvalue => undef, + value1 => undef, + value2 => undef, + next_word => undef, + + basic_opcode_map => [ + undef, + '_op_SET', + '_op_ADD', + '_op_SUB', + '_op_MUL', + '_op_DIV', + '_op_MOD', + '_op_SHL', + '_op_SHR', + '_op_AND', + '_op_BOR', + '_op_XOR', + '_op_IFE', + '_op_IFN', + '_op_IFG', + '_op_IFB', + ], + non_basic_opcode_map => [ + undef, + '_op_JSR', + (undef) x (0x3f - 0x02 - 1), + '_op_HLT', # XXX extension + ], + }, $class; +} + +sub memory { shift->{memory} } +sub registers { shift->{registers} } +sub PC { shift->{PC} } +sub SP { shift->{SP} } +sub O { shift->{O} } + +sub load { + my $self = shift; + my ($bytecode) = @_; + + my $idx = 0; + while (my $word = substr($bytecode, 0, 2, '')) { + $self->{memory}[$idx++] = ord($word) * 2**8 + ord(substr($word, 1, 1)); + } +} + +sub run { + my $self = shift; + + $self->step until $self->{halt}; +} + +sub step { + my $self = shift; + + if ($self->{delay}) { + $self->{delay}--; + return; + } + + $self->{time_taken} = TIME_TAKEN_NONE; + while (1) { + my $state = $self->{state}; + if ($state == STATE_NEW_OP) { + $self->{state} = $self->_parse_op($self->{memory}[$self->{PC}++]); + } + elsif ($state == STATE_READ_ARG_1) { + $self->{state} = $self->_parse_value($self->{value1}) + } + elsif ($state == STATE_READ_ARG_2) { + $self->{state} = $self->_parse_value($self->{value2}) + } + elsif ($state == STATE_OP_EXECUTE) { + $self->{state} = $self->_execute_current_op; + } + else { + die "Invalid state"; + } + + last if $self->{time_taken} != TIME_TAKEN_NONE; + } +} + +# XXX this duplicates a bit from _parse_value +sub _op_length { + my $self = shift; + + my $length = 1; + $self->_parse_op($self->{memory}[$self->{PC}]); + + for my $value ($self->{value1}, $self->{value2}) { + next unless defined $value; + $length++ if $value >= 0x10 && $value < 0x18; + $length++ if $value >= 0x1e && $value < 0x20; + } + + return $length; +} + +sub _parse_op { + my $self = shift; + my ($opcode) = @_; + + my $basic_op = $opcode & 0x0f; + + if ($basic_op) { + $self->{value1} = ($opcode >> 4) & 0x3f; + $self->{value2} = ($opcode >> 10) & 0x3f; + $self->{current_op} = $self->{basic_opcode_map}[$basic_op]; + } + else { + my $non_basic_op = ($opcode >> 4) & 0x3f; + + $self->{value1} = ($opcode >> 10) & 0x3f; + $self->{value2} = undef; + $self->{current_op} = $self->{non_basic_opcode_map}[$non_basic_op]; + } + + die "Illegal opcode" unless $self->{current_op}; + + return STATE_READ_ARG_1; +} + +sub _parse_value { + my $self = shift; + my ($value) = @_; + + my $state = $self->{state}; + my $key = $state == STATE_READ_ARG_1 ? 'value1' : 'value2'; + + if ($value < 0x08) { + $self->{$key} = $self->{registers}[$value]; + $self->{lvalue} = \$self->{registers}[$value] + if $state == STATE_READ_ARG_1; + } + elsif ($value < 0x10) { + my $addr = $self->{registers}[$value & 0x07]; + $self->{$key} = $self->{memory}[$addr]; + } + elsif ($value < 0x18) { + $self->_next_word; + return $state if $self->{time_taken} != TIME_TAKEN_WORK; + + my $addr = $self->{registers}[$value & 0x07] + $self->{next_word}; + $self->{$key} = $self->{memory}[$addr]; + $self->{lvalue} = \$self->{memory}[$addr] + if $state == STATE_READ_ARG_1; + } + elsif ($value > 0x1f) { + die "Illegal value" unless $value <= 0x3f; + $self->{$key} = $value - 0x20; + } + elsif ($value == 0x18) { + $self->{$key} = $self->{memory}[++$self->{SP}]; + } + elsif ($value == 0x19) { + $self->{$key} = $self->{memory}[$self->{SP}]; + } + elsif ($value == 0x1a) { + $self->{$key} = $self->{memory}[$self->{SP}--]; + } + elsif ($value == 0x1b) { + $self->{$key} = $self->{SP}; + $self->{lvalue} = \$self->{SP} + if $state == STATE_READ_ARG_1; + } + elsif ($value == 0x1c) { + $self->{$key} = $self->{PC}; + $self->{lvalue} = \$self->{PC} + if $state == STATE_READ_ARG_1; + } + elsif ($value == 0x1d) { + $self->{$key} = $self->{O}; + } + elsif ($value == 0x1e) { + $self->_next_word; + return $state if $self->{time_taken} != TIME_TAKEN_WORK; + + my $addr = $self->{next_word}; + $self->{$key} = $self->{memory}[$addr]; + $self->{lvalue} = \$self->{memory}[$addr] + if $state == STATE_READ_ARG_1; + } + elsif ($value == 0x1f) { + $self->_next_word; + return $state if $self->{time_taken} != TIME_TAKEN_WORK; + + $self->{$key} = $self->{next_word}; + } + + return $state == STATE_READ_ARG_2 || !defined($self->{value2}) + ? STATE_OP_EXECUTE + : STATE_READ_ARG_2; +} + +sub _execute_current_op { + my $self = shift; + + my $op_meth = $self->{current_op}; + $self->$op_meth($self->{value1}, $self->{value2}); + + return $self->{state} if $self->{time_taken} != TIME_TAKEN_WORK; + + $self->{lvalue} = undef; + + return STATE_NEW_OP; +} + +sub _next_word { + my $self = shift; + + undef $self->{next_word}; + + return 1 if $self->_delay(1); + + $self->{next_word} = $self->{memory}[$self->{PC}++]; + + return; +} + +sub _delay { + my $self = shift; + my ($delay) = @_; + + return unless $delay; + + $delay--; + + if (!$delay || $self->{has_delayed}) { + $self->{time_taken} = TIME_TAKEN_WORK; + undef $self->{has_delayed}; + return; + } + else { + $self->{time_taken} = TIME_TAKEN_DELAY; + $self->{delay} = $delay - 1; + $self->{has_delayed} = 1; + return 1; + } +} + +sub _op_SET { + my $self = shift; + my ($a, $b) = @_; + + return if $self->_delay(1); + + my $lvalue = $self->{lvalue}; + return unless $lvalue; + + ${ $self->{lvalue} } = $b; +} + +sub _op_ADD { + my $self = shift; + my ($a, $b) = @_; + + return if $self->_delay(2); + + my $lvalue = $self->{lvalue}; + return unless $lvalue; + + $$lvalue = $a + $b; + $self->{O} = $$lvalue >> 16; + $$lvalue &= 0xffff; +} + +sub _op_SUB { + my $self = shift; + my ($a, $b) = @_; + + return if $self->_delay(2); + + my $lvalue = $self->{lvalue}; + return unless $lvalue; + + $$lvalue = $a - $b; + $self->{O} = $$lvalue >> 16; + $$lvalue &= 0xffff; +} + +sub _op_MUL { + my $self = shift; + my ($a, $b) = @_; + + return if $self->_delay(2); + + my $lvalue = $self->{lvalue}; + return unless $lvalue; + + $$lvalue = $a * $b; + $self->{O} = $$lvalue >> 16; + $$lvalue &= 0xffff; +} + +sub _op_DIV { + my $self = shift; + my ($a, $b) = @_; + + return if $self->_delay(3); + + my $lvalue = $self->{lvalue}; + return unless $lvalue; + + if ($b == 0) { + $$lvalue = 0; + $self->{O} = 0; + } + else { + $$lvalue = $a / $b; + $self->{O} = (($a << 16) / $b) & 0xffff; + $$lvalue &= 0xffff; + } +} + +sub _op_MOD { + my $self = shift; + my ($a, $b) = @_; + + return if $self->_delay(3); + + my $lvalue = $self->{lvalue}; + return unless $lvalue; + + if ($b == 0) { + $$lvalue = 0; + } + else { + $$lvalue = ($a % $b) & 0xffff; + } +} + +sub _op_SHL { + my $self = shift; + my ($a, $b) = @_; + + return if $self->_delay(2); + + my $lvalue = $self->{lvalue}; + return unless $lvalue; + + $$lvalue = $a << $b; + $self->{O} = $$lvalue >> 16; + $$lvalue &= 0xffff; +} + +sub _op_SHR { + my $self = shift; + my ($a, $b) = @_; + + return if $self->_delay(2); + + my $lvalue = $self->{lvalue}; + return unless $lvalue; + + $$lvalue = $a >> $b; + $self->{O} = (($a << 16) >> $b) & 0xffff; + $$lvalue &= 0xffff; +} + +sub _op_AND { + my $self = shift; + my ($a, $b) = @_; + + return if $self->_delay(1); + + my $lvalue = $self->{lvalue}; + return unless $lvalue; + + $$lvalue = $a & $b; +} + +sub _op_BOR { + my $self = shift; + my ($a, $b) = @_; + + return if $self->_delay(1); + + my $lvalue = $self->{lvalue}; + return unless $lvalue; + + $$lvalue = $a | $b; +} + +sub _op_XOR { + my $self = shift; + my ($a, $b) = @_; + + return if $self->_delay(1); + + my $lvalue = $self->{lvalue}; + return unless $lvalue; + + $$lvalue = $a ^ $b; +} + +sub _op_IFE { + my $self = shift; + my ($a, $b) = @_; + + if ($a == $b) { + return if $self->_delay(2); + } + else { + return if $self->_delay(3); + + $self->{PC} += $self->_op_length; + } +} + +sub _op_IFN { + my $self = shift; + my ($a, $b) = @_; + + if ($a != $b) { + return if $self->_delay(2); + } + else { + return if $self->_delay(3); + + $self->{PC} += $self->_op_length; + } +} + +sub _op_IFG { + my $self = shift; + my ($a, $b) = @_; + + if ($a > $b) { + return if $self->_delay(2); + } + else { + return if $self->_delay(3); + + $self->{PC} += $self->_op_length; + } +} + +sub _op_IFB { + my $self = shift; + my ($a, $b) = @_; + + if ($a & $b) { + return if $self->_delay(2); + } + else { + return if $self->_delay(3); + + $self->{PC} += $self->_op_length; + } +} + +sub _op_JSR { + my $self = shift; + my ($a) = @_; + + return if $self->_delay(2); + + $self->{memory}[$self->{SP}--] = $self->{PC}; + $self->{PC} = $a; +} + +sub _op_HLT { + my $self = shift; + my ($a) = @_; + + $self->{halt} = 1; +} + +=for notes + +is SP defined to start at 0xffff? + +is PC defined to start at 0? + +behavior of MOD? + +behavior of underflow? + +how do you do only a PUSH? POP and PEEK make sense as values, PUSH doesn't + +is PC incremented for success of the test ops during execution of the test op, +or before execution of the next op? really, when is PC incremented in general? + +does memory start out as 0, or undefined? + +what happens when an invalid op is read? + +POP should be [++SP] and PUSH should be [SP--] (actually PUSH shouldn't return +anything, probably) + +=cut + +1; -- cgit v1.2.3-54-g00ecf