view release on metacpan or  search on metacpan

lib/Hardware/Simulator/MIX.pm  view on Meta::CPAN

    $self->add(\@tmp);
    return 1;
}

sub X_ADDR_TRANSFER {
    my ($self, $c, $f, $r, $l, $i, $a, $m) = @_;

    my $reg = $self->{$regname[$c-48]};
    if ($f == 0) { ## INC
	my $v = word_to_int($reg, $self->{max_byte});
	if (int_to_word($v+$m, $reg, $self->{max_byte})) {
	    $self->{ov_flag} = 0;
	} else {
	    $self->{ov_flag} = 1;
	}
    } elsif ($f == 1) { ## DEC
	my $v = word_to_int($reg, $self->{max_byte});
	if (int_to_word($v-$m, $reg, $self->{max_byte})) {
	    $self->{ov_flag} = 0;
	} else {
	    $self->{ov_flag} = 1;
	}
    } elsif ($f == 2) { ##ENT
	int_to_word($m, $reg, $self->{max_byte});
    } elsif ($f == 3) { ##ENN
	int_to_word(-$m, $reg, $self->{max_byte});
    } else {
	return 0;
    }

    return 1;
}

sub X_CMP {
    my ($self, $c, $f, $r, $l, $i, $a, $m) = @_;

    my $tmp1 = $self->get_reg($regname[$c-56], $l, $r);
    my $tmp2 = $self->read_mem_timed($m, $l, $r);
    $self->{cmp_flag} = $tmp1 - $tmp2;

    return 1;
}

sub X_DIV {
    my ($self, $c, $f, $r, $l, $i, $a, $m) = @_;

    return 0 if $f == 6;

    my @tmp = $self->read_mem_timed($m, $l, $r);
    $self->div(\@tmp);

    # DIV requires 10 additional time units
    $self->{time} += 10;
    return 1;
}

# Usage: $self->wait_until_device_ready($devnum)
#
# Used only before IN/OUT operations. 
# 
# If the device is busy, that is, the current time - last started < delay,
# increase the current time, so that the device would be ready
sub wait_until_device_ready
{
    my ($self, $devnum) = @_;

    return if $devnum < 0 || $devnum > 19;

    my $devstat = @{$self->{devstat}}[$devnum];
    my $laststarted = $devstat->{laststarted};

    # See whether the device is still busy
    if ($self->{time} - $laststarted < $devstat->{delay})
    {
        # advance the current system time to the point
        # that the device would be ready
        $self->{time} = $laststarted + $devstat->{delay};
    }
}

sub X_INPUT {
    my ($self, $c, $f, $r, $l, $i, $a, $m) = @_;

    $self->wait_until_device_ready($f);
    if ($f == U_CARDREADER) { ## CARD READER
	$self->load_card($m);
    } elsif ($f >= U_TAPE && $f < U_DISK) {
	$self->read_tape($f, $m);
    } elsif ($f >= U_DISK && $f < U_CARDREADER) {
	$self->read_disk($f, $m);
    } elsif ($f == U_TYPEWRITER) { # Input from typewriter
	$self->read_typewriter($m);
    } else {
	$self->{status} = MIX_ERROR;
	$self->{message} = "invalid input device(#$f)";
    }
    return 1;
}

sub X_IOC {
    my ($self, $c, $f, $r, $l, $i, $a, $m) = @_;

    $self->wait_until_device_ready($f);
    if ($f == U_PRINTER) { ## Printer: set up new page
	$self->new_page($m);
    } elsif (U_TAPE <= $f && $f <= (U_TAPE+7)) {
	$self->set_tape_pos($f, $m);
    } elsif (U_DISK <= $f && $f <= (U_DISK+7)) {
	$self->set_disk_pos($f);
    } elsif ($f == U_PAPERTAPE) {
	$self->rewind_paper_tape;
    } else {
	$self->{status} = MIX_ERROR;
	$self->{message} = "invalid ioc for device(#$f)";
    }
    return 1;
}

# Jump when device busy: always no busy
sub X_JBUS {
    my ($self, $c, $f, $r, $l, $i, $a, $m) = @_;
    return 1;
}

sub X_JMP_COND {
    my ($self, $c, $f, $r, $l, $i, $a, $m) = @_;

    return 0 if $f > 9;
    my $ok   = 1;
    my $savj = 0;
    my $cf   = $self->{cmp_flag};
    my @cond = ($cf<0,$cf==0,$cf>0,$cf>=0,$cf!=0,$cf<=0);

    if ($f == 0) {
	$ok = 1;
    }elsif ($f == 1) {
	$savj = 1;
    } elsif ($f == 2) {
	$ok = $self->{ov_flag};
    } elsif ($f == 3) {
	$ok = !$self->{ov_flag};
    } else {
	$ok = $cond[$f-4];
    }

    if ($ok) {
	if (!$savj) {
	    int_to_word($self->{next_pc}, $self->{rJ}, $self->{max_byte});
	}
	$self->{next_pc} = $m;
    }

    return 1;
}

sub X_JMP_REG {
    my ($self, $c, $f, $r, $l, $i, $a, $m) = @_;
    return 0 if $f > 5;
    my $val = $self->get_reg($regname[$c-40]);
    my @cond = ($val<0,$val==0,$val>0,$val>=0,$val!=0,$val<=0);
    if ($cond[$f]) {
	int_to_word($self->{next_pc}, $self->{rJ}, $self->{max_byte});
	$self->{next_pc} = $m;
    }
    return 1;
}

# Jump ready: jump immediately
sub X_JRED {
    my ($self, $c, $f, $r, $l, $i, $a, $m) = @_;

    int_to_word($self->{next_pc}, $self->{rJ}, $self->{max_byte});
    $self->{next_pc} = $m;

    return 1;
}

sub X_LDA {
    my ($self, $c, $f, $r, $l, $i, $a, $m) = @_;