line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Acme::6502::Tube; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
859
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
36
|
|
4
|
1
|
|
|
1
|
|
6
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
31
|
|
5
|
1
|
|
|
1
|
|
6
|
use Carp; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
77
|
|
6
|
1
|
|
|
1
|
|
5102
|
use Time::HiRes qw(time); |
|
1
|
|
|
|
|
11681
|
|
|
1
|
|
|
|
|
9
|
|
7
|
1
|
|
|
1
|
|
2012
|
use Term::ReadKey (); |
|
1
|
|
|
|
|
14317
|
|
|
1
|
|
|
|
|
41
|
|
8
|
1
|
|
|
1
|
|
14
|
use base qw(Acme::6502); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
183
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our $VERSION = '0.77'; |
11
|
|
|
|
|
|
|
|
12
|
1
|
|
|
1
|
|
7
|
use constant ERROR => 0xF800; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
110
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
use constant { |
15
|
1
|
|
|
|
|
87
|
PAGE => 0x0800, |
16
|
|
|
|
|
|
|
HIMEM => 0x8000 |
17
|
1
|
|
|
1
|
|
6
|
}; |
|
1
|
|
|
|
|
2
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
use constant { |
20
|
1
|
|
|
|
|
2682
|
OSRDRM => 0xFFB9, |
21
|
|
|
|
|
|
|
OSEVEN => 0xFFBF, |
22
|
|
|
|
|
|
|
GSINIT => 0xFFC2, |
23
|
|
|
|
|
|
|
GSREAD => 0xFFC5, |
24
|
|
|
|
|
|
|
NVWRCH => 0xFFC8, |
25
|
|
|
|
|
|
|
NVRDCH => 0xFFCB, |
26
|
|
|
|
|
|
|
OSFIND => 0xFFCE, |
27
|
|
|
|
|
|
|
OSGBPB => 0xFFD1, |
28
|
|
|
|
|
|
|
OSBPUT => 0xFFD4, |
29
|
|
|
|
|
|
|
OSBGET => 0xFFD7, |
30
|
|
|
|
|
|
|
OSARGS => 0xFFDA, |
31
|
|
|
|
|
|
|
OSFILE => 0xFFDD, |
32
|
|
|
|
|
|
|
OSASCI => 0xFFE3, |
33
|
|
|
|
|
|
|
OSNEWL => 0xFFE7, |
34
|
|
|
|
|
|
|
OSWRCH => 0xFFEE, |
35
|
|
|
|
|
|
|
OSRDCH => 0xFFE0, |
36
|
|
|
|
|
|
|
OSWORD => 0xFFF1, |
37
|
|
|
|
|
|
|
OSBYTE => 0xFFF4, |
38
|
|
|
|
|
|
|
OSCLI => 0xFFF7 |
39
|
1
|
|
|
1
|
|
6
|
}; |
|
1
|
|
|
|
|
3
|
|
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
sub _BUILD { |
42
|
0
|
|
|
0
|
|
|
my ( $self, $args ) = @_; |
43
|
|
|
|
|
|
|
|
44
|
0
|
|
|
|
|
|
$self->SUPER::_BUILD( $args ); |
45
|
|
|
|
|
|
|
|
46
|
0
|
|
|
|
|
|
$self->{ time_base } = time(); |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# Inline OSASCI code |
49
|
0
|
|
|
|
|
|
$self->poke_code( OSASCI, |
50
|
|
|
|
|
|
|
0xC9, 0x0D, # CMP #&0D |
51
|
|
|
|
|
|
|
0xD0, 0x07, # BNE +7 |
52
|
|
|
|
|
|
|
0xA9, 0x0A, # LDA #&0A |
53
|
|
|
|
|
|
|
0x20, 0xEE, 0xFF, # JSR &FFEE |
54
|
|
|
|
|
|
|
0xA9, 0x0D # LDA #&0D |
55
|
|
|
|
|
|
|
); |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
# BRK handler. The interrupt handling is bogus - so don't |
58
|
|
|
|
|
|
|
# generate any interrupts before fixing it :) |
59
|
0
|
|
|
|
|
|
$self->poke_code( |
60
|
|
|
|
|
|
|
0xFF00, 0x85, 0xFC, 0x68, 0x58, 0x29, 0x10, 0xF0, |
61
|
|
|
|
|
|
|
0x17, 0x8A, 0x48, 0xBA, 0x38, 0xBD, 0x02, 0x01, |
62
|
|
|
|
|
|
|
0xE9, 0x01, 0x85, 0xFD, 0xBD, 0x03, 0x01, 0xE9, |
63
|
|
|
|
|
|
|
0x00, 0x85, 0xFE, 0x68, 0xAA, 0x6C, 0x02, 0x02, |
64
|
|
|
|
|
|
|
0x6C, 0x04, 0x02 |
65
|
|
|
|
|
|
|
); |
66
|
|
|
|
|
|
|
|
67
|
0
|
|
|
|
|
|
$self->write_16( $self->BREAK, 0xFF00 ); |
68
|
|
|
|
|
|
|
|
69
|
0
|
|
|
|
|
|
$self->make_vector( 'OSCLI', 0x208, \&_oscli ); |
70
|
0
|
|
|
|
|
|
$self->make_vector( 'OSBYTE', 0x20A, \&_osbyte ); |
71
|
0
|
|
|
|
|
|
$self->make_vector( 'OSWORD', 0x20C, \&_osword ); |
72
|
0
|
|
|
|
|
|
$self->make_vector( 'OSWRCH', 0x20E, \&_oswrch ); |
73
|
0
|
|
|
|
|
|
$self->make_vector( 'OSRDCH', 0x210, \&_osrdch ); |
74
|
0
|
|
|
|
|
|
$self->make_vector( 'OSFILE', 0x212, \&_osfile ); |
75
|
0
|
|
|
|
|
|
$self->make_vector( 'OSARGS', 0x214, \&_osargs ); |
76
|
0
|
|
|
|
|
|
$self->make_vector( 'OSBGET', 0x216, \&_osbget ); |
77
|
0
|
|
|
|
|
|
$self->make_vector( 'OSBPUT', 0x218, \&_osbput ); |
78
|
0
|
|
|
|
|
|
$self->make_vector( 'OSGBPB', 0x21A, \&_osgbpb ); |
79
|
0
|
|
|
|
|
|
$self->make_vector( 'OSFIND', 0x21C, \&_osfind ); |
80
|
|
|
|
|
|
|
|
81
|
0
|
|
|
|
|
|
$self->set_jumptab( 0xFA00 ); |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub _oscli { |
85
|
0
|
|
|
0
|
|
|
my $self = shift; |
86
|
0
|
|
|
|
|
|
my $blk = $self->get_xy(); |
87
|
0
|
|
|
|
|
|
my $cmd = ''; |
88
|
0
|
|
|
|
|
|
CH: for ( ;; ) { |
89
|
0
|
|
|
|
|
|
my $ch = $self->read_8( $blk++ ); |
90
|
0
|
0
|
|
|
|
|
last CH if $ch < 0x20; |
91
|
0
|
|
|
|
|
|
$cmd .= chr( $ch ); |
92
|
|
|
|
|
|
|
} |
93
|
0
|
|
|
|
|
|
$cmd =~ s/^[\s\*]+//g; |
94
|
0
|
0
|
|
|
|
|
if ( lc( $cmd ) eq 'quit' ) { |
95
|
0
|
|
|
|
|
|
exit; |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
else { |
98
|
0
|
|
|
|
|
|
system( $cmd ); |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
sub _osbyte { |
103
|
0
|
|
|
0
|
|
|
my $self = shift; |
104
|
0
|
|
|
|
|
|
my $a = $self->get_a(); |
105
|
0
|
0
|
|
|
|
|
if ( $a == 0x7E ) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
106
|
|
|
|
|
|
|
# Ack escape |
107
|
0
|
|
|
|
|
|
$self->write_8( 0xFF, 0 ); |
108
|
0
|
|
|
|
|
|
$self->set_x( 0xFF ); |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
elsif ( $a == 0x82 ) { |
111
|
|
|
|
|
|
|
# Read m/c high order address |
112
|
0
|
|
|
|
|
|
$self->set_xy( 0 ); |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
elsif ( $a == 0x83 ) { |
115
|
|
|
|
|
|
|
# Read OSHWM (PAGE) |
116
|
0
|
|
|
|
|
|
$self->set_xy( PAGE ); |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
elsif ( $a == 0x84 ) { |
119
|
|
|
|
|
|
|
# Read HIMEM |
120
|
0
|
|
|
|
|
|
$self->set_xy( HIMEM ); |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
elsif ( $a == 0xDA ) { |
123
|
0
|
|
|
|
|
|
$self->set_xy( 0x0900 ); |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
else { |
126
|
0
|
|
|
|
|
|
die sprintf( "OSBYTE %02x not handled\n", $a ); |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
sub _set_escape { |
131
|
0
|
|
|
0
|
|
|
my $self = shift; |
132
|
0
|
|
|
|
|
|
$self->write_8( 0xFF, 0xFF ); |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
sub _osword { |
136
|
0
|
|
|
0
|
|
|
my $self = shift; |
137
|
0
|
|
|
|
|
|
my $a = $self->get_a(); |
138
|
0
|
|
|
|
|
|
my $blk = $self->get_xy(); |
139
|
|
|
|
|
|
|
|
140
|
0
|
0
|
|
|
|
|
if ( $a == 0x00 ) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
141
|
|
|
|
|
|
|
# Command line input |
142
|
0
|
|
|
|
|
|
my $buf = $self->read_16( $blk ); |
143
|
0
|
|
|
|
|
|
my $len = $self->read_8( $blk + 2 ); |
144
|
0
|
|
|
|
|
|
my $min = $self->read_8( $blk + 3 ); |
145
|
0
|
|
|
|
|
|
my $max = $self->read_8( $blk + 4 ); |
146
|
0
|
|
|
|
|
|
my $y = 0; |
147
|
0
|
0
|
|
|
|
|
if ( defined( my $in = <> ) ) { |
148
|
0
|
|
|
|
|
|
my @c = map ord, split //, $in; |
149
|
0
|
|
0
|
|
|
|
while ( @c && $len-- > 1 ) { |
150
|
0
|
|
|
|
|
|
my $c = shift @c; |
151
|
0
|
0
|
0
|
|
|
|
if ( $c >= $min && $c <= $max ) { |
152
|
0
|
|
|
|
|
|
$self->write_8( $buf + $y++, $c ); |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
} |
155
|
0
|
|
|
|
|
|
$self->write_8( $buf + $y++, 0x0D ); |
156
|
0
|
|
|
|
|
|
$self->set_y( $y ); |
157
|
0
|
|
|
|
|
|
$self->set_p( $self->get_p() & ~$self->C ); |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
else { |
160
|
|
|
|
|
|
|
# Escape I suppose... |
161
|
0
|
|
|
|
|
|
$self->set_p( $self->get_p() | $self->C ); |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
elsif ( $a == 0x01 ) { |
165
|
|
|
|
|
|
|
# Read clock |
166
|
0
|
|
|
|
|
|
my $now = int( ( time() - $self->{ time_base } ) * 100 ); |
167
|
0
|
|
|
|
|
|
$self->write_32( $blk, $now ); |
168
|
0
|
|
|
|
|
|
$self->write_8( $blk + 4, 0 ); |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
elsif ( $a == 0x02 ) { |
171
|
|
|
|
|
|
|
# Set clock |
172
|
0
|
|
|
|
|
|
my $tm = $self->read_32( $blk ); |
173
|
0
|
|
|
|
|
|
$self->{ time_base } = time() - ( $tm * 100 ); |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
else { |
176
|
0
|
|
|
|
|
|
die sprintf( "OSWORD %02x not handled\n", $a ); |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
sub _oswrch { |
181
|
0
|
|
|
0
|
|
|
my $self = shift; |
182
|
0
|
|
|
|
|
|
printf( "%c", $self->get_a() ); |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
sub _osrdch { |
186
|
0
|
|
|
0
|
|
|
my $self = shift; |
187
|
0
|
|
|
|
|
|
Term::ReadKey::ReadMode( 4 ); |
188
|
0
|
|
|
|
|
|
eval { |
189
|
0
|
|
|
|
|
|
my $k = ord( Term::ReadKey::ReadKey( 0 ) ); |
190
|
0
|
0
|
|
|
|
|
$k = 0x0D if $k == 0x0A; |
191
|
0
|
|
|
|
|
|
$self->set_a( $k ); |
192
|
0
|
0
|
|
|
|
|
if ( $k == 27 ) { |
193
|
0
|
|
|
|
|
|
$self->set_escape; |
194
|
0
|
|
|
|
|
|
$self->set_p( $self->get_p() | $self->C ); |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
else { |
197
|
0
|
|
|
|
|
|
$self->set_p( $self->get_p() & ~$self->C ); |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
}; |
200
|
0
|
|
|
|
|
|
Term::ReadKey::ReadMode( 0 ); |
201
|
0
|
0
|
|
|
|
|
die $@ if $@; |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
sub _osfile { |
205
|
0
|
|
|
0
|
|
|
my $self = shift; |
206
|
0
|
|
|
|
|
|
my $a = $self->get_a(); |
207
|
0
|
|
|
|
|
|
my $blk = $self->get_xy(); |
208
|
0
|
|
|
|
|
|
my $name = $self->read_str( $self->read_16( $blk ) ); |
209
|
0
|
|
|
|
|
|
my $load = $self->read_32( $blk + 2 ); |
210
|
0
|
|
|
|
|
|
my $exec = $self->read_32( $blk + 6 ); |
211
|
0
|
|
|
|
|
|
my $start = $self->read_32( $blk + 10 ); |
212
|
0
|
|
|
|
|
|
my $end = $self->read_32( $blk + 14 ); |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
# printf("%-20s %08x %08x %08x %08x\n", $name, $load, $exec, $start, $end); |
215
|
0
|
0
|
|
|
|
|
if ( $a == 0x00 ) { |
|
|
0
|
|
|
|
|
|
216
|
|
|
|
|
|
|
# Save |
217
|
0
|
0
|
|
|
|
|
open my $fh, '>', $name or die "Can't write $name\n"; |
218
|
0
|
|
|
|
|
|
binmode $fh; |
219
|
0
|
|
|
|
|
|
my $buf = $self->read_chunk( $start, $end ); |
220
|
0
|
0
|
|
|
|
|
syswrite $fh, $buf or die "Error writing $name\n"; |
221
|
0
|
|
|
|
|
|
$self->set_a( 1 ); |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
elsif ( $a == 0xFF ) { |
224
|
|
|
|
|
|
|
# Load |
225
|
0
|
0
|
|
|
|
|
if ( -f $name ) { |
|
|
0
|
|
|
|
|
|
226
|
0
|
0
|
|
|
|
|
open my $fh, '<', $name or die "Can't read $name\n"; |
227
|
0
|
|
|
|
|
|
binmode $fh; |
228
|
0
|
|
|
|
|
|
my $len = -s $fh; |
229
|
0
|
0
|
|
|
|
|
sysread $fh, my $buf, $len or die "Error reading $name\n"; |
230
|
0
|
0
|
|
|
|
|
$load = PAGE if $exec & 0xFF; |
231
|
0
|
|
|
|
|
|
$self->write_chunk( $load, $buf ); |
232
|
0
|
|
|
|
|
|
$self->write_32( $blk + 2, $load ); |
233
|
0
|
|
|
|
|
|
$self->write_32( $blk + 6, 0x00008023 ); |
234
|
0
|
|
|
|
|
|
$self->write_32( $blk + 10, $len ); |
235
|
0
|
|
|
|
|
|
$self->write_32( $blk + 14, 0x00000000 ); |
236
|
0
|
|
|
|
|
|
$self->set_a( 1 ); |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
elsif ( -d $name ) { |
239
|
0
|
|
|
|
|
|
$self->set_a( 2 ); |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
else { |
242
|
0
|
|
|
|
|
|
$self->set_a( 0 ); |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
else { |
246
|
0
|
|
|
|
|
|
die sprintf( "OSFILE %02x not handled\n", $a ); |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
sub _osargs { |
251
|
0
|
|
|
0
|
|
|
die "OSARGS not handled\n"; |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
sub _osbget { |
255
|
0
|
|
|
0
|
|
|
die "OSBGET not handled\n"; |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
sub _osbput { |
259
|
0
|
|
|
0
|
|
|
die "OSBPUT not handled\n"; |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
sub _osgbpb { |
263
|
0
|
|
|
0
|
|
|
die "OSGBPB not handled\n"; |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
sub _osfind { |
267
|
0
|
|
|
0
|
|
|
die "OSFIND not handled\n"; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
sub make_vector { |
271
|
0
|
|
|
0
|
1
|
|
my( $self, $name, $vec, $code ) = @_; |
272
|
|
|
|
|
|
|
|
273
|
0
|
|
|
|
|
|
my $addr = $self->$name; |
274
|
0
|
|
|
|
|
|
my $vecno = scalar @{ $self->{ os } }; |
|
0
|
|
|
|
|
|
|
275
|
0
|
|
|
|
|
|
push @{ $self->{ os } }, [ $code, $name ]; |
|
0
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
|
277
|
0
|
|
|
|
|
|
$self->SUPER::make_vector( $addr, $vec, $vecno ); |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
sub call_os { |
281
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
282
|
0
|
|
|
|
|
|
my $vecno = shift; |
283
|
|
|
|
|
|
|
|
284
|
0
|
|
|
|
|
|
eval { |
285
|
0
|
|
0
|
|
|
|
my $call = $self->{ os }->[ $vecno ] || die "Bad OS call $vecno\n"; |
286
|
0
|
|
|
|
|
|
$call->[ 0 ]->( $self ); |
287
|
|
|
|
|
|
|
}; |
288
|
|
|
|
|
|
|
|
289
|
0
|
0
|
|
|
|
|
if ( $@ ) { |
290
|
0
|
|
|
|
|
|
my $err = $@; |
291
|
0
|
|
|
|
|
|
$self->write_16( ERROR, 0x7F00 ); |
292
|
0
|
|
|
|
|
|
$err =~ s/\s+/ /; |
293
|
0
|
|
|
|
|
|
$err =~ s/^\s+//; |
294
|
0
|
|
|
|
|
|
$err =~ s/\s+$//; |
295
|
0
|
|
|
|
|
|
warn $err; |
296
|
0
|
|
|
|
|
|
my $ep = ERROR + 2; |
297
|
0
|
|
|
|
|
|
for ( map ord, split //, $err ) { |
298
|
0
|
|
|
|
|
|
$self->write_8( $ep++, $_ ); |
299
|
|
|
|
|
|
|
} |
300
|
0
|
|
|
|
|
|
$self->write_8( $ep++, 0x00 ); |
301
|
0
|
|
|
|
|
|
$self->set_pc( ERROR ); |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
1; |
306
|
|
|
|
|
|
|
__END__ |