viewvc.cgi/VRac/Orao.pm

package Orao;

use warnings;
use strict;

use Carp qw/confess/;
use lib './lib';
#use Time::HiRes qw(time);
use File::Slurp;
use Data::Dump qw/dump/;
use M6502;

use base qw(Class::Accessor M6502 Screen Prefs);
__PACKAGE__->mk_accessors(qw(run_for));

=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

=head2 init

Start emulator, open L<Screen>, load initial ROM images, and render memory

=cut

our $orao;

select(STDERR); $| = 1;

sub init {
        my $self = shift;
        warn "Orao calling upstream init\n";
        $self->SUPER::init( $self, @_ );

        warn "Orao $Orao::VERSION emulation starting\n";

        $self->open_screen;
        $self->load_rom({
                0x1000 => 'dump/SCRINV.BIN',
                # should be 0x6000, but oraoemu has 2 byte prefix
                0x5FFE => 'dump/screen.dmp',
                0xC000 => 'rom/BAS12.ROM',
                0xE000 => 'rom/CRT12.ROM',
        });

#       $PC = 0xDD11;   # BC
#       $PC = 0xC274;   # MC

        $orao = $self;

#       $self->prompt( 0x1000 );

        my ( $trace, $debug ) = ( $self->trace, $self->debug );
        $self->trace( 0 );
        $self->debug( 0 );

        $self->render( @mem[ 0x6000 .. 0x7fff ] );

        if ( $self->show_mem ) {

                warn "rendering memory map\n";

                $self->render_mem( @mem );

                my @mmap = (
                        0x0000, 0x03FF, 'nulti blok',
                        0x0400, 0x5FFF, 'korisnièki RAM (23K)',
                        0x6000, 0x7FFF, 'video RAM',
                        0x8000, 0x9FFF, 'sistemske lokacije',
                        0xA000, 0xAFFF, 'ekstenzija',
                        0xB000, 0xBFFF, 'DOS',
                        0xC000, 0xDFFF, 'BASIC ROM',
                        0xE000, 0xFFFF, 'sistemski ROM',
                );

        } else {

                warn "rendering video memory\n";
                $self->render( @mem[ 0x6000 .. 0x7fff ] );
        
        }
        $self->sync;
        $self->trace( $trace );
        $self->debug( $debug );

        #( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );

        warn "Orao init finished",
                $self->trace ? ' trace' : '',
                $self->debug ? ' debug' : '',
                "\n";

}

=head2 load_rom

called to init memory and load initial rom images

  $orao->load_rom;

=cut

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

    #my $time_base = time();

        foreach my $addr ( sort keys %$loaded_files ) {
                my $path = $loaded_files->{$addr};
                $self->load_oraoemu( $path, $addr );
        }
}

# write chunk directly into memory, updateing vram if needed
sub _write_chunk {
        my $self = shift;
        my ( $addr, $chunk ) = @_;
        $self->write_chunk( $addr, $chunk );
        my $end = $addr + length($chunk);
        my ( $f, $t ) = ( 0x6000, 0x7fff );

        if ( $end < $f || $addr >= $t ) {
                warn "skip vram update\n";
                return;
        };

        $f = $addr if ( $addr > $f );
        $t = $end if ( $end < $t );

        warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
#       foreach my $a ( $f .. $t ) {
#               $self->vram( $a - 0x6000 , $mem[ $a ] );
#       }
        $self->render( @mem[ 0x6000 .. 0x7fff ] );
        $self->render_mem( @mem ) if $self->show_mem;
}

=head2 load_oraoemu

Load binary files, ROM images and Orao Emulator files

  $orao->load_oraoemu( '/path/to/file', 0x1000 );

Returns true on success.

=cut

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

        if ( ! -e $path ) {
                warn "ERROR: file $path doesn't exist\n";
                return;
        }

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

        my $buff = read_file( $path );

        if ( $size == 65538 ) {
                $addr = 0;
                warn sprintf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
                $self->_write_chunk( $addr, substr($buff,2) );
                return 1;
        } elsif ( $size == 32800 ) {
                $addr = 0;
                warn sprintf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
                $self->_write_chunk( $addr, substr($buff,0x20) );
                return 1;
        }
        printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
        $self->_write_chunk( $addr, $buff );
        return 1;

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

        return 1;
};

=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;
        warn sprintf "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 {
                                if ( defined($_) ) {
                                        sprintf( "%02x", $_ )
                                } else {
                                        '  '
                                }
                        } @mem[ $a .. $a+8 ]
                )
        );
}

=head1 Memory management

Orao implements all I/O using mmap addresses. This was main reason why
L<Acme::6502> was just too slow to handle it.

=cut

=head2 read

Read from memory

  $byte = read( $address );

=cut

sub read {
        my $self = shift;
        my ($addr) = @_;
        my $byte = $mem[$addr];
        warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
        $self->mmap_pixel( $addr, 0, $byte, 0 );
        return $byte;
}

=head2 write

Write into emory

  write( $address, $byte );

=cut

sub write {
        my $self = shift;
        my ($addr,$byte) = @_;
        warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;

        if ( $addr >= 0x6000 && $addr < 0x8000 ) {
                $self->vram( $addr - 0x6000 , $byte );
        }

        if ( $addr == 0x8800 ) {
                warn sprintf "sound ignored: %x\n", $byte;
        }

        if ( $addr > 0xafff ) {
                warn sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
                return;
        }

        $self->mmap_pixel( $addr, $byte, 0, 0 );

        $mem[$addr] = $byte;
        return;
}

=head1 Command Line

Command-line debugging intrerface is implemented for communication with
emulated device

=head2 prompt

  my ( $entered_line, @p ) = $orao->prompt( $address, $last_command );

=cut

my $last = 'r 1';

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

=head2 cli

  $orao->cli();

=cut

my $show_R = 0;

sub cli {
        my $self = shift;
        my $a = $PC || confess "no pc?"; 
        warn $self->dump_R() if $show_R;
        while ( my ($line, @v) = $self->prompt( $a, $last ) ) {
                my $c = shift @v;
                next unless defined($c);
                my $v = shift @v;
                $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
                @v = map { hex($_) } @v;
                printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
                if ( $c =~ m/^[qx]/i ) {
                        exit;
                } elsif ( $c eq '?' ) {
                        my $t = $self->trace ? 'on' : 'off' ;
                        my $d = $self->debug ? 'on' : 'off' ;
                        warn <<__USAGE__;
Usage:

x|q\t\texit
e 6000 6010\tdump memory, +/- to walk forward/backward
m 1000 ff 00\tput ff 00 on 1000
j|u 1000\t\tjump (change pc)
r 42\t\trun 42 instruction opcodes
t\t\ttrace [$t]
d\t\tdebug [$d]

__USAGE__
                        warn $self->dump_R;
                } elsif ( $c =~ m/^e/i ) {
                        $a = $v if defined($v);
                        my $to = shift @v;
                        $to = $a + 32 if ( ! $to || $to <= $a );
                        $to = 0xffff if ( $to > 0xffff );
                        my $lines = int( ($to - $a + 8) / 8 );
                        printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
                        while ( --$lines ) {
                                print $self->hexdump( $a );
                                $a += 8;
                        }
                        $last = '+';
                        $show_R = 0;
                } elsif ( $c =~ m/^\+/ ) {
                        $a += 8;
                        $show_R = 0;
                } elsif ( $c =~ m/^\-/ ) {
                        $a -= 8;
                        $show_R = 0;
                } elsif ( $c =~ m/^m/i ) {
                        $a = $v if defined($v);
                        $self->poke_code( $a, @v );
                        printf "poke %d bytes at %04x\n", $#v + 1, $a;
                        $last = '+';
                        $show_R = 0;
                } elsif ( $c =~ m/^l/i ) {
                        my $to = shift @v || 0x1000;
                        $a = $to;
                        $self->load_oraoemu( $v, $a );
                        $last = '';
                } elsif ( $c =~ m/^s/i ) {
                        $self->save_dump( $v || 'mem.dump', @v );
                        $last = '';
                } elsif ( $c =~ m/^r/i ) {
                        $run_for = $v || 1;
                        print "run_for $run_for instructions\n";
                        $show_R = 1;
                        last;
                } elsif ( $c =~ m/^(u|j)/ ) {
                        my $to = $v || $a;
                        printf "set pc to %04x\n", $to;
                        $PC = $to;      # remember for restart
                        $run_for = 1;
                        $last = "r $run_for";
                        $show_R = 1;
                        last;
                } elsif ( $c =~ m/^t/ ) {
                        $self->trace( not $self->trace );
                        print "trace ", $self->trace ? 'on' : 'off', "\n";
                        $last = '';
                } elsif ( $c =~ m/^d/ ) {
                        $self->debug( not $self->debug );
                        print "debug ", $self->debug ? 'on' : 'off', "\n";
                        $last = '';
                } else {
                        warn "# ignored $line\n" if ($line);
                        $last = '';
                }
        }

}

=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	dpavlin	56	use Carp qw/confess/;
7	dpavlin	29	use lib './lib';
8			#use Time::HiRes qw(time);
9			use File::Slurp;
10	dpavlin	32	use Data::Dump qw/dump/;
11	dpavlin	34	use M6502;
12	dpavlin	29
13	dpavlin	56	use base qw(Class::Accessor M6502 Screen Prefs);
14			__PACKAGE__->mk_accessors(qw(run_for));
15	dpavlin	29
16			=head1 NAME
17
18			Orao - Orao emulator
19
20			=head1 VERSION
21
22			Version 0.02
23
24			=cut
25
26			our $VERSION = '0.02';
27
28			=head1 SUMMARY
29
30			Emulator or Orao 8-bit 6502 machine popular in Croatia
31
32			=cut
33
34	dpavlin	30	=head2 init
35
36	dpavlin	56	Start emulator, open L<Screen>, load initial ROM images, and render memory
37	dpavlin	30
38			=cut
39
40	dpavlin	32	our $orao;
41
42	dpavlin	42	select(STDERR); $\| = 1;
43
44	dpavlin	30	sub init {
45			my $self = shift;
46	dpavlin	34	warn "Orao calling upstream init\n";
47	dpavlin	33	$self->SUPER::init( $self, @_ );
48	dpavlin	30
49	dpavlin	56	warn "Orao $Orao::VERSION emulation starting\n";
50	dpavlin	30
51			$self->open_screen;
52	dpavlin	33	$self->load_rom({
53			0x1000 => 'dump/SCRINV.BIN',
54	dpavlin	76	# should be 0x6000, but oraoemu has 2 byte prefix
55			0x5FFE => 'dump/screen.dmp',
56	dpavlin	33	0xC000 => 'rom/BAS12.ROM',
57			0xE000 => 'rom/CRT12.ROM',
58			});
59	dpavlin	32
60	dpavlin	73	# $PC = 0xDD11; # BC
61	dpavlin	46	# $PC = 0xC274; # MC
62	dpavlin	35
63	dpavlin	32	$orao = $self;
64
65	dpavlin	33	# $self->prompt( 0x1000 );
66
67	dpavlin	49	my ( $trace, $debug ) = ( $self->trace, $self->debug );
68	dpavlin	38	$self->trace( 0 );
69	dpavlin	49	$self->debug( 0 );
70	dpavlin	33
71	dpavlin	73	$self->render( @mem[ 0x6000 .. 0x7fff ] );
72
73	dpavlin	38	if ( $self->show_mem ) {
74	dpavlin	33
75	dpavlin	38	warn "rendering memory map\n";
76
77	dpavlin	76	$self->render_mem( @mem );
78
79	dpavlin	38	my @mmap = (
80			0x0000, 0x03FF, 'nulti blok',
81			0x0400, 0x5FFF, 'korisnièki RAM (23K)',
82			0x6000, 0x7FFF, 'video RAM',
83			0x8000, 0x9FFF, 'sistemske lokacije',
84			0xA000, 0xAFFF, 'ekstenzija',
85			0xB000, 0xBFFF, 'DOS',
86			0xC000, 0xDFFF, 'BASIC ROM',
87			0xE000, 0xFFFF, 'sistemski ROM',
88			);
89
90			} else {
91
92			warn "rendering video memory\n";
93	dpavlin	73	$self->render( @mem[ 0x6000 .. 0x7fff ] );
94	dpavlin	38
95	dpavlin	33	}
96	dpavlin	38	$self->sync;
97			$self->trace( $trace );
98	dpavlin	49	$self->debug( $debug );
99	dpavlin	33
100	dpavlin	39	#( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );
101	dpavlin	34
102	dpavlin	49	warn "Orao init finished",
103			$self->trace ? ' trace' : '',
104			$self->debug ? ' debug' : '',
105			"\n";
106	dpavlin	38
107	dpavlin	30	}
108
109	dpavlin	29	=head2 load_rom
110
111			called to init memory and load initial rom images
112
113			$orao->load_rom;
114
115			=cut
116
117			sub load_rom {
118	dpavlin	33	my ($self, $loaded_files) = @_;
119	dpavlin	29
120			#my $time_base = time();
121
122			foreach my $addr ( sort keys %$loaded_files ) {
123			my $path = $loaded_files->{$addr};
124			$self->load_oraoemu( $path, $addr );
125			}
126			}
127
128	dpavlin	61	# write chunk directly into memory, updateing vram if needed
129	dpavlin	46	sub _write_chunk {
130			my $self = shift;
131			my ( $addr, $chunk ) = @_;
132			$self->write_chunk( $addr, $chunk );
133			my $end = $addr + length($chunk);
134			my ( $f, $t ) = ( 0x6000, 0x7fff );
135
136			if ( $end < $f \|\| $addr >= $t ) {
137			warn "skip vram update\n";
138			return;
139			};
140
141			$f = $addr if ( $addr > $f );
142			$t = $end if ( $end < $t );
143
144			warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
145	dpavlin	73	# foreach my $a ( $f .. $t ) {
146			# $self->vram( $a - 0x6000 , $mem[ $a ] );
147			# }
148			$self->render( @mem[ 0x6000 .. 0x7fff ] );
149	dpavlin	77	$self->render_mem( @mem ) if $self->show_mem;
150	dpavlin	46	}
151
152	dpavlin	61	=head2 load_oraoemu
153
154			Load binary files, ROM images and Orao Emulator files
155
156			$orao->load_oraoemu( '/path/to/file', 0x1000 );
157
158			Returns true on success.
159
160			=cut
161
162	dpavlin	29	sub load_oraoemu {
163			my $self = shift;
164			my ( $path, $addr ) = @_;
165
166	dpavlin	61	if ( ! -e $path ) {
167			warn "ERROR: file $path doesn't exist\n";
168			return;
169			}
170
171	dpavlin	31	my $size = -s $path \|\| confess "no size for $path: $!";
172	dpavlin	29
173			my $buff = read_file( $path );
174
175			if ( $size == 65538 ) {
176			$addr = 0;
177	dpavlin	33	warn sprintf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
178	dpavlin	46	$self->_write_chunk( $addr, substr($buff,2) );
179	dpavlin	61	return 1;
180	dpavlin	29	} elsif ( $size == 32800 ) {
181			$addr = 0;
182	dpavlin	33	warn sprintf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
183	dpavlin	46	$self->_write_chunk( $addr, substr($buff,0x20) );
184	dpavlin	61	return 1;
185	dpavlin	29	}
186	dpavlin	33	printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
187	dpavlin	61	$self->_write_chunk( $addr, $buff );
188			return 1;
189	dpavlin	29
190			my $chunk;
191
192			my $pos = 0;
193
194			while ( my $long = substr($buff,$pos,4) ) {
195			my @b = split(//, $long, 4);
196			$chunk .=
197			( $b[3] \|\| '' ) .
198			( $b[2] \|\| '' ) .
199			( $b[1] \|\| '' ) .
200			( $b[0] \|\| '' );
201			$pos += 4;
202			}
203
204	dpavlin	46	$self->_write_chunk( $addr, $chunk );
205	dpavlin	29
206	dpavlin	61	return 1;
207	dpavlin	29	};
208
209			=head2 save_dump
210
211			$orao->save_dump( 'filename', $from, $to );
212
213			=cut
214
215			sub save_dump {
216			my $self = shift;
217
218			my ( $path, $from, $to ) = @_;
219
220			$from \|\|= 0;
221			$to \|\|= 0xffff;
222
223			open(my $fh, '>', $path) \|\| die "can't open $path: $!";
224			print $fh $self->read_chunk( $from, $to );
225			close($fh);
226
227			my $size = -s $path;
228	dpavlin	32	warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
229	dpavlin	29	}
230
231			=head2 hexdump
232
233			$orao->hexdump( $address );
234
235			=cut
236
237			sub hexdump {
238			my $self = shift;
239			my $a = shift;
240			return sprintf(" %04x %s\n", $a,
241			join(" ",
242			map {
243	dpavlin	71	if ( defined($_) ) {
244			sprintf( "%02x", $_ )
245			} else {
246			' '
247			}
248	dpavlin	47	} @mem[ $a .. $a+8 ]
249	dpavlin	29	)
250			);
251			}
252
253	dpavlin	32	=head1 Memory management
254	dpavlin	30
255	dpavlin	32	Orao implements all I/O using mmap addresses. This was main reason why
256			L<Acme::6502> was just too slow to handle it.
257
258			=cut
259
260			=head2 read
261
262			Read from memory
263
264			$byte = read( $address );
265
266			=cut
267
268			sub read {
269	dpavlin	33	my $self = shift;
270	dpavlin	32	my ($addr) = @_;
271			my $byte = $mem[$addr];
272	dpavlin	41	warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
273	dpavlin	33	$self->mmap_pixel( $addr, 0, $byte, 0 );
274	dpavlin	32	return $byte;
275			}
276
277			=head2 write
278
279			Write into emory
280
281			write( $address, $byte );
282
283			=cut
284
285			sub write {
286	dpavlin	33	my $self = shift;
287	dpavlin	32	my ($addr,$byte) = @_;
288	dpavlin	41	warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
289	dpavlin	32
290			if ( $addr >= 0x6000 && $addr < 0x8000 ) {
291			$self->vram( $addr - 0x6000 , $byte );
292			}
293
294			if ( $addr == 0x8800 ) {
295			warn sprintf "sound ignored: %x\n", $byte;
296			}
297
298	dpavlin	52	if ( $addr > 0xafff ) {
299	dpavlin	65	warn sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
300			return;
301	dpavlin	52	}
302
303	dpavlin	33	$self->mmap_pixel( $addr, $byte, 0, 0 );
304	dpavlin	32
305			$mem[$addr] = $byte;
306	dpavlin	36	return;
307	dpavlin	32	}
308
309	dpavlin	42	=head1 Command Line
310	dpavlin	32
311	dpavlin	42	Command-line debugging intrerface is implemented for communication with
312			emulated device
313
314	dpavlin	50	=head2 prompt
315
316	dpavlin	61	my ( $entered_line, @p ) = $orao->prompt( $address, $last_command );
317	dpavlin	50
318			=cut
319
320			my $last = 'r 1';
321
322			sub prompt {
323			my $self = shift;
324			$self->app->sync;
325			my $a = shift;
326			print STDERR $self->hexdump( $a ),
327			$last ? "[$last] " : '',
328			"> ";
329			my $in = <STDIN>;
330			chomp($in);
331			warn "## prompt got: $in\n" if $self->debug;
332			$in \|\|= $last;
333			$last = $in;
334	dpavlin	61	return ( $in, split(/\s+/, $in) ) if $in;
335	dpavlin	50	}
336
337	dpavlin	42	=head2 cli
338
339			$orao->cli();
340
341			=cut
342
343	dpavlin	68	my $show_R = 0;
344
345	dpavlin	42	sub cli {
346			my $self = shift;
347			my $a = $PC \|\| confess "no pc?";
348	dpavlin	68	warn $self->dump_R() if $show_R;
349	dpavlin	61	while ( my ($line, @v) = $self->prompt( $a, $last ) ) {
350	dpavlin	42	my $c = shift @v;
351	dpavlin	61	next unless defined($c);
352	dpavlin	42	my $v = shift @v;
353			$v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
354			@v = map { hex($_) } @v;
355	dpavlin	49	printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v \|\| 'undef'), join(",",@v) if $self->debug;
356	dpavlin	42	if ( $c =~ m/^[qx]/i ) {
357			exit;
358			} elsif ( $c eq '?' ) {
359	dpavlin	50	my $t = $self->trace ? 'on' : 'off' ;
360			my $d = $self->debug ? 'on' : 'off' ;
361	dpavlin	42	warn <<__USAGE__;
362	dpavlin	50	Usage:
363
364	dpavlin	42	x\|q\t\texit
365			e 6000 6010\tdump memory, +/- to walk forward/backward
366			m 1000 ff 00\tput ff 00 on 1000
367			j\|u 1000\t\tjump (change pc)
368			r 42\t\trun 42 instruction opcodes
369	dpavlin	50	t\t\ttrace [$t]
370			d\t\tdebug [$d]
371
372	dpavlin	42	__USAGE__
373	dpavlin	68	warn $self->dump_R;
374	dpavlin	42	} elsif ( $c =~ m/^e/i ) {
375	dpavlin	49	$a = $v if defined($v);
376	dpavlin	42	my $to = shift @v;
377			$to = $a + 32 if ( ! $to \|\| $to <= $a );
378	dpavlin	71	$to = 0xffff if ( $to > 0xffff );
379	dpavlin	59	my $lines = int( ($to - $a + 8) / 8 );
380			printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
381			while ( --$lines ) {
382	dpavlin	42	print $self->hexdump( $a );
383			$a += 8;
384			}
385			$last = '+';
386	dpavlin	68	$show_R = 0;
387	dpavlin	42	} elsif ( $c =~ m/^\+/ ) {
388			$a += 8;
389	dpavlin	68	$show_R = 0;
390	dpavlin	42	} elsif ( $c =~ m/^\-/ ) {
391			$a -= 8;
392	dpavlin	68	$show_R = 0;
393	dpavlin	42	} elsif ( $c =~ m/^m/i ) {
394	dpavlin	70	$a = $v if defined($v);
395	dpavlin	42	$self->poke_code( $a, @v );
396			printf "poke %d bytes at %04x\n", $#v + 1, $a;
397	dpavlin	50	$last = '+';
398	dpavlin	68	$show_R = 0;
399	dpavlin	42	} elsif ( $c =~ m/^l/i ) {
400			my $to = shift @v \|\| 0x1000;
401			$a = $to;
402			$self->load_oraoemu( $v, $a );
403	dpavlin	50	$last = '';
404	dpavlin	42	} elsif ( $c =~ m/^s/i ) {
405			$self->save_dump( $v \|\| 'mem.dump', @v );
406	dpavlin	50	$last = '';
407	dpavlin	42	} elsif ( $c =~ m/^r/i ) {
408			$run_for = $v \|\| 1;
409			print "run_for $run_for instructions\n";
410	dpavlin	68	$show_R = 1;
411	dpavlin	42	last;
412			} elsif ( $c =~ m/^(u\|j)/ ) {
413			my $to = $v \|\| $a;
414			printf "set pc to %04x\n", $to;
415			$PC = $to; # remember for restart
416			$run_for = 1;
417	dpavlin	62	$last = "r $run_for";
418	dpavlin	68	$show_R = 1;
419	dpavlin	42	last;
420			} elsif ( $c =~ m/^t/ ) {
421			$self->trace( not $self->trace );
422			print "trace ", $self->trace ? 'on' : 'off', "\n";
423	dpavlin	64	$last = '';
424	dpavlin	49	} elsif ( $c =~ m/^d/ ) {
425			$self->debug( not $self->debug );
426			print "debug ", $self->debug ? 'on' : 'off', "\n";
427	dpavlin	64	$last = '';
428	dpavlin	42	} else {
429	dpavlin	61	warn "# ignored $line\n" if ($line);
430			$last = '';
431	dpavlin	42	}
432			}
433
434			}
435
436	dpavlin	29	=head1 AUTHOR
437
438			Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
439
440			=head1 BUGS
441
442			=head1 ACKNOWLEDGEMENTS
443
444			See also L<http://www.foing.hr/~fng_josip/orao.htm> which is source of all
445			info about this machine (and even hardware implementation from 2007).
446
447			=head1 COPYRIGHT & LICENSE
448
449			Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
450
451			This program is free software; you can redistribute it and/or modify it
452			under the same terms as Perl itself.
453
454			=cut
455
456			1; # End of Orao