ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/vt102/vt102
(Generate patch)

Comparing vt102/vt102 (file contents):
Revision 1.18 by root, Wed Dec 3 02:16:45 2014 UTC vs.
Revision 1.30 by root, Fri Dec 5 07:34:56 2014 UTC

15# 15#
16 16
17# If this file contains embedded ROMs, the above copyright notice does 17# If this file contains embedded ROMs, the above copyright notice does
18# not apply to them. 18# not apply to them.
19 19
20use 5.010;
20use strict; 21use strict;
22use integer;
21#use common::sense; 23#use common::sense;
22 24
23my $VT102 = 1; 25my $VT102 = 1;
24my $VT131 = 0; 26my $VT131 = 0;
25my $AVO = 1; 27my $AVO = 1;
27shift, ($VT102 = 0), ($AVO = 0) if $ARGV[0] =~ /^-?-vt100$/; 29shift, ($VT102 = 0), ($AVO = 0) if $ARGV[0] =~ /^-?-vt100$/;
28shift, ($VT102 = 0) if $ARGV[0] =~ /^-?-vt100\+avo$/; 30shift, ($VT102 = 0) if $ARGV[0] =~ /^-?-vt100\+avo$/;
29shift if $ARGV[0] =~ /^-?-vt102$/; 31shift if $ARGV[0] =~ /^-?-vt102$/;
30shift, ($VT131 = 1) if $ARGV[0] =~ /^-?-vt131$/; 32shift, ($VT131 = 1) if $ARGV[0] =~ /^-?-vt131$/;
31 33
34# vt100 wps = word processing roms
35# vt101 = vt102 - avo, but custom rom? really?
36# vt103 = vt100 + tu58 tape drive
37# vt125 = vt100 + gpo graphics processor
38# vt132 = vt100 + avo, stp
39# vt180 = vt100 + z80 cp/m
40
32if ($ARGV[0] =~ /^-/) { 41if ($ARGV[0] =~ /^-/) {
33 die <<EOF; 42 die <<EOF;
34 43
35VT102, A VT100/101/102/131 SIMULATOR 44VT102, A VT100/102/131 SIMULATOR
36 45
37Usage: 46Usage:
38 47
39 $0 [option] [program [args]] 48 $0 [option] [program [args]]
40 49
57 SET UP Home 66 SET UP Home
58 BACKSPACE Rubout 67 BACKSPACE Rubout
59 CAPS LOCK Prior/PgUp 68 CAPS LOCK Prior/PgUp
60 NO SCROLL Next/PgDown 69 NO SCROLL Next/PgDown
61 BREAK End 70 BREAK End
71 CTRL-C Insert
62 72
63Set-Up Guide: 73Set-Up Guide:
64 74
65 http://vt100.net/docs/vt102-ug/chapter3.html#S3.6 75 http://vt100.net/docs/vt102-ug/chapter3.html#S3.6
66 76
98 108
99############################################################################# 109#############################################################################
100# 8085 CPU registers and I/O support 110# 8085 CPU registers and I/O support
101 111
102# 8080/8085 registers 112# 8080/8085 registers
103my ($A, $B, $C, $D, $E, $H, $L); 113my ($A, $B, $C, $D, $E, $H, $L); # 8 bit general purpose
104my ($PC, $SP, $IFF, $FA, $FZ, $FS, $FP, $FC); 114my ($PC, $SP, $IFF); # program counter, stack pointer, interrupt flag
115my ($FA, $FZ, $FS, $FP, $FC); # condition codes (psw)
105 116
106my $RST = 0; # 8080 pending interrupts 117my $RST = 0; # pending interrupts (external interrupt logic)
107my $INTMASK = 7; # 8085 half interrupts 118my $INTMASK = 7; # 8085 half interrupt mask
108my $INTPEND = 0; # 8085 half interrupts 119my $INTPEND = 0; # 8085 half interrupts pending
109 120
110my $CLK; # rather inexact clock 121my $CLK; # rather inexact clock, counts extended basic blocks
111 122
112############################################################################# 123#############################################################################
113# the dreaded NVR1400 chip. not needed to get it going, but provided anyway 124# the dreaded NVR1400 chip. not needed to get it going, but provided anyway
114 125
115# nvram 126# nvram
127 sub { $NVR[$_[0]] = 0x3fff; }, # 5 erase 138 sub { $NVR[$_[0]] = 0x3fff; }, # 5 erase
128 sub { $NVRDATA = $NVR[$_[0]]; }, # 6 read 139 sub { $NVRDATA = $NVR[$_[0]]; }, # 6 read
129 sub { }, # 7 standby 140 sub { }, # 7 standby
130); 141);
131 142
132my @NVR_BITIDX;
133$NVR_BITIDX[1 << $_] = 9 - $_ for 0..9; 143my @NVR_BITIDX; $NVR_BITIDX[1 << $_] = 9 - $_ for 0..9;
134 144
135# the nvr1400 state machine. what a monster 145# the nvr1400 state machine. what a monster
136sub nvr() { 146sub nvr() {
137 my $a1 = $NVR_BITIDX[(~$NVRADDR ) & 0x3ff]; 147 my $a1 = $NVR_BITIDX[(~$NVRADDR ) & 0x3ff];
138 my $a0 = $NVR_BITIDX[(~$NVRADDR >> 10) & 0x3ff]; 148 my $a0 = $NVR_BITIDX[(~$NVRADDR >> 10) & 0x3ff];
139 149
140# printf "NVR %02x A %020b %d %d D %02x\n", $NVRLATCH, $NVRADDR & 0xfffff, $a1, $a0, $NVRDATA;
141
142 $NVRCMD[($NVRLATCH >> 1) & 7]($a1 * 10 + $a0, $NVRLATCH & 1) 150 $NVRCMD[($NVRLATCH >> 1) & 7]($a1 * 10 + $a0, $NVRLATCH & 1)
143} 151}
144 152
145############################################################################# 153#############################################################################
146# I/O ports - output 154# I/O ports - output
147 155
148my $DC11_REVERSE = 0; 156my $DC11_REVERSE = 0; # light background?
149 157
150my $XON = 1; # false if terminal wants us to pause 158my $XON = 1; # false if terminal wants us to pause
151my $PUSARTCMD; 159my $PUSARTCMD;
152 160
161my $KSTATUS; # keyboard status (click + scan flag + leds)
153my @KXMIT; # current scan queue 162my @KXMIT; # current scan queue
154my %KXMIT; # currently pressed keys 163my %KXMIT; # currently pressed keys
155my @KQUEUE; # key event queue 164my @KQUEUE; # key event queue
156my $KXCNT; # count for debouncew 165my $KXCNT; # count for debouncew
157my @PUSARTRECV; 166
158my $KSTATUS; 167my @PUSARTRECV; # serial input (to terminal) queue
159 168
160sub out_00 { # pusartdata 169sub out_00 { # pusartdata
161 # handle xon/xoff, but also pass it through 170 # handle xon/xoff, but also pass it through
162 if ($_[0] == 0x13) { 171 if ($_[0] == 0x13) {
163 $XON = 0; 172 $XON = 0;
170 syswrite $PTY, chr $_[0]; 179 syswrite $PTY, chr $_[0];
171 180
172 $INTPEND |= 1; 181 $INTPEND |= 1;
173} 182}
174 183
175sub out_01 { 184sub out_01 { # pusartcmd
176 $PUSARTCMD = shift; 185 $PUSARTCMD = shift;
177 186
178 $INTPEND |= 1 if $PUSARTCMD & 0x01; # VT102, 5.5 txrdy 187 $INTPEND |= 1 if $PUSARTCMD & 0x01; # VT102, 5.5 txrdy
179 $INTPEND |= 2 if $PUSARTCMD & 0x04 && !@PUSARTRECV; # VT102, 6.5 rxrdy, needed for some reason 188 $INTPEND |= 2 if $PUSARTCMD & 0x04 && !@PUSARTRECV; # VT102, 6.5 rxrdy, needed for some reason
180} 189}
181 190
182sub out_02 { } # baudrate generator 191sub out_02 { } # baudrate generator
183 192
184sub out_23 { } # unknown 193sub out_23 { } # vt102 unknown
185sub out_27 { } # unknown 194sub out_27 { } # vt102 unknown
186sub out_2f { } # unknown, connected to in 0f 195sub out_2f { } # vt102 unknown, connected to in 0f
187 196
188sub out_42 { } # brightness 197sub out_42 { } # brightness
189 198
190sub out_62 { 199sub out_62 { # nvr latch register (4 bits)
191 $NVRLATCH = shift; 200 $NVRLATCH = shift;
192} 201}
193 202
194sub out_a2 { 203sub out_a2 { # device control 011
195 my $dc11 = 0x0f & shift; 204 my $dc11 = 0x0f & shift;
196 205
197 $DC11_REVERSE = 1 if $dc11 == 0b1010; 206 $DC11_REVERSE = 1 if $dc11 == 0b1010;
198 $DC11_REVERSE = 0 if $dc11 == 0b1011; 207 $DC11_REVERSE = 0 if $dc11 == 0b1011;
199} 208}
200 209
201sub out_c2 { } # unknown 210sub out_c2 { } # unknown
202sub out_d2 { } # 0..3 == 80c/132c/60hz/50hz 211sub out_d2 { } # device control 012, 0..3 == 80c/132c/60hz/50hz
203 212
204sub out_82 { 213sub out_82 { # keyboard txmit
205 # keyboard 214 # CLICK STARTSCAN ONLINE LOCKED | L1 L2 L3 L4 (vt100)
206
207 # CLICK STARTSCAN ONLINE LOCKED | CTS DSR INS L1 215 # CLICK STARTSCAN ONLINE LOCKED | CTS DSR INS L1 (vt102)
208 # CLICK STARTSCAN ONLINE LOCKED | L1 L2 L3 L4
209 $KSTATUS = $_[0]; 216 $KSTATUS = $_[0];
210 217
211 # start new scan unless scan in progress 218 # start new scan unless scan is in progress
212 if (($_[0] & 0x40) && !@KXMIT) { 219 if (($_[0] & 0x40) && !@KXMIT) {
213 # do not reply with keys in locked mode 220 # do not reply with keys in locked mode
214 # or during post (0xff), 221 # or during post (0xff),
215 # mostly to skip init and not fail POST, 222 # mostly to skip init and not fail POST,
216 # and to send startup keys only when terminal is ready 223 # and to send startup keys only when terminal is ready
238} 245}
239 246
240############################################################################# 247#############################################################################
241# I/O ports - input 248# I/O ports - input
242 249
243my $NVRBIT; 250my $NVRBIT; # the current nvr data bit
244my $LBA6; # twice the frequenxy of LBA7 251my $LBA6; # twice the frequenxy of LBA7
245 252
246sub in_00 { # pusart data 253sub in_00 { # pusart data
247 # interrupt not generated here, because infinite 254 # interrupt not generated here, because infinite
248 # speed does not go well with the vt102. 255 # speed does not go well with the vt102.
249 256
253sub in_01 { # pusart status 260sub in_01 { # pusart status
254 # DSR SYNDET FE OE | PE TXEMPTY RXRDY TXRDY 261 # DSR SYNDET FE OE | PE TXEMPTY RXRDY TXRDY
255 0x85 + (@PUSARTRECV && 0x02) 262 0x85 + (@PUSARTRECV && 0x02)
256} 263}
257 264
258sub in_22 { # modem buffer(?) 265sub in_22 { # modem buffer
259 # wild guess: -CTS -SPDI -RI -CD 0 0 0 0 266 # wild guess: -CTS -SPDI -RI -CD 0 0 0 0
260 0x20 267 0x20
261} 268}
262 269
263sub in_0f { 0xff } # vt102 unknown, connected to out 2f 270sub in_0f { 0xff } # vt102 unknown, connected to out 2f
292############################################################################# 299#############################################################################
293# 8085 cpu opcodes and flag handling 300# 8085 cpu opcodes and flag handling
294 301
295my $x; # dummy scratchpad for opcodes 302my $x; # dummy scratchpad for opcodes
296 303
297sub sf { # set flags (ZSC - AP not implemented) 304sub sf { # set flags, full version (ZSC - AP not implemented)
298 $FS = $_[0] & 0x080; 305 $FS = $_[0] & 0x080;
299 $FZ = !($_[0] & 0x0ff); 306 $FZ = !($_[0] & 0x0ff);
300 $FC = $_[0] & 0x100; 307 $FC = $_[0] & 0x100;
301 308
302 $_[0] &= 0xff; 309 $_[0] &= 0xff;
303} 310}
304 311
305sub sf8 { # set flags (ZSC - AP not implemented) 312sub sf8 { # set flags, for 8-bit results (ZSC - AP not implemented)
306 $FS = $_[0] & 0x080; 313 $FS = $_[0] & 0x080;
307 $FZ = !($_[0] & 0x0ff); 314 $FZ = !($_[0] & 0x0ff);
308 $FC = 0; 315 $FC = 0;
309} 316}
310 317
311sub sf_nc { # set flags except carry 318sub sf_nc { # set flags, except carry
312 $FS = $_[0] & 0x080; 319 $FS = $_[0] & 0x080;
313 $FZ = ($_[0] & 0x0ff) == 0; 320 $FZ = ($_[0] & 0x0ff) == 0;
314 321
315 $_[0] &= 0xff; 322 $_[0] &= 0xff;
316} 323}
317 324
325# opcode table
318my @op = map { sprintf "status(); die 'unknown op %02x'", $_ } 0x00 .. 0xff; 326my @op = map { sprintf "status(); die 'unknown op %02x'", $_ } 0x00 .. 0xff;
319 327
320my @reg = qw($B $C $D $E $H $L $M[$H*256+$L] $A); 328my @reg = qw($B $C $D $E $H $L $M[$H*256+$L] $A); # r/m encoding
321my @cc = ('if !$FZ', 'if $FZ', 'if !$FC', 'if $FC', ';die', ';die', 'if !$FS', 'if $FS'); # die == unimplemented $FP parity 329my @cc = ('!$FZ', '$FZ', '!$FC', '$FC', 'die;', 'die;', '!$FS', '$FS'); # cc encoding. die == unimplemented $FP parity
322 330
323$op[0x00] = ''; 331$op[0x00] = ''; # nop
324 332
325# mov r,r / r,M / M,r 333# mov r,r / r,M / M,r
326for my $s (0..7) { 334for my $s (0..7) {
327 for my $d (0..7) { 335 for my $d (0..7) {
328 $op[0x40 + $d * 8 + $s] = "$reg[$d] = $reg[$s]"; # mov 336 $op[0x40 + $d * 8 + $s] = "$reg[$d] = $reg[$s]"; # mov
368$op[0x04 + $_ * 8] = "sf_nc ++$reg[$_]" for 0..7; # inr 376$op[0x04 + $_ * 8] = "sf_nc ++$reg[$_]" for 0..7; # inr
369$op[0x05 + $_ * 8] = "sf_nc --$reg[$_]" for 0..7; # dcr 377$op[0x05 + $_ * 8] = "sf_nc --$reg[$_]" for 0..7; # dcr
370 378
371$op[0x07] = ' $FC = $A & 0x80; $A = (($A << 1) + ($FC && 0x01)) & 0xff '; # rlc 379$op[0x07] = ' $FC = $A & 0x80; $A = (($A << 1) + ($FC && 0x01)) & 0xff '; # rlc
372$op[0x17] = ' ($FC, $A) = ($A & 0x80, (($A << 1) + ($FC && 0x01)) & 0xff)'; # ral 380$op[0x17] = ' ($FC, $A) = ($A & 0x80, (($A << 1) + ($FC && 0x01)) & 0xff)'; # ral
373
374$op[0x0f] = ' $FC = $A & 0x01; $A = ($A >> 1) | ($FC && 0x80) '; # rrc 381$op[0x0f] = ' $FC = $A & 0x01; $A = ($A >> 1) | ($FC && 0x80) '; # rrc
375$op[0x1f] = ' ($FC, $A) = ($A & 0x01, ($A >> 1) | ($FC && 0x80))'; # rar 382$op[0x1f] = ' ($FC, $A) = ($A & 0x01, ($A >> 1) | ($FC && 0x80))'; # rar
376
377$op[0x2f] = '$A ^= 0xff'; # cma
378 383
379# getting this insn wrong (its the only 16 bit insn to modify flags) 384# getting this insn wrong (its the only 16 bit insn to modify flags)
380# wasted three of my best days with mindless vt102 rom reverse engineering 385# wasted three of my best days with mindless vt102 rom reverse engineering
381sub dad { 386sub dad {
382 $x = $H * 256 + $L + $_[0]; 387 $x = $H * 256 + $L + $_[0];
387 392
388$op[0x09] = 'dad $B * 256 + $C'; # dad 393$op[0x09] = 'dad $B * 256 + $C'; # dad
389$op[0x19] = 'dad $D * 256 + $E'; # dad 394$op[0x19] = 'dad $D * 256 + $E'; # dad
390$op[0x29] = 'dad $H * 256 + $L'; # dad 395$op[0x29] = 'dad $H * 256 + $L'; # dad
391$op[0x39] = 'dad $SP '; # dad 396$op[0x39] = 'dad $SP '; # dad
397
398$op[0x2f] = '$A ^= 0xff'; # cma
392 399
393$op[0x80 + $_] = 'sf $A += + ' . $reg[$_] for 0..7; # add 400$op[0x80 + $_] = 'sf $A += + ' . $reg[$_] for 0..7; # add
394$op[0x88 + $_] = 'sf $A += ($FC && 1) + ' . $reg[$_] for 0..7; # adc 401$op[0x88 + $_] = 'sf $A += ($FC && 1) + ' . $reg[$_] for 0..7; # adc
395$op[0x90 + $_] = 'sf $A -= + ' . $reg[$_] for 0..7; # sub 402$op[0x90 + $_] = 'sf $A -= + ' . $reg[$_] for 0..7; # sub
396$op[0x98 + $_] = 'sf $A -= ($FC && 1) + ' . $reg[$_] for 0..7; # sbb 403$op[0x98 + $_] = 'sf $A -= ($FC && 1) + ' . $reg[$_] for 0..7; # sbb
397$op[0xa0 + $_] = 'sf8 $A &= ' . $reg[$_] for 0..7; # ana 404$op[0xa0 + $_] = 'sf8 $A &= ' . $reg[$_] for 0..7; # ana
398$op[0xa8 + $_] = 'sf8 $A ^= ' . $reg[$_] for 0..7; # xra 405$op[0xa8 + $_] = 'sf8 $A ^= ' . $reg[$_] for 0..7; # xra
399$op[0xb0 + $_] = 'sf8 $A |= ' . $reg[$_] for 0..7; # ora 406$op[0xb0 + $_] = 'sf8 $A |= ' . $reg[$_] for 0..7; # ora
400$op[0xb8 + $_] = 'sf $x = $A - ' . $reg[$_] for 0..7; # cmp 407$op[0xb8 + $_] = 'sf $x = $A - ' . $reg[$_] for 0..7; # cmp
401# possible todo: optimize ora a, maybe xra a 408# possible todo: optimize ora a, maybe xra a, possibly ana
402 409
403$op[0xc6] = 'sf $A += IMM8'; # adi 410$op[0xc6] = 'sf $A += IMM8'; # adi
404# ce ADI NYI
405$op[0xd6] = 'sf $A -= IMM8'; # sui 411$op[0xd6] = 'sf $A -= IMM8'; # sui
406# de SBI NYI
407$op[0xe6] = 'sf8 $A &= IMM8'; # ani 412$op[0xe6] = 'sf8 $A &= IMM8'; # ani
408$op[0xee] = 'sf8 $A ^= IMM8'; # xri 413$op[0xee] = 'sf8 $A ^= IMM8'; # xri
409$op[0xf6] = 'sf8 $A |= IMM8'; # ori 414$op[0xf6] = 'sf8 $A |= IMM8'; # ori
410$op[0xfe] = 'sf $A - IMM8'; # cpi 415$op[0xfe] = 'sf $A - IMM8'; # cpi
416# ce ACI NYI, apparently unused
417# de SBI NYI, apparently unused
411 418
412$op[0xc5] = 'PUSH $B; PUSH $C'; 419$op[0xc5] = 'PUSH $B; PUSH $C';
413$op[0xd5] = 'PUSH $D; PUSH $E'; 420$op[0xd5] = 'PUSH $D; PUSH $E';
414$op[0xe5] = 'PUSH $H; PUSH $L'; 421$op[0xe5] = 'PUSH $H; PUSH $L';
415$op[0xf5] = 'PUSH $A; PUSH +($FS && 0x80) | ($FZ && 0x40) | ($FA && 0x10) | ($FP && 0x04) | ($FC && 0x01)'; # psw 422$op[0xf5] = 'PUSH $A; PUSH +($FS && 0x80) | ($FZ && 0x40) | ($FA && 0x10) | ($FP && 0x04) | ($FC && 0x01)'; # psw
417$op[0xc1] = '($C, $B) = (POP, POP)'; # pop 424$op[0xc1] = '($C, $B) = (POP, POP)'; # pop
418$op[0xd1] = '($E, $D) = (POP, POP)'; # pop 425$op[0xd1] = '($E, $D) = (POP, POP)'; # pop
419$op[0xe1] = '($L, $H) = (POP, POP)'; # pop 426$op[0xe1] = '($L, $H) = (POP, POP)'; # pop
420$op[0xf1] = '($x, $A) = (POP, POP); ($FS, $FZ, $FA, $FP, $FC) = ($x & 0x80, $x & 0x40, $x & 0x10, $x & 0x04, $x & 0x01)'; # pop psw 427$op[0xf1] = '($x, $A) = (POP, POP); ($FS, $FZ, $FA, $FP, $FC) = ($x & 0x80, $x & 0x40, $x & 0x10, $x & 0x04, $x & 0x01)'; # pop psw
421 428
422$op[0xc2 + $_ * 8] = 'BRA IMM16 ' . $cc[$_] for 0..7; # jcc 429$op[0xc2 + $_ * 8] = 'BRA IMM16 if ' . $cc[$_] for 0..7; # jcc
423$op[0xc3] = 'JMP IMM16'; # jmp 430$op[0xc3] = 'JMP IMM16'; # jmp
424 431
425$op[0xc4 + $_ * 8] = '(PUSH PC >> 8), (PUSH PC & 0xff), (BRA IMM16) ' . $cc[$_] for 0..7; # ccc 432$op[0xc4 + $_ * 8] = '(PUSH PC >> 8), (PUSH PC & 0xff), (BRA IMM16) if ' . $cc[$_] for 0..7; # ccc
426$op[0xcd] = '(PUSH PC >> 8), (PUSH PC & 0xff), (BRA IMM16)'; # call 433$op[0xcd] = '(PUSH PC >> 8), (PUSH PC & 0xff), (BRA IMM16)'; # call
427 434
428$op[0xc0 + $_ * 8] = 'BRA POP + POP * 256 ' . $cc[$_] for 0..7; # rcc 435$op[0xc0 + $_ * 8] = 'BRA POP + POP * 256 if ' . $cc[$_] for 0..7; # rcc
429$op[0xc9] = 'JMP POP + POP * 256'; # ret 436$op[0xc9] = 'JMP POP + POP * 256'; # ret
430 437
431$op[0xc7 + $_ * 8] = "JMP $_ * 8" for 0..7; # rst 438$op[0xc7 + $_ * 8] = "JMP $_ * 8" for 0..7; # rst
432 439
433$op[0xe9] = 'JMP $H * 256 + $L'; # pchl 440$op[0xe9] = 'JMP $H * 256 + $L'; # pchl
434# f9 SPHL NYI 441# f9 SPHL NYI, apparently unused
435 442
436$op[0x37] = '$FC = 1 '; # stc 443$op[0x37] = '$FC = 1 '; # stc
437$op[0x3f] = '$FC = !$FC'; # cmc 444$op[0x3f] = '$FC = !$FC'; # cmc
438 445
439$op[0xd3] = 'OUT'; # out 446$op[0xd3] = 'OUT'; # out
440$op[0xdb] = 'IN'; # in 447$op[0xdb] = 'IN'; # in
441 448
442$op[0xeb] = '($D, $E, $H, $L) = ($H, $L, $D, $E)'; # xchg 449$op[0xeb] = '($D, $E, $H, $L) = ($H, $L, $D, $E)'; # xchg
443 450
444# e3 xthl NYI # @ 917b, hl <-> (sp) 451# e3 xthl NYI # @ 917b in e69, hl <-> (sp)
445 452
446$op[0x20] = '$A = $INTPEND * 16 + $INTMASK + ($IFF && 8)'; # rim (incomplete) 453$op[0x20] = '$A = $INTPEND * 16 + $INTMASK + ($IFF && 8)'; # rim (8085, incomplete)
447$op[0x30] = '$INTMASK = $A & 7 if $A & 8'; # sim (incomplete) 454$op[0x30] = '$INTMASK = $A & 7 if $A & 8'; # sim (8085, incomplete)
448 455
449$op[0xf3] = '$IFF = 0'; # DI 456$op[0xf3] = '$IFF = 0'; # di
450$op[0xfb] = '$IFF = 1'; # EI 457$op[0xfb] = '$IFF = 1'; # ei
451 458
452# yeah, the fucking setup screens actually use daa... 459# yeah, the fucking setup screen actually uses daa...
453$op[0x27] = ' 460$op[0x27] = '
454 my ($h, $l); 461 my ($h, $l);
455 462
456 ($h, $l) = ($A >> 4, $A & 15); 463 ($h, $l) = ($A >> 4, $A & 15);
457 464
465 $A = ($h * 16 + $l) & 0xff; 472 $A = ($h * 16 + $l) & 0xff;
466 } 473 }
467'; # daa, almost certainly borked, also, acarry not set by sf 474'; # daa, almost certainly borked, also, acarry not set by sf
468 475
469############################################################################# 476#############################################################################
470# print cpu status for debugging purposes 477# debug
471 478
472# print cpu status, for debugging 479# print cpu status, for debugging
473sub status { 480sub status {
474 my $PC = shift || $PC; 481 my $PC = shift || $PC;
475 482
487############################################################################# 494#############################################################################
488# video emulation 495# video emulation
489 496
490binmode STDOUT; 497binmode STDOUT;
491 498
492my @CHARMAP = ( 499my @CHARMAP = ( # acschars / chars 0..31
493 " " , "\x{29eb}", "\x{2592}", "\x{2409}", 500 " " , "\x{29eb}", "\x{2592}", "\x{2409}",
494 "\x{240c}", "\x{240d}", "\x{240a}", "\x{00b0}", 501 "\x{240c}", "\x{240d}", "\x{240a}", "\x{00b0}",
495 "\x{00b1}", "\x{2424}", "\x{240b}", "\x{2518}", 502 "\x{00b1}", "\x{2424}", "\x{240b}", "\x{2518}",
496 "\x{2510}", "\x{250c}", "\x{2514}", "\x{253c}", 503 "\x{2510}", "\x{250c}", "\x{2514}", "\x{253c}",
497 "\x{23ba}", "\x{23bb}", "\x{2500}", "\x{23bc}", 504 "\x{23ba}", "\x{23bb}", "\x{2500}", "\x{23bc}",
523 530
524my @LED = $VT102 531my @LED = $VT102
525 ? qw(L1 INSERT DSR CTS LOCKED LOCAL SCAN BEEP) 532 ? qw(L1 INSERT DSR CTS LOCKED LOCAL SCAN BEEP)
526 : qw(L4 L3 L2 L1 LOCKED LOCAL SCAN BEEP); 533 : qw(L4 L3 L2 L1 LOCKED LOCAL SCAN BEEP);
527 534
535my $CURSOR_IS_ON;
536
528# display screen 537# display screen
529sub display { 538sub display {
539 # this is for the powersave mode - check whether the cursor is on here,
540 # and only allow powersave later when it was on the last display time
541 $CURSOR_IS_ON = $M[$VT102 ? 0x207b : 0x21ba];
542
530 my $i = 0x2000; 543 my $i = 0x2000;
531 544
532 my $leds = join " ", map $KSTATUS & 2**$_ ? "\e[7m$LED[$_]\e[m" : "$LED[$_]", reverse 0 .. $#LED; 545 my $leds = join " ", map $KSTATUS & 2**$_ ? "\e[7m$LED[$_]\e[m" : "$LED[$_]", reverse 0 .. $#LED;
533 546
534 my $scr = sprintf "\e[H--- LED [ %s ] CLK %d\e[K\n", $leds, $CLK; 547 my $scr = sprintf "\e[H--- LED [ %s ] CLK %d\e[K\n", $leds, $CLK;
586 "\x1e" => 0x24 | 0x100, # CTRL-~ 599 "\x1e" => 0x24 | 0x100, # CTRL-~
587 "\x1f" => 0x75 | 0x100, # CTRL-? 600 "\x1f" => 0x75 | 0x100, # CTRL-?
588 601
589 # hardcoded rxvt keys 602 # hardcoded rxvt keys
590 "\e" => 0x2a, # ESC 603 "\e" => 0x2a, # ESC
604 "\e[2~" => 0x79 | 0x100, # CTRL-C (insert)
591 "\e[3~" => 0x03, # DC 605 "\e[3~" => 0x03, # DC
592 "\e[5~" => 0x7e, # CAPS LOCK (prior) 606 "\e[5~" => 0x7e, # CAPS LOCK (prior)
593 "\e[6~" => 0x6a, # NO SCROLL (next) 607 "\e[6~" => 0x6a, # NO SCROLL (next)
594 "\e[A" => 0x30, # UP 608 "\e[A" => 0x30, # UP
595 "\e[B" => 0x22, # DOWN 609 "\e[B" => 0x22, # DOWN
602 "\e[7~" => 0x7b, # SETUP (home) 616 "\e[7~" => 0x7b, # SETUP (home)
603 "\e[8~" => 0x23, # BREAK (end) 617 "\e[8~" => 0x23, # BREAK (end)
604 "\e[8\$" => 0x23 | 0x080, # SHIFT BREAK / DISCONNECT (shift-end) 618 "\e[8\$" => 0x23 | 0x080, # SHIFT BREAK / DISCONNECT (shift-end)
605 "\x7f" => 0x33, # BACKSPACE 619 "\x7f" => 0x33, # BACKSPACE
606 620
607 "\e[11~" => 0x32, # F1 621 "\e[11~" => 0x32, # PF1
608 "\e[11~" => 0x42, # F2 622 "\e[12~" => 0x42, # PF2
609 "\e[11~" => 0x31, # F3 623 "\e[13~" => 0x31, # PF3
610 "\e[11~" => 0x41, # F4 624 "\e[14~" => 0x41, # PF4
611); 625);
612 626
613@KEYMAP{map chr, 0x20 .. 0x40, 0x5b .. 0x7e} = unpack "C*", pack "H*", 627@KEYMAP{map chr, 0x20 .. 0x40, 0x5b .. 0x7e} = unpack "C*", pack "H*",
614 "779ad5a9a8b8a755a6b5b6b466256575" . "351a3929283837273626d656e634e5f5" . "b9" # 20..40 628 "779ad5a9a8b8a755a6b5b6b466256575" . "351a3929283837273626d656e634e5f5" . "b9" # 20..40
615 . "154514b7a5" . "244a6879591949485816574746766706" . "050a185a0817780969077a95c594a4"; # 5b..7e 629 . "154514b7a5" . "244a6879591949485816574746766706" . "050a185a0817780969077a95c594a4"; # 5b..7e
618$KEYMAP{"\x20" ^ $_} ||= $KEYMAP{$_} | 0x080 for "a" .. "z"; # shift 632$KEYMAP{"\x20" ^ $_} ||= $KEYMAP{$_} | 0x080 for "a" .. "z"; # shift
619 633
620my $KEYMATCH = join "|", map quotemeta, reverse sort keys %KEYMAP; 634my $KEYMATCH = join "|", map quotemeta, reverse sort keys %KEYMAP;
621$KEYMATCH = qr{^($KEYMATCH)}s; 635$KEYMATCH = qr{^($KEYMATCH)}s;
622 636
623my %KMOD; 637my %KMOD; # currently pressed modifier keys
624 638
625sub key { 639sub key {
626 my ($key) = @_; 640 my ($key) = @_;
627 641
628 push @KQUEUE, -0x7c if !($key & 0x100) && delete $KMOD{0x7c}; # ctrl-up 642 push @KQUEUE, -0x7c if !($key & 0x100) && delete $KMOD{0x7c}; # ctrl-up
644 # skip input we can't decipher 658 # skip input we can't decipher
645 substr $STDIN_BUF, 0, 1, ""; 659 substr $STDIN_BUF, 0, 1, "";
646} 660}
647 661
648if ($KBD) { 662if ($KBD) {
649 system "stty -icanon -icrnl -inlcr -echo min 1 time 0"; 663 system "stty -icanon -icrnl -inlcr -echo min 1 time 0"; # -isig
650 eval q{ sub END { system "stty sane" } }; 664 eval q{ sub END { system "stty sane" } };
651 $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = sub { exit 1 }; 665 $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = sub { exit 1 };
652} 666}
653 667
654############################################################################# 668#############################################################################
675); 689);
676 690
677############################################################################# 691#############################################################################
678# process/pty management 692# process/pty management
679 693
694if (1) {
680require IO::Pty; 695 require IO::Pty;
681$PTY = IO::Pty->new; 696 $PTY = IO::Pty->new;
682 697
683my $slave = $PTY->slave; 698 my $slave = $PTY->slave;
684 699
685$PTY->set_winsize (24, 80); 700 $PTY->set_winsize (24, 80);
686 701
687unless (fork) { 702 unless (fork) {
703 $ENV{LC_ALL} = "C";
688 $ENV{TERM} = $VT102 ? "vt102" : "vt100"; 704 $ENV{TERM} = $VT102 ? "vt102" : "vt100";
689 705
690 close $PTY; 706 close $PTY;
691 707
692 open STDIN , "<&", $slave; 708 open STDIN , "<&", $slave;
693 open STDOUT, ">&", $slave; 709 open STDOUT, ">&", $slave;
694 open STDERR, ">&", $slave; 710 open STDERR, ">&", $slave;
695 711
696 system "stty ixoff erase ^H"; 712 system "stty ixoff erase ^H";
697 713
698 $PTY->make_slave_controlling_terminal; 714 $PTY->make_slave_controlling_terminal;
715 $PTY->close_slave;
716
717 @ARGV = "sh" unless @ARGV;
718 exec @ARGV;
719 }
720
699 $PTY->close_slave; 721 $PTY->close_slave;
700 722} else {
701 @ARGV = "sh" unless @ARGV; 723 open $PTY, "+</dev/null"
702 exec @ARGV; 724 or die "/dev/null: $!";
703} 725}
704
705$PTY->close_slave;
706 726
707############################################################################# 727#############################################################################
708# the actual hardware simulator 728# the actual hardware simulator
709 729
710my @ICACHE; # compiled instruction cache 730my @ICACHE; # compiled instruction/basic block cache
711 731
732my $POWERSAVE; # powersave counter
733
734my $RIN; # libev for the less well-off
735
736(vec $RIN, 0, 1) = 1 if $KBD;
737(vec $RIN, fileno $PTY, 1) = 1 if $PTY;
738
739# the cpu.
712while () { 740while () {
713 # execute extended basic blocks 741 # execute an extended basic block
714 $PC = ($ICACHE[$PC] ||= do { 742 $PC = ($ICACHE[$PC] ||= do {
715 my $pc = $PC; 743 my $pc = $PC;
716 744
717 my $insn = ""; 745 my $insn = "";
718 746
730 758
731 s/\bPC\b/$pc/ge; # PC at end of insn 759 s/\bPC\b/$pc/ge; # PC at end of insn
732 s/\bBRA\b/return/g; # conditional jump 760 s/\bBRA\b/return/g; # conditional jump
733 s/\bJMP\b(.*)/$1\x00/sg; # unconditional jump 761 s/\bJMP\b(.*)/$1\x00/sg; # unconditional jump
734 762
735 s/\bIN\b/ sprintf "\$A = in_%02x", $M[$pc++]/xge; 763 s/\bIN\b/ sprintf "\$A = in_%02x", $M[$pc++]/xge; # in insns call in_HEX
736 s/\bOUT\b/sprintf "out_%02x \$A ", $M[$pc++]/xge; 764 s/\bOUT\b/sprintf "out_%02x \$A ", $M[$pc++]/xge; # out likewise
737 } 765 }
738 766
739 $insn .= "$op;\n"; 767 $insn .= "$op;\n";
740 } 768 }
741 769
742 770
743 $insn .= $pc; 771 $insn .= $pc;
744 $insn =~ s/\x00.*$//s; 772 $insn =~ s/\x00.*$//s;
745 773
746 eval "use integer; sub { $insn }" or die "$insn: $@" 774 eval "sub { $insn }" or die "$insn: $@"
747 })->(); 775 })->();
748 776
749 ++$CLK; 777 ++$CLK;
750 778
751 # things we do from time to time only 779 # things we do from time to time only
752 unless ($CLK & 0xf) { 780 unless ($CLK & 0xf) {
753 # do I/O 781 # do I/O
754 782
755 unless ($CLK & 0xfff) { 783 unless ($CLK & 0xfff) {
784 if (select $x = $RIN, undef, undef, $POWERSAVE < 10 ? 0 : $CURSOR_IS_ON && 3600) {
756 785
757 # pty/serial I/O 786 # pty/serial I/O
758 unless ((@PUSARTRECV >= 128) || @KQUEUE || !$PTY) { 787 if ($PTY && (vec $x, fileno $PTY, 1) && (@PUSARTRECV < 128) && !@KQUEUE) {
759 my $rin = ""; (vec $rin, fileno $PTY, 1) = 1;
760
761 if (select $rin, undef, undef, 0) {
762 sysread $PTY, my $buf, 256; 788 sysread $PTY, my $buf, 256;
789
790 # linux don't do cs7 and/or parity anymore, so we need to filter # out xoff characters to avoid freezes.
763 push @PUSARTRECV, unpack "C*", $buf; 791 push @PUSARTRECV, grep { ($_ & 0x7f) != 0x13 } unpack "C*", $buf;
764 } 792 }
765 }
766 793
767 # keyboard input 794 # keyboard input
768 if ($KBD) { 795 if ($KBD && (vec $x, 0, 1)) {
796 # to avoid non-blocking mode on stdin (and stty min 0), we
797 # just read byte-by-byte after a select says there is data.
769 while (select my $rin = "\x01", undef, undef, 0) { 798 while (select my $rin = "\x01", undef, undef, 0) {
770 sysread STDIN, $STDIN_BUF, 1, length $STDIN_BUF 799 sysread STDIN, $STDIN_BUF, 1, length $STDIN_BUF
771 or last; 800 or last;
801 }
802
803 stdin_parse if length $STDIN_BUF;
772 } 804 }
773 805
774 stdin_parse if length $STDIN_BUF; 806 $POWERSAVE = 0; # activity
807 } elsif (@PUSARTRECV || @KQUEUE) {
808 $POWERSAVE = 0;
809 } else {
810 ++$POWERSAVE;
775 } 811 }
776 } 812 }
777 813
778 # kick off various interrupts 814 # kick off serial input interrupt quite often
779
780 $RST |= 2 if @PUSARTRECV && $XON; # VT100, but works on vt102, too (probably not used on real hardware though) 815 $RST |= 2 if @PUSARTRECV && $XON; # VT100, but works on vt102, too (probably not used on real hardware though)
781 #$INTPEND |= 2 if @PUSARTRECV && $XON; # VT102, 6.5 rxrdy 816 #$INTPEND |= 2 if @PUSARTRECV && $XON; # VT102, 6.5 rxrdy
782 817
783 # kick off vertical retrace form time to time 818 # kick off vertical retrace interrupt from time to time
784 unless ($CLK & 0x1ff) { 819 unless ($CLK & 0x1ff) {
785 $RST |= 4; # vertical retrace 820 $RST |= 4; # vertical retrace
786 } 821 }
787 822
788 # handle video hardware 823 # handle video hardware
789 unless ($CLK & 0x3fff) { 824 unless ($CLK & 0x3fff) {
790 display; 825 display;
791 } 826 }
792 } 827 }
793 828
794 # the interrupt logic 829 # the interrupt logic - we only interrupt after basic blocks
830 # which, as a side effect, ensures that we don't interrupt
831 # "ei; ret" sequences and thus reduce the risk of stack overflows.
795 if (($RST || ($INTPEND & ~$INTMASK)) && $IFF) { 832 if (($RST || ($INTPEND & ~$INTMASK)) && $IFF) {
796 # rst 1 kbd data available 833 # rst 1 kbd data available
797 # rst 2 pusart xmit+recv flag 834 # rst 2 pusart xmit+recv flag
798 # rst 4 vertical retrace 835 # rst 4 vertical retrace
799 # 5.5 vt125 mb7 trans ready (serial send?) 836 # 5.5 vt125 mb7 trans ready (serial send?)
813 } elsif ($RST & 4) { $vec = 0x20; $RST &= ~4; 850 } elsif ($RST & 4) { $vec = 0x20; $RST &= ~4;
814 } else { 851 } else {
815 die; 852 die;
816 } 853 }
817 854
855 # jump to the interrupt vector
818 $M[--$SP] = $PC >> 8; 856 $M[--$SP] = $PC >> 8;
819 $M[--$SP] = $PC & 0xff; 857 $M[--$SP] = $PC & 0xff;
820 $PC = $vec; 858 $PC = $vec;
821 859
822 $IFF = 0; 860 $IFF = 0;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines