| … | |
… | |
| 15 | # |
15 | # |
| 16 | |
16 | |
| 17 | # If this file contains embedded ROMs, the above copyright notice does |
17 | # If this file contains embedded ROMs, the above copyright notice does |
| 18 | # not apply to them. |
18 | # not apply to them. |
| 19 | |
19 | |
|
|
20 | use 5.010; |
| 20 | use strict; |
21 | use strict; |
|
|
22 | use integer; |
| 21 | #use common::sense; |
23 | #use common::sense; |
| 22 | |
24 | |
| 23 | my $VT102 = 1; |
25 | my $VT102 = 1; |
| 24 | my $VT131 = 0; |
26 | my $VT131 = 0; |
| 25 | my $AVO = 1; |
27 | my $AVO = 1; |
| … | |
… | |
| 527 | |
529 | |
| 528 | my @LED = $VT102 |
530 | my @LED = $VT102 |
| 529 | ? qw(L1 INSERT DSR CTS LOCKED LOCAL SCAN BEEP) |
531 | ? qw(L1 INSERT DSR CTS LOCKED LOCAL SCAN BEEP) |
| 530 | : qw(L4 L3 L2 L1 LOCKED LOCAL SCAN BEEP); |
532 | : qw(L4 L3 L2 L1 LOCKED LOCAL SCAN BEEP); |
| 531 | |
533 | |
|
|
534 | my $CURSOR_IS_ON; |
|
|
535 | |
| 532 | # display screen |
536 | # display screen |
| 533 | sub display { |
537 | sub display { |
|
|
538 | # this is for the powersave mode - check whether the cursor is on here, |
|
|
539 | # and only allow powersave later when it was on the last display time |
|
|
540 | $CURSOR_IS_ON = $M[$VT102 ? 0x207b : 0x21ba]; |
|
|
541 | |
| 534 | my $i = 0x2000; |
542 | my $i = 0x2000; |
| 535 | |
543 | |
| 536 | my $leds = join " ", map $KSTATUS & 2**$_ ? "\e[7m$LED[$_]\e[m" : "$LED[$_]", reverse 0 .. $#LED; |
544 | my $leds = join " ", map $KSTATUS & 2**$_ ? "\e[7m$LED[$_]\e[m" : "$LED[$_]", reverse 0 .. $#LED; |
| 537 | |
545 | |
| 538 | my $scr = sprintf "\e[H--- LED [ %s ] CLK %d\e[K\n", $leds, $CLK; |
546 | my $scr = sprintf "\e[H--- LED [ %s ] CLK %d\e[K\n", $leds, $CLK; |
| … | |
… | |
| 679 | ); |
687 | ); |
| 680 | |
688 | |
| 681 | ############################################################################# |
689 | ############################################################################# |
| 682 | # process/pty management |
690 | # process/pty management |
| 683 | |
691 | |
|
|
692 | if (1) { |
| 684 | require IO::Pty; |
693 | require IO::Pty; |
| 685 | $PTY = IO::Pty->new; |
694 | $PTY = IO::Pty->new; |
| 686 | |
695 | |
| 687 | my $slave = $PTY->slave; |
696 | my $slave = $PTY->slave; |
| 688 | |
697 | |
| 689 | $PTY->set_winsize (24, 80); |
698 | $PTY->set_winsize (24, 80); |
| 690 | |
699 | |
| 691 | unless (fork) { |
700 | unless (fork) { |
| 692 | $ENV{LC_ALL} = "C"; |
701 | $ENV{LC_ALL} = "C"; |
| 693 | $ENV{TERM} = $VT102 ? "vt102" : "vt100"; |
702 | $ENV{TERM} = $VT102 ? "vt102" : "vt100"; |
| 694 | |
703 | |
| 695 | close $PTY; |
704 | close $PTY; |
| 696 | |
705 | |
| 697 | open STDIN , "<&", $slave; |
706 | open STDIN , "<&", $slave; |
| 698 | open STDOUT, ">&", $slave; |
707 | open STDOUT, ">&", $slave; |
| 699 | open STDERR, ">&", $slave; |
708 | open STDERR, ">&", $slave; |
| 700 | |
709 | |
| 701 | system "stty ixoff erase ^H"; |
710 | system "stty ixoff erase ^H"; |
| 702 | |
711 | |
| 703 | $PTY->make_slave_controlling_terminal; |
712 | $PTY->make_slave_controlling_terminal; |
|
|
713 | $PTY->close_slave; |
|
|
714 | |
|
|
715 | @ARGV = "sh" unless @ARGV; |
|
|
716 | exec @ARGV; |
|
|
717 | } |
|
|
718 | |
| 704 | $PTY->close_slave; |
719 | $PTY->close_slave; |
| 705 | |
720 | } else { |
| 706 | @ARGV = "sh" unless @ARGV; |
721 | open $PTY, "+</dev/null" |
| 707 | exec @ARGV; |
722 | or die "/dev/null: $!"; |
| 708 | } |
723 | } |
| 709 | |
|
|
| 710 | $PTY->close_slave; |
|
|
| 711 | |
724 | |
| 712 | ############################################################################# |
725 | ############################################################################# |
| 713 | # the actual hardware simulator |
726 | # the actual hardware simulator |
| 714 | |
727 | |
| 715 | my @ICACHE; # compiled instruction/basic block cache |
728 | my @ICACHE; # compiled instruction/basic block cache |
| … | |
… | |
| 721 | (vec $RIN, 0, 1) = 1 if $KBD; |
734 | (vec $RIN, 0, 1) = 1 if $KBD; |
| 722 | (vec $RIN, fileno $PTY, 1) = 1 if $PTY; |
735 | (vec $RIN, fileno $PTY, 1) = 1 if $PTY; |
| 723 | |
736 | |
| 724 | # the cpu. |
737 | # the cpu. |
| 725 | while () { |
738 | while () { |
| 726 | # execute extended basic blocks |
739 | # execute an extended basic block |
| 727 | $PC = ($ICACHE[$PC] ||= do { |
740 | $PC = ($ICACHE[$PC] ||= do { |
| 728 | my $pc = $PC; |
741 | my $pc = $PC; |
| 729 | |
742 | |
| 730 | my $insn = ""; |
743 | my $insn = ""; |
| 731 | |
744 | |
| … | |
… | |
| 754 | |
767 | |
| 755 | |
768 | |
| 756 | $insn .= $pc; |
769 | $insn .= $pc; |
| 757 | $insn =~ s/\x00.*$//s; |
770 | $insn =~ s/\x00.*$//s; |
| 758 | |
771 | |
| 759 | eval "use integer; sub { $insn }" or die "$insn: $@" |
772 | eval "sub { $insn }" or die "$insn: $@" |
| 760 | })->(); |
773 | })->(); |
| 761 | |
774 | |
| 762 | ++$CLK; |
775 | ++$CLK; |
| 763 | |
776 | |
| 764 | # things we do from time to time only |
777 | # things we do from time to time only |
| 765 | unless ($CLK & 0xf) { |
778 | unless ($CLK & 0xf) { |
| 766 | # do I/O |
779 | # do I/O |
| 767 | |
780 | |
| 768 | unless ($CLK & 0xfff) { |
781 | unless ($CLK & 0xfff) { |
| 769 | if (select $x = $RIN, undef, undef, $POWERSAVE < 100 ? 0 : 0.2) { |
782 | if (select $x = $RIN, undef, undef, $POWERSAVE < 100 ? 0 : $CURSOR_IS_ON && 60) { |
| 770 | |
783 | |
| 771 | # pty/serial I/O |
784 | # pty/serial I/O |
| 772 | if ($PTY && (vec $x, fileno $PTY, 1) && (@PUSARTRECV < 128) && !@KQUEUE) { |
785 | if ($PTY && (vec $x, fileno $PTY, 1) && (@PUSARTRECV < 128) && !@KQUEUE) { |
| 773 | sysread $PTY, my $buf, 256; |
786 | sysread $PTY, my $buf, 256; |
| 774 | |
787 | |
| 775 | # linux don't do cs7 and/or parity anymore, so we need to filter |
788 | # linux don't do cs7 and/or parity anymore, so we need to filter # out xoff characters to avoid freezes. |
| 776 | # out xoff characters to avoid freezes. |
|
|
| 777 | push @PUSARTRECV, grep { ($_ & 0x7f) != 0x13 } unpack "C*", $buf; |
789 | push @PUSARTRECV, grep { ($_ & 0x7f) != 0x13 } unpack "C*", $buf; |
| 778 | } |
790 | } |
| 779 | |
791 | |
| 780 | # keyboard input |
792 | # keyboard input |
| 781 | if ($KBD && (vec $x, 0, 1)) { |
793 | if ($KBD && (vec $x, 0, 1)) { |
