view release on metacpan or  search on metacpan

lib/Acme/6502/Tube.pm  view on Meta::CPAN

  $self->write_16( $self->BREAK, 0xFF00 );

  $self->make_vector( 'OSCLI',  0x208, \&_oscli );
  $self->make_vector( 'OSBYTE', 0x20A, \&_osbyte );
  $self->make_vector( 'OSWORD', 0x20C, \&_osword );
  $self->make_vector( 'OSWRCH', 0x20E, \&_oswrch );
  $self->make_vector( 'OSRDCH', 0x210, \&_osrdch );
  $self->make_vector( 'OSFILE', 0x212, \&_osfile );
  $self->make_vector( 'OSARGS', 0x214, \&_osargs );
  $self->make_vector( 'OSBGET', 0x216, \&_osbget );
  $self->make_vector( 'OSBPUT', 0x218, \&_osbput );
  $self->make_vector( 'OSGBPB', 0x21A, \&_osgbpb );
  $self->make_vector( 'OSFIND', 0x21C, \&_osfind );

  $self->set_jumptab( 0xFA00 );
}

sub _oscli {
  my $self = shift;
  my $blk = $self->get_xy();
  my $cmd = '';
  CH: for ( ;; ) {
    my $ch = $self->read_8( $blk++ );
    last CH if $ch < 0x20;
    $cmd .= chr( $ch );
  }
  $cmd =~ s/^[\s\*]+//g;
  if ( lc( $cmd ) eq 'quit' ) {
    exit;
  }
  else {
    system( $cmd );
  }
}

sub _osbyte {
  my $self = shift;
  my $a = $self->get_a();
  if ( $a == 0x7E ) {
    # Ack escape
    $self->write_8( 0xFF, 0 );
    $self->set_x( 0xFF );
  }
  elsif ( $a == 0x82 ) {
    # Read m/c high order address
    $self->set_xy( 0 );
  }
  elsif ( $a == 0x83 ) {
    # Read OSHWM (PAGE)
    $self->set_xy( PAGE );
  }
  elsif ( $a == 0x84 ) {
    # Read HIMEM
    $self->set_xy( HIMEM );
  }
  elsif ( $a == 0xDA ) {
    $self->set_xy( 0x0900 );
  }
  else {
    die sprintf( "OSBYTE %02x not handled\n", $a );
  }
}

sub _set_escape {
  my $self = shift;
  $self->write_8( 0xFF, 0xFF );
}

sub _osword {
  my $self = shift;
  my $a   = $self->get_a();
  my $blk = $self->get_xy();

  if ( $a == 0x00 ) {
    # Command line input
    my $buf = $self->read_16( $blk );
    my $len = $self->read_8( $blk + 2 );
    my $min = $self->read_8( $blk + 3 );
    my $max = $self->read_8( $blk + 4 );
    my $y   = 0;
    if ( defined( my $in = <> ) ) {
      my @c = map ord, split //, $in;
      while ( @c && $len-- > 1 ) {
        my $c = shift @c;
        if ( $c >= $min && $c <= $max ) {
          $self->write_8( $buf + $y++, $c );
        }
      }
      $self->write_8( $buf + $y++, 0x0D );
      $self->set_y( $y );
      $self->set_p( $self->get_p() & ~$self->C );
    }
    else {
      # Escape I suppose...
      $self->set_p( $self->get_p() | $self->C );
    }
  }
  elsif ( $a == 0x01 ) {
    # Read clock
    my $now = int( ( time() - $self->{ time_base } ) * 100 );
    $self->write_32( $blk, $now );
    $self->write_8( $blk + 4, 0 );
  }
  elsif ( $a == 0x02 ) {
    # Set clock
    my $tm = $self->read_32( $blk );
    $self->{ time_base } = time() - ( $tm * 100 );
  }
  else {
    die sprintf( "OSWORD %02x not handled\n", $a );
  }
}

sub _oswrch {
  my $self = shift;
  printf( "%c", $self->get_a() );
}

sub _osrdch {
  my $self = shift;
  Term::ReadKey::ReadMode( 4 );
  eval {
    my $k = ord( Term::ReadKey::ReadKey( 0 ) );
    $k = 0x0D if $k == 0x0A;
    $self->set_a( $k );
    if ( $k == 27 ) {
      $self->set_escape;
      $self->set_p( $self->get_p() | $self->C );
    }
    else {
      $self->set_p( $self->get_p() & ~$self->C );
    }
  };
  Term::ReadKey::ReadMode( 0 );
  die $@ if $@;
}

sub _osfile {
  my $self = shift;
  my $a     = $self->get_a();
  my $blk   = $self->get_xy();
  my $name  = $self->read_str( $self->read_16( $blk ) );
  my $load  = $self->read_32( $blk + 2 );
  my $exec  = $self->read_32( $blk + 6 );
  my $start = $self->read_32( $blk + 10 );
  my $end   = $self->read_32( $blk + 14 );

  # printf("%-20s %08x %08x %08x %08x\n", $name, $load, $exec, $start, $end);
  if ( $a == 0x00 ) {
    # Save
    open my $fh, '>', $name or die "Can't write $name\n";
    binmode $fh;
    my $buf = $self->read_chunk( $start, $end );
    syswrite $fh, $buf or die "Error writing $name\n";
    $self->set_a( 1 );
  }
  elsif ( $a == 0xFF ) {
    # Load
    if ( -f $name ) {
      open my $fh, '<', $name or die "Can't read $name\n";
      binmode $fh;
      my $len = -s $fh;
      sysread $fh, my $buf, $len or die "Error reading $name\n";
      $load = PAGE if $exec & 0xFF;
      $self->write_chunk( $load, $buf );
      $self->write_32( $blk + 2,  $load );
      $self->write_32( $blk + 6,  0x00008023 );
      $self->write_32( $blk + 10, $len );
      $self->write_32( $blk + 14, 0x00000000 );
      $self->set_a( 1 );
    }
    elsif ( -d $name ) {
      $self->set_a( 2 );
    }
    else {
      $self->set_a( 0 );
    }
  }
  else {
    die sprintf( "OSFILE %02x not handled\n", $a );
  }
}

sub _osargs {
  die "OSARGS not handled\n";
}

sub _osbget {
  die "OSBGET not handled\n";
}

sub _osbput {
  die "OSBPUT not handled\n";
}

sub _osgbpb {
  die "OSGBPB not handled\n";
}

sub _osfind {
  die "OSFIND not handled\n";
}

sub make_vector {
    my( $self, $name, $vec, $code ) = @_;

    my $addr = $self->$name;
    my $vecno = scalar @{ $self->{ os } };
    push @{ $self->{ os } }, [ $code, $name ];

    $self->SUPER::make_vector( $addr, $vec, $vecno );
}

sub call_os {
  my $self = shift;
  my $vecno = shift;

  eval {
    my $call = $self->{ os }->[ $vecno ] || die "Bad OS call $vecno\n";
    $call->[ 0 ]->( $self );
  };

  if ( $@ ) {
    my $err = $@;
    $self->write_16( ERROR, 0x7F00 );
    $err =~ s/\s+/ /;
    $err =~ s/^\s+//;
    $err =~ s/\s+$//;
    warn $err;
    my $ep = ERROR + 2;
    for ( map ord, split //, $err ) {
      $self->write_8( $ep++, $_ );
    }
    $self->write_8( $ep++, 0x00 );
    $self->set_pc( ERROR );
  }
}

1;
__END__