3406 - PDP-6 code to run the display for the 340D Datapoint emulator.

Published with permission from Stan Kugell.
2026-02-10 10:19:50 +00:00 · 2019-05-02 13:22:26 +02:00
parent eb13065977
commit b96c73e244
3 changed files with 167 additions and 0 deletions
--- a/src/stan_k/3406.40
+++ 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