… | |
… | |
21 | # ./vt102 bash |
21 | # ./vt102 bash |
22 | # ./vt102 telnet towel.blinkenlights.nl |
22 | # ./vt102 telnet towel.blinkenlights.nl |
23 | # ./vt102 curl http://artscene.textfiles.com/vt100/trekvid.vt |
23 | # ./vt102 curl http://artscene.textfiles.com/vt100/trekvid.vt |
24 | # ./vt102 curl http://artscene.textfiles.com/vt100/surf.vt # in 3d! |
24 | # ./vt102 curl http://artscene.textfiles.com/vt100/surf.vt # in 3d! |
25 | |
25 | |
|
|
26 | # TODO: ctrl |
|
|
27 | |
26 | use common::sense; |
28 | use common::sense; |
27 | |
29 | |
28 | $| = 1; |
30 | $| = 1; |
29 | |
31 | |
30 | my $VT102 = 0; |
32 | my $VT102 = 1; |
31 | my $AVO = $VT102 || 1; |
33 | my $AVO = $VT102 || 1; |
32 | my $KBD = 1; |
34 | my $KBD = 1; |
33 | |
35 | |
34 | ############################################################################# |
36 | ############################################################################# |
35 | |
37 | # rom initialising |
36 | my $PTY; # the pty we allocated, if any |
|
|
37 | |
38 | |
38 | my $ROM = do { |
39 | my $ROM = do { |
39 | binmode DATA; |
40 | binmode DATA; |
40 | local $/; |
41 | local $/; |
41 | <DATA> |
42 | <DATA> |
… | |
… | |
54 | } else { |
55 | } else { |
55 | @M[0x0000 .. 0x1fff] = unpack "C*", substr $ROM, 0x0000, 0x2000; |
56 | @M[0x0000 .. 0x1fff] = unpack "C*", substr $ROM, 0x0000, 0x2000; |
56 | } |
57 | } |
57 | |
58 | |
58 | ############################################################################# |
59 | ############################################################################# |
|
|
60 | # cpu registers and I/O support |
59 | |
61 | |
|
|
62 | my $PTY; # the pty we allocated, if any |
60 | my $PRSTATUS = 0; |
63 | my $PRSTATUS = 0; |
61 | |
64 | |
62 | # 8080/8085 registers |
65 | # 8080/8085 registers |
63 | # b, c, d, e, h, l, a |
66 | # b, c, d, e, h, l, a |
64 | my ($A, $B, $C, $D, $E, $H, $L, $A); |
67 | my ($A, $B, $C, $D, $E, $H, $L, $A); |
… | |
… | |
71 | my $x; # dummy temp for instructions |
74 | my $x; # dummy temp for instructions |
72 | |
75 | |
73 | my $CLK; # rather inexact clock |
76 | my $CLK; # rather inexact clock |
74 | |
77 | |
75 | ############################################################################# |
78 | ############################################################################# |
|
|
79 | # the dreaded nvr1400 chip. not needed to get it going, but provided for reference |
76 | |
80 | |
77 | # nvram |
81 | # nvram |
78 | 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 |
79 | my $NVRADDR; |
83 | my $NVRADDR; |
80 | my $NVRDATA; |
84 | my $NVRDATA; |
81 | my $NVRLATCH; |
85 | my $NVRLATCH; |
82 | |
86 | |
83 | #$NVR[$_] = $_ for 0..99;#d# |
|
|
84 | |
|
|
85 | my @NVRCMD = ( |
87 | my @NVRCMD = ( |
86 | sub { # accept data |
|
|
87 | $NVRDATA = ($NVRDATA << 1) + $_[1]; |
88 | sub { $NVRDATA = ($NVRDATA << 1) + $_[1]; }, # 0 accept data |
88 | }, |
89 | sub { $NVRADDR = ($NVRADDR << 1) + $_[1]; }, # 1 accept addr |
89 | sub { # accept addr |
90 | sub { ($NVRDATA <<= 1) & 0x4000 }, # 2 shift out |
90 | $NVRADDR = ($NVRADDR << 1)+ $_[1]; |
91 | undef, # 3 not used, will barf |
91 | }, |
|
|
92 | sub { # shift out |
|
|
93 | my $bit = $NVRDATA & 0x02000; |
|
|
94 | $NVRDATA *= 2; |
|
|
95 | $bit |
|
|
96 | }, |
|
|
97 | undef, |
|
|
98 | sub { # write |
|
|
99 | print "NVR WRITE $_[0]\n";#d# |
|
|
100 | $NVR[$_[0]] = $NVRDATA & 0x3fff; |
92 | sub { $NVR[$_[0]] = $NVRDATA & 0x3fff; }, # 4 write |
101 | }, |
93 | sub { $NVR[$_[0]] = 0x3fff; }, # 5 erase |
102 | sub { # erase |
94 | sub { $NVRDATA = $NVR[$_[0]]; }, # 6 read |
103 | print "NVR ERASE $_[0]\n";#d# |
95 | sub { }, # 7 standby |
104 | $NVR[$_[0]] = 0x3fff; |
|
|
105 | }, |
|
|
106 | sub { # read |
|
|
107 | # print "NVR READ $_[0] = $NVR[$_[0]]\n";#d# |
|
|
108 | $NVRDATA = $NVR[$_[0]]; |
|
|
109 | }, |
|
|
110 | sub { # standby |
|
|
111 | }, |
|
|
112 | ); |
96 | ); |
113 | |
97 | |
114 | my @bitidx; |
98 | my @bitidx; |
115 | $bitidx[1 << $_] = 9 - $_ for 0..9; |
99 | $bitidx[1 << $_] = 9 - $_ for 0..9; |
116 | |
100 | |
… | |
… | |
141 | |
125 | |
142 | sub out_00 { # pusartdata |
126 | sub out_00 { # pusartdata |
143 | # handle xon/xoff, but also pass it through |
127 | # handle xon/xoff, but also pass it through |
144 | if ($_[0] == 0x13) { |
128 | if ($_[0] == 0x13) { |
145 | $XON = 0; |
129 | $XON = 0; |
|
|
130 | return;#d# |
146 | } elsif ($_[0] == 0x11) { |
131 | } elsif ($_[0] == 0x11) { |
147 | $XON = 1; |
132 | $XON = 1; |
|
|
133 | return;#d# |
148 | } |
134 | } |
149 | |
135 | |
150 | syswrite $PTY, chr $_[0]; |
136 | syswrite $PTY, chr $_[0]; |
151 | |
137 | |
152 | $INTPEND |= 1; # 5.5 txrdy |
138 | $INTPEND |= 1; |
153 | } |
139 | } |
154 | |
140 | |
155 | sub out_01 { |
141 | sub out_01 { |
156 | $PUSARTCMD = shift; |
142 | $PUSARTCMD = shift; |
157 | |
143 | |
158 | $INTPEND |= 1 if $PUSARTCMD & 0x01; # VT102, 5.5 txrdy |
144 | $INTPEND |= 1 if $PUSARTCMD & 0x01; # VT102, 5.5 txrdy |
159 | $INTPEND |= 2 if $PUSARTCMD & 0x04; # VT102, 6.5 rxrdy |
145 | $INTPEND |= 2 if $PUSARTCMD & 0x04 && !@PUSARTRECV; # VT102, 6.5 rxrdy, needed for some reason |
160 | } |
146 | } |
161 | |
147 | |
162 | sub out_02 { } # baudrate generator |
148 | sub out_02 { } # baudrate generator |
163 | |
149 | |
164 | sub out_23 { } # unknown |
150 | sub out_23 { } # unknown |
… | |
… | |
215 | |
201 | |
216 | my $NVRBIT; |
202 | my $NVRBIT; |
217 | my $LBA; |
203 | my $LBA; |
218 | |
204 | |
219 | sub in_00 { # pusart data |
205 | sub in_00 { # pusart data |
220 | # print "READ PUSARTDATA (@PUSARTRECV)\n"; |
206 | # interrupt not generated here, because infinite |
221 | |
207 | # speed does not go well with the vt102. |
222 | # $RST |= 2 if $#PUSARTRECV && $XON; |
|
|
223 | # $INTPEND |= 2 if $#PUSARTRECV && $XON; |
|
|
224 | |
208 | |
225 | shift @PUSARTRECV |
209 | shift @PUSARTRECV |
226 | } |
210 | } |
227 | |
211 | |
228 | sub in_01 { # pusart status |
212 | sub in_01 { # pusart status |
… | |
… | |
237 | |
221 | |
238 | sub in_0f { } # unknown, connected to out 2f |
222 | sub in_0f { } # unknown, connected to out 2f |
239 | |
223 | |
240 | sub in_42 { # flag buffer |
224 | sub in_42 { # flag buffer |
241 | ++$LBA; |
225 | ++$LBA; |
242 | # ++$LBA; |
|
|
243 | # printf "%04x lba %04x, %04x\n", $PC, $LBA, $CLK; |
|
|
244 | |
226 | |
245 | $NVRBIT = nvr ? 0x20 : 0x00 if ($LBA & 0x3) == 0x2; |
227 | $NVRBIT = nvr ? 0x20 : 0x00 if ($LBA & 0x3) == 0x2; |
246 | |
228 | |
247 | # KBD_XMITEMPTY LBA7 NVRDATA ODDFIELD - OPTION !GFX !AVO PUSART_TXRDY |
229 | # KBD_XMITEMPTY LBA7 NVRDATA ODDFIELD - OPTION !GFX !AVO PUSART_TXRDY |
248 | |
230 | |
… | |
… | |
266 | sub in_17 { 0xff } # unknown, printer status clear by reading? |
248 | sub in_17 { 0xff } # unknown, printer status clear by reading? |
267 | sub in_1b { 0xff } # unknown |
249 | sub in_1b { 0xff } # unknown |
268 | |
250 | |
269 | ############################################################################# |
251 | ############################################################################# |
270 | |
252 | |
271 | sub sf { |
253 | sub sf { # set flags (ZSC - AP not implemented) |
272 | $FS = $_[0] & 0x080; |
254 | $FS = $_[0] & 0x080; |
273 | $FZ = ($_[0] & 0x0ff) == 0; |
255 | $FZ = ($_[0] & 0x0ff) == 0; |
274 | $FC = $_[0] & 0x100; |
256 | $FC = $_[0] & 0x100; |
275 | |
257 | |
276 | $_[0] & 0xff |
258 | $_[0] & 0xff |
277 | } |
259 | } |
278 | |
260 | |
279 | sub sf_nc { |
261 | sub sf_nc { # set flags except carry |
280 | $FS = $_[0] & 0x080; |
262 | $FS = $_[0] & 0x080; |
281 | $FZ = ($_[0] & 0x0ff) == 0; |
263 | $FZ = ($_[0] & 0x0ff) == 0; |
282 | |
264 | |
283 | $_[0] & 0xff |
265 | $_[0] & 0xff |
284 | } |
266 | } |
… | |
… | |
453 | } |
435 | } |
454 | |
436 | |
455 | ############################################################################# |
437 | ############################################################################# |
456 | |
438 | |
457 | my @chr = ( |
439 | my @chr = ( |
458 | " ", |
440 | " " , "\x{29eb}", "\x{2592}", "\x{2409}", |
459 | "\x{29eb}", |
441 | "\x{240c}", "\x{240d}", "\x{240a}", "\x{00b0}", |
460 | "\x{2592}", |
442 | "\x{00b1}", "\x{2424}", "\x{240b}", "\x{2518}", |
461 | "\x{2409}", |
443 | "\x{2510}", "\x{250c}", "\x{2514}", "\x{253c}", |
462 | "\x{240c}", |
444 | "\x{23ba}", "\x{23bb}", "\x{2500}", "\x{23bc}", |
463 | "\x{240d}", |
445 | "\x{23bd}", "\x{251c}", "\x{2524}", "\x{2534}", |
464 | "\x{240a}", |
446 | "\x{252c}", "\x{2502}", "\x{2264}", "\x{2265}", |
465 | "\x{00b0}", |
447 | "\x{03c0}", "\x{2260}", "\x{00a3}", "\x{00b7}", |
466 | "\x{00b1}", |
|
|
467 | "\x{2424}", |
|
|
468 | "\x{240b}", |
|
|
469 | "\x{2518}", |
|
|
470 | "\x{2510}", |
|
|
471 | "\x{250c}", |
|
|
472 | "\x{2514}", |
|
|
473 | "\x{253c}", |
|
|
474 | "\x{23ba}", |
|
|
475 | "\x{23bb}", |
|
|
476 | "\x{2500}", |
|
|
477 | "\x{23bc}", |
|
|
478 | "\x{23bd}", |
|
|
479 | "\x{251c}", |
|
|
480 | "\x{2524}", |
|
|
481 | "\x{2534}", |
|
|
482 | "\x{252c}", |
|
|
483 | "\x{2502}", |
|
|
484 | "\x{2264}", |
|
|
485 | "\x{2265}", |
|
|
486 | "\x{03c0}", |
|
|
487 | "\x{2260}", |
|
|
488 | "\x{00a3}", |
|
|
489 | "\x{00b7}", |
|
|
490 | (map chr, 0x020 .. 0x7e), |
448 | (map chr, 0x020 .. 0x7e), |
491 | "?", |
|
|
492 | ); |
449 | ); |
493 | |
450 | |
494 | utf8::encode $_ for @chr; |
451 | utf8::encode $_ for @chr; |
495 | |
452 | |
496 | sub prscr { |
453 | sub prscr { |
497 | my $i = 0x2000; |
454 | my $i = 0x2000; |
498 | |
455 | |
499 | 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; |
456 | 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; |
500 | |
457 | |
501 | line: |
458 | line: |
502 | for my $y (0 .. 25) { |
459 | for my $y (0 .. 25) { |
503 | $scr .= sprintf "%2d |", ++$y; |
460 | $scr .= sprintf "%2d |", ++$y; |
504 | |
461 | |
505 | for (0..140) { |
462 | for (0..140) { |
… | |
… | |
549 | require IO::Pty; |
506 | require IO::Pty; |
550 | $PTY = IO::Pty->new; |
507 | $PTY = IO::Pty->new; |
551 | |
508 | |
552 | my $slave = $PTY->slave; |
509 | my $slave = $PTY->slave; |
553 | |
510 | |
|
|
511 | $PTY->set_winsize (24, 80); |
|
|
512 | |
554 | unless (fork) { |
513 | unless (fork) { |
555 | $ENV{TERM} = $VT102 ? "vt102" : "vt100"; |
514 | $ENV{TERM} = $VT102 ? "vt102" : "vt100"; |
556 | |
515 | |
557 | close $PTY; |
516 | close $PTY; |
558 | |
517 | |
559 | open STDIN , "<&", $slave; |
518 | open STDIN , "<&", $slave; |
560 | open STDOUT, ">&", $slave; |
519 | open STDOUT, ">&", $slave; |
561 | open STDERR, ">&", $slave; |
520 | open STDERR, ">&", $slave; |
562 | |
521 | |
|
|
522 | system "stty ixoff erase ^H"; |
|
|
523 | |
|
|
524 | $PTY->make_slave_controlling_terminal; |
563 | close $slave; |
525 | $PTY->close_slave; |
564 | |
526 | |
565 | exec @ARGV; |
527 | exec @ARGV; |
566 | } |
528 | } |
567 | |
529 | |
568 | close $slave; |
530 | $PTY->close_slave; |
|
|
531 | |
569 | } else { |
532 | } else { |
570 | open $PTY, "</dev/null" or die;#d |
533 | open $PTY, "</dev/null" or die;#d |
571 | } |
534 | } |
572 | |
535 | |
573 | ############################################################################# |
536 | ############################################################################# |
… | |
… | |
721 | eval "use integer; sub { $insn }" or die "$insn: $@" |
684 | eval "use integer; sub { $insn }" or die "$insn: $@" |
722 | })->(); |
685 | })->(); |
723 | |
686 | |
724 | ++$CLK; |
687 | ++$CLK; |
725 | |
688 | |
726 | #TODO: just check on ret instructions or so |
689 | # things we do from time too time only |
|
|
690 | unless ($CLK & 0xf) { |
|
|
691 | # do I/O |
|
|
692 | |
|
|
693 | unless ($CLK & 0x7ff) { |
|
|
694 | |
|
|
695 | # pty/serial I/O |
|
|
696 | unless (@PUSARTRECV || @KQUEUE || !$PTY) { |
|
|
697 | my $rin = ""; (vec $rin, fileno $PTY, 1) = 1; |
|
|
698 | |
|
|
699 | if (select $rin, undef, undef, 0) { |
|
|
700 | sysread $PTY, my $buf, 256; |
|
|
701 | push @PUSARTRECV, unpack "C*", $buf; |
|
|
702 | } |
|
|
703 | } |
|
|
704 | |
|
|
705 | # keyboard input |
|
|
706 | if ($KBD) { |
|
|
707 | while (select my $rin = "\x01", undef, undef, 0) { |
|
|
708 | sysread STDIN, $STDIN_BUF, 1, length $STDIN_BUF |
|
|
709 | or last; |
|
|
710 | } |
|
|
711 | |
|
|
712 | stdin_parse if length $STDIN_BUF; |
|
|
713 | } |
|
|
714 | } |
|
|
715 | |
|
|
716 | # kick off various interrupts |
|
|
717 | |
|
|
718 | $RST |= 2 if @PUSARTRECV && $XON; # VT100, but works on vt102, too (probably not used on real hardware though) |
|
|
719 | #$INTPEND |= 2 if @PUSARTRECV && $XON; # VT102, 6.5 rxrdy |
|
|
720 | |
|
|
721 | # kick off vertical retrace form time to time |
|
|
722 | unless ($CLK & 0x1ff) { |
|
|
723 | $RST |= 4; # vertical retrace |
|
|
724 | } |
|
|
725 | |
|
|
726 | # handle video hardware |
|
|
727 | |
|
|
728 | unless ($CLK & 0x1fff) { |
|
|
729 | prscr; |
|
|
730 | } |
|
|
731 | } |
|
|
732 | |
727 | # the interrupt logic |
733 | # the interrupt logic |
728 | $x = $INTPEND & ~$INTMASK; |
734 | $x = $INTPEND & ~$INTMASK; |
729 | |
|
|
730 | if (($RST || $x) && $IFF) { |
735 | if (($RST || $x) && $IFF) { |
731 | # rst 1 kbd data available |
736 | # rst 1 kbd data available |
732 | # rst 2 pusart xmit+recv flag |
737 | # rst 2 pusart xmit+recv flag |
733 | # rst 4 vertical retrace |
738 | # rst 4 vertical retrace |
734 | # 5.5 vt125 mb7 trans ready (serial send?) |
739 | # 5.5 vt125 mb7 trans ready (serial send?) |
… | |
… | |
751 | $M[--$SP] = $PC >> 8; |
756 | $M[--$SP] = $PC >> 8; |
752 | $M[--$SP] = $PC & 0xff; |
757 | $M[--$SP] = $PC & 0xff; |
753 | $PC = $vec; |
758 | $PC = $vec; |
754 | |
759 | |
755 | $IFF = 0; |
760 | $IFF = 0; |
756 | } |
|
|
757 | |
|
|
758 | # things we do from time too time only |
|
|
759 | unless ($CLK & 0xf) { |
|
|
760 | # do I/O |
|
|
761 | |
|
|
762 | unless ($CLK & 0x7ff) { |
|
|
763 | |
|
|
764 | # pty/serial I/O |
|
|
765 | unless (@PUSARTRECV || @KQUEUE || !$PTY) { |
|
|
766 | my $rin = ""; (vec $rin, fileno $PTY, 1) = 1; |
|
|
767 | |
|
|
768 | if (select $rin, undef, undef, 0) { |
|
|
769 | sysread $PTY, my $buf, 256; |
|
|
770 | push @PUSARTRECV, unpack "C*", $buf; |
|
|
771 | } |
|
|
772 | } |
|
|
773 | |
|
|
774 | # keyboard input |
|
|
775 | if ($KBD) { |
|
|
776 | while (select my $rin = "\x01", undef, undef, 0) { |
|
|
777 | sysread STDIN, $STDIN_BUF, 1, length $STDIN_BUF |
|
|
778 | or last; |
|
|
779 | } |
|
|
780 | |
|
|
781 | stdin_parse if length $STDIN_BUF; |
|
|
782 | } |
|
|
783 | } |
|
|
784 | |
|
|
785 | # kick off various interrupts |
|
|
786 | |
|
|
787 | $RST |= 2 if @PUSARTRECV && $XON;# vt100, also works on vt102, probably by accident |
|
|
788 | #$INTPEND |= 2 if @PUSARTRECV && $XON;# real vt102 probably does it this way |
|
|
789 | |
|
|
790 | unless ($CLK & 0x3ff) { |
|
|
791 | $RST |= 4; # vertical retrace |
|
|
792 | } |
|
|
793 | |
|
|
794 | # handle video hardware |
|
|
795 | |
|
|
796 | unless ($CLK & 0x1fff) { |
|
|
797 | prscr; |
|
|
798 | } |
|
|
799 | } |
761 | } |
800 | } |
762 | } |
801 | |
763 | |
802 | __DATA__ |
764 | __DATA__ |
803 | 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 |
765 | 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 |