From b96c73e2442a4bb8d7d63fe8931572693c256ce5 Mon Sep 17 00:00:00 2001
From: Lars Brinkhoff <lars@nocrew.org>
Date: Thu, 2 May 2019 13:22:26 +0200
Subject: [PATCH] 3406 - PDP-6 code to run the display for the 340D Datapoint
 emulator.

Published with permission from Stan Kugell.
---
 build/misc.tcl     |   4 ++
 doc/programs.md    |   1 +
 src/stan_k/3406.40 | 162 +++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 167 insertions(+)
 create mode 100644 src/stan_k/3406.40

diff --git a/build/misc.tcl b/build/misc.tcl
index 307d9a59..b9a34989 100644
--- a/build/misc.tcl
+++ b/build/misc.tcl
@@ -567,6 +567,10 @@ expect ":KILL"
 respond "*" ":midas;324 dsk0:.;@ pornis_rwg; pornis\r"
 expect ":KILL"
 
+# 3406
+respond "*" ":midas;324 dsk0:.;@ 3406_stan.k; 3406\r"
+expect ":KILL"
+
 # 340D
 respond "*" ":midas stan.k;mod11 bin_340d\r"
 expect ":KILL"
diff --git a/doc/programs.md b/doc/programs.md
index 148d2147..967334e8 100644
--- a/doc/programs.md
+++ b/doc/programs.md
@@ -5,6 +5,7 @@
 - 11SIM, PDP-11 emulator.
 - 11STNK, PDP-11 linker.
 - 20XCVT, convert TOPS-20 CSAVE file to PDUMP.
+- 3406, PDP-6 part of 340D.
 - 340D, Datapoint emulator for 340 display.
 - @, cross reference generation tool.
 - ACNVRT/MCNVRT/PCNVRT/UCNVRT, asciizer and binarator.
diff --git a/src/stan_k/3406.40 b/src/stan_k/3406.40
new file mode 100644
index 00000000..21ec9442
--- /dev/null
+++ b/src/stan_k/3406.40
@@ -0,0 +1,162 @@
+TITLE 6HACK
+A=1
+B=2
+C=3
+D=4
+CASE=5
+BPI=6
+BPO=7
+BLKOP=8
+E=9
+TICKA=10.
+	LOC 42
+	BLKO DIS,BLKOP
+	JSR BLKE
+	JSR PISS
+	.
+	JSR TICK
+
+.MLLIT==1
+LINEL==80.
+PAGEH==40.
+7WPL==<LINEL+4>/5
+6WPL==<2*LINEL+2+5>/6
+
+LOC 100
+GO:	CONO PI,10400
+	CONO DIS,100
+	CONO PI,12360
+	MOVEI TICKA,1
+	CONO 2003
+	CONO DIS,100
+	MOVE BLKOP,BLKPTS-1
+	MOVSI A,-PAGEH
+	HRROS FLAGS(A)
+	AOBJN A,.-1
+	MOVSI E,-PAGEH-2
+	JRST GOMAN1
+BLKE:	.
+	MOVE BLKOP,BLKPTS-1(E)
+	AOBJN E,.+2
+	MOVSI E,-PAGEH-2
+	JRST 12,@BLKE
+GOMAIN:	CONO DIS,21
+GOMAN1:	SETO A,	;A IS LINE TO CHECK
+NEXL:	DATAI KEYS
+	SKIPE KEYS
+	JRST KEYCAL
+	AOJ A,	;NEXT LINE
+	CAIL A,PAGEH	;IS THIS END OF LIST?
+	JRST GOMAIN	;YES, CHECK FIRST AGAIN
+	SKIPL FLAGS(A)	;NO, IS THIS ONE FLAGED?
+	JRST NEXL	;NO
+	HRRZS BPI,FLAGS(A)	;YUP, CLEAR ITS FLAG
+	SETZ CASE,	;ASSUME CASE INCORRECT
+	MOVSI BPI,440700
+	HRR BPI,FLAGS(A)	;SET UP INPUT BYTE POINTER
+	MOVE BPO,6BITBP(A)
+	HRROI D,[343434,,343433]-1
+	MOVEM D,BLKPTS(A)
+	SETO D,
+	MOVEM BPO,SAB'
+NECH:	AOJ D,
+	CAIN D,LINEL
+	JRST DONE
+	ILDB B,BPI	;READ A CHR.
+	SKIPL C,6TO7(B)	;IS THIS CHR. UPPER OR LOWER?
+	JRST LW	;ITS LOWER
+	CAIN CASE,35	;ITS UPPER, IS 340'S CASE CORRECT?
+	JRST CASER	;YUP
+	MOVEI CASE,35	;WRONG, CHANGE IT IN AC
+	JRST CASEW
+LW:	CAIN CASE,36	;IS 340 CASE 36?
+	JRST CASER	;YES, IT SHOULD BE.
+	MOVEI CASE,36	;CHANGE IT
+CASEW:	IDPB CASE,BPO	;SEND CORRECT CASE TO DISPLAY
+CASER:	IDPB C,BPO	;SEND THE CHAR.
+	TLZ C,-1
+	CAIE C,40
+	MOVEM BPO,SAB
+	JRST NECH	;NEXT CHR.
+DONE:	MOVE BPO,SAB	;RECOVER LAST NON-SPACE BP
+	MOVE C,[35]
+	IDPB C,BPO
+	MOVEI D,34	;FILLOUT CODE
+	IDPB D,BPO
+	IDPB D,BPO
+	TLNE BPO,770000
+	JRST .-2
+	MOVEI D,33
+	DPB D,BPO
+	MOVE D,BPO
+	SUB D,6BITBP(A)	;CREATE BLKO POINTER
+	SETCMI D,1(D)
+	MOVSS D
+	ADDI D,@6BITBP(A)
+	MOVEM D,BLKPTS(A)
+	JRST NEXL
+PISS:	.
+	CONI DIS,77
+	CONO DIS,221
+	JRST 12,@PISS
+TICK:	.
+	CONO 1003
+	SOJN TICKA,CJ12
+	MOVE TICKA,[<-3,,CMUNG-2>#<-1,,[370000,,]-1>]
+	XORM TICKA,ZAP
+	MOVEI TICKA,14
+CJ12:	JRST 12,@TICK
+KEYS:	0
+KEYCAL:	CONO DIS,100
+	DATAO 20,[4000,,]
+	DATAI KEYS
+	SKIPE KEYS
+	JRST .-2
+	JRST GO
+	JRST NEXL
+PAT:	BLOCK 10
+
+LOC 4000
+TOTEN:	0
+FLAGS:	REPEAT PAGEH+1,.RPCNT*7WPL+7BIT
+7BIT:	BLOCK PAGEH*7WPL
+	370000,,20016
+CMUNG:	20000,,261750
+	367137,,
+	BLOCK 10.
+6BITBP:	REPEAT PAGEH,440600,,.RPCNT*6WPL+6BIT
+6BIT:	BLOCK PAGEH*6WPL
+6TO7:	,,40
+	BLOCK 6
+	7,,63
+	BLOCK 2
+	12,,33
+	BLOCK 2
+	15,,34
+	BLOCK 16.
+	36,,34
+	37,,34
+	40,,40
+	REPEAT 31.,400000+.RPCNT+41,,.RPCNT+41
+	REPEAT 27.,400000+.RPCNT+100,,.RPCNT
+	133,,53
+	134,,52
+	135,,54
+	136,,46
+	137,,51
+	140,,66
+	REPEAT 26.,.RPCNT+141,,.RPCNT+1
+	173,,55
+	174,,62
+	175,,56
+	176,,43
+	177,,50
+	-2,,[20135,,261750
+		343434343434]-1
+BLKPTS:	BLOCK PAGEH
+ZAP:	-3,,CMUNG-2
+	CONSTA
+	VARIAB
+	LOC 41
+	JRST 100
+END
\ No newline at end of file