[ViewVC] Diff of: cvs/vt102/vt102

Comparing vt102/vt102 (file contents):
Revision 1.7 by root, Mon Dec 1 20:01:29 2014 UTC vs.
Revision 1.33 by root, Wed Nov 11 16:32:21 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
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 key map
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		97
47	binmode STDOUT;
48
49	my @M = (0xff) x 65536; # main memory, = (0xff) x 65536;	98	my @M = (0xff) x 65536; # main memory
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_REVERSE = 0;	156	my $DC11_REVERSE = 0; # light background?
114		157
115	my $XON = 1; # false if terminal wants us to pause	158	my $XON = 1; # false if terminal wants us to pause
116	my $PUSARTCMD;	159	my $PUSARTCMD;
117		160
		161	my $KSTATUS; # keyboard status (click + scan flag + leds)
118	my @KXMIT; # current scan queue	162	my @KXMIT; # current scan queue
119	my %KXMIT; # currently pressed keys	163	my %KXMIT; # currently pressed keys
120	my @KQUEUE; # key event queue	164	my @KQUEUE; # key event queue
121	my $KXCNT; # count for debouncew	165	my $KXCNT; # count for debouncew
122	my @PUSARTRECV;	166
123	my $KSTATUS;	167	my @PUSARTRECV; # serial input (to terminal) queue
124		168
125	sub out_00 { # pusartdata	169	sub out_00 { # pusartdata
126	# handle xon/xoff, but also pass it through	170	# handle xon/xoff, but also pass it through
127	if ($_[0] == 0x13) {	171	if ($_[0] == 0x13) {
128	$XON = 0;	172	$XON = 0;
…		…
135	syswrite $PTY, chr $_[0];	179	syswrite $PTY, chr $_[0];
136		180
137	$INTPEND \|= 1;	181	$INTPEND \|= 1;
138	}	182	}
139		183
140	sub out_01 {	184	sub out_01 { # pusartcmd
141	$PUSARTCMD = shift;	185	$PUSARTCMD = shift;
142		186
143	$INTPEND \|= 1 if $PUSARTCMD & 0x01; # VT102, 5.5 txrdy	187	$INTPEND \|= 1 if $PUSARTCMD & 0x01; # VT102, 5.5 txrdy
144	$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
145	}	189	}
146		190
147	sub out_02 { } # baudrate generator	191	sub out_02 { } # baudrate generator
148		192
149	sub out_23 { } # unknown	193	sub out_23 { } # vt102 unknown
150	sub out_27 { } # unknown	194	sub out_27 { } # vt102 unknown
151	sub out_2f { } # unknown, connected to in 0f	195	sub out_2f { } # vt102 unknown, connected to in 0f
152		196
153	sub out_42 { } # brightness	197	sub out_42 { } # brightness
154		198
155	sub out_62 {	199	sub out_62 { # nvr latch register (4 bits)
156	$NVRLATCH = shift;	200	$NVRLATCH = shift;
157	}	201	}
158		202
159	sub out_a2 {	203	sub out_a2 { # device control 011
160	my $dc11 = 0x0f & shift;	204	my $dc11 = 0x0f & shift;
161		205
162	$DC11_REVERSE = 1 if $dc11 == 0b1010;	206	$DC11_REVERSE = 1 if $dc11 == 0b1010;
163	$DC11_REVERSE = 0 if $dc11 == 0b1011;	207	$DC11_REVERSE = 0 if $dc11 == 0b1011;
164	}	208	}
165		209
166	sub out_c2 { } # unknown	210	sub out_c2 { } # unknown
167	sub out_d2 { } # 0..3 == 80c/132c/60hz/50hz	211	sub out_d2 { } # device control 012, 0..3 == 80c/132c/60hz/50hz
168		212
169	sub out_82 {	213	sub out_82 { # keyboard txmit
170	# keyboard	214	# CLICK STARTSCAN ONLINE LOCKED \| L1 L2 L3 L4 (vt100)
171
172	# CLICK STARTSCAN ONLINE LOCKED \| CTS DSR INSERT L1(?)	215	# CLICK STARTSCAN ONLINE LOCKED \| CTS DSR INS L1 (vt102)
173	# CLICK STARTSCAN ONLINE LOCKED \| LED1 LED2 LED3 LED4
174	$KSTATUS = $_[0];	216	$KSTATUS = $_[0];
175		217
176	# start new scan unless scan in progress	218	# start new scan unless scan is in progress
177	if (($_[0] & 0x40) && !@KXMIT) {	219	if (($_[0] & 0x40) && !@KXMIT) {
178	# do not reply with keys in locked mode	220	# do not reply with keys in locked mode
179	# or during post (0xff),	221	# or during post (0xff),
180	# mostly to skip init and not fail POST,	222	# mostly to skip init and not fail POST,
181	# and to send startup keys only when terminal is ready	223	# and to send startup keys only when terminal is ready
…		…
201	$RST \|= 1;	243	$RST \|= 1;
202	}	244	}
203	}	245	}
204		246
205	#############################################################################	247	#############################################################################
		248	# I/O ports - input
206		249
207	my $NVRBIT;	250	my $NVRBIT; # the current nvr data bit
208	my $LBA;	251	my $LBA6; # twice the frequenxy of LBA7
209		252
210	sub in_00 { # pusart data	253	sub in_00 { # pusart data
211	# interrupt not generated here, because infinite	254	# interrupt not generated here, because infinite
212	# speed does not go well with the vt102.	255	# speed does not go well with the vt102.
213		256
…		…
217	sub in_01 { # pusart status	260	sub in_01 { # pusart status
218	# DSR SYNDET FE OE \| PE TXEMPTY RXRDY TXRDY	261	# DSR SYNDET FE OE \| PE TXEMPTY RXRDY TXRDY
219	0x85 + (@PUSARTRECV && 0x02)	262	0x85 + (@PUSARTRECV && 0x02)
220	}	263	}
221		264
222	sub in_22 { # modem buffer(?)	265	sub in_22 { # modem buffer
223	# wild guess: -CTS -SPDI -RI -CD 0 0 0 0	266	# wild guess: -CTS -SPDI -RI -CD 0 0 0 0
224	0x20	267	0x20
225	}	268	}
226		269
227	sub in_0f { } # unknown, connected to out 2f	270	sub in_0f { 0xff } # vt102 unknown, connected to out 2f
228		271
229	sub in_42 { # flag buffer	272	sub in_42 { # flag buffer
230	++$LBA;	273	++$LBA6;
231		274
232	$NVRBIT = nvr ? 0x20 : 0x00 if ($LBA & 0x3) == 0x2;	275	$NVRBIT = nvr ? 0x20 : 0x00 if ($LBA6 & 0x3) == 0x2;
233		276
234	# KBD_XMITEMPTY LBA7 NVRDATA ODDFIELD - OPTION !GFX !AVO PUSART_TXRDY	277	# KBD_XMITEMPTY LBA7 NVRDATA ODDFIELD - OPTION !GFX !AVO PUSART_TXRDY
235		278
236	my $f = 0x85 \| $NVRBIT;	279	my $f = 0x85 \| $NVRBIT;
237		280
238	$f \|= 0x02 unless $AVO;	281	$f \|= 0x02 unless $AVO;
239	$f \|= 0x40 if $LBA & 0x2;	282	$f \|= 0x40 if $LBA6 & 0x2;
240		283
241	$f	284	$f
242	}	285	}
243		286
244	sub in_82 { # tbmt keyboard uart	287	sub in_82 { # tbmt keyboard uart
…		…
246		289
247	$RST \|= 1;	290	$RST \|= 1;
248	shift @KXMIT	291	shift @KXMIT
249	}	292	}
250		293
251	sub in_03 { 0xff } # unknown, printer uart input?	294	sub in_03 { 0xff } # vt102 unknown, printer uart input?
252	sub in_0b { 0xff } # unknown	295	sub in_0b { 0xff } # vt102 unknown
253	sub in_17 { 0xff } # unknown, printer status clear by reading?	296	sub in_17 { 0xff } # vt102 unknown, printer status clear by reading?
254	sub in_1b { 0xff } # unknown	297	sub in_1b { 0xff } # vt102 unknown
255		298
256	#############################################################################	299	#############################################################################
		300	# 8085 cpu opcodes and flag handling
257		301
		302	my $x; # dummy scratchpad for opcodes
		303
258	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
259	$FS = $_[0] & 0x080;	319	$FS = $_[0] & 0x080;
260	$FZ = ($_[0] & 0x0ff) == 0;	320	$FZ = ($_[0] & 0x0ff) == 0;
261	$FC = $_[0] & 0x100;
262		321
263	$_[0] & 0xff	322	$_[0] &= 0xff;
264	}	323	}
265		324
266	sub sf_nc { # set flags except carry	325	# opcode table
267	$FS = $_[0] & 0x080;
268	$FZ = ($_[0] & 0x0ff) == 0;
269
270	$_[0] & 0xff
271	}
272
273	my @op = map { sprintf "status(); die 'unknown op %02x'", $_ } 0 .. 255;	326	my @op = map { sprintf "status(); die 'unknown op %02x'", $_ } 0x00 .. 0xff;
274	my @ops;
275		327
276	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
277	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
278		332
279	# mov r,r / r,M / M,r	333	# mov r,r / r,M / M,r
280	for my $s (0..7) {	334	for my $s (0..7) {
281	for my $d (0..7) {	335	for my $d (0..7) {
282	$op[0x40 + $d * 8 + $s] = "$reg[$d] = $reg[$s]";	336	$op[0x40 + $d * 8 + $s] = "$reg[$d] = $reg[$s]"; # mov
283	}	337	}
284	}	338	}
285		339
286	$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;
287		344
288	$op[0x01] = '($B, $C) = (IMM16 >> 8, IMM16 & 0xff)'; # lxi	345	$op[0x01] = '($B, $C) = (IMM16 >> 8, IMM16 & 0xff)'; # lxi
289	$op[0x11] = '($D, $E) = (IMM16 >> 8, IMM16 & 0xff)'; # lxi	346	$op[0x11] = '($D, $E) = (IMM16 >> 8, IMM16 & 0xff)'; # lxi
290	$op[0x21] = '($H, $L) = (IMM16 >> 8, IMM16 & 0xff)'; # lxi	347	$op[0x21] = '($H, $L) = (IMM16 >> 8, IMM16 & 0xff)'; # lxi
291	$op[0x31] = '$SP = IMM16' ; # lxi #d# 0xf000 because of limited stack	348	$op[0x31] = '$SP = IMM16' ; # lxi
292		349
293	$op[0x02] = '$M[$B * 256 + $C] = $A'; # stax	350	$op[0x02] = '$M[$B * 256 + $C] = $A'; # stax
294	$op[0x12] = '$M[$D * 256 + $E] = $A'; # stax	351	$op[0x12] = '$M[$D * 256 + $E] = $A'; # stax
295	$op[0x32] = '$M[IMM16 ] = $A'; # sta	352	$op[0x32] = '$M[IMM16 ] = $A'; # sta
296		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
297	sub inxdcx($$$) {	361	sub inxdcx($$$) {
298	$x = ($_[0] * 256 + $_[1] + $_[2]) & 0xffff;	362	$x = $_[0] * 256 + $_[1] + $_[2];
299	$_[0] = $x >> 8;	363	($_[0], $_[1]) = (($x >> 8) & 0xff, $x & 0xff);
300	$_[1] = $x & 0xff;
301	}	364	}
302		365
303	$op[0x03] = 'inxdcx $B, $C, 1'; # inx	366	$op[0x03] = 'inxdcx $B, $C, 1'; # inx
304	$op[0x13] = 'inxdcx $D, $E, 1'; # inx	367	$op[0x13] = 'inxdcx $D, $E, 1'; # inx
305	$op[0x23] = 'inxdcx $H, $L, 1'; # inx	368	$op[0x23] = 'inxdcx $H, $L, 1'; # inx
…		…
308	$op[0x1b] = 'inxdcx $D, $E, -1'; # dcx	371	$op[0x1b] = 'inxdcx $D, $E, -1'; # dcx
309	$op[0x2b] = 'inxdcx $H, $L, -1'; # dcx	372	$op[0x2b] = 'inxdcx $H, $L, -1'; # dcx
310	$op[0x3b] = '--$SP' ; # dcx	373	$op[0x3b] = '--$SP' ; # dcx
311		374
312	# "no carry" doesn't seem to be needed for vt100 - optimize?	375	# "no carry" doesn't seem to be needed for vt100 - optimize?
313	$op[0x04 + $_ * 8] = "$reg[$_] = sf_nc $reg[$_] + 1" for 0..7; # inr
314	$op[0x05 + $_ * 8] = "$reg[$_] = sf_nc $reg[$_] - 1" for 0..7; # dcr
315
316	# mvi r / M
317	$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
318		383
319	# 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)
320	# 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
321	sub dad {	386	sub dad {
322	$x = $H * 256 + $L + $_[0];	387	$x = $H * 256 + $L + $_[0];
…		…
328	$op[0x09] = 'dad $B * 256 + $C'; # dad	393	$op[0x09] = 'dad $B * 256 + $C'; # dad
329	$op[0x19] = 'dad $D * 256 + $E'; # dad	394	$op[0x19] = 'dad $D * 256 + $E'; # dad
330	$op[0x29] = 'dad $H * 256 + $L'; # dad	395	$op[0x29] = 'dad $H * 256 + $L'; # dad
331	$op[0x39] = 'dad $SP '; # dad	396	$op[0x39] = 'dad $SP '; # dad
332		397
333	$op[0x07] = ' $FC = $A >> 7; $A = ($A * 2 + $FC) & 0xff '; # rlc	398	$op[0x2f] = '$A ^= 0xff'; # cma
334	$op[0x17] = ' ($FC, $A) = ($A >> 7, ($A * 2 + $FC) & 0xff)'; # ral
335		399
336	$op[0x0f] = ' $FC = $A & 1; $A = ($A >> 1) \| ($FC && 0x80) '; # rrc	400	$op[0x80 + $_] = 'sf $A += + ' . $reg[$_] for 0..7; # add
337	$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
338		409
339	$op[0x0a] = '$A = $M[$B * 256 + $C]'; # ldax b	410	$op[0xc6] = 'sf $A += IMM8'; # adi
340	$op[0x1a] = '$A = $M[$D * 256 + $E]'; # ldax d	411	$op[0xd6] = 'sf $A -= IMM8'; # sui
341	$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
342		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
343	$op[0x20] = '$A = $INTPEND * 16 + $INTMASK + ($IFF && 8)'; # rim (incomplete)	453	$op[0x20] = '$A = $INTPEND * 16 + $INTMASK + ($IFF && 8)'; # rim (8085, incomplete)
344	$op[0x30] = '$INTMASK = $A & 7 if $A & 8'; # sim (incomplete)	454	$op[0x30] = '$INTMASK = $A & 7 if $A & 8'; # sim (8085, incomplete)
345		455
346	$op[0x22] = '($M[IMM16], $M[IMM16 + 1]) = ($L, $H)'; # shld	456	$op[0xf3] = '$IFF = 0'; # di
347	$op[0x2a] = '($L, $H) = ($M[IMM16], $M[IMM16 + 1])'; # lhld	457	$op[0xfb] = '$IFF = 1'; # ei
348		458
349	# yeah, the fucking setup screens actually use daa...	459	# yeah, the fucking setup screen actually uses daa...
350	$op[0x27] = '	460	$op[0x27] = '
351	my ($h, $l);	461	my ($h, $l);
352		462
353	($h, $l) = ($A >> 4, $A & 15);	463	($h, $l) = ($A >> 4, $A & 15);
354		464
355	if ($l > 9 \|\| $FA) {	465	if ($l > 9 \|\| $FA) {
356	$A = sf $A + 6;	466	sf $A += 6;
357	($h, $l) = ($A >> 4, $A & 15);	467	($h, $l) = ($A >> 4, $A & 15);
358	}	468	}
359		469
360	if ($h > 9 \|\| $FC) {	470	if ($h > 9 \|\| $FC) {
361	$h += 6;	471	$h += 6;
362	$A = ($h * 16 + $l) & 0xff;	472	$A = ($h * 16 + $l) & 0xff;
363	}	473	}
364	'; # daa, almost certainly borked, also, acarry not set by sf	474	'; # daa, almost certainly borked, also, acarry not set by sf
365		475
366	$op[0x2f] = '$A ^= 0xff'; # cma
367
368	$op[0x37] = '$FC = 1 '; # stc
369	$op[0x3f] = '$FC = !$FC'; # cmc
370
371	$op[0x76] = 'die "HLT"'; # hlt
372
373	$op[0x80 + $_] = '$A = sf $A + ' . $reg[$_] for 0..7; # add
374	$op[0x88 + $_] = '$A = sf $A + $FC + ' . $reg[$_] for 0..7; # adc
375	$op[0x90 + $_] = '$A = sf $A - ' . $reg[$_] for 0..7; # sub
376	$op[0x98 + $_] = '$A = sf $A - $FC - ' . $reg[$_] for 0..7; # sbb
377	$op[0xa0 + $_] = '$A = sf $A & ' . $reg[$_] for 0..7; # ana
378	$op[0xa8 + $_] = '$A = sf $A ^ ' . $reg[$_] for 0..7; # xra
379	$op[0xb0 + $_] = '$A = sf $A \| ' . $reg[$_] for 0..7; # ora
380	$op[0xb8 + $_] = ' sf $A - ' . $reg[$_] for 0..7; # cmp
381	# possible todo: optimize ora a, maybe xra a
382
383	$op[0xc6 + $_] = '$A = sf $A + IMM8'; # adi
384	$op[0xd6 + $_] = '$A = sf $A - IMM8'; # sui
385	$op[0xe6 + $_] = '$A = sf $A & IMM8'; # ani
386	$op[0xee + $_] = '$A = sf $A ^ IMM8'; # xri
387	$op[0xf6 + $_] = '$A = sf $A \| IMM8'; # ori
388	$op[0xfe + $_] = ' sf $A - IMM8'; # cpi
389
390	$op[0xc1] = '($C, $B) = (POP, POP)'; # pop
391	$op[0xd1] = '($E, $D) = (POP, POP)'; # pop
392	$op[0xe1] = '($L, $H) = (POP, POP)'; # pop
393	$op[0xf1] = '($x, $A) = (POP, POP); ($FS, $FZ, $FA, $FP, $FC) = (!!($x & 0x80), !!($x & 0x40), !!($x & 0x10), !!($x & 0x04), !!($x & 0x01))'; # pop psw
394
395	$op[0xeb] = '($D, $E, $H, $L) = ($H, $L, $D, $E)'; # xchg
396
397	$op[0xc2 + $_ * 8] = 'BRA IMM16 ' . $cc[$_] for 0..7; # jcc
398	$op[0xc3] = 'JMP IMM16'; # jmp
399
400	$op[0xc4 + $_ * 8] = '(PUSH PC >> 8), (PUSH PC & 0xff), (BRA IMM16) ' . $cc[$_] for 0..7; # ccc
401	$op[0xcd] = '(PUSH PC >> 8), (PUSH PC & 0xff), (BRA IMM16)'; # call
402
403	$op[0xc7 + $_ * 8] = "JMP $_ * 8" for 0..7; # rst
404
405	$op[0xc0 + $_ * 8] = 'BRA POP + POP * 256 ' . $cc[$_] for 0..7; # rcc
406	$op[0xc9] = 'JMP POP + POP * 256'; # ret
407
408	$op[0xc5] = 'PUSH $B; PUSH $C';
409	$op[0xd5] = 'PUSH $D; PUSH $E';
410	$op[0xe5] = 'PUSH $H; PUSH $L';
411	$op[0xf5] = 'PUSH $A; PUSH +($FS && 0x80) \| ($FZ && 0x40) \| ($FA && 0x10) \| ($FP && 0x04) \| ($FC && 0x01)'; # psw
412
413	$op[0xd3] = 'OUT'; # out
414	$op[0xdb] = 'IN'; # in
415
416	# e3 xthl @ 917b, hl <-> (sp)
417
418	$op[0xe9] = 'JMP $H * 256 + $L'; # pchl
419
420	$op[0xf3] = '$IFF = 0'; # DI
421	$op[0xfb] = '$IFF = 1'; # EI
422
423	@ops = @op; # for debugging #d#
424
425	#############################################################################	476	#############################################################################
		477	# debug
426		478
427	# print cpu status, for debugging	479	# print cpu status, for debugging
428	sub status {	480	sub status {
429	my $PC = shift \|\| $PC;	481	my $PC = shift \|\| $PC;
430		482
…		…
434	($FZ ? "1" : "0")	486	($FZ ? "1" : "0")
435	. ($FS ? "1" : "0")	487	. ($FS ? "1" : "0")
436	. ($FC ? "1" : "0")	488	. ($FC ? "1" : "0")
437	. ($FA ? "1" : "0")	489	. ($FA ? "1" : "0")
438	. ($FP ? "1" : "0"),	490	. ($FP ? "1" : "0"),
439	$M[$PC], $ops[$M[$PC]];	491	$M[$PC], $op[$M[$PC]];
440	}	492	}
441		493
442	#############################################################################	494	#############################################################################
		495	# video emulation
443		496
444	my @chr = (	497	binmode STDOUT;
		498
		499	my @CHARMAP = ( # acschars / chars 0..31
445	" " , "\x{29eb}", "\x{2592}", "\x{2409}",	500	" " , "\x{29eb}", "\x{2592}", "\x{2409}",
446	"\x{240c}", "\x{240d}", "\x{240a}", "\x{00b0}",	501	"\x{240c}", "\x{240d}", "\x{240a}", "\x{00b0}",
447	"\x{00b1}", "\x{2424}", "\x{240b}", "\x{2518}",	502	"\x{00b1}", "\x{2424}", "\x{240b}", "\x{2518}",
448	"\x{2510}", "\x{250c}", "\x{2514}", "\x{253c}",	503	"\x{2510}", "\x{250c}", "\x{2514}", "\x{253c}",
449	"\x{23ba}", "\x{23bb}", "\x{2500}", "\x{23bc}",	504	"\x{23ba}", "\x{23bb}", "\x{2500}", "\x{23bc}",
…		…
451	"\x{252c}", "\x{2502}", "\x{2264}", "\x{2265}",	506	"\x{252c}", "\x{2502}", "\x{2264}", "\x{2265}",
452	"\x{03c0}", "\x{2260}", "\x{00a3}", "\x{00b7}",	507	"\x{03c0}", "\x{2260}", "\x{00a3}", "\x{00b7}",
453	(map chr, 0x020 .. 0x7e),	508	(map chr, 0x020 .. 0x7e),
454	);	509	);
455		510
456	utf8::encode $_ for @chr;	511	utf8::encode $_ for @CHARMAP;
457		512
458	my @sgr; # sgr sequences for attributes	513	my @SGR; # sgr sequences for attributes
459		514
460	for (0x00 .. 0xff) {	515	for (0x00 .. 0xff) {
461	my $sgr = "";	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
462		522
463	$sgr .= ";5" unless $_ & 0x01;	523	$sgr .= ";5" unless $_ & 0x01;
464	$sgr .= ";4" unless $_ & 0x02;	524	$sgr .= ";4" unless $_ & 0x02;
465	$sgr .= ";1" unless $_ & 0x04;	525	$sgr .= ";1" unless $_ & 0x04;
466	$sgr .= ";7" if $_ & 0x80;	526	$sgr .= ";7" if $_ & 0x80;
467		527
468	$sgr[$_] = "\e[${sgr}m";	528	$SGR[$_] = "\e[${sgr}m";
469	}	529	}
470		530
471	sub prscr {	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
		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
472	my $i = 0x2000;	549	my $i = 0x2000;
473
474	my $scr = sprintf "\e[H--- KBD %08b CLK %d\e[K\n", $KSTATUS, $CLK;
475
476	$scr .= "\e[?5" . ($DC11_REVERSE ? "h" : "l");
477		550
478	line:	551	line:
479	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
480	my $prev_sgr;	553	my $prev_attr;
		554	my ($c, $attr); # declare here for speedup
481		555
482	$scr .= sprintf "%2d \|", ++$y;	556	$scr .= sprintf "%2d \xe2\x94\x82", $y;
483		557
484	for (0..139) {	558	for (0..139) {
485	my $c = $M[$i];	559	$c = $M[$i];
486		560
487	if ($c == 0x7f) { # also 0xff, but the firmware avoids that	561	if ($c == 0x7f) { # also 0xff, but the firmware avoids that
488	$scr .= "\e[m\|\e[K\n";	562	$scr .= "\e[m\xe2\x94\x82\e[K\n";
489		563
490	my $a1 = $M[$i + 1];	564	my $a1 = $M[$i + 1];
491	my $a0 = $M[$i + 2];	565	my $a0 = $M[$i + 2];
492		566
493	$i = 0x2000 + (($a1 * 256 + $a0) & 0xfff);	567	$i = 0x2000 + (($a1 * 256 + $a0) & 0xfff);
494		568
495	next line;	569	next line;
496	}	570	}
497		571
		572	$scr .= $SGR[$prev_attr = $attr]
498	my $sgr = $sgr[ ($M[$i++ + 0x1000] & 15) \| ($c & 0x80)];	573	if $prev_attr != ($attr = ($M[$i++ + 0x1000] & 15) \| ($c & 0x80));
499		574
500	# ~1 sgr 5 blink
501	# ~2 sgr 4 underline
502	# ~4 sgr 1 bold
503	# 0x80 in attr, sgr 7, reversed
504
505	$scr .= $prev_sgr = $sgr if $sgr ne $prev_sgr;
506
507	$scr .= $chr[$c & 0x7f];	575	$scr .= $CHARMAP[$c & 0x7f];
508	}	576	}
509		577
510	$scr .= "\e[K\nvideo overflow\e[K\n";	578	$scr .= "\e[K\nvideo overflow\e[K\n";
511	last;	579	last;
512	}	580	}
513		581
514	$scr .= "\e[m";	582	$scr .= "\e[m\e[J";
515
516	if (0) {
517	$scr .= "\e[K\n";
518	for my $o (0x200 .. 0x232) {
519	$scr .= sprintf "%04x:", $o * 16;
520	for (0..15) {
521	$scr .= sprintf " %02x", $M[$o * 16 + $_];
522	}
523	$scr .= "\e[K\n";
524	}
525	}
526
527	$scr .= "\e[J";
528		583
529	syswrite STDOUT, $scr;	584	syswrite STDOUT, $scr;
530	}	585	}
531		586
532	#############################################################################	587	#############################################################################
		588	# keyboard handling
533		589
534	if (@ARGV) {	590	# 0x080 shift, 0x100 ctrl
535	require IO::Pty;	591	my %KEYMAP = (
536	$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	);
537		626
538	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
539		630
540	$PTY->set_winsize (24, 80);	631	$KEYMAP{"\x1f" & $_} \|\|= $KEYMAP{$_} \| 0x100 for "a" .. "z"; # ctrl
		632	$KEYMAP{"\x20" ^ $_} \|\|= $KEYMAP{$_} \| 0x080 for "a" .. "z"; # shift
541		633
542	unless (fork) {	634	my $KEYMATCH = join "\|", map quotemeta, reverse sort keys %KEYMAP;
543	$ENV{TERM} = $VT102 ? "vt102" : "vt100";	635	$KEYMATCH = qr{^($KEYMATCH)}s;
544		636
545	close $PTY;	637	my %KMOD; # currently pressed modifier keys
546		638
547	open STDIN , "<&", $slave;	639	sub key {
548	open STDOUT, ">&", $slave;	640	my ($key) = @_;
549	open STDERR, ">&", $slave;
550		641
551	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
552		644
553	$PTY->make_slave_controlling_terminal;	645	push @KQUEUE, 0x7c if $key & 0x100 && !$KMOD{0x7c}++; # ctrl-down
554	$PTY->close_slave;	646	push @KQUEUE, 0x7d if $key & 0x080 && !$KMOD{0x7d}++; # shift-down
555		647
556	exec @ARGV;	648	$key &= 0x7f;
557	}	649	push @KQUEUE, $key, -$key;
558
559	$PTY->close_slave;
560
561	} else {
562	open $PTY, "</dev/null" or die;#d
563	}	650	}
564		651
565	#############################################################################	652	my $STDIN_BUF;
566		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	#############################################################################
567	# 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
568	@KQUEUE = (	672	@KQUEUE = (
569	0x7b, -0x7b, # setup	673	0x7b, -0x7b, # setup
570	0, # delay	674	0, # delay
571	0x28, -0x28, # 4, toggle local/online	675	0x28, -0x28, # 4, toggle local/online
572	0x38, -0x38, # 5, setup b	676	0x38, -0x38, # 5, setup b
…		…
583	0x37, -0x37, # 6 toggle wrap around	687	0x37, -0x37, # 6 toggle wrap around
584	0x7b, -0x7b, # leave setup	688	0x7b, -0x7b, # leave setup
585	);	689	);
586		690
587	#############################################################################	691	#############################################################################
		692	# process/pty management
588		693
589	# 0x080 shift, 0x100 ctrl	694	if (1) {
590	my %KEYMAP = (	695	require IO::Pty;
591	"\t" => 0x3a,	696	$PTY = IO::Pty->new;
592	"\r" => 0x64,
593	"\n" => 0x44,
594		697
595	"\x00" => 0x77 \| 0x100, # CTRL-SPACE	698	my $slave = $PTY->slave;
596	"\x1c" => 0x45 \| 0x100, # CTRL-\
597	"\x1d" => 0x14 \| 0x100, # CTRL-]
598	"\x1e" => 0x24 \| 0x100, # CTRL-~
599	"\x1f" => 0x75 \| 0x100, # CTRL-?
600		699
601	# hardcoded rxvt keys	700	$PTY->set_winsize (24, 80);
602	"\e" => 0x2a, # ESC
603	"\e[3~" => 0x03, # DC
604	"\e[5~" => 0x7e, # CAPS LOCK (prior)
605	"\e[6~" => 0x6a, # NO SCROLL (next)
606	"\e[A" => 0x30, # UP
607	"\e[B" => 0x22, # DOWN
608	"\e[C" => 0x10, # RIGHT
609	"\e[D" => 0x20, # LEFT
610	"\e[a" => 0x30 \| 0x080, # UP
611	"\e[b" => 0x22 \| 0x080, # DOWN
612	"\e[c" => 0x10 \| 0x080, # RIGHT
613	"\e[d" => 0x20 \| 0x080, # LEFT
614	"\e[7~" => 0x7b, # SETUP (home)
615	"\e[8~" => 0x23, # BREAK (end)
616	"\e[8\$" => 0x23 \| 0x080, # SHIFT BREAK / DISCONNECT (shift-end)
617	"\x7f" => 0x33, # BACKSPACE
618		701
619	"\e[11~" => 0x32, # F1	702	unless (fork) {
620	"\e[11~" => 0x42, # F2	703	$ENV{LC_ALL} = "C";
621	"\e[11~" => 0x31, # F3	704	$ENV{TERM} = $VT102 ? "vt102" : "vt100";
622	"\e[11~" => 0x41, # F4
623	);
624		705
625	@KEYMAP{map chr, 0x20..0x40} = unpack "C", pack "H",	706	close $PTY;
626	"779ad5a9a8b8a755a6b5b6b466256575" . "351a3929283837273626d656e634e5f5" . "b9";
627		707
628	@KEYMAP{map chr, 0x5b .. 0x7e} = unpack "C", pack "H",	708	open STDIN , "<&", $slave;
629	"154514b7a5" . "244a6879591949485816574746766706" . "050a185a0817780969077a95c594a4";	709	open STDOUT, ">&", $slave;
		710	open STDERR, ">&", $slave;
630		711
631	$KEYMAP{"\x1f" & $_} \|\|= $KEYMAP{$_} \| 0x100 for "a" .. "z"; # ctrl	712	system "stty ixoff erase ^H";
632	$KEYMAP{uc $_} \|\|= $KEYMAP{$_} \| 0x080 for "a" .. "z"; # shift
633		713
634	my $KEYMATCH = join "\|", map quotemeta, reverse sort keys %KEYMAP;	714	$PTY->make_slave_controlling_terminal;
635	$KEYMATCH = qr{^($KEYMATCH)}s;	715	$PTY->close_slave;
636		716
637	sub key {	717	@ARGV = "sh" unless @ARGV;
638	my ($key) = @_;	718	exec @ARGV;
		719	}
639		720
640	state %MOD;	721	$PTY->close_slave;
641		722	} else {
642	push @KQUEUE, -0x7c if !($key & 0x100) && delete $MOD{0x7c}; # ctrl-up	723	open $PTY, "+</dev/null"
643	push @KQUEUE, -0x7d if !($key & 0x080) && delete $MOD{0x7d}; # shift-up	724	or die "/dev/null: $!";
644
645	push @KQUEUE, 0x7c if $key & 0x100 && !$MOD{0x7c}++; # ctrl-down
646	push @KQUEUE, 0x7d if $key & 0x080 && !$MOD{0x7d}++; # shift-down
647
648	$key &= 0x7f;
649	push @KQUEUE, $key, -$key;
650	}	725	}
651		726
652	my $STDIN_BUF;
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";
664	eval q{ sub END { system "stty sane" } };
665	$SIG{INT} = $SIG{TERM} = $SIG{QUIT} = sub { exit 1 };
666	}
667
668	#############################################################################	727	#############################################################################
		728	# the actual hardware simulator
669		729
670	my @ICACHE; # compiled instruction cache	730	my @ICACHE; # compiled instruction/basic block cache
671		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
672	# the cpu	739	# the cpu.
673	while () {	740	while () {
674
675	# execute extended basic blocks	741	# execute an extended basic block
676	$PC = ($ICACHE[$PC] \|\|= do {	742	$PC = ($ICACHE[$PC] \|\|= do {
677	my $pc = $PC;	743	my $pc = $PC;
678		744
679	my $insn = "";	745	my $insn = "";
680		746
681	# the jit compiler	747	# the jit compiler
682	for (0..15) {	748	for (0..31) {
683
684	# optional tracing support
685	if (0) {
686	$insn .= qq<
687	if (\$PRSTATUS) {
688	status $pc;
689	die unless --\$PRSTATUS;
690	}
691	>;
692	}
693
694	my $imm;	749	my $imm;
695	my $op = $op[$M[$pc++]];	750	my $op = $op[$M[$pc++]];
696		751
697	for ($op) {	752	for ($op) {
698	s/\bPUSH\b/\$M[--\$SP] =/g; # push byte to stack	753	s/\bPUSH\b/\$M[--\$SP] =/g; # push byte to stack
…		…
703		758
704	s/\bPC\b/$pc/ge; # PC at end of insn	759	s/\bPC\b/$pc/ge; # PC at end of insn
705	s/\bBRA\b/return/g; # conditional jump	760	s/\bBRA\b/return/g; # conditional jump
706	s/\bJMP\b(.*)/$1\x00/sg; # unconditional jump	761	s/\bJMP\b(.*)/$1\x00/sg; # unconditional jump
707		762
708	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
709	s/\bOUT\b/sprintf "out_%02x \$A ", $M[$pc++]/xge;	764	s/\bOUT\b/sprintf "out_%02x \$A ", $M[$pc++]/xge; # out likewise
710	}	765	}
711		766
712	$insn .= "$op;\n";	767	$insn .= "$op;\n";
713	}	768	}
714		769
715
716	$insn .= "$pc";	770	$insn .= $pc;
717	$insn =~ s/\x00.*$//s;	771	$insn =~ s/\x00.*$//s;
718		772
719	eval "use integer; sub { $insn }" or die "$insn: $@"	773	eval "sub { $insn }" or die "$insn: $@"
720	})->();	774	})->();
721		775
722	++$CLK;	776	++$CLK;
723		777
724	# things we do from time too time only	778	# things we do from time to time only
725	unless ($CLK & 0xf) {	779	unless ($CLK & 0xf) {
726	# do I/O	780	# do I/O
727		781
728	unless ($CLK & 0x7ff) {	782	unless ($CLK & 0xfff) {
		783	if (select $x = $RIN, undef, undef, $POWERSAVE < 10 ? 0 : $CURSOR_IS_ON && 3600) {
729		784
730	# pty/serial I/O	785	# pty/serial I/O
731	unless (@PUSARTRECV \|\| @KQUEUE \|\| !$PTY) {	786	if ($PTY && (vec $x, fileno $PTY, 1) && (@PUSARTRECV < 128) && !@KQUEUE) {
732	my $rin = ""; (vec $rin, fileno $PTY, 1) = 1;
733
734	if (select $rin, undef, undef, 0) {
735	sysread $PTY, my $buf, 256;	787	sysread $PTY, my $buf, 256;
		788
		789	# linux don't do cs7 and/or parity anymore, so we need to filter
		790	# out xoff characters to avoid freezes.
736	push @PUSARTRECV, unpack "C*", $buf;	791	push @PUSARTRECV, grep { ($_ & 0x7f) != 0x13 } unpack "C*", $buf;
737	}	792	}
738	}
739		793
740	# keyboard input	794	# keyboard input
741	if ($KBD) {	795	if ($KBD && (vec $x, 0, 1)) {
		796	# to avoid non-blocking mode on stdin (and stty min 0), we
		797	# just read byte-by-byte after a select says there is data.
742	while (select my $rin = "\x01", undef, undef, 0) {	798	while (select my $rin = "\x01", undef, undef, 0) {
743	sysread STDIN, $STDIN_BUF, 1, length $STDIN_BUF	799	sysread STDIN, $STDIN_BUF, 1, length $STDIN_BUF
744	or last;	800	or last;
		801	}
		802
		803	stdin_parse if length $STDIN_BUF;
745	}	804	}
746		805
747	stdin_parse if length $STDIN_BUF;	806	$POWERSAVE = 0; # activity
		807	} elsif (@PUSARTRECV \|\| @KQUEUE) {
		808	$POWERSAVE = 0;
		809	} else {
		810	++$POWERSAVE;
748	}	811	}
749	}	812	}
750		813
751	# kick off various interrupts	814	# kick off serial input interrupt quite often
752
753	$RST \|= 2 if @PUSARTRECV && $XON; # VT100, but works on vt102, too (probably not used on real hardware though)	815	$RST \|= 2 if @PUSARTRECV && $XON; # VT100, but works on vt102, too (probably not used on real hardware though)
754	#$INTPEND \|= 2 if @PUSARTRECV && $XON; # VT102, 6.5 rxrdy	816	#$INTPEND \|= 2 if @PUSARTRECV && $XON; # VT102, 6.5 rxrdy
755		817
756	# kick off vertical retrace form time to time	818	# kick off vertical retrace interrupt from time to time
757	unless ($CLK & 0x1ff) {	819	unless ($CLK & 0x1ff) {
758	$RST \|= 4; # vertical retrace	820	$RST \|= 4; # vertical retrace
759	}	821	}
760		822
761	# handle video hardware	823	# handle video hardware
762
763	unless ($CLK & 0x1fff) {	824	unless ($CLK & 0x3fff) {
764	prscr;	825	display;
765	}	826	}
766	}	827	}
767		828
768	# the interrupt logic	829	# the interrupt logic - we only interrupt after basic blocks
769	$x = $INTPEND & ~$INTMASK;	830	# which, as a side effect, ensures that we don't interrupt
770	if (($RST \|\| $x) && $IFF) {	831	# "ei; ret" sequences and thus reduce the risk of stack overflows.
		832	if (($RST \|\| ($INTPEND & ~$INTMASK)) && $IFF) {
771	# rst 1 kbd data available	833	# rst 1 kbd data available
772	# rst 2 pusart xmit+recv flag	834	# rst 2 pusart xmit+recv flag
773	# rst 4 vertical retrace	835	# rst 4 vertical retrace
774	# 5.5 vt125 mb7 trans ready (serial send?)	836	# 5.5 vt125 mb7 trans ready (serial send?)
775	# 6.5 vt125 mb7 read ready (something modem?)	837	# 6.5 vt125 mb7 read ready (something modem?)
776	# 7.5 vt125 mb7 vblank h(?)	838	# 7.5 vt125 mb7 vblank h(?)
777	# trap vt125 mbi init h(?)	839	# trap vt125 mbi init h(?)
778	my $vec;	840	my $vec;
779		841
		842	my $pend = $INTPEND & ~$INTMASK;
		843
780	if ($x & 1) { $vec = 0x2c; $INTPEND &= ~1;	844	if ($pend & 1) { $vec = 0x2c; $INTPEND &= ~1;
781	} elsif ($x & 2) { $vec = 0x34; $INTPEND &= ~2;	845	} elsif ($pend & 2) { $vec = 0x34; $INTPEND &= ~2;
782	} elsif ($x & 4) { $vec = 0x3c; $INTPEND &= ~4;	846	} elsif ($pend & 4) { $vec = 0x3c; $INTPEND &= ~4;
783	# } elsif ($RST ) { $vec = $RST * 8; $RST = 0; # for some reason, this breaks vt102	847	# } elsif ($RST ) { $vec = $RST * 8; $RST = 0; # the vt102 firmware doesn't like combined interrupts
784	} elsif ($RST & 1) { $vec = 0x08; $RST &= ~1; # separate is better for vt102	848	} elsif ($RST & 1) { $vec = 0x08; $RST &= ~1; # separate is better for vt102
785	} elsif ($RST & 2) { $vec = 0x10; $RST &= ~2;	849	} elsif ($RST & 2) { $vec = 0x10; $RST &= ~2;
786	} elsif ($RST & 4) { $vec = 0x20; $RST &= ~4;	850	} elsif ($RST & 4) { $vec = 0x20; $RST &= ~4;
787	} else {	851	} else {
788	die;	852	die;
789	}	853	}
790		854
		855	# jump to the interrupt vector
791	$M[--$SP] = $PC >> 8;	856	$M[--$SP] = $PC >> 8;
792	$M[--$SP] = $PC & 0xff;	857	$M[--$SP] = $PC & 0xff;
793	$PC = $vec;	858	$PC = $vec;
794		859
795	$IFF = 0;	860	$IFF = 0;
796	}	861	}
797	}	862	}
		863
		864	#############################################################################
		865	# roms in the data section + one newline
		866	#
		867	# vt100 @ 0x0000+0x0800 23-032E2
		868	# vt100 @ 0x0800+0x0800 23-061E2
		869	# vt100 @ 0x1000+0x0800 23-033E2
		870	# vt100 @ 0x1800+0x0800 23-034E2
		871	#
		872	# vt102 @ 0x0000+0x2000 23-226E4
		873	# vt102 @ 0x8000+0x2000 23-225E4
		874	#
		875	# vt131 @ 0xa000+0x0800 23-280E2
		876	#
798		877
799	__DATA__	878	__DATA__
800	�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	879	�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
801	�2�!�0*� w�4ʘ> 2�!��~î!N �̓/2!! "R !�""� ��	880	�2�!�0*� w�4ʘ> 2�!��~î!N �̓/2!! "R !�""� ��
802	! �͋!2[ 2v!!�"I!>2s >�2� �B�>�2y >�2!2�!&�l"� �>@�:X!�:�!�͔>2�!�b�:�!��K>G��:\| �� !p �^!p" :�!��x��:�!� �u>�	881	! �͋!2[ 2v!!�"I!>2s >�2� �B�>�2y >�2!2�!&�l"� �>@�:X!�:�!�͔>2�!�b�:�!��K>G��:\| �� !p �^!p" :�!��x��:�!� �u>�
…		…
906		985
907	��.��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 ��Ѱ	986	��.��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 ��Ѱ
908	\lkgfa��';jhds�� .,nbx��* ��:B!��4��	987	\lkgfa��';jhds�� .,nbx��* ��:B!��4��
909	�!O!�,�ͳ��ʄ��m�Ý�	988	�!O!�,�ͳ��ʄ��m�Ý�
910	�! 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 �	989	�! 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 �
911	��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�	990	��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��!
		991	"~�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�:
		992	"�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.7 by root, Mon Dec 1 20:01:29 2014 UTC vs. Revision 1.33 by root, Wed Nov 11 16:32:21 2015 UTC

Diff Legend

Comparing vt102/vt102 (file contents):
Revision 1.7 by root, Mon Dec 1 20:01:29 2014 UTC vs.
Revision 1.33 by root, Wed Nov 11 16:32:21 2015 UTC