viewvc.cgi/VRac/Orao.pm

package Orao;

use warnings;
use strict;

use Carp;
use lib './lib';
#use Time::HiRes qw(time);
use File::Slurp;

use base qw(Class::Accessor M6502);
__PACKAGE__->mk_accessors(qw(debug trace run_for mem_dump trace));

=head1 NAME

Orao - Orao emulator

=head1 VERSION

Version 0.02

=cut

our $VERSION = '0.02';

=head1 SUMMARY

Emulator or Orao 8-bit 6502 machine popular in Croatia

=cut

my $loaded_files = {
        0xC000 => 'rom/BAS12.ROM',
        0xE000 => 'rom/CRT12.ROM',
};

=head2 load_rom

called to init memory and load initial rom images

  $orao->load_rom;

=cut

sub load_rom {
    my ($self) = @_;

    #my $time_base = time();

        foreach my $addr ( sort keys %$loaded_files ) {
                my $path = $loaded_files->{$addr};
                printf "loading '%s' at %04x\n", $path, $addr;
                $self->load_oraoemu( $path, $addr );
        }
}


=head2 load_oraoemu

=cut

sub load_oraoemu {
        my $self = shift;
        my ( $path, $addr ) = @_;

        my $size = -s $path || die "no size for $path: $!";

        my $buff = read_file( $path );

        if ( $size == 65538 ) {
                $addr = 0;
                printf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $size;
                $self->write_chunk( $addr, substr($buff,2) );
                return;
        } elsif ( $size == 32800 ) {
                $addr = 0;
                printf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $size;
                #$self->write_chunk( $addr, substr($buff,0x20) );
                $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );
                return;
        }
        printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $size;
        return $self->write_chunk( $addr, $buff );

        my $chunk;

        my $pos = 0;

        while ( my $long = substr($buff,$pos,4) ) {
                my @b = split(//, $long, 4);
                $chunk .=
                        ( $b[3] || '' ) .
                        ( $b[2] || '' ) .
                        ( $b[1] || '' ) .
                        ( $b[0] || '' );
                $pos += 4;
        }

        $self->write_chunk( $addr, $chunk );

};

=head2 save_dump

  $orao->save_dump( 'filename', $from, $to );

=cut

sub save_dump {
        my $self = shift;

        my ( $path, $from, $to ) = @_;

        $from ||= 0;
        $to ||= 0xffff;

        open(my $fh, '>', $path) || die "can't open $path: $!";
        print $fh $self->read_chunk( $from, $to );
        close($fh);

        my $size = -s $path;
        printf "saved %s %d %x bytes\n", $path, $size, $size;
}

=head2 hexdump

  $orao->hexdump( $address );

=cut

sub hexdump {
        my $self = shift;
        my $a = shift;
        return sprintf(" %04x %s\n", $a,
                join(" ",
                        map {
                                sprintf( "%02x", $_ )
                        } $self->ram( $a, $a+8 )
                )
        );
}

=head2 prompt

  $orao->prompt( $address, $last_command );

=cut

sub prompt {
        my $self = shift;
        my $a = shift;
        my $last = shift;
        print $self->hexdump( $a ),
                $last ? "[$last] " : '',
                "> ";
        my $in = <STDIN>;
        chomp($in);
        $in ||= $last;
        $last = $in;
        return split(/\s+/, $in) if $in;
}

=head1 AUTHOR

Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>

=head1 BUGS

=head1 ACKNOWLEDGEMENTS

See also L<http://www.foing.hr/~fng_josip/orao.htm> which is source of all
info about this machine (and even hardware implementation from 2007).

=head1 COPYRIGHT & LICENSE

Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1; # End of Orao
1	dpavlin	29	package Orao;
2
3			use warnings;
4			use strict;
5
6			use Carp;
7			use lib './lib';
8			#use Time::HiRes qw(time);
9			use File::Slurp;
10
11			use base qw(Class::Accessor M6502);
12			__PACKAGE__->mk_accessors(qw(debug trace run_for mem_dump trace));
13
14			=head1 NAME
15
16			Orao - Orao emulator
17
18			=head1 VERSION
19
20			Version 0.02
21
22			=cut
23
24			our $VERSION = '0.02';
25
26			=head1 SUMMARY
27
28			Emulator or Orao 8-bit 6502 machine popular in Croatia
29
30			=cut
31
32			my $loaded_files = {
33			0xC000 => 'rom/BAS12.ROM',
34			0xE000 => 'rom/CRT12.ROM',
35			};
36
37			=head2 load_rom
38
39			called to init memory and load initial rom images
40
41			$orao->load_rom;
42
43			=cut
44
45			sub load_rom {
46			my ($self) = @_;
47
48			#my $time_base = time();
49
50			foreach my $addr ( sort keys %$loaded_files ) {
51			my $path = $loaded_files->{$addr};
52			printf "loading '%s' at %04x\n", $path, $addr;
53			$self->load_oraoemu( $path, $addr );
54			}
55			}
56
57
58			=head2 load_oraoemu
59
60			=cut
61
62			sub load_oraoemu {
63			my $self = shift;
64			my ( $path, $addr ) = @_;
65
66			my $size = -s $path \|\| die "no size for $path: $!";
67
68			my $buff = read_file( $path );
69
70			if ( $size == 65538 ) {
71			$addr = 0;
72			printf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $size;
73			$self->write_chunk( $addr, substr($buff,2) );
74			return;
75			} elsif ( $size == 32800 ) {
76			$addr = 0;
77			printf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $size;
78			#$self->write_chunk( $addr, substr($buff,0x20) );
79			$self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );
80			return;
81			}
82			printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $size;
83			return $self->write_chunk( $addr, $buff );
84
85			my $chunk;
86
87			my $pos = 0;
88
89			while ( my $long = substr($buff,$pos,4) ) {
90			my @b = split(//, $long, 4);
91			$chunk .=
92			( $b[3] \|\| '' ) .
93			( $b[2] \|\| '' ) .
94			( $b[1] \|\| '' ) .
95			( $b[0] \|\| '' );
96			$pos += 4;
97			}
98
99			$self->write_chunk( $addr, $chunk );
100
101			};
102
103			=head2 save_dump
104
105			$orao->save_dump( 'filename', $from, $to );
106
107			=cut
108
109			sub save_dump {
110			my $self = shift;
111
112			my ( $path, $from, $to ) = @_;
113
114			$from \|\|= 0;
115			$to \|\|= 0xffff;
116
117			open(my $fh, '>', $path) \|\| die "can't open $path: $!";
118			print $fh $self->read_chunk( $from, $to );
119			close($fh);
120
121			my $size = -s $path;
122			printf "saved %s %d %x bytes\n", $path, $size, $size;
123			}
124
125			=head2 hexdump
126
127			$orao->hexdump( $address );
128
129			=cut
130
131			sub hexdump {
132			my $self = shift;
133			my $a = shift;
134			return sprintf(" %04x %s\n", $a,
135			join(" ",
136			map {
137			sprintf( "%02x", $_ )
138			} $self->ram( $a, $a+8 )
139			)
140			);
141			}
142
143			=head2 prompt
144
145			$orao->prompt( $address, $last_command );
146
147			=cut
148
149			sub prompt {
150			my $self = shift;
151			my $a = shift;
152			my $last = shift;
153			print $self->hexdump( $a ),
154			$last ? "[$last] " : '',
155			"> ";
156			my $in = <STDIN>;
157			chomp($in);
158			$in \|\|= $last;
159			$last = $in;
160			return split(/\s+/, $in) if $in;
161			}
162
163			=head1 AUTHOR
164
165			Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
166
167			=head1 BUGS
168
169			=head1 ACKNOWLEDGEMENTS
170
171			See also L<http://www.foing.hr/~fng_josip/orao.htm> which is source of all
172			info about this machine (and even hardware implementation from 2007).
173
174			=head1 COPYRIGHT & LICENSE
175
176			Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
177
178			This program is free software; you can redistribute it and/or modify it
179			under the same terms as Perl itself.
180
181			=cut
182
183			1; # End of Orao