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 | use strict; |
|
|
27 | use feature qw(state); |
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 \xe2\x94\x82", $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\xe2\x94\x82\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 |