From f1dc5794875b0c9261aed1bd4c2e650fda7b039c Mon Sep 17 00:00:00 2001
From: Lars Brinkhoff <lars@nocrew.org>
Date: Fri, 21 Sep 2018 12:41:44 +0200
Subject: [PATCH] GTLOAD - Load programs into GT40.

At the * prompt, type a file name and then Enter to load that file.
(Terminate with Altmode to first load the GT40LL "loader loader".
That file is currently missing.)
---
 build/misc.tcl       |   4 +
 doc/programs.md      |   1 +
 src/syseng/gtload.13 | 520 +++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 525 insertions(+)
 create mode 100755 src/syseng/gtload.13

diff --git a/build/misc.tcl b/build/misc.tcl
index ff30516b..1a56e886 100644
--- a/build/misc.tcl
+++ b/build/misc.tcl
@@ -1101,6 +1101,10 @@ expect ":KILL"
 respond "*" ":midas sys3;ts carpet_syseng;carpet\r"
 expect ":KILL"
 
+# GTLOAD, load programs into GT40.
+respond "*" ":midas sys1; ts gtload_syseng; gtload\r"
+expect ":KILL"
+
 # URUG, GT40 debugger.
 respond "*" ":palx sysbin;_sysen2;urug\r"
 respond "=YES" "1\r"
diff --git a/doc/programs.md b/doc/programs.md
index 16fc1a87..1ee2ce6b 100644
--- a/doc/programs.md
+++ b/doc/programs.md
@@ -95,6 +95,7 @@
 - GLP/XGP, queue files to be printed by GLPSPL/XGPSPL.
 - GLPDEV/XGPDEV, device for viewing GLPSPL/XGPSPL printer queues.
 - GTLEM, GT40 Lunar Lander.
+- GTLOAD, load programs into GT40.
 - GO, the Go board game.
 - GOTO, go to specified terminal line.
 - GUESS, a very silly game.
diff --git a/src/syseng/gtload.13 b/src/syseng/gtload.13
new file mode 100755
index 00000000..4af7f16d
--- /dev/null
+++ b/src/syseng/gtload.13
@@ -0,0 +1,520 @@
+	TITLE	LOADER
+
+	CHK=16
+	ERP=15
+	PPTR=14
+	C=4
+	D=11
+	CKSM=12
+	REG=13
+	F=7
+	S=10
+	SPNTR=10
+	P=6
+	PNTR=1
+	A=2
+	B=3
+	CMPTR=4
+	BCOUNT=5
+
+	O.SYMS=-100.	;GETS ADDED TO IN DEBUGGER
+
+BUFF:	BLOCK 40
+
+RCH:	MOVE	PNTR,[10700,,BUFF-1]	;INITL BYTE PNTR TO BUFF
+	MOVEM	PNTR,CMPTR
+GCHR:	PUSHJ	P,TYI	;GET CHAR
+	CAIN	A,177	;RUBOUT?
+	JRST	RUBOT
+	IDPB	A,PNTR
+	CAIN A,33
+	JRST GCHR1		;ALT MODE ALSO TERMINATES COMMAND
+	CAIE	A,15	;CR?
+	JRST	GCHR
+GCHR1:	MOVEI	A,0	;IT WAS CR
+	IDPB	A,PNTR	;MARK END OF STRNG
+CPOPJ:	POPJ	P,
+
+RUBOT:	CAMN	PNTR,[10700,,BUFF-1]	;RUBOUT AT BEG OF BUFFER?
+	JRST	BRUB
+	LDB	A,PNTR	;GET LAST CHAR TYPED
+	PUSHJ	P,TYO	;ECHO IT
+	ADD	PNTR,[70000,,]	;DECREMENT POINTER
+	JUMPGE	PNTR,GCHR	;JUMP IF VALID
+	SUB	PNTR,[430000,,1]	;WAS 440700,,SOMETHING, BACK IT UP
+	JRST	GCHR
+
+BRUB:	PUSHJ	P,CRR	;TYPE CR LF
+	JRST	GCHR
+
+TYI:	.IOT	TTI,A
+	JUMPE	A,TYI
+	CAIE	A,15
+	POPJ	P,
+	PUSHJ	P,CRR	;ECHO CR
+	MOVEI	A,15
+	POPJ	P,
+
+TYO:	.IOT	TTO,A
+	POPJ	P,
+
+SCRS:	MOVEI	A,2
+	PUSHJ	P,TYO
+CRS:	MOVEI	A,"*
+	PUSHJ	P,TYO
+CRR:	MOVEI	A,15
+	PUSHJ	P,TYO
+	MOVEI	A,12
+	JRST	TYO
+
+	LINE==1
+	TTO==1
+	TTI==2
+	DSK==3
+	ERRC==4
+
+
+BEGIN:	MOVE	P,[-100,,PLD]
+	.OPEN	TTO,STTO
+	.VALUE	0
+	.OPEN	TTI,STTI
+	.VALUE	0
+	JRST	BCMD
+
+STTO:	45,,(SIXBIT /TTY/)
+STTI:	20,,(SIXBIT /TTY/)
+STTI1:	4,,(SIXBIT /TTY/)
+
+PLD:	BLOCK	100
+
+BCMD:	CLEARM PASS		;PASS 0 - LOAD NORMAL, -1 LOAD LOADER LOADER
+	PUSHJ	P,SCRS
+	PUSHJ	P,RCH	;GET TYPED IN COMMANND
+	MOVE	PNTR,IP
+	SETZB	F,S
+COMND:	ILDB	A,CMPTR
+	CAIN	A,^Q
+	JRST	CMDQ
+	CAIN A,33		;ALT MODE TERMINATES COMMAND
+	SOSA PASS		;AND SAYS TO USE LOADER LOADER (TO AVOID CLOBBERING)
+	CAIN	A,15
+	JRST	CMDE
+	CAIN	A,^G
+	JRST	BCMD
+	CAIN	A,":
+	JRST	CMDCOL
+	CAIN	A,";
+	JRST	CMDSC
+	CAIG	A,40
+	JRST	CMDS
+SXBT:	SUBI	A,40
+	TLNE	PNTR,770000	;STOP AFTER POSITIN=0
+	IDPB	A,PNTR
+	JRST	COMND
+CMDS:	MOVE	F,S
+CMD1:	MOVE	PNTR,IP
+	MOVEI	S,0
+	JRST	COMND
+CMDSC:	MOVEM	S,SNR
+	JRST	CMD1
+CMDCOL:	JRST	CMD1	;FOR NOW IGNORE IT
+
+IP:	440600,,S
+
+CMDE:	.SUSET	[.SSNAM,,SNR]
+	JUMPE	F,FZ
+	JUMPN	S,SNZ
+FZ:	LSHC	F,36.	;MOVE S TO F AND ZERO S
+SZ:	JUMPE	F,BCMD	;TAKE IN NEW NAME
+	MOVE	S,BIN
+SNZ:	MOVEM	F,ADR+1
+	MOVEM	S,ADR+2
+PASS2:	.OPEN	DSK,ADR
+	JRST	ERROR
+	SKIPGE PASS
+	JRST LLDR		;LOAD LOADER LOADER FIRST
+LLDR1:	.OPEN	LINE,[45,,'TTY]
+	.VALUE		;SUPER-IMAGE OUT SO NO PADDING, ETC.
+	.OPEN	TTI,STTI1	;SWITCH INTO IMAGE MODE
+	.VALUE 0
+	MOVEI	A,15
+	.SLEEP	A,
+	MOVEI	PNTR,0
+	JRST	STBLK
+
+LLDR:	.CALL LLOPN
+	.VALUE
+	JRST LLDR1
+
+ERROR:	.OPEN	ERRC,ERR0
+	.VALUE	0
+ERR1:	.IOT	ERRC,A
+	CAIN	A,3
+	JRST	BCMD
+	JUMPL	A,BCMD
+	PUSHJ	P,TYO
+	JRST	ERR1
+
+PASS:	0		;0 LOAD REGULAR THING, -1 LOAD LOADER LOADER
+
+ERR0:	SIXBIT /   ERR/
+	1
+	0
+
+SNR:	0
+ADR:	2,,(SIXBIT /DSK/)
+	0
+	0
+BIN:	SIXBIT /BIN   /
+ CMDQ:	ILDB	A,CMPTR
+	JRST	SXBT
+
+BTTO:	7,,(SIXBIT /TTY/)
+
+LLOPN:	SETZ
+	SIXBIT /OPEN/
+	5000,,2
+	1000,,DSK
+	[SIXBIT /DSK/]
+	[SIXBIT /GT40LL/]
+	[SIXBIT /BIN/]
+	SETZ+[SIXBIT /GT40/]
+
+;PNTR HAS MINUS # LEFT SO ADRS(PNTR) GIVES NEXT WORD
+;WHEN IT EQUALS 0, GET NEW BLOCK. IF RETURN WITH NEG
+;POINTER, WRITE NEG 1 AS EOF CHAR
+
+GETDSK:	JUMPE	PNTR,RELOD	;NEED NEW BLOCK
+	MOVE	A,ADRS(PNTR)
+	ANDI A,377
+	AOJA	PNTR,CPOPJ	;ADD ONE AND RET URN
+RELOD:	MOVE	PNTR,DBUFP
+	.IOT	DSK,PNTR
+	JUMPL	PNTR,ENFIL
+NPNTR:	HLRE	PNTR,DBUFP	;GET MIN WRD COUNT IN PNTR
+	JRST	GETDSK
+ENFIL:	HRRZS	PNTR	;ZERO LEFT HALF TO GET NEXT ADRESS
+	SETOM	(PNTR)	;WRITE EOF CHAR
+	JRST	NPNTR
+
+DBUFP:	-50,,BUFR
+BUFR:	BLOCK	50
+	ADRS=.
+STBLK:	.IOT LINE,[175]
+	.IOT LINE,["R]
+	.IOT LINE,[175]
+	.IOT LINE,["L]
+	SETZB B,C
+STBLK4:	.RESET TTI,
+STBLK1:	PUSHJ P,GETDSK
+	CAIE A,1	;START OF BLOCK?
+	JRST STBLK1	;NOT YET
+	PUSHJ P,SEND	;YES, SEND IT
+	PUSHJ P,GETDSK	;AND THE ZERO FOLLOWING
+	PUSHJ P,SEND
+	PUSHJ P,GWRD	;GET COUNT
+	MOVE D,C
+	CAIN D,6
+	JRST STBLK2
+	SUBI D,4
+STBLK3:	PUSHJ P,GETDSK
+	PUSHJ P,SEND
+	SOJGE D,STBLK3
+	MOVEI A,TTI
+	.LISTEN A,
+	JUMPE A,STBLK1
+	.IOT TTI,A
+	CAIE A,175
+	JRST STBLK4
+	JRST BEGIN
+
+GWRD:	PUSHJ P,GETDSK
+	MOVE C,A
+	PUSHJ P,SEND
+	PUSHJ P,GETDSK
+	PUSHJ P,SEND
+	LSH A,8.
+	ADD C,A
+	POPJ P,
+
+STBLK2:	PUSHJ P,GWRD
+	PUSHJ P,GETDSK
+	PUSHJ P,SEND
+	MOVEI A,0
+	PUSHJ P,SEND
+	AOSG PASS
+	JRST PASS2		;NOW FOR THE REAL STUFF
+	.VALUE [ASCIZ /:LOGOUT 
+/]
+
+SENDCH:	TRNN F,40
+	TRO F,100
+	.IOT TTO,F
+	POPJ P,
+
+SEND:	JRST @SENDD(B)
+SENDD:	SEND1
+	SEND2
+	SEND3
+
+SEND1:	MOVE F,A
+	MOVEI S,0
+	LSHC F,-2
+	LSH S,-30.
+	AOS B
+	JRST SENDCH
+
+SEND2:	MOVE F,A
+	ANDI F,360
+	LSH F,-4
+	ADD F,S
+	MOVE S,A
+	ANDI S,17
+	LSH S,2
+	AOS B
+	JRST SENDCH
+
+SEND3:	MOVE F,A
+	LSH F,-6
+	ADD F,S
+	MOVE S,A
+	PUSHJ P,SENDCH
+	MOVE F,A
+	ANDI F,77
+	MOVEI B,0
+	JRST SENDCH
+
+
+	END BEGIN
+GSWRD:	PUSHJ	P,GETDSK
+	ANDI	A,377
+	LSHC	A,-36.	;MOVE A TO B AND ZERO A
+	SOSLE	BCOUNT	;IF CHECKSUM DON'T GET EXTRA BLOCK YET
+	PUSHJ	P,GETDSK
+	SOS	BCOUNT
+	AOSE	A	;WAS IT A NEG 1?
+	SOS	A	;IF NOT RESTORE, ELSE SEND ZERO
+	LSH	A,8.
+	ADDB	A,B
+SWORD:	ANDI	A,77
+	PUSHJ	P,SEND
+	MOVE	A,B
+	LSH	A,-6
+	ANDI	A,17
+	PUSHJ	P,SEND
+	MOVE	A,B
+	LSH	A,-10.
+	ANDI	A,77
+SEND:	JUMPL	A,FSEND	;ACTUALLY IOT THIS CRUFT
+	ADDI	A,40
+	IDPB	A,ERP
+	POPJ	P,
+FSEND:	MOVEI	F,5
+	MOVEI	A,40
+FSNDL:	IDPB	A,ERP
+	SOSLE	F
+	JRST	FSNDL
+	HRRZM	ERP,SPNTR
+	SUBI	SPNTR,EBUFF
+	MOVNS	SPNTR
+	HRLZS	SPNTR
+	HRRI	SPNTR,EBUFF
+	MOVEM	SPNTR,SPSAV
+RESEND:	.IOT	LINE,SPNTR
+	.IOT	TTI,A
+	ANDI	A,177
+	CAIN	A,4
+	POPJ	P,
+	MOVE	SPNTR,SPSAV
+	JRST	RESEND
+
+SPSAV:	0
+SYMBS:	.IOT	TTI,A
+	CAIN	A,47	;^G;I.E.DON'T SEND SYMBOLS
+	JRST	GBYE
+	CAIE	A,5
+	JRST	SYMBS	;THAT SIGNALS 11 READY FOR SYMBOLS
+	.IOT	LINE,ONEP
+SYM1:	PUSHJ	P,GETDSK
+	CAIE	A,2
+	JRST	SYM1
+	PUSHJ	P,SETUP1
+	SKIPN	FINFLG
+	PUSHJ	P,SETUPU
+	MOVEI	C,BUFF1
+	PUSHJ	P,SNDB
+	MOVEI	C,FBUFF
+	PUSHJ	P,SNDB
+GBYE:	.VALUE	[ASCIZ /:LOGOUT
+/]
+
+SETUP1:	SETZM	FINFLG
+	MOVEI	REG,R1
+	MOVEI	C,7.
+	MOVEI	B,BF1ST
+	PUSHJ	P,SETUP
+	JUMPE	C,CPOPJ
+	MOVNS	C
+	ADDI	C,17.	;SEE HOW MUCH LEFT
+	IMULI	C,6
+	ADD	C,LDAD
+	MOVEM	C,..B
+	SETOM	FINFLG
+	POPJ	P,
+
+ONEP:	-1,,ONE
+ONE:	PACK	1,40,40,40,40
+SETUPU:	MOVEI	REG,RFLGS
+	SETZM	(REG)
+	SETZM	-1(REG)
+	MOVNI	A,100.
+	ADDM	A,LDAD
+	MOVEI	C,1
+	MOVEI	B,BUFFST
+	PUSHJ	P,SETUP
+	MOVE	A,LDAD
+	MOVEM	A,..B
+	JUMPE	C,SAME
+	MOVNS	C
+	ADDI	C,17.
+	IMULI	C,6
+	ADDM	C,..B
+	SETOM	FINFLG
+SAME:	MOVEI	C,BUFF2
+	PUSHJ	P,SNDB
+	SKIPN	FINFLG
+	JRST	SETUPU
+	POPJ	P,
+SNDB:	MOVE	ERP,EBUFP
+	MOVE	BCOUNT,1(C)
+	SUBI	BCOUNT,2
+	MOVEI	CKSM,1
+STPN:	MOVEI	A,1
+	PUSHJ	P,SEND
+	MOVEI	A,0
+	PUSHJ	P,SEND
+SNDLP:	MOVE	A,1(C)
+	ADDM	A,CKSM
+	MOVEM	A,B
+	LSH	A,-8.
+	ADDM	A,CKSM
+	SUBI	BCOUNT,2
+	MOVE	A,B
+	PUSHJ	P,SWORD
+	AOS	C
+	JUMPN	BCOUNT,SNDLP
+	MOVN	A,CKSM
+	ANDI	A,377
+	MOVE	B,A
+	PUSHJ	P,SWORD
+	SETOM	A
+	PUSHJ	P,SEND	;.IOT THE BLOCK
+	POPJ	P,
+
+
+FINFLG:	0
+SBTB:	440600,,A	;SIXBIT BYTE POINTER TO A
+
+RAD50:	MOVE	PPTR,SBTB
+	PUSHJ	P,LOOP50
+	HRRZM	F,-2(B)
+	PUSHJ	P,LOOP50
+	MOVEM	F,-1(B)
+	POPJ	P,
+LOOP50:	MOVEI	F,0
+	MOVEI	BCOUNT,3
+LOP50:	ILDB	S,PPTR
+	PUSHJ	P,CNVT
+	IMULI	F,50
+	ADD	F,S
+	SOJG	BCOUNT,LOP50
+	POPJ	P,
+
+CNVT:	CAIGE	S,41
+	JRST	NOTLET
+	CAILE	S,72
+	JRST	NOTLET
+	SUBI	S,40
+	POPJ	P,
+NOTLET:	CAIN	S,4
+	JRST	DOLR
+	CAIN	S,16
+	JRST	PERD
+	CAILE	S,31
+	JRST	NOTNUM
+	CAIGE	S,20
+	JRST	NOTNUM
+	ADDI	S,16
+	POPJ	P,
+NOTNUM:	MOVEI	S,0
+	POPJ	P,
+DOLR:	MOVEI	S,33
+	POPJ	P,
+PERD:	MOVEI	S,34
+	POPJ	P,
+SETUP:	PUSHJ	P,GETDSK
+	JUMPE	A,CPOPJ
+	AOJE	A,CPOPJ
+	SOS	A
+	PUSHJ	P,RAD50		;DEPOSITS INTO MEMORY
+	PUSHJ	P,GETDSK	;VALUE THIS TIME
+	HRRZM	A,(B)
+	MOVEI	D,1
+	LSH	D,-1(C)	;SO CAN POINT TO RIGHT BIT IN FLAG
+	MOVE	S,(REG)
+	TLNE	A,4000
+	TDO	S,D
+	MOVEM	S,(REG)
+	MOVE	S,-1(REG)
+	TLNE	A,20000
+	TDO	S,D
+	MOVEM	S,-1(REG)
+	SUBI	B,3
+	AOS	C
+	CAIG	C,16.
+	JRST	SETUP
+	MOVEI	C,0
+	POPJ	P,
+BUFF1:	1
+	106.
+	O.SYMS
+	BLOCK	29.
+BF1ST:	0
+	127570	;/.C /
+	0
+	24
+	130600	;/.P /
+	0
+	10
+	130410	;/.M /
+	0
+	11
+	127520	;/.B /
+	0
+	14
+	131542	;/..B/
+	0
+..B:	0
+	127400	;/.  /
+	0
+	0
+HK1:	1
+R1:	74
+BUFF2:	1
+	106.
+LDAD:	O.SYMS
+	BLOCK	47.
+BUFFST:	0
+	0
+RFLGS:	0
+
+FBUFF:	1
+	6
+	0
+
+	CONSTANTS
+	VARIABLES
+EBUFF:	BLOCK	10000
+	-1	;TO FAKE OUT DDT'S LOADER INTO CAUSING ENOUGH MEMORY
+	END	BEGIN
+
\ No newline at end of file