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',
#               0x6000 => '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";

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

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