| 1 | #!/opt/bin/perl |
1 | #!/opt/bin/perl |
|
|
2 | |
|
|
3 | # |
|
|
4 | # Copyright(C) 2014 Marc Alexander Lehmann <vt102@schmorp.de> |
|
|
5 | # |
|
|
6 | # vt102 is free software; you can redistribute it and/or modify it under |
|
|
7 | # the terms of the GNU General Public License as published by the Free |
|
|
8 | # Software Foundation; either version 3, or (at your option) any later |
|
|
9 | # version. |
|
|
10 | # |
|
|
11 | # vt102 is distributed in the hope that it will be useful, but WITHOUT |
|
|
12 | # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
|
13 | # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
|
14 | # for more details. |
|
|
15 | # |
|
|
16 | |
|
|
17 | # If this file contains embedded ROMs, the above copyright notice does |
|
|
18 | # not apply to them. |
| 2 | |
19 | |
| 3 | # this hack is not considered release ready in and way, shape, or form |
20 | # this hack is not considered release ready in and way, shape, or form |
| 4 | # ./vt102 bash |
21 | # ./vt102 bash |
| 5 | # ./vt102 telnet towel.blinkenlights.nl |
22 | # ./vt102 telnet towel.blinkenlights.nl |
| 6 | # ./vt102 curl http://artscene.textfiles.com/vt100/trekvid.vt |
23 | # ./vt102 curl http://artscene.textfiles.com/vt100/trekvid.vt |
| 7 | # ./vt102 curl http://artscene.textfiles.com/vt100/surf.vt # in 3d! |
24 | # ./vt102 curl http://artscene.textfiles.com/vt100/surf.vt # in 3d! |
| 8 | |
25 | |
|
|
26 | # TODO: ctrl key map |
|
|
27 | |
| 9 | use common::sense; |
28 | use common::sense; |
| 10 | |
29 | |
| 11 | $| = 1; |
30 | $| = 1; |
| 12 | |
31 | |
| 13 | my $VT102 = 1; |
32 | my $VT102 = 1; |
| 14 | my $AVO = $VT102 || 1; |
33 | my $AVO = $VT102 || 1; |
| 15 | my $KBD = 1; |
34 | my $KBD = 1; |
| 16 | |
35 | |
| 17 | ############################################################################# |
36 | ############################################################################# |
| 18 | |
37 | # rom initialising |
| 19 | my $PTY; # the pty we allocated, if any |
|
|
| 20 | |
38 | |
| 21 | my $ROM = do { |
39 | my $ROM = do { |
| 22 | binmode DATA; |
40 | binmode DATA; |
| 23 | local $/; |
41 | local $/; |
| 24 | <DATA> |
42 | <DATA> |
| … | |
… | |
| 37 | } else { |
55 | } else { |
| 38 | @M[0x0000 .. 0x1fff] = unpack "C*", substr $ROM, 0x0000, 0x2000; |
56 | @M[0x0000 .. 0x1fff] = unpack "C*", substr $ROM, 0x0000, 0x2000; |
| 39 | } |
57 | } |
| 40 | |
58 | |
| 41 | ############################################################################# |
59 | ############################################################################# |
|
|
60 | # cpu registers and I/O support |
| 42 | |
61 | |
|
|
62 | my $PTY; # the pty we allocated, if any |
| 43 | my $PRSTATUS = 0; |
63 | my $PRSTATUS = 0; |
| 44 | |
64 | |
| 45 | # 8080/8085 registers |
65 | # 8080/8085 registers |
| 46 | # b, c, d, e, h, l, a |
66 | # b, c, d, e, h, l, a |
| 47 | my ($A, $B, $C, $D, $E, $H, $L, $A); |
67 | my ($A, $B, $C, $D, $E, $H, $L, $A); |
| … | |
… | |
| 54 | my $x; # dummy temp for instructions |
74 | my $x; # dummy temp for instructions |
| 55 | |
75 | |
| 56 | my $CLK; # rather inexact clock |
76 | my $CLK; # rather inexact clock |
| 57 | |
77 | |
| 58 | ############################################################################# |
78 | ############################################################################# |
|
|
79 | # the dreaded nvr1400 chip. not needed to get it going, but provided for reference |
| 59 | |
80 | |
| 60 | # nvram |
81 | # nvram |
| 61 | my @NVR = (0x3fff) x 100; # vt102: 214e accum, 214f only lower 8 bit used, first 44 bytes |
82 | my @NVR = (0x3fff) x 100; # vt102: 214e accum, 214f only lower 8 bit used, first 44 bytes |
| 62 | my $NVRADDR; |
83 | my $NVRADDR; |
| 63 | my $NVRDATA; |
84 | my $NVRDATA; |
| 64 | my $NVRLATCH; |
85 | my $NVRLATCH; |
| 65 | |
86 | |
| 66 | #$NVR[$_] = $_ for 0..99;#d# |
|
|
| 67 | |
|
|
| 68 | my @NVRCMD = ( |
87 | my @NVRCMD = ( |
| 69 | sub { # accept data |
|
|
| 70 | $NVRDATA = ($NVRDATA << 1) + $_[1]; |
88 | sub { $NVRDATA = ($NVRDATA << 1) + $_[1]; }, # 0 accept data |
| 71 | }, |
89 | sub { $NVRADDR = ($NVRADDR << 1) + $_[1]; }, # 1 accept addr |
| 72 | sub { # accept addr |
90 | sub { ($NVRDATA <<= 1) & 0x4000 }, # 2 shift out |
| 73 | $NVRADDR = ($NVRADDR << 1)+ $_[1]; |
91 | undef, # 3 not used, will barf |
| 74 | }, |
|
|
| 75 | sub { # shift out |
|
|
| 76 | my $bit = $NVRDATA & 0x02000; |
|
|
| 77 | $NVRDATA *= 2; |
|
|
| 78 | $bit |
|
|
| 79 | }, |
|
|
| 80 | undef, |
|
|
| 81 | sub { # write |
|
|
| 82 | print "NVR WRITE $_[0]\n";#d# |
|
|
| 83 | $NVR[$_[0]] = $NVRDATA & 0x3fff; |
92 | sub { $NVR[$_[0]] = $NVRDATA & 0x3fff; }, # 4 write |
| 84 | }, |
93 | sub { $NVR[$_[0]] = 0x3fff; }, # 5 erase |
| 85 | sub { # erase |
94 | sub { $NVRDATA = $NVR[$_[0]]; }, # 6 read |
| 86 | print "NVR ERASE $_[0]\n";#d# |
95 | sub { }, # 7 standby |
| 87 | $NVR[$_[0]] = 0x3fff; |
|
|
| 88 | }, |
|
|
| 89 | sub { # read |
|
|
| 90 | # print "NVR READ $_[0] = $NVR[$_[0]]\n";#d# |
|
|
| 91 | $NVRDATA = $NVR[$_[0]]; |
|
|
| 92 | }, |
|
|
| 93 | sub { # standby |
|
|
| 94 | }, |
|
|
| 95 | ); |
96 | ); |
| 96 | |
97 | |
| 97 | my @bitidx; |
98 | my @bitidx; |
| 98 | $bitidx[1 << $_] = 9 - $_ for 0..9; |
99 | $bitidx[1 << $_] = 9 - $_ for 0..9; |
| 99 | |
100 | |
| … | |
… | |
| 107 | $NVRCMD[($NVRLATCH >> 1) & 7]($a1 * 10 + $a0, $NVRLATCH & 1) |
108 | $NVRCMD[($NVRLATCH >> 1) & 7]($a1 * 10 + $a0, $NVRLATCH & 1) |
| 108 | } |
109 | } |
| 109 | |
110 | |
| 110 | ############################################################################# |
111 | ############################################################################# |
| 111 | |
112 | |
| 112 | my $DC11 = 0; # 4 bit commands |
113 | my $DC11_REVERSE = 0; |
| 113 | my $DC12 = 0; |
|
|
| 114 | |
114 | |
| 115 | my $XON = 1; # false if terminal wants us to pause |
115 | my $XON = 1; # false if terminal wants us to pause |
| 116 | my $PUSARTCMD; |
116 | my $PUSARTCMD; |
| 117 | |
117 | |
| 118 | my @KXMIT; # current scan queue |
118 | my @KXMIT; # current scan queue |
| … | |
… | |
| 124 | |
124 | |
| 125 | sub out_00 { # pusartdata |
125 | sub out_00 { # pusartdata |
| 126 | # handle xon/xoff, but also pass it through |
126 | # handle xon/xoff, but also pass it through |
| 127 | if ($_[0] == 0x13) { |
127 | if ($_[0] == 0x13) { |
| 128 | $XON = 0; |
128 | $XON = 0; |
|
|
129 | return;#d# |
| 129 | } elsif ($_[0] == 0x11) { |
130 | } elsif ($_[0] == 0x11) { |
| 130 | $XON = 1; |
131 | $XON = 1; |
|
|
132 | return;#d# |
| 131 | } |
133 | } |
| 132 | |
134 | |
| 133 | syswrite $PTY, chr $_[0]; |
135 | syswrite $PTY, chr $_[0]; |
| 134 | |
136 | |
| 135 | $INTPEND |= 1; # 5.5 txrdy |
137 | $INTPEND |= 1; |
| 136 | } |
138 | } |
| 137 | |
139 | |
| 138 | sub out_01 { |
140 | sub out_01 { |
| 139 | $PUSARTCMD = shift; |
141 | $PUSARTCMD = shift; |
| 140 | |
142 | |
| 141 | $INTPEND |= 1 if $PUSARTCMD & 0x01; # VT102, 5.5 txrdy |
143 | $INTPEND |= 1 if $PUSARTCMD & 0x01; # VT102, 5.5 txrdy |
| 142 | $INTPEND |= 2 if $PUSARTCMD & 0x04; # VT102, 6.5 rxrdy |
144 | $INTPEND |= 2 if $PUSARTCMD & 0x04 && !@PUSARTRECV; # VT102, 6.5 rxrdy, needed for some reason |
| 143 | } |
145 | } |
| 144 | |
146 | |
| 145 | sub out_02 { } # baudrate generator |
147 | sub out_02 { } # baudrate generator |
| 146 | |
148 | |
| 147 | sub out_23 { } # unknown |
149 | sub out_23 { } # unknown |
| … | |
… | |
| 152 | |
154 | |
| 153 | sub out_62 { |
155 | sub out_62 { |
| 154 | $NVRLATCH = shift; |
156 | $NVRLATCH = shift; |
| 155 | } |
157 | } |
| 156 | |
158 | |
| 157 | sub out_a2 { $DC11 = shift } |
159 | sub out_a2 { |
|
|
160 | my $dc11 = 0x0f & shift; |
|
|
161 | |
|
|
162 | $DC11_REVERSE = 1 if $dc11 == 0b1010; |
|
|
163 | $DC11_REVERSE = 0 if $dc11 == 0b1011; |
|
|
164 | } |
|
|
165 | |
| 158 | sub out_c2 { } # unknown |
166 | sub out_c2 { } # unknown |
| 159 | sub out_d2 { $DC12 = shift } |
167 | sub out_d2 { } # 0..3 == 80c/132c/60hz/50hz |
| 160 | |
168 | |
| 161 | sub out_82 { |
169 | sub out_82 { |
| 162 | # keyboard |
170 | # keyboard |
| 163 | |
171 | |
| 164 | # CLICK STARTSCAN ONLINE LOCKED | CTS DSR INSERT L1(?) |
172 | # CLICK STARTSCAN ONLINE LOCKED | CTS DSR INSERT L1(?) |
| … | |
… | |
| 198 | |
206 | |
| 199 | my $NVRBIT; |
207 | my $NVRBIT; |
| 200 | my $LBA; |
208 | my $LBA; |
| 201 | |
209 | |
| 202 | sub in_00 { # pusart data |
210 | sub in_00 { # pusart data |
| 203 | # print "READ PUSARTDATA (@PUSARTRECV)\n"; |
211 | # interrupt not generated here, because infinite |
| 204 | |
212 | # speed does not go well with the vt102. |
| 205 | # $RST |= 2 if $#PUSARTRECV && $XON; |
|
|
| 206 | # $INTPEND |= 2 if $#PUSARTRECV && $XON; |
|
|
| 207 | |
213 | |
| 208 | shift @PUSARTRECV |
214 | shift @PUSARTRECV |
| 209 | } |
215 | } |
| 210 | |
216 | |
| 211 | sub in_01 { # pusart status |
217 | sub in_01 { # pusart status |
| … | |
… | |
| 220 | |
226 | |
| 221 | sub in_0f { } # unknown, connected to out 2f |
227 | sub in_0f { } # unknown, connected to out 2f |
| 222 | |
228 | |
| 223 | sub in_42 { # flag buffer |
229 | sub in_42 { # flag buffer |
| 224 | ++$LBA; |
230 | ++$LBA; |
| 225 | # ++$LBA; |
|
|
| 226 | # printf "%04x lba %04x, %04x\n", $PC, $LBA, $CLK; |
|
|
| 227 | |
231 | |
| 228 | $NVRBIT = nvr ? 0x20 : 0x00 if ($LBA & 0x3) == 0x2; |
232 | $NVRBIT = nvr ? 0x20 : 0x00 if ($LBA & 0x3) == 0x2; |
| 229 | |
233 | |
| 230 | # KBD_XMITEMPTY LBA7 NVRDATA ODDFIELD - OPTION !GFX !AVO PUSART_TXRDY |
234 | # KBD_XMITEMPTY LBA7 NVRDATA ODDFIELD - OPTION !GFX !AVO PUSART_TXRDY |
| 231 | |
235 | |
| … | |
… | |
| 249 | sub in_17 { 0xff } # unknown, printer status clear by reading? |
253 | sub in_17 { 0xff } # unknown, printer status clear by reading? |
| 250 | sub in_1b { 0xff } # unknown |
254 | sub in_1b { 0xff } # unknown |
| 251 | |
255 | |
| 252 | ############################################################################# |
256 | ############################################################################# |
| 253 | |
257 | |
| 254 | sub sf { |
258 | sub sf { # set flags (ZSC - AP not implemented) |
| 255 | $FS = $_[0] & 0x080; |
259 | $FS = $_[0] & 0x080; |
| 256 | $FZ = ($_[0] & 0x0ff) == 0; |
260 | $FZ = ($_[0] & 0x0ff) == 0; |
| 257 | $FC = $_[0] & 0x100; |
261 | $FC = $_[0] & 0x100; |
| 258 | |
262 | |
| 259 | $_[0] & 0xff |
263 | $_[0] & 0xff |
| 260 | } |
264 | } |
| 261 | |
265 | |
| 262 | sub sf_nc { |
266 | sub sf_nc { # set flags except carry |
| 263 | $FS = $_[0] & 0x080; |
267 | $FS = $_[0] & 0x080; |
| 264 | $FZ = ($_[0] & 0x0ff) == 0; |
268 | $FZ = ($_[0] & 0x0ff) == 0; |
| 265 | |
269 | |
| 266 | $_[0] & 0xff |
270 | $_[0] & 0xff |
| 267 | } |
271 | } |
| … | |
… | |
| 436 | } |
440 | } |
| 437 | |
441 | |
| 438 | ############################################################################# |
442 | ############################################################################# |
| 439 | |
443 | |
| 440 | my @chr = ( |
444 | my @chr = ( |
| 441 | " ", |
445 | " " , "\x{29eb}", "\x{2592}", "\x{2409}", |
| 442 | "\x{29eb}", |
446 | "\x{240c}", "\x{240d}", "\x{240a}", "\x{00b0}", |
| 443 | "\x{2592}", |
447 | "\x{00b1}", "\x{2424}", "\x{240b}", "\x{2518}", |
| 444 | "\x{2409}", |
448 | "\x{2510}", "\x{250c}", "\x{2514}", "\x{253c}", |
| 445 | "\x{240c}", |
449 | "\x{23ba}", "\x{23bb}", "\x{2500}", "\x{23bc}", |
| 446 | "\x{240d}", |
450 | "\x{23bd}", "\x{251c}", "\x{2524}", "\x{2534}", |
| 447 | "\x{240a}", |
451 | "\x{252c}", "\x{2502}", "\x{2264}", "\x{2265}", |
| 448 | "\x{00b0}", |
452 | "\x{03c0}", "\x{2260}", "\x{00a3}", "\x{00b7}", |
| 449 | "\x{00b1}", |
|
|
| 450 | "\x{2424}", |
|
|
| 451 | "\x{240b}", |
|
|
| 452 | "\x{2518}", |
|
|
| 453 | "\x{2510}", |
|
|
| 454 | "\x{250c}", |
|
|
| 455 | "\x{2514}", |
|
|
| 456 | "\x{253c}", |
|
|
| 457 | "\x{23ba}", |
|
|
| 458 | "\x{23bb}", |
|
|
| 459 | "\x{2500}", |
|
|
| 460 | "\x{23bc}", |
|
|
| 461 | "\x{23bd}", |
|
|
| 462 | "\x{251c}", |
|
|
| 463 | "\x{2524}", |
|
|
| 464 | "\x{2534}", |
|
|
| 465 | "\x{252c}", |
|
|
| 466 | "\x{2502}", |
|
|
| 467 | "\x{2264}", |
|
|
| 468 | "\x{2265}", |
|
|
| 469 | "\x{03c0}", |
|
|
| 470 | "\x{2260}", |
|
|
| 471 | "\x{0142}", |
|
|
| 472 | "\x{00b7}", |
|
|
| 473 | (map chr, 0x020 .. 0x7e), |
453 | (map chr, 0x020 .. 0x7e), |
| 474 | "?", |
|
|
| 475 | ); |
454 | ); |
| 476 | |
455 | |
| 477 | utf8::encode $_ for @chr; |
456 | utf8::encode $_ for @chr; |
|
|
457 | |
|
|
458 | my @sgr; # sgr sequences for attributes |
|
|
459 | |
|
|
460 | for (0x00 .. 0xff) { |
|
|
461 | my $sgr = ""; |
|
|
462 | |
|
|
463 | $sgr .= ";5" unless $_ & 0x01; |
|
|
464 | $sgr .= ";4" unless $_ & 0x02; |
|
|
465 | $sgr .= ";1" unless $_ & 0x04; |
|
|
466 | $sgr .= ";7" if $_ & 0x80; |
|
|
467 | |
|
|
468 | $sgr[$_] = "\e[${sgr}m"; |
|
|
469 | } |
| 478 | |
470 | |
| 479 | sub prscr { |
471 | sub prscr { |
| 480 | my $i = 0x2000; |
472 | my $i = 0x2000; |
| 481 | |
473 | |
| 482 | my $scr = sprintf "\x1b[H--- KBD %08b CLK %d PC %04x RST %03b IFF %01b PUS %02x IM %03b\x1b[K\n", $KSTATUS, $CLK, $PC, $RST, $IFF, $PUSARTCMD, $INTMASK; |
474 | my $scr = sprintf "\e[H--- KBD %08b CLK %d\e[K\n", $KSTATUS, $CLK; |
| 483 | |
475 | |
|
|
476 | $scr .= "\e[?5" . ($DC11_REVERSE ? "h" : "l"); |
|
|
477 | |
| 484 | line: |
478 | line: |
| 485 | for my $y (0 .. 25) { |
479 | for my $y (0 .. 25) { # ntsc, two vblank delay lines, up to 24 text lines |
|
|
480 | my $prev_sgr; |
|
|
481 | |
| 486 | $scr .= sprintf "%2d |", ++$y; |
482 | $scr .= sprintf "%2d |", ++$y; |
| 487 | |
483 | |
| 488 | for (0..140) { |
484 | for (0..139) { |
| 489 | my $c = $M[$i++]; |
485 | my $c = $M[$i]; |
| 490 | |
|
|
| 491 | # printf "%04x %02x\n", $i-1,$c; |
|
|
| 492 | |
486 | |
| 493 | if ($c == 0x7f) { # also 0xff, but the firmware avoids that |
487 | if ($c == 0x7f) { # also 0xff, but the firmware avoids that |
| 494 | $scr .= "|\x1b[K\n"; |
488 | $scr .= "\e[m|\e[K\n"; |
| 495 | |
489 | |
| 496 | my $a1 = $M[$i++]; |
490 | my $a1 = $M[$i + 1]; |
| 497 | my $a0 = $M[$i++]; |
491 | my $a0 = $M[$i + 2]; |
| 498 | |
492 | |
| 499 | $i = 0x2000 + (($a1 * 256 + $a0) & 0xfff); |
493 | $i = 0x2000 + (($a1 * 256 + $a0) & 0xfff); |
| 500 | |
494 | |
| 501 | next line; |
495 | next line; |
| 502 | } |
496 | } |
| 503 | |
497 | |
| 504 | $scr .= "\x1b[7m" if $c & 0x80; |
498 | my $sgr = $sgr[ ($M[$i++ + 0x1000] & 15) | ($c & 0x80)]; |
| 505 | $scr .= $chr[$c & 0x7f] // sprintf "[%02x]", $c & 0x7f; |
499 | |
| 506 | $scr .= "\x1b[m" if $c & 0x80; |
500 | # ~1 sgr 5 blink |
|
|
501 | # ~2 sgr 4 underline |
|
|
502 | # ~4 sgr 1 bold |
|
|
503 | # 0x80 in attr, sgr 7, reversed |
|
|
504 | |
|
|
505 | $scr .= $prev_sgr = $sgr if $sgr ne $prev_sgr; |
|
|
506 | |
|
|
507 | $scr .= $chr[$c & 0x7f]; |
| 507 | } |
508 | } |
| 508 | |
509 | |
| 509 | $scr .= "\x1b[K\noverflow\x1b[K\n"; |
510 | $scr .= "\e[K\nvideo overflow\e[K\n"; |
| 510 | last; |
511 | last; |
| 511 | } |
512 | } |
| 512 | |
513 | |
|
|
514 | $scr .= "\e[m"; |
|
|
515 | |
| 513 | if (0) { |
516 | if (0) { |
| 514 | $scr .= "\x1b[K\n"; |
517 | $scr .= "\e[K\n"; |
| 515 | for my $o (0x200 .. 0x232) { |
518 | for my $o (0x200 .. 0x232) { |
| 516 | $scr .= sprintf "%04x:", $o * 16; |
519 | $scr .= sprintf "%04x:", $o * 16; |
| 517 | for (0..15) { |
520 | for (0..15) { |
| 518 | $scr .= sprintf " %02x", $M[$o * 16 + $_]; |
521 | $scr .= sprintf " %02x", $M[$o * 16 + $_]; |
| 519 | } |
522 | } |
| 520 | $scr .= "\x1b[K\n"; |
523 | $scr .= "\e[K\n"; |
| 521 | } |
524 | } |
| 522 | } |
525 | } |
| 523 | |
526 | |
| 524 | $scr .= "\x1b[J"; |
527 | $scr .= "\e[J"; |
| 525 | |
528 | |
| 526 | syswrite STDOUT, $scr; |
529 | syswrite STDOUT, $scr; |
| 527 | } |
530 | } |
| 528 | |
531 | |
| 529 | ############################################################################# |
532 | ############################################################################# |
| … | |
… | |
| 532 | require IO::Pty; |
535 | require IO::Pty; |
| 533 | $PTY = IO::Pty->new; |
536 | $PTY = IO::Pty->new; |
| 534 | |
537 | |
| 535 | my $slave = $PTY->slave; |
538 | my $slave = $PTY->slave; |
| 536 | |
539 | |
|
|
540 | $PTY->set_winsize (24, 80); |
|
|
541 | |
| 537 | unless (fork) { |
542 | unless (fork) { |
| 538 | $ENV{TERM} = $VT102 ? "vt102" : "vt100"; |
543 | $ENV{TERM} = $VT102 ? "vt102" : "vt100"; |
| 539 | |
544 | |
| 540 | close $PTY; |
545 | close $PTY; |
| 541 | |
546 | |
| 542 | open STDIN , "<&", $slave; |
547 | open STDIN , "<&", $slave; |
| 543 | open STDOUT, ">&", $slave; |
548 | open STDOUT, ">&", $slave; |
| 544 | open STDERR, ">&", $slave; |
549 | open STDERR, ">&", $slave; |
| 545 | |
550 | |
|
|
551 | system "stty ixoff erase ^H"; |
|
|
552 | |
|
|
553 | $PTY->make_slave_controlling_terminal; |
| 546 | close $slave; |
554 | $PTY->close_slave; |
| 547 | |
555 | |
| 548 | exec @ARGV; |
556 | exec @ARGV; |
| 549 | } |
557 | } |
| 550 | |
558 | |
| 551 | close $slave; |
559 | $PTY->close_slave; |
|
|
560 | |
| 552 | } else { |
561 | } else { |
| 553 | open $PTY, "</dev/null" or die;#d |
562 | open $PTY, "</dev/null" or die;#d |
| 554 | } |
563 | } |
| 555 | |
564 | |
| 556 | ############################################################################# |
565 | ############################################################################# |
| … | |
… | |
| 575 | 0x7b, -0x7b, # leave setup |
584 | 0x7b, -0x7b, # leave setup |
| 576 | ); |
585 | ); |
| 577 | |
586 | |
| 578 | ############################################################################# |
587 | ############################################################################# |
| 579 | |
588 | |
| 580 | # 0x80 shift, 0x100 ctrl, 0x200 toggle |
589 | # 0x080 shift, 0x100 ctrl |
| 581 | my %KEYMAP = ( |
590 | my %KEYMAP = ( |
|
|
591 | # these get overwritten by generic control codes, but both work, so i have no priority |
|
|
592 | # tid fix these. |
| 582 | "\t" => 0x3a, |
593 | "\t" => 0x3a, |
| 583 | "\r" => 0x64, |
594 | "\r" => 0x64, |
| 584 | "\n" => 0x44, |
595 | "\n" => 0x44, |
| 585 | |
596 | |
|
|
597 | "\x00" => 0x77 | 0x100, # CTRL-SPACE |
|
|
598 | "\x1c" => 0x45 | 0x100, # CTRL-\ |
|
|
599 | "\x1d" => 0x14 | 0x100, # CTRL-] |
|
|
600 | "\x1e" => 0x24 | 0x100, # CTRL-~ |
|
|
601 | "\x1f" => 0x75 | 0x100, # CTRL-? |
|
|
602 | |
| 586 | # hardcoded rxvt keys |
603 | # hardcoded rxvt keys |
| 587 | "\e" => 0x2a, # ESC |
604 | "\e" => 0x2a, # ESC |
| 588 | "\e[3~" => 0x03, # DC |
605 | "\e[3~" => 0x03, # DC |
| 589 | "\e[5~" => 0x7e, # CAPS LOCK (prior) |
606 | "\e[5~" => 0x7e, # CAPS LOCK (prior) |
| 590 | "\e[6~" => 0x6a, # NO SCROLL (next) |
607 | "\e[6~" => 0x6a, # NO SCROLL (next) |
| 591 | "\e[A" => 0x30, # UP |
608 | "\e[A" => 0x30, # UP |
| 592 | "\e[B" => 0x22, # DOWN |
609 | "\e[B" => 0x22, # DOWN |
| 593 | "\e[C" => 0x10, # RIGHT |
610 | "\e[C" => 0x10, # RIGHT |
| 594 | "\e[D" => 0x20, # LEFT |
611 | "\e[D" => 0x20, # LEFT |
| 595 | "\e[a" => 0x30 | 0x080, # UP |
612 | "\e[a" => 0x30 | 0x080, # UP |
| 596 | "\e[b" => 0x22 | 0x080, # DOWN |
613 | "\e[b" => 0x22 | 0x080, # DOWN |
| 597 | "\e[c" => 0x10 | 0x080, # RIGHT |
614 | "\e[c" => 0x10 | 0x080, # RIGHT |
| 598 | "\e[d" => 0x20 | 0x080, # LEFT |
615 | "\e[d" => 0x20 | 0x080, # LEFT |
| 599 | "\e[7~" => 0x7b, # SETUP (home) |
616 | "\e[7~" => 0x7b, # SETUP (home) |
| 600 | "\e[8~" => 0x23, # BREAK (end) |
617 | "\e[8~" => 0x23, # BREAK (end) |
| 601 | "\e[8\$" => 0x23 | 0x080, # SHIFT BREAK / DISCONNECT (shift-end) |
618 | "\e[8\$" => 0x23 | 0x080, # SHIFT BREAK / DISCONNECT (shift-end) |
| 602 | "\x7f" => 0x33, # BACKSPACE |
619 | "\x7f" => 0x33, # BACKSPACE |
| 603 | |
620 | |
| 604 | "\e[11~" => 0x32, # F1 |
621 | "\e[11~" => 0x32, # F1 |
| 605 | "\e[11~" => 0x42, # F2 |
622 | "\e[11~" => 0x42, # F2 |
| 606 | "\e[11~" => 0x31, # F3 |
623 | "\e[11~" => 0x31, # F3 |
| 607 | "\e[11~" => 0x41, # F4 |
624 | "\e[11~" => 0x41, # F4 |
| 608 | ); |
625 | ); |
| 609 | |
626 | |
| 610 | @KEYMAP{map chr, 0x20..0x40} = unpack "C*", pack "H*", |
627 | @KEYMAP{map chr, 0x20..0x40} = unpack "C*", pack "H*", |
| 611 | "779ad5a9a8b8a755a6b5b6b466256575" . "351a3929283837273626d656e634e5f5" . "b9"; |
628 | "779ad5a9a8b8a755a6b5b6b466256575" . "351a3929283837273626d656e634e5f5" . "b9"; |
| 612 | |
629 | |
| 613 | @KEYMAP{map chr, 0x5b .. 0x7e} = unpack "C*", pack "H*", |
630 | @KEYMAP{map chr, 0x5b .. 0x7e} = unpack "C*", pack "H*", |
| 614 | "154514b7a5" . "244a6879591949485816574746766706" . "050a185a0817780969077a95c594a4"; |
631 | "154514b7a5" . "244a6879591949485816574746766706" . "050a185a0817780969077a95c594a4"; |
| 615 | |
632 | |
| 616 | $KEYMAP{"\x3f" & $_} ||= $KEYMAP{$_} | 0x100 for "a" .. "z"; # ctrl |
633 | $KEYMAP{"\x1f" & $_} ||= $KEYMAP{$_} | 0x100 for "a" .. "z"; # ctrl |
| 617 | $KEYMAP{uc $_} ||= $KEYMAP{$_} | 0x080 for "a" .. "z"; # shift |
634 | $KEYMAP{uc $_} ||= $KEYMAP{$_} | 0x080 for "a" .. "z"; # shift |
| 618 | |
635 | |
| 619 | my $KEYMATCH = join "|", map quotemeta, reverse sort keys %KEYMAP; |
636 | my $KEYMATCH = join "|", map quotemeta, reverse sort keys %KEYMAP; |
| 620 | $KEYMATCH = qr{^($KEYMATCH)}s; |
637 | $KEYMATCH = qr{^($KEYMATCH)}s; |
| 621 | |
638 | |
| … | |
… | |
| 704 | eval "use integer; sub { $insn }" or die "$insn: $@" |
721 | eval "use integer; sub { $insn }" or die "$insn: $@" |
| 705 | })->(); |
722 | })->(); |
| 706 | |
723 | |
| 707 | ++$CLK; |
724 | ++$CLK; |
| 708 | |
725 | |
| 709 | #TODO: just check on ret instructions or so |
726 | # things we do from time too time only |
|
|
727 | unless ($CLK & 0xf) { |
|
|
728 | # do I/O |
|
|
729 | |
|
|
730 | unless ($CLK & 0x7ff) { |
|
|
731 | |
|
|
732 | # pty/serial I/O |
|
|
733 | unless (@PUSARTRECV || @KQUEUE || !$PTY) { |
|
|
734 | my $rin = ""; (vec $rin, fileno $PTY, 1) = 1; |
|
|
735 | |
|
|
736 | if (select $rin, undef, undef, 0) { |
|
|
737 | sysread $PTY, my $buf, 256; |
|
|
738 | push @PUSARTRECV, unpack "C*", $buf; |
|
|
739 | } |
|
|
740 | } |
|
|
741 | |
|
|
742 | # keyboard input |
|
|
743 | if ($KBD) { |
|
|
744 | while (select my $rin = "\x01", undef, undef, 0) { |
|
|
745 | sysread STDIN, $STDIN_BUF, 1, length $STDIN_BUF |
|
|
746 | or last; |
|
|
747 | } |
|
|
748 | |
|
|
749 | stdin_parse if length $STDIN_BUF; |
|
|
750 | } |
|
|
751 | } |
|
|
752 | |
|
|
753 | # kick off various interrupts |
|
|
754 | |
|
|
755 | $RST |= 2 if @PUSARTRECV && $XON; # VT100, but works on vt102, too (probably not used on real hardware though) |
|
|
756 | #$INTPEND |= 2 if @PUSARTRECV && $XON; # VT102, 6.5 rxrdy |
|
|
757 | |
|
|
758 | # kick off vertical retrace form time to time |
|
|
759 | unless ($CLK & 0x1ff) { |
|
|
760 | $RST |= 4; # vertical retrace |
|
|
761 | } |
|
|
762 | |
|
|
763 | # handle video hardware |
|
|
764 | |
|
|
765 | unless ($CLK & 0x1fff) { |
|
|
766 | prscr; |
|
|
767 | } |
|
|
768 | } |
|
|
769 | |
| 710 | # the interrupt logic |
770 | # the interrupt logic |
| 711 | $x = $INTPEND & ~$INTMASK; |
771 | $x = $INTPEND & ~$INTMASK; |
| 712 | |
|
|
| 713 | if (($RST || $x) && $IFF) { |
772 | if (($RST || $x) && $IFF) { |
| 714 | # rst 1 kbd data available |
773 | # rst 1 kbd data available |
| 715 | # rst 2 pusart xmit+recv flag |
774 | # rst 2 pusart xmit+recv flag |
| 716 | # rst 4 vertical retrace |
775 | # rst 4 vertical retrace |
| 717 | # 5.5 vt125 mb7 trans ready (serial send?) |
776 | # 5.5 vt125 mb7 trans ready (serial send?) |
| … | |
… | |
| 734 | $M[--$SP] = $PC >> 8; |
793 | $M[--$SP] = $PC >> 8; |
| 735 | $M[--$SP] = $PC & 0xff; |
794 | $M[--$SP] = $PC & 0xff; |
| 736 | $PC = $vec; |
795 | $PC = $vec; |
| 737 | |
796 | |
| 738 | $IFF = 0; |
797 | $IFF = 0; |
| 739 | } |
|
|
| 740 | |
|
|
| 741 | # things we do from time too time only |
|
|
| 742 | unless ($CLK & 0xf) { |
|
|
| 743 | # do I/O |
|
|
| 744 | |
|
|
| 745 | unless ($CLK & 0x7ff) { |
|
|
| 746 | |
|
|
| 747 | # pty/serial I/O |
|
|
| 748 | unless (@PUSARTRECV || @KQUEUE || !$PTY) { |
|
|
| 749 | my $rin = ""; (vec $rin, fileno $PTY, 1) = 1; |
|
|
| 750 | |
|
|
| 751 | if (select $rin, undef, undef, 0) { |
|
|
| 752 | sysread $PTY, my $buf, 256; |
|
|
| 753 | push @PUSARTRECV, unpack "C*", $buf; |
|
|
| 754 | } |
|
|
| 755 | } |
|
|
| 756 | |
|
|
| 757 | # keyboard input |
|
|
| 758 | if ($KBD) { |
|
|
| 759 | while (select my $rin = "\x01", undef, undef, 0) { |
|
|
| 760 | sysread STDIN, $STDIN_BUF, 1, length $STDIN_BUF |
|
|
| 761 | or last; |
|
|
| 762 | } |
|
|
| 763 | |
|
|
| 764 | stdin_parse if length $STDIN_BUF; |
|
|
| 765 | } |
|
|
| 766 | } |
|
|
| 767 | |
|
|
| 768 | # kick off various interrupts |
|
|
| 769 | |
|
|
| 770 | $RST |= 2 if @PUSARTRECV && $XON;# vt100, also works on vt102, probably by accident |
|
|
| 771 | #$INTPEND |= 2 if @PUSARTRECV && $XON;# real vt102 probably does it this way |
|
|
| 772 | |
|
|
| 773 | unless ($CLK & 0x3ff) { |
|
|
| 774 | $RST |= 4; # vertical retrace |
|
|
| 775 | } |
|
|
| 776 | |
|
|
| 777 | # handle video hardware |
|
|
| 778 | |
|
|
| 779 | unless ($CLK & 0x1fff) { |
|
|
| 780 | prscr; |
|
|
| 781 | } |
|
|
| 782 | } |
798 | } |
| 783 | } |
799 | } |
| 784 | |
800 | |
| 785 | __DATA__ |
801 | __DATA__ |
| 786 | 1N ; 0 >b/BWog<Gӂ,O $
O [ xI,ڥ # yOt ͤ[ zW>/2!b>>g$>%
!h w-!h >-4!j pO:{ y:! u:x!_yA[>y
>yA[>?y@
:x!yA[P>>O[>>[Î:!ʵyA>>OlyAPÇ!:!S!h ~ ~ : O͓: Ô!20!2!!!yAG~"& =w< w:!/!!A:!Ey2!~1N ! ~ eBi<2!͢:P =2S!~6ʘ!!6 |
802 | 1N ; 0 >b/BWog<Gӂ,O $
O [ xI,ڥ # yOt ͤ[ zW>/2!b>>g$>%
!h w-!h >-4!j pO:{ y:! u:x!_yA[>y
>yA[>?y@
:x!yA[P>>O[>>[Î:!ʵyA>>OlyAPÇ!:!S!h ~ ~ : O͓: Ô!20!2!!!yAG~"& =w< w:!/!!A:!Ey2!~1N ! ~ eBi<2!͢:P =2S!~6ʘ!!6 |
