/[VRac]/Orao.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /Orao.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 31 - (hide annotations)
Mon Jul 30 18:07:29 2007 UTC (16 years, 8 months ago) by dpavlin
Original Path: M6502/Orao.pm
File size: 3424 byte(s)
startup, open window
1 dpavlin 29 package Orao;
2    
3     use warnings;
4     use strict;
5    
6     use Carp;
7     use lib './lib';
8     #use Time::HiRes qw(time);
9     use File::Slurp;
10    
11 dpavlin 30 use base qw(Class::Accessor M6502 Screen);
12 dpavlin 29 __PACKAGE__->mk_accessors(qw(debug trace run_for mem_dump trace));
13    
14     =head1 NAME
15    
16     Orao - Orao emulator
17    
18     =head1 VERSION
19    
20     Version 0.02
21    
22     =cut
23    
24     our $VERSION = '0.02';
25    
26     =head1 SUMMARY
27    
28     Emulator or Orao 8-bit 6502 machine popular in Croatia
29    
30     =cut
31    
32 dpavlin 30 =head2 init
33    
34     Start emulator
35    
36     =cut
37    
38     sub init {
39     my $self = shift;
40     warn "call upstream init\n";
41     $self->SUPER::init( @_ );
42    
43 dpavlin 31 warn "staring Orao $Orao::VERSION emulation\n";
44 dpavlin 30
45     $self->open_screen;
46     $self->load_rom;
47     }
48    
49 dpavlin 29 my $loaded_files = {
50     0xC000 => 'rom/BAS12.ROM',
51     0xE000 => 'rom/CRT12.ROM',
52     };
53    
54     =head2 load_rom
55    
56     called to init memory and load initial rom images
57    
58     $orao->load_rom;
59    
60     =cut
61    
62     sub load_rom {
63     my ($self) = @_;
64    
65     #my $time_base = time();
66    
67     foreach my $addr ( sort keys %$loaded_files ) {
68     my $path = $loaded_files->{$addr};
69     printf "loading '%s' at %04x\n", $path, $addr;
70     $self->load_oraoemu( $path, $addr );
71     }
72     }
73    
74    
75     =head2 load_oraoemu
76    
77     =cut
78    
79     sub load_oraoemu {
80     my $self = shift;
81     my ( $path, $addr ) = @_;
82    
83 dpavlin 31 my $size = -s $path || confess "no size for $path: $!";
84 dpavlin 29
85     my $buff = read_file( $path );
86    
87     if ( $size == 65538 ) {
88     $addr = 0;
89     printf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $size;
90     $self->write_chunk( $addr, substr($buff,2) );
91     return;
92     } elsif ( $size == 32800 ) {
93     $addr = 0;
94     printf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $size;
95     #$self->write_chunk( $addr, substr($buff,0x20) );
96     $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );
97     return;
98     }
99     printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $size;
100     return $self->write_chunk( $addr, $buff );
101    
102     my $chunk;
103    
104     my $pos = 0;
105    
106     while ( my $long = substr($buff,$pos,4) ) {
107     my @b = split(//, $long, 4);
108     $chunk .=
109     ( $b[3] || '' ) .
110     ( $b[2] || '' ) .
111     ( $b[1] || '' ) .
112     ( $b[0] || '' );
113     $pos += 4;
114     }
115    
116     $self->write_chunk( $addr, $chunk );
117    
118     };
119    
120     =head2 save_dump
121    
122     $orao->save_dump( 'filename', $from, $to );
123    
124     =cut
125    
126     sub save_dump {
127     my $self = shift;
128    
129     my ( $path, $from, $to ) = @_;
130    
131     $from ||= 0;
132     $to ||= 0xffff;
133    
134     open(my $fh, '>', $path) || die "can't open $path: $!";
135     print $fh $self->read_chunk( $from, $to );
136     close($fh);
137    
138     my $size = -s $path;
139     printf "saved %s %d %x bytes\n", $path, $size, $size;
140     }
141    
142     =head2 hexdump
143    
144     $orao->hexdump( $address );
145    
146     =cut
147    
148     sub hexdump {
149     my $self = shift;
150     my $a = shift;
151     return sprintf(" %04x %s\n", $a,
152     join(" ",
153     map {
154     sprintf( "%02x", $_ )
155     } $self->ram( $a, $a+8 )
156     )
157     );
158     }
159    
160     =head2 prompt
161    
162     $orao->prompt( $address, $last_command );
163    
164     =cut
165    
166     sub prompt {
167     my $self = shift;
168     my $a = shift;
169     my $last = shift;
170     print $self->hexdump( $a ),
171     $last ? "[$last] " : '',
172     "> ";
173     my $in = <STDIN>;
174     chomp($in);
175     $in ||= $last;
176     $last = $in;
177     return split(/\s+/, $in) if $in;
178     }
179    
180 dpavlin 30
181 dpavlin 29 =head1 AUTHOR
182    
183     Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
184    
185     =head1 BUGS
186    
187     =head1 ACKNOWLEDGEMENTS
188    
189     See also L<http://www.foing.hr/~fng_josip/orao.htm> which is source of all
190     info about this machine (and even hardware implementation from 2007).
191    
192     =head1 COPYRIGHT & LICENSE
193    
194     Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
195    
196     This program is free software; you can redistribute it and/or modify it
197     under the same terms as Perl itself.
198    
199     =cut
200    
201     1; # End of Orao

  ViewVC Help
Powered by ViewVC 1.1.26