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 |
|
|
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 | |
… | |
… | |
124 | |
125 | |
125 | sub out_00 { # pusartdata |
126 | sub out_00 { # pusartdata |
126 | # handle xon/xoff, but also pass it through |
127 | # handle xon/xoff, but also pass it through |
127 | if ($_[0] == 0x13) { |
128 | if ($_[0] == 0x13) { |
128 | $XON = 0; |
129 | $XON = 0; |
|
|
130 | return;#d# |
129 | } elsif ($_[0] == 0x11) { |
131 | } elsif ($_[0] == 0x11) { |
130 | $XON = 1; |
132 | $XON = 1; |
|
|
133 | return;#d# |
131 | } |
134 | } |
132 | |
135 | |
133 | syswrite $PTY, chr $_[0]; |
136 | syswrite $PTY, chr $_[0]; |
134 | |
137 | |
135 | $INTPEND |= 1; # 5.5 txrdy |
138 | $INTPEND |= 1; |
136 | } |
139 | } |
137 | |
140 | |
138 | sub out_01 { |
141 | sub out_01 { |
139 | $PUSARTCMD = shift; |
142 | $PUSARTCMD = shift; |
140 | |
143 | |
141 | $INTPEND |= 1 if $PUSARTCMD & 0x01; # VT102, 5.5 txrdy |
144 | $INTPEND |= 1 if $PUSARTCMD & 0x01; # VT102, 5.5 txrdy |
142 | $INTPEND |= 2 if $PUSARTCMD & 0x04; # VT102, 6.5 rxrdy |
145 | $INTPEND |= 2 if $PUSARTCMD & 0x04 && !@PUSARTRECV; # VT102, 6.5 rxrdy, needed for some reason |
143 | } |
146 | } |
144 | |
147 | |
145 | sub out_02 { } # baudrate generator |
148 | sub out_02 { } # baudrate generator |
146 | |
149 | |
147 | sub out_23 { } # unknown |
150 | sub out_23 { } # unknown |
… | |
… | |
198 | |
201 | |
199 | my $NVRBIT; |
202 | my $NVRBIT; |
200 | my $LBA; |
203 | my $LBA; |
201 | |
204 | |
202 | sub in_00 { # pusart data |
205 | sub in_00 { # pusart data |
203 | # print "READ PUSARTDATA (@PUSARTRECV)\n"; |
206 | # interrupt not generated here, because infinite |
204 | |
207 | # speed does not go well with the vt102. |
205 | # $RST |= 2 if $#PUSARTRECV && $XON; |
|
|
206 | # $INTPEND |= 2 if $#PUSARTRECV && $XON; |
|
|
207 | |
208 | |
208 | shift @PUSARTRECV |
209 | shift @PUSARTRECV |
209 | } |
210 | } |
210 | |
211 | |
211 | sub in_01 { # pusart status |
212 | sub in_01 { # pusart status |
… | |
… | |
220 | |
221 | |
221 | sub in_0f { } # unknown, connected to out 2f |
222 | sub in_0f { } # unknown, connected to out 2f |
222 | |
223 | |
223 | sub in_42 { # flag buffer |
224 | sub in_42 { # flag buffer |
224 | ++$LBA; |
225 | ++$LBA; |
225 | # ++$LBA; |
|
|
226 | # printf "%04x lba %04x, %04x\n", $PC, $LBA, $CLK; |
|
|
227 | |
226 | |
228 | $NVRBIT = nvr ? 0x20 : 0x00 if ($LBA & 0x3) == 0x2; |
227 | $NVRBIT = nvr ? 0x20 : 0x00 if ($LBA & 0x3) == 0x2; |
229 | |
228 | |
230 | # KBD_XMITEMPTY LBA7 NVRDATA ODDFIELD - OPTION !GFX !AVO PUSART_TXRDY |
229 | # KBD_XMITEMPTY LBA7 NVRDATA ODDFIELD - OPTION !GFX !AVO PUSART_TXRDY |
231 | |
230 | |
… | |
… | |
249 | sub in_17 { 0xff } # unknown, printer status clear by reading? |
248 | sub in_17 { 0xff } # unknown, printer status clear by reading? |
250 | sub in_1b { 0xff } # unknown |
249 | sub in_1b { 0xff } # unknown |
251 | |
250 | |
252 | ############################################################################# |
251 | ############################################################################# |
253 | |
252 | |
254 | sub sf { |
253 | sub sf { # set flags (ZSC - AP not implemented) |
255 | $FS = $_[0] & 0x080; |
254 | $FS = $_[0] & 0x080; |
256 | $FZ = ($_[0] & 0x0ff) == 0; |
255 | $FZ = ($_[0] & 0x0ff) == 0; |
257 | $FC = $_[0] & 0x100; |
256 | $FC = $_[0] & 0x100; |
258 | |
257 | |
259 | $_[0] & 0xff |
258 | $_[0] & 0xff |
260 | } |
259 | } |
261 | |
260 | |
262 | sub sf_nc { |
261 | sub sf_nc { # set flags except carry |
263 | $FS = $_[0] & 0x080; |
262 | $FS = $_[0] & 0x080; |
264 | $FZ = ($_[0] & 0x0ff) == 0; |
263 | $FZ = ($_[0] & 0x0ff) == 0; |
265 | |
264 | |
266 | $_[0] & 0xff |
265 | $_[0] & 0xff |
267 | } |
266 | } |
… | |
… | |
436 | } |
435 | } |
437 | |
436 | |
438 | ############################################################################# |
437 | ############################################################################# |
439 | |
438 | |
440 | my @chr = ( |
439 | my @chr = ( |
441 | " ", |
440 | " " , "\x{29eb}", "\x{2592}", "\x{2409}", |
442 | "\x{29eb}", |
441 | "\x{240c}", "\x{240d}", "\x{240a}", "\x{00b0}", |
443 | "\x{2592}", |
442 | "\x{00b1}", "\x{2424}", "\x{240b}", "\x{2518}", |
444 | "\x{2409}", |
443 | "\x{2510}", "\x{250c}", "\x{2514}", "\x{253c}", |
445 | "\x{240c}", |
444 | "\x{23ba}", "\x{23bb}", "\x{2500}", "\x{23bc}", |
446 | "\x{240d}", |
445 | "\x{23bd}", "\x{251c}", "\x{2524}", "\x{2534}", |
447 | "\x{240a}", |
446 | "\x{252c}", "\x{2502}", "\x{2264}", "\x{2265}", |
448 | "\x{00b0}", |
447 | "\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), |
448 | (map chr, 0x020 .. 0x7e), |
474 | "?", |
|
|
475 | ); |
449 | ); |
476 | |
450 | |
477 | utf8::encode $_ for @chr; |
451 | utf8::encode $_ for @chr; |
478 | |
452 | |
479 | sub prscr { |
453 | sub prscr { |
480 | my $i = 0x2000; |
454 | my $i = 0x2000; |
481 | |
455 | |
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; |
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; |
483 | |
457 | |
484 | line: |
458 | line: |
485 | for my $y (0 .. 25) { |
459 | for my $y (0 .. 25) { |
486 | $scr .= sprintf "%2d |", ++$y; |
460 | $scr .= sprintf "%2d |", ++$y; |
487 | |
461 | |
488 | for (0..140) { |
462 | for (0..140) { |
… | |
… | |
532 | require IO::Pty; |
506 | require IO::Pty; |
533 | $PTY = IO::Pty->new; |
507 | $PTY = IO::Pty->new; |
534 | |
508 | |
535 | my $slave = $PTY->slave; |
509 | my $slave = $PTY->slave; |
536 | |
510 | |
|
|
511 | $PTY->set_winsize (24, 80); |
|
|
512 | |
537 | unless (fork) { |
513 | unless (fork) { |
538 | $ENV{TERM} = $VT102 ? "vt102" : "vt100"; |
514 | $ENV{TERM} = $VT102 ? "vt102" : "vt100"; |
539 | |
515 | |
540 | close $PTY; |
516 | close $PTY; |
541 | |
517 | |
542 | open STDIN , "<&", $slave; |
518 | open STDIN , "<&", $slave; |
543 | open STDOUT, ">&", $slave; |
519 | open STDOUT, ">&", $slave; |
544 | open STDERR, ">&", $slave; |
520 | open STDERR, ">&", $slave; |
545 | |
521 | |
|
|
522 | system "stty ixoff erase ^H"; |
|
|
523 | |
|
|
524 | $PTY->make_slave_controlling_terminal; |
546 | close $slave; |
525 | $PTY->close_slave; |
547 | |
526 | |
548 | exec @ARGV; |
527 | exec @ARGV; |
549 | } |
528 | } |
550 | |
529 | |
551 | close $slave; |
530 | $PTY->close_slave; |
|
|
531 | |
552 | } else { |
532 | } else { |
553 | open $PTY, "</dev/null" or die;#d |
533 | open $PTY, "</dev/null" or die;#d |
554 | } |
534 | } |
555 | |
535 | |
556 | ############################################################################# |
536 | ############################################################################# |
… | |
… | |
704 | eval "use integer; sub { $insn }" or die "$insn: $@" |
684 | eval "use integer; sub { $insn }" or die "$insn: $@" |
705 | })->(); |
685 | })->(); |
706 | |
686 | |
707 | ++$CLK; |
687 | ++$CLK; |
708 | |
688 | |
709 | #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 | |
710 | # the interrupt logic |
733 | # the interrupt logic |
711 | $x = $INTPEND & ~$INTMASK; |
734 | $x = $INTPEND & ~$INTMASK; |
712 | |
|
|
713 | if (($RST || $x) && $IFF) { |
735 | if (($RST || $x) && $IFF) { |
714 | # rst 1 kbd data available |
736 | # rst 1 kbd data available |
715 | # rst 2 pusart xmit+recv flag |
737 | # rst 2 pusart xmit+recv flag |
716 | # rst 4 vertical retrace |
738 | # rst 4 vertical retrace |
717 | # 5.5 vt125 mb7 trans ready (serial send?) |
739 | # 5.5 vt125 mb7 trans ready (serial send?) |
… | |
… | |
734 | $M[--$SP] = $PC >> 8; |
756 | $M[--$SP] = $PC >> 8; |
735 | $M[--$SP] = $PC & 0xff; |
757 | $M[--$SP] = $PC & 0xff; |
736 | $PC = $vec; |
758 | $PC = $vec; |
737 | |
759 | |
738 | $IFF = 0; |
760 | $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 | } |
761 | } |
783 | } |
762 | } |
784 | |
763 | |
785 | __DATA__ |
764 | __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 |
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 |