VRac/M6502/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 ) {
                confess sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
        }

        $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

sub cli {
        my $self = shift;
        my $a = $PC || confess "no pc?"; 
        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 sprintf(" PC: %04x A:%02x P:%02x X:%02x Y:%02x S:%02x\n", $PC, $A, $P, $X, $Y, $S);
                } 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 = '+';
                } elsif ( $c =~ m/^\+/ ) {
                        $a += 8;
                } elsif ( $c =~ m/^\-/ ) {
                        $a -= 8;
                } elsif ( $c =~ m/^m/i ) {
                        $a = $v;
                        $self->poke_code( $a, @v );
                        printf "poke %d bytes at %04x\n", $#v + 1, $a;
                        $last = '+';
                } 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";
                        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 = sprintf('m %04x', $to);
                        last;
                } elsif ( $c =~ m/^t/ ) {
                        $self->trace( not $self->trace );
                        print "trace ", $self->trace ? 'on' : 'off', "\n";
                } elsif ( $c =~ m/^d/ ) {
                        $self->debug( not $self->debug );
                        print "debug ", $self->debug ? 'on' : 'off', "\n";
                } 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	56	confess sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
304	dpavlin	52	}
305
306	dpavlin	33	$self->mmap_pixel( $addr, $byte, 0, 0 );
307	dpavlin	32
308			$mem[$addr] = $byte;
309	dpavlin	36	return;
310	dpavlin	32	}
311
312	dpavlin	42	=head1 Command Line
313	dpavlin	32
314	dpavlin	42	Command-line debugging intrerface is implemented for communication with
315			emulated device
316
317	dpavlin	50	=head2 prompt
318
319	dpavlin	61	my ( $entered_line, @p ) = $orao->prompt( $address, $last_command );
320	dpavlin	50
321			=cut
322
323			my $last = 'r 1';
324
325			sub prompt {
326			my $self = shift;
327			$self->app->sync;
328			my $a = shift;
329			print STDERR $self->hexdump( $a ),
330			$last ? "[$last] " : '',
331			"> ";
332			my $in = <STDIN>;
333			chomp($in);
334			warn "## prompt got: $in\n" if $self->debug;
335			$in \|\|= $last;
336			$last = $in;
337	dpavlin	61	return ( $in, split(/\s+/, $in) ) if $in;
338	dpavlin	50	}
339
340	dpavlin	42	=head2 cli
341
342			$orao->cli();
343
344			=cut
345
346			sub cli {
347			my $self = shift;
348			my $a = $PC \|\| confess "no pc?";
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	50	warn sprintf(" PC: %04x A:%02x P:%02x X:%02x Y:%02x S:%02x\n", $PC, $A, $P, $X, $Y, $S);
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	59	my $lines = int( ($to - $a + 8) / 8 );
379			printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
380			while ( --$lines ) {
381	dpavlin	42	print $self->hexdump( $a );
382			$a += 8;
383			}
384			$last = '+';
385			} elsif ( $c =~ m/^\+/ ) {
386			$a += 8;
387			} elsif ( $c =~ m/^\-/ ) {
388			$a -= 8;
389			} elsif ( $c =~ m/^m/i ) {
390			$a = $v;
391			$self->poke_code( $a, @v );
392			printf "poke %d bytes at %04x\n", $#v + 1, $a;
393	dpavlin	50	$last = '+';
394	dpavlin	42	} elsif ( $c =~ m/^l/i ) {
395			my $to = shift @v \|\| 0x1000;
396			$a = $to;
397			$self->load_oraoemu( $v, $a );
398	dpavlin	50	$last = '';
399	dpavlin	42	} elsif ( $c =~ m/^s/i ) {
400			$self->save_dump( $v \|\| 'mem.dump', @v );
401	dpavlin	50	$last = '';
402	dpavlin	42	} elsif ( $c =~ m/^r/i ) {
403			$run_for = $v \|\| 1;
404			print "run_for $run_for instructions\n";
405			last;
406			} elsif ( $c =~ m/^(u\|j)/ ) {
407			my $to = $v \|\| $a;
408			printf "set pc to %04x\n", $to;
409			$PC = $to; # remember for restart
410			$run_for = 1;
411	dpavlin	50	$last = sprintf('m %04x', $to);
412	dpavlin	42	last;
413			} elsif ( $c =~ m/^t/ ) {
414			$self->trace( not $self->trace );
415			print "trace ", $self->trace ? 'on' : 'off', "\n";
416	dpavlin	49	} elsif ( $c =~ m/^d/ ) {
417			$self->debug( not $self->debug );
418			print "debug ", $self->debug ? 'on' : 'off', "\n";
419	dpavlin	42	} else {
420	dpavlin	61	warn "# ignored $line\n" if ($line);
421			$last = '';
422	dpavlin	42	}
423			}
424
425			}
426
427	dpavlin	29	=head1 AUTHOR
428
429			Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
430
431			=head1 BUGS
432
433			=head1 ACKNOWLEDGEMENTS
434
435			See also L<http://www.foing.hr/~fng_josip/orao.htm> which is source of all
436			info about this machine (and even hardware implementation from 2007).
437
438			=head1 COPYRIGHT & LICENSE
439
440			Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
441
442			This program is free software; you can redistribute it and/or modify it
443			under the same terms as Perl itself.
444
445			=cut
446
447			1; # End of Orao