ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/vt102/vt102
(Generate patch)

Comparing vt102/vt102 (file contents):
Revision 1.25 by root, Thu Dec 4 04:36:11 2014 UTC vs.
Revision 1.34 by root, Wed Dec 9 09:23:52 2015 UTC

… …
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
20use 5.010;
20use strict; 21use strict;
22use integer;
21#use common::sense; 23#use common::sense;
22 24
23my $VT102 = 1; 25my $VT102 = 1;
24my $VT131 = 0; 26my $VT131 = 0;
25my $AVO = 1; 27my $AVO = 1;
… …
64 SET UP Home 66 SET UP Home
65 BACKSPACE Rubout 67 BACKSPACE Rubout
66 CAPS LOCK Prior/PgUp 68 CAPS LOCK Prior/PgUp
67 NO SCROLL Next/PgDown 69 NO SCROLL Next/PgDown
68 BREAK End 70 BREAK End
71 CTRL-C Insert
69 72
70Set-Up Guide: 73Set-Up Guide:
71 74
72 http://vt100.net/docs/vt102-ug/chapter3.html#S3.6 75 http://vt100.net/docs/vt102-ug/chapter3.html#S3.6
73 76
… …
90 <DATA> 93 <DATA>
91}; 94};
92 95
930x6801 == length $ROMS or die "corrupted rom image"; 960x6801 == length $ROMS or die "corrupted rom image";
94 97
95my @M = (0xff) x 65536; # main memory, = (0xff) x 65536; 98my @M = (0xff) x 65536; # main memory
96 99
97# populate mem with rom contents 100# populate mem with rom contents
98if ($VT102) { 101if ($VT102) {
99 @M[0x0000 .. 0x1fff] = unpack "C*", substr $ROMS, 0x2000, 0x2000; 102 @M[0x0000 .. 0x1fff] = unpack "C*", substr $ROMS, 0x2000, 0x2000;
100 @M[0x8000 .. 0x9fff] = unpack "C*", substr $ROMS, 0x4000, 0x2000; 103 @M[0x8000 .. 0x9fff] = unpack "C*", substr $ROMS, 0x4000, 0x2000;
… …
527 530
528my @LED = $VT102 531my @LED = $VT102
529 ? qw(L1 INSERT DSR CTS LOCKED LOCAL SCAN BEEP) 532 ? qw(L1 INSERT DSR CTS LOCKED LOCAL SCAN BEEP)
530 : qw(L4 L3 L2 L1 LOCKED LOCAL SCAN BEEP); 533 : qw(L4 L3 L2 L1 LOCKED LOCAL SCAN BEEP);
531 534
535my $CURSOR_IS_ON;
536
532# display screen 537# display screen
533sub display { 538sub display {
539 # this is for the powersave mode - check whether the cursor is on here,
540 # and only allow powersave later when it was on the last display time
541 $CURSOR_IS_ON = $M[$VT102 ? 0x207b : 0x21ba];
542
543 my $leds = join " ", map $KSTATUS & 2**$_ ? "\e[7m$LED[$_]\e[m" : "$LED[$_]", reverse 0 .. $#LED;
544
545 my $scr = sprintf "\e[H--- LED [ %s ] CLK %d\e[K\n", $leds, $CLK;
546
547 $scr .= "\e[?5" . ($DC11_REVERSE ? "h" : "l");
548
534 my $i = 0x2000; 549 my $i = 0x2000;
535
536 my $leds = join " ", map $KSTATUS & 2**$_ ? "\e[7m$LED[$_]\e[m" : "$LED[$_]", reverse 0 .. $#LED;
537
538 my $scr = sprintf "\e[H--- LED [ %s ] CLK %d\e[K\n", $leds, $CLK;
539
540 $scr .= "\e[?5" . ($DC11_REVERSE ? "h" : "l");
541 550
542 line: 551 line:
543 for my $y (0 .. 25) { # ntsc, two vblank delay lines, up to 24 text lines 552 for my $y (0 .. 25) { # ntsc, two vblank delay lines, up to 24 text lines
544 my $prev_sgr; 553 my $prev_attr;
554 my ($c, $attr); # declare here for speedup
545 555
546 $scr .= sprintf "%2d \xe2\x94\x82", $y; 556 $scr .= sprintf "%2d \xe2\x94\x82", $y;
547 557
548 for (0..139) { 558 for (0..139) {
549 my $c = $M[$i]; 559 $c = $M[$i];
550 560
551 if ($c == 0x7f) { # also 0xff, but the firmware avoids that 561 if ($c == 0x7f) { # also 0xff, but the firmware avoids that
552 $scr .= "\e[m\xe2\x94\x82\e[K\n"; 562 $scr .= "\e[m\xe2\x94\x82\e[K\n";
553 563
554 my $a1 = $M[$i + 1]; 564 my $a1 = $M[$i + 1];
… …
557 $i = 0x2000 + (($a1 * 256 + $a0) & 0xfff); 567 $i = 0x2000 + (($a1 * 256 + $a0) & 0xfff);
558 568
559 next line; 569 next line;
560 } 570 }
561 571
572 $scr .= $SGR[$prev_attr = $attr]
562 my $sgr = $SGR[ ($M[$i++ + 0x1000] & 15) | ($c & 0x80)]; 573 if $prev_attr != ($attr = ($M[$i++ + 0x1000] & 15) | ($c & 0x80));
563
564 $scr .= $prev_sgr = $sgr if $sgr ne $prev_sgr;
565 574
566 $scr .= $CHARMAP[$c & 0x7f]; 575 $scr .= $CHARMAP[$c & 0x7f];
567 } 576 }
568 577
569 $scr .= "\e[K\nvideo overflow\e[K\n"; 578 $scr .= "\e[K\nvideo overflow\e[K\n";
… …
590 "\x1e" => 0x24 | 0x100, # CTRL-~ 599 "\x1e" => 0x24 | 0x100, # CTRL-~
591 "\x1f" => 0x75 | 0x100, # CTRL-? 600 "\x1f" => 0x75 | 0x100, # CTRL-?
592 601
593 # hardcoded rxvt keys 602 # hardcoded rxvt keys
594 "\e" => 0x2a, # ESC 603 "\e" => 0x2a, # ESC
604 "\e[2~" => 0x79 | 0x100, # CTRL-C (insert)
595 "\e[3~" => 0x03, # DC 605 "\e[3~" => 0x03, # DC
596 "\e[5~" => 0x7e, # CAPS LOCK (prior) 606 "\e[5~" => 0x7e, # CAPS LOCK (prior)
597 "\e[6~" => 0x6a, # NO SCROLL (next) 607 "\e[6~" => 0x6a, # NO SCROLL (next)
598 "\e[A" => 0x30, # UP 608 "\e[A" => 0x30, # UP
599 "\e[B" => 0x22, # DOWN 609 "\e[B" => 0x22, # DOWN
… …
606 "\e[7~" => 0x7b, # SETUP (home) 616 "\e[7~" => 0x7b, # SETUP (home)
607 "\e[8~" => 0x23, # BREAK (end) 617 "\e[8~" => 0x23, # BREAK (end)
608 "\e[8\$" => 0x23 | 0x080, # SHIFT BREAK / DISCONNECT (shift-end) 618 "\e[8\$" => 0x23 | 0x080, # SHIFT BREAK / DISCONNECT (shift-end)
609 "\x7f" => 0x33, # BACKSPACE 619 "\x7f" => 0x33, # BACKSPACE
610 620
611 "\e[11~" => 0x32, # F1 621 "\e[11~" => 0x32, # PF1
612 "\e[11~" => 0x42, # F2 622 "\e[12~" => 0x42, # PF2
613 "\e[11~" => 0x31, # F3 623 "\e[13~" => 0x31, # PF3
614 "\e[11~" => 0x41, # F4 624 "\e[14~" => 0x41, # PF4
615); 625);
616 626
617@KEYMAP{map chr, 0x20 .. 0x40, 0x5b .. 0x7e} = unpack "C*", pack "H*", 627@KEYMAP{map chr, 0x20 .. 0x40, 0x5b .. 0x7e} = unpack "C*", pack "H*",
618 "779ad5a9a8b8a755a6b5b6b466256575" . "351a3929283837273626d656e634e5f5" . "b9" # 20..40 628 "779ad5a9a8b8a755a6b5b6b466256575" . "351a3929283837273626d656e634e5f5" . "b9" # 20..40
619 . "154514b7a5" . "244a6879591949485816574746766706" . "050a185a0817780969077a95c594a4"; # 5b..7e 629 . "154514b7a5" . "244a6879591949485816574746766706" . "050a185a0817780969077a95c594a4"; # 5b..7e
… …
648 # skip input we can't decipher 658 # skip input we can't decipher
649 substr $STDIN_BUF, 0, 1, ""; 659 substr $STDIN_BUF, 0, 1, "";
650} 660}
651 661
652if ($KBD) { 662if ($KBD) {
653 system "stty -icanon -icrnl -inlcr -echo min 1 time 0"; 663 system "stty -icanon -icrnl -inlcr -echo min 1 time 0"; # -isig
654 eval q{ sub END { system "stty sane" } }; 664 eval q{ sub END { system "stty sane" } };
655 $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = sub { exit 1 }; 665 $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = sub { exit 1 };
656} 666}
657 667
658############################################################################# 668#############################################################################
659# initial key input, to set up online mode etc. 669# initial key input, to set up online mode etc.
660# could be done via nvram defaults 670# could be done via nvram defaults
661 671
662@KQUEUE = ( 672@KQUEUE = (
663 0x7b, -0x7b, # setup 673 0x7b, -0x7b, # setup
664 0, # delay 674 0, # delay
665 0x28, -0x28, # 4, toggle local/online 675 0x28, -0x28, # 4, toggle local/online
666 0x38, -0x38, # 5, setup b 676 0x38, -0x38, # 5, setup b
667 0, # delay 677 0, # delay
668 (0x10, -0x10) x 2, # cursor right 678 (0x10, -0x10) x 2, # cursor right
669 0x37, -0x37, # 6 toggle soft scroll 679 0x37, -0x37, # 6 toggle soft scroll
670 (0x10, -0x10) x 1, # cursor right 680 (0x10, -0x10) x 1, # cursor right
671 0x37, -0x37, # 6 toggle autorepeat off 681 0x37, -0x37, # 6 toggle autorepeat off
672 (0x10, -0x10) x 8, # cursor right 682 (0x10, -0x10) x 8, # cursor right
673 0x37, -0x37, # 6 toggle keyclick 683 0x37, -0x37, # 6 toggle keyclick
674 (0x10, -0x10) x 1, # cursor right 684 (0x10, -0x10) x 1, # cursor right
675 $VT102 ? () : (0x37, -0x37), # 6 toggle ansi/vt52 685 $VT102 ? () : (0x37, -0x37), # 6 toggle ansi/vt52
676 (0x10, -0x10) x 7, # cursor right 686 (0x10, -0x10) x 7, # cursor right
677 0x37, -0x37, # 6 toggle wrap around 687 0x37, -0x37, # 6 toggle wrap around
678 0x7b, -0x7b, # leave setup 688 0x7b, -0x7b, # leave setup
679); 689);
680 690
681############################################################################# 691#############################################################################
682# process/pty management 692# process/pty management
683 693
694if (1) {
684require IO::Pty; 695 require IO::Pty;
685$PTY = IO::Pty->new; 696 $PTY = IO::Pty->new;
686 697
687my $slave = $PTY->slave; 698 my $slave = $PTY->slave;
688 699
689$PTY->set_winsize (24, 80); 700 $PTY->set_winsize (24, 80);
690 701
691unless (fork) { 702 unless (fork) {
692 $ENV{LC_ALL} = "C"; 703 $ENV{LC_ALL} = "C";
693 $ENV{TERM} = $VT102 ? "vt102" : "vt100"; 704 $ENV{TERM} = $VT102 ? "vt102" : "vt100";
694 705
695 close $PTY; 706 close $PTY;
696 707
697 open STDIN , "<&", $slave; 708 open STDIN , "<&", $slave;
698 open STDOUT, ">&", $slave; 709 open STDOUT, ">&", $slave;
699 open STDERR, ">&", $slave; 710 open STDERR, ">&", $slave;
700 711
701 system "stty ixoff erase ^H"; 712 system "stty ixoff erase ^H";
702 713
703 $PTY->make_slave_controlling_terminal; 714 $PTY->make_slave_controlling_terminal;
715 $PTY->close_slave;
716
717 @ARGV = "sh" unless @ARGV;
718 exec @ARGV;
719 }
720
704 $PTY->close_slave; 721 $PTY->close_slave;
705 722} else {
706 @ARGV = "sh" unless @ARGV; 723 open $PTY, "+</dev/null"
707 exec @ARGV; 724 or die "/dev/null: $!";
708} 725}
709
710$PTY->close_slave;
711 726
712############################################################################# 727#############################################################################
713# the actual hardware simulator 728# the actual hardware simulator
714 729
715my @ICACHE; # compiled instruction/basic block cache 730my @ICACHE; # compiled instruction/basic block cache
… …
721(vec $RIN, 0, 1) = 1 if $KBD; 736(vec $RIN, 0, 1) = 1 if $KBD;
722(vec $RIN, fileno $PTY, 1) = 1 if $PTY; 737(vec $RIN, fileno $PTY, 1) = 1 if $PTY;
723 738
724# the cpu. 739# the cpu.
725while () { 740while () {
726 # execute extended basic blocks 741 # execute an extended basic block
727 $PC = ($ICACHE[$PC] ||= do { 742 $PC = ($ICACHE[$PC] ||= do {
728 my $pc = $PC; 743 my $pc = $PC;
729 744
730 my $insn = ""; 745 my $insn = "";
731 746
… …
750 } 765 }
751 766
752 $insn .= "$op;\n"; 767 $insn .= "$op;\n";
753 } 768 }
754 769
755
756 $insn .= $pc; 770 $insn .= $pc;
757 $insn =~ s/\x00.*$//s; 771 $insn =~ s/\x00.*$//s;
758 772
759 eval "use integer; sub { $insn }" or die "$insn: $@" 773 eval "sub { $insn }" or die "$insn: $@"
760 })->(); 774 })->();
761 775
762 ++$CLK; 776 ++$CLK;
763 777
764 # things we do from time to time only 778 # things we do from time to time only
765 unless ($CLK & 0xf) { 779 unless ($CLK & 0xf) {
766 # do I/O 780 # do I/O
767 781
768 unless ($CLK & 0xfff) { 782 unless ($CLK & 0xfff) {
769 if (select $x = $RIN, undef, undef, $POWERSAVE < 100 ? 0 : 0.2) { 783 if (select $x = $RIN, undef, undef, $POWERSAVE < 10 ? 0 : $CURSOR_IS_ON && 3600) {
770 784
771 # pty/serial I/O 785 # pty/serial I/O
772 if ($PTY && (vec $x, fileno $PTY, 1) && (@PUSARTRECV < 128) && !@KQUEUE) { 786 if ($PTY && (vec $x, fileno $PTY, 1) && (@PUSARTRECV < 128) && !@KQUEUE) {
773 sysread $PTY, my $buf, 256; 787 sysread $PTY, my $buf, 256;
774 788

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines