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

        if ( $self->show_mem ) {

                warn "rendering memory map\n";

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

                foreach my $i ( 0 .. $#mmap / 3 ) {
                        my $o = $i * 3;
                        my ( $from, $to, $desc ) = @mmap[$o,$o+1,$o+2];
                        printf "%04x - %04x - %s\n", $from, $to, $desc;
                        for my $a ( $from .. $to ) {
                                if ( $a >= 0x6000 && $a < 0x8000 ) {
                                        my $b = $self->read( $a );
                                        $self->vram( $a - 0x6000, $b );
                                } else {
                                        $self->read( $a );
                                }
                        }
                }

        } else {

                warn "rendering video memory\n";
                for my $a ( 0x6000 .. 0x7fff ) {
                        $self->vram( $a - 0x6000, $mem[$a] );
                }
        
        }
        $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 ] );
        }
}

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