… | |
… | |
32 | my $VT102 = 1; |
32 | my $VT102 = 1; |
33 | my $AVO = $VT102 || 1; |
33 | my $AVO = $VT102 || 1; |
34 | my $KBD = 1; |
34 | my $KBD = 1; |
35 | |
35 | |
36 | ############################################################################# |
36 | ############################################################################# |
37 | |
37 | # rom initialising |
38 | my $PTY; # the pty we allocated, if any |
|
|
39 | |
38 | |
40 | my $ROM = do { |
39 | my $ROM = do { |
41 | binmode DATA; |
40 | binmode DATA; |
42 | local $/; |
41 | local $/; |
43 | <DATA> |
42 | <DATA> |
… | |
… | |
56 | } else { |
55 | } else { |
57 | @M[0x0000 .. 0x1fff] = unpack "C*", substr $ROM, 0x0000, 0x2000; |
56 | @M[0x0000 .. 0x1fff] = unpack "C*", substr $ROM, 0x0000, 0x2000; |
58 | } |
57 | } |
59 | |
58 | |
60 | ############################################################################# |
59 | ############################################################################# |
|
|
60 | # cpu registers and I/O support |
61 | |
61 | |
|
|
62 | my $PTY; # the pty we allocated, if any |
62 | my $PRSTATUS = 0; |
63 | my $PRSTATUS = 0; |
63 | |
64 | |
64 | # 8080/8085 registers |
65 | # 8080/8085 registers |
65 | # b, c, d, e, h, l, a |
66 | # b, c, d, e, h, l, a |
66 | my ($A, $B, $C, $D, $E, $H, $L, $A); |
67 | my ($A, $B, $C, $D, $E, $H, $L, $A); |
… | |
… | |
73 | my $x; # dummy temp for instructions |
74 | my $x; # dummy temp for instructions |
74 | |
75 | |
75 | my $CLK; # rather inexact clock |
76 | my $CLK; # rather inexact clock |
76 | |
77 | |
77 | ############################################################################# |
78 | ############################################################################# |
|
|
79 | # the dreaded nvr1400 chip. not needed to get it going, but provided for reference |
78 | |
80 | |
79 | # nvram |
81 | # nvram |
80 | 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 |
81 | my $NVRADDR; |
83 | my $NVRADDR; |
82 | my $NVRDATA; |
84 | my $NVRDATA; |
83 | my $NVRLATCH; |
85 | my $NVRLATCH; |
84 | |
86 | |
85 | #$NVR[$_] = $_ for 0..99;#d# |
|
|
86 | |
|
|
87 | my @NVRCMD = ( |
87 | my @NVRCMD = ( |
88 | sub { # accept data |
|
|
89 | $NVRDATA = ($NVRDATA << 1) + $_[1]; |
88 | sub { $NVRDATA = ($NVRDATA << 1) + $_[1]; }, # 0 accept data |
90 | }, |
89 | sub { $NVRADDR = ($NVRADDR << 1) + $_[1]; }, # 1 accept addr |
91 | sub { # accept addr |
90 | sub { ($NVRDATA <<= 1) & 0x4000 }, # 2 shift out |
92 | $NVRADDR = ($NVRADDR << 1)+ $_[1]; |
91 | undef, # 3 not used, will barf |
93 | }, |
|
|
94 | sub { # shift out |
|
|
95 | my $bit = $NVRDATA & 0x02000; |
|
|
96 | $NVRDATA *= 2; |
|
|
97 | $bit |
|
|
98 | }, |
|
|
99 | undef, |
|
|
100 | sub { # write |
|
|
101 | print "NVR WRITE $_[0]\n";#d# |
|
|
102 | $NVR[$_[0]] = $NVRDATA & 0x3fff; |
92 | sub { $NVR[$_[0]] = $NVRDATA & 0x3fff; }, # 4 write |
103 | }, |
93 | sub { $NVR[$_[0]] = 0x3fff; }, # 5 erase |
104 | sub { # erase |
94 | sub { $NVRDATA = $NVR[$_[0]]; }, # 6 read |
105 | print "NVR ERASE $_[0]\n";#d# |
95 | sub { }, # 7 standby |
106 | $NVR[$_[0]] = 0x3fff; |
|
|
107 | }, |
|
|
108 | sub { # read |
|
|
109 | # print "NVR READ $_[0] = $NVR[$_[0]]\n";#d# |
|
|
110 | $NVRDATA = $NVR[$_[0]]; |
|
|
111 | }, |
|
|
112 | sub { # standby |
|
|
113 | }, |
|
|
114 | ); |
96 | ); |
115 | |
97 | |
116 | my @bitidx; |
98 | my @bitidx; |
117 | $bitidx[1 << $_] = 9 - $_ for 0..9; |
99 | $bitidx[1 << $_] = 9 - $_ for 0..9; |
118 | |
100 | |
… | |
… | |
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) { |
… | |
… | |
727 | eval "use integer; sub { $insn }" or die "$insn: $@" |
684 | eval "use integer; sub { $insn }" or die "$insn: $@" |
728 | })->(); |
685 | })->(); |
729 | |
686 | |
730 | ++$CLK; |
687 | ++$CLK; |
731 | |
688 | |
732 | #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 | |
733 | # the interrupt logic |
733 | # the interrupt logic |
734 | $x = $INTPEND & ~$INTMASK; |
734 | $x = $INTPEND & ~$INTMASK; |
735 | |
|
|
736 | if (($RST || $x) && $IFF) { |
735 | if (($RST || $x) && $IFF) { |
737 | # rst 1 kbd data available |
736 | # rst 1 kbd data available |
738 | # rst 2 pusart xmit+recv flag |
737 | # rst 2 pusart xmit+recv flag |
739 | # rst 4 vertical retrace |
738 | # rst 4 vertical retrace |
740 | # 5.5 vt125 mb7 trans ready (serial send?) |
739 | # 5.5 vt125 mb7 trans ready (serial send?) |
… | |
… | |
757 | $M[--$SP] = $PC >> 8; |
756 | $M[--$SP] = $PC >> 8; |
758 | $M[--$SP] = $PC & 0xff; |
757 | $M[--$SP] = $PC & 0xff; |
759 | $PC = $vec; |
758 | $PC = $vec; |
760 | |
759 | |
761 | $IFF = 0; |
760 | $IFF = 0; |
762 | } |
|
|
763 | |
|
|
764 | # things we do from time too time only |
|
|
765 | unless ($CLK & 0xf) { |
|
|
766 | # do I/O |
|
|
767 | |
|
|
768 | unless ($CLK & 0x7ff) { |
|
|
769 | |
|
|
770 | # pty/serial I/O |
|
|
771 | unless (@PUSARTRECV || @KQUEUE || !$PTY) { |
|
|
772 | my $rin = ""; (vec $rin, fileno $PTY, 1) = 1; |
|
|
773 | |
|
|
774 | if (select $rin, undef, undef, 0) { |
|
|
775 | sysread $PTY, my $buf, 256; |
|
|
776 | push @PUSARTRECV, unpack "C*", $buf; |
|
|
777 | } |
|
|
778 | } |
|
|
779 | |
|
|
780 | # keyboard input |
|
|
781 | if ($KBD) { |
|
|
782 | while (select my $rin = "\x01", undef, undef, 0) { |
|
|
783 | sysread STDIN, $STDIN_BUF, 1, length $STDIN_BUF |
|
|
784 | or last; |
|
|
785 | } |
|
|
786 | |
|
|
787 | stdin_parse if length $STDIN_BUF; |
|
|
788 | } |
|
|
789 | } |
|
|
790 | |
|
|
791 | # kick off various interrupts |
|
|
792 | |
|
|
793 | $RST |= 2 if @PUSARTRECV && $XON; # VT100, but works on vt102, too (probably not used on real hardware though) |
|
|
794 | #$INTPEND |= 2 if @PUSARTRECV && $XON; # VT102, 6.5 rxrdy |
|
|
795 | |
|
|
796 | # kick off vertical retrace form time to time |
|
|
797 | unless ($CLK & 0x3ff) { |
|
|
798 | $RST |= 4; # vertical retrace |
|
|
799 | } |
|
|
800 | |
|
|
801 | # handle video hardware |
|
|
802 | |
|
|
803 | unless ($CLK & 0x1fff) { |
|
|
804 | prscr; |
|
|
805 | } |
|
|
806 | } |
761 | } |
807 | } |
762 | } |
808 | |
763 | |
809 | __DATA__ |
764 | __DATA__ |
810 | 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 |