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	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