[ViewVC] Diff of: cvs/vt102/vt102

Comparing vt102/vt102 (file contents):
Revision 1.5 by root, Mon Dec 1 18:41:36 2014 UTC vs.
Revision 1.32 by root, Wed Dec 17 03:06:21 2014 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
20	# this hack is not considered release ready in and way, shape, or form	20	use 5.010;
21	# ./vt102 bash	21	use strict;
22	# ./vt102 telnet towel.blinkenlights.nl	22	use integer;
23	# ./vt102 curl http://artscene.textfiles.com/vt100/trekvid.vt
24	# ./vt102 curl http://artscene.textfiles.com/vt100/surf.vt # in 3d!
25
26	# TODO: ctrl
27
28	use common::sense;	23	#use common::sense;
29
30	$\| = 1;
31		24
32	my $VT102 = 1;	25	my $VT102 = 1;
33	my $AVO = $VT102 \|\| 1;	26	my $VT131 = 0;
		27	my $AVO = 1;
		28
		29	shift, ($VT102 = 0), ($AVO = 0) if $ARGV[0] =~ /^-?-vt100$/;
		30	shift, ($VT102 = 0) if $ARGV[0] =~ /^-?-vt100\+avo$/;
		31	shift if $ARGV[0] =~ /^-?-vt102$/;
		32	shift, ($VT131 = 1) if $ARGV[0] =~ /^-?-vt131$/;
		33
		34	# vt100 wps = word processing roms
		35	# vt101 = vt102 - avo, but custom rom? really?
		36	# vt103 = vt100 + tu58 tape drive
		37	# vt125 = vt100 + gpo graphics processor
		38	# vt132 = vt100 + avo, stp
		39	# vt180 = vt100 + z80 cp/m
		40
		41	if ($ARGV[0] =~ /^-/) {
		42	die <<EOF;
		43
		44	VT102, A VT100/102/131 SIMULATOR
		45
		46	Usage:
		47
		48	$0 [option] [program [args]]
		49
		50	Examples:
		51
		52	$0 bash
		53	$0 telnet towel.blinkenlights.nl
		54	$0 curl http://artscene.textfiles.com/vt100/trekvid.vt
		55	$0 curl http://artscene.textfiles.com/vt100/surf.vt # in 3d!
		56
		57	Option can be one of:
		58
		59	--vt100
		60	--vt100+avo
		61	--vt102
		62	--vt131
		63
		64	Non-obvious special keys are:
		65
		66	SET UP Home
		67	BACKSPACE Rubout
		68	CAPS LOCK Prior/PgUp
		69	NO SCROLL Next/PgDown
		70	BREAK End
		71	CTRL-C Insert
		72
		73	Set-Up Guide:
		74
		75	http://vt100.net/docs/vt102-ug/chapter3.html#S3.6
		76
		77	Author:
		78
		79	Marc Lehmann <vt102\@schmorp.de>
		80
		81	EOF
		82	}
		83
		84	#############################################################################
		85	# ROM/hardware init
		86
		87	my $PTY; # the pty we allocated, if any
34	my $KBD = 1;	88	my $KBD = 1;
35		89
36	#############################################################################
37	# rom initialising
38
39	my $ROM = do {	90	my $ROMS = do {
40	binmode DATA;	91	binmode DATA;
41	local $/;	92	local $/;
42	<DATA>	93	<DATA>
43	};	94	};
44		95
45	0x6001 == length $ROM or die "corrupted rom image";	96	0x6801 == length $ROMS or die "corrupted rom image";
46
47	binmode STDOUT;
48		97
49	my @M = (0xff) x 65536; # main memory, = (0xff) x 65536;	98	my @M = (0xff) x 65536; # main memory, = (0xff) x 65536;
50		99
51	# populate mem with rom contents	100	# populate mem with rom contents
52	if ($VT102) {	101	if ($VT102) {
53	@M[0x0000 .. 0x1fff] = unpack "C*", substr $ROM, 0x2000, 0x2000;	102	@M[0x0000 .. 0x1fff] = unpack "C*", substr $ROMS, 0x2000, 0x2000;
54	@M[0x8000 .. 0x9fff] = unpack "C*", substr $ROM, 0x4000, 0x2000;	103	@M[0x8000 .. 0x9fff] = unpack "C*", substr $ROMS, 0x4000, 0x2000;
		104	@M[0xa000 .. 0xa7ff] = unpack "C*", substr $ROMS, 0x6000, 0x0800 if $VT131;
55	} else {	105	} else {
56	@M[0x0000 .. 0x1fff] = unpack "C*", substr $ROM, 0x0000, 0x2000;	106	@M[0x0000 .. 0x1fff] = unpack "C*", substr $ROMS, 0x0000, 0x2000;
57	}	107	}
58		108
59	#############################################################################	109	#############################################################################
60	# cpu registers and I/O support	110	# 8085 CPU registers and I/O support
61
62	my $PTY; # the pty we allocated, if any
63	my $PRSTATUS = 0;
64		111
65	# 8080/8085 registers	112	# 8080/8085 registers
66	# b, c, d, e, h, l, a	113	my ($A, $B, $C, $D, $E, $H, $L); # 8 bit general purpose
67	my ($A, $B, $C, $D, $E, $H, $L, $A);	114	my ($PC, $SP, $IFF); # program counter, stack pointer, interrupt flag
68	my ($PC, $SP, $IFF, $FA, $FZ, $FS, $FP, $FC);	115	my ($FA, $FZ, $FS, $FP, $FC); # condition codes (psw)
69		116
70	my $RST = 0; # 8080 pending interrupts	117	my $RST = 0; # pending interrupts (external interrupt logic)
71	my $INTMASK = 7; # 8085 half interrupts	118	my $INTMASK = 7; # 8085 half interrupt mask
72	my $INTPEND = 0; # 8085 half interrupts	119	my $INTPEND = 0; # 8085 half interrupts pending
73		120
74	my $x; # dummy temp for instructions	121	my $CLK; # rather inexact clock, counts extended basic blocks
75		122
76	my $CLK; # rather inexact clock
77
78	#############################################################################	123	#############################################################################
79	# the dreaded nvr1400 chip. not needed to get it going, but provided for reference	124	# the dreaded NVR1400 chip. not needed to get it going, but provided anyway
80		125
81	# nvram	126	# nvram
82	my @NVR = (0x3fff) x 100; # vt102: 214e accum, 214f only lower 8 bit used, first 44 bytes	127	my @NVR = (0x3fff) x 100; # vt102: 214e accum, 214f only lower 8 bit used, first 44 bytes
83	my $NVRADDR;	128	my $NVRADDR;
84	my $NVRDATA;	129	my $NVRDATA;
…		…
93	sub { $NVR[$_[0]] = 0x3fff; }, # 5 erase	138	sub { $NVR[$_[0]] = 0x3fff; }, # 5 erase
94	sub { $NVRDATA = $NVR[$_[0]]; }, # 6 read	139	sub { $NVRDATA = $NVR[$_[0]]; }, # 6 read
95	sub { }, # 7 standby	140	sub { }, # 7 standby
96	);	141	);
97		142
98	my @bitidx;	143	my @NVR_BITIDX; $NVR_BITIDX[1 << $_] = 9 - $_ for 0..9;
99	$bitidx[1 << $_] = 9 - $_ for 0..9;
100		144
101	# the nvr1400 state machine. what a monster	145	# the nvr1400 state machine. what a monster
102	sub nvr() {	146	sub nvr() {
103	my $a1 = $bitidx[(~$NVRADDR ) & 0x3ff];	147	my $a1 = $NVR_BITIDX[(~$NVRADDR ) & 0x3ff];
104	my $a0 = $bitidx[(~$NVRADDR >> 10) & 0x3ff];	148	my $a0 = $NVR_BITIDX[(~$NVRADDR >> 10) & 0x3ff];
105
106	# printf "NVR %02x A %020b %d %d D %02x\n", $NVRLATCH, $NVRADDR & 0xfffff, $a1, $a0, $NVRDATA;
107		149
108	$NVRCMD[($NVRLATCH >> 1) & 7]($a1 * 10 + $a0, $NVRLATCH & 1)	150	$NVRCMD[($NVRLATCH >> 1) & 7]($a1 * 10 + $a0, $NVRLATCH & 1)
109	}	151	}
110		152
111	#############################################################################	153	#############################################################################
		154	# I/O ports - output
112		155
113	my $DC11 = 0; # 4 bit commands	156	my $DC11_REVERSE = 0; # light background?
114	my $DC12 = 0;
115		157
116	my $XON = 1; # false if terminal wants us to pause	158	my $XON = 1; # false if terminal wants us to pause
117	my $PUSARTCMD;	159	my $PUSARTCMD;
118		160
		161	my $KSTATUS; # keyboard status (click + scan flag + leds)
119	my @KXMIT; # current scan queue	162	my @KXMIT; # current scan queue
120	my %KXMIT; # currently pressed keys	163	my %KXMIT; # currently pressed keys
121	my @KQUEUE; # key event queue	164	my @KQUEUE; # key event queue
122	my $KXCNT; # count for debouncew	165	my $KXCNT; # count for debouncew
123	my @PUSARTRECV;	166
124	my $KSTATUS;	167	my @PUSARTRECV; # serial input (to terminal) queue
125		168
126	sub out_00 { # pusartdata	169	sub out_00 { # pusartdata
127	# handle xon/xoff, but also pass it through	170	# handle xon/xoff, but also pass it through
128	if ($_[0] == 0x13) {	171	if ($_[0] == 0x13) {
129	$XON = 0;	172	$XON = 0;
…		…
136	syswrite $PTY, chr $_[0];	179	syswrite $PTY, chr $_[0];
137		180
138	$INTPEND \|= 1;	181	$INTPEND \|= 1;
139	}	182	}
140		183
141	sub out_01 {	184	sub out_01 { # pusartcmd
142	$PUSARTCMD = shift;	185	$PUSARTCMD = shift;
143		186
144	$INTPEND \|= 1 if $PUSARTCMD & 0x01; # VT102, 5.5 txrdy	187	$INTPEND \|= 1 if $PUSARTCMD & 0x01; # VT102, 5.5 txrdy
145	$INTPEND \|= 2 if $PUSARTCMD & 0x04 && !@PUSARTRECV; # VT102, 6.5 rxrdy, needed for some reason	188	$INTPEND \|= 2 if $PUSARTCMD & 0x04 && !@PUSARTRECV; # VT102, 6.5 rxrdy, needed for some reason
146	}	189	}
147		190
148	sub out_02 { } # baudrate generator	191	sub out_02 { } # baudrate generator
149		192
150	sub out_23 { } # unknown	193	sub out_23 { } # vt102 unknown
151	sub out_27 { } # unknown	194	sub out_27 { } # vt102 unknown
152	sub out_2f { } # unknown, connected to in 0f	195	sub out_2f { } # vt102 unknown, connected to in 0f
153		196
154	sub out_42 { } # brightness	197	sub out_42 { } # brightness
155		198
156	sub out_62 {	199	sub out_62 { # nvr latch register (4 bits)
157	$NVRLATCH = shift;	200	$NVRLATCH = shift;
158	}	201	}
159		202
160	sub out_a2 { $DC11 = shift }	203	sub out_a2 { # device control 011
		204	my $dc11 = 0x0f & shift;
		205
		206	$DC11_REVERSE = 1 if $dc11 == 0b1010;
		207	$DC11_REVERSE = 0 if $dc11 == 0b1011;
		208	}
		209
161	sub out_c2 { } # unknown	210	sub out_c2 { } # unknown
162	sub out_d2 { $DC12 = shift }	211	sub out_d2 { } # device control 012, 0..3 == 80c/132c/60hz/50hz
163		212
164	sub out_82 {	213	sub out_82 { # keyboard txmit
165	# keyboard	214	# CLICK STARTSCAN ONLINE LOCKED \| L1 L2 L3 L4 (vt100)
166
167	# CLICK STARTSCAN ONLINE LOCKED \| CTS DSR INSERT L1(?)	215	# CLICK STARTSCAN ONLINE LOCKED \| CTS DSR INS L1 (vt102)
168	# CLICK STARTSCAN ONLINE LOCKED \| LED1 LED2 LED3 LED4
169	$KSTATUS = $_[0];	216	$KSTATUS = $_[0];
170		217
171	# start new scan unless scan in progress	218	# start new scan unless scan is in progress
172	if (($_[0] & 0x40) && !@KXMIT) {	219	if (($_[0] & 0x40) && !@KXMIT) {
173	# do not reply with keys in locked mode	220	# do not reply with keys in locked mode
174	# or during post (0xff),	221	# or during post (0xff),
175	# mostly to skip init and not fail POST,	222	# mostly to skip init and not fail POST,
176	# and to send startup keys only when terminal is ready	223	# and to send startup keys only when terminal is ready
…		…
196	$RST \|= 1;	243	$RST \|= 1;
197	}	244	}
198	}	245	}
199		246
200	#############################################################################	247	#############################################################################
		248	# I/O ports - input
201		249
202	my $NVRBIT;	250	my $NVRBIT; # the current nvr data bit
203	my $LBA;	251	my $LBA6; # twice the frequenxy of LBA7
204		252
205	sub in_00 { # pusart data	253	sub in_00 { # pusart data
206	# interrupt not generated here, because infinite	254	# interrupt not generated here, because infinite
207	# speed does not go well with the vt102.	255	# speed does not go well with the vt102.
208		256
…		…
212	sub in_01 { # pusart status	260	sub in_01 { # pusart status
213	# DSR SYNDET FE OE \| PE TXEMPTY RXRDY TXRDY	261	# DSR SYNDET FE OE \| PE TXEMPTY RXRDY TXRDY
214	0x85 + (@PUSARTRECV && 0x02)	262	0x85 + (@PUSARTRECV && 0x02)
215	}	263	}
216		264
217	sub in_22 { # modem buffer(?)	265	sub in_22 { # modem buffer
218	# wild guess: -CTS -SPDI -RI -CD 0 0 0 0	266	# wild guess: -CTS -SPDI -RI -CD 0 0 0 0
219	0x20	267	0x20
220	}	268	}
221		269
222	sub in_0f { } # unknown, connected to out 2f	270	sub in_0f { 0xff } # vt102 unknown, connected to out 2f
223		271
224	sub in_42 { # flag buffer	272	sub in_42 { # flag buffer
225	++$LBA;	273	++$LBA6;
226		274
227	$NVRBIT = nvr ? 0x20 : 0x00 if ($LBA & 0x3) == 0x2;	275	$NVRBIT = nvr ? 0x20 : 0x00 if ($LBA6 & 0x3) == 0x2;
228		276
229	# KBD_XMITEMPTY LBA7 NVRDATA ODDFIELD - OPTION !GFX !AVO PUSART_TXRDY	277	# KBD_XMITEMPTY LBA7 NVRDATA ODDFIELD - OPTION !GFX !AVO PUSART_TXRDY
230		278
231	my $f = 0x85 \| $NVRBIT;	279	my $f = 0x85 \| $NVRBIT;
232		280
233	$f \|= 0x02 unless $AVO;	281	$f \|= 0x02 unless $AVO;
234	$f \|= 0x40 if $LBA & 0x2;	282	$f \|= 0x40 if $LBA6 & 0x2;
235		283
236	$f	284	$f
237	}	285	}
238		286
239	sub in_82 { # tbmt keyboard uart	287	sub in_82 { # tbmt keyboard uart
…		…
241		289
242	$RST \|= 1;	290	$RST \|= 1;
243	shift @KXMIT	291	shift @KXMIT
244	}	292	}
245		293
246	sub in_03 { 0xff } # unknown, printer uart input?	294	sub in_03 { 0xff } # vt102 unknown, printer uart input?
247	sub in_0b { 0xff } # unknown	295	sub in_0b { 0xff } # vt102 unknown
248	sub in_17 { 0xff } # unknown, printer status clear by reading?	296	sub in_17 { 0xff } # vt102 unknown, printer status clear by reading?
249	sub in_1b { 0xff } # unknown	297	sub in_1b { 0xff } # vt102 unknown
250		298
251	#############################################################################	299	#############################################################################
		300	# 8085 cpu opcodes and flag handling
252		301
		302	my $x; # dummy scratchpad for opcodes
		303
253	sub sf { # set flags (ZSC - AP not implemented)	304	sub sf { # set flags, full version (ZSC - AP not implemented)
		305	$FS = $_[0] & 0x080;
		306	$FZ = !($_[0] & 0x0ff);
		307	$FC = $_[0] & 0x100;
		308
		309	$_[0] &= 0xff;
		310	}
		311
		312	sub sf8 { # set flags, for 8-bit results (ZSC - AP not implemented)
		313	$FS = $_[0] & 0x080;
		314	$FZ = !($_[0] & 0x0ff);
		315	$FC = 0;
		316	}
		317
		318	sub sf_nc { # set flags, except carry
254	$FS = $_[0] & 0x080;	319	$FS = $_[0] & 0x080;
255	$FZ = ($_[0] & 0x0ff) == 0;	320	$FZ = ($_[0] & 0x0ff) == 0;
256	$FC = $_[0] & 0x100;
257		321
258	$_[0] & 0xff	322	$_[0] &= 0xff;
259	}	323	}
260		324
261	sub sf_nc { # set flags except carry	325	# opcode table
262	$FS = $_[0] & 0x080;
263	$FZ = ($_[0] & 0x0ff) == 0;
264
265	$_[0] & 0xff
266	}
267
268	my @op = map { sprintf "status(); die 'unknown op %02x'", $_ } 0 .. 255;	326	my @op = map { sprintf "status(); die 'unknown op %02x'", $_ } 0x00 .. 0xff;
269	my @ops;
270		327
271	my @reg = qw($B $C $D $E $H $L $M[$H*256+$L] $A);	328	my @reg = qw($B $C $D $E $H $L $M[$H*256+$L] $A); # r/m encoding
272	my @cc = ('if !$FZ', 'if $FZ', 'if !$FC', 'if $FC', ';die', ';die', 'if !$FS', 'if $FS'); # die == unimplemented $FP parity	329	my @cc = ('!$FZ', '$FZ', '!$FC', '$FC', 'die;', 'die;', '!$FS', '$FS'); # cc encoding. die == unimplemented $FP parity
		330
		331	$op[0x00] = ''; # nop
273		332
274	# mov r,r / r,M / M,r	333	# mov r,r / r,M / M,r
275	for my $s (0..7) {	334	for my $s (0..7) {
276	for my $d (0..7) {	335	for my $d (0..7) {
277	$op[0x40 + $d * 8 + $s] = "$reg[$d] = $reg[$s]";	336	$op[0x40 + $d * 8 + $s] = "$reg[$d] = $reg[$s]"; # mov
278	}	337	}
279	}	338	}
280		339
281	$op[0x00] = '';	340	$op[0x76] = 'die "HLT"'; # hlt (mov m,m)
		341
		342	# mvi r / M
		343	$op[0x06 + $_ * 8] = "$reg[$_] = IMM8" for 0..7;
282		344
283	$op[0x01] = '($B, $C) = (IMM16 >> 8, IMM16 & 0xff)'; # lxi	345	$op[0x01] = '($B, $C) = (IMM16 >> 8, IMM16 & 0xff)'; # lxi
284	$op[0x11] = '($D, $E) = (IMM16 >> 8, IMM16 & 0xff)'; # lxi	346	$op[0x11] = '($D, $E) = (IMM16 >> 8, IMM16 & 0xff)'; # lxi
285	$op[0x21] = '($H, $L) = (IMM16 >> 8, IMM16 & 0xff)'; # lxi	347	$op[0x21] = '($H, $L) = (IMM16 >> 8, IMM16 & 0xff)'; # lxi
286	$op[0x31] = '$SP = IMM16' ; # lxi #d# 0xf000 because of limited stack	348	$op[0x31] = '$SP = IMM16' ; # lxi
287		349
288	$op[0x02] = '$M[$B * 256 + $C] = $A'; # stax	350	$op[0x02] = '$M[$B * 256 + $C] = $A'; # stax
289	$op[0x12] = '$M[$D * 256 + $E] = $A'; # stax	351	$op[0x12] = '$M[$D * 256 + $E] = $A'; # stax
290	$op[0x32] = '$M[IMM16 ] = $A'; # sta	352	$op[0x32] = '$M[IMM16 ] = $A'; # sta
291		353
		354	$op[0x0a] = '$A = $M[$B * 256 + $C]'; # ldax b
		355	$op[0x1a] = '$A = $M[$D * 256 + $E]'; # ldax d
		356	$op[0x3a] = '$A = $M[IMM16]'; # lda
		357
		358	$op[0x22] = '($M[IMM16], $M[IMM16 + 1]) = ($L, $H)'; # shld
		359	$op[0x2a] = '($L, $H) = ($M[IMM16], $M[IMM16 + 1])'; # lhld
		360
292	sub inxdcx($$$) {	361	sub inxdcx($$$) {
293	$x = ($_[0] * 256 + $_[1] + $_[2]) & 0xffff;	362	$x = $_[0] * 256 + $_[1] + $_[2];
294	$_[0] = $x >> 8;	363	($_[0], $_[1]) = (($x >> 8) & 0xff, $x & 0xff);
295	$_[1] = $x & 0xff;
296	}	364	}
297		365
298	$op[0x03] = 'inxdcx $B, $C, 1'; # inx	366	$op[0x03] = 'inxdcx $B, $C, 1'; # inx
299	$op[0x13] = 'inxdcx $D, $E, 1'; # inx	367	$op[0x13] = 'inxdcx $D, $E, 1'; # inx
300	$op[0x23] = 'inxdcx $H, $L, 1'; # inx	368	$op[0x23] = 'inxdcx $H, $L, 1'; # inx
…		…
303	$op[0x1b] = 'inxdcx $D, $E, -1'; # dcx	371	$op[0x1b] = 'inxdcx $D, $E, -1'; # dcx
304	$op[0x2b] = 'inxdcx $H, $L, -1'; # dcx	372	$op[0x2b] = 'inxdcx $H, $L, -1'; # dcx
305	$op[0x3b] = '--$SP' ; # dcx	373	$op[0x3b] = '--$SP' ; # dcx
306		374
307	# "no carry" doesn't seem to be needed for vt100 - optimize?	375	# "no carry" doesn't seem to be needed for vt100 - optimize?
308	$op[0x04 + $_ * 8] = "$reg[$_] = sf_nc $reg[$_] + 1" for 0..7; # inr
309	$op[0x05 + $_ * 8] = "$reg[$_] = sf_nc $reg[$_] - 1" for 0..7; # dcr
310
311	# mvi r / M
312	$op[0x06 + $_ * 8] = "$reg[$_] = IMM8" for 0..7;	376	$op[0x04 + $_ * 8] = "sf_nc ++$reg[$_]" for 0..7; # inr
		377	$op[0x05 + $_ * 8] = "sf_nc --$reg[$_]" for 0..7; # dcr
		378
		379	$op[0x07] = ' $FC = $A & 0x80; $A = (($A << 1) + ($FC && 0x01)) & 0xff '; # rlc
		380	$op[0x17] = ' ($FC, $A) = ($A & 0x80, (($A << 1) + ($FC && 0x01)) & 0xff)'; # ral
		381	$op[0x0f] = ' $FC = $A & 0x01; $A = ($A >> 1) \| ($FC && 0x80) '; # rrc
		382	$op[0x1f] = ' ($FC, $A) = ($A & 0x01, ($A >> 1) \| ($FC && 0x80))'; # rar
313		383
314	# getting this insn wrong (its the only 16 bit insn to modify flags)	384	# getting this insn wrong (its the only 16 bit insn to modify flags)
315	# wasted three of my best days with mindless vt102 rom reverse engineering	385	# wasted three of my best days with mindless vt102 rom reverse engineering
316	sub dad {	386	sub dad {
317	$x = $H * 256 + $L + $_[0];	387	$x = $H * 256 + $L + $_[0];
…		…
323	$op[0x09] = 'dad $B * 256 + $C'; # dad	393	$op[0x09] = 'dad $B * 256 + $C'; # dad
324	$op[0x19] = 'dad $D * 256 + $E'; # dad	394	$op[0x19] = 'dad $D * 256 + $E'; # dad
325	$op[0x29] = 'dad $H * 256 + $L'; # dad	395	$op[0x29] = 'dad $H * 256 + $L'; # dad
326	$op[0x39] = 'dad $SP '; # dad	396	$op[0x39] = 'dad $SP '; # dad
327		397
328	$op[0x07] = ' $FC = $A >> 7; $A = ($A * 2 + $FC) & 0xff '; # rlc	398	$op[0x2f] = '$A ^= 0xff'; # cma
329	$op[0x17] = ' ($FC, $A) = ($A >> 7, ($A * 2 + $FC) & 0xff)'; # ral
330		399
331	$op[0x0f] = ' $FC = $A & 1; $A = ($A >> 1) \| ($FC && 0x80) '; # rrc	400	$op[0x80 + $_] = 'sf $A += + ' . $reg[$_] for 0..7; # add
332	$op[0x1f] = ' ($FC, $A) = ($A & 1, ($A >> 1) \| ($FC && 0x80))'; # rar	401	$op[0x88 + $_] = 'sf $A += ($FC && 1) + ' . $reg[$_] for 0..7; # adc
		402	$op[0x90 + $_] = 'sf $A -= + ' . $reg[$_] for 0..7; # sub
		403	$op[0x98 + $_] = 'sf $A -= ($FC && 1) + ' . $reg[$_] for 0..7; # sbb
		404	$op[0xa0 + $_] = 'sf8 $A &= ' . $reg[$_] for 0..7; # ana
		405	$op[0xa8 + $_] = 'sf8 $A ^= ' . $reg[$_] for 0..7; # xra
		406	$op[0xb0 + $_] = 'sf8 $A \|= ' . $reg[$_] for 0..7; # ora
		407	$op[0xb8 + $_] = 'sf $x = $A - ' . $reg[$_] for 0..7; # cmp
		408	# possible todo: optimize ora a, maybe xra a, possibly ana
333		409
334	$op[0x0a] = '$A = $M[$B * 256 + $C]'; # ldax b	410	$op[0xc6] = 'sf $A += IMM8'; # adi
335	$op[0x1a] = '$A = $M[$D * 256 + $E]'; # ldax d	411	$op[0xd6] = 'sf $A -= IMM8'; # sui
336	$op[0x3a] = '$A = $M[IMM16]'; # lda	412	$op[0xe6] = 'sf8 $A &= IMM8'; # ani
		413	$op[0xee] = 'sf8 $A ^= IMM8'; # xri
		414	$op[0xf6] = 'sf8 $A \|= IMM8'; # ori
		415	$op[0xfe] = 'sf $A - IMM8'; # cpi
		416	# ce ACI NYI, apparently unused
		417	# de SBI NYI, apparently unused
337		418
		419	$op[0xc5] = 'PUSH $B; PUSH $C';
		420	$op[0xd5] = 'PUSH $D; PUSH $E';
		421	$op[0xe5] = 'PUSH $H; PUSH $L';
		422	$op[0xf5] = 'PUSH $A; PUSH +($FS && 0x80) \| ($FZ && 0x40) \| ($FA && 0x10) \| ($FP && 0x04) \| ($FC && 0x01)'; # psw
		423
		424	$op[0xc1] = '($C, $B) = (POP, POP)'; # pop
		425	$op[0xd1] = '($E, $D) = (POP, POP)'; # pop
		426	$op[0xe1] = '($L, $H) = (POP, POP)'; # pop
		427	$op[0xf1] = '($x, $A) = (POP, POP); ($FS, $FZ, $FA, $FP, $FC) = ($x & 0x80, $x & 0x40, $x & 0x10, $x & 0x04, $x & 0x01)'; # pop psw
		428
		429	$op[0xc2 + $_ * 8] = 'BRA IMM16 if ' . $cc[$_] for 0..7; # jcc
		430	$op[0xc3] = 'JMP IMM16'; # jmp
		431
		432	$op[0xc4 + $_ * 8] = '(PUSH PC >> 8), (PUSH PC & 0xff), (BRA IMM16) if ' . $cc[$_] for 0..7; # ccc
		433	$op[0xcd] = '(PUSH PC >> 8), (PUSH PC & 0xff), (BRA IMM16)'; # call
		434
		435	$op[0xc0 + $_ * 8] = 'BRA POP + POP * 256 if ' . $cc[$_] for 0..7; # rcc
		436	$op[0xc9] = 'JMP POP + POP * 256'; # ret
		437
		438	$op[0xc7 + $_ * 8] = "JMP $_ * 8" for 0..7; # rst
		439
		440	$op[0xe9] = 'JMP $H * 256 + $L'; # pchl
		441	# f9 SPHL NYI, apparently unused
		442
		443	$op[0x37] = '$FC = 1 '; # stc
		444	$op[0x3f] = '$FC = !$FC'; # cmc
		445
		446	$op[0xd3] = 'OUT'; # out
		447	$op[0xdb] = 'IN'; # in
		448
		449	$op[0xeb] = '($D, $E, $H, $L) = ($H, $L, $D, $E)'; # xchg
		450
		451	# e3 xthl NYI # @ 917b in e69, hl <-> (sp)
		452
338	$op[0x20] = '$A = $INTPEND * 16 + $INTMASK + ($IFF && 8)'; # rim (incomplete)	453	$op[0x20] = '$A = $INTPEND * 16 + $INTMASK + ($IFF && 8)'; # rim (8085, incomplete)
339	$op[0x30] = '$INTMASK = $A & 7 if $A & 8'; # sim (incomplete)	454	$op[0x30] = '$INTMASK = $A & 7 if $A & 8'; # sim (8085, incomplete)
340		455
341	$op[0x22] = '($M[IMM16], $M[IMM16 + 1]) = ($L, $H)'; # shld	456	$op[0xf3] = '$IFF = 0'; # di
342	$op[0x2a] = '($L, $H) = ($M[IMM16], $M[IMM16 + 1])'; # lhld	457	$op[0xfb] = '$IFF = 1'; # ei
343		458
344	# yeah, the fucking setup screens actually use daa...	459	# yeah, the fucking setup screen actually uses daa...
345	$op[0x27] = '	460	$op[0x27] = '
346	my ($h, $l);	461	my ($h, $l);
347		462
348	($h, $l) = ($A >> 4, $A & 15);	463	($h, $l) = ($A >> 4, $A & 15);
349		464
350	if ($l > 9 \|\| $FA) {	465	if ($l > 9 \|\| $FA) {
351	$A = sf $A + 6;	466	sf $A += 6;
352	($h, $l) = ($A >> 4, $A & 15);	467	($h, $l) = ($A >> 4, $A & 15);
353	}	468	}
354		469
355	if ($h > 9 \|\| $FC) {	470	if ($h > 9 \|\| $FC) {
356	$h += 6;	471	$h += 6;
357	$A = ($h * 16 + $l) & 0xff;	472	$A = ($h * 16 + $l) & 0xff;
358	}	473	}
359	'; # daa, almost certainly borked, also, acarry not set by sf	474	'; # daa, almost certainly borked, also, acarry not set by sf
360		475
361	$op[0x2f] = '$A ^= 0xff'; # cma
362
363	$op[0x37] = '$FC = 1 '; # stc
364	$op[0x3f] = '$FC = !$FC'; # cmc
365
366	$op[0x76] = 'die "HLT"'; # hlt
367
368	$op[0x80 + $_] = '$A = sf $A + ' . $reg[$_] for 0..7; # add
369	$op[0x88 + $_] = '$A = sf $A + $FC + ' . $reg[$_] for 0..7; # adc
370	$op[0x90 + $_] = '$A = sf $A - ' . $reg[$_] for 0..7; # sub
371	$op[0x98 + $_] = '$A = sf $A - $FC - ' . $reg[$_] for 0..7; # sbb
372	$op[0xa0 + $_] = '$A = sf $A & ' . $reg[$_] for 0..7; # ana
373	$op[0xa8 + $_] = '$A = sf $A ^ ' . $reg[$_] for 0..7; # xra
374	$op[0xb0 + $_] = '$A = sf $A \| ' . $reg[$_] for 0..7; # ora
375	$op[0xb8 + $_] = ' sf $A - ' . $reg[$_] for 0..7; # cmp
376	# possible todo: optimize ora a, maybe xra a
377
378	$op[0xc6 + $_] = '$A = sf $A + IMM8'; # adi
379	$op[0xd6 + $_] = '$A = sf $A - IMM8'; # sui
380	$op[0xe6 + $_] = '$A = sf $A & IMM8'; # ani
381	$op[0xee + $_] = '$A = sf $A ^ IMM8'; # xri
382	$op[0xf6 + $_] = '$A = sf $A \| IMM8'; # ori
383	$op[0xfe + $_] = ' sf $A - IMM8'; # cpi
384
385	$op[0xc1] = '($C, $B) = (POP, POP)'; # pop
386	$op[0xd1] = '($E, $D) = (POP, POP)'; # pop
387	$op[0xe1] = '($L, $H) = (POP, POP)'; # pop
388	$op[0xf1] = '($x, $A) = (POP, POP); ($FS, $FZ, $FA, $FP, $FC) = (!!($x & 0x80), !!($x & 0x40), !!($x & 0x10), !!($x & 0x04), !!($x & 0x01))'; # pop psw
389
390	$op[0xeb] = '($D, $E, $H, $L) = ($H, $L, $D, $E)'; # xchg
391
392	$op[0xc2 + $_ * 8] = 'BRA IMM16 ' . $cc[$_] for 0..7; # jcc
393	$op[0xc3] = 'JMP IMM16'; # jmp
394
395	$op[0xc4 + $_ * 8] = '(PUSH PC >> 8), (PUSH PC & 0xff), (BRA IMM16) ' . $cc[$_] for 0..7; # ccc
396	$op[0xcd] = '(PUSH PC >> 8), (PUSH PC & 0xff), (BRA IMM16)'; # call
397
398	$op[0xc7 + $_ * 8] = "JMP $_ * 8" for 0..7; # rst
399
400	$op[0xc0 + $_ * 8] = 'BRA POP + POP * 256 ' . $cc[$_] for 0..7; # rcc
401	$op[0xc9] = 'JMP POP + POP * 256'; # ret
402
403	$op[0xc5] = 'PUSH $B; PUSH $C';
404	$op[0xd5] = 'PUSH $D; PUSH $E';
405	$op[0xe5] = 'PUSH $H; PUSH $L';
406	$op[0xf5] = 'PUSH $A; PUSH +($FS && 0x80) \| ($FZ && 0x40) \| ($FA && 0x10) \| ($FP && 0x04) \| ($FC && 0x01)'; # psw
407
408	$op[0xd3] = 'OUT'; # out
409	$op[0xdb] = 'IN'; # in
410
411	# e3 xthl @ 917b, hl <-> (sp)
412
413	$op[0xe9] = 'JMP $H * 256 + $L'; # pchl
414
415	$op[0xf3] = '$IFF = 0'; # DI
416	$op[0xfb] = '$IFF = 1'; # EI
417
418	@ops = @op; # for debugging #d#
419
420	#############################################################################	476	#############################################################################
		477	# debug
421		478
422	# print cpu status, for debugging	479	# print cpu status, for debugging
423	sub status {	480	sub status {
424	my $PC = shift \|\| $PC;	481	my $PC = shift \|\| $PC;
425		482
…		…
429	($FZ ? "1" : "0")	486	($FZ ? "1" : "0")
430	. ($FS ? "1" : "0")	487	. ($FS ? "1" : "0")
431	. ($FC ? "1" : "0")	488	. ($FC ? "1" : "0")
432	. ($FA ? "1" : "0")	489	. ($FA ? "1" : "0")
433	. ($FP ? "1" : "0"),	490	. ($FP ? "1" : "0"),
434	$M[$PC], $ops[$M[$PC]];	491	$M[$PC], $op[$M[$PC]];
435	}	492	}
436		493
437	#############################################################################	494	#############################################################################
		495	# video emulation
438		496
439	my @chr = (	497	binmode STDOUT;
		498
		499	my @CHARMAP = ( # acschars / chars 0..31
440	" " , "\x{29eb}", "\x{2592}", "\x{2409}",	500	" " , "\x{29eb}", "\x{2592}", "\x{2409}",
441	"\x{240c}", "\x{240d}", "\x{240a}", "\x{00b0}",	501	"\x{240c}", "\x{240d}", "\x{240a}", "\x{00b0}",
442	"\x{00b1}", "\x{2424}", "\x{240b}", "\x{2518}",	502	"\x{00b1}", "\x{2424}", "\x{240b}", "\x{2518}",
443	"\x{2510}", "\x{250c}", "\x{2514}", "\x{253c}",	503	"\x{2510}", "\x{250c}", "\x{2514}", "\x{253c}",
444	"\x{23ba}", "\x{23bb}", "\x{2500}", "\x{23bc}",	504	"\x{23ba}", "\x{23bb}", "\x{2500}", "\x{23bc}",
…		…
446	"\x{252c}", "\x{2502}", "\x{2264}", "\x{2265}",	506	"\x{252c}", "\x{2502}", "\x{2264}", "\x{2265}",
447	"\x{03c0}", "\x{2260}", "\x{00a3}", "\x{00b7}",	507	"\x{03c0}", "\x{2260}", "\x{00a3}", "\x{00b7}",
448	(map chr, 0x020 .. 0x7e),	508	(map chr, 0x020 .. 0x7e),
449	);	509	);
450		510
451	utf8::encode $_ for @chr;	511	utf8::encode $_ for @CHARMAP;
452		512
453	sub prscr {	513	my @SGR; # sgr sequences for attributes
		514
		515	for (0x00 .. 0xff) {
		516	my $sgr = "";
		517
		518	# ~1 sgr 5 blink
		519	# ~2 sgr 4 underline
		520	# ~4 sgr 1 bold
		521	# 0x80 in attr, sgr 7, reversed
		522
		523	$sgr .= ";5" unless $_ & 0x01;
		524	$sgr .= ";4" unless $_ & 0x02;
		525	$sgr .= ";1" unless $_ & 0x04;
		526	$sgr .= ";7" if $_ & 0x80;
		527
		528	$SGR[$_] = "\e[${sgr}m";
		529	}
		530
		531	my @LED = $VT102
		532	? qw(L1 INSERT DSR CTS LOCKED LOCAL SCAN BEEP)
		533	: qw(L4 L3 L2 L1 LOCKED LOCAL SCAN BEEP);
		534
		535	my $CURSOR_IS_ON;
		536
		537	# display screen
		538	sub 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
454	my $i = 0x2000;	543	my $i = 0x2000;
455		544
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;	545	my $leds = join " ", map $KSTATUS & 2**$_ ? "\e[7m$LED[$_]\e[m" : "$LED[$_]", reverse 0 .. $#LED;
		546
		547	my $scr = sprintf "\e[H--- LED [ %s ] CLK %d\e[K\n", $leds, $CLK;
		548
		549	$scr .= "\e[?5" . ($DC11_REVERSE ? "h" : "l");
457		550
458	line:	551	line:
459	for my $y (0 .. 25) {	552	for my $y (0 .. 25) { # ntsc, two vblank delay lines, up to 24 text lines
		553	my $prev_attr;
		554	my ($c, $attr); # declare here for speedup
		555
460	$scr .= sprintf "%2d \|", ++$y;	556	$scr .= sprintf "%2d \xe2\x94\x82", $y;
461		557
462	for (0..140) {	558	for (0..139) {
463	my $c = $M[$i++];	559	$c = $M[$i];
464
465	# printf "%04x %02x\n", $i-1,$c;
466		560
467	if ($c == 0x7f) { # also 0xff, but the firmware avoids that	561	if ($c == 0x7f) { # also 0xff, but the firmware avoids that
468	$scr .= "\|\x1b[K\n";	562	$scr .= "\e[m\xe2\x94\x82\e[K\n";
469		563
470	my $a1 = $M[$i++];	564	my $a1 = $M[$i + 1];
471	my $a0 = $M[$i++];	565	my $a0 = $M[$i + 2];
472		566
473	$i = 0x2000 + (($a1 * 256 + $a0) & 0xfff);	567	$i = 0x2000 + (($a1 * 256 + $a0) & 0xfff);
474		568
475	next line;	569	next line;
476	}	570	}
477		571
478	$scr .= "\x1b[7m" if $c & 0x80;	572	$scr .= $SGR[$prev_attr = $attr]
479	$scr .= $chr[$c & 0x7f] // sprintf "[%02x]", $c & 0x7f;	573	if $prev_attr != ($attr = ($M[$i++ + 0x1000] & 15) \| ($c & 0x80));
480	$scr .= "\x1b[m" if $c & 0x80;	574
		575	$scr .= $CHARMAP[$c & 0x7f];
481	}	576	}
482		577
483	$scr .= "\x1b[K\noverflow\x1b[K\n";	578	$scr .= "\e[K\nvideo overflow\e[K\n";
484	last;	579	last;
485	}	580	}
486		581
487	if (0) {
488	$scr .= "\x1b[K\n";
489	for my $o (0x200 .. 0x232) {
490	$scr .= sprintf "%04x:", $o * 16;
491	for (0..15) {
492	$scr .= sprintf " %02x", $M[$o * 16 + $_];
493	}
494	$scr .= "\x1b[K\n";
495	}
496	}
497
498	$scr .= "\x1b[J";	582	$scr .= "\e[m\e[J";
499		583
500	syswrite STDOUT, $scr;	584	syswrite STDOUT, $scr;
501	}	585	}
502		586
503	#############################################################################	587	#############################################################################
		588	# keyboard handling
504		589
505	if (@ARGV) {	590	# 0x080 shift, 0x100 ctrl
506	require IO::Pty;	591	my %KEYMAP = (
507	$PTY = IO::Pty->new;	592	"\t" => 0x3a,
		593	"\r" => 0x64,
		594	"\n" => 0x44,
		595
		596	"\x00" => 0x77 \| 0x100, # CTRL-SPACE
		597	"\x1c" => 0x45 \| 0x100, # CTRL-\
		598	"\x1d" => 0x14 \| 0x100, # CTRL-]
		599	"\x1e" => 0x24 \| 0x100, # CTRL-~
		600	"\x1f" => 0x75 \| 0x100, # CTRL-?
		601
		602	# hardcoded rxvt keys
		603	"\e" => 0x2a, # ESC
		604	"\e[2~" => 0x79 \| 0x100, # CTRL-C (insert)
		605	"\e[3~" => 0x03, # DC
		606	"\e[5~" => 0x7e, # CAPS LOCK (prior)
		607	"\e[6~" => 0x6a, # NO SCROLL (next)
		608	"\e[A" => 0x30, # UP
		609	"\e[B" => 0x22, # DOWN
		610	"\e[C" => 0x10, # RIGHT
		611	"\e[D" => 0x20, # LEFT
		612	"\e[a" => 0x30 \| 0x080, # UP
		613	"\e[b" => 0x22 \| 0x080, # DOWN
		614	"\e[c" => 0x10 \| 0x080, # RIGHT
		615	"\e[d" => 0x20 \| 0x080, # LEFT
		616	"\e[7~" => 0x7b, # SETUP (home)
		617	"\e[8~" => 0x23, # BREAK (end)
		618	"\e[8\$" => 0x23 \| 0x080, # SHIFT BREAK / DISCONNECT (shift-end)
		619	"\x7f" => 0x33, # BACKSPACE
		620
		621	"\e[11~" => 0x32, # PF1
		622	"\e[12~" => 0x42, # PF2
		623	"\e[13~" => 0x31, # PF3
		624	"\e[14~" => 0x41, # PF4
		625	);
508		626
509	my $slave = $PTY->slave;	627	@KEYMAP{map chr, 0x20 .. 0x40, 0x5b .. 0x7e} = unpack "C", pack "H",
		628	"779ad5a9a8b8a755a6b5b6b466256575" . "351a3929283837273626d656e634e5f5" . "b9" # 20..40
		629	. "154514b7a5" . "244a6879591949485816574746766706" . "050a185a0817780969077a95c594a4"; # 5b..7e
510		630
511	$PTY->set_winsize (24, 80);	631	$KEYMAP{"\x1f" & $_} \|\|= $KEYMAP{$_} \| 0x100 for "a" .. "z"; # ctrl
		632	$KEYMAP{"\x20" ^ $_} \|\|= $KEYMAP{$_} \| 0x080 for "a" .. "z"; # shift
512		633
513	unless (fork) {	634	my $KEYMATCH = join "\|", map quotemeta, reverse sort keys %KEYMAP;
514	$ENV{TERM} = $VT102 ? "vt102" : "vt100";	635	$KEYMATCH = qr{^($KEYMATCH)}s;
515		636
516	close $PTY;	637	my %KMOD; # currently pressed modifier keys
517		638
518	open STDIN , "<&", $slave;	639	sub key {
519	open STDOUT, ">&", $slave;	640	my ($key) = @_;
520	open STDERR, ">&", $slave;
521		641
522	system "stty ixoff erase ^H";	642	push @KQUEUE, -0x7c if !($key & 0x100) && delete $KMOD{0x7c}; # ctrl-up
		643	push @KQUEUE, -0x7d if !($key & 0x080) && delete $KMOD{0x7d}; # shift-up
523		644
524	$PTY->make_slave_controlling_terminal;	645	push @KQUEUE, 0x7c if $key & 0x100 && !$KMOD{0x7c}++; # ctrl-down
525	$PTY->close_slave;	646	push @KQUEUE, 0x7d if $key & 0x080 && !$KMOD{0x7d}++; # shift-down
526		647
527	exec @ARGV;	648	$key &= 0x7f;
528	}	649	push @KQUEUE, $key, -$key;
529
530	$PTY->close_slave;
531
532	} else {
533	open $PTY, "</dev/null" or die;#d
534	}	650	}
535		651
536	#############################################################################	652	my $STDIN_BUF;
537		653
		654	sub stdin_parse {
		655	key $KEYMAP{$1}
		656	while $STDIN_BUF =~ s/$KEYMATCH//;
		657
		658	# skip input we can't decipher
		659	substr $STDIN_BUF, 0, 1, "";
		660	}
		661
		662	if ($KBD) {
		663	system "stty -icanon -icrnl -inlcr -echo min 1 time 0"; # -isig
		664	eval q{ sub END { system "stty sane" } };
		665	$SIG{INT} = $SIG{TERM} = $SIG{QUIT} = sub { exit 1 };
		666	}
		667
		668	#############################################################################
538	# initial key input, to set up online mode etc.	669	# initial key input, to set up online mode etc.
		670	# could be done via nvram defaults
		671
539	@KQUEUE = (	672	@KQUEUE = (
540	0x7b, -0x7b, # setup	673	0x7b, -0x7b, # setup
541	0, # delay	674	0, # delay
542	0x28, -0x28, # 4, toggle local/online	675	0x28, -0x28, # 4, toggle local/online
543	0x38, -0x38, # 5, setup b	676	0x38, -0x38, # 5, setup b
…		…
554	0x37, -0x37, # 6 toggle wrap around	687	0x37, -0x37, # 6 toggle wrap around
555	0x7b, -0x7b, # leave setup	688	0x7b, -0x7b, # leave setup
556	);	689	);
557		690
558	#############################################################################	691	#############################################################################
		692	# process/pty management
559		693
560	# 0x80 shift, 0x100 ctrl, 0x200 toggle	694	if (1) {
561	my %KEYMAP = (	695	require IO::Pty;
562	"\t" => 0x3a,	696	$PTY = IO::Pty->new;
563	"\r" => 0x64,
564	"\n" => 0x44,
565		697
566	# hardcoded rxvt keys	698	my $slave = $PTY->slave;
567	"\e" => 0x2a, # ESC
568	"\e[3~" => 0x03, # DC
569	"\e[5~" => 0x7e, # CAPS LOCK (prior)
570	"\e[6~" => 0x6a, # NO SCROLL (next)
571	"\e[A" => 0x30, # UP
572	"\e[B" => 0x22, # DOWN
573	"\e[C" => 0x10, # RIGHT
574	"\e[D" => 0x20, # LEFT
575	"\e[a" => 0x30 \| 0x080, # UP
576	"\e[b" => 0x22 \| 0x080, # DOWN
577	"\e[c" => 0x10 \| 0x080, # RIGHT
578	"\e[d" => 0x20 \| 0x080, # LEFT
579	"\e[7~" => 0x7b, # SETUP (home)
580	"\e[8~" => 0x23, # BREAK (end)
581	"\e[8\$" => 0x23 \| 0x080, # SHIFT BREAK / DISCONNECT (shift-end)
582	"\x7f" => 0x33, # BACKSPACE
583		699
584	"\e[11~" => 0x32, # F1	700	$PTY->set_winsize (24, 80);
585	"\e[11~" => 0x42, # F2
586	"\e[11~" => 0x31, # F3
587	"\e[11~" => 0x41, # F4
588	);
589		701
590	@KEYMAP{map chr, 0x20..0x40} = unpack "C", pack "H",	702	unless (fork) {
591	"779ad5a9a8b8a755a6b5b6b466256575" . "351a3929283837273626d656e634e5f5" . "b9";	703	$ENV{LC_ALL} = "C";
		704	$ENV{TERM} = $VT102 ? "vt102" : "vt100";
592		705
593	@KEYMAP{map chr, 0x5b .. 0x7e} = unpack "C", pack "H",	706	close $PTY;
594	"154514b7a5" . "244a6879591949485816574746766706" . "050a185a0817780969077a95c594a4";
595		707
596	$KEYMAP{"\x3f" & $_} \|\|= $KEYMAP{$_} \| 0x100 for "a" .. "z"; # ctrl	708	open STDIN , "<&", $slave;
597	$KEYMAP{uc $_} \|\|= $KEYMAP{$_} \| 0x080 for "a" .. "z"; # shift	709	open STDOUT, ">&", $slave;
		710	open STDERR, ">&", $slave;
598		711
599	my $KEYMATCH = join "\|", map quotemeta, reverse sort keys %KEYMAP;	712	system "stty ixoff erase ^H";
600	$KEYMATCH = qr{^($KEYMATCH)}s;
601		713
602	sub key {	714	$PTY->make_slave_controlling_terminal;
603	my ($key) = @_;	715	$PTY->close_slave;
604		716
605	state %MOD;	717	@ARGV = "sh" unless @ARGV;
		718	exec @ARGV;
		719	}
606		720
607	push @KQUEUE, -0x7c if !($key & 0x100) && delete $MOD{0x7c}; # ctrl-up	721	$PTY->close_slave;
608	push @KQUEUE, -0x7d if !($key & 0x080) && delete $MOD{0x7d}; # shift-up	722	} else {
609		723	open $PTY, "+</dev/null"
610	push @KQUEUE, 0x7c if $key & 0x100 && !$MOD{0x7c}++; # ctrl-down	724	or die "/dev/null: $!";
611	push @KQUEUE, 0x7d if $key & 0x080 && !$MOD{0x7d}++; # shift-down
612
613	$key &= 0x7f;
614	push @KQUEUE, $key, -$key;
615	}	725	}
616		726
617	my $STDIN_BUF;
618
619	sub stdin_parse {
620	key $KEYMAP{$1}
621	while $STDIN_BUF =~ s/$KEYMATCH//;
622
623	# skip input we can't decipher
624	substr $STDIN_BUF, 0, 1, "";
625	}
626
627	if ($KBD) {
628	system "stty -icanon -icrnl -inlcr -echo min 1 time 0";
629	eval q{ sub END { system "stty sane" } };
630	$SIG{INT} = $SIG{TERM} = $SIG{QUIT} = sub { exit 1 };
631	}
632
633	#############################################################################	727	#############################################################################
		728	# the actual hardware simulator
634		729
635	my @ICACHE; # compiled instruction cache	730	my @ICACHE; # compiled instruction/basic block cache
636		731
		732	my $POWERSAVE; # powersave counter
		733
		734	my $RIN; # libev for the less well-off
		735
		736	(vec $RIN, 0, 1) = 1 if $KBD;
		737	(vec $RIN, fileno $PTY, 1) = 1 if $PTY;
		738
637	# the cpu	739	# the cpu.
638	while () {	740	while () {
639
640	# execute extended basic blocks	741	# execute an extended basic block
641	$PC = ($ICACHE[$PC] \|\|= do {	742	$PC = ($ICACHE[$PC] \|\|= do {
642	my $pc = $PC;	743	my $pc = $PC;
643		744
644	my $insn = "";	745	my $insn = "";
645		746
646	# the jit compiler	747	# the jit compiler
647	for (0..15) {	748	for (0..31) {
648
649	# optional tracing support
650	if (0) {
651	$insn .= qq<
652	if (\$PRSTATUS) {
653	status $pc;
654	die unless --\$PRSTATUS;
655	}
656	>;
657	}
658
659	my $imm;	749	my $imm;
660	my $op = $op[$M[$pc++]];	750	my $op = $op[$M[$pc++]];
661		751
662	for ($op) {	752	for ($op) {
663	s/\bPUSH\b/\$M[--\$SP] =/g; # push byte to stack	753	s/\bPUSH\b/\$M[--\$SP] =/g; # push byte to stack
…		…
668		758
669	s/\bPC\b/$pc/ge; # PC at end of insn	759	s/\bPC\b/$pc/ge; # PC at end of insn
670	s/\bBRA\b/return/g; # conditional jump	760	s/\bBRA\b/return/g; # conditional jump
671	s/\bJMP\b(.*)/$1\x00/sg; # unconditional jump	761	s/\bJMP\b(.*)/$1\x00/sg; # unconditional jump
672		762
673	s/\bIN\b/ sprintf "\$A = in_%02x", $M[$pc++]/xge;	763	s/\bIN\b/ sprintf "\$A = in_%02x", $M[$pc++]/xge; # in insns call in_HEX
674	s/\bOUT\b/sprintf "out_%02x \$A ", $M[$pc++]/xge;	764	s/\bOUT\b/sprintf "out_%02x \$A ", $M[$pc++]/xge; # out likewise
675	}	765	}
676		766
677	$insn .= "$op;\n";	767	$insn .= "$op;\n";
678	}	768	}
679		769
680		770
681	$insn .= "$pc";	771	$insn .= $pc;
682	$insn =~ s/\x00.*$//s;	772	$insn =~ s/\x00.*$//s;
683		773
684	eval "use integer; sub { $insn }" or die "$insn: $@"	774	eval "sub { $insn }" or die "$insn: $@"
685	})->();	775	})->();
686		776
687	++$CLK;	777	++$CLK;
688		778
689	# things we do from time too time only	779	# things we do from time to time only
690	unless ($CLK & 0xf) {	780	unless ($CLK & 0xf) {
691	# do I/O	781	# do I/O
692		782
693	unless ($CLK & 0x7ff) {	783	unless ($CLK & 0xfff) {
		784	if (select $x = $RIN, undef, undef, $POWERSAVE < 10 ? 0 : $CURSOR_IS_ON && 3600) {
694		785
695	# pty/serial I/O	786	# pty/serial I/O
696	unless (@PUSARTRECV \|\| @KQUEUE \|\| !$PTY) {	787	if ($PTY && (vec $x, fileno $PTY, 1) && (@PUSARTRECV < 128) && !@KQUEUE) {
697	my $rin = ""; (vec $rin, fileno $PTY, 1) = 1;
698
699	if (select $rin, undef, undef, 0) {
700	sysread $PTY, my $buf, 256;	788	sysread $PTY, my $buf, 256;
		789
		790	# linux don't do cs7 and/or parity anymore, so we need to filter
		791	# out xoff characters to avoid freezes.
701	push @PUSARTRECV, unpack "C*", $buf;	792	push @PUSARTRECV, grep { ($_ & 0x7f) != 0x13 } unpack "C*", $buf;
702	}	793	}
703	}
704		794
705	# keyboard input	795	# keyboard input
706	if ($KBD) {	796	if ($KBD && (vec $x, 0, 1)) {
		797	# to avoid non-blocking mode on stdin (and stty min 0), we
		798	# just read byte-by-byte after a select says there is data.
707	while (select my $rin = "\x01", undef, undef, 0) {	799	while (select my $rin = "\x01", undef, undef, 0) {
708	sysread STDIN, $STDIN_BUF, 1, length $STDIN_BUF	800	sysread STDIN, $STDIN_BUF, 1, length $STDIN_BUF
709	or last;	801	or last;
		802	}
		803
		804	stdin_parse if length $STDIN_BUF;
710	}	805	}
711		806
712	stdin_parse if length $STDIN_BUF;	807	$POWERSAVE = 0; # activity
		808	} elsif (@PUSARTRECV \|\| @KQUEUE) {
		809	$POWERSAVE = 0;
		810	} else {
		811	++$POWERSAVE;
713	}	812	}
714	}	813	}
715		814
716	# kick off various interrupts	815	# kick off serial input interrupt quite often
717
718	$RST \|= 2 if @PUSARTRECV && $XON; # VT100, but works on vt102, too (probably not used on real hardware though)	816	$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	817	#$INTPEND \|= 2 if @PUSARTRECV && $XON; # VT102, 6.5 rxrdy
720		818
721	# kick off vertical retrace form time to time	819	# kick off vertical retrace interrupt from time to time
722	unless ($CLK & 0x1ff) {	820	unless ($CLK & 0x1ff) {
723	$RST \|= 4; # vertical retrace	821	$RST \|= 4; # vertical retrace
724	}	822	}
725		823
726	# handle video hardware	824	# handle video hardware
727
728	unless ($CLK & 0x1fff) {	825	unless ($CLK & 0x3fff) {
729	prscr;	826	display;
730	}	827	}
731	}	828	}
732		829
733	# the interrupt logic	830	# the interrupt logic - we only interrupt after basic blocks
734	$x = $INTPEND & ~$INTMASK;	831	# which, as a side effect, ensures that we don't interrupt
735	if (($RST \|\| $x) && $IFF) {	832	# "ei; ret" sequences and thus reduce the risk of stack overflows.
		833	if (($RST \|\| ($INTPEND & ~$INTMASK)) && $IFF) {
736	# rst 1 kbd data available	834	# rst 1 kbd data available
737	# rst 2 pusart xmit+recv flag	835	# rst 2 pusart xmit+recv flag
738	# rst 4 vertical retrace	836	# rst 4 vertical retrace
739	# 5.5 vt125 mb7 trans ready (serial send?)	837	# 5.5 vt125 mb7 trans ready (serial send?)
740	# 6.5 vt125 mb7 read ready (something modem?)	838	# 6.5 vt125 mb7 read ready (something modem?)
741	# 7.5 vt125 mb7 vblank h(?)	839	# 7.5 vt125 mb7 vblank h(?)
742	# trap vt125 mbi init h(?)	840	# trap vt125 mbi init h(?)
743	my $vec;	841	my $vec;
744		842
		843	my $pend = $INTPEND & ~$INTMASK;
		844
745	if ($x & 1) { $vec = 0x2c; $INTPEND &= ~1;	845	if ($pend & 1) { $vec = 0x2c; $INTPEND &= ~1;
746	} elsif ($x & 2) { $vec = 0x34; $INTPEND &= ~2;	846	} elsif ($pend & 2) { $vec = 0x34; $INTPEND &= ~2;
747	} elsif ($x & 4) { $vec = 0x3c; $INTPEND &= ~4;	847	} elsif ($pend & 4) { $vec = 0x3c; $INTPEND &= ~4;
748	# } elsif ($RST ) { $vec = $RST * 8; $RST = 0; # for some reason, this breaks vt102	848	# } elsif ($RST ) { $vec = $RST * 8; $RST = 0; # the vt102 firmware doesn't like combined interrupts
749	} elsif ($RST & 1) { $vec = 0x08; $RST &= ~1; # separate is better for vt102	849	} elsif ($RST & 1) { $vec = 0x08; $RST &= ~1; # separate is better for vt102
750	} elsif ($RST & 2) { $vec = 0x10; $RST &= ~2;	850	} elsif ($RST & 2) { $vec = 0x10; $RST &= ~2;
751	} elsif ($RST & 4) { $vec = 0x20; $RST &= ~4;	851	} elsif ($RST & 4) { $vec = 0x20; $RST &= ~4;
752	} else {	852	} else {
753	die;	853	die;
754	}	854	}
755		855
		856	# jump to the interrupt vector
756	$M[--$SP] = $PC >> 8;	857	$M[--$SP] = $PC >> 8;
757	$M[--$SP] = $PC & 0xff;	858	$M[--$SP] = $PC & 0xff;
758	$PC = $vec;	859	$PC = $vec;
759		860
760	$IFF = 0;	861	$IFF = 0;
761	}	862	}
762	}	863	}
		864
		865	#############################################################################
		866	# roms in the data section + one newline
		867	#
		868	# vt100 @ 0x0000+0x0800 23-032E2
		869	# vt100 @ 0x0800+0x0800 23-061E2
		870	# vt100 @ 0x1000+0x0800 23-033E2
		871	# vt100 @ 0x1800+0x0800 23-034E2
		872	#
		873	# vt102 @ 0x0000+0x2000 23-226E4
		874	# vt102 @ 0x8000+0x2000 23-225E4
		875	#
		876	# vt131 @ 0xa000+0x0800 23-280E2
		877	#
763		878
764	__DATA__	879	__DATA__
765	�1N �;��0�>�b/�B�Wog<Gӂ�,�O$ �O��[x��I�,ڥ�#��yO�t�ͤ��[��z�W>/2�!�b��>�>��g$>%� !h �w�-!h >��-4!j ��p��O:{ ��y��:�!� �u:x!��_y�A�[>�y� >�y�A�[>?�y�@� :x!�y�A�[�P��>�>O��[>�>[Î:�!�ʵy�A�>�>O�ly�A��P��Ç!�:�!��S!h ~�� ~� ��: �O�͓�: ��Ô!�20!2�!!�!y�AG~�"�&��=�w�<� �w�:�!/�!�!��A:�!��Ey�2�!�~��1N ! �~�e�B��i<2�!͢:P =2S!�~6�ʘ�!�!6	880	�1N �;��0�>�b/�B�Wog<Gӂ�,�O$ �O��[x��I�,ڥ�#��yO�t�ͤ��[��z�W>/2�!�b��>�>��g$>%� !h �w�-!h >��-4!j ��p��O:{ ��y��:�!� �u:x!��_y�A�[>�y� >�y�A�[>?�y�@� :x!�y�A�[�P��>�>O��[>�>[Î:�!�ʵy�A�>�>O�ly�A��P��Ç!�:�!��S!h ~�� ~� ��: �O�͓�: ��Ô!�20!2�!!�!y�AG~�"�&��=�w�<� �w�:�!/�!�!��A:�!��Ey�2�!�~��1N ! �~�e�B��i<2�!͢:P =2S!�~6�ʘ�!�!6
766	�2�!�0*� w�4ʘ> 2�!��~î!N �̓/2!! "R !�""� ��	881	�2�!�0*� w�4ʘ> 2�!��~î!N �̓/2!! "R !�""� ��
767	! �͋!2[ 2v!!�"I!>2s >�2� �B�>�2y >�2!2�!&�l"� �>@�:X!�:�!�͔>2�!�b�:�!��K>G��:\| �� !p �^!p" :�!��x��:�!� �u>�	882	! �͋!2[ 2v!!�"I!>2s >�2� �B�>�2y >�2!2�!&�l"� �>@�:X!�:�!�͔>2�!�b�:�!��K>G��:\| �� !p �^!p" :�!��x��:�!� �u>�
…		…
871		986
872	��.��y��'��&��%��&5��>��L�G�x��W��d��k��ͨ��w�ͨ�/�w�!e!6#}�v�n��ͨ��w�ͨ��ڐ�W�zʁ�Ú�#}�v>�� :,!�ڢ�y2!��:!OW!e!��oһ�$z�W>��0)1!2@3#4$5%6^7&8*9(-_=+`~[{]};:/?'",<.>\\| poytwq�][iure1�`-9743��=08652 ��Ѱ	987	��.��y��'��&��%��&5��>��L�G�x��W��d��k��ͨ��w�ͨ�/�w�!e!6#}�v�n��ͨ��w�ͨ��ڐ�W�zʁ�Ú�#}�v>�� :,!�ڢ�y2!��:!OW!e!��oһ�$z�W>��0)1!2@3#4$5%6^7&8*9(-_=+`~[{]};:/?'",<.>\\| poytwq�][iure1�`-9743��=08652 ��Ѱ
873	\lkgfa��';jhds�� .,nbx��* ��:B!��4��	988	\lkgfa��';jhds�� .,nbx��* ��:B!��4��
874	�!O!�,�ͳ��ʄ��m�Ý�	989	�!O!�,�ͳ��ʄ��m�Ý�
875	�! 0>2ͳ��ʥ��"�>02I y��>c�}��" �2. y2N!��~�2/ z��#ͫ��:/ ��w:N!O:/ ��O��#:. <õ�!N!��蝾�:&0��> 2 �!{!>��!q{" Î�Waitp!O!'6�#�'�M��_! 0R��_:B!��7��N �	990	�! 0>2ͳ��ʥ��"�>02I y��>c�}��" �2. y2N!��~�2/ z��#ͫ��:/ ��w:N!O:/ ��O��#:. <õ�!N!��蝾�:&0��> 2 �!{!>��!q{" Î�Waitp!O!'6�#�'�M��_! 0R��_:B!��7��N �
876	��8�>�2\0��͍��2\0��:y!�ʟ��25!24!�̞�D��!;!~G�6��̞:70��x��!F!~�ɞ��˞�w:5!��ڞ:4!��ឯ͆�;�:<!��B�ʾ�:B!��.�ڇ�!�!~#��;�:!��;��D�!�!"!F#�u�x��2A0:{!��4��R�\|!��x��7��f��Ç�:%0��H�:l ��:5!��S�6!�:4!��k�!w��f�##�]�~#fo�:K ��2\0� )��şZşG>�2\0:70�ʫ�x!z!�«�!F!~� w!B0~�w:40��x·��!l 6�2\0�+��2\0�12vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv�	991	��8�>�2\0��͍��2\0��:y!�ʟ��25!24!�̞�D��!;!~G�6��̞:70��x��!F!~�ɞ��˞�w:5!��ڞ:4!��ឯ͆�;�:<!��B�ʾ�:B!��.�ڇ�!�!~#��;�:!��;��D�!�!"!F#�u�x��2A0:{!��4��R�\|!��x��7��f��Ç�:%0��H�:l ��:5!��S�6!�:4!��k�!w��f�##�]�~#fo�:K ��2\0� )��şZşG>�2\0:70�ʫ�x!z!�«�!F!~� w!B0~�w:40��x·��!l 6�2\0�+��2\0�12vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv��^��y�5�k��6��!
		992	"~�A��C�>Bw2"!z"p�v�"x"��>Cw2"!n"p�v�"l"!!~<� ��N��[�>2,!�N�Ap##�!(0S{�}��ˠ>��w# »�x�E��##ö�6T]#z��pw#s�X�6#��N�\|��p}�H�p�v�"x"7�:
		993	"�C��C�!(0:!��@�W� �=��=��}��wï��2C!2D!z�5�b �Q�!{!\|�� g��H�:d G\|�� g�W]>�6#�k�<�\|e��o��oz�W>��Ê��

Diff Legend

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

Comparing vt102/vt102 (file contents): Revision 1.5 by root, Mon Dec 1 18:41:36 2014 UTC vs. Revision 1.32 by root, Wed Dec 17 03:06:21 2014 UTC

Diff Legend

Comparing vt102/vt102 (file contents):
Revision 1.5 by root, Mon Dec 1 18:41:36 2014 UTC vs.
Revision 1.32 by root, Wed Dec 17 03:06:21 2014 UTC