Trailing-Edge - PDP-10 Archives - ks10_8080_microcode - ks.mas
There are no other files named ks.mas in the archive.

;   Version 5.2 of Console Code - all of the changes between version 4.2
; and 5.2 are  noted  with a (5.2x) at the change where x identifies the
; category of change.  X can be:
;   A - Klinik fixes
;   B - Uart fixes
;   C - ?NXM fixes
;   D - PW recoding
;   E - HSB fixes
;   F - Forced reload fixes
;   G - Power fail code
;   H - Addition of comment capability
;   Also, this file (KS.MAS) consists of 6 individual M80 files which are
; separated  into  the  individual files before being assembled by CROSS.  
; These individual files  separate  the code into major divisions and for
; ease in making changes, etc.. they are all combined into on master file
; KS.MAS.  These are:
;	CONDEF.M80 - Definitions, etc.
;	CHKSMS.M80 - Prom checksums
;	HCORE.M80 -  Hardcore console stuff
;	CMDS.M80 -   Console commands
;	SUBRTN.M80 - Subroutine file
;	DR.M80 -     Disk/tape routines
;	MSG.M80 -    Message file
;	STORE.M80 -  Storage area


; Listing controls

; Symbol assignments

RAMST 	=	8192.		; First "RAM" memory address
KPAINI	=	1700.		; Value for .44 sec between WORD31 checks
KATIMX	=	35.		; Number of time in a row KA has to be the same
				; KATIMX = 14. is 6 seconds, = 35. is 15 sec
RUNFP 	=	^O300		; I/O Reg containing CPU "RUN FLOP"
TTYSW 	=	^O300		; I/O Reg for TTY front panel switches
SMSTS 	=	^O301		; I/O Reg for KS10 status bits
BOOTSW	=	^O301		; I/O Reg for hardware "BOOT" switch
CARRIER	=	^O302		; I/O Reg for reading KLINIK carrier
SMPAR 	=	^O100		; I/O Reg for enabling KS10 parity detect
RESET 	=	^O100		; I/O Reg for issueing KS10 bus reset
REFERR	=	^O101		; I/O Reg for reading mos mem refresh err flag
LIGHTS	=	^O101		; I/O Reg for writing the panel lights
DTR	=	^O101		; I/O Reg for writing the data terminal ready
R.BUSY	=	^O102		; I/O Reg for reading "MEM BUSY" or "I/O BUSY"
R.RESET	=	^O102		; I/O Reg for ready if reset went true (via AC LO)
CRMCTL	=	^O204		; I/O Reg for accessing CRAM
DIAG	=	^O205		; I/O Reg for diag function bits
CLKCTL	=	^O206		; I/O Reg for setting KS10 clk ctl bits
BUSCTL	=	^O210		; I/O Reg for KS10 bus comm.
CTYCTL	=	^O201		; I/O Reg for UART control/status
CTYDAT	=	^O200		; I/O Reg for UART data buffer
REMCTL	=	^O203		; Remote UART control register
REMDAT	=	^O202		; Remote UART data register
DTARB	=	^O114		; I/O Reg for data cycle of bus arb..
BUSARB	=	^O115		; I/O Reg for bus arbitration signals
INT2KS	=	^O116		; I/O Reg for interrupting KS-10
D2835	=	^O0		; R data bits 28-35 
D2027	=	^O1		; R data bits 20-27
D1219	=	^O2		; R data bits 12-19
D0411	=	^O3		; R data bits 04-11
D0003	=	^O103		; R data bits 0-3
A2835	=	^O103
A2027	=	^O105
A1219	=	^O107
A0411	=	^O111
A0003	=	^O113
W2835	=	^O102
W2027	=	^O104
W1219	=	^O106
W0411	=	^O110
W0003	=	^O112


BPI16	=	^O2000		; "Density/slave" default for 1600 bpi tapes
BPI8	=	^O1000		; "Density/slave" default for 800 bpi tapes
EOLCH	=	^O377		; End-of-line code
ARBRESP	=	^O20		; Bit for "BUS REQ"
TRPDEF	=	^O20		; Bit says default trap enable on
DEFLTE	=	^O174		; Bits say default: cache enable, 1msec clk ena
				; All parity on
BIT15	=	^O100000	; This is bit 15 (if you count right to left)
BT.BIT	=	1		; Bit says doing bootstrap from disk
MT.BIT	=	2		; Bit says doing bootstrap from magtape
.MODE0	=	1		; Flag says KLINIK Mode 0
.MODE1	=	2		; Flag says KLINIK Mode 1
.MODE2	=	4		; Flag says KLINIK Mode 2
.MODE3	=	^O10		; Flag says KLINIK Mode 3
.MODE4	=	^O20		; Flag says KLINIK Mode 4 (manufacturing mode)
CARRLOSS =	^O3		; Interrupt code for "KLINIK carrier loss"
KL.ACTIVE =	^O2		; Interrupt code for when KLINIK becomes active
STMSK	=	^O373		; Mask for the state light
STBIT	=	^O4		; State bit
.IN	=	^O333		; The "IN" instruction
.OUT	=	^O323		; The "OUT" instruction
.RET	=	^O311		; The "RET" instruction


Q.OUT	=	00		; Null char..stands for "quick.out"
SYNC	=	01		; Sync char for APT messages
CRCHR	=	^O15		; Carriage return
LFCHR	=	^O12		; Line feed
COMMA	=	^O54		; Ascii for comma
SEMIC	=	^O73		; (5.2H) Ascii for semi-colon
CNBCK	=	^O34		; Control-backslash
BELL	=	^O7		; A bell for when host systems give me grief
STAR	=	^O52		; A star *
QUO	=	^O42		; Double quotes "
LBSIGN	=	^O43		; Pound sign #
RPAREN	=	^O51		; Right paren )
ALT	=	^O33		; Altmode
CNTLZ	=	^O32		; Control-Z
CNTLY	=	^O31		; Control-Y ends Mode 4
CNTLU	=	^O25		; Control-U
CNTLS	=	^O23		; Control-S
CNTLQ	=	^O21		; Control-Q
CNTLO	=	^O17		; Control-O
CNTLC	=	^O3		; Control-C
RBOUT	=	^O177		; Rub-out
CCHR	=	^O103		; "C"
DCHR	=	^O104		; "D"
TAB	=	^O11		; Horizontal tab
SPACE	=	^O40		; Space
SLASH	=	^O57		; Slash "/"
BSLASH	=	^O134		; Backslash "\"
DOLLAH	=	^O44		; Dollar sign "$"
PERCNT	=	^O45		; "%"
QUES	=	^O77		; "?"
ARROW	=	^O76		; "^"
UCHR	=	^O125		; "U"
OCHR	=	^O117		; "O"
UPARR	=	^O136		; "^"
ONE	=	^O01		; "1"
TWO	=	^O02		; "2"
THREE	=	^O03		; "3"
FOUR	=	^O04		; "4"
FIVE	=	^O05		; "5"
SIX	=	^O06		; "6"
SEVEN	=	^O07		; "7"
EIGHT	=	^O70		; "8" The ascii number
NINE	=	^O71		; "9" The ascii number
TEN	=	^O12		; "10"

; Numerical assignments to generate the offsets used in computing
; device addresses from any RH base address.

P.00	=	0
P.02	=	2
P.04	=	4
P.06	=	6
P.10	=	10
P.12	=	12
P.14	=	14
P.16	=	16
P.20	=	20
P.22	=	22
P.24	=	24
P.26	=	26
P.30	=	30
P.32	=	32
P.34	=	34
P.36	=	36
P.40	=	40
P.42	=	42
P.44	=	44
P.46	=	46
D776	=	776
D772	=	772

	.RADIX 10

; Drive controller register is 776440..following commands apply
				; 7 =  Rewind
				; 11 = Drive clear
				; 25 = Erase
				; 27 = Write tape mark
 SKP.TAPE=^O31			; 31 = Space forward (skip a file)
				; 33 = Space reverse (skip a file)
				; 51 = Write check forward
				; 57 = Write check reverse
				; 61 = Write forward
 READ.TAPE=^O71			; 71 = Read forward(go!)
				; 77 = Read reverse(go!)

; Default values for checksum counts, so that assemblies with 3 proms will work

CHKSM0	=	0
CHKSM1	=	0
CHKSM2	=	0
CHKSM3	=	0


; PCHAR:  Prints a single character, which it finds in the trailing byte.
;  Clobbers accum.

	RST	1		; Go print char in trailing byte
	.BYTE	XCHR		; Char to print

; KCHAR:  Print a single character on the KLINIK line only.  Char to be
;  printed is passed as a trailing argument.

	CALL	KCHR		; Go print the character

; PLINE:  Prints a line of characters, pointer passed as trailing argument.
;  And end of line signaled by a "0" byte.

	RST	3		; Print line of chars
	.ADDR	XMS		; Buff to print

; KLINE:  Prints a line of characters, pointer passed as trailing argument
;  and end of line signaled by a "0" byte.

	CALL	KLINE		; Print line of chars
	.ADDR	XMS		; Buff to print

; INTOFF:   Executes the old "INTERNAL MODE OFF" subroutine.., but by
;  using restart instruction call, we save 30.+ bytes over "CALL INTOFF".

	RST	6		; Go exit from internal mode

; INTON:  Executes the old "INTERNAL MODE ON" subroutine.., but by using
;  restart instruction call, we save 30.+ bytes over "CALL INTON".

	RST	2		; Go set internal mode

; CLINE:  Prints a line of characters, pointer passed in (H,L),
;  and end of line signaled by a "0" byte.

	LXI	H,XMS		; Pass pointer to the characters
	CALL	CLINE		; Print line of chars

; PCRLF:  Prints carriage return-line feed.  Leaves all registers intact.

	CRLF			; Go print carriage return line feed

; SSCLK:  Issues a single KS10 clock..clobbers the accumulator.

	MVI	A,02		; Bit to set "SINGLE CLK" to KS10
	OUT	CLKCTL		; Issue the single clock

; PTAB:  Prints a tab.  Clobbers accum.

	PCHAR	TAB		; Go print a tab

; PSPACE:  Prints a " " space.  Clobbers accum.

	PCHAR	SPACE		; Go print a space

; PSLSH:  Prints a "/" slash.  Clobbers accum.

	PCHAR	SLASH		; Go print a slash

; ENDCMD:  Macro to do the right stuff at the end of a command.
;  Common code for finishing all instructions.

	RET			; Return to caller

;  Macro to read I/O Reg 301 in order to check any of the bits which
;  are readable in that register.. the bit or bits to be  checked is
;  passed  as  a  trailing arguement "DB" to a RST instruction.  The
;  execution of the restart accounts for the 2 "NOP"  time  required
;  for  the  Bus  arbitrator  to  grant the bus.  This macro returns
;  mainline with the Z-Bit set.  If the Reg 301 does !not! match the
;  trailing arg that was passed and with the Z-Bit clear if there is
;  a "true" in any of the bit positions passed...

	CALL	BUSRESP		; Do a call to execute this code
	.BYTE	XXX		; Bits to be checked

	.BYTE	ARG3 & 377
Q.1	= 	<<ARG3/400> & 1> ! <<ARG2*2> & 376>
Q.2	= 	<<ARG2/200> & 3> ! <<ARG1*4> & 374>
Q.3	= 	<<ARG1/100> & 7> ! <<ARG*10> & 370>
Q.4	= 	<ARG/40> & 17
	.BYTE	Q.1
	.BYTE	Q.2
	.BYTE	Q.3
	.BYTE	Q.4
	.RADIX 10

ARG	=	0
ARG1	=	0
NUL	=	0
Q.1	= 	<<ARG3/400> & 1> ! <<ARG2*2> & 376>
Q.2	= 	<<ARG2/200> & 3> ! <<ARG1*4> & 374> ! <2*4>
	.BYTE	Q.1
	.BYTE	ARG3 & 377
	.BYTE	Q.2
	.RADIX	10

ARG	=	0
ARG1	=	0
NUL	=	0
Q.1	= 	<<ARG3/400> & 1> ! <<ARG2*2> & 376>
Q.2	= 	<<ARG2/200> & 3> ! <<ARG1*4> & 374> ! <4*4>
	.BYTE	Q.1
	.BYTE	ARG3 & 377
	.BYTE	Q.2
	.RADIX 10
ARG	=	0
ARG1	=	0
NUL	=	0
	.BYTE	ARG3 & 377
Q.1	= 	<<ARG3/400> & 1> ! <<ARG2*2> & 376>
Q.2	= 	<<ARG2/200> & 3> ! <<ARG1*4> & 374>
	.BYTE	Q.1
	.BYTE	Q.2
	.RADIX	10

	.BYTE	^O200
	.RADIX 10

	.BYTE	<14*4>
	.RADIX 10

	.BYTE	<6*4>
	.RADIX 10

	.BYTE	<10*4>
	.RADIX 10
ARG	=	0
ARG1	=	0
NUL	=	0
	.BYTE	ARG3 & 377
Q.1	= 	<<ARG3/400> & 1> ! <<ARG2*2> & 376>
Q.2	= 	<<ARG2/200> & 3> ! <<ARG1*4> & 374> ! <16*4>
	.BYTE	Q.1
	.BYTE	Q.2
	.RADIX	10

	.BYTE	0
	.BYTE	0
	.BYTE	<12*4>
	.RADIX 10

	RST	4
	.BYTE	0

	RST	4
	.BYTE	2

	RST	4
	.BYTE	4

	RST	4
	.BYTE	6

	RST	4
	.BYTE	8
	RST	4
	.BYTE	10.

	CALL	EXAMSH		; And do exam assuming short address
	.ADDR	FOO		; Addr to be zapped passed as trailing arg
	.RADIX	10

	ANA	A		; Clr "C-Bit" for use by common code
	CALL	DEPSHT		; And do the deposit assuming short addr
	.ADDR	FOO		; Addr to be zapped passed as trailing arg
	.RADIX	10

	IN	FOO		; Read an I/O Reg
	CMA			; And always complement


	IN	FOO		; Read desired UART status
	ANI	01		; Check if set?  Zbit=0/1 ready/not yet ready
	.RADIX	10

	LXI	H,200. * ARG	; Set up the timing count in H,L Reg
	CALL	LTLOOP		; And go delay about 1 sec for each (300 count)

; Macro to  save  space  on  operations  that  want to clear a location in
; the RAM.. eliminates every XRA/STA pair, and inserts instead an RST/byte
; pair.. At best, an XRA and an STA are eliminated. at worst, a 3 byte STA
; is replaced with a 2 byte RST/byte.

	OFFSET= XX - ^O20000
	RST	5
	.ERROR	OFFSET,		; Byte out of range on CLRB macro


CHKSM0	=	-^O57726
CHKSM1	=	-^O37161
CHKSM2	=	-^O17621
CHKSM3	=	-^O174562



; At power up, always begin at 0000

	.=	0000
	NOP			; No-ops for 2 instr cycles
	NOP			; Lets 8080 settle down
	DI			; Guarantee interrupts disabled
	JMP	PWRUP		; Begin with initialization code

; *** Reserve "RESTART" memory blocks for interrupts
; *** And special purpose "RST" instructions
; Begin code for "PCHAR" with a "RST 1"

	.=	^O10
	XTHL			; Get pointer to trailing arg
	MOV	A,M		; Char into accum
	INX	H		; Update pointer to return address
	XTHL			; Restore return address to stack
	JMP	PCHR		; And go....

; *** Reserve "RESTART" memory blocks for interrupts
; *** And special purpose "RST" instructions
; Subroutine to set internal status (i.e. don't type on TTY)

	.=	^O20
INTON:	PUSH	H		; Save the lil bugger
	LXI	H,NOPNT		; Get value of flag
	INR	M		; Increment by one
	POP	H		; Restore the reg we saved
	RET			; And return

; *** Reserve "RESTART" memory blocks for interrupts
; *** And special purpose "RST" instructions
; Begin code for "PLINE"

	.=	^O30
	XTHL			; Get pntr to trailing arg
	MOV	E,M		; Get lo order piece
	INX	H		; Update pntr
	MOV	D,M		; Get hi order piece
	INX	H		; Update pntr
	JMP	PLNE		; And go to actual routine
; *** Reserve "RESTART" memory blocks for interrupts
; *** And special purpose "RST" instructions
; Begin code for "TRAP" or "UUO" type subroutine calls

	.=	^O40
	XTHL			; Save "H,L" while getting PC
	MOV	A,M		; Get index into subroutine dispatch list
	INX	H		; Update "PC" to point at return
	XTHL			; Put back return and restore "H,L"
	PUSH	H		; Now save "H,L" while we set up dispatch
	JMP	RTNDIS		; Go calculate subroutine to dispatch to..

; *** Reserve "RESTART" memory blocks for interrupts
; *** And special purpose "RST" instructions
; This code clears a single byte of RAM space, in the range from 20000-20377

	.=	^O50
	XTHL			; Save "H,L" while getting PC
	MOV	A,M		; Get index into subroutine dispatch list
	INX	H		; Update "PC" to point at return
	XTHL			; Put back return and restore "H,L"
	PUSH	H		; Now save "H,L" while we set up dispatch
	JMP	CLRBYT		; Go calculate subroutine to dispatch to..

; *** Reserve "RESTART" memory blocks for interrupts
; *** And special purpose "RST" instructions
; This code executes the "internal mode off" function, turning off
; the printing of 8080 functions executed internally.  "INTOFF" is
; called at least 15 times, so this restart code saves at least 30
; bytes over "CALLS INTOFF".

	.=	^O60
	PUSH	H		; Save the lil bugger
	LXI	H,NOPNT		; Clear accum
	DCR	M		; Decrement print flag
	POP	H		; Restore the reg we saved
	RET			; And return

; *** Reserve "RESTART" memory blocks for interrupts
; *** And special purpose "RST" instructions
; Begin code for handling interrupts

	.=	^O70
	DI			; Guarantee interrupts disabled
	PUSH	PSW		; Save
	PUSH	B		;  everything
	PUSH	D		;   on the stack

	JMP	INTRP		; And go to process the interrupt...


; Mainline code begins here

	.=	^O100

; Begin by setting up 8080 stack pointer

PWRUP:	LXI	SP,RAMST+^O2000 ; Load stack pntr with top RAM loc

; Must set dispatch list and clear RAM

	LXI	H,RAMST		; Set "H,L" Register to RAM Start Addr
	LXI	D,^O2000	; Counter to fill rest of RAM with 0's

CLRLP:	MVI	M,00		; Clear a RAM loc
	INX	H		; Next RAM location
	DCX	D		; Down counter
	MOV	A,E		; Lo order piece to accum
	ORA	D		; Throw in the hi order piece
	JNZ	CLRLP		; Continue till done

; Begin proceedure  for  initializing KS10.  Must individually clear
; KS10 flops "RUN","EXECUTE",& "CONTINUE" because they are not reset
; by KS10 bus reset.

	XRA	A		; Set accum=0

; Set 0's to "RUN,EXECUTE,CONT"

	OUT	CPUCTL		; ***** I/O WRT 212/0 *****

; Issue KS10 bus reset

	CALL	MRINT		; Does reset and sets default parity & traps


; RAM buffers have been initialized..  Now must read front panel
; switches & initialize "UART".

	IN	TTYSW		; ***** I/O Read 300Q *****
	CMA			; Fix inversion

	LXI	B,^O2200	; This sets B=^O4 and C=^O200
	MOV	H,A		; H will hold cty stop bit for us. @bit pos 7
	RAR			; Bit 4 moves to bit 3
	RAR			; Bit moves to bit 2
	MOV	E,A		; E will hold KLINIK length bit. @bit pos 2
	RAR			; Bit 6 is at 4 from other shifts, now to bit 3
	RAR			;  and to bit 2
	MOV	L,A		; L will hold cty length bit. @bit pos 2
	MOV	A,H		; Original back to accum
	RAL			; Bit 5 to bit 6
	RAL			; And to bit 7
	MOV	D,A		; D will hold KLINIK stop bit. @bit pos 7

; Now begin masking operations to isolate the desired UART bit settings

	MOV	A,C		; Mask of octal 200 into accum
	ANA	H		; Accum has only cty stop bit
	MOV	H,A		; Copy back to H
	MOV	A,C		; Mask to accum
	ANA	D		; Accum has only a stop bit
	MOV	D,A		; Copy back to D

; Now mask for the length bits

	MOV	A,B		; Mask of octal 4 into accum
	ANA	L		; Accum now has cty length bit only
	ORA	H		; Throw in the cty stop bit
	ORI	^B01001010	; Add in the constant bits
	OUT	CTYCTL		; Set the UART mode..........

; Now set mode for the KLINIK stuff

	MOV	A,B		; Mask of octal 4 into accum
	ANA	E		; Accum now has KLINIK length bit only
	ORA	D		; Throw in the KLINIK stop bit
	ORI	^B01001010	; Add in the constant bits
; Now enable the UART to receive and transmit

	MVI	A,^B00010101	; Bits for UART control

; Set UART to receive and transmit

	OUT	CTYCTL		; ***** I/O WRT 200/025 *****

	MVI	A,^O20		; One bit to say reset the UART
	OUT	REMCTL		; Reset the KLINIK UART but do not enable it!!

	IN	CTYDAT		; ** I/O RD 201** read 1 dummy char out of UART
	IN	REMDAT		; ** I/O RD 203** read 1 dummy char out of UART

	CALL	BFRST		; Init tty input buffer


; Code to compute a checksum for each of the 2k 8080 prom pieces.  First
; compute  the  checksums for each prom, then do simple test on the 8080
; Ram..  Begin with the proms.

	LXI	H,00		; Start at prom address 0
LCHKR:	XRA	A		; Clear accum
	MOV	C,A		; Clear B,C pair
	MOV	B,A		; "B,C" to be used as addend
	MOV	E,A		; Clear D,E pair
	MOV	D,A		; "D,E" to hold current count of checksum

A256:	MOV	C,M		; Get a byte
	INX	H		; Update mem pointer
	XCHG			; Put current checksum sub total into H,L
	DAD	B		; Throw in an addend
	XCHG			; Return H,L to rightful place

; Now quick check for the end of prom

	MOV	A,L		; Get lo order of current prom address
	ANA	A		; Set condition codes
	JNZ	A256		; If = 0, we've done 256 locs, if # 0, do more

; Fall to here when done a chunk of 256..see if its on a prom boundary now

	MOV	A,H		; Get hi order piece of address
	ANI	^O7		; If this .eq. 0, then we are at a boundary
	JNZ	A256		; If .ne 0, then keep trying

; Fall thru here when we've completed a proms worth

	MOV	A,H		; Get hi order (corresponds to "which prom")
	RRC			; Justify at edge of the accum
	DCR	A		; Decrement makes "0-3" instead of "1-4"
	ADD	A		; Double this value to make it on 16 byte boundaries

	PUSH	PSW		; Save this value for a bit
	PUSH	H		; And save our current pointer
	JNZ	DEV		; If doing Prom 0, eliminate actual checksum cnt

; Fell thru to here to do actual checksum elimination executed when
; checksumming Prom 0.  It removes  the actual checksum values from 
; the  computed  checksum, as we cannot solve the checksum feedback
; loop problem.

	PUSH	PSW		; Save accum
	LXI	H,CHECKS	; H,L gets a pointer to the list of checksums
	MVI	A,8.		; Start with a count of 8, for the eight bytes we must sub
DEVLP:	STA	T80DT		; Save count in RAM, so we can use accum
	MVI	B,^O377		; In B,C pair, ensure upper half .eq. -1
	MOV	A,M		; Get checksum byte to accum
	CMA			; Negate it
	MOV	C,A		; Throw it into a 16 bit entity
	INX	B		; And make B,C pair 2's complement

	XCHG			; Get current computed checksum to H,L
	DAD	B		; "Subtract" the byte assembled. (2's comp addition)
	XCHG			; Put H,L/D,E pair right
	INX	H		; And update the pointer into the list
	LDA	T80DT		; Get our current count from the RAM
	DCR	A		; Decrement
	JNZ	DEVLP		; Continue in the loop

	LXI	B,00		; Now guarantee B,C pair is all gone
; Fall thru when finished

	POP	PSW		; Restore accum

DEV:	MOV	C,A		; Get current prom number into C
	LXI	H,CHECKS	; H,L points to the table of checksum
	DAD	B		; Add index, and now (M) points to expected checksum
	MOV	C,M		; Copy expected checksum into C
	MOV	B,M		; And B, makes "B,C" pair
	INX	H		; And keep count up

; Now D,E has calculated checksum and B,C has expected checksum

	XCHG			; H,L now has calculated checksum
	DAD	B		; If checksum ok, result of this should .eq. 0
	MOV	A,L		; Get lo piece
	ORA	H		; Throw in hi piece..condition code flags
				;   are now set

	XCHG			; D,E now has the results of the addition
	POP	H		; Before jumping on condition codes, first
				;   fix register
	JNZ	CHKERR		; If H,L non-0, then had prom checksum error...

; Fall thru if checksum was ok

	POP	PSW		; Restore index into "which prom" we are in
	CPI	6		; See if done all
	JNZ	LCHKR		; Jump back to beginning if not done all

; Fall thru if done all..proms checksum ok

	JMP	XXX230		; So avoid the error printout code

; You jumped to here if you encountered a checksum error.

ROMMSG:	.ASCIZ	/?CHK/		; If prom checksum fails, use this message
	POP	PSW		; Retrieve prom number
	RRC			; Divide down, since we doubled it before
	INR	A		; Make prom type-out be 1-4
	ORI	^O60		; Make it ascii
	CALL	PCHR		; Go print it
	PCRLF			; <CR-LF>

; Final step is to enable parity detection in the KS10.
; Default is:  Parity detection on.. Data path parity detection enabled

XXX230:	MVI	A,DEFLTE	; Init enables to be on
	OUT	SMPAR		; ***** I/O WRT 100/174 *****

; Little  routine  to  load all default constants into the 8080 RAM.
; This routine saves about 40. bytes of prom, over using LXI's,SHLD's
; MVI's & STA's.

	LXI	H,KATIM1	; List of destination locations begins here
	LXI	D,PRMLST	; List of datums for the RAM init
RAMMER:	LDAX	D		; Get byte from the data list
	CPI	^O252		; Test for end of list
	JZ	XXX235		; Continue prom init

; Else more RAM to initialize

	MOV	M,A		; Put good stuff in RAM
	INX	H		; Update pointers

	.ADDR	KPAINI		; KATIM1(2) keep alive initial counter
.IIF	DF,SCECOD, .BYTE -1	; For SCE adr init
.IIF	DF,SCECOD, .BYTE -1	; For SCE adr init
	.ADDR	MODE0		; MODDIS(2) init the KLINIK line to Mode 0
	.ADDR	REINI		; Normal instr ends will go to reinit
	.ADDR	ENVBUF		; Envpnt(2) apt pnter for envelopes sent to the host
	.BYTE	DEFLTE		; PARBT(1) init enables to be on
	.BYTE	TRPDEF		; TRAPEN(1) init enables the hardware traps
	.BYTE	^O14		; MTAUBA(1) default magtape UBA number is "3"
	.BYTE	^O4		; DSKUBA(1) default disk UBA number is "1"
	.BYTE	^O10		; STATE(1) state begins with DTR true
	.BYTE	^O41		; LSTMSG(1) first APT msg should be 136 (not of 41)
	 D 0,0,,2,0		; DEN.SLV(5) get default value for all tapes
.MTBASE: D 0,0,,772,440		; MTBASE(5) initial default MTA RHBASE address
.DSBASE: D 0,0,,776,700		; DSBASE(5) initial default DSK RHBASE address
	.BYTE	-1		; RPINI(1) so can make it -1
	.BYTE	^O252		; End of list marker

XXX235:	MVI	A,^O25		; Bit to reset the UART
	OUT	REMCTL		; Reset the KLINIK UART and enable it!!
	MVI	A,^O10		; Get a bit to set "DATA TERMINAL READY"
	OUT	DTR		; Set it.

	PLINE	INIMS		; Print version and id
	INTON			; Set internal mode

; Clear ?NXM if this bit is currently set for some reason

	XRA	A		; (5.2C) Clr accum
	OUT	BUSCTL		; (5.2C) *** I/O WRT 210/0 *** clr nxm bit
	CALL	EM1		; Do pseudo examine to set mem latches
	CALL	EBCMD		; Examine the bus, to see if zero
	EI			; Enable interrupts

	CALL	CMP36		; Now check results of the "EB" cmd
	.ADDR	EMBUF		; The results read from the bus
	.ADDR	MAD000		; Versus a word of all zeroes

	JZ	PWRCHK		; If ok, go to auto boot

; Fall thru if errors encountered

	INTOFF			; Leave internal mode
	PLINE	INIER		; Say "initialize error"
	JMP	REINI		; And go out

;(5.2G) This code was for handling power fail restart - with battery
; backup.  Since there is no battery backup any more, it is taken out.
; Jump to here if doing pwr fail restart
;PWR.FAIL: CALL	MICROP		; Read in pointers and ready to go
;	JC	C.BTERR		; If bombed, give up
;	CALL	DMEM2CRAM	; Go readin the micro-code
;	CALL	BT.GO		; Start micro-code
;	CLRRM	TMPBF2		; Clear a buffer
;	MVI	M,^O70		; Power fail start address is "70"
;	MVI	A,4		; Code 4 indicates pwr fail
;	STA	GOCODE		; Save in restart indicator
;	CALL	STINT		; Go start machine, use internal mode
;	JMP	REINI		; And go let things happen

;(5.2G) Since power fail restart (recovery) is no longer supported by
; this  code, there  is  no reason to read the mem status register to 
; determine if the memory  contents are still valid.  So this section
; is deleted.
; First thing to do is to check if this is a power fail restart.
; Note: we are still in "internal" mode here..things won't print.
;PWRCHK:CLRRM	IOAD		; Clear a buffer..we will generate a "100000"
;	INX	H		; CLRRM passes pntr..we make it "IOAD+1"
;	MVI	M,^O200		; Set bit that makes it "100000"
;	CALL	EI1		; Go examine I/O address - read Mem Stat Reg

PWRCHK:	INTOFF			; (5.2G - label moved) Clear internal mode

SYSUP:	MVI	C,150.		; Now do an auto boot sequence
SYSUP1:	LXI	H,25.		; Will do a delay loop
	CALL	LTLOOP		; By hand, by-passing usual macro generation

	LDA	RPEND		; See if a char was typed to end the auto boot
	ANA	A		; Set condition flags
	JNZ	REINI		; If a char was typed, no auto stuff, go null job
; While we haven't got anything to do, might as well check boot switch
; to see if that got pushed while we were sitting here.

	IN	BOOTSW		; ***** I/O RD/301 *****
	ANI	2		; "Boot" button pushed is "true .lo."
	JZ	N0.5		; So, if results = Z-Bit, then button pushed

	IN	^O102		; Read and see if "AC PWR LO" happened
	ANI	^O100		; Check the reset signal
	JZ	0000		; Its true .LO., so if true, restart machine

; Fall through if no boot button pushed

	DCR	C		; Still timing out.. wait longer
	JNZ	SYSUP1		; Back while waiting

; Now see if need auto boot, or power fail recovery..

;(5.2G) This code handles power fail recovery - it checks the power saved
; bit in mem stat register to see if the memory is still valid.  It is
; taken out
;	LDA	EMBUF+2		; Fetch up bits 12-19
;	ANI	^O200		; Check the pwr saved bit
;	JZ	PWR.FAIL	; If bit set, go try a power fail recovery

; Fell through if this must be an auto boot sequence

	CALL	BTAUT		; Call the boot


REINI:	LXI	SP,RAMST+^O2000	; Reset stack pointer to re-init
	CLRB	EOL		; Guarantee end-of-line cntr reset
	CLRB	ERRCD		; Clear current error code
	CLRB	ERRCD+1		; Clear current error code
	CLRB	RPTON		; Always clear the repeat flag
	CLRB	NOPNT		; Clr the "no print" flag
	LXI	H,RPINI		; Get pointer to buffer where we save the
	SHLD	RPLST		;   command dispatch addresses.used by repeat
	LXI	H,REINI		; If got here, it is safe to guarantee that
				;    you always get here
	SHLD	NOREND		; Pass reinit location to normal end dispatch
	CALL	BFRST		; Reset tty input buffer
	EI			; Make sure that bombs restore the interrupts

	LDA	USRMD		; Grab user mode flag
	ANA	A		; Set condition codes
	JNZ	NULLJ		; If user mode, no prompts, no CR-LF, nothing

	LDA	MMFLG		; If MM mode we will print no prompts
	ANA	A		; Set 8080 flags
	JNZ	NULLJ		; Skip prompt if MM

	PCRLF			; Start fresh with CR-LF
	PLINE	KSPRMT		; Prompt is "KS10>"

; Here begins the null state loop....   Check front panel boot switch.

NULLJ:	LXI	H,DCODE		; NULLJ job processes commands on "end-of-line"
NULLW:	IN	^O102		; Read and see if "AC PWR LO" happened
	ANI	^O100		; Check the reset signal
	JZ	0000		; Its true .lo., so if true, restart machine

	IN	^O302		; Read the state of the KLINIK switches
	CMA			; Fix the hardware inversion
	MOV	C,A		; Save results of read in reg "C"
	ANI	^O14		; Off all but the 2 KLINIK bits
	RRC			; Justify "word-wise"
	MOV	B,A		; Save the KLINIK bits for a sec.
	LDA	KLNKSW		; Get the current KLINIK switch state
	CMP	B		; See if KLINIK switch changed since last time
	PUSH	H		; Save H,L  it has our dispatch address
	CNZ	KLNKLT		; If compare # 0, then we must change lights
	POP	H		; Retrieve H,L so we have the real dispatch

; Ok, now see if we are watching carrier from the KLINIK line, and if
; we are, see if it has gone away.. If KLINIK carrier goes away for 2
; seconds, then we will hangup the line.

	MOV	A,C		; Get state of the carrier into accum
	ANI	1		; See if it is set
	JZ	N00		; If there is no carrier, then see if we care

; Carrier was true if we got here, set flag saying that we must watch 
; If it decides to go away on us

	STA	WATCHC		; Set flag saying watch the KLINIK
	JMP	N0		; And proceed with the null job

; Got here if carrier was false, see if we care

N00:	LDA	WATCHC		; Fetch up the "watch" flag
	ANA	A		; Set flags
	JZ	N0		; We don't care, jump

; Carrier went away on us. wait 2 seconds, if still gone, hang em up

	PUSH	H		; Best save dispatcher type address
	LONG.DELAY 2		; Wait 2 seconds
	IN	CARRIER		; ***** I/O RD 302 *****
	ANI	1		; See if true(low) or false(high)
	CNZ	KILL.KLINIK	; (5.2A) Still false (high), hangup the line
	POP	H		; Now restore
	CLRB	WATCHC		; And say to leave this alone for a while
; Else fall thru cause all ok

N0:	IN	BOOTSW		; ***** I/O READ 301 *****
	ANI	2		; BOOT SW set? (true lo, because of inversion)
	JNZ	N1		; Skip next instr if false(i.e high)

N0.5:	CALL	BOOT		; Otherwise...go to boot command
	JMP	NULLJ		; After boot, all tty input waits are killed

; Continue null state status check.
; Check for system parity errors.

N1:	IN	BOOTSW		; ***** I/O RD 301 *****
	ANI	^O10		; Is parity err signal set(true .lo.)
	JNZ	NX2		; Skip next instr if not set

; If yes set, must check the parity error

	LDA	CHKPAR		; Get flag to see if should report parity errors
	ANA	A		; Set flags
	JNZ	RPTPAR		; If not zero, must go report parity error
	JMP	N2		; And continue else

NX2:	CMA			; If here, set accum  .eq. -1
	STA	CHKPAR		; And set flag to say report parity err
; Continue null state status checks
; Check to see if run flop has died

N2:	IN	RUNFP		; ;***** I/O READ 300Q *****
	ANI	^O10		; Is halt loop set? (true .lo.)
	JNZ	NX3		; CPU running - continue

; Fall thru if halt loop set..

	LDA	CHKHLT		; Get the flag that says if we shld chk halt
	ANA	A		; Set condition codes
	PUSH	PSW		; Save flags for later use
	CNZ	HLTCM		; If flag set, go report the halt
	POP	PSW		; Get flags back
	JNZ	CHKKA		; If you just halted, go see if reload request
	JMP	N3		; If clr, no need to report..they know

; This and the "CONTINUE" code is the only code in the console that sets
; the "CHECK HALT" flag..  And  you can only get here if the "HALT LOOP"
; flag has been cleared, by any means.  And when you get here, the accum
; must be zero.

NX3:	CMA			; Set accum = -1
	STA	CHKHLT		; And zap the check halt flag..

; Continue null state status checks.
; Check to see if MOS memory refresh cycle has died.

N3:	IN	REFERR		; Read refresh error bit
	ANI	01		; Refresh error true? (true .lo.)
	JNZ	NX4		; Skip following code if no refresh error

; Fall into this if a refresh error occurs

	LDA	CHKREF		; Get flag that says check refresh
				;  ..see if should be reported
	ANA	A		; Set 8080 flags
	PUSH	H		; Save dispatching address
	CNZ	NOREFRESH	; Go report refresh error if necessary
	POP	H		; Restore dispatch address
	JMP	N4		; And continue as if nothing happened
; This is the only code that can set the "report refresh error flag"

NX4:	CMA			; You got here on a JZ, so accum must be zero
	STA	CHKREF		; And set flag to -1

; Continue null state status check
; Check for "end-of-line" or a running 10's "Keep-Alive"

N4:	LDA	USRMD		; Is this user mode?
	ANA	A		; Set condition flags
	JNZ	LIVE10		; If yes, check 10 interrupts & keep alive

; Before doing another command - see if we are enveloping
; and must send out a packet.

	LDA	CSLMODE		; Only do envelope stuff if in Mode 4 or greater
	CPI	.MODE4		; Check if Mode 4
	JNZ	EOL.LK		; Not Mode 4, proceed as normal

	PUSH	H		; Save H,L - it has the dispatch address
	CALL	DECNET		; If something there, send it out
	POP	H		; Need H,L again

; Otherwise, CTY's EOL flag.
; But first see if this is a repeat.

EOL.LK:	LDA	RPTON		; Get the repeat flag
	ANA	A		; Set the processor flags
	JNZ	RPTRTN		; Go back to repeat function so that he can proceed

	LDA	EOL		; Get value of EOL flag
	ORA	A		; Set EOL set?
	JZ	NULLW		; Remain in null job loop if not set

; Else go process a command

	PCHL			; Return to command in tty input, or decode


DCODE:	XRA	A		; Zero out the accum
	MOV	B,A		; And zero out tmp location

	LXI	D,CMDLST	; "D,E" now points to cmd list character pairs
	LHLD	FIRST		; "H,L" now points to first char typed as cmd
	CALL	FNDARG		; First go clr any leading spaces or tabs
				;   from cmd line
	JC	NORML		; If at end-of-command, its a null command

; Now begins command look up loop... "H,L" points to first command char.
; While "D,E" points to first char in the list of allowable commands.

DCODL:	LDAX	D		; Cmd list char to accum
	ORA	A		; Is this a zero byte?
	JZ	NXMDC		; If yes, end of list
	INX	D		; While you are at it update cmd list pntr

	CMP	M		; Compare cmd list char with typed char.
	JZ	MTCH1		; If they match, br to "MTCH1"

; Here if no match..  Update cmd list pntr to start of next command,
; then check if tried entire list yet.  If tried entire list, report
; command error and back to null job loop.  If not tried entire list
; yet, loop back and try some more.

MISS2:	INX	D		; Bump pntr past second char of cmd
	INX	D		; Bump past the dispatch addr
	INR	B		; Update number of "tries"
	JMP	DCODL		; If not, jump back and try again

; If fall to here, was illegal command.. clear rest of line up to eol...
; Type error messsage and back to null job loop.  First step is clearing
; bad command from command buffer.

NXMDC:	PLINE	CMDNG		; Command no good

	JMP	MMERR		; And back to prompt..


; Code entered from the null job loop whenever we are in user mode
; (Mode 3).  Code  checks  to see if char is available from the 10
; and also if keep alive count is active. We also check for reboot
; requests (as in 20 system monitor's "BUGHALTS").

LIVE10:	IN	SMSTS		; See if interrupt from the 10 is pending
	ANA	A		; Set condition codes
	PUSH	PSW		; Save flags for a little bit
	CP	CHRRDY		; If plus, a character is ready, go process

; First, we only want to check the keep-alive counter every second.
; First we will check our counters and see if time to check keep-alive data

	POP	PSW		; Get flags back
	CP	FAKLIT		; If typed a char, then down count for time wasted
	JZ	CHKKA		; If zero, do what must be done

	CALL	DTIME		; Always do it at least once
	JNZ	NULLJ		; If not zero, it hasn't been a second yet. back null

; When you fall to here, it is time to check for "keep-alive" or "reload"

CHKKA:	LXI	H,KPAINI	; First we must reset our major loop counter
	SHLD	KATIM1		; Each num in this loc .eq. .444 seconds between checks

	INTON			; Don't print this crud
	DI			; No interrupts
	EXAM	31		; Mos memory loc 31 has the information
	EI			; Ok..interrupts

	INTOFF			; Internal mode off now
	LDA	EMBUF+3		; Grab the reload bits.. we certainly need those
	RAL			; "Forced reload" shift into carry
	JC	FRELOAD		; If "reload" set, go execute a reload

; Now see if keep-alive active

	RAL			; "Keep-alive" bit into the C-Bit
	JNC	NULLJ		; If its not set, go back to null job
; Keeping a watch on the keep alive count...blinky lights

	LDA	STATE		; Get current state of the lights
	MOV	D,A		; Save it just for a little bit
	ANI	STMSK		; Clr the "state" light from current selections
	MOV	E,A		; And now save this little bit in a register

	MOV	A,D		; Get back the original "state"
	CMA			; "Blink"
	ANI	STBIT		; Only want to blink the single light
	ORA	E		; Throw in the part that is as was..
	STA	STATE		; Put whole mess back, null loop will blinky
	OUT	LIGHTS		; Blink the lights here
	JM	NULLJ		; And if minus, we are "shutting down", let lights go

; We did an exam 31 a very short time ago, so the examine buffer
; should still have a valid "keep-alive" update count in it.

	LXI	H,KACNTR	; Get pointer to the previous "KA" count
	LDA	EMBUF+1		; Get what should be an updated "KA" count
	CMP	M		; Compare..better be different
	JZ	DIEING		; If same, go see if cpu is really dieing

; Fall thru if the counts were different.. Save the new count.

	MOV	M,A		; New count goes to RAM, overwrites the old
	CLRB	DIECNT		; Clear that die count
	JMP	NULLJ		; Back to the null loop

; Routine for when doing cty output the lights still blink at
; a reasonable rate.

FAKLIT:	LHLD	KATIM1		; Get current count for between the lights
	MOV	A,L		; Get lo order piece
	ANI	^O374		; Tweek lite count, cause typing messed up timer loop
	MOV	L,A		; Put lo order piece back (masking equiv to sub 100)
	JMP	DTM1		; And proceed

; Routine to down count keep alive counter

DTIME:	LHLD	KATIM1		; Get a 16-bit minor loop counter
	DCX	H		; Decrement the counter
DTM1:	SHLD	KATIM1		; And put it back
	MOV	A,L		; Now check the count for .eq. 0
	ORA	H		; "Or" hi piece with the "lo" piece
; Routine to entered when the "force reload" bit has been set by a running
; program in the KS10.

FRELOAD:CLRB	NOPNT		; Clear the no print flag
	PLINE	FRCMSG		; Print message to indicate the forced reload
	MVI	A,2		; Bit 34 is the appropriate guy on a forced reload
	STA	GOCODE		; Set bit in the 8080 RAM buffer
	IN	RUNFP		; Now see if we must halt the processor
	ANI	^O10		; We did not invert signal. 0=halted, 1=running

	INTON			; Don't print what happens to the halt
	CNZ	HACMD		; Make sure the processor is stopped
	INTOFF			; Ok to print now
	LDA	SECRET		; Secret location
	ANA	A		; Set 8080 flags
	JNZ	REINI		; If flag set, we will not do auto reloads

	LXI	D,^O1004	; Pointer to the monitor pre-boot
	CALL	FILEINIT	; Go read in the monitor pre-boot
	 JC	L.BTERR		; If error, fatal out

	LXI	H,1		; No err, now go start the micro-code at loc 1
	CALL	SM1.5		; Start microcode, address passed in H,L
	LONG.DELAY 2		; Guarantee that the "SM 1" has time to finish
	CALL	BT.GO1		; Now fix parity and other things that we broke
	CALL	INFOBT		; And pass the source of the pre-boot in mos mem

	LXI	H,HSBFL1	; (5.2F) Set "H,L" Register to special HSB flag
	MVI	M,4		; (5.2F) Set to 4 ("RUN")
	INX	H		; (5.2E) Point to next HSB flag
	MVI	M,1		; (5.2E) Set to 1 ("CONTINUE")
	CALL	LB.GO1		; And go execute the boot code
	JMP	NULLJ		; And back to null job

DIEING:	LXI	H,DIECNT	; Get number of consecutive "no changes" in KA cnt
	INR	M		; Increment
	MOV	A,M		; Get count into accum
	CPI	KATIMX		; Now see if official death
	JM	NULLJ		; If not yet, go back and wait for more

; Else, fall on through to the reload code
; Routine entered when the "KEEP-ALIVE" count does not change, and we
; issue  a  reload because we believe that the program running in the
; KS10 has died.

	CLRB	NOPNT		; Clear the no print flag
	CLRB	DIECNT		; And reset the die count
	PLINE	KAMSG		; Print message to indicate keep-alive failure

	INTON			; Don't print any of this stuff
	CALL	HACMD		; First, stop the machine
	DI			; No interrupts, till the examine is complete
	EXAM	71		; Examine the instruction in 71
	EI			; Ok to interrupt now

	MVI	A,1		; Keep alive code is a 1
	STA	GOCODE		; Save for passing to KS10
	CALL	EXINTM		; Now go execute loc 71 in page 0 of monitor space
	CALL	COCMD		; Let the processor resume
	INTOFF			; May resume printing this stuff
	JMP	NULLJ		; And back to null job


; Continue command decoder......
; Here if first character matched.  See if second char matched.

MTCH1:	INX	H		; Input buffer now pnts to second char typed
	LDAX	D		; Accum gets second "expected" char from cmd list
	CMP	M		; Now. does second character match??
	JZ	MTCH2		; Jump if yes, second char matches.

; Here if second character did not match.reset "H,L" & go back to try again

	DCX	H		; Reset "H,L"
	JMP	MISS2		; And continue processing

; Get to here if second character matched

MTCH2:	INX	D		; Update past 2nd char
	INX	H		; Update buffer pointer

	CALL	SEPCHR		; Get rid of separators

; "H,L" should now points to the cmd buff
; "D,E" now points to the disp addr
; Or else to "eol" char if cmd has no args.. anything else is command error

	SHLD	.ARG1		; Save "H,L" pointer to first arg.

	MOV	A,B		; Now load accum with number "tries" to find match
	XCHG			; Disp pointer now to "H,L"

	MOV	E,M		; Set low order half of "table entry" into "E"
	INX	H		; Bump pointer
	MOV	D,M		; Set high order half of "table entry" into "D"
	LXI	H,NORML		; Set a return value
	PUSH	H		; And place on stack for returns
; Piece of code to save each command dispatch address in the RAM buffer
; So that the repeat function can dispatch thru the list without decoding
; The typed in command string again..

	ANA	A		; Check if this is rp command..if yes must
	STA	T80DT		; Save which command is being executed
	JZ	CMDGO		; Jump so that cmd lst buffer no changed

	LDA	CMDS..		; See if this is the first command in a line
	ANA	A		; Set flags
	CZ	RPNEW		; If is first cmd, reset repeat buffer pointers

	LHLD	RPLST		; Get pointer to current free buffer location
	MOV	M,D		; Save hi order piece of dispatch address
	INX	H		; Update mem pointer
	MOV	M,E		; Save lo order piece of dispatch address
	INX	H		; Update pointer to first free..
	XRA	A		; Clr accum
	CMA			; In order to make it -1
	MOV	M,A		; Set -1 as end-of-list indicator
	SHLD	RPLST		; And restore the pointer

; Continue the dispatch

CMDGO:	XCHG			; Set "table entry" into "H,L"

; And dispatch to actual command code

	CALL	EOCML		; Set "C-Bit" to say end-of-line if true
	PUSH	PSW		; Save state of processor flags
	CNC	REMARG		; If no C-Bit, cmd had arg..must remember it

; Finally see if command requires an arg

	JNC	CMDGO9		; If requires no arg, go go go

; Fall here if command had no arg..see if it should have had one

	MOV	A,H		; Get hi order of disp address
	RAL			; Shift hi order bit (bit15) into the C-Bit
	JC	RRARG		; Well if set, it needed arg.. report that had none

; Else all ok.. clear bit15 if set and proceed

CMDGO9:	MOV	A,H		; Hi order to accum
	ANI	^O177		; Clear bit 15 no matter what
	MOV	H,A		; Put hi order back
	POP	PSW		; Get the processor flags back
	PCHL			; Addr to pc takes the dispatch
; Routine to remember if command had an arg..used by repeat function

REMARG:	PUSH	PSW		; Save flags
	LDA	T80DT		; See if this was a repeat, in which case, do nothing
	ANA	A		; Set CPU flags
	JZ	REMAR1		; If was RP, get out

	PUSH	H		; And save dispatch address
	LHLD	RPLST		; Get this dispatch from repeat list
	DCX	H		; Back up addr pointer to point
	DCX	H		;   Hi order piece of address
	MOV	A,M		; Now get hi order piece into accum
	ORI	^O200		; Add sign bit to remember arg
	MOV	M,A		; Now put it back
	POP	H		; Restore dispatch address
REMAR1:	POP	PSW		; And restore C-Bit from previous "EOCML"
	RET			; And return

; This is "NORML", for normal returns.. it sets up previous pointers
; and then goes back to prompt.

NORML:	LXI	H,EOL		; Get pntr to command count
	MOV	A,M		; Copy to accum
	DCR	A		; Decrement it
	MOV	M,A		; Put back where u got it

; If count was down to zero, then reset it

	DCR	A		; If count was zero, this makes it negative
	JM	NORDIS		; If eol has gone minus, take normal dispatch
	CALL	FXNXT		; Other wise be clever & cryptic
	CLRB	ERRCD		; And clear error code
	LXI	H,DCODE		; Fix H,L for normal null job

	JMP	N1		; And finally, all else goes to null loop
FXNXT:	LHLD	.ARG1		; Get cmd pntr
	INX	H		; Update it past current eol char (, or CRLF)
	SHLD	FIRST		; Fix current cmd line pntr
	RET			; And thats enough for now

; Code for buffer over flow

BFOVR:	PLINE	BV		; "Buffer overflow
NORDIS:	LHLD	NOREND		; Get the current dispatch address for normal ends
	PCHL			; And go
; Subroutine to print a single character.  Character to be printed is
; passed in the accum.  If  the  UART should fail and never reach the
; transmitter ready state,  the 8080 will hang  in  this loop forever
; trying to print.

PCHR:	PUSH	PSW		; Save character on the stack
	LDA	NOPNT		; Get no print flag
	ORA	A		; Is it set?
	JZ	PCHR0		; If not continue as normal

	POP	PSW		; If it printing
	RET			; So return

PCHR0:	LDA	CSLMODE		; Get current KLINIK line mode
	CPI	.MODE4		; Is this APT mode?
	JNZ	PCHR1		; If no, print

; Here if doing APT and must merely stack chars to be enveloped and sent out
; a little later.  The  character to be stacked is sitting on the top of the
; stack.

	POP	PSW		; Now get the character that was stacked
	PUSH	H		; Must save H,L in here
	LHLD	ENVPNT		; Get the pointer to the envelope
	MOV	M,A		; Put character into the buffer
	INX	H		; Update the pointer
	MVI	M,0		; Guarantee last byte is a zero
	SHLD	ENVPNT		; Put it back where u got it
	POP	H		; And restore reg
	CPI	CRCHR		; If we are buffering a CR, must set the flag
	RNZ			; If not a CR, just leave
	STA	MAILFG		; Else set the flag
	RET			; And out

PCHR1Z:	PUSH	PSW		; Char on stack for a bit
PCHR1:	IN	CTYCTL		; Get UART status
	ANI	01		; Check bits to see is xmitter ready?
	JZ	PCHR1		; Jump back if not ready yet

; Now,before printing, see if need to type to KLINIK line too.

	LDA	CSLMODE		; Get current KLINIK line mode
	CPI	.MODE3		; KLINIK in parallel mode??
	JNZ	PCHROV		; If not, just go print

; Fall through if need KLINIK too

	ANI	01		; Check the ready bit
	JZ	PCHR2		; If not ready, go back and try again
	POP	PSW		; Get char off stack when things are ready
	OUT	REMDAT		; Print char on the KLINIK line
	OUT	CTYDAT		; Print on cty
	RET			; And back to caller

PCHROV:	POP	PSW		; Finally ready..get char from stack
	OUT	CTYDAT		; Send character
	RET			; And return
; Subroutine KCHR.   For printing a single character on the KLINIK line
; only. Particularly useful for the "?NA" and "PW:" messages. Character
; to be printed can be a trailing arg, or you can call this routine  in
; the middle and pass the char to be printed in the accum.

KCHR:	XTHL			; Swap stack top with H,L
	MOV	A,M		; Get the trailing arg from prom
	INX	H		; Update return address past the trailing arg
	XTHL			; Put the return back on the stack
KCHR0:	PUSH	PSW		; Save the character just for a little bit
	ANI	01		; See if UART is ready
	JZ	KCHR1		; Loop till it is

	POP	PSW		; Ready now, get the char off the stack
	RET			; And back to caller
; Subroutine KLINE.  For printing a line of characters.  A trailing arg
; pointing to the string to be printed is used.  ("/" for CRLF not used).

KLINE:	XTHL			; Swap stack, get pointer to trailing arg to H,L
	CALL	TARG1		; Get pointer to arg into D,E
	XTHL			; Fix return address

KLINE1:	LDAX	D		; Get first char into accum
	INX	D		; Update the character pointer

	ANA	A		; Well then, see if char is 0, meaning end of string
	RZ			; Out if yes

; Well then , might as well go print the thing

	CALL	KCHR0		; Go print the character
	JMP	KLINE1		; And when return, go fetch up the next char
; Subroutine to  print a line of characters.  Pointer to the line of
; characters to be printed is passed in "H,L" register. No registers
; are destroyed by this routine.  The end-of-message for the line of
; characters to be printed is indicated by a "00" byte at the end of
; the message text.

PLNE:	XTHL			; Replace return..put on stack
	XCHG			; Trailing arg from "D,E" to "H,L"

PLN1:	MOV	A,M		; Get character from mem.
	INX	H		; Increment to next character to be printed

	CPI	BSLASH		; Is this a back slash(i.e. in-line crlf)
	JZ	PLN2		; Jump if yes...

	ORA	A		; Is it a "00" byte?
	RZ			; Return if done

; Fall here if gotta real char..

	CALL	PCHR		; Go print char in accum
PLN2:	CZ	CRLFIN		; Get here on zero flag,only if need crlf
	JMP	PLN1		; Continue loop

; Subroutine to print a carriage return-line feed.  No registers
; destroyed..just call to get your <Cr><lf> printed

.CRLF:	POP	H		; Must fix the stack
CRLFIN:	PCHAR	CRCHR		; Print carriage return
	PCHAR	LFCHR		; Print line feed
	RET			; Return


; This list contains all character pairs which are considered
; legitimate commands to the KS10 console.

	.BYTE	'R,'P		; *Repeat in fast loop*
	.BYTE	'D,'N		; *Deposit next*
	.BYTE	'D,'C		; *Deposit cram*
	.BYTE	'D,'M		; *Deposit memory*
	.BYTE	'L,'C		; *Load cram address*

	.BYTE	'L,'A		; *Load memory address*
	.BYTE	'D,'I		; *Deposit i/o*
	.BYTE	'L,'I		; *Load i/o address*
	.BYTE	'D,'B		; *Deposit bus*
	.BYTE	'D,'K		; *Deposit konsole*

	.BYTE	'L,'K		; *Load adr for  konsole*
	.BYTE	'E,'K		; *Examine konsole*
	.BYTE	'L,'F		; Load diag function
	.BYTE	'D,'F		; Deposit into diag function
	.BYTE	'M,'K		; *Mark micro-code*
	.BYTE	'U,'M		; *Unmark micro-code*
	.BYTE	'P,'E		; *Parity enable*
	.BYTE	'C,'E		; *Cache enable*
	.BYTE	'T,'E		; *1 Msec clock enable*
	.BYTE	'T,'P		; *Trap enable*

	.BYTE	'S,'T		; *Start*
	.BYTE	'H,'A		; *Halt*
	.BYTE	'C,'O		; *Continue*
	.BYTE	'S,'I		; *Single instruct*
	.BYTE	'S,'M		; *Start micro-code*

	.BYTE	'M,'R		; *Master reset*
	.BYTE	'C,'S		; *Start cpu clock*
	.BYTE	'C,'H		; *Halt cpu clock*
	.BYTE	'C,'P		; *Pulse cpu clock*
	.BYTE	'E,'N		; *Examine next*
	.BYTE	'E,'M		; *Examine memory*
	.BYTE	'E,'I		; *Examine I/O*
	.BYTE	'E,'C		; *Examine cram*
	.BYTE	'E,'B		; *Examine bus*
	.BYTE	'E,'J		; *Examine current cram info*

	.BYTE	'T,'R		; *Trace*
	.BYTE	'R,'C		; *Function read cram control reg*
	.BYTE	'Z,'M		; *Zero KS10 mos memory*
	.BYTE	'P,'M		; *Pulse micro-code..*
	.BYTE	'B,'T		; *Boot sys*

	.BYTE	'B,'C		; *Boot check*
	.BYTE	'L,'B		; *Load boot*
	.BYTE	'E,'X		; *Execute*
	.BYTE	'L,'T		; *Lamp test*  
	.BYTE	'K,'L		; *KLINIK*
	.BYTE	'E,'R		; *Examine register*
	.BYTE	'L,'R		; *Load register*
	.BYTE	'D,'R		; *Deposit register*
	.BYTE	'M,'T		; *Magtape boot*
	.BYTE	'D,'S		; *Disk select*
	.BYTE	'M,'S		; *Magtape select*
	.BYTE	'S,'H		; *Shutdown*
	.BYTE	'M,'B		; *Magtape bootstrap*
	.BYTE	'P,'W		; *Password*
	.BYTE	'T,'T		; *KLINIK line to tty*
	.BYTE	'V,'T		; *Verify against tape*
	.BYTE	'V,'D		; *Verify against disk*
	.BYTE	'X,'1		; Dummy
	.BYTE	'F,'I		; *File*
	.BYTE	'B,'2		; **Temp bootcheck 2**
	.BYTE	'M,'M		; Manufacturing mode
	.BYTE	'S,'C		; Soft cram error recovery "on/off" switch
	.BYTE	0		; End list marker



CHECKS:	.ADDR	0		; Psuedo bytes for RAM number 1
	.ADDR	0		; Psuedo bytes for RAM number 2
	.ADDR	0		; Psuedo bytes for RAM number 3
	.ADDR	0		; Psuedo bytes for RAM number 4

CHECKS:	.ADDR	CHKSM0		; Checksum for RAM number 1
	.ADDR	CHKSM1		; Checksum for RAM number 2
	.ADDR	CHKSM2		; Checksum for RAM number 3
	.ADDR	CHKSM3		; Checksum for RAM number 4


INIMS: .ASCIZ	/\KS10 CSL.V5.2\/ ; Power up message and identifier

	.SBTTL	*** "MR" CMD ***

; This code performs the "MASTER RESET" console function.

	XRA	A		; Set accum=0
	CALL	CHCMD		; And insure CPU has stopped...

; Issue SM10 bus reset

MRINT:	MVI	A,5		; Bits for "DP RESET", & "CRAM RESET"
	OUT	CRMCTL		; ***** I/O WRT 204/5 *****

	MVI	A,^B10000000	; Bit 7 for reset
	OUT	RESET		; Issue reset, set console mode

	CALL	SMFINI		; Get current parity settings & set in ks

	LDA	TRAPEN		; Bit for "CLR TEN INT" should be low
	OUT	DIAG		; ***** I/O WRT 205/XX *****

	MVI	B,0		; Will set no bits in the state word
	CALL	STATEM		; Set the state
	.BYTE	^O12		; Off the stuff we don't want
	ENDCMD			; And out


; Here on interrrupts..regs already saved at "RST" block

INTRP:	LXI	H,ENDIN		; Push our favorite exit address on the stack
	PUSH	H		; And we can do "RET"'s to leave routine
	IN	CTYCTL		; Get CTY TTY status
	MOV	B,A		; Save it in the "B" reg for a couple instrs
	IN	REMCTL		; Now fetch up the remote status
	ORA	B		; And throw both status's together
	ANI	^O70		; Any err bits set?
	JNZ	TTERR		; Go tell err if yes

; Fall through if no one in error. now see who the character is from

	MOV	A,B		; Copy cty status into accum
	ANI	2		; Is a character in the cty UART??
	JNZ	INTCH		; Jump if yes. find character in cty UART.

; Fall here if it was a KLINIK char

	IN	REMDAT		; Fetch out the character
	ANI	^O177		; Off the parity bit
	MOV	B,A		; Make second copy of character in "B"

	CPI	CNTLY		; Before dispatching, is this "Control-Y"?
	JNZ	KL.DSP		; If not, do everything as per normal

; Aha. it was a see if in MM mode

	LDA	MMFLG		; Get flag
	ANA	A		; Set 8080 condition codes
	JNZ	MMERR1		; If yes, MM mode, then abort whatever you are doing
	MOV	A,B		; Now replace the char we just bombed

; Else fall through

KL.DSP:	LHLD	MODDIS		; Get current KLINIK mode dispatch
	PCHL			; Dispatch to do the right thing

; Check if we are in user mode

INTCH:	IN	CTYDAT		; Input character
	ANI	^O177		; Strip bit 8
	MOV	B,A		; Save char for 2 instructions

; See if this is manufacturing mode before we continue

	LDA	CSLMODE		; Grab current CSL mode
	ANI	.MODE4		; And see if its Mode 4
	JZ	CMNBUF		; If no, CTY input normal

; Place you go if manufacturing mode.. cty chars are just sent to KLINIK

	MOV	A,B		; Grab character to be sent to KLINIK
	CALL	KCHR0		; Only echo cty stuff against the KLINIK line

; Now see if that was a mode change char we just sent down the line

	CPI	CNTLY		; Is it "Control-Y"
	RNZ			; If was not, simply get out

	CLRB	KLNKSW		; Force re-examine of things
	CLRB	MMFLG		; Turn off manufacturing mode
	CALL	SETM2		; Force KLINIK line immediately into Mode 2
; Also standard common entry point when KLINIK line parallels the cty

CMNBUF:	LDA	USRMD		; Get user mode flag
	ANA	A		; Is it set?
	MOV	A,B		; Copy char into accum (for KLINIK or CTY)
	JNZ	USER		; Jump if in user mode...

; Fall thru to here if not user mode and we need do something with char

	CPI	CNTLO		; Control-O?
	JNZ	SKP2		; Jmp if no

; Else fall into Control-O code..stop the printer

	LDA	NOPNT		; Get current state of "no print"
	ADI	^O200		; Zap print flag
	STA	NOPNT		; Put it back
	XRA	A		; Zap char so we can early exit

SKP2:	CPI	CNTLS		; Is it Control-S
	CZ	CNTS		; Call if yes

	CPI	CNTLQ		; Is it Control-Q
	JNZ	SKP6		; Jmp if no

; Fall to here if yes, zapp Cntl-Q flag

	CLRB	STPPD		; Zap!!
	XRA	A		; Clear accum
SKP6:	STA	RPEND		; Any other chars mean end repeat loop
	CPI	CNTLZ		; Control-Z?
	JZ	CNTZ		; Jmp if yes

	CPI	CNTLU		; Control-U?
	JNZ	SKP8		; Jmp if no

; Fall to here to do the control-u code

	PCRLF			; And a CR-LF to give clean line
	CALL	BFRST		; Clear input buffer
	XRA	A		; And set accum for early out

SKP8:	CPI	CNTLC		; Control-C?
	JZ	CNTC		; Jmp if yes

	CPI	Q.OUT		; See if must take a quick out
	RZ			; Leave if yes

	CPI	COMMA		; Is it a comma?
	JNZ	M11		; If not comma, avoid next couple instructions

; Fall to here if was a comma

	LXI	H,CMCNT		; Point to the comma counter
	INR	M		; Update.. and continue
; Not special char..process normal

M11:	CPI	CNBCK		; Control backslash should look like crlf
	CZ	EOMRK		; Call if yes

	CPI	CRCHR		; Carriage ret?
	CZ	EOMRK		; Call if yes

	CPI	LFCHR		; Line feed?
	CZ	EOMRK		; Call if yes

	LHLD	BUF.		; Pointer to first free buffer place
	CPI	RBOUT		; Rub-out char?
	JZ	RUB		; Jmp if yes

; Otherwise its a regular char..
; This is dumb code - for first go around type-ahead won't work.

	CALL	UP.LO		; Convert so pgm internal only sees upper case

	MOV	M,A		; Char into buffer space
	INX	H		; Update pntr
	SHLD	BUF.		; And replace pntr

	MOV	B,A		; Save the char just typed
	SUI	^O40		; Check if its a printing char
	JM	NOECH		; If it is none-pnt..go no echo

	MOV	A,B		; Get char back
	SUI	^O176		; Is it too hi to be printing char?
	JP	NOECH		; If yes, go no echo

	MOV	A,B		; Get char back again
	CALL	PCHR		; Now go echo it.....

NOECH:	LDA	BFCNT		; Get char count
	INR	A		; Bump up
	CPI	80.		; Too many?
	JZ	BFOVR		; Jmp buffer overflow if yes
	STA	BFCNT		; Replace count
	POP	H		; Clear stack of the pseudo return first

; Fall into end interrrupt code if char count ok

ENDIN:	POP	H		; Restore regs
	EI			; Interrupts back on
	RET			; And out

; And accept lower case as requested

UP.LO:	CPI	^O141		; Low case "A" or better?
	RM			; If minus, not low case, continue
	CPI	^O173		; Low case "Z" or worse?
	RP			; If pos, or zero, its not low case range

; Fall into here if it was lower case....

	SUI	^O40		; Make it upper for all
	RET			; And out

; Code for end-of-line char typed in

EOMRK:	PCRLF			; Give cr-lf

	LDA	CMCNT		; Get count of commas
	INR	A		; Up by one, for the cr-lf
	STA	EOL		; And set eol marker
	XRA	A		; Clear accum
	STA	CMCNT		; Set location
	CMA			; Set accum = -1
	RET			; Return

; Code for a rub-out

RUB:	LDA	BFCNT		; Get current char count
	ANA	A		; Is it 0?
	RZ			; Good, nothing to delete
	DCR	A		; Decrement otherwise
	STA	BFCNT		; And put it back

	DCX	H		; And back up the buffer pntr
	SHLD	BUF.		; Put it back
	PSLASH			; Type slash as rubout indicator
	MOV	A,M		; Get current char in buffer
	CALL	PCHR		; Echo what was rubbed out
	CPI	COMMA		; Oh wait, was that a comma?
	RNZ			; Jmp if no, take a normal out

; Fall thru if was a comma

	LXI	H,CMCNT		; Get comma count
	DCR	M		; Decrement
	RET			; An exit this place
; Here if user mode flag is set..

USER:	CPI	CNBCK		; Is it "^\"?
	JNZ	TENCHR		; If not, then its a char for the KS-10

; Before we leave user mode, we must check the console enable switch

END.USR: IN	BOOTSW		; ***** I/O RD 301 ***** is console locked up??

; Bit 2 is "lo" if console enable is true. if bit 2 is "hi", we are disabled
; due to the hardware inversion of signal levels.

	ANI	^O4		; Check bit 2
	RNZ			; If hi, we are disabled and will ignore

; If yes, user mode must be cleared

	CLRB	NOPNT		; Clr no print flag in case we were in "internal mode"
	CALL	CLRUSE		; Exit from user mode
	PLINE	RDYMS		; "Enabled"
	LXI	H,REINI		; Set up an exit address
IOUT:	POP	D		; Clear the pseudo return to "endin" from stack
	POP	D		; Clear original saved "H,L" off stack
	INX	SP		; Now get old return addr off stack

	EI			; Enable ints..
	PCHL			; And go to prompt

CLRUSE:	CLRB	USRMD		; And clear the user mode flag
	LDA	MMFLG		; Before dropping user, see if in MM mode
	ANA	A		; Set 8080 flags
	RZ			; If not MM mode, ok to get out

; If was set, must drop back to Mode 4

	CALL	KCHR		; Non-printing char, also tells host to switch modes
	.BYTE	CNBCK		; "Control-backslash is the magic char"
	RET			; Just leave
; Control-Z code...enter user mode

CNTZ:	CALL	SETUSE		; Set the user mode
	CALL	BFRST		; Buffer tty input buffer

;This line was remove because in protect mode typing a Control-Z would
;cause the PW to be queried again and would not allow the Klinik line to
;enter duplicate CTY mode (Mode 3).
;(5.2A)	CLRB	KLNKSW		; Force lights fixing after enter user

	PLINE	U		; Print "user mode"
	LXI	H,NULLJ		; Load "H,L" with a place to go
	JMP	IOUT		; And get out


; Here is the deposit word 31 code..

WRD31:	INTON			; Don't print this stuff
	EXAM	31		; Must save current state of KA & reload bits
	INTOFF			; Its ok now
	LDA	GOCODE		; Byte 28-35 gets the reason for reload
	LXI	H,DMDAT		; Make H,L point to the desired buffer
	MOV	M,A		; Set the gocode bits into the byte "DMDAT"

	LDA	TRAPEN		; Now grab the trap bit
	RLC			; And shift to appropriate position (20 to 40)
	RLC			; (40 to 100)
	RLC			; (100 to 200)
	MOV	B,A		; Save it in B for a while

	ANA	A		; Set 8080 flags
	PUSH	PSW		; Save the state of the flags for later use
	JZ	WRD.PR		; If no MM mode, don't set a bit

; Was MM mode, must set the bit

	MVI	A,^O100		; A bit for MM mode
WRD.PR:	ORA	B		; Throw together with the trap bit
	INX	H		; Put into the deposit buffer
	MOV	M,A		; This is loc "DMDAT+2"

	LDA	PARBT		; Now for the selection of parity bits
	RRC			; Right once to free up 200 weight
	MOV	B,A		; Save in B reg
	LDA	CSLMODE		; Get current KLINIK mode
	ANI	.MODE2!.MODE3	; If either of these modes, must set the bit
	JZ	WRD.DP		; Jump if not those bits

; Here if one of those modes was set

	MVI	A,^O100		; A bit to set

WRD.DP:	ORA	B		; Throw this bit with the others
	RRC			; Final justification
	MOV	B,A		; Now save this good stuff in "B"
	LDA	EMBUF+3		; Get the byte that has current "KA" bit
	ANI	^O300		; Off everything else
	ORA	B		; Now throw whole mess together again

	INX	H		; Bump pointer to "DMDAT+3"
	MOV	M,A		; And put data into RAM
	DEPOS	31		; Put into mos memory at loc 31
	CLRB	GOCODE		; Clear the reload code

	POP	PSW		; This word has flags set from before when we tested "MM"
	MVI	A,-1		; Flags won't change while we set user mode flag
	STA	USRMD		; Set user mode... now do s/g based on the flags
	RZ			; If not set, a simple out

; Here if set, we must send an "ack" down KLINIK line before anything else

	CALL	ACK		; "Ack" down the KLINIK
	JMP	SETM2		; Also set Mode 2 and use his "RET" to return

; Typed "Control-S" to stop console output

CNTS:	LXI	H,STPPD		; Pointer to stopped flag
	MOV	A,M		; Get the flag
	CMA			; Set .eq. 0 if was already set
	ANA	A		; Now set flags, 'cause CMA doesn't
	RZ			; If .eq. 0 now, merely leave..already set

	MOV	M,A		; And set the flag .eq. -1 if here
	EI			; Let the Cntl-Q thru

CNTSL:	MOV	A,M		; Get flag status
	ANA	A		; Is it set?
	RZ			; If not,then time to quit
	JMP	CNTSL		; Stay in loop if flag still set


TENCHR:	STA	CHRBUF		; Put character in a RAM buffer
	MVI	A,^O32		; Desired address for deposting character

	OUT	A2835		; Write only relevant piece of the address
	XRA	A		; Then clr accum
	OUT	A2027		; And clr rest of the hardware address register
	OUT	A1219
	OUT	W1219		; Clear pieces of deposit data which must be zero
	OUT	W0411
	OUT	W0003

	MVI	A,02		; Bit to say "write function"
	OUT	A0003		; ***** I/O WRT 113 *****

; The following "ADD A" works by luck..i.e. 2+2=4

	ADD	A		; Bit into accum for "COM/ADR cycle"
	OUT	BUSARB		; ***** I/O WRT 115/4 *****

	LDA	CHRBUF		; Now get the character we want
	OUT	W2835		; Put it in the hardware register
	MVI	A,1		; And get the valid bit to go with character
	OUT	W2027		; Put it in the hardware register

; And by luck, the accum has just what we need for the next step

	OUT	DTARB		; ***** I/O WRT 114/1 *****

	OUT	BUSCTL		; *****I/O WRT 210/360 *****

; Do this twice to guarantee that the interrupt happens

	MVI	A,1		; Bit for setting interrupt to the KS10
	OUT	INT2KS		; Set the interrupt
	OUT	INT2KS		; Set the interrupt

	RET			; And exit normally....


; Enter here with the char in the accum.   Routine for handling
; interrupt characters from a running KS10.  Only chars from KS
; to CTY implemented.

CHRRDY:	INTON			; Set up internal mode
	DI			; Common code,not to be disturbed

; Disable interrupts for this operation

	LDA	TRAPEN		; Get default for the trap enable bits
	OUT	DIAG		; *****I/O WRT/ to clr the interrupt*****

; Fall to here if yes we are in KLINIK Mode 2.  Its possible that this
; interrupt is from the KLINIK comm word, for the KLINIK line.

	EXAM	35		; Exam the KLINIK comm word
	INTOFF			; Keep this flag in step
	LDA	EMBUF+1		; Grab contents of the byte with the control key
	ANA	A		; Set 8080 flags
	JZ	CTYONLY		; If control key clear, nothing from KLINIK, try cty

	MOV	B,A		; Save the data in the accum for a little while
	LDA	CSLMODE		; Get current mode. Decide if have to discard
	ANI	.MODE0!.MODE1!.MODE3 ;  chars or just act as a null bit bucket
	JNZ	NULKL		; Jump to a null action if any of these 3 modes

; Now here if control key is .ne. 0

	MOV	A,B		; Retrieve data
	CPI	1		; Is it the key for a simple char to be output?
	JZ	KLPCHR		; If yes, go process the character

	CPI	2		; Is it for a hangup
	JNZ	NOACTN		; Nope, ignore entirely

	CALL	KILL.KLINIK	; (5.2A) Yup, hang 'em up
	EI			; Identical code to location "NOACTN", but the
	RET			;   2 bytes here are cheaper than a "JMP"
; Code for printing the desired character on the KLINIK line

KLPCHR:	TSTRDY	REMCTL		; See if the line is ready for the next char
	JZ	KLPCHR		; If not ready yet, better wait longer

; Here when ready

	LDA	EMBUF		; Get the character
	OUT	REMDAT		; Print it
NULKL:	MVI	A,^O35		; Now must clear word and interrupt to say done
	CALL	TTOCOM		; (5.2A) Go common code
	DI			; Keep interrupts off because TTOCOM turned it on
CTYONLY: INTON			; Don't print this crud
	EXAM	33		; Get the communication word
	INTOFF			; Internal mode off
	LDA	EMBUF+1		; Get the interrupt code
	CPI	1		; Is interrupt code .eq. 1?
	JNZ	NOACTN		; Jump to "NO ACTION" if not, code out of bounds

	LDA	EMBUF		; Actual char to accum
	MOV	B,A		; And save it in the B reg

; Code to print a char passed from the KS-10 CPU.  Code interrupts
; the 10 when the character has finished printing

CTYPCHR: TSTRDY	CTYCTL		; Check is the xmitter ready?
	JZ	CTYPCHR		; Loop until it is

; Fall thru when ready
; But before printing, check the KLINIK line to see if it gets the
; character too.
	LDA	CSLMODE		; Check the KLINIK mode
	CPI	.MODE3		; Is the KLINIK parallel to the cty line?
	JNZ	CTYOUT		; Jump if no. KLINIK does not get this char

; Fall here if yes, KLINIK line gets a piece of this character too.

KLTOO:	TSTRDY	REMCTL		; See if KLINIK line is ready
	JZ	KLTOO		; If not yet, go back and try again

	MOV	A,B		; Char to accum
	OUT	REMDAT		; Print it on the KLINIK line

CTYOUT:	MOV	A,B		; Get the char we saved in the B reg.
	OUT	CTYDAT		; Send to the UART
; Now clear  a data buffer for depositing 0's into the mos memory.
; We are using in-line code here in order to speed up the type-out
; on KS10 to 8080 xfer's.. 

	MVI	A,^O33		; This is the address we wish to deposit
TTOCOM:	OUT	A2835		; Put it into the hardware register
	XRA	A		; Clear accum, because rest of addr must be zero
	OUT	A2027		; Clr the other hardware registers
	OUT	A1219
	OUT	W2835		; And we will make all of the hardware data regs 0
	OUT	W2027
	OUT	W1219
	OUT	W0411
	OUT	W0003

	MVI	A,02		; Bit to say "write function"
	OUT	A0003		; ***** I/O WRT 113 *****

; This "ADD A" works by luck..i.e. 2+2=4

	ADD	A		; Bit into accum for "COM/ADR CYCLE"
	OUT	BUSARB		; ***** I/O WRT 115/4 *****

	MVI	A,1		; Bit into accum for "DATA CYCLE"
	OUT	DTARB		; ***** I/O WRT 114/1 *****

	OUT	BUSCTL		; *****I/O WRT 210/360 *****

; Do this twice to guarantee the interrupt gets thru

POKE10:	MVI	A,1		; Bit for setting interrupt to the KS10
	OUT	INT2KS		; Set the interrupt
	OUT	INT2KS		; Set the interrupt
NOACTN:	EI			; Ok for interrupts now
	RET			; And out


; When here, "B" reg contains the status of the cty line

TTERR:	MOV	A,B		; Copy cty status to accum
	ANI	^O70		; Any errs in cty UART?
;	ANI	^O170		; (5.2B was ^O70) Any errs in cty UART?
	JNZ	TTERR1		; If yes, go check things on the cty line

; Here if got KLINIK errors

	MVI	A,^O25		; Before jumping, reset UART so it will work
	OUT	REMCTL		; I/O write to reset the UART

	LDA	USRMD		; Check user mode. Will not report err if it is
	ANA	A		; Set flags
	JNZ	INTCH		; If was user mode, ignore overrun and handle char
	RET			; Done int
TTERR1:	ANI	^O150		; See if overrrun or a fatal error

; Now must clr error from the UART first

	MVI	A,^O25		; Bits to clr error conditions in UART
	OUT	CTYCTL		; *****I/O WRT 200/25 *****
	JNZ	TTERMS		; Now jump if fatal

	LDA	USRMD		; Before issuing message,is user mode set?
	ORA	A		; Test user mode flag
	JNZ	INTCH		; If yes, user mode, then ignore the error

; Now must clr overrun error from the UART

;	ANI	^O100		; (5.2B) See if break detect
;	JZ	TTERMZ		; (5.2B) No - continue
;	MVI	A,^O125		; (5.2B) Yes - bits to clr errors in UART
;	OUT	CTYCTL		; (5.2B) *****I/O WRT 200/125 *****

TTERMZ:	LXI	H,CSLMODE	; Get current mode of KLINIK
	MOV	C,M		; Save it in C
	MVI	M,0		; Now clear CSL mode
	PUSH	H		; And save "H,L"
	PLINE	TTM		; Output the error message
	POP	H		; And restore mem pointer
	MOV	M,C		; Replace CSL mode and get out
	RET			; And restart null loop

CNTC:	LXI	SP,RAMST+^O2000 ;Guarantee that Cntrl-C wins
	JMP	REINI		; Jump away
; Local subroutine to reset TTY input buffer

BFRST:	LXI	H,BUFBG		; Buffer beginning
	SHLD	BUF.		; Reset current buffer pointer
	SHLD	FIRST		; Reset cmd pointer
	CLRB	RPEND		; Clear repeat killer
	CLRB	CMDS..		; Say line is done.. at beginning of things
	CLRB	BFCNT		; Clear char count
	RET			; And return
; This is the initial mode of the KLINIK line after a power up. Also,
; when  the  KLINIK  line  is  disabled, or in "protect" mode, but no
; password has been set by the operator.

MODE0:	CPI	BELL		; No echo if receive bell
	RZ			; Bell, so out
	KLINE	NOACCS		; Print a message for the KLINIK line only
	JMP	KILL.KLINIK	; (5.2A) Hang up so repeat ?NA don't hang systm

; This is KLINIK Mode 1.   This is the mode of the KLINIK line whenever
; the front panel switch is in the protect position, and we are waiting
; for the password to be entered.

MODE1:	KLINE	QPW		; Begin by printing "PW:"
	LXI	H,PASSWORD	; Get address of password (1st character)
	SHLD	APASS		; (5.2D) Save address in pointer location
	CLRB	PNUM		; (5.2D) Clear password character count
	CLRB	PWNOK		; (5.2D) Clear password validity flag

;This section was the old PW init section which is replace by the 3 lines above
;(5.2D)	LXI	H,KPWBUF	; Initialize buffer for saving typed password
;(5.2D)	SHLD	KPWPNT		; Save in the buffer pointer
;(5.2D)	CLRB	KPWCNT		; And clear the password character counter

	LXI	H,PW.WAIT	; Now additional KLINIK chars must dispatch to
	SHLD	MODDIS		;  the place that waits for a complete password
	RET			; End of interrupt
;(5.2D) This section has been recoded to save 20 - 30 bytes, and the code
; replacing this is below this section.
; This is the entry point when the person is in the process of typing the
; password. We store the password as it is typed, then when done, we will
; verify that it is correct.
;PW.WAIT: CPI	CRCHR		; Is it an end of line character
;	JZ	PW.TST		; Jump if yes.. time to verify the password
;	CALL	UP.LO		; Generate only upper case for program internals
;	MOV	B,A		; Save the char in B reg for a little bit
; If not end of line, just add it to the buffer of chars that is the password
;	LDA	KPWCNT		; First things first, see how many chars in buffer
;	INR	A		; Update to account for this one
;	CPI	7		; Is it too many
;	JZ	PW.ERR		; Jump if yes. its a password error
;	STA	KPWCNT		; Else save the updated count and continue
;	LHLD	KPWPNT		; Get the buffer pointer
;	MOV	M,B		; Put the character in the buffer
;	INX	H		; Update the buffer pointer
;	SHLD	KPWPNT		; Put the pointer back
;	RET			; And end of interrupt
; Code for verifying that the password entered is the correct and valid 
; password.
;PW.TST:LXI	D,PASSWORD	; D,E points to the expected password
;	LXI	H,KPWBUF	; H,L points to the typed in buffer
;	MVI	B,00		; "B" will be the counter
;PW..:	LDAX	D		; Fetch up an expected character
;	ANA	A		; Set the flags
;	JZ	PW.END		; If "end", go make sure typein is terminated
;	INR	B		; Else update our counter
;	CMP	M		; And compare a char
;	JNZ	PW.ERR		; If mis-compare report it as error
;	INX	D		; Update expected pointer
;	INX	H		; Update typed in pointer
;	JMP	PW..		; Continue
; End.. this is only to verify that typed terminated at the same number of
; characters as expected.
;PW.END:LDA	KPWCNT		; Get expected count
;	CMP	B		; Check against the current count
;	JZ	PW.OK		; And jump if counts match
;(5.2D) This section replaces the previous section to verify the correctness
; of a password as it is being entered.
; This section takes each character of the password as it is being
; entered and compares to expected.  If any character mismatches
; occur, an error flag is set.

PW.WAIT:CPI	CRCHR		; EOL character?
	JZ	PW.TST		; Yes - check if PW is ok
	CALL	UP.LO		; No - convert to upper case

; Compare character typed to expected

	LHLD	APASS		; Get addr of password (current character)
	CMP	M		; Compare to typed in
	INX	H		; Increment PW addr
	SHLD	APASS		; Save PW addr
	JZ	PWOK1		; Character same? yes - continue

; Error seen - set error flag

	LXI	H,PWNOK		; get addr of PWNOK flag
	INR	M		; increment it

; Check if over 6 characters

PWOK1:	LDA	PNUM		; Get character count
	INR	A		; Update to account for this one
	CPI	7		; Seven yet?
	JZ	PW.ERR		; Yes - error
	STA	PNUM		; Save character count
	RET			; End of interrupt

; Check if ok

PW.TST:	LHLD	APASS		; Get addr of next pw char - should be 0
	MOV	A,M		; Load char into accum
	ANA	A		; Is this 0? (ie. pw length ok?)
	JNZ	PW.ERR		; If not - handle pw error
	LDA	PWNOK		; Get PW not ok flag
	ANA	A		; Set the flags
	JZ	PW.OK		; Zero? - yes - PW ok - exit

; Fall thru to error if character counts don't match

PW.ERR:	KLINE	CMDNG		; Give user an error message
	LXI	H,PWRTRY	; Had error. only get 3 chances for errors
	INR	M		; Update error count
	MOV	A,M		; Place count in accum for a test
	CPI	3		; See if struck out
	JZ	KLIRST		; Go reset KLINIK line if user struck out

	JMP	MODE1		; Else give him "PW:" message again
; Here if everything matched

PW.OK:	CALL	SETM2		; Change line to Mode 2
	KLINE	POKMSG		; When good pw, send out an "OK"

PW.OUT:	CLRB	PWRTRY		; Clear error counter
	RET			; Exit

; KLINIK line reset code. for reseting KLINIK line and hanging up the user

KLIRST:	CALL	HANGUP		; Go hang up the KLINIK line
	CALL	SETM1		; Drop back to Mode 1
	JMP	PW.OUT		; Zap error flag then out

; KLINIK line Mode 2.  This is stream input/output.  All characters from
; the KLINIK UART are sent to the special KLINIK communication words and
; all words from the KLINIK comm words are output to the KLINIK line.

MODE2:	CPI	CNBCK		; First see if KLINIK user wants a mode change
	JNZ	KL3435		; If not, go send info to the KLINIK comm word

	LDA	MMFLG		; Before going to Mode 3, see if MM mode
	ANA	A		;   set 8080 flags
	JNZ	END.USR		; If yes, MM mode, act like from a cty

; Fall thru if wants to change modes. but before changing, check if he's
; allowed to change modes.

	LDA	KLLINE.ON	; Check if KLINIK on, & user allowed to change
	ANA	A		; Set flags
	RZ			; If not enabled to change, ignore this intrpt

; Well, he is allowed to change. see if the front panel switch is unlocked

	IN	BOOTSW		; ***** I/O RD 301 *****

; Note that bit lo is truth, if bit hi is false(disabled)

	ANI	4		; Check the console enable bit
	JZ	SETM3		; Go Mode 3 only if panel not locked.
				;   let SETM3 do "RET"
; This is where you actually write the desired character into the KLINIK
; line communication word.

	STA	CHRBUF		; Put character in a RAM buffer
	MVI	A,^O34		; Desired address for deposting character

	OUT	A2835		; Write only relevant piece of the address
	XRA	A		; Then clr accum
	OUT	A2027		; And clr the rest of the hardware addr reg
	OUT	A1219
	OUT	W1219		; Clear pieces of deposit data which must be zero
	OUT	W0411
	OUT	W0003

	MVI	A,02		; Bit to say "write function"
	OUT	A0003		; ***** I/O WRT 113 *****

; The following "ADD A" works by luck..i.e. 2+2=4

	ADD	A		; Bit into accum for "COM/ADR CYCLE"
	OUT	BUSARB		; ***** I/O WRT 115/4 *****

	LDA	CHRBUF		; Now get the character we want
	OUT	W2835		; Put it in the hardware register
	MVI	A,1		; And get the valid bit to go with the character
	OUT	W2027		; Put it in the hardware register

; And by luck, the accum has just what we need for the next step

	OUT	DTARB		; ***** I/O WRT 114/1 *****

	OUT	BUSCTL		; *****I/O WRT 210/360 *****

; Do this twice to guarantee that the interrupt happens

	MVI	A,1		; Bit for setting interrupt to the KS10
	OUT	INT2KS		; Set the interrupt
	OUT	INT2KS		; Set the interrupt

	RET			; And exit normally....

; This code performs the "EXAMINE BUS" console function.

EBCMD:	MVI	A,01		; First clr "R CLK ENB" 
	OUT	BUSCTL		; ***** I/O WRT 210/001 *****
	CALL	RDATT		; ***** I/O RD "0,1,2,3,103" (read bits 0-35) *****
	.ADDR	EMBUF		; Place bits 0-35 into RAM buffer area "EMBUF"

; Read the rest of the I/O registers and save in the ram

	LXI	H,RM100		; Get beginning address of RAM buffer area
	LXI	D,IORGS		; D,E will point to source of regs to be read
	MVI	B,8		; There are 8 registers to be read

EB.RDIN: LDAX	D		; Fetch up first register to be read
	CALL	ER.UTL		; Call ER command
	MOV	M,A		; Copy results of read into the RAM space
	INX	D		; Update source pointer
	INX	H		; Update destination pointer
	DCR	B		; Down the counter
	JP	EB.RDIN		; Continue loop

	XRA	A		; Clr accum must set "R CLK ENB" 
	OUT	BUSCTL		; ***** I/O WRT 210/0 *****

	PLINE	EBHED		; EB cmd header msg
	CALL	DECNET		; Print the heading
	CALL	P36.		; Go print it
	PCRLF			; And a <cr><lf>
	CALL	DECNET		; And make sure this gets sent
	LXI	H,IORGS		; "H,L" now pnts to list of I/O register names
	LXI	D,RM100		; "D,E" now pnts to corresponding list of data for I/O reg
	MVI	B,8		; Accum now contains a count of 8 (for 8 I/O regs)

EB1:	CALL	P8BIT		; Print first reg name
	INX	H		; Bump to next
	PSLASH			; Print "1"
	XCHG			; Swap so "H,L" points to data

	CALL	P8BIT		; Print data for that reg
	INX	H		; Bump to next
	XCHG			; Swap back-"H,L" points to name again
	PSPACE			; Space over
	DCR	B		; Down count
	JNZ	EB1		; Continue till done all eight regs
	CALL	DECNET		; And finally make sure last thing gets sent
	ENDCMD			; End-of-command

; End this code with a 6 byte buffer of the I/O regs names, in binary

IORGS:	.BYTE	^O100		; First reg name in binary
	.BYTE	^O101		; 2nd
	.BYTE	^O102		; 3rd
	.BYTE	^O103		; 4th
	.BYTE	^O300		; 5th
	.BYTE	^O301		; 6th
	.BYTE	^O302		; 7th
	.BYTE	^O303		; 8th

	.SBTTL	*** "DB" CMD ***

; This code performs the "deposit bus" console function

DBCMD:	RUN..			; Is CPU running?
	JC	DB1		; Skip code if at end of command
	ARG36			; If not, go assemble arg.
	.ADDR	BUSAD		; And put into buffer "BUS AD"

DB1:	CALL	ADATT		; ***** I/O WRT to R Data 0-35 data reg(odds) *****
	.ADDR	BUSAD		; Buffer address of source of data

	XRA	A		; Clr accum so can clr I/O Reg 115
	OUT	BUSARB		; ***** I/O WRT 115/0 *****

	MVI	A,^O141		; Bits to set "CONSOLE REQ" & "T ENB FOR COM/ADR"
	OUT	BUSCTL		; ***** I/O WRT 210/141 *****

	BUSRESP	ARBRESP		; ***** I/O read 301 *****
	JNZ	NOARB		; If no arb response with "BUS REQ", abort

	CALL	DBRDIN		; Go read results, and do a 36-bit compare
	JNZ	DBERR		; If "Z-bit" not set report miscompare & abort

; Second half of command

	CALL	ADATT		; Clr out old crud
	.ADDR	MAD000		; With all zeroes

	CALL	WDATT		; ***** I/O WRT data 0-35 addr reg(evens) *****
	.ADDR	BUSAD		; Buffer address of source of data

	MVI	A,01		; Bits to set "DATA CYCLE"
	OUT	^O114		; ***** I/O WRT 114/1 *****

	MVI	A,^O363		; Bits for "CONSOLE REQ", "TENB FOR COM/AD R"
	OUT	BUSCTL		; ***** I/O WRT 210/363 *****

	BUSRESP	ARBRESP		; ***** I/O RD 301 *****

	JNZ	NOARB		; If no arb resp, abort with 2nd half message

	BUSRESP	DATACK		; How about data acknowledge?
	JZ	NOACK		; Jump if none

	CALL	DBRDIN		; Go read in results and compare result
	RZ			; If Z-Bit, then ok to exit

; Else fall into this code if a miscompare

	PCHAR	DCHR		; Print "D"
	JMP	DBCOM		; And now the err finishes up like the 1st half

; Common subroutine to read in the contents of the KS10 bus & compare against
; the data which was put onto the bus.

DBRDIN:	CALL	RDATT		; ***** I/O RD 0,1,2,3,103 *****
	.ADDR	TMPB2		; Place to put rdata 0-35

	CALL	CMP36		; Check data just read vs. data sent
	.ADDR	BUSAD		; Sent data
	.ADDR	TMPB2		; Received data
	RET			; Done
; "DB" command code for the cases where data deposited on the bus is not
; the same as the data read back from the bus..   By the way...right now
; this is pretty sloppy code....

DBERR:	PCHAR	CCHR		; Print a "C"

	LXI	H,BUSAD		; Addr of 36-bit data
	CALL	P36		; Now print that data

	PLINE	DRCVD		; "Received data"

	LXI	H,TMPB2		; This is addr of received data
	CALL	P36		; Print that 36-bit data
	PCRLF			; And cr-lf
	LXI	H,4		; Pass error code before exit
	JMP	ERRRTN		; Go finish with the error code

	.SBTTL	*** "EM" CMD ***

; This is the actual "EM" command code

EMCMD:	JC	EM1		; Skip code if at end of command
	CALL	LACMD		; Go fetch up an address to examine

EM1:	XRA	A		; Clear accum
	STA	ENEXT		; And set so "EN " cmd will know what to do

EM2:	LXI	D,MEMAD		; Address for memory loc.

EMINT:	MVI	A,04		; Bit to say "read function"

EN2ND:	MOV	B,A		; Save function data
	XCHG			; Data pointer to "H,L"
	SHLD	AM.AI		; Store for later use by common code
	XCHG			; Restore "D,E"
	CALL	ADATP		; ***** I/O WRT 103,105,107,111,113 *****

	MOV	A,B		; Get function
EM.CRM:	OUT	A0003		; ***** I/O WRT 113/4 *****

; Now set "COM/ADR" cycle

	MVI	A,^O04		; Bit to set com/adr cyc
	OUT	BUSARB		; ***** I/O WRT 115/4 *****

; Check if doing EI or EM

	LDA	EIFLAG		; Get the EI flag
	ANA	A		; Set codes, if .ne. 0, then it is an EI code
	JNZ	EMCONT		; And if was EI, go do it
; Otherwise just fall thru and use the DM codes

EMCONT:	OUT	BUSCTL		; ***** I/O WRT 210/343 *****

	XRA	A		; Clear the accum
	STA	EIFLAG		; Clear flag on the way out

	BUSRESP ARBRESP		; ***** I/O RD 301 *****
	JNZ	NOARB		; If get no "BUS REQ", arb failed so abort

	BUSRESP	NONXMEM		; ***** I/O RD 301 *****
	JNZ	NIXOM		; Jump if non-existant mem flag is set

; Now must wait for "data acknowledge" from memory

	BUSRESP DATACK		; ***** I/O RD 301 *****
	JZ	NOACK		; Jmp if no "DATA ACK" (bus has 15 usec to respond)
; Here if "data acknowledge" received..get results & print

	LXI	D,EMBUF		; Place to put received data
	CALL	RDATP		; ***** I/O RD 0,1,2,3,103 *****

	XRA	A		; Set accum .eq. 0 for "R CLK ENABLE"
	OUT	BUSCTL		; ***** I/O WRT 210/0 *****

	LDA	NOPNT		; Get the print flag
	ANA	A		; Set condition codes
	RNZ			; And don't waste time if not printing

	LHLD	AM.AI		; Get pointer to mem addr just examined
	CALL	P36		; Print it

	PSLASH			; Print "/"
	CALL	P36.		; And print it
	PCRLF			; Cr-lf
	ENDCMD			; All done

	.SBTTL	*** "EN" CMD ***

; Actual code for "EN" cmd

ENEM:	CALL	INC36		; Add 1 to 36-bit buffer
	.ADDR	MEMAD		; This is the buffer to increment
	JMP	EM1		; And no go process just like "EM" cmd

; Examine next will do the next, same as the last

ENCMD:	LHLD	ENEXT		; Get index for which examine is next
	LXI	D,ENLST		; Get pntr to dispatch list
	DAD	D		; And now add "which" examine
	MOV	E,M		; Get lo order piece
	INX	H		; Update mem pntr
	MOV	D,M		; Get hi order piece
	XCHG			; Put this new addr into "H,L"
	PCHL			; And take the dispatch

ENLST:	.ADDR	ENEM		; Dispatch for exam mem cmd
	.ADDR	ENEI		; Dispatch for exam I/O cmd
	.ADDR	ENEK		; Dispatch for exam konsole cmd
	.ADDR	ENEC		; Dispatch for exam cram cmd

	.SBTTL	*** "DM" CMD ***
	.SBTTL	*** "DN" CMD ***

; Deposit memory actual command code

DNDM:	CALL	INC36		; Increment memory address
	.ADDR	MEMAD		; Here is current memory address
DMCMD:	ARG36			; Otherwise, assemble the arg
	.ADDR	DMDAT		; Place to put assembled data

DM1:	XRA	A		; 0 Is the index for mem next cmds
	STA	DNEXT		; Save so "next" command will know what to do

DM2:	LXI	D,MEMAD		; Pntr to SM10 memory address

DMINT:	MVI	A,02		; Bit to say "write function"

DN2ND:	MOV	B,A		; Save function status
	CALL	ADATP		; ***** I/O WRT 103,105,107,111,113 *****

	MOV	A,B		; Get function data
	OUT	A0003		; ***** I/O WRT 113 *****

	MVI	A,04		; Bit into accum for "COM/ADR CYCLE"
	OUT	BUSARB		; ***** I/O WRT 115/4 *****

	CALL	WDATT		; ***** I/O WRT 102,104,106,110,112 *****
	.ADDR	DMDAT		; Place to get data for deposit

	MVI	A,01		; Bit into accum for "DATA CYCLE"
	OUT	DTARB		; ***** I/O WRT 114/1 *****

; Check to see if doing DI or DM

	LDA	DIFLAG		; Get the flag
	ANA	A		; Set the condition codes
	JNZ	DMCONT		; If .ne. 0, then you got the code for a DI
; Otherwise, fall thru to do a DM

				;   (latch data sent prevents false par err)
DMCONT:	OUT	BUSCTL		; *****I/O WRT 210/362 *****

	XRA	A		; Clear the accum
	STA	DIFLAG		; And clear the flag

	BUSRESP ARBRESP		; ***** I/O RD 301 *****
	JNZ	NOARB		; If no "BUS REQ", arb failed, so abort

; If that was ok, check for non-existant memory

	BUSRESP	NONXMEM		; ***** I/O RD 301 *****
	JNZ	NIXOM		; If flag says nxm, then we jump

; Else all ok....


	.SBTTL	*** "DN" CMD ***

; Routine will deposit next, just as the last

DNCMD:	LHLD	DNEXT		; Get code for which deposit is next
	LXI	D,DNLST		; Pntr to dispatch list
	DAD	D		; Add gives pntr to which is next

	MOV	E,M		; Lo order piece to reg
	INX	H		; Update mem pntr
	MOV	D,M		; Hi order piece to reg
	XCHG			; Now the dispatch goes to "H,L"
	PCHL			; And dispatch

DNLST:	.ADDR	DNDM		; Dispatch for dep next to mem
	.ADDR	DNDI		; For deposit next to I/O
	.ADDR	DNDK		; For deposit next to konsole
	.ADDR	DNDC		; For deposit next cram

	.SBTTL	*** "EI" CMD ***

EICMD:	RUN..			; Illegal command if CPU running
	JC	EI1		; Skip code if at end of command
	CALL	LICMD		; Fetch up the desired I/O address

EI1:	MVI	A,2		; Disp code for examine next..
	STA	ENEXT		; Tell examine next to come here

	LXI	D,IOAD		; "H,L" gets pntr to addr buffer

	MVI	A,^O143		; Special code for when doing DI
	STA	EIFLAG		; Pass it to routine

	MVI	A,^O14		; Bits for "I/O func" & "read func"
	JMP	EN2ND		; Jump to common code

; Examine I/O entry pnt for examine next situation

ENEI:	CALL	IO.INC		; Go increment I/O address twice
	JMP	EI1		; Then on to common code

	.SBTTL	*** "DI" CMD ***
	.SBTTL	*** "DN" CMD ***

DNDI:	CALL	IO.INC		; Go increment the I/O address twice
DICMD:	ARG36			; Otherwise go assemble the arg
	.ADDR	DMDAT		; And store it here

DI1:	MVI	A,02		; Set word that says dep next will be DI
	STA	DNEXT		; And save for "DN" cmd

	LXI	D,IOAD		; Pntr to address data to use

	MVI	A,^O160		; Set code for use by DI command
	STA	DIFLAG		; And pass it to routine

	MVI	A,^O012		; Bits to say "I/O func" & "write func"
	JMP	DN2ND		; And jump to common code

IO.INC:	CALL	INC36		; Now increment I/O address
	.ADDR	IOAD		; Its right here
	CALL	INC36		; Now increment I/O address
	.ADDR	IOAD		; Its right here
	RET			; And back

	.SBTTL	*** "EK" CMD ***

; Routine examines 8080 locations

EKCMD:	JC	EK1		; If not, no arg to be assembled

; Otherwise, must assemble arg

	ARG16			; Go get 16 bit addr to examine
	.ADDR	C80AD		; And put into current addr buffer

EK1:	MVI	A,04		; Index says EK is next
	STA	ENEXT		; Save in the RAM

	LXI	H,C80AD		; Get current addr
	CALL	P16		; And print it as is

	PSLASH			; Now a "/"

	LHLD	C80AD		; Get addr just printed
	MOV	A,M		; Pass arg to print in the accum and
	JMP	P8CRLF		;   print data plus crlf, for free

	.SBTTL	*** "EN" CMD ***

ENEK:	LHLD	C80AD		; Get current 8080 address
	INX	H		; Update
	SHLD	C80AD		; Put it back
	JMP	EK1		; Common code

	.SBTTL	*** "LA" CMD ***

LACMD:	ARG36			; Otherwise, get arg & put in 36-bit buffer
	.ADDR	MEMAD		; Place to put data
	ENDCMD			; And done

	.SBTTL	*** "LI" CMD ***

LICMD:	ARG36			; Get arg and put into a temp buffer
	.ADDR	IOAD		; This temp buffer
	ENDCMD			; And done

	.SBTTL	*** "LK" CMD ***

; Routine sets current 8080 address into ram..
; If user tries to deposit prom, too bad. he should know better

LKCMD:	ARG16			; If ok, go assemble 16 bit arg
	.ADDR	C80AD		; This is a good place to keep it
	ENDCMD			; And end

	.SBTTL	*** "DN" CMD ***

DNDK:	LHLD	C80AD		; Get 8080 address
	INX	H		; Increment by 1
	SHLD	C80AD		; Put it back

; Fall into the "DK" command

	.SBTTL	*** "DK" CMD ***

; Code to deposit into 8080 ram.. if u try to deposit prom
; its your own fault.

DKCMD:	CALL	ARG16.		; Ok, now go assemble 16 bits of data

	MOV	A,L		; Get data from loc
	LHLD	C80AD		; And current address to "H,L"
	MOV	M,A		; Write the 8-bit data
	MVI	A,04		; Get code that says 'EN' should be "konsole"
	STA	DNEXT		; And save in ram
	ENDCMD			; All done

	.SBTTL	*** "CP" CMD ***

; Command to single pulse the SM10 CPU clk

CPCMD:	JC	CP1		; If no arg, only give single CPU clk
	CALL	ARG16.		; Else get arg

; Now give number of clks requested

CPMLT:	MOV	A,L		; Lo order piece into accum
	ORA	H		; Add the hi order piece
	RZ			; All done if down to zero

	CALL	CP1		; Otherwise, give clock
	DCX	H		; Decrement
	JMP	CPMLT		; And continue till done all

CP1:	MVI	A,^O010		; Set bit for "SS MODE"
	OUT	CRMCTL		; *****I/O WRT 204/010 *****
	MVI	A,2		; Set bit for "single clk"
	OUT	CLKCTL		; ***** I/O WRT 206/2 *****
	ENDCMD			; Done..

	.SBTTL	*** "ER" CMD ***

; Command to examine one of the 8080 internal register, and display
; The contents of that register.

ERCMD:	JC	ER1		; If no arg, go use the one already in the ram

	CALL	ARG16.		; Else, pick up the arg that was typed

; Fall to here if arg ok..

	MOV	A,L		; Get actual arg into the accum
	STA	ERADDR		; Well, best save this thing in the ram
ER1:	LDA	ERADDR		; Common type code.. a no-op if arg was typed

	PUSH	PSW		; Now save accum please
	CALL	P8BITA		; Print name of 8080 reg that is being examined
	PSLASH			; And separate from its contents with a slash

	POP	PSW		; Restore accum please
	CALL	ER.UTL		; Execute the instr pair from the RAM space

; Back here and the data is in the accum

	CALL	P8CRLF		; Print the results
	RET			; And done
; Routine to execute an "in" or "out" from the 8080 RAM space

RAMXCT:	SHLD	ER.LOC		; The "in/out" and the reg number into RAM space
	PUSH	PSW		; Save accum, in case routine is an "out"
	MVI	A,.RET		; A "return" into accum
	STA	ER.LOC+2	; And then the return gets put into RAM space
	POP	PSW		; Restore accum, anyway
	CALL	ER.LOC		; Go execute the RAM loc
	CMA			; Fix hardware inversion
	RET			; Back to caller

; Routine ER.UTL.. Does an examine register, internal type format.
; No printing, just the examine.  Pass desired I/O reg address in
; accum.  Accum gets the results of the read.

ER.UTL:	PUSH	H		; Save H,L pair
	MOV	H,A		; Now, the number typed is put into hi half
	MVI	L,.IN		; And an "in" instr goes lo half

	CALL	RAMXCT		; Now actually execute the code to do the read
	POP	H		; Fix h,l
	RET			; Out

	.SBTTL	*** "LR" CMD ***

; Command to set into the 8080 RAM, the I/O register to be either 
; deposited or examined.

LRCMD:	CALL	ARG16.		; Fetch in the number typed

	MOV	A,L		; Desired reg to accum
	STA	ERADDR		; Put in 8080 RAM
	RET			; And out

	.SBTTL	*** "DR" CMD ***

; Command to deposit a number into the last specified 8080 I/O reg.

	.ADDR	T80DT		; Take arg and put into RAM space

	MVI	L,.OUT		; "L" gets the operation type we will perform
	LDA	ERADDR		; Fetch up the currently selected I/O reg
	MOV	H,A		; And put it into the "H"
	LDA	T80DT		; Now the data to be written goes to the accum

	CALL	RAMXCT		; Perform the operation
	RET			; Thats all

	.SBTTL	*** "LC" CMD ***

; Command to load the 8080 RAM current cram address

LCCMD:	ARG16			; Ok, assemble the 16 bits
	.ADDR	CRMAD		; Temp place to keep bits
	ENDCMD			; Done..

	.SBTTL	*** "CE" CMD ***

; Command to set cache enable on the CSL board
;  or perhaps clr cache enable if desired.

CECMD:	JC	CEDIS		; If no arg, display "cache enable"

	CALL	ARG16.		; Must assemble arg if fall thru

	MOV	A,L		; Arg to accum
	RAL			; Bit 0 to 1
	RAL			; Bit to 2
	RAL			; Bit to 3
	ANI	^O10		; Off all bits but the cache bit
	MOV	B,A		; Save result in "B" for a little while
	LDA	PARBT		; Get current parity bit status
	ANI	^O367		; Off the cache bit

; Here is some common code, useful by routines which must adjust
; the data in the PARBT location.

ENACOM:	ORA	B		; Add new data to defaulted "PARBT"
KS.PAR:	STA	PARBT		; Now save the new default
	OUT	RESET		; ***** I/O WRT 100/stuff *****
	ENDCMD			; And all done

; Code entered when we want to display the cache enable status

CEDIS:	LDA	PARBT		; Get current status
	ANI	^O10		; Is the cache bit set?
CHOOSE:	JNZ	PNT.ON		; Here if yes
	PLINE	OFFMSG		; Off message depending things
PNT.ON:	PCHAR	'O		; Printing "on" a char at a time saves 1 byte
	PCHAR	'N		; Over printing it as a is a little tight

	.SBTTL	*** "TE" CMD ***

; Console command to enable or disable the 1 msec clock

TECMD:	JC	TEDIS		; If no arg, display current state

	CALL	ARG16.		; Otherwise, go fetch the arg

	MOV	A,L		; Get info just typed
	RAL			; Bit 0 to 1
	RAL			; Bit to 2
	ANI	^O4		; Off all but the time bit
	MOV	B,A		; Save stuff in b
	LDA	PARBT		; Get current default
	ANI	^O373		; Off the 1 msec clock signal

	JMP	ENACOM		; Go do common code

; This code entered when we only want to display current state of 1 msec clock

TEDIS:	LDA	PARBT		; We need to report state..get default
	ANI	^O4		; Is the bit set??
	JMP	CHOOSE		; Go to common place that chooses "yes" or "no"

	.SBTTL	*** "SC" CMD ***

; Code to turn off or on, the ability to recover from soft cram errors.
; Flag  at  0, means  try  and  recover, therefore  its  the default on 
; machine power on...

SCCMD:	JC	SCDIS		; If no arg typed, go display state of SC

	CALL	ARG16.		; Else go gather up an argument
	MOV	A,L		; Arg goes into accum
	ANA	A		; Set 8080 flags
	JZ	SC.TOFF		; If zero , turn off sc soft cram recovery

; Fall thru if turning on SCE

	XRA	A		; Zero accum
	STA	SC.OFF		; So that we can set the appropriate flag
	ENDCMD			; That's it
SC.TOFF: MVI	A,-1		; Want to turn off SCE, need -1 to do it
	STA	SC.OFF		; Zap
	ENDCMD			; And out

SCDIS:	LDA	SC.OFF		; Grab the flag
	CMA			; Since 0 = on, we must invert flavor of flag
	ANA	A		; Set 8080 processor flags
	JMP	CHOOSE		; And go print the right thing

	.SBTTL	*** "TP CMD" ***

; Console command to enable or disable the ten style traps

TPCMD:	JC	TPDIS		; Go display current state if nothing typed

	CALL	ARG16.		; Otherwise, go assemble a number typed in

	MOV	A,L		; Get info that was typed
	RAL			; Bit 0 to 1
	RAL			;     1 To 2
	RAL			;     2 To 3
	RAL			;     3 To 4
	ANI	^O20		; Off all but trap bit
	JMP	TP.SET		; Jump to place that sets traps, and saves data

; Code to display current state of signal

TPDIS:	LDA	TRAPEN		; Get current state of traps bit
	ANI	^O20		; Set condition codes
	JMP	CHOOSE		; And go do it
	.SBTTL	*** "LT" cmd ***

; Console command to turn on the lights on the console front panel

LTCMD:	CLRB	KLNKSW		; force a fixing of the lights
	MVI	A,7		; load accum with a bit for each of 3 lights
	OUT	LIGHTS		; ***** I/O WRT 101/7 *****
	CALL	LTDLY		; leave lights on for about a second
	XRA	A		; clear accum
	OUT	LIGHTS		; ***** I/O WRT 101/0 *****

; Fall into code that waits a while with the lights off

LTDLY:	LXI	H,300		; delay about a second and a half

LTLOOP:	CALL	DELAY.		; Go do a little delay
	.BYTE	-1		; Max count

	DCX	H		; Down the count
	MOV	A,L		; Get piece of the count
	ORA	H		; Throw in the rest of the count
	JNZ	LTLOOP		; Continue waiting
	LDA	STATE		; (5.2A) Must guarantee DTR has been restored
	OUT	DTR		; (5.2A) Do it
	RET			; Until all done

	.SBTTL	*** "MM" CMD ***

; Command to put the 8080 into manufacturing mode.  Sets the state for
; the KLINIK line then sends a communications clear to whatever is  at
; the other end of the KLINIK line.

MMCMD:	CALL	SETM4		; Set KLINIK line to Mode 4
	MVI	A,^O41		; We must always reset the message numbers
	STA	LSTMSG		; This is the "receive" message number
	STA	ENVMNO		; And this is the "send" message number
	STA	MMFLG		; Say manufacturing mode has been entered
	CALL	Z.TBUF		; Clear some communication DEC10 buffers
	JMP	DECEX2		; Clear the mailing envelopes
				; **Using jmp uses other guy's return to return

	.SBTTL	*** "SI" CMD ***

; Command to cause SM10 to execute a single instr.

SICMD:	IN	RUNFP		; Before continuing,must read machine state
	ANI	4		; Is RUN flop set (already running?)(true lo)
	JZ	YSRUN		; If yes, go print ?RUN msg and abort command

	MVI	A,01		; Set bit for "CONTINUE"
	OUT	CPUCTL		; ***** I/O WRT 212/1 *****
	CALL	DNF		; Check that instr finished
	JMP	PCCOM		; And go to type out the pc

	.SBTTL	*** "CS" CMD ***

; Command to start the SM10 CPU clk running.

	XRA	A		; Clr accum to clr "SS MODE"
	OUT	CRMCTL		; ***** I/O WRT 204/0 *****
	MVI	A,03		; Set bits for "CLK RUN" & "SINGLE CLK"
	OUT	CLKCTL		; ***** I/O WRT 206/3 *****
	ENDCMD			; Done..

	.SBTTL	*** "CH" CMD ***

; Command to halt the SM10 CPU clk

CHCMD:	CALL	CLRRN		; Clear clk "RUNNING" flag
	MVI	A,^O010		; Set bit for "SS MODE"
	OUT	CRMCTL		; ***** I/O WRT 204/010 *****
	XRA	A		; Clr bits for "SINGLE CLK" & "CLK RUN"
	OUT	CLKCTL		; ***** I/O WRT 206/0 *****
	ENDCMD			; Done..

	.SBTTL	*** "LF" CMD ***

; Command to "load function".  Specifies which diag function write
; to do on the next "DF" commands.

LFCMD:	CALL	ARG16.		; Go assemble 16 bit arg(we only need 4 bits)

	SHLD	CRMFN		; Permanent home for data
	ENDCMD			; Done..

	.SBTTL	*** "DF" CMD ***

; Routine writes the data typed using the diag function
; previously specified by LF command.

DFCMD:	RUN..			; Is CPU running?

	CALL	ARG16.		; Go assemble arg

; Next routine does lots of I/O WRTs to SM10 CPU all while trying to
; write diagnostic address reg for CRAM loading or reading..

	PUSH	H		; Save data to be deposited
	CALL	CRM.AD		; Write the cram address
	POP	H		; Get data to be deposited

WFUNC:	MOV	A,L		; Get data for bits 28-35 into accum
	OUT	A2835		; ***** I/O WRT 103 *****
	MOV	A,H		; Get data for bits 20-27
	OUT	A2027		; ***** I/O WRT 105 *****

WFNC1:	XRA	A		; Clr accum
	OUT	BUSARB		; ***** I/O WRT 115/0 *****

	MVI	A,^O144		; Bits for "CONS REQ","T ENB FOR COM/ADR","CRA R CLK"
	OUT	BUSCTL		; ***** I/O WRT 210/144 *****

	LDA	CRMFN		; Get diag function
	OUT	DIAG		; ***** I/O WRT 205/fnc *****

; Note that "TRAP EN" was just zapped, but it is only useful if the
; micro-code is running and anything you do  to  get the micro-code
; running  will  restore the trap enable.  This  kludge  speeds  up
; micro-code load.

	MVI	A,^O40		; Bit for "CRAM WRT"
	OUT	CRMCTL		; ***** I/O WRT 204/40
	XRA	A		; Bit to clr "CRAM WRT"
	OUT	CRMCTL		; ***** I/O WRT 204/0 *****
	ENDCMD			; Done..

; Simple little routine to save some space..used in several places

CRM.AD:	LHLD	CRMAD		; Load diag addr to be written

; Routine counts on data in "H,L"..destroys "H,L"...

CADWR:	MVI	A,01		; Bit for cram reset
	OUT	CRMCTL		; ***** I/O WRT 204/1 *****
	XRA	A		; Clr bit to clr cram reset
	OUT	CRMCTL		; ***** I/O WRT 204/0 *****

; ***** I/O WRT 103,105,107,111,113 *****

	MOV	A,L		; Lo order 8 bits to accum
	OUT	A2835		; Set in hardware reg
	MOV	A,H		; Hi order 4 bits to accum
	OUT	A2027		; Set into hardware reg

	XRA	A		; Clr accum
	OUT	A1219		; Clr other hardware regs
	OUT	A0411
	OUT	A0003

	OUT	BUSARB		; ***** I/O WRT 115/0 *****

	MVI	A,^O144		; Bits for "CONS REQ", "T ENB FOR COM/ADR","CRA R CLK"
	OUT	BUSCTL		; ***** I/O WRT 210/144 *****
	MVI	A,^O21		; Bit for "crm addr load"
	OUT	CRMCTL		; ***** I/O WRT 204/21
	XRA	A		; Bit to clr cram addr load
	OUT	CRMCTL		; ***** I/O WRT 204/0 *****
	RET			; And return

; Routine to read a single diag func worth of stuff from
; the CRA/CRM processor boards.

READC:	MOV	D,A		; Save diag func for a sec..
	LDA	TRAPEN		; Get current value for trap enables
	ORA	D		; Mix together
	OUT	DIAG		; ***** I/O WRT 205/fnc *****
	OUT	BUSCTL		; ***** I/O WRT 210/115 *****	

	IN	D2835		; ***** I/O RD 0 *****
	CMA			; Fix inversion
	STA	TMPB2		; Save in standard buffer

	IN	D2027		; ***** I/O RD 1 *****
	CMA			; Fix inversion
	ANI	^O17		; Keep only 12-8
	STA	TMPB2+1		; Save in standard buffer

	XRA	A		; Clr accum
	OUT	BUSCTL		; ***** I/O WRT 210/0 *****

	RET			; Return
	.SBTTL	*** "RC" ***

RCCMD:	RUN..			; Is CPU running?

RCINT:	XRA	A		; Clear accum for use as a counter
	LXI	B,CRMBF+^D31	; Pntr to a buffer area to save "RC's" as read
RCLP:	MOV	E,A		; Save in "E" reg
	CALL	READC		; Read a diag func from CRA/CRM brd

; Now print what was read

	LDA	NOPNT		; We will make it quicker if not printing results
	ANA	A		; Set flags
	JNZ	RCNOP		; If no print, avoid typing code

	MOV	A,E		; Put in mem for print routine
	CALL	P8BITA		; Print name of this diag func
	PSLASH			; And "/"
	CALL	P16.		; And print it

	PUSH	B		; Save couple regs while go decnet
	CALL	DECNET		; Yes.. send this group of data down the KLINIK line
	POP	D		; Retrieve those registers

; Code for saving the results of these function reads in the 8080 RAM space
; for now we will save the  results in the place where cram data is kept.

RCNOP:	LHLD	TMPB2		; Fetch up the data that was actually read
	MOV	A,H		; Get lo order piece to accum
	STAX	B		; Store to place pointed to by "D,E"
	DCX	B		; Update the storage pointer
	MOV	A,L		; Get hi order piece of cram data
	STAX	B		; Save in storage area
	DCX	B		; Again downdate pointer to begining of actual

	INR	E		; Increment it
	MOV	A,E		; Copy current count to accum for the compare
	CPI	^O20		; Reached max yet??
	JNZ	RCLP		; Back if not yet..

; Otherwise 

	ENDCMD			; Done...

	.SBTTL	*** "EJ" CMD ***

; Console  command  to  display the flow of the control store by printing
; out the current "J-Field", "NEXT LOC", "SUBROUTINE RET REG", & "CURRENT

EJCMD:	RUN..			; Is CPU running?
	LXI	H,EJLST		; First get a pntr to ascii text
	LXI	B,^B10010000111 ; Set B=4 & C="10,00,01,11"

EJLP:	MOV	A,C		; Copy diag func string to accum
	ANI	3		; Strip all but lo order 2 bits

EJ1:	CALL	READC		; Go read diag func as given by accum

	CALL	PLN1		; Print ascii identifier for this func

	PUSH	H		; Save "H,L"
	CALL	P16.		; And go print it as 16 bit octal
	POP	H		; Get "H,L" back

	MOV	A,C		; Get function picker
	RRC			; Shift function list
	RRC			;  2 places
	MOV	C,A		; Put back function

	DCR	B		; Now down the counter
	JNZ	EJLP		; And jump to the executing code

	PCRLF			; And a CR-LF

; Else.. end of command

	ENDCMD			; Return to caller

EJLST:	.ASCIZ %CUR/%		; Func 03 is current cram location
	.ASCIZ %NXT/%		; Func 01 is next loc
	.ASCIZ %J/%		; Func 00 is j-field
	.ASCIZ %SUB/%		; Func 02 is subroutine return reg

	.SBTTL	*** "TR" CMD ***

; This console  command  traces  the  flow of the micro-code by typing
; the 4 known addresses from the control RAM address brd, then issuing
; a single CPU pulse and continuing this until the user types carriage
; return.

TRCMD:	JC	TR1		; If no arg, go like normal
	ARG16			; If was arg, go get it
	.ADDR	BRKDT		; Place to put it

	MVI	A,^O77		; Now any arbitrary,non-zero value
	STA	BRKON		; To say that breaking is on..

TR1:	RUN..			; Is CPU running?
	CLRB	RPEND		; So can clr cmd cntr
TR:	LDA	BRKON		; Check if break is on
	ANA	A		; Check flag
	JZ	TRLP		; If zero, don't look at break stuff
	LXI	D,BRKDT		; Pass pntr to the desired stopping address
	CALL	BREAK		; If flag set, call to check address
	RZ			; If return with Z-set, we are at break place

TRLP:	CALL	PULSE		; Give pulse
	PCRLF			; Carriage return line feed

	LDA	RPEND		; Get cmd cntr
	ANA	A		; Is it set?
	JZ	TR		; Well, cont loop if not yet

; Otherwise, end the command

	CLRB	BRKON		; And clr the flag
	ENDCMD			; Done..

	.SBTTL	*** "PM" CMD ***

; Console command to "pulse" "micro-code".  Ie., give a single pulse and
; then an "EJ" command. Command is equivalent to the "TR" trace command,
; only executing the trace once.

PMCMD:	RUN..			; Is clk running?

PULSE:	CALL	CP1		; Go do a single clock
	CALL	EJCMD		; Type control store addresses & exit from there
	ENDCMD			; And out

	.SBTTL	*** "EC" CMD ***

; Routine to read the C-RAM and type it out

ECCMD:	RUN..			; Is CPU running?
	JC	EC2		; If no arg, don't go assemble one
	CALL	LCCMD		; Fetch up desired cram address

EC1:	CLRRM	TMPB2		; Zap a temporary buffer

	CALL	CRM.AD		; Now write desired cram address
	CALL	CP1		; And give a single clk pulse to load cntrl reg

EC2:	MVI	A,06		; Set up "examine next" type commands
	STA	ENEXT		; Save examine stuff in ram

; Now ready to read the control reg

	LXI	H,RDLST		; Get pntr to diag functions to be read

ECLP:	MOV	A,M		; Get diag function to accum
	INX	H		; Update pntr
	ANA	A		; Was fnc end-of-list(yes if was minus)
	JM	ECBEE		; Jmp if was end of list

; Otherwise, we must do a diag function

	CALL	READC		; Go read this diag func,data returned in "TMPB2"
	SHLD	ECSAV		; Now save "H,L" for a minute

	LXI	H,TMPB2		; Pointer to data just read
	CALL	OCTAL		; Now turn data into ascii octal chars
	.BYTE	2		; Two bytes relevant data
	.BYTE	4		; Want 4 octal chars

	LHLD	ECSAV		; Restore the "H,L"
	JMP	ECLP		; And continue till read all diag funcs
; When you get to here, you've read all funcs, now read & cmp A & B copies

ECBEE:	MOV	A,M		; Get diag func for an "A" copy
	INX	H		; Update mem pntr
	ANA	A		; Did diag func have minus sign?
	JM	PCRAM		; Done list, jmp if was minus

; Otherwise, go and read the "A" copy again

	CALL	READC		; Data returned in "TMPB2"
	MOV5B			; Move that data to 2nd tmp buff
	.ADDR	TMPB2		; Src of data
	.ADDR	TMPBF2		; Place to put it

	MOV	A,M		; Get diag func for a "B" copy
	INX	H		; Update pntr
	CALL	READC		; Now read a "B" copy

	PUSH	H		; Save "H,L"
	CALL	CMP36		; Now compare the "A" and "B" copies
	.ADDR	TMPB2		; "B" copy
	.ADDR	TMPBF2		; "A" copy
	POP	H		; Restore "H,L"
	JZ	ECBEE		; If checked ok, back to read next "A/B" copies

; Fall thru to verify error if "z" not set

	JMP	RCINT		; Go print all cram regs

; If "A/B" copies verified, time to print C-RAM contents

PCRAM:	MVI	A,03		; Diag func to read "current cram location"
	CALL	READC		; Go read current cram loc..
	CALL	P16.		; Print it
	PSLASH			;  And "/"

; Now print the 32 octal chars.......

	MVI	B,32.		; Num chars to print
PCRLP:	POP	PSW		; Get a char
	CALL	PCHR		; Print it
	DCR	B		; Down count of chars printed
	JNZ	PCRLP		; Loop till done

	PCRLF			; Need cr-lf

	ENDCMD			; Then out

RDLST:	.BYTE	^O17		; Read 84-95
	.BYTE	^O16		; Read 72-83
	.BYTE	^O15		; Read 60-71
	.BYTE	^O14		; Read 48-59
	.BYTE	^O12		; Read 36-47a
	.BYTE	^O5		; Read 24-35a
	.BYTE	^O4		; Read 12-23
	.BYTE	0		; Read 0-11
	.BYTE	^O377		; End byte
	.BYTE	^O12		; Read 36-47a
	.BYTE	^O13		; Read 36-47b
	.BYTE	^O5		; Read 24-35a
	.BYTE	^O6		; Read 24-35b
	.BYTE	^O377		; End byte

	.SBTTL	*** "EN" CMD ***

ENEC:	LHLD	CRMAD		; Get current address
	INX	H		; Update it
	SHLD	CRMAD		; Put it back
	JMP	EC1		; Go to common code

	.SBTTL	*** "DC" CMD ***
	.SBTTL	*** "DN TO DC" CMD ***

; Code used in deposit next for the cram

DNDC:	LHLD	CRMAD		; Get current address
	INX	H		; Increment it
	SHLD	CRMAD		; Put it back

DCCMD:	RUN..			; Is CPU running?
	CALL	ARG96		; Assemble data to deposit
	.ADDR	CRMTM		; Place to put it

	LXI	D,CRMBF		; Place to put the results of the cram shuffle
	LXI	H,CRMTM		; The old 12-byte format will always be here
	MVI	C,4		; Load "C" with a 4

; Begin the unpacking

GENLP:	CALL	PLACE		; Local routine that takes 12 bits of 24.
	MVI	A,3		; A shift 24 requires 3 bytes of data to shift
	CALL	SHR24		; Shift 12 bits just packed into outer space
	.BYTE	12.		; Tell routine 12 places
	CALL	PLACE		; Now routine will get 12 more bits..12+12=24

	INX	H		; Update pntr 3-bytes(ie 24 bits)

	DCR	C		; Down the counter (there are 4 groups of 24=96)
	JNZ	GENLP		; Continue till done the 4 groups

	CALL	CRM.AD		; Write the cram address
	LXI	H,CRMBF		; Get place where info was just placed

	MVI	A,06		; Number for deposit next to use
	STA	DNEXT		; Standard place to keep it
	INR	A		; Set function .eq. 7 (INR works by luck)
	LXI	B,CRMFN		; Set an address into "B,C" register,to use as a pointer
DCLP:	STAX	B		; Save it in the RAM at loc "CRMFN"

	MOV	E,M		; Get 8 bits of data
	INX	H		; Update pntr
	MOV	D,M		; Get 4 more bits of data
	INX	H		; And update pntr again

	XCHG			; Now "H,L" contains the data & "D,E" the pntr
	CALL	WFUNC		; And diag function wrt
	XCHG			; Pointer back to "H,L"

	LDAX	B		; Get particular diag func from RAM loc
	DCR	A		; Down to next
	JP	DCLP		; As long as 0-7, keep going
	ENDCMD			; Now all done

	.SBTTL	*** "SM" CMD ***

; Code to start the micro-code at the address specified.  Defaults to
; starting at C-RAM loc 0 if no address is given.

SMCMD:	JC	SM1		; If no arg, supply address of 0000

; Otherwise must assemble the given address

	CALL	ARG16.		; Assemble 16-bits of argument

	JMP	SM1.5		; Otherwise, continue normally

SM1:	LXI	H,00		; If here, desire address of 0000
SM1.5:	SHLD	T80DT		; Set addr

	CALL	MRCMD		; Reset the machine

	MOV5B			; Set up initial data
	.ADDR	ONES		; Data to be is all ones
	.ADDR	DMDAT		; Place where it goes

	LXI	D,MAD000	; Get address of mem loc 0
	CALL	DMINT		; "Deposit memory" internal format

	LDA	PARBT		; Get parity stuff
	ANI	^O140		; Only keep a little bit
	OUT	RESET		; And turn of all parity stuff while we do this

	LHLD	T80DT		; Get start address of micro-code to "H,L"
	CALL	CADWR		; Write the diag address reg

	CALL	CSCMD		; Start the CPU clk free run
HLTCM:	CALL	DELAY.		; Now wait for micro-code to reach halt loop
	.BYTE	-1
	CALL	CLRUSE		; Exit from user mode
	IN	RUNFP		; ***** I/O RD 300 *****
	CMA			; And fix inversion
	ANI	^O10		; Is CPU in the halt loop?
	JNZ	SMVER		; Jump if yes..appeared to start ok

; Fall to here if SM10 did not set halt loop flag

	PLINE	SMERR		; Print err message
	STC			; Set C-Bit to indicate an error exit
	JMP	SMFINI		; And exit via restore parity path

SMVER:	INTON			; Set interal status for the examine
	EXAM	0		; Examine mem loc 0(micro-code stop code)
	INTOFF			; Turn off internal status

; It did succeed in setting halt loop flag, so merely print halted
; And the data in location 0..
; ****Subroutine "stop code" ****

	CALL	SETRN		; Just a little kludge - cheap way to fix state
				;   light if program executed a "HALT" while
				;   lites were blinky

	PLINE 	HLTMS		; Print "HALTED" message
	LXI	H,EMBUF		; Pntr to data in loc 0
	CALL	P18		; Print right half of 36-bit data
	CLRB	CHKHLT		; Set flag to say weve typed halted already

	PSPACE			; Print a space
	PSPACE			; And another
PCCOM:	INTON			; Set internal mode
	EXAM	1		; Examine word which holds the pc
	INTOFF			; Clr internal mode
	PLINE	PCMSG		; Print "PC/"
	CALL	P36.		; And print the pc
	PCRLF			; Print carriage return line-feed
	ANA	A		; Clear the C-Bit 'cause all ok

; And before we leave,restore the parity stuff

SMFINI:	LDA	PARBT		; Get current parity defaults
	OUT	RESET		; Restore the parity detects
	RET			; And out
MAD000:	D	0,0,,0,0	; Memory address 0
				; From memory location 0

	.SBTTL	*** "PE" CMD ***

; Command to enable various parity checks normally made by the 8080..
; Acceptable parity commands are:
; 	PE	0	; "disable" all parity detection
; 	PE	1	; "enable" "DP" parity detect
; 	PE	2	; "enable" "CRM" parity detection
; 	PE	4	; "enable" "PE" parity det (clk freeze on par err)
; 	PE	7	; "enable" all
; Bits are weighted for the three types of parity errors

PECMD:	JC	PARDIS		; Command requires arg

	CALL	ARG16.		; Assemble typed arg

	MOV	A,L		; Get number typed into the accum
	ANI	^O7		; Keep only appropriate bits
	RAL			; Bit 0 into bit 1
	RAL			; Bit 0 into bit 2
	RAL			;       into bit 3
	RAL			;       into bit 4

	MOV	L,A		; Save in l
	LDA	PARBT		; Now get current status
	ANI	^O217		; Off the old crummy parity
	ORA	L		; Throw in these new bits

	JMP	KS.PAR		; Save in RAM place & write to ks

; This is the code for if we want to display the parity

PARDIS:	LDA	PARBT		; Get the current parity status
	ANI	^O160		; Clr crud, just saving parity bits
	RAR			; Rotate to justify the bits at bit 0

P8CRLF:	CALL	P8BITA		; And go print those 8 bits
	PCRLF			; Terminate all with a cr-lf
	ENDCMD			; All done

	.SBTTL	*** "EX" CMD ***

; Console command to execute a single SM10 "ten order" instruction

EXCMD:	ARG36			; Go assemble the instr to be executed
	.ADDR	EMBUF		; Place to put it

EXINTM:	LXI	D,EMBUF		; Pointer to instr into "D,E"

EXINT:	CALL	WDATP		; ***** I/O WRT 102,104,106,101,112 *****

	MVI	A,2		; Set bit for "I/O DATA CYCLE"
	OUT	DTARB		; ***** I/O WRT 114/2 *****

	MVI	A,3		; Bits for "EXECUTE" & "CONTINUE"
	LXI	H,HSBFL1	; (5.2F) Set "H,L" Register to special HSB flag
	ADD	M		; (5.2F) Add it in (for FRC will add in "RUN")
	OUT	CPUCTL		; ***** I/O WRT 212/3 *****
	MVI	M,0		; (5.2F) Clear HSB flag

	NOP			; Wait

	IN	RUNFP		; ***** I/O RD 300 *****
	CMA			; Fix inversion
	ANI	1		; Is CONTINUE still set?
	RZ			; If clr, we are ok...

; If CONT still set, we have an error

	CALL	CLRUSE		; Exit from user mode
	CMA			; Accum now .eq. -1
	ANA	A		; Set flags, so "JNZ" will jump
	RET			; And return

	.SBTTL	*** "ST" CMD ***

; Console command to issue a start to the CPU

STCMD:	CALL	LACMD		; First go assemble a legal address to start at
	MOV5B			; Move to tmp buff so don't kill "MEMAD"
	.ADDR	TMPBF2		; Temp place to keep it

STINT:	CLRRM	DMDAT		; Must clr comm words before we start
	DEPOS	32		; Clear loc 32 (the tty input word)
	DEPOS	33		; Clear 33 (the tty output word)

	LDA	GOCODE		; (5.2F) Byte 28-35 gets the reason for reload
	LXI	H,DMDAT		; (5.2F) Make H,L point to the desired buffer
	MOV	M,A		; (5.2F) Set GOCODE bits into the byte "DMDAT"

	DEPOS	31		; Clear loc 31 (keep alive word)

	LXI	H,^O2540	; Load "H,L" with "JRST" opcode
	SHLD	TMPBF2+3	; And put into the buffer where the addr is

	LXI	D,TMPBF2	; Now set pointer to the instr
	CALL	EXINT		; And go handle just like an execute
	RNZ			; If non zero, the execute failed

; And now fall into the "continue" command

	.SBTTL	*** "CO" CMD ***

; Console command to issue continue to CPU

COCMD:	CALL	SETUSE		; Enter user mode
	MVI	A,5		; Set bits for "CONTINUE" & "RUN"
	LXI	H,HSBFL2	; (5.2F) Set "H,L" Register to special HSB flag
	SUB	M		; (5.2F) Subtract (for FRC remove "CONTINUE")
	MVI	M,0		; (5.2F) Clear HSB flag
	OUT	CPUCTL		; ***** I/O WRT 212/5 *****
COINT:	STA	CHKHLT		; And guarantee that any fast halts will get reported

	PLINE	KSPRMT		; Want to tell user when we switch modes

; And jump off to common code that checks the continue bit
; and errs if continue has not been cleared by the CPU.

	JMP	DNF		; Go....

	.SBTTL	*** "HA" CMD ***

; Console command to halt the SM10 CPU.  CPU micro-code should enter
; the halt loop.

HACMD:	XRA	A		; Clr accum for "RUN","EXECUTE" & "CONTINUE"
	OUT	CPUCTL		; *****I/O WRT 212/0 *****
	JMP	HLTCM		; And finishes up just like "SM" command

	.SBTTL	*** "SH" CMD ***

; Command to cause the Tops20 monitor to begin an orderly system shutdown

SHCMD:	MOV5B			; Move us some data
	.ADDR	.DSBASE		; From here (0,,776700)
	.ADDR	DMDAT		; To here. place for deposit to find it

	DEPOS	30		; And do it
	CALL	SETUSE		; Now be sure we enter the user mode again
	MVI	B,^O200		; Set sign bit so as to ignore "KEEP-ALIVE"
	CALL	STATEM		; Go do the stuff without
	.BYTE	^O377		;   changing things
	JMP	COINT		; Return to user mode to watch montr "SHUTDOWN"

	.SBTTL	*** "KL" CMD ***

; KLINIK command

KLCMD:	JC	KLDIS		; Display current state if nothing typed

; Else assemble the typed in arg

	CALL	ARG16.		; Permit 16 bit wide type in

; Now verify that lower half is a legal number

	MOV	A,L		; Lo half to accum
	ANA	A		; Set condition codes
	JZ	KLOFF		; If typed zero, go turn off KLINIK

; Now fall thru here if .eq. 1, must turn on the KLINIK

	STA	KLLINE.ON	; Set bit to say that KLINIK is on
	RET			; And out
KLOFF:	STA	KLLINE.ON	; Get here if accum was zero.. zap KLINIK flag

; And fall into code to see if the end of KLINIK must force a change in the
; state of the KLINIK line and user.  Ie., if in Mode 3, we must force user
; into Mode 2.

	LDA	CSLMODE		; Get current mode
	CPI	.MODE3		; Is it Mode 3?
	CZ	SETM2		; Set Mode 2 if not in there
	RET			; And out

; Here if just want to display current KLINIK state

KLDIS:	LDA	KLLINE.ON	; Get current value
	ANA	A		; Set flags
	JMP	CHOOSE		; Go display the appropriate message

	.SBTTL	*** "TT" CMD ***

TTCMD:	CALL	SETUSE		; On this command we desire that cty enter user mode
	LDA	CSLMODE		; (5.2A) Check KLINIK status - put into Mode 2?
	SUI	.MODE2		; (5.2A) Is mode less than Mode 2?
	JP	SETM2		; (5.2A) No - ok to set Mode 2 - so go do it
	CLRB	KLNKSW		; (5.2A) Clear KLINIK status word - force 
				;   reexamination of the switches ...
	RET			; Now return

	.SBTTL	*** "PW" CMD ***

; Command for setting a password into the 8080, so that the KLINIK line
; user will have something  to  match against when he tries to get into 
; the system.

PWCMD:	CLRB	KLNKSW		; On any password command, force re-examination
				;   of the KLINIK mode

; Now do the normal stuff u need to do with this command

	JC	PW.CLR		; If no pw typed, go clr password

; Fall thru else.. ie must set the password

PW.SET:	LHLD	.ARG1		; Get pointer to the type-in buffer
	LXI	D,PASSWORD	; Point to buffer area where password will be
	MVI	B,-6		; Set a max count for length of the password

PW.LOOP: MOV	A,M		; Copy a password character to the accum
	CPI	EOLCH		; Is it end of line?
	RZ			; If yes, simple return

; Fall to here if more to be moved

	CALL	UP.LO		; Upper case only
	STAX	D		; Move a character to the save buffer
	INX	D		; Update destination pointer
	INX	H		; Update source pointer
	INR	B		; Update character count
	JNZ	PW.LOOP		; Stay in the loop

; Fall thru when done 6 chracters.. that had better be all, else error

	MOV	A,M		; Get 7th character
	CPI	EOLCH		; It better be end
	RZ			; If yes, was end of line, then ok to return

; Fall thru when user typed too many characters

	PLINE	PWLEN		; Err message
PW.CLR:	CLRRM	PASSWORD+1	; Clear 5 bytes of the 6 byte buffer
	DCX	H		; Pointer came out good
	MVI	M,0		; Clr the 6th byte of the buffer
	RET			; That's all

	.SBTTL	*** "MK" & "UM" CMD ***

; Console command to mark and umark specified micro-code locations

UMCMD:	MVI	C,0		; We are clearing the mark bit..
	JMP	MRKCM		; And go save it as a flag for what we're doing

MKCMD:	MVI	C,1		; A bit says we are setting the mark bit
MRKCM:	PUSH	B		; Save "B,C", it has data for set or clear
	RUN..			; Is CPU running?
	CALL	LCCMD		; "C-Bit" is clr..go assemble a legal ram-addr
	CALL	CRM.AD		; Set diagnostic address reg
	CALL	CP1		; Give single pulse to get data where I can read

	MVI	A,^O17		; Get function read for cram data that includes mrk
	CALL	READC		; Do the diagnostic function read
	CALL	CRM.AD		; Set diagnostic address reg
	LXI	D,TMPB2		; Get pntr to data that has the mark bit
	POP	B		; Get instr type

	LDAX	D		; Get the actual data
	ANI	^O376		; Clear bit 0
	ORA	C		; Now either set or clear the bit

MRKRT:	STAX	D		; But data back, new mark bit status

	CALL	ADATP		; Write data to bus reg

	MVI	A,7		; Now wish to do function write 7
	STA	CRMFN		; Set into func word

	JMP	WFNC1		; And finish up by writing data back

	.SBTTL	*** "ZM" CMD ***

; Console command to zero the SM10 MOS memory..

ZMCMD:	CLRRM	MEMAD		; Clear memory address buffer(to start at 0)
	MVI	A,2		; Bits to say write type function
	STA	MEMAD+4		; Write into the buffer

	CLRRM	DMDAT		; Data to deposit is all zeroes

	INTON			; Internal mode on
	CALL	DM1		; Deposit zeroes into first location
ZM1:	CALL	INC36		; To next address
	.ADDR	MEMAD		; Here it is

	LXI	D,MEMAD		; Do part of the deposit here, for speed  sake
	CALL	ADATP		; Load up bus regs with the desired data
	MVI	A,4		; Now function type bit into accum
	OUT	BUSARB		; ***** I/O WRT *****

	CALL	DMGO		; Now go do the deposit

; And check to see if got a nxm

	LDA	ERRCD		; Get error code..
	ANA	A		; Check if set
	JZ	ZM1		; If no errors yet, keep going

; Fall thru when had "no data acnowledge" error

	INTOFF			; Clear internal mode
	ENDCMD			; And done

	.SBTTL	*** "RP" CMD ***

; Note:  the list of saved command dispatches is not in the normal 8080
; address the command list is saved in pairs of bytes as:
;   Hi order piece first..
;   Lo order piece second..

RPCMD:	JNC	RP1		; If arg, begin at a special place
	XRA	A		; Clr accum
RP0:	STA	RPCNTR		; There is no repeat count
	CALL	RPFOO		; In the beginning you must reset the pointers
	XRA	A		; Clr accum
	STA	RPEND		; Clr the repeat killer
	CMA			; Make accum .eq. -1
	STA	RPTON		; That repeat function is turned on
	JMP	RP2		; Continue...

RP1:	CALL	ARG16.		; Fetch the arg that was typed

	MOV	A,H		; It must only be 256 or less
	ANA	A		; Set processor flags
	JNZ	KILNM		; If .gt. 256, then bad number

; Fall thru if accum 0

	MOV	A,L		; Get real arg into accum
	INR	A		; Set accum 1 greater than actual
	JMP	RP0		; Continue by initing flags

RPTRTN:	LDA	RPEND		; Next thing is to see if time to stop repeat
	ANA	A		; Test data
	JNZ	RP.OUT		; And end the repeat if "end" flag is set
RP2:	LHLD	RPLST		; Get pointer to command dispatch list
	MOV	A,M		; Check byte..make sure its not the end-of-list
	INR	A		; If it was -1, now its a zero
	JNZ	RP4		; And go back too

	LDA	RPCNTR		; Check if this is a counted repeat
	CZ	RPFOO		; It was end of list if u got here, so fix pointers
	ANA	A		; Set flags
	JZ	RPTRTN		; If .eq. 0 no count on the repeat

	DCR	A		; There is a counter, down it
	STA	RPCNTR		; Save new count
	CPI	1		; See if at bottom line
	CNZ	RPFOO		; If a counted repeat, fix end of list only if more to do
	JNZ	RPTRTN		; Jump if no

RP.OUT:	XRA	A		; Clear accum prior to leaving
	STA	RPTON		; Turn off the "on" flag
	RET			; And here if yes

RP4:	MOV	D,M		; If it was ok.. start assembling the dispatch
	INX	H		; Update to lo order piece
	MOV	E,M		; And dispatch is now in "D,E"
	INX	H		; Update pointer
	SHLD	RPLST		; Save pointer to where we are in cmd list

	LXI	H,NULLW		; "H,L" gets place we want to return to
	PUSH	H		; Place on stack so that "ret" ins comes here
	XCHG			; Dispatch address into "H,L"

	MOV	A,H		; Get hi order piece of addr to see if arg
	ANA	A		;   was typed with this command..set flags
	JP	RPGO		; If sign bit clr, cmd got no arg

; Otherwise must set the C-Bit to tell cmd to look for arg

	ANI	^O177		; Clr sign bit
	MOV	H,A		; Put it back for correct dispath
	STC			; Set C-Bit if neccessary
RPGO:	CMC			; Set C-Bit for this command to see
	PCHL			; And go do it..
; If reached end of the dispatch list, then this code resets
; The pointer back to the beginning of the list

RPNEW:	CMA			; Rpfoo doesnt touch accum, set accum to -1
	STA	CMDS..		; Now zap the first in line flag
RPFOO:	LXI	H,RPINI		; Buffer beginning address
	SHLD	RPLST		; Put back into ram
	LXI	H,RPTBFI	; Pointer to data buffer
	SHLD	RPBUFS		; Reset into holding location
	RET			; And return

	.SBTTL	*** "DS" CMD ***

; Command to select non default disk unit and unibus adapters for booting
; from disk

DSCMD:	PLINE	Q.UBA		; Message to ask for "UNIBUS ADAPTER" to be used
	CALL	PICKUP		; Go fetch the response that was typed
	JC	DS1		; If nothing typed, leave uba as currently selected

; Fall into here if a new UBA number was typed

	LDA	TMPB2		; Grab the new UBA number as typed
	RLC			; The UBA number is justified "*4" in a byte
	RLC			; Takes 2 rotates to get it justified
	STA	DSKUBA		; And save the new value in the RAM

DS1:	PLINE	Q.RH		; Ask for an RH11 to use
	CALL	PICKUP		; Get what was typed
	JC	DS2		; If nothing typed, do nothing

	MOV5B			; Now save this new disk base
	.ADDR	TMPB2		; This is where the data should be sitting
	.ADDR	DSBASE		; This is where we will keep it

DS2:	PLINE	Q.UNIT		; Ask for a unit number to boot from
	CALL	PICKUP		; Go fetch what was typed
	RC			; If nothing typed, then all done. return from this cmd

; Fall to here if a unit was typed..go set the unit to be used

	LDA	TMPB2		; Get number typed for the new unit
	STA	UNITNM		; Set it into RAM as the new value
	RET			; All done this command....

	.SBTTL	*** "MS" CMD ***

; Command to select what magtape to boot from

MSCMD:	PLINE	Q.UBA		; Ask for a unibus adapter to load from
	CALL	PICKUP		; Get what was typed
	JC	MS1		; If nothing, leave uba alone.. go get the next thing

; Fall into here if a new UBA was selected

	LDA	TMPB2		; Get the new UBA typed
	RLC			; UBA numbers must be justified on byte boundary *4
	RLC			; Takes two shifts to set the UBA number
	STA	MTAUBA		; Save the new UBA value in the RAM

MS1:	PLINE	Q.RH		; Ask for a new RH11 to use
	CALL	PICKUP		; Fetch what was typed
	JC	MS1.5		; If nothing typed, then do nothing

	MOV5B			; If something typed, get it from the buffer
	.ADDR	TMPB2		; Place where the stuff was put
	.ADDR	MTBASE		; Place where we keep the magtape base reg
MS1.5:	PLINE	Q.TCU		; Go ask for a unit number
	CALL	PICKUP		; Go see what was typed
	JC	MS2		; If nothing type, leave value alone.. go around this.

; Fall to here if need to set a new unit number

	LDA	TMPB2		; Get what was typed
	STA	TAPEUNIT	; Set in the new unit number

MS2:	PLINE	Q.DEN		; Now go see what density to set for the magtape
	CALL	INBUF		; Update buffer pntr. This case different from
				;  the others. We must examine ascii, not octal
	JC	MS3		; But if nothing typed, go ask for a new slave
; Fall thru if need to set a density....
; Now H,L reg points to the string just typed in

	PUSH	H		; Save pointer to the typed in buffer
	LXI	D,EIGHT0	; Get pointer to the "800" list
	CALL	STRCMP		; Now do a string compare
	JNZ	S16CHK		; If was not an "800", see if its a "1600"

; Ok, it was set up the channel data to say 800 BPI tape

	MVI	A,2		; A 2 is the correct code for 800 BPI
	POP	H		; If "800" matched, then clean up the stack
	JMP	MS2.5		; Go to next check

S16CHK:	POP	H		; Get pointer to the typed in stuff
	LXI	D,SIXTN		; Match against "1600"
	CALL	STRCMP		; Do the string compare
	JNZ	KILNM		; If was not 1600, then it was bad

; It was 1600, so set the right thing for tape BPI

	MVI	A,4		; This is the code for 1600 BPI
MS2.5:	STA	DEN.SLV+1	; Set the byte in the channel data word

MS3:	PLINE	Q.SLV		; Ask for a new slave device
	CALL	PICKUP		; Fetch what was typed
	RC			; If nothing typed, then we are all done

; Else fall to here to get the slave

	LDA	TMPB2		; Get the number
	STA	DEN.SLV		; Set the byte as required
	RET			; And all done
EIGHT0:	.ASCIZ /800/		; For 800 BPI tapes
SIXTN:	.ASCIZ /1600/		; String for 1600 BPI tapes
; Some subroutines for use by the device select commands.
; First a routine to read in a number typed in answer to an 8080 question
; and save the number typed in the 36 bit buffer "TMPB2".   Returns C-Bit
; clear if a number was gathered and stored in "TMPB2". Returns C-Bit set
; if nothing was typed.

PICKUP:	CALL	INBUF		; Set up the input buffer to the current typein
	RC			; Returns here with C-Bit set if nothing typed

; Get here if something was typed.. go get it and put it in "TMPB2"

	ARG36			; Gather a 36-bit argument
	.ADDR	TMPB2		; Put it in this buffer
	XRA	A		; Clear C-Bit because all was ok.
	RET			; All done

; Subroutine to fix up the buffer pointers in the input buffer

INBUF:	LXI	H,EOL		; Get pointer to end-of-line counter
	DCR	M		; So can decrement
	CALL	BFRST		; Reset tty input pointers
	LHLD	BUF.		; Find the beginning of buffer
	SHLD	.ARG1		; And set it as the pointer to the first arg

	LXI	H,INRDY		; Pass a return address in H,L
	JMP	NULLW		; Enter tty input wait

INRDY:	LHLD	.ARG1		; Get pointer to the start of the new data
FNDARG:	CALL	SEPCHR		; Eat up any no-op separators
	SHLD	.ARG1		; Replace the pointer
	JMP	EOCML		; Check if at EOL. C-set if yes (ie no arg)

	.SBTTL	*** "BT" CMD ***

BOOT:	PLINE	BTMSG1		; Include a msg so users know you are booting
BTAUT:	PCRLF			; And keep it on one line
	MVI	A,^O10		; Bit 32 in tenland for boot button load
	STA	GOCODE		; Save in the "go code" place
	STC			; Fall thru to a "BT"

BTCMD:	CALL	BTCHOICE	; Go select monitor or diag pre-boot
BT.SRC:	CALL	MICROP		; Read page of file pointers into memory @1000

; When get to here, the page  has been read in.

	JC	C.BTERR		; Error in boot process during micro-code load

	CALL	DMEM2CRAM	; Load data from memory into cram

; Fall thru if done the cram loading portion.
; Now must read in the boot code itself, start the  SM10  micro-code and
; then start the boot program at address 1000.  Now set up disk pointers
; to point to boot block of disk, in order that we load the monitor boot.

LB.GO:	CALL	LBINT		; Go read-in the appropriate bootstrap
LB.GO1:	MOV5B			; Set up a start address
	.ADDR	MA1000		; Memory address 1000 for starting program
	.ADDR	TMPBF2		; Set up so start command can find the address

; Temp code for figuring out how to make the internal start code work

	JMP	STINT		; Go start the machine with monitor boot

	.SBTTL	*** "LB" CMD ***

LBCMD:	CALL	BTCHOICE	; If arg given, go set up a choice for the booting
LBINT:	LXI	D,^O1000	; All pointers start at 1000
	LDA	RM100		; Get the offset as selected (mon or diag pre-boot)
	ADD	E		; Add lo order to the offset
	MOV	E,A		; Put it back
	CALL	FILEINIT	; Read in pointers to the "pre-boots"

	JC	L.BTERR		; Error in loading the pre-boot

	CALL	BT.GO		; Start up the micro-code & internal off

; Now pass addresses of RH base & drive # to the pre-boot programs

INFOBT:	LHLD	UNITNM		; Unit number into HL register
	JMP	PASSSRC		; Routine which writes locs 36,37 & 40

; Cute little routine for selecting which boot to load

BTCHOICE: JC	LOAD4		; If no arg, set for "BOOT>" input

	CALL	ARG16.		; Assemble the arg

; As long as it was a number, we will load the diag boot

	MVI	A,6		; A 6 is the offset for the diag pre-boot
EXIT4:	STA	RM100		; Save it
LOAD4:	MVI	A,4		; Pass a 4.. to say load monitor boot
	JMP	EXIT4		; And common exit

; Routine to start up the machine(KS10), and re-establish the parity default

BT.GO:	CALL	SM1		; Start the micro-code
	JC	D.BTERR		; If micro-code does not start
BT.GO1:	INTOFF			; Internal mode off

	MVI	A,DEFLTE	; Get machine default value for enables
	CALL	KS.PAR		; Set them into the RAM & write into KS
	MVI	A,TRPDEF	; Get machine default for trap enables
TP.SET:	STA	TRAPEN		; Set default into the RAM
	OUT	DIAG		; ***** I/O WRT 205/traps enable *****
	RET			; And out

	.SBTTL	*** "MT" CMD ***

MTCMD:	SHLD	CMD..		; Save what command this is, so retrys will work
	CALL	MTSETUP		; Go to some common code
	MVI	A,READ.TAPE	; Get the command execution code for the tape cmd
	CALL	MTXFR		; And read-in the micro-code from tape
	JNC	MT.1		; No need to check if fatal err if all ok

	CALL	NONFATAL	; Was an error, go see what kind
	JNZ	A.BTERR		; Err type "A" if initial read fails

MT.1:	MVI	A,MT.BIT	; Set accum .eq. magtape bit
	CALL	MEM2CRAM	; Load micro-code from memory to "CRAM" space

	CALL	MBINT		; Now load in the pre-boot program
	CALL	BT.GO		; Start the micro-code,replace parity & trap defaults
	JMP	LB.GO1		; And proceed to start things

; Now must do a re-wind.. skip first file(micro-code), then read-in the
; second file (the pre-boot).

MBINT:	MVI	A,SKP.TAPE	; Grab a skip command
	CALL	MTXFR		; Issue a rewind. and a file-skip

; Now we expect there to be a frame count error from the space forward
; And we will do what we can to ignore it

	JNC	MTSKOK		; If no error at all, thats ok too

	CALL	NONFATAL	; Check error type if fall into here
	JNZ	L.BTERR		; If was not a frame count error, was more serious

; If compare result was zero, then the error was a frame count error
; And we will ignore it by falling into the continue code

MTSKOK:	MVI	A,READ.TAPE	; Get a tape read command
	CALL	QMXFR		; Execute tap command list with no rewind in it
	JNC	PASSME		; No error if no "C" bit

	CALL	NONFATAL	; See what kind of error
	JNZ	L.BTERR		; Boot error if no Z

PASSME:	LHLD	TAPEUNIT	; Get tape unit for current magtape selection
; Now pass info in lo memory address spots

PASSSRC: PUSH	H		; Save the passed unit number on top of stack
	MOV5B			; Pass RH base address to internal buffer
	.ADDR	RHBASE		; From here
	.ADDR	DMDAT		; To here
	LXI	H,DMDAT+2	; Get pointer to piece for UBA
	LDA	UBANUM		; Get current UBA
	ORA	M		; Put it into memory

	PUSH	H		; Save the pointer to "DMDAT" area
	DEPOS	36		; Deposit in memory
	POP	H		; Get back the pointer to "DMDAT" area
	MVI	M,0		; Clear byte with bits 12-19
	POP	H		; Get the unit number that was saved on stack
	SHLD	DMDAT		; And put it into the deposit memory data area
	DEPOS	37		; Deposit in memory here

	MOV5B			; Finally pass density slave information
	.ADDR	DEN.SLV		; Get it from here
	.ADDR	DMDAT		; Put it here
	DEPOS	40		; And MOS memory here
	RET			; Back to caller
; Routine that checks to see what kind of error we have suffered under
; the magtape transfer

NONFAT:	MVI	A,<^O377&FRMERR+2> ; Chk error code for fatal or non fatal types
	LXI	H,ERRCD		; Now point to actual error type that we got
	CMP	M		; Compare the two
	PUSH	PSW		; Save flags while we reset the tape drive
	CZ	MTRESET		; Go reset any errors encountered in the skip op
	POP	PSW		; Get back the flags
	RZ			; Only return if error was non fatal

; Fall to here if err was fatal type..see if we can retry it

	MVI	A,<^O377&RETRY.+2> ; "Retryable" error?
	CMP	M		; Compare
	RNZ			; Out if can't even retry..die

; And here if it was retryable

	LXI	SP,RAMST+^O2000 ; First clear the stack
	LXI	H,NORML		; Put a return address onto the stack

	LHLD	CMD..		; Now get "which" command to retry
	PCHL			; Give it a go

	.SBTTL	*** "MB" CMD ***

; Command to load only the bootstrap off of the currently selected magtape

MBCMD:	SHLD	CMD..		; Save which command this is
	CALL	MTSETUP		; Go to some common code to set up for magtape xfer
	CALL	MBINT		; And go
	CALL	BT.GO		; Start up the micro-code & internal off
	RET			; Back to null job loop

; Some common code that sets up parameters for magtape xfer's..saves a few
; bytes of 8080 space.

MTSETUP: CALL	BTINT		; First set up for the booting process
	LDA	MTAUBA		; Get selected UBA for magtape
	STA	UBANUM		; Pass to common spot for channel cmd list to find

	MOV5B			; And move selected MT base for RH base to find
	.ADDR	MTBASE		; Selected magtape RH base address
	.ADDR	RHBASE		; Common RH base register location
	RET			; Back to mailine

MA1000:	D 0,0,,1,000
HOMEWD:	D 505,755,,000,000	; "HOM" means home block
ONES:	D 777,777,,777,777	; All ones...


; --Page of pointers format--
; 	+0	Pointer to free
; 	+1	Length of free

; 	+2	Pointer to micro-code
; 	+3	Length of micro-code

; 	+4	Pointer to monitor pre-boot
; 	+5	Length of pre-boot

; 	+6	Pointer to diag pre-boot
; 	+7	Length of same

; 	+10	Pointer to BC1 micro-code
; 	+11	Length of same

; 	+12	Pointer to BC2 pre-boot
; 	+13	Length

; 	+14	Pointer to monitor boot program
; 	+15	Length of same

; 	+16	Pointer to diagnostic boot
; 	+17	Length of same

; 	+20	Pointer to BC2 itself
; 	+21	Length of same

; 	+22	Pointer to fi-able 0
; 	+23	Length of same
; 	.
; 	.
; 	.
; 	+776	Pointer to fi-able 366(8)
; 	+777	Length of same

; Routine to "find the 8080 file system", which is really just a page
; of physical pointers, to physical disk locations.

MICROP:	LXI	D,^O1002	; For microcode, always go to 2nd pointer
FILEINIT: PUSH	D		; Save pointer into the file page
	CALL	BTINT		; And set up to do a readin
	POP	D		; Restore "D,E"..kludgy way to make subroutine
FILESH:	PUSH	D		;   have multiple entry points
	CALL	DSKDFT		; Fetch current disk defaults

	LXI	H,00		; Clr "H,L"
	SHLD	BLKADR		; And set the desired cylinder to 00
	INX	H		; Bump H,L to make it .eq. 01
	SHLD	BLKNUM		; Now set this into the block number(home block)

	CALL	CHKHOM		; Go see if this page has the "HOM" blk i.d.
	JZ	GOODPK		; If yes, jump to continue read-in

; Fall thru if first home block no good

	MVI	A,^O10		; Try alternate home block
	STA	BLKNUM		; Set block number to alternate

	CALL	CHKHOM		; Try alternate
	JNZ	A.BTERR		; If this ones bad, then give up
GOODPK:	EXAM	1103		; Examine word with home block in it

; Now that youve read home block, find pointer file and transfer the entire
; micro-code into MOS memory.  Short  routine  to  move data from the EMBUF
; into the channel command list.

	CALL	BLKRDR		; Read in the page of pointers from the disk
	JC	B.BTERR		; Error in boot process during pointer page read-in

; Now exam the real desired data

	POP	H		; Fetch up the file pointer address
	STC			; Set sign which indicates and examine
	CALL	EXMHL		; And read it in to mem

; Short routine to move data from the EMBUF into the channel command list

BLKRDR:	LHLD	EMBUF+3		; Get cylinder from special home blk pntr
	SHLD	BLKADR		; Set cylinder in channel command list
	LHLD	EMBUF		; Get track sector byte
	SHLD	BLKNUM		; Set info into the trck/sector word

	CALL	DSXFR		; Finally read the first page of the desired
; Little routine to read in the home block, check that it is a home block
; via the "HOM" id, and return Z-Bit set if it is.

CHKHOM:	CALL	DSXFR		; Execute disk transfer
	JC	A.BTERR		; Boot error "A", if oops

	EXAM	1000		; Now examine the home block id
	CALL	CMP36		; And try out a compare
	.ADDR	HOMEWD		; Expected id
	.ADDR	EMBUF		; Against what was just read in
	RET			; And out

BTINT:	INTON			; Set internal mode on
	CLRB	PARBT		; No paritys
	CLRB	TRAPEN		; And no traps while booting
	CALL	MRCMD		; And don't forget MR reset

; Little routine to set up disk defaults

DSKDFT:	LDA	DSKUBA		; Get currently selected disk UBA number
	STA	UBANUM		; Set into command list place

	MOV5B			; And send currently selected rhbase
	.ADDR	DSBASE		; Current disk RH base
	.ADDR	RHBASE		; To place for command list to find it
	RET			; Out


DMEM2CR: MVI	A,BT.BIT	; Do couple routines a favor, load bit
MEM2CR:	STA	BT.TYPE		; Accum had the booting it
	LXI	H,00		; Zeroes to "H,L"
	PUSH	H		; Save current cram address
	CALL	CADWR		; And then write it to the cram
	MVI	A,7		; Start with function 7
NEWPAG:	MOV5B			; Initialize mem address
	.ADDR	MA1000		; With 1000  octal
	.ADDR	MEMAD		; Standard mem address

; Code to decide if we need to read an additional disk sector

	LHLD	MEMAD		; Get current mos mem address
RD.EXM:	MOV	A,L		; Get 8 bits of address to be examined
	OUT	A2835		; Set piece of address into address register
	MOV	A,H		; Get couple more bits
	OUT	A2027		; Set into csl board address register
	MVI	A,4		; Special key to make "examine" work correctly
	CALL	EM.CRM		; Go do a memory examine, of the short flavor

	LHLD	EMBUF		; Get 16 bits of the memory data
	MOV	A,H		; Copy to accum, so that we can make it 12 bits
	ANI	^O17		; Clr the bits
	MOV	H,A		; Put back into the hi order reg

	CALL	WFUNC		; Write the piece
	LXI	H,CRMFN		; Get current diag function 
	DCR	M		; Down count

	LHLD	EMBUF+1		; Get 16 bits of the memory read

	MVI	C,4		; Now a quick little loop
	XRA	A		; Clr accum temp
QQLOOP:	MOV	A,H		; Copy to accum
	RAR			; Rotate into the C-Bit
	MOV	H,A		; Put it back

	MOV	A,L		; Try bottom piece
	RAR			; Rotate C-Bit into the top
	MOV	L,A		; Put it back
	DCR	C		; Down the little counter
	JNZ	QQLOOP		; Continue

	CALL	WFUNC		; Write this piece
	LXI	H,CRMFN		; Down the function counter
	DCR	M		; Decrement
	JP	BBLOOP		; Jump around this stuff if not at function 0
; If done functions 0-7, try a little reset

	MVI	A,7		; Restart at function 7
	STA	CRMFN		; Save it

; Here if finshed a cram word & need to do reset.

	POP	H		; Get cram address
	INX	H		; Update
	CALL	CADWR		; Now write this, the next cram address
	MOV	A,H		; Now get hi order piece of cram addr
	ANI	^O10		; Is it .eq. 4000 octal yet?
	JZ	SEEPAGE		; If not 4000 octal yet, check for a nxt word
	POP	H		; And restore stack before leaving
	RET			; Otherwise all done

BBLOOP:	LHLD	EMBUF+3		; Grab 16 bits of the memory data
	MOV	A,H		; Pass 8 bits to accum, so we can make it 4 bits
	ANI	^O17		; Off unneeded bits
	MOV	H,A		; Put it back
	CALL	WFUNC		; Write this datum
	LXI	H,CRMFN		; Get function
	DCR	M		; Down to next function

SEEPAGE: LHLD	MEMAD		; Get the current memory address
	INX	H		; Go to next address
	SHLD	MEMAD		; Save this next address
	MOV	A,H		; Test h for at "2000"
	ANI	^O4		; If "2000" weight bit set, time for new page of data
	JZ	RD.EXM		; If mem address .eq. 2000, then fall thru to next readin
	CALL	NEXTCR		; Routine to fetch next page of cram data
	JMP	NEWPAG		; And back to beginning

; Else, must read in another page's worth from current boot device

NEXTCR:	LDA	BT.TYPE		; Find out what kind of device we are booting from
	CPI	BT.BIT		; See if doing boot from the disk
	JNZ	TAPDEV		; If flag .ne. bt.bit, then booting from magtape
; Fall thru to do boot from disk

	LXI	H,QXFR		; Set up for the quick xfr command list
	CALL	CHNXCT		; Read in, short format(trk/sec/cyl is preset)
	JC	C.BTERR		; Error in reading cram
	RET			; Back to caller

; Jump to here to do boot from tape

TAPDEV:	MVI	A,READ.TYPE	; Pass to channel cmd list executor the xfr type
	CALL	QMXFR		; Read in a single page from magtape
	RNC			; If nothing bad, return
	CALL	NONFATAL	; If badness, see if fatal kind or not
	JNZ	C.BTERR		; Error in reading the cram
	RET			; Back to caller

	.SBTTL	*** "FI" CMD ***

; Command to read in a particular page of the filesystem and to execute its
; contents as if they were typed in 8080 commands.

FICMD:	CALL	ARG16.		; Collect it when its there

; Beware..if you type FI with a bogus argument, then you lose..
; He who uses the FI cmd best know what he's doing.

	LXI	D,^O1022	; Start with offset "0" into the "FI" files
	DAD	D		; Add this to number typed to get the desired
	CALL	FILEINIT	; Read in the desired page
	JC	L.BTERR		; If err

; Now do something with the stuff typed...

	MOV5B			; First must get info from mos mem to 8080 RAM
	.ADDR	MA1000		; Info starts at mos mem loc 1000
	.ADDR	MEMAD		; And we will tell internal reader to start there

	LXI	D,E.BEG+2	; A place to store ascii bytes from memory
FI.GET:	INTON			; No printing
	CALL	GATHER		; Go read in a word from mos mem
	INTOFF			; Ok to print now
	MVI	L,4		; Now only 4 bytes per word are useful
	LXI	B,EMBUF		; And this is where in 8080 RAM the bytes are
FI.MOV:	LDAX	B		; Fetch up a byte
	STAX	D		; Put it in place
	CPI	^O377		; Is it end of string?
	JNZ	FI.NXT		; If no, go move some more

	CALL	MV.ALL		; Got here, move to execute buffer
	JMP	DCODE		; And go do it

; Nope.. move some more

FI.NXT:	INX	B		; Update the pointers
	DCR	L		; Check count to see if we've done 4 yet
	JNZ	FI.MOV		; If not, go move next byte from current word
	JMP	FI.GET		; Yes, read next mem word and try it
;;**********Proposed instruction ********************
;	.SBTTL	*** "B1" CMD ***
;; Command to read in a second type of micro-code and execute it..
;; I.e. bootcheck 1 micro-code
;B1CMD:	LXI	D,^O1010	; get the correct offset
;	CALL	FILEINIT	; read in the first page
;	JC	C.BTERR		; if err
;	MVI	A,BT.BIT	; say that this is a load from disk
;	CALL	MEM2CRAM	; read it in as micro-code
;	CALL	BT.GO		; start it up
;	RET			; that it

	.SBTTL	*** "B2" CMD ***

; Bootcheck 2.. this loads in a separate "pre-boot", which
; loads in the boot check 2.

B2CMD:	MVI	A,^O12		; Get the offset
	STA	RM100		; Save it so we can use some super common code
	JMP	BT.SRC		; That's it!!!!

	.SBTTL	*** "VD" CMD ***

; Command to verify the contents of the C-RAM against the micro-code
; as it sits on disk.

VDCMD:	CALL	MICROP		; Now read in home blocks, then 1st page of u-code
	JC	C.BTERR		; If error, go tell world about it

	MVI	A,BT.BIT	; Went ok.. specify a disk type operation
	JMP	VERCRAM		; And go in to verify the cram

	.SBTTL	*** "VT" CMD ***

; Command to verify the contents of the C-RAM against the micro-code
; as it sits on mag tape.

VTCMD:	CALL	MTSETUP		; Go to some common code to look at magtapes
	MVI	A,READ.TAPE	; Tell channel lister to do a read in
	CALL	MTXFR		; Read in first page of u-code off the tape
	 JC	A.BTERR		; If error, go report it

	MVI	A,MT.BIT	; Went ok.. specify a tape operation

; Fall straight into the code to verify the cram


; Routines  that  do read ins from the currently selected device and compares
; that hard micro-code data against the current contents of the control-store.

	STA	BT.TYPE		; Begin by saving device against which we will verify

	MOV5B			; Start by setting memory address at 1000
	.ADDR	MA1000		; A "1000"
	.ADDR	MEMAD		; Place where mem address is kept
	LXI	H,00		; Begin with cram address 00
	SHLD	CRMAD		; Set cram address to zeroes
	JMP	V.GO		; Enter loop at the proper place

V.DONWD: LHLD	CRMAD		; Get current cram address
	INX	H		; And update for next time around
	MOV	A,H		; Put hi order piece of it into accum
	ANI	^O10		; See if at end of cram yet
	RNZ			; If it is, all done, go out

; Here if really ready to do a cram loc

V.GO:	CALL	CADWR		; Write it to cram, be it good or bad
	SHLD	CRMAD		; Now save address while we do some stuff
	CALL	CP1		; Single clock gets cram contents to control reg
	CALL	RCINT		; Read in contents of C-RAM and save in 8080 ram

; Here when cram data is safely tucked away in the 8080 ram

	LXI	B,VERLST	; B,C pair points to list of data offsets
	LXI	D,CRMBF		; D,E pair points to actual data list (H,L pnts expected)

V.NXMEM: CALL	GATHER		; Here to call routine that reads in the next mem word
	MVI	A,3		; And take time out to reset the 3 counter
	STA	VERCNT		; Set up a clean count
; And here below begins the actual data compares

V.BLP:	LDAX	B		; Get the first index byte from the list of bytes
	ANI	^O77		; Off the signals, and continue
V.BLP1:	LHLD	EMBUF		; Get expected data into H,L register
	INX	B		; Update b,c to point at function read
	ADD	E		; Add as an offset to the D,E pair
	MOV	E,A		; Put the good addr back into "E"
	MOV	A,D		; And grab the hi order for a sec
	ACI	0		; Add in the carry if required
	MOV	D,A		; Put the hi order back again

	LDAX	D		; Now load in the first "actual" datum
	INX	D		; Update pointer to actual
	CMP	L		; Compare against expected
	JNZ	V.ERR		; Report if badness

	MOV	A,H		; Get upper 12 bits of the expected
	ANI	^O17		; If data was equal, only discrepency can be in B7-B4

	MOV	H,A		; Get the 4 bits of data left after the "and"
	LDAX	D		; Get the actual data to accum
	CMP	H		; See if same and B3-B0 should be
V.ERR:	CNZ	VERRPT		;   zero.  If not report as error
	DCX	D		; Fix D to look at beginning of "actual" 2 bytes

; Now need to choose if need check twice(for double copies), or if end
; Of list for this cram word

	INX	B		; Update pointer into the indexer list
	LDAX	B		; Get the next index byte
	RAL			; Copy sign into C-Bit
	JC	V.DONWD		; If set, end of list.. go do next cram word

	RAL			; Wasn't end of list.. see if a double checker
	JC	V.BLP		; Jump back to main loop without updating if yes

; If not a double, must fall through to update expected
; Here when must update expected..not a double copy

V.NXT:	LXI	H,VERCNT	; Load current count for how many compare per mem word
	DCR	M		; Decrement that count
	JZ	V.NXMEM		; If down to zero, go read in the next memory word

	LXI	H,EMBUF		; Tell SHR36 where it should shift
	CALL	SHR36		; If not down, shift what we have to next 12 bit grp
	.BYTE	12.		; Specify the next 12 bit group is what we want
	JMP	V.BLP		; And continue in the big loop

; List of indexer bytes

VERLST:	.BYTE	0,17		; Read fcn 17 (bits 84-95)
	.BYTE	2,16		; Read fcn 16 (bits 72-83)
	.BYTE	2,15		; Read fcn 15 (bits 60-71)
	.BYTE	2,14		; Read fcn 14 (bits 48-59)
	.BYTE	2,13		; Read fcn 13 (bits 36-47)
	.BYTE	102,12		; Read fcn 12 (bits 36-47) second copy
	.BYTE	10,6		; Read fcn 6  (bits 24-35)
	.BYTE	102,5		; Read fcn 5  (bits 24-35) second copy
	.BYTE	2,4		; Read fcn 4  (bits 12-23)
	.BYTE	10,0		; Read fcn 0  (bits 00-11)
	.BYTE	200		; End of list marker
; Subroutine to read in the next word from memory.
; Also checks to see if at the end of the memory page(addr 1777), and if so
; to go  and  read  in  the next page of micro-code from the device against
; which we are verifying the micro-code.


	LHLD	MEMAD		; Get current memory address
	PUSH	H		; Save current mem address

	MOV	A,H		; Get the hi order piece of the mem address
	ANI	^O4		; See if address at "2000" yet
	JZ	G.SKP		; If not, simply go read in the next word

; Else must read in the next page of micro-code

	CALL	NEXTCR		; Do the read in

	POP	H		; Get old crummy H,L off the stack
	LXI	H,^O1000	; Want to reset mem address to beginning of page
	PUSH	H		; Put back on stack
	SHLD	MEMAD		; And pass new address in ram
G.SKP:	CALL	EM2		; Examine the next memory word
	POP	H		; Grab the address we want to read next time
	INX	H		; Update to next
	SHLD	MEMAD		; Put it back
	POP	B		; Restore the regs now
	RET			; And out
; Verify error reporter subroutine.  Reports verify errors as they  happen
; and then permits the verifier to continue verifying the rest of the cram.

VERRPT:	PUSH	H		; Save contents of H,L pair
	PUSH	D		; Must also save D,E
	INTOFF			; Print all this good stuff

	LXI	H,CRMAD		; Then print cram address of the failing cram word
	CALL	P16		; And print out the address

	PSLASH			; Throw out a "/"

	LDAX	B		; Fetch up the diag func of the read failure
	CALL	P8BITA		; And print it

	PCHAR	':		; Simple characters are ": a "

	XCHG			; And now H,L points at the actual
	DCX	H		; Now D,E points to the actual
	CALL	P16		; Print the actual data
	XCHG			; Fix so H,L points at temp loc once again

	PSPACE			; Another space
	PCHAR	'E		; A "W" stands for "was"

	LHLD	EMBUF		; Get the expected data into H,L pair
	MOV	A,H		; Want to strip any bits above 12 bits
	ANI	^O17		; Keep only relevant bits
	MOV	H,A		; Put it back
	SHLD	TMPB2		; Put it in the temp place
	CALL	P16.		; Print the expected

	PUSH	B		; Save B reg too
	CALL	DECNET		; If there is a host, tell him too
	INTON			; And back to internal mode
; Execute channel commands....

DSXFR:	LXI	H,DSKSEQ	; Pntr to command list
XCTNOW:	CALL	CHNXCT		; Execute channel list

MTXFR:	LXI	H,MTASEQ	; Pntr to command list
XCTMTA:	STA	SKP.GO		; Accum had xfr it
	JMP	XCTNOW		; Go execute the channel command list

QMXFR:	LXI	H,QTXFR		; Pntr to command list
	JMP	XCTMTA		; Go execute the channel command list

MTRESET: LXI	H,MTARST	; Channel cmd list to clear error from magtape
	JMP	XCTNOW		; Go execute the channel command list


; Routine to a channel command list type operation, for data transfers from
; our selected boot device.  Command list is coded as follows:
; The list is a series of 36-bit commands.
; We have free use of bits 0-17 as command types
;  Bits 15,16,17 .eq. 0 mean "DI" command
;  Bits 15,16,17 .eq. 1 mean "LI" command
;  Bits 15,16,17 .eq. 2 mean "EI" command
;  Bits 15,16,17 .eq. 3 mean "WAIT" command
;  Bits 15,16,17 .eq. 4 mean "ERRTST" command
;  Bits 15,16,17 .eq. 5 mean "END" of command list
;  Bits 15,16,17 .eq. 6 mean "TWAIT" command
;  Bits 15,16,17 .eq. 7 mean "UBA" command

; Pointer to the current command list is always stored in H,L

CHNXCT:	INTON			; Set up for internal mode

DSCON:	LXI	D,2		; "D,E" gets the constant "2"
	DAD	D		; Now "H,L" points to "data+2"(bits 12-19)

	MOV	B,H		; Copy "H,L" into "B,C"
	PUSH	H		; Save "H,L"
	MOV	A,M		; Get bits 12-19 into accum

	RAR			; Now justify accum at bits 16,17
	RAR			; Takes 2 shifts
	ANI	^O17		; Off all but bits 14,15,16,17
	MOV	E,A		; Now put into lo-order half of double reg
	LXI	H,DSLST		; Get a pntr to the dispatching list
	DAD	D		; Creat pntr to the command

	MOV	E,M		; Get lo order piece of cmd dispatch
	MOV	D,M		; Get hi order piece of cmd dispatch
	XCHG			; Assembled address to "H,L"
	LXI	D,XFRRT		; Now get a pseudo return pc to put on stack
	PUSH	D		; And put it there

	PCHL			; Dispatch to that assembled address

; Upon completion of the command list commands, you generally
; return here in the code.

XFRRT:	POP	H		; Get pointer to current location in cmd list
	INX	H		; Make it point to next word in the list
	JMP	DSCON		; And continue in command list executor

; Command list dispatch selection

DSLST:	.ADDR	CMDDI		; DI cmd .eq. 0
	.ADDR	CMDLI		; LI cmd .eq. 2
	.ADDR	CMDEI		; EI cmd .eq. 4
	.ADDR	CMDWAIT		; WAIT cmd .eq. 6
	.ADDR	CMDERCHK	; ERRTST cmd .eq. 10
	.ADDR	CMDEN		; END cmd .eq. 12
	.ADDR	CMDTWAIT	; WAIT cmd with no timeout. checks for bit true .eq. 14
	.ADDR	CMDUBA		; LI type cmd. no offsets, good for UBA stuff .eq. 16

; Code for "EI" command

CMDEI:	ANA	A		; Clr the "C-Bit"
	JMP	CMDLI1		; Go to common code for LI and EI command

; Code for "LI" command

CMDLI:	STC			; Set the "C-Bit"
CMDLI1:	PUSH	PSW		; And save it
	MOV5B			; Pass the command list executor the rhbase address
	.ADDR	RHBASE		; Kept in here
	.ADDR	IOAD		; Used in here

	LXI	H,IOAD+2	; "H,L" pnts to dest+2
	LDA	UBANUM		; Current UBA number into accum
	ORA	M		; Throw in the current bits
	MOV	M,A		; Put it all back

	DCX	H		; Now make "H,L" point to addr +0
	DCX	B		; Make "B,C" pair point to selected offset from base
	LDAX	B		; Get selected offset
	ADD	M		; Add offset to the base
	MOV	M,A		; And put the whole mess back
	POP	PSW		; Now get state of processor flags
	RC			; If "C" set, it was an LI and we are done

; Call thru if "C" was EI and we must finish it

	CALL	EI1		; Execute "EI" cmd
	RET			; All done
; Code for LI type command only using no offsets, taking the addresses
; exactly as presented.. good for UBA operations, which require no offsets.

CMDUBA:	LXI	D,IOAD+2	; "D,E" pnts to dest+2
	PUSH	D		; Save the address of UBA/RH address
	CALL	MOV18B		; Move some data
	POP	H		; Addr of UBA/RH into H,L
	LDA	UBANUM		; Current UBA number into accum
	ORA	M		; Throw in the current bits
	MOV	M,A		; Put it all back
	RET			; We are done

; Code for DI command

CMDDI:	LDAX	B		; Get disp code to see if indirect
	ANA	A		; Check the sign bit
	JP	DILOCL		; And jump if no indirection

; Fall to here if was indirect

	MOV	L,C		; Pass addr in "B,C" to "H,L"
	DCX	H		; Now back up pntr to hi order pce of indirect wrd
	MOV	B,M		; And into b
	DCX	H		; Now to lo order piece of indirect word
	MOV	C,M		; Lo order piece to C and done
	INX	B		; "B,C" must point to src + 2
DILOCL:	LXI	D,DMDAT+2	; "D,E" points to dest+2
	CALL	MOV18B		; Move some stuff around
	CALL	DI1		; Execute the deposit
	RET			; And back to command list

; Code for wait command(for waiting for a tape to finish, for example)

	XRA	A		; Clear accum
	MOV	D,A		; Now clr "D", the register we will use for timeout count
	MOV	E,A		; Clr "E" too

	CALL	CHKBIT		; Check bits versus device status to see if set(i.e ready)
	POP	B		; Restore B,C
	RNZ			; If ready bit set, its ok, go away

; Fall thru if ready not set

	PUSH	B		; Save B,C from destruction
	PUSH	D		; Save time-out count
	CALL	EI1		; Do another examine of device status to see if ready now
	POP	D		; Get the time-out count
	POP	B		; Restore B,C
	INX	D		; Increment
	MOV	A,E		; See if count down to zero yet
	ORA	D		; Use top half too
	JNZ	WAITLP		; Go try again

; Fall thru if device time's out before getting a ready

	JMP	DEVERR		; Go report "?BT" and the failed pc

; Code for TWAIT command

CMDTWAIT: PUSH	B		; First save the BC pointers
	CALL	EI1		; Read the current state as it is now
	POP	B		; Reset B to a good value
	PUSH	B		; And save it from destruction again
	CALL	CHKBIT		; Now see if appropriate bit is set
	POP	B		; Restore
	RNZ			; Return if bit was set as desired
	JMP	DEVERR		; Else.. go say err, bit was not set as desired
; Code for error test command

	CALL	CHKBIT		; First go check to see if any of desired bits set
	POP	B		; And restore
	RZ			; If none set, return cause all is ok

; Fall to here if some bits set..had device error & therefore "BOOT" failed

DEVERR:	MOV	H,B		; Now copy "B,C" to "H,L" register

	SHLD	ERRCD		; "H,L" now has failing pc
	INTOFF			; Let all messages print now
	XRA	A		; Clr C-Bit, so that it will set later, to indicate err
	JMP	DEVEXIT		; Go exit with messing with print flags

; Code for the end command

CMDEN:	LXI	D,MAD000	; Guarantee CSL bus addr reg .eq. 0 after xfr
	CALL	ADATP		; Write the CSL bus address reg with 0's
	INTOFF			; Clr internal mode
	STC			; Set the C-Bit, so that it will be cleared later
DEVEXIT: CMC			; Complement C-Bit, so it will say err, or no err
	POP	H		; Throw out pseudo return from stack top
	POP	H		; Throw out the saved "H,L"
	POP	H		; And restore all the registers
	POP	D		; That we saved
	MVI	A,0		; Accum will always be 0 on exit from cmd list executor

; Routine for moving 3 bytes of data.   "B,C" has src+2..."D,E" has dst+2.

MOV18B:	MVI	H,2		; Count of 3 is how many to move
	LDAX	B		; Get piece of source
	ANI	3		; Only interested in bits 18,19
	STAX	D		; Put at destination
	DCX	B		; Point to next relevant byte
	DCX	D		; For src and dst
MOV18X:	LDAX	B		; Get a piece of the src to accum
	STAX	D		; And put at destination place
	DCX	B		; Down the pointer
	DCX	D		; Down the other pointer
	DCR	H		; And down the counter..
	JNZ	MOV18X		; Continue till moved 3 bytes
	RET			; Then out
; Common routine for checking device status, for either device errors or
; ready bit true..must be called immediatly after an "EI" command.

CHKBIT:	LHLD	EMBUF		; Get current device status into "H,L"
	DCX	B		; Make B pnt to +1
	DCX	B		;  And make it pnt to +0
	LDAX	B		; Byte of desired into accum
	ANA	L		; Compare against current device
	RNZ			; If non-zero, no need to look further

	INX	B		; If 1st byte was zero, bump pntr to look at next byte
	LDAX	B		; Next byte into the accum
	ANA	H		; Compare versus desired
	RET			; Plain return..z bit will be set appropriately

	.SBTTL	*** "BC" CMD ***

; Code which performs the very famous boot check i

BCCMD:	CALL	MRCMD		; Make sure machine is stopped
	INTON			; Set up internal mode
	CLRB	ERRCD		; Begin by clearing the error codes
	CLRB	ERRCD+1		; Must clear both halves

	CLRRM	BUSAD		; Will generate a starting buffer of (400000,,0)
	MVI	A,^O10		; This turns out to be bit0 in 36-bit land
	STA	BUSAD+4		;   Set it

	LXI	B,^O400		; Set b=1, c=0
BC.ALP:	PUSH	B		; Save counters
	CALL	DBCMD		; Execute the deposit bus

; Check for failure

	LDA	ERRCD		; Fetch an error code
	ANA	A		; Set 8080 condition codes
	JNZ	BCA.ERR		; Go standard error report if err found

; No error, generate the next datum

	LXI	H,BUSAD		; Point to a buffer to be shifted
	CALL	SHR36		; Shift 36 bits(i.e. float a 1 or 0)
	.BYTE	1		; Shift only one place at a time

; Now check for end of test

	POP	B		; Grab up the current loop counters
	INR	C		; Up count for this dataum
	MOV	A,C		; Copy to accum
	CPI	36.		; Now see if floated down the entire 36 bit word
	JC	BC.ALP		; Jump if not done a group of 36 yet..

; Here when done a group of 36, see if this was first or second time through

	DCR	B		; Decrement "times through the loop" counter
	JM	BC.2ND		; If minus, time to get out..go next phase of test

; Here when done first word, time to set up to float a 0 thru field of ones.

	MOV5B			; Move 2nd data pattern
	.ADDR	BC.DB2		; Init 2nd pattern to be (377777,,777777)
	.ADDR	BUSAD		; And this is the place that DB command uses

	MVI	C,00		; Reset the counter
	JMP	BC.ALP		; And go round for the second time......

BC.DB2:	D	377,777,,777,777
; Bootcheck code for executing a test of the cram and its abilitiy to
; hold  all ones and zeroes, and to see if its addressing logic works
; as it should....

BC.2ND:	LXI	H,00		; Start at cram address 00
BC.BLP:	CALL	W.CRMZ		; Write the location with all zeroes
	INX	H		; Update to next cram address
	MOV	A,H		; Now check to see if done all
	ANI	^O10		; Is address at "4000" yet?
	JZ	BC.BLP		; Back and zero more if not yet

; Now ready for combined address and data test

	MVI	H,00		; L is already .eq. 0, now make H,L pair .eq. 0
BC.BL1:	CALL	CADWR		; Write current cram address
	PUSH	H		; And save it for a while
	CALL	CP1		; Clock to get the contents of that loc to c.r.
	CALL	RCINT		; Now read-in the contents of the c.r.
	LXI	H,00		; Data to verify against is 00
	CALL	V.VER		; Verify contents of c.r. to be all 0
	CALL	A.CRMO		; Now write that location with all ones
	POP	H		; Retrieve current cram address
	INX	H		; Up to the next address
	MOV	A,H		; Copy hi half to accum, so can check for 4000
	ANI	^O10		; Address at "4000"?
	JZ	BC.BL1		; Back into loop if not yet..

; When done here, fall into memory part of boot check a page mos memory check.

BC.3RD:	CALL	ZMCMD		; First clear entire mos memory (at least try)

	MOV5B			; Set up the initial data
	.ADDR	ONES		; Data for depositing is all ones
	.ADDR	DMDAT		; .. The deposit buffer

	MOV5B			; Set up the starting memory address
	.ADDR	MA1000		; Start at address 1000
	.ADDR	MEMAD		; .. Memory address buffer

BC.CLP:	CALL	EM2		; Examine a location
	CALL	CMP36		; Then compare should be all zeroes
	.ADDR	EMBUF		; This is the actual read-in data
	.ADDR	ZEROES		; Versus 36-bits of 0's
	JNZ	BC.CERR		; Go to error report if not all zeroes
; Fall thru if that went ok.

	CALL	DM2		; Now deposit ones into that loc and continue

	CALL	EM2		; While we are at it, we'll check all ones
	CALL	CMP36		; Do the 36-bit compare
	.ADDR	EMBUF		; This stuff just read in
	.ADDR	ONES		; Against all ones
	JNZ	BC.CERR		; If bad, say so..

	LHLD	MEMAD		; Fetch up the current memory address
	INX	H		; Update to the next 
	MOV	A,H		; Copy hi piece to the accum
	ANI	^O4		; See if reached address 2000
	SHLD	MEMAD		; Replace the updated address first
	JZ	BC.CLP		; And continue if had not reached the max

	RET			; Return..done all boot check ok

; Subroutines required for the cram testing.
; Subroutines for writing all ones and all zeroes into a selected cram
; location.  Desired  address  passed  in  the H,L register (for W.XXX
; calls).  Uses currently selected address for (A.XXX calls).

A.CRMO:	PUSH	H		; Save H,L
	LXI	H,-1		; H,L to all ones indicates the all ones data desired
	JMP	W.LOC		; Go common code

W.CRMZ:	CALL	CADWR		; Write desired address
A.CRMZ:	PUSH	H		; Save H,L
	LXI	H,00		; Set to zero, data is all zeroes
W.LOC:	MVI	C,7		; Takes 8 function writes to do all of one cram loc
W.LP:	MOV	A,C		; Get current function to accum
	STA	CRMFN		; Put function into loc used by standard routine
	CALL	WFUNC		; Write one of the 8 pieces of a cram loc
	DCR	C		; Down count
	JP	W.LP		; As long as .ge. 0, keep going
	POP	H		; Here when done all 8
	RET			; Now get out of here.
; Routine to verfiy that a cram location is indeed all ones or all zeroes.
; No arguments passed to this routine.

V.VER:	SHLD	CRMBF+^O14	; All don't care locations of the "read" are
	SHLD	CRMBF+^O16	;   fudged to match expected data
	SHLD	CRMBF+^O20	; There are 12 don't care locations

	SHLD	CRMBF+^O30	; Some are various address (nxt/current/subrtn)
	SHLD	CRMBF+^O32	;  and some are just unbuffered copies of the
	SHLD	CRMBF+^O34	;  bus

	MOV	A,L		; Now copy expected data into "B,C" pair
	CMA			; First complement
	MOV	C,A		; Then move
	MOV	A,H		; Need both halves please
	CMA			; Complement
	MOV	B,A		; Then move

	LXI	H,CRMBF		; Now point to start of buffer where expected 
V.BCLP:	MOV	E,M		;   data kept. Proceed to copy buffer data into
	INX	H		; (Update pointer)
	MOV	D,M		; The D,E register pair
	INX	H		; And update memory pointer after each move
	XCHG			; Swap, so now "H,L" has buffer, "D,E" has pointer
	DAD	B		; Add complement to expected...should get 0.
	INX	H		; Two's complement , that is..
	MOV	A,L		; Piece to accum
	ORA	H		; "Or" in the other piece
	JNZ	BC.BERR		; And go handle error if results .ne. 0

; You fell through to here if data check was ok..

	XCHG			; "H,L" has pointer, "D,E" has 00
	MVI	A,<<CRMBF+32.>&^O377> ;Check if done
	CMP	L		; See if at last location in list
	JNZ	V.BCLP		; Jump back if not yet
	RET			; Else ok to return
; Error reporting

BC.CERR: LHLD	MEMAD		; Grab up failed mem address
	MVI	B,^O100		; Get a bit to set in error printout
	JMP	BCC.ERR		; Go process standard error typeouts
BC.BERR: POP	H		; Clear a return address
	MVI	B,^O200		; Bit to set for cram failures
	POP	H		; Now gather up the current cram address
BCC.ERR: SHLD	ERRCD		; Save 1 byte by depositing twice
	MOV	A,H		; Hi half to the accum
	ORA	B		; Throw in a weight so number will differ
	STA	ERRCD+1		; Put number into error code loc
	JMP	BCB.ERR		; And go print out the correct error stuff

BCA.ERR: POP	B		; Get counter off the stack
	MOV	A,C		; Subtest to accum
	STA	ERRCD		; Place from which to report errors
BCB.ERR: CLRB	NOPNT		; Guarantee printing on
	LXI	H,ERRCD		; Point at the error i.d.
	CALL	P16		; Print

; Subroutine to check if the CPU is running, and if it is,
; to abort the command that called it.

.RUN..:	POP	H		; Must fix the stack
	PUSH	PSW		; Save flags (state of the "C-Bit"
	LDA	RNFLG		; Check software run flag to see if CPU clk on
	ANA	A		; Is it zero? , or not zero
	JNZ	YSRUN		; If not zero, jmp off to print message

	POP	PSW		; Otherwise, restore flags
	RET			; And out

YSRUN:	PLINE	RN.		; Message to say running..
	JMP	MMERR		; Now go restart ourselves

; Routine to report a parity error when detected by the 8080 console

RPTPAR:	CLRB	NOPNT		; Turn typing on
	XRA	A		; Accum must be zero
	OUT	CLKCTL		; Kill clk, so par err clring wont release the cpu clks

	LDA	SC.OFF		; Get flag to see if we can try for soft recover
	ANA	A		; Set 8080 flags
	JNZ	HRDERR		; If flag .ne. 0, then we will not recover

; First thing we need to do is check for cram/cra parity errors, and decide
; if we can recover from them

	LONG.DELAY 1		; Let disk traffic stop
	MVI	A,SMPAR		; Get which reg has parity info in it
	CALL	ER.UTL		; Read data,parity cram parity error occurring 
				;   at same cram addr more than once in a row)
	CMA			; Invert so that .true. .eq. hi
	ANI	^O22		; See if CRA/CRM error type
	JZ	HRDERR		; If no, go for a hard error
; Well, lets see if mem busy or I/O busy

	IN	R.BUSY		; *****I/O RD 102*****
	CMA			; Fix hardware complement
	ANI	^O60		; See if either of those two bits set
	MOV	B,A		; Save results of this "and" for a bit
	IN	REFERR		; See if mem refresh err either
	CMA			; Fix hardware inversion
	ANI	1		; Only keep the refresh bit
	ORA	B		; Throw the two together.  If results 0, then all ok
	JZ	SOFTERR		; If nothing, go try for soft error recovery

; Get to here if error is considered non-recoverable

NR:	PLINE	NRSCE		; "?NR-SCE".  Non recoverable-soft cram error
HRDERR:	CLRB	CHKPAR		; Say not to report again & again
	CALL	CLRUSE		; exit from user mode
	PLINE	PARMSG		; message to cty

	IN	SMPAR		; ***** I/O RD PARITY *****
	CMA			; Fix the hardware inversion
	CALL	P8BITA		; And print it out with the error message
	PSPACE			; Separate the 8 bit datums
	IN	^O303		; Read "DPM PARITY BIT"
	CMA			; Fix CPU inversion
	ANI	^O1		; Only interested in bit 0 "DPM PAR ERR"
	CALL	P8BITA		; And then print the "DPM PAR" data
	PSPACE			; Again, separate by spaces
	IN	^O103		; Read reg that has R PAR Right & R PAR Left
	CMA			; Fix the hardare inversion
	ANI	^O360		; Keep only the 2 "R PAR" bits
	CALL	P8CRLF		; Print it
	CALL	CLRRN		; Clear the software "RUNNING" flag too
	CALL	LTFLT		; Parity error lights the fault light
	JMP	REINI		; And go re-init..par errs are fatal

; Command list for reading UBA INFO

UBA.RD:	UBA. 763,001

; RH11 command list for checking for recoverable & non recoverable
; states of the controller.

RH.TST:	EI. D776,P.00		; Exam controller status reg
	ERRTST 60000		; Test for fatal errs
	EI. D776,P.12		; Exam drive status reg
	ERRTST 40000		; Check that guy for errs
	ENDLST			; Here if all ok

RH.EXE:	EI. D776,P.00		; A template for RH examines
	ENDLST			; That's all we need for this

SAVLST:	.BYTE	P.00		; READ 776700
	.BYTE	P.02		; READ 776702
	.BYTE	P.04		; READ 776704
	.BYTE	P.06		; READ 776706
	.BYTE	P.10		; READ 776710
	.BYTE	P.32		; READ 776732
	.BYTE	P.34		; READ 776734
	.BYTE	-1		; End of list marker

; The ASCII messages required for parity recovery

NRSCE:	.ASCIZ/?NR-SCE /	; Not recoverable soft cram error
OKSCE:	.ASCIZ/%SCE /		; Recoverable soft cram error

; Now get the current cram address and check for hard cram errors.  (Note: a
; hard cram error is a cram parity error  occurring at the same cram address
; more than once in a row).

SOFTERR: LXI	D,SCEADR	; "D,E" pair will point at the desired
	CALL	BREAK		; Go check if current .eq. desired..
	JZ	HRDERR		; If yes, jump 'cause its a hard error
; Soft cram erro recovery continued....
; Recovery begins by zapping the PE(1) flop so we may catch any additional
; parity errors.

	MVI	A,1		; Bit to reset cram C.R. & PE(1)
	OUT	CRMCTL		; ***** I/O WRT/204 *****

; Fall thru if address not the same

NOTSAME: SHLD	SCEADR		; Save it as the new "previous"

; Now check RH11 to see if this failure is recoverable for the
; monitor.  8080 will simply execute a channel command list of
; "ERRTST", with the correct error bits checked for.

	LXI	H,RH.TST	; Point to error checker command list
	CALL	CHNXCT		; Execute that list
	JC	NR		; If bad, say not recoverable
; Else...fall into the soft recovery code

; Finally get to here if this thing looks recoverable. now we must
; begin saving things.  First.. get the current disk UBA number to
; set up the RH11 register saving.  Then  we  must set up the RH11
; base register itself.  While we are at it, might as  well  print
; a little message saying what we are doing in here.

RECVR:	PLINE	OKSCE		; Err msg "%SCE" soft cram error
	LXI	H,SCEADR	; Now point to this bad address
	CALL	P16		; And print it
	PCRLF			; Terminate everything with a CR-LF
	CALL	DSKDFT		; Now get those defaults just mentioned
	XRA	A		; Clear accum
	OUT	RESET		; *****I/O WRT 100***** no par checking

; Finally ready to begin the act of saving some registers.
; First get UBA location 763001.

	LXI	H,UBA.RD	; Pointer to UBA read-in list
	CALL	CHNXCT		; Read-in the UBA info.. now its in EMBUF
	INTON			; Don't print this
	CALL	EI1		; Actually do the read-in
	INTOFF			; Ok now

; Before we save it, we will set up for saving RH registers.. That way,
; we can use some common code for putting data into our save buffer.

	LXI	B,RH.EXE	; Now point to a channel command list
	LXI	D,RM100		; And point to a place to put the list
	MVI	A,6		; It takes six bytes to move the entire list
	CALL	M5B		; Move the stuff to RAM
; The code to move bytes requires "B,C" pointing to the source and "D,E"
; pointing to the destination. And "A" having how many bytes to be moved.
; "MOVREG" does 5 bytes free of charge.  B,C and D,E are  updated by the
; number of bytes moved.

	LXI	H,SAVLST	; Point to a list of things which we must save
	PUSH	H		; Place it in the RAM for safe keeping
	LXI	D,RHSAVE	; D,e gets the pointer to the save area
RH.LP:	LXI	B,EMBUF		; We will always be moving stuff from "EMBUF"
	CALL	MOVREG		; Move 5 bytes, please

; To  save  the RH registers, we will put a tiny channel command list into
; RAM space, then execute it, changing the desired registers between reads,
; which will give us a chance to save the results of the read.

	POP	H		; Get pointer into "reg to be saved" buffer
	MOV	A,M		; Get current byte into accum
	STA	RM100+1		; Put byte into buffer so can be executed
	INR	A		; Up by one
	JZ	SCE.GO		; If that makes .eq. 0, then out

	INX	H		; Else update pointer
	PUSH	H		; Save the pointer too
	LXI	H,RM100		; Prepare to execute the readin buffer
	PUSH	D		; Now save spot we are in in the RHSAVE area
	CALL	CHNXCT		; Do RH register is in
	POP	D		; Retrieve pointer to the data save space
	JMP	RH.LP		; Save info, and read in next RH register

; Now data has been saved, we can actually begin to restore the micro-code

SCE.GO:	INTON			; Set internal mode
	LXI	D,^O1002	; Place in disk page of pointers to micro-code
	CALL	FILESH		; Go read in the first page of micro-code
	  JC	C.BTERR		; If err its all over

	CALL	DMEM2CR		; Go load cram

	LHLD	SCEADR		; Get address at which to continue
	CALL	CADWR		; Set the cram address to the guy that slipped

; We are nearing the end  of this recovery stuff.. we must restore the state
; of the RH11 and UBA to what it was before we started, then we can turn the 
; clocks on again.

	LXI	H,UBA.RD	; Point to a UBA read channel command list
	CALL	CHNXCT		; Set the I/O address to a UBA page register
; Now fix up the format between a read of the UBA paging reg, and
; the write we wish to do to the paging RAM.

	LDA	RHSAVE+3	; Get the byte that has the current cntrl bits
	ANI	^O170		; Off junk, keep only 4 relevant bits
	MOV	C,A		; Save in the C reg
	LXI	H,RHSAVE	; Now point to our buffer with the desired info
	CALL	SHR36		; Shift data right, 4 places
	.BYTE	4

	MOV	A,C		; Get our control bits back
	STA	RHSAVE+2	; Plop them into the 36 bit word
	CALL	SHR36		; Now shift the whole mess 5 more places
	.BYTE	5

; And thats it.. move stuff to a deposit buffer

	MOV5B			; A "move"
	.ADDR	RHSAVE		; From the save buffer
	.ADDR	DMDAT		;  to the deposit buffer
	CALL	DI1		; Write this mess back to UBA paging RAM

; Now we want to write back the RH11 registers that we saved, then destroyed

	LXI	H,RH.EXE	; Now set the RH11 register i.d. into the 
	CALL	CHNXCT		; Internal buffer "IOAD",including UBA number

	LXI	H,SAVLST	; Point to list of regs to be restored
	PUSH	H		; Save this info on the stack
	LXI	B,RHSAVE+5	; Will begin moving stuff we saved from RH
DI.LP:	LXI	D,DMDAT		; Always move the stuff to the deposit buffer
	CALL	MOVREG		; Move the stuff into "DMDAT"
	POP	H		; Get our little list pointer
	LDA	IOAD		; Get current offset into RH
	ANI	^O300		; Throw away current offset
	ORA	M		; Throw our desired offset into the word
	STA	IOAD		; Put it back into the IOAD buffer
	MOV	A,M		; Get the offset we just messed with
	INR	A		; Test to see if end of list
	JZ	CONT.I		; If end of list, finish the recovery
; Not end of list, must save some more RH registers

	INX	H		; Update the list pointer
	PUSH	H		; Save the pointer
	PUSH	B		; Save pointer to the saved data in "rhsave"
	CALL	DI1		; Now restore this RH register
	POP	B		; Restore pointer into buffer
	JMP	DI.LP		; Continue

CONT.I:	CALL	SMFINI		; Get current parity defaults & write them out
	CALL	CSCMD		; Turn the clock back on
	INTOFF			; No more internal mode
; Routine to check if current RAM address is the desired break address..

BREAK:	PUSH	D		; "D,E" has pointer to desired addr, save it
	MVI	A,3		; Diag func to read current RAM addr
	CALL	READC		; Go do function read
	POP	D		; Now make "D,E" point at desired again

	LHLD	TMPB2		; Get current address..
	MOV	A,H		; Also make sure current just read is 11 bits
	ANI	^O7		; 8 Bits lo half, plus 3 bits hi half
	MOV	H,A		; Now put the whole mess back

	LDAX	D		; Get lo order piece to accum
	CMP	L		; Check versus just read
	RNZ			; If .ne. 0, then no match, so out..
	INX	D		; Ok, so update pntr to read-in
	LDAX	D		; Get hi order of desired piece
	CMP	H		; Compare, signs take care of themselves
	RET			; If result of add was zero, good.if not,ok too..

; Routine to do short form of examine memory
; Enter with "D,E" containing short address

EXAMSH:	STC			; Set C-Bit for later use in common code
DEPSHT:	XTHL			; Swap so H,L points to trailing arg
	CALL	TARG1		; Collect trailing arg into "D,E"
	XTHL			; Swap back so that things are right
	XCHG			; And now make "H,L" hold the trailing arg
EXMHL:	SHLD	SHRTAD		; Store short address in the ram
	LXI	D,SHRTAD	; DE, gets replaced with a pointer to short address
	PUSH	PSW		; Save the C-Bit for later use
	CC	EMINT		; If C was set, go do an examine
	POP	PSW		; Get flags as they were
	CNC	DMINT		; If C was clr do a deposit
	RET			; Now ok to return

; Routine that executes an "ARG16", then returns the data in "H,L"

ARG16.:	ARG16			; Argument assembler
	.ADDR	T80DT		; Use a temp location

	LHLD	T80DT		; Gather data into H,L
	RET			; And back
; Subroutine to print a single 8-bit byte as octal data of the form: xxx
; No regs destroyed..pntr to 8-bit byte passed in "H,L"

P8BIT:	PUSH	H		; Save all registers
	CALL	OCTAL		; Create 8-bit buffer as a 3 octal characters
	.BYTE	1		; One byte of binary data involved
	.BYTE	3		; Want only 3 octal chars
	MVI	C,03		; Num chars to print
P8LP:	POP	PSW		; Char off top of stack
	CALL	PCHR		; And go print it
	DCR	C		; Down count
	JNZ	P8LP		; And continue till done all 3

	POP	PSW		; Restore regs
	RET			; And all done

; When doing a "P8BIT" with the data passed in the accum
; instead of being pointed to by H,L then come here.

P8BITA:	PUSH	H		; Must save H,L here, so we can mess it up
	LXI	H,P8.TMP	; Keep a place for printing data
	MOV	M,A		; Put the thing to be printed in the RAM space
	JMP	P8BIT1		; Go to common code
; Subroutine to print 16-bits worth of data..
; Pointer to that data is passed to the routine in Register "H,L"

P16.:	LXI	H,TMPB2		; In this type call, we load H,L automatically
P16:	PUSH	PSW		; Save all the registers

	CALL	OCTAL		; Create octal chars from the 16-bit data
	.BYTE	2		; We have 2 bytes of relevant data
	.BYTE	6		; And we want 6 octal chars to print

	MVI	B,6		; On return we want to print 6 chars
P16LP:	POP	PSW		; Get octal char off stack
	CALL	PCHR		; And go print it
	DCR	B		; Down the count
	JNZ	P16LP		; Back to print more till all done

	POP	H		; restore all regs
	RET			; And return

; Subroutine print 36-bit binary data as a 12-octal digit character
; string in the form:  XXXXXX,,XXXXXX
; No regs destroyed-bin data pntr passed in "H,L".

P36.:	LXI	H,EMBUF		; In this call, we load H,L automatically
P36:	PUSH	PSW		; Will save all regs in here
	CALL	OCTAL		; Create 36-bit buffer as an octal char string
	.BYTE	5		; 5 Bytes required by 36-bits
	.BYTE	^D12		; Want 12 octal digits

	CALL	PHALF		; Print 18 bits

; If here, just finished first pass, need 2 commas.

	PCHAR	COMMA		; Print ",,"
P36RH:	CALL	PHALF		; Print 18 more bits...
	POP	H		; Now restore all the regs
	RET			; Return
; Routine prints 18 bits as 6 octal chars

PHALF:	POP	H		; Get a return addr off stack,so stack is clr
	MVI	B,6		; "B" will be a counter, in it with 3
P36L2:	POP	PSW		; Characters to accum
	CALL	PCHR		; Print it

	DCR	B		; Down count
	JNZ	P36L2		; Continue if not done 6 chars yet
	PCHL			; Return

; Routine to alone print 18 bits

P18:	PUSH	PSW		; Will save all regs in here
	CALL	OCTAL		; Create 6 octal chars
	.BYTE	3		; 3 Bytes have relevant data
	.BYTE	6		; And desire 6 octal chars

	JMP	P36RH		; Go to right half printer from "P36"
; Universal binary data to ascii character subroutine.
; Routine destroys the contents of all registers.  Pass pointer to
; binary data in "H,L" ,then call appropriate  conversion  desired
; with 2 trailing parameters-chars placed on stack, MSB-LSB.
; 	DB	XX	; number of bytes holding relevant binary data
; 	DB	YY	; number of ascii characters to be generated
; Routines are "octal", "binry", and "hexidecimal"

; Code was never used..keep text here just in case we ever need to add it..
; this way we won't have to figure it all out again.
;BINRY:	LXI	D,^O401		; load D=1,E=1
; 	JMP	COMEN		; go to common code

OCTAL:	LXI	D,^O1407	; Load D=3,E=7
	XCHG			; Swap "D,E" with "H,L"
	SHLD	BTMSK		; Set data into "BTMSK" & "BTNUM"

; Pointer to bin data now in "D,E"

	XTHL			; "H,L" now points to trailing args
	MOV	B,M		; Bomb "B" register, now contains "num" bytes
	INX	H		; Update pntr
	MOV	C,M		; Num chars into c
	INX	H		; And update pntr to ret addr

	SHLD	HLSAVE		; Save return in ram
	POP	H		; Clear old stuff off stack
	PUSH	B		; Save "B,C" just temporarily

	LXI	H,TMPBF2	; "H,L" now points to temporary buffer

; If fall to here, must move data from binary buffer to temp buffer

OCTL1:	LDAX	D		; Data pointed to by "D,E" to accum
	INX	D		; Bump pointer
	MOV	M,A		; Set that data in RAM
	INX	H		; Bump pointer
	DCR	B		; Done all bytes yet?
	JNZ	OCTL1		; Back till moved all.

	POP	B		; Restore "B,C" and go

	LXI	H,TMPBF2	; "H,L" now pnts to tmp buff
	XRA	A		; Clear accum
	MOV	D,A		; Clear "D" reg
	MOV	E,B		; Byte count to "E"
	DCR	E		; Buff is always 1 less than byte count
	DAD	D		; "H,L" gets buff addr plus byte count
	SHLD	OCTSV		; And save this addr in the RAM
; Here will begin translation from binary to characters

OCTLC:	LXI	H,TMPBF2	; "H,L" now points to temporary buffer
	LDA	BTMSK		; Now get bit mask
	ANA	M		; And to keep only desired chars

	ADI	^O60		; Make into ascii

; Now must rotate entire buffer 3 places to rid ourselves of char just processed
	PUSH	PSW		; Now save character weve just created
	DCR	C		; Down the char count
	JZ	OCTL5		; Jump out if processed all chars
	LDA	BTNUM		; Get num bits into accum
	MOV	D,A		; "D" gets inital count of bits

OCTL3:	MOV	E,B		; "E" gets byte count
	LHLD	OCTSV		; Get updated buff pntr to "H,L"
	ANA	A		; Clear "C-Bit"

OCTL4:	MOV	A,M		; Group of binary bits to accum
	RAR			; Bit 0 into "C" bit
	MOV	M,A		; And shifted data back into mem
	DCX	H		; Step up in the buffer (upside-down buffer)
	DCR	E		; Down byte count
	JNZ	OCTL4		; Continue with buffer
	DCR	D		; Done buffers worth, see if done all 3 bits worth

; Done the 3-bits, now continue with next character

	JMP	OCTLC		; Go process next character

; Here when done all chars.

OCTL5:	LHLD	HLSAVE		; Grab the return address
	PCHL			; And return
; Subroutine to shift 36-bit data buffer some number of places to the
; right.  Address of buffer to be shifted is passed in "H,L".  Number
; of places for it to be shifted is passed as a trailing parameter in
; a byte trailing the subroutine call.
; 	.BYTE	XX		; num places to shift

SHR36:	MVI	A,5		; A shift 36 requires 5 bytes to be moved
SHRGO:	XTHL			; Pointer to trailing byte into "H,L"
	PUSH	B		; Save all the registers
	MOV	B,M		; Number places  to shift in "B"

	INX	SP		; Bump stack pointer around the saved "B,C"
	INX	H		; Now bump return address past the trailing arg
	XTHL			; And put it back onto the stack
	DCX	SP		; Now fix stack so that saved "B,C" is back on top

	MOV	E,A		; Number of bytes involved was in A, save in E

	DCR	A		; Fix count
	ADD	L		; And now add count to "H,L" address
	MOV	L,A		; Put back into  lo order
	MOV	A,H		; Get hi piece
	ACI	0		; And add A carry to H if there was one
	MOV	H,A		; Now put it back

	PUSH	H		; And put on stack for reuse

S36BL:	POP	H		; Fetch saved, updated address
	PUSH	H		; Now save "H,L"
	MOV	C,E		; Get number byte involved into C again
	ANA	A		; Clear the C-Bit

S36LP:	MOV	A,M		; Get byte from buff to accum
	RAR			; Shift it right
	MOV	M,A		; Now put it back into the buffer
	DCX	H		; Next byte

	DCR	C		; Wait!..have we done all bytes yet??
	JNZ	S36LP		; Back into loop if not yet
; Fall thru when done the 5 bytes

	DCR	B		; Done number of times yet??
	JNZ	S36BL		; Jump if yes done all

; Here when all done

	POP	H		; Restore the "H,L"+X
	POP	H		; Restore "B,C"
	POP	D		; Restore "D,E"
	POP	B		; Restore "H,L"

; Routine to assemble 16-bit argument.  Place to put 16-bit data passed
; as a trailing argument.  "B,C" is messed up by this routine.

ARG96:	MVI	A,12.		; Numb bytes used in ARG96 is 12

.ARG36:	MVI	A,5		; Numb bytes used in ARG36 is 5

.ARG16:	MVI	A,2		; Numb bytes used in ARG16 is 2
ARGBEG:	POP	H		; Get H,L from trap handler
	LDA	RPTON		; Is this a repeat?
	ANA	A		; Check the repeat flag
	JNZ	CLEAN		; Jump if yes a repeat....

; Else fall thru and "get" characters as binary data

	LHLD	.ARG1		; Get pntr to arg
	LXI	B,00		; Clr regs "B,C"

GETLP:	MOV	A,M		; Get an ascii character
	SUI	^O60		; Otherwise, off ascii stuff
	ANI	^O370		; Now be sure it was num and not char
	JNZ	GETEN		; If had bits go see if proper ending
	MOV	A,M		; Messed up char, get it back
	SUI	^O60		; Off the ascii again
	PUSH	PSW		; So we can stack it

	INR	C		; Was ok.. so up count
	INX	H		; And update to next char
	JMP	GETLP		; And continue till done
; Jump to here when stacked all the chars

GETEN:	CALL	SEPCHR		; Throw out trailing spaces & tabs
	SHLD	.ARG1		; Save "H,L"
	CALL	EOCML		; End of line?
	JNC	KILNM		; If not we have a problem

	LHLD	RPBUFS		; Get pntr to repeat data buffer
	XRA	A		; Clr accm
	MOV	M,A		; Clr the "byte" counter
	INX	H		; Update pointer

	MOV	E,L		; Copy pointer into "D,E" reg
	DCR	C		; Make C start at count-1

RPINCB:	PUSH	D		; H,L should be same as D,E
	POP	H		; So do it using stack
	INX	D		; Except D,E should be
	INX	D		;   3 greater

	PUSH	H		; Save H,L for a minute
	LHLD	RPBUFS		; While the "byte" counter gets updated
	MOV	A,M		; Copy current count
	ADI	3		; Update by 3
	MOV	M,A		; Now put it back
	POP	H		; And fix up H,L

	MVI	B,8.		; B gets a count of 8 for our loop
A16PK:	POP	PSW		; Get 3-bit binary

ARGQQ:	STAX	D		; And put into tmp buffer

; Don't mess up "H,L", its needed by "SHR36" routine

	CALL	SHR36		; Shift thing 36 places
	.BYTE	3		; Shift 3 places

	DCR	C		; Down char count
	JP	NOTRK		; Fool the 8-time loop if goes minus
	XRA	A		; Clr accum,in order to pad with zeroes
	DCR	B		; Down our "8" counter
	JZ	CHKSTK		; And out if zero
	JMP	ARGQQ		; Else continue looping

NOTRK:	DCR	B		; Down count the 8-time loop
	JNZ	A16PK		; If still doing 8-times
; Done check if C has gone to zero

CHKSTK:	MOV	A,C		; Copy C to accm to check if zero
	ANA	A		; .Eq. 0?
	JP	RPINCB		; Jump if not yet..

; Else fall thru..must now move assembled number to destination

CLEAN:	LHLD	RPBUFS		; Get byte counter for this data
	MOV	B,M		; Now b has count of number bytes assy'd
	INX	H		; Fix H,L up again..

; Now H,L has src.  D,E has ff.   Stack has PC

	XTHL			; Swap-eee
	CALL	TARG1		; Assemble dest addr into D,E
	XTHL			; Swap-eee back

	LDA	CHRCNT		; Get numb chars desired by this routine
	MOV	C,A		; C now has desired.  B has numb char assy'd
MOVLP:	MOV	A,M		; Start moving chars to destination
	STAX	D		; Char to dest..
	INX	H		; Update src pointer
	INX	D		; Update dest pointer
	DCR	C		; Down the desired count
	JZ	FIXPNT		; If got desired number,dont pass any more

	DCR	B		; Down the assy'd count
	JNZ	MOVLP		; Keep on keepin' on

; When fall thru weve moved all that we pad the buffer

	MOV	A,B		; Clr accum.  B must be zero
PADLP:	DCR	C		; Down the desired count
	JM	FINARG		; If that's minus, were all done..
	STAX	D		; Otherwise stack a zero
	INX	D		; Updat dest pointer
	JMP	PADLP		; And continue till done

FIXLP:	INX	H		; Must update buffer pointer
FIXPNT:	DCR	B		; Down the assembled count
	JNZ	FIXLP		; And go back to adjust pointer if not zero

FINARG:	SHLD	RPBUFS		; Now put back our little pointer
	RET			; And get out
; Routine for shuffling bits for a nice cram format

PLACE:	MOV	A,M		; Get piece of src byte
	STAX	D		; Place at destination
	INX	H		; Update src pointer
	INX	D		; Update destination pointer
	MOV	A,M		; Get upper 4 bits of 12 bit chunk
	ANI	^O17		; Make sure only 4 bits worth
	STAX	D		; And place at the destination
	INX	D		; Destination update
	DCX	H		; Backup the src pointr to begin of 24 bits
	RET			; And return

; Routine to complete the trap handling type operation which changes
; a normal 3 byte subroutine  call into a 2 byte trap type call.  It
; costs 3 bytes to add any subroutine to the trap call, so  that you
; save at least one byte for any  subroutine that is called 3 times.
; And you save one byte for each additional time it is called.

RTNDIS:	LXI	H,DLIST		; Get pointer to dispatch list
	PUSH	PSW		; Save state of processor flags
	PUSH	D		; Save "D,E"..trap cant destroy regs
	ADD	L		; Add offset in accum to address.
	MOV	L,A		; Put addr plus offset back
	MOV	A,H		; Get hi order piece
	ACI	0		; Now add in a carry if there was one
	MOV	H,A		; Put it back

	MOV	E,M		; Now go fetch addr to be dispatched to
	INX	H		; Update to next
	MOV	D,M		; Now fetch hi order piece of addr to be dispatched to
	XCHG			; Get dispatch addr into H,L
	POP	D		; Restore D,E. Now only H,L//ret addr on stack
	POP	PSW		; Restore processor flags
	PCHL			; Dispatch to appropriate subroutine

	.ADDR	.CRLF		; +2
	.ADDR	.ARG16		; +4
	.ADDR	.RUN..		; +6
	.ADDR	.ARG36		; +8.
	.ADDR	.CLRRM		; +10.


CLRBYT:	MVI	H,^O40		; This half generates the "20000's" weight of addr
	MOV	L,A		; This generates the rest of the RAM address
	MVI	M,0		; Clear that location
	POP	H		; Fix H,L
	RET			; Out & done


	JMP	NORML		; Error must reset the stack
KILNM:	PLINE	BB1		; ?BN bad number
MMERR:	LDA	MMFLG		; See if in maintenace mode
	ANA	A		; Set 8080 flags
	JZ	REINI		; If no MM mode, out
	CALL	DECNET		; Finish up any messages
MMERR1:	CALL	MMCMD		; If yes, reset mode
	JMP	REINI		; Error must reset the stack

; Errors incurred during the boot process

D.BTERR: ADI	1*2		; Failure when tried to start ucode after boot

C.BTERR: ADI	1*2		; Failure during the reading of the micro-code

B.BTERR: ADI	1*2		; Failure during reading of the page of pointers

A.BTERR: ADI	1*2		; Failure during the reading of the home block

	CALL	LTFLT		; These boot errors are fatal
BTERR1:	STA	ERRCD+1		; This bit of code goes in hi order byte of number
	CLRB	NOPNT		; Restore printing
	PLINE	BTFAIL		; Print message "?BT "
	LXI	H,ERRCD		; Point to the error code
	CALL	P16		; Print the 16-bit number
	PCRLF			; Put a CRLF at the end of this line
	JMP	REINI		; Kill the process

; Code for when only bootstrap fails to readin

L.BTERR: LXI	H,STATE		; Get pointer to state light
	MVI	A,^O01		; Set fault light, but don't change state
	ORA	M		; Throw current state with fault bit
	MOV	M,A		; Put stuff back
	MVI	A,8*2		; Failure during loading of pre-boot program
	JMP	BTERR1		; Avoid some code
; Subroutine to check if a command from the CSL board has been granted
; the bus.  Which it must always be granted because it is the bus master.

BUSRESP: XTHL			; Get pointer to trailing arg
	IN	SMSTS		; ***** I/O RD 301 *****
	CMA			; Fix inversion
	ANA	M		; "And" read stuff vs. trailing arg
	INX	H		; Update to return addr
	XTHL			; Swap return back to stack
	RET			; Return.."Z-bit" corresponds to "and" results

; Little routine to set and or clr the software run flag

SETRN:	MVI	B,STBIT		; We want to set the run light
	CALL	STATEM		; Go do it
	.BYTE	^O17		; And don't mash anything
	XRA	A		; Clear accum
	CMA			; Accum = -1
RNCOM:	STA	RNFLG		; Data to run flag
	RET			; And out

CLRRN:	MVI	B,0		; We don't want to set anything
	CALL	STATEM		; Just go and clear some things
	.BYTE	^O13		; Bits to keep
	XRA	A		; Clear accum
	JMP	RNCOM		; And out.

NOREFRESH: CLRB	NOPNT		; Turn typing on
	CLRB	CHKREF		; Say not to report over and over
	CALL	CLRUSE		; Exit from user mode
	PLINE	MOSMSG		; Message to cty

LTFLT:	PUSH	PSW		; Must save accum to get correct "BT err msg"
	MVI	B,1		; We merely want to set fault light
	CALL	STATEM		; Go set the lights
	.BYTE	^O12		; Bits to flush with this
	POP	PSW		; Restore accum
	RET			; And now safe to return
; Routine to clear and set bits in the state word, then to light 
; the lights on the front panel as specified by the state word.

STATEM:	XTHL			; Get pointer to mask
	LDA	STATE		; Now fetch current state of the machine
	ANA	M		; Mask as specified
	INX	H		; Update return pointer
	XTHL			; And put it back on the stack

	ORA	B		; Now throw in any new bits
	STA	STATE		; Now save it
	OUT	LIGHTS		; Change the lights
	RET			; Out

; Subroutine to decide if "first" points to an end-of-command character.
; C-Bit set if yes, "first" does point to end-of-command.  Accumulator
; is destroyed.

EOCML:	PUSH	H		; Save "H,L"
	LHLD	.ARG1		; Get current pointer for command buffer

	MOV	A,M		; Get character

	CPI	SEMIC		; (5.2H) Comment beginning?
	JZ	MMERR		; (5.2H) Jump if yes

	CPI	EOLCH		; End-of-command?
	JZ	EOLYS		; Jump if yes

	CPI	COMMA		; Or, end-of-command?
	JZ	EOLYS		; Jump if yes

; Here if not... clr "C-Bit" & leave

	ANA	A		; Clr "C-Bit"

	POP	H		; Restore "H,L"
	RET			; Return

; Comment found - assume that anything else on the line is a comment
; also.  This prevents commas in the command to cause comment text to
; be interpreted as commands also.

EOLCM:	CALL	BFRST		; Clear input buffer

; Here if yes, at end-of-command

EOLYS:	STC			; Set carry
	POP	H		; Restore "H,L"
	RET			; Return
; Subroutine to move 5 contiguous bytes beginning with a specified source
; address,to another buffer area, its address  also  passed as a trailing
; argument.  Source address is first  trailing  parameter, destination is
; second trailing parameter.

.MOV5B:	POP	H		; Get H,L from trap handler
	XTHL			; Swap stack top with "H,L"
	PUSH	D		; Save "D,E"
	PUSH	B		; Save "B,C"
	CALL	TARG2		; Assemble args into "B,C" and "D,E"

	CALL	MOVREG		; Move the data, args passed in registers
	POP	B		; Restore "B,C"
	POP	D		; Restore "D,E"

	XTHL			; Restore stack
	RET			; And return

MOVREG:	MVI	A,5		; Set counter to 5
M5B:	DCR	A		; Down counter
	CNZ	M5B		;  And be recursive till down counted

	LDAX	B		; Byte to accum
	STAX	D		; Store at destination
	INX	D		; Up both pntrs
	INX	B		;  To next byte
	RET			; And back to caller

; Subroutine  to compare 2 36-bit values.  If the addresses of the 2 36-bit
; buffers are passed as trailing parameters to the routine. If both buffers
; are the same, the "C-Bit" is clr upon return.  If they are different, the
; "C-Bit" is set on return.

CMP36:	XTHL			; Swap stack top with "H,L"
	CALL	TARG2		; Get the 2 trailing args into "B,C" & "D,E"
	XTHL			; Put return back on stack
	XCHG			; Swap "D,E" & "H,L"
	MVI	D,5		; Set counter to 4.

CMPLP:	LDAX	B		; Get a byte of data
	CMP	M		; Compare
	RNZ			; Return with z-clr if had err..
	INX	B		; Bump pointer
	INX	H		; Bump other pointer
	DCR	D		; Down count
	JNZ	CMPLP		; Continue till done
	RET			; Normal return

; Subroutine to assemble trailing args into register pairs.
; Routine used to save core only because this sequence of coding
; is repeated so often.  "H,L" points to the trailing arg of the
; original caller.  "D,E" and "B,C" must have been saved  before
; this routine is called or they will be destroyed.  If a single 
; trailing arg is to be gathered up, it will be put into the reg
; pair "D,E" via the call "TARG1".  If two trailing  args  to be
; gathered  up, the  first will be put into "B,C" and the second
; will be put into "D,E".  "H,L" is updated to point to the byte
; following the trailing args.

TARG2:	MOV	C,M		; Lo order source to "C"
	MOV	B,M		; Hi order source to "B"

TARG1:	MOV	E,M		; Lo order source to "E"
	MOV	D,M		; Hi order source to "D"

	RET			; And return

; Subroutine  to  add 1 to a 36-bit buffer and guarantee that the
; carry propagates correctly.  Buffer to be incremented is passed
; as a trailing arg.

INC36:	XTHL			; Get pointer to trailing arg
	CALL	TARG1		; Assemble arg into "D,E"

	XTHL			; Put return back on the stack
	XCHG			; Now H,L pnts to buffer to be incremented

	XRA	A		; Clr the accum
	STC			;  And set "C-Bit"

INCLP:	ADC	M		; Add piece of data buff, with cry
	MOV	M,A		; And put it back, with the addition
	RNC			; Return if finally stopped cry's into next byte
	INX	H		; Next piece to inc
	JMP	INCLP		; And continue if there was a cry
; Subroutine "RDATT"
; Routine reads I/O registers 0,1,2,3,103 and moves the data in those
; buffers (BUS.bits 0-35) into a RAM area whose address  is specified
; by a trailing parameter used with the call to this routine.
; Call is:
; 	DW	XXX		; XXX is place to move the 36 bits of data
; Accumulator is destroyed, reg pair "D,E" is incremented by 5.

	XTHL			; Swap stack top with "H,L"
	CALL	TARG1		; Assemble trailing arg into "D,E"
	XTHL			; Put back the stack

; The real reading code begins here & also serves as an alternate entry
; if you choose to pass the buffer address in register "D,E"

	PUSH	D		; Save "D,E"
	IN	D2835		; ***** I/O RD "0" (bits 28-35) *****
	STAX	D		; Save in RAM
	INX	D		; Up pntr to next byte
	IN	D2027		; ***** I/O RD "1" (bits 20-27) *****
	STAX	D		; Save in RAM
	INX	D		; Up pntr to next byte
	IN	D1219		; *****I/O RD "2" (bits 12-19) *****
	STAX	D		; Save in RAM
	INX	D		; Up pntr
	IN	D0411		; ***** I/O RD "3" (bits 4-11) *****
	STAX	D		; Save
	INX	D		; Up pntr
	IN	D0003		; ***** I/O RD "103" (bits 0-03) *****
	ANI	^O17		; Off trash in d bits 7-4
	STAX	D		; Save
	POP	D		; Restore "D,E"
	RET			; Return
; Subroutine "WDATT"
; Routine writes I/O Registers 102,104,106,110,112 and gets address
; either passed as a trailing parameter, or passed in "D,E".
; Call is:
; 	DW	XXX		; XXX is source of data to be written

WDATT:	XTHL			; Swap stack top with "H,L"
	CALL	TARG1		; Assemble trailing arg into "D,E"
	XTHL			; Swap stack back to original state

; Alternate entry for when passing data pointer in "D,E"

WDATP:	PUSH	D		; Save "D,E"
	LDAX	D		; Data 28-35 to accum
	OUT	W2835		; ***** I/O WRT "102" (bits 28-35) *****
	INX	D		; Next datum

	LDAX	D		; Data 20-27 to accum
	OUT	W2027		; ***** I/O WRT "104" (bits 20-27) *****
	INX	D		; Next datum

	LDAX	D		; Data 12-19 to accum
	OUT	W1219		; ***** I/O WRT "106" (bits 12-19) *****
	INX	D		; Next datum

	LDAX	D		; Data 4-11 to accum
	OUT	W0411		; ***** I/O WRT "110" (bits 04-11) *****
	INX	D		; Next datum

	LDAX	D		; Data 0-3 to accum
	OUT	W0003		; ***** I/O WRT "112" (bits 00-03) *****
	POP	D		; Restore "D,E"
	RET			; Return
; Subroutine "ADATT"
; Routine writes I/O Registers 103,105,107,111,113 and gets address
; either passed as a trailing parameter, or passed in "D,E".
; Call is:
; 	DW	XXX		; XXX is source of data to be written

ADATT:	XTHL			; Swap stack top with "H,L"
	CALL	TARG1		; Assemble trailing arg into "D,E"
	XTHL			; Swap stack back to original state

; Alternate entry for when passing data pointer in "D,E"

ADATP:	PUSH	D		; Save "D,E"
	LDAX	D		; Data 28-35 to accum
	OUT	A2835		; ***** I/O WRT "103" (bits 28-35) *****
	INX	D		; Next datum

	LDAX	D		; Data 20-27 to accum
	OUT	A2027		; ***** I/O WRT "105" (bits 20-27) *****
	INX	D		; Next datum

	LDAX	D		; Data 12-19 to accum
	OUT	A1219		; ***** I/O WRT "107" (bits 12-19) *****
	INX	D		; Next datum

	LDAX	D		; Data 4-11 to accum
	OUT	A0411		; ***** I/O WRT "111" (bits 04-11) *****
	INX	D		; Next datum

	LDAX	D		; Data 0-3 to accum
	OUT	A0003		; ***** I/O WRT "113" (bits 00-03) *****
	POP	D		; Restore "D,E"
	RET			; Return

; Local subroutine to clr

.CLRRM:	POP	H		; Fix reg as messed up by RST instr
	XTHL			; Pointer to the trailing param
	CALL	TARG1		; Assy arg into "D,E"
	XTHL			; Fix "H,L" and replace for return
	XCHG			; Put "D,E" stuff into "H,L"
	MVI	A,5		; And set starting count to 5
CLRT1:	DCX	H		; Down the mem address
	MVI	M,0		; 0 data to mem
	DCR	A		; Down the counter
	JNZ	CLRT1		; Back till done
	RET			; Return

; Subroutine to swallow separator characters from the address pointed
; To by "H,L", up to the first non-separator character.
; Separators are:  "Space"
;	 	   "Tab"
; Only the "H,L" register should be changed by this routine

SEPCHR:	PUSH	PSW		; Save accum and status
	DCX	H		; Down count H,L so nxt instr will make it even
SEPYS:	INX	H		; Up the count
	MOV	A,M		; Copy character into accum
	CPI	 ' 		; Is the char a "space"
	JZ	SEPYS		; Go update "H,L" if yes..

; Else see if its a tab

	CPI	'		; Is the char a "tab"
	JZ	SEPYS		; Go update "H,L" if yes

; Else no more separators-time to return

	POP	PSW		; Restore accum and status
	RET			; All done return


; Each unit of delay counted in the trailing byte is worth 1.02 micro-sec
; This  subroutine  wastes some amount of time.  The greater the trailing
; argument, the more time is wasted...

DELAY.:	XTHL			; Get pointer to trailing arg into "H,L"
	PUSH	PSW		; Now save accum
	MOV	A,M		; Get the trailing arg into accum
	INX	H		; Up date to correct return location
DLYLP:	DCR	A		; Down the counter
	PUSH	PSW		; Add more delay in the loop
	POP	PSW		; Because pushes and pops take long time
	JNZ	DLYLP		; Loop till zero
	POP	PSW		; Restore accum
	XTHL			; Put return back onto the stack
	RET			; And done


; Routine to compare a typed in ascii string  versus  some  expected
; string.  Enter with "H,L" pointing to the beginning of the type-in
; buffer and with D,E pointing to the expected string.  Return Z-Bit
; clr if no match.  Z-Bit set if match.

STRCMP:	LDAX	D		; Get first expected character
	ANA	A		; Set flags to see if zero byte
	JZ	STREND		; If zero byte, end of expected string.. out

	CMP	M		; If a real byte, compare against the type-in
	RNZ			; If no match, take error return
	INX	D		; If match , update to next expected
	INX	H		; And update to next typed in.

STREND:	SHLD	.ARG1		; Pass current pointer to routine that checks for EOL
	CALL	EOCML		; Check that type in was terminated
	RC			; If yes, Z-Bit is set,... ok to return

	ORA	H		; Clr Z-Bit flag.. H will be non-zero
	RET			; And out.....
; Routine called whenever KLINIK switch changes state.
; The routine examines the new state of KLINIK, zaps the lights as required
; then  sets  the  KLINIK  line  into the appropriate state.  If KLINIK was
; established, going to enable position will change nothing, but any switch
; change that increases the amount of protection will force change the mode
; of the KLINIK line. 
; The routine  is entered with "B" holding the new KLINIK switch state, and
; "KLNKSW" holding the old state.  Values are as follows:
; 	Enable = 2
; 	Protect = 6
; 	Disable = 4

KLNKLT:	MOV	A,B		; Copy KLINIK state into the accum
	STA	KLNKSW		; Save the new status
	CPI	4		; Is switch now in disabled position
	JZ	SETM0		; Go set Mode 0 if yes

	CPI	6		; Is switch now in the protect position?
	JZ	.SETM1		; If yes, go set Mode 1

; Fall thru if new switch position is the "ENABLE" position.  First
; check current mode.  If in Mode 3 already, we make no change.

	LDA	CSLMODE		; Get current CSL mode
	CPI	.MODE3		; Is it Mode 3

; Flags are set, fall into code that does the right thing if in Mode 3

	CNZ	SETM2		; If was not Mode 3, this will set Mode 2

; And fall into KL.LON code

KL.LON:	MVI	B,2		; Get a bit for setting the remote light on

; And fall into code for setting the lights

KL.LAMP: CALL	STATEM		; Set lights as specified in B reg
	.BYTE	^O375		; Keep all lights, 'cept remote
	RET			; And done with this mess


; Code for setting the KLINIK line into Mode 1

.SETM1:	LDA	PASSWORD	; Get current password
	ANA	A		; Set flags to see if any password exists
	JZ	SETM0		; If no password, then set into Mode 0
	CNZ	SETM1		; If password exists, set things into Mode 1
	JNZ	KL.LON		; If we went Mode 1, then must turn on light

; Code for actually setting the KLINIK line mode to 1

SETM1:	MVI	A,.MODE1	; Get Mode 1 flag
	LXI	H,MODE1		; Get the Mode 1 dispatch
	JMP	SETM		; Set up RAM

; Code that sets both Mode 0 and the appropriate lights

SETM0:	CLRB	KLLINE.ON	; Disabling KLINIK kills CTY availability
	MVI	B,0		; The pass lights off in register "B"
	CALL	KL.LAMP		; And go do the lights
	MVI	A,.MODE0	; Get the Mode 0 flag
	LXI	H,MODE0		; Get the Mode 0 dispatch
	JMP	SETM		; Set up RAM

; Code to set us into Mode 3

SETM3:	MVI	A,.MODE3	; Get Mode 3 flag
	LXI	H,MODE3		; Get the Mode 3 dispatch
	JMP	SETM		; Set up RAM
; Code to set us into Mode 4

SETM4:	LDA	USRMD		; See if user, if which case we won't do "Mode 4"
	ANA	A		; Set 8080 flags
	RNZ			; And out if user mode

; Accum must .eq. 0 if fell to here

	STA	MAILFG		; Better clear this flag too
	STA	E.CNT		; Use fastest way to clear this location
	LXI	H,E.BEG-1	; And reset enveloper
	MVI	A,.MODE4	; Get Mode 4 flag
	LXI	H,MODE4		; Get the Mode 4 dispatch
	JMP	SETM		; Set up RAM

; Set line to Mode 2

SETM2:	LDA	CSLMODE		; Before a/g else, see what we are doing now
	ANI	.MODE0!.MODE1	; If Modes 0 or 1, must interrupt KS10
	JZ	SETM2X		; If not, don't bother KS10 at all

	MVI	A,KL.ACTIVE	; Must inform the ten we are entering KLINIK
	CALL	WRD34		; Call routine that writes word 34
SETM2X:	LXI	H,MODE2		; Get dispatch for Mode 2
	MVI	A,.MODE2	; Set Mode 2 to the state flag also
SETDIS:	SHLD	MODDIS		; And set to KLINIK dispatcher
	RET			; And all done
; Little routine to hang up the KLINIK line

KILL.KLINIK: CLRB KLNKSW	; Force a relook at the remote switch
HANGUP:	LDA	STATE		; Get current state
	ANI	^O7		; Off the "DTR" signal
	MVI	A,CARRLOSS	; Tell KS10 that KLINIK carrier has gone away
	CALL	WRD34		; Deposit into word 34
	LXI	H,200. * 2	; Set a timing delay of 2 seconds
	JMP	LTLOOP		; Go do delay, and use his return to exit

; Routine for doing simple deposit into KS10 memory at word 34, and
; then interrupting the 10.

WRD34:	PUSH	PSW		; Save accum & status
	CLRRM	DMDAT		; Clear a buffer
	POP	PSW		; Fetch the accum's contents again
	INX	H		; Bump H,L (value after a CLRRM = 1st loc of buff)
	MOV	M,A		; Store data at "DMDAT+1"
	DEPOS	34		; Deposit
	JMP	POKE10		; Interrupt the KS10 & use his return

; Code used in adding up the checksums on envelopes to be sent

CHKADD:	ADD	B		; Here to add new char to the current sum
	MOV	B,A		; And keep the results in "B"
	INX	H		; Bump up to look at the next char
	JMP	TSKLP		; Back to loop

; This is the APT envelope sender.  When we have a buffer of info to 
; send to the APT host system, this is the code that gets called.

DECNET:	LDA	MAILFG		; Only do s/g here if the mailing flag set
	ANA	A		; Set 8080 flags
	RZ			; No flag, no sendy....

	EI			; Absolutely must allow interrupts, in case host dies
	LDA	ENVMNO		; First thing to do is complement the message #
	CMA			; Flip
	ANI	^O177		; No sign bits allowed
	STA	ENVMNO		; Put it back

	LXI	H,ENVBUF	; 1st thing to do is compute checksum for envelope
	MVI	B,0		; "B" will hold the current sum
TSKLP:	MOV	A,M		; Grab a character
	CPI	CRCHR		; See if end of the envelope character
	JZ	TSKGO		; If yes, go to the actual sender

	ANA	A		; Maybe the char was a 0, because there is no CRCHR
	JNZ	CHKADD		; If not, go add the character to the sum
; Here when time to actually mail an envelope

TSKGO:	INX	H		; Update past the "CR" character
	MVI	M,0		; Now guarantee that we end with "CR","0" pair
	MOV	A,B		; Grab the current sum
	CMA			; Complement
	INR	A		; Make twos complement
	ANI	^O77		; And only six bits count

; Now must decide if you need to ascii-ize the checksum

	CPI	^O75		; 75,76,77 don't get ascii-ed
	JP	TSKGO1		; So jump if any of those three
	ORI	^O100		; Had to ascii-ize, so do it with a 100
TSKGO1:	STA	ENVCHK		; Save in the appropriate place in the buffer

TSK2TSK: CLRB	APTANS		; Clear the answer
	KCHAR	SYNC		; 2 Syncs start every message

	LXI	D,ENVMNO	; Now send the rest 
	LDA	ENVBUF		; Grab first char of envelope just sent
	CPI	QUES		; Is it question mark?
	JZ	MMERR1		; If it was, abort envelope stuff, reset APT

	CPI	PERCNT		; Is it a per cent sign?
	JZ	MMERR1		; If it was, abort envelope stuff, reset APT

APT.WT:	LDA	APTANS		; Now wait for APT sys to answer(ack or nack)
	ANA	A		; If zero, got no answer yet
	JZ	APT.WT		; So wait

; Finally got an answer

	CPI	'N		; Was it a nack??
	JZ	TSK2TSK		; If yes, send it out again
	XRA	A		; Use fast way to clear a RAM location
	STA	MAILFG		; Say end of this envelope
	LXI	H,ENVBUF	; Point to the buffer
	SHLD	ENVPNT		; Save the pointer to the buffer
	RET			; Then out
; Subroutine to move a string of characters into the TTY input buffer,
; keeping track of the number of commas  and  other important features
; of the string.  Must pass the source of  the  characters in reg B,C,
; subroutine will bomb registers D,E and H,L

MV.ALL:	LXI	B,E.BEG+2	; Point to the character buffer to be executed
	CALL	BFRST		; Reset cmd chain pointers
MV.INP:	LXI	D,BUFBG		; DE, will point to the input buffer
	LXI	H,EOL		; And HL will point to the comma/eol counter
	MVI	M,0		; Make sure count begins at 0

MV.IN1:	LDAX	B		; Get first character from wherever it is
	STAX	D		; And put it into the buffer
	INX	B		; Up pointer
	INX	D		; And this one too

; Now check for comma or eol

	CPI	COMMA		; Is it a comma?
	CZ	MV.CNT		; If yes, increment the count

; Fall thru if was a comma before, EOLCH will not match

	CPI	EOLCH		; Is it an end of line?
	JNZ	MV.IN1		; If not, there is more to do

; Here if was an eol.. not only do we bump the count, we also get out

MV.CNT:	INR	M		; Up count
	RET			; And out


; Mode 4 handler.  Watches for the first sync char, then goes into
; a finite state machine mode where it collects an envelope.  When
; you enter here, Reg B has a copy of the character just typed.

M4.0:	CPI	SYNC		; Look for a sync character
	JNZ	MMOUT		; If not, simple print of character on cty

	LXI	H,M4.1		; Shift enveloper to next input state
	JMP	SETDIS		; And set interrupt handler to come here when
				; Done with interrupt

; State 2 of envelope eater.  This code will discard any additional syncs
; store the  message number when it finally gets here (& flic to state 3)
; or collect the first character of a cmd sequence (& flic to state 3).

	CPI	SYNC		; Is this an additional sync char
	RZ			; If yes, ignore and proceed

; Fall thru if not a sync

	LXI	H,COLLECT	; Now go to next state of envelope collector
	SHLD	MODDIS		; Set up for interrupt handler to find


; This is where you come on characters that are part of an envelope.
; This code checks for 2 kinds of terminators:  (1) End of envelope
;						(2) End of control sequence
; Or else merely stuffs the character into the envelope buffer. When
; an  entire  message  has been received, then we will calculate the
; checksums or  whatever, make  with  the  acks,  nacks, and execute
; whatever the stuff may be.  When you enter here, Reg B has  a copy
; of the character just typed.

COLLECT: CPI	DOLLAH		; TOPS20 calls a spade a "dollar"
	JZ	ACTION		; If "$", treat like an altmode

	CPI	ALT		; If altmode, then end of control sequence
	JZ	ACTION		; And jump if it was altmode. execute control char

	CPI	CRCHR		; If carriage return, then end of envelope
	JZ	EXECUT		; Go execute the envelope if <CR>

	CPI	SYNC		; Also look for "SYNC", which means "RESYNC"
	JZ	SETM4		; If yes, then must re-sync

; We must be aware of "re-syncing", in case the "ALT" or "CR" was garbled
; as  it  came  down  the  line, and  was missed by the 8080.  Re-syncing
; requires starting at the beginning of mode4.

; Fall thru if must simply shove the character into the buffer

COL.LP:	LHLD	E.BUF		; Get pointer to the last character in the buffer
	INX	H		; Bump pointer to first free
	MOV	M,A		; And stack the character in the buffer
	SHLD	E.BUF		; Replace the pointer

	LXI	H,E.CNT		; Get current character count
	INR	M		; Update
	MOV	A,M		; Now copy count to accum for testing
	CPI	^O134		; Too much for an envelope?
	JNC	NACK.EN		; If too many, nack it.. maybe he will start over
	RET			; Else out
; Here when an envelope is complete... We must compute the checksum and
; compare  against the check character sent over, then actually execute
; the contents of the envelope.

EXECUT:	LDA	E.CNT		; Get char count so we can tell when we finish
	MOV	C,A		; Put it in "C"

	LXI	H,E.BEG+1	; Point to the checksum in the envelope buffer
	MOV	A,M		; Get checksum character into the accum
	INX	H		; Update past the checksum just collected
	DCR	C		;   and down the char count for the things
	DCR	C		;   we just picked out of the list
	DCR	C		; We want loop to end at -1, instead of 0

ENV.LP:	ADD	M		; Add characters to checksum
	INX	H		; Next character
	DCR	C		; But first see if done yet
	JP	ENV.LP		; Back if not

; When done,check that checksum has worked out to be zero

	ANI	^O77		; Only six bits count
	JNZ	NACK.EN		; If # 0, then checksum failed and "nack"
; Fall thru to here if ok so far

	MVI	M,EOLCH		; Mark the end of the envelope with eol marker

; Now must check the message number for ok-ness

	LXI	H,LSTMSG	; Get pointer to message number
	MOV	C,M		; Save it in "C" for a little while
	LDA	E.BEG		; Grab current message number

	CMP	C		; Are they the same?
	JZ	ACK.EN		; If yes, do simple ack and ignore message

; If diff, twas a good message, save number and execute

	MOV	M,A		; Save message number as the last

	CALL	MV.ALL		; And move the stuff to a buffer for execution
	MVI	A,^O41		; Every cmd envelope executed resets the env #
	STA	ENVMNO		;   so reset the envelope message number to 41
	CALL	SETM4		; Mode 4 to grab interrupts correctly while running
	CALL	DECEX1		; Before executing, clear all old messages
	LXI	H,OKDN		; Tell normal ends to return here for further orders
	SHLD	NOREND		; Pass info in the dedicated RAM position
	JMP	DCODE		; And begin execution of the string read in
OKDN:	EI			; Must allow interrupts here
	CALL	DECNET		; If yes, mail envelope before ack'ing

; Now ok to acknowledge the command

ACK.EN:	CALL	SETM4		; Send "ack" down the KLINIK line

	RET			; Done with this
	.BYTE	SYNC		; Sync
	.BYTE	'A		; Acknowledge char
	.BYTE	ALT		; Altmode
	.BYTE	0		; End of string
NACK.EN: CALL	SETM4		; Send "nack" down the KLINIK line
	RET			; Back to caller

	.BYTE	SYNC		; Sync
	.BYTE	'N		; Negative acknowledge char
	.BYTE	ALT		; Altmode
	.BYTE	0		; End of string

ACTION:	LHLD	E.BUF		; Get the type of control this was(ack or nack)
	MOV	A,M		; Put it into accum
	STA	APTANS		; Set it into the answer word
	JMP	SETM4		; And now reset interrupt handler and out
; This is the code do do straight output from the KLINIK line to the cty
; and include  a  scheme  for  buffering  the output so that a 9600 baud
; KLINIK line will  output ok to a 300 baud cty.  If  interrupted  while
; printing a character, the characters waiting to be printed are stacked
; at the "SYSOUT" pointer.  Characters that are removed from the waiting
; buffer are removed via the pointer "SYSIN".

MMOUT:	ANA	A		; See if this is a null character
	RZ			; If yes, don't do nothin
	LHLD	SYSOUT		; See if we are busy printing
	MOV	A,H		; Get an indicator
	ANA	A		; Set pc flags
	JZ	NOTBUSY		; Go if not busy

; Fell to here if busy printing

	XCHG			; Save the current "SYSOUT" value (in D,E)
	LHLD	SYSIN		; Now see if this is first time in
	MOV	A,H		; Get the indicator
	ANA	A		; Set flags
	JNZ	STCK.Y		; Jump if already stacking

	LXI	H,SYSBUF	; First time in, so set input flag
	SHLD	SYSIN		; Set it

STCK.Y:	LXI	H,-SYSEND	; Now see if buffer is full
	DAD	D		; Add end to the current to see if buff full
	MOV	A,H		; See if zero
	ORA	L		; See if zero
	RZ			; If .eq. 0 throw away stuff..buff is full

; Here if not full. must stack this character

	XCHG			; Current pntr goes back to HL reg (pnt to SYSOUT)
	MOV	M,B		; Char into RAM space
	INX	H		; Up count
	MVI	M,0		; Guarantee a zero byte at the end of buffer
	JMP	SETOUT		; Put the pointer back where it goes
; Here if not printing yet.. print first character and plan on some more

NOTBUSY: LXI	H,SYSBUF	; This is the first time in
	SHLD	SYSOUT		; Set the flag & the pointer

	MOV	A,B		; Get char back to accum so can print it
MORE.:	MOV	B,A		; Where ever u come from, save accum in B reg
	CPI	LFCHR		; Is this a line feed?
	JNZ	MM.PNT		; If no, nothing special

	LDA	CNTLQ.ON	; Must we answer every <LF> with a "Cntrol-Q"
	ANA	A		; If flag .eq., then no, if yes then write it
	CNZ	KCHR0		; Yes, a <LF>, send the system a "Control-Q"
MM.PNT:	MOV	A,B		; No matter how u got here, char goes to accum
	EI			; Interrupts on now, begin printing
	CALL	PCHR1Z		; Print a char

; Back to here when done printing

	DI			; Don't bother me for a bit
	LHLD	SYSIN		; Grab pointer of things waiting to be printed
	MOV	A,H		; Get flag
	ANA	A		; Set flags
	JZ	DONE.BUF	; If nothin, all done

; Here when something to do

	MOV	A,M		; Grab a character to print
	ANA	A		; Must first check for end of buffer
	JZ	DONE.BUF	; If done reset the pointers and get out

	INX	H		; Next point
	SHLD	SYSIN		; Set into RAM
	JMP	MORE.		; Do more

; Here on done all..fall into Z-BUFF code

Z.TBUF: LXI	H,0		; We need to clear some buffers
	SHLD	SYSIN		; Clear pointer
SETOUT:	SHLD	SYSOUT		; And clear pointer


NOACK:	PLINE	NOA		; "Print no data ack"

	LXI	H,1		; Err code is 1
ERRRTN:	SHLD	ERRCD		; Set error code

NOARB:	XRA	A		; Clr accum
	OUT	BUSCTL		; ***** I/O WRT 210/0 *****

	LXI	H,2		; Err code is 2
	JMP	ERRRTN		; Go set error code

NIXOM:	XRA	A		; Clr accum
	OUT	BUSCTL		; *** I/O WRT 210/0 *** clr nxm bit aftr report
NIXEX:	LXI	H,3		; Error code 3
	JMP	ERRRTN		; Set error code


; A minor note: 40000 weight bit is "valid"
;		100000 Weight bit is "36-bit xfr"

	UBA. 763,001		; Address of UBA is first element of the list
	DI. 140,001		; Valid & "36 BIT XFR" for page 1 (1000-1777)
	LI. D776,P.10		; Get drive status & cntrl reg, so can set unit
	DI.INDIRECT UNITNM	; Now set the unit number
	EI. D776,P.12		; Address of drive status
	TWAIT 400		; Check that the drive is present
	WAIT 200		; Check & wait for ready
	LI. D776,P.10		; Addr of drive status reg
	DI. 0,40		; Issue controller clr
	DI.INDIRECT UNITNM	; Set to unit # 
	LI. D776,P.00		; Addr of controller status reg
	DI. 0,11		; Issue drive clear
	DI. 0,21		; Set "READ-IN-PRESET"
	LI. D776,P.12		; Get to the drive status register
	WAIT 200		; Wait for it to be ready
	TWAIT	100		; Now check that "PRE-SET" has set volume valid
	LI. D776,P.06		; Addr track/sector reg
	DI.INDIRECT	BLKNUM	; Empty for now
	LI. D776,P.34		; Addr of cylinder reg
	DI.INDIRECT	BLKADR	; Empty for now
QXFR:	LI. D776,P.02		; Add of word count reg
	DI. 176,000		; 512 Words is 1024 18-bit bytes (a page)
	LI. D776,P.04		; Addr of UNIBUS address reg
	DI. 4,000		; Set SM10 mem addr to 1000
	LI. D776,P.00		; Back to status reg
	DI. 0,71		; Issue read
	EI. D776,P.00		; Now read to check for errors in xfer
	WAIT 200		; Check for ready bit true..
	EI. D776,P.12		; Check drive status reg itself
	ERRTST	40000		; Test "ERR" bit

; If it was ok, then check the controller for errors

	EI. D776,P.00		; Examine controller
	ERRTST 060000		; Drive rdy, now see if encountered errors
	ENDLST			; End of channel command list


; Drive controller register is 776440..following commands apply
; 	7=Rewind
; 	11=Drive clear
; 	25=Erase
; 	27=Write tape mark
; 	31=Space forward(skip a file)
; 	33=Space reverse(skip a file, moving tape in reverse)
; 	51=Write check forward
; 	57=Write check reverse
; 	61=Write forward
; 	71=Read forward(go!)
; 	77=Read reverse(go!)

MTASEQ:	UBA. 763,001		; Address of UBA paging ram
	DI. 40,001		; Set valid in page 1
	LI. D772,P.10		; Set address of drive control register
	DI. 0,40		; Issue controller and slave clr
	DI.INDIRECT TAPEUNIT	; Set tape unit #
	LI. D772,P.32		; Slave select/format/density reg
	DI.INDIRECT DEN.SLV	; Set slave,format,dens(temp:dens=1600,f=0,s=0)
	EI. D772,P.12		; Read the drive status, to make sure it exists
	TWAIT 400		; Check the "DRIVE PRESENT" bit
	WAIT 200		; If was present, wait for it to be ready
	LI. D772,P.06		; Frame count register
	DI. 0,0			; Frame count to 0 is max numb of frames
	LI. D772,P.00		; Set address to RH11 control register
	DI. 0,7			; Issue "REWIND" to tape
	EI. D772,P.12		; Read the drive status to check for ready
	WAIT 200		; Wait for rewind to complete
QTXFR:	LI. D772,P.04		; Controller to memory destination reg
	DI. 4,000		; Set KS10 start address to 1000
	LI. D772,P.02		; Set address to word count register
	DI. 176,000		; 1 Page of 512 words is 1024 18-bit bytes
	LI. D772,P.06		; Frame count register
	DI. 0,0			; Frame count to 0 is max number of frames
	LI. D772,P.00		; Set address to RH11 control register
	DI.INDIRECT SKP.GO	; Issue "XFER CMD" (31=SKIP .or. 71=RD-IN)
	EI. D772,P.12		; Read the drive status to check for ready
	WAIT 200		; Wait for file read to complete
	EI. D772,P.14		; Look at the drive error register
RETRY.:	ERRTST 070300		; Errors worth retrying??
FRMERR:	ERRTST 103400		; See if this was a correctable type error
	EI. D772,P.12		; Read the drive status to check for errors
	ERRTST 40000		; Get any drive errors?
	LI. D772,P.00		; Now address to controller status
	ERRTST 60000		; Check for errors there.
	ENDLST			; End of channel command list

; Quick little routine to reset the magtape after it suffers an
; ignorable error.

MTARST:	LI. D772,P.10		; Set address of drive control register
	DI. 0,40		; Issue controller and slave clr
	DI.INDIRECT TAPEUNIT	; Fix unit number
	LI. D772,P.04		; Controller to memory destination reg
	DI. 4,000		; Set KS10 start address to 1000
	LI. D772,P.06		; Frame count register
	DI. 0,0			; Frame count to 0 is max numb of frames
	ENDLST			; Quick out

.IIF NDF,NOROOM INIER:	.ASCIZ /?BUS\/	; Bus polluted on power up
BV:	.ASCIZ	/?BFO/		; Input buffer overflow
CMDNG:	.ASCII	/?IL/		; Illegal instruction
	.BYTE	^O15,^O12,0	; CR-LF
TTM:	.ASCIZ	/?UI\/		; Unknown interrrupt
EBHED:	.ASCIZ	/BUS 0-35\/	; Message header for "EB" cmd
KSPRMT:	.ASCII	/KS10>/		; Prompt message
	.BYTE	^O377,0
MSG10:	.ASCIZ	% CYC\SENT/%	; Cycle type for "DB" command
DRCVD:	.ASCIZ	%\RCVD/%	; Data received on bus (DB cmd)
ECVER:	.ASCIZ	%?A/B\%		; A & B copies of CRAM bits did not match
PCMSG:	.ASCIZ	%PC/%		; Obvious
HLTMS:	.ASCIZ	.%HLTD/.	; Message "HALTED/XXXXXX" where XXXXXX is data
BTFAIL:	.ASCIZ	/?BT /		; Device error or timeout during boot operation
BTMSG1:	.ASCIZ	/BT SW/		; Message says booting, using BOOT SW
OFFMSG:	.ASCIZ	/OFF\/		; Message says signal is "OFF"
PARMSG:	.ASCIZ	/?PAR ERR /	; Report clock freeze due to PAR ERR
MOSMSG:	.ASCIZ	/?MRE\/		; Memory refresh error
ERRMSG:	.ASCIZ	/?BC /		; Ta-da....boot check
RN.:	.ASCIZ	/?RUNNING\/	; Trying to do a cmd that may screw up
NOA:	.ASCIZ	/?NDA\/		; Received no data acknowledge on mem request
NXMMSG:	.ASCIZ	/?NXM\/		; Referrenced non existant memory location
NBR:	.ASCIZ	/?NBR\/		; Console was not granted bus on a request
RAG:	.ASCIZ	/?RA/		; Cmd requires arguement.. must type something
BB1:	.ASCIZ	/?BN/		; Typed a bad number(i.e 9 or x or # etc.)
Q.UBA:	.ASCIZ	/>>UBA?/	; Query for UNIBUS adapter
Q.RH:	.ASCIZ	/>>RHBASE?/	; Query for RH11 to use
Q.UNIT:	.ASCIZ	/>>UNIT?/	; Query for unit to use
Q.TCU:	.ASCIZ	/>>TCU?/	; Query for tape control unit
Q.DEN:	.ASCIZ	/>>DEN?/	; Query for tape density
Q.SLV:	.ASCIZ	/>>SLV?/	; Query for tape slave
KAMSG:	.ASCIZ	/?KA\/		; Keep alive failed
FRCMSG:	.ASCIZ	/?FRC\/		; Had a forced reload
PWLEN:	.ASCIZ	/?PWL/		; Password length error
NOACCS:	.ASCII	/?NA/		; Not available (KLINIK line that is)
	.BYTE	^O15,^O12,0	; CR-LF
QPW:	.ASCII	/PW:/		; Ask for a password message
	.BYTE	^O15,^O12,0
POKMSG:	.ASCII	/OK/		; OK the PW is valid
	.BYTE	^O15,^O12,0
AUTOMS:	.ASCIZ	/BT AUTO/	; Beginning auto boot sequence

; Note that all these locations are RAM locations and may be used
; with the assembly of separate modules of console code....

ZEROB:	.BLKB	2		; (5.2) Zero byte to end prior ASCIZ msg
C80AD:	.BLKB	2
ER.LOC:	.BLKB	3		; Place to execute 8080 "in's" and "out's"

; Current Klinik state switch:	Enable  = 2
;				Protect = 6
;				Disable = 4


APASS:	.BLKB	2		; (5.2D) Address of pointer in password
PWNOK:	.BLKB	1		; (5.2D) Flag indicating validity of pw entered

;KPWPNT:.BLKB	2		; (5.2D) Replaced by APASS, PWNOK, 
;KPWCNT:.BLKB	1		; (5.2D)   PNUM

RM100:	.BLKB	8
CMD..:	.BLKB	2
.ARG1:	.BLKB	2
; Restart indicator - 1 - KA failed to change
;		      2 - Forced reload
; 		      3 - Power fail
; 		      4 - Boot button pushed


; No automatic reload flag (set by operator if desired)


PASSWORD: .BLKB 7		; Current password set

PNUM:	.BLKB	1		; (5.2D) number of PW characters entered so far

; Flags to indicate that EXINT should set RUN also then executing the
; JRST 1000 to reboot the system after a forced reload.  And that the
; CO cmd that gets executed after that should not set CONTINUE.

HSBFL1:	.BLKB	1		; (5.2E) HSB flag 1
HSBFL2:	.BLKB	1		; (5.2E) HSB flag 2

; Flag to ensure ?NXM does not print on power up - what really happens
; there is that internal mode is set so as to not print it - then if a
; control-\ is typed the 8080 gets out of internal mode to handle this
; character and then when is returns from the interrupt internal mode
; is now off and the error message prints.

NXMFLG:	.BLKB	1		; (5.2C) Nxm print flag

T80DT:	.BLKB	2		; (5.2) Location moved to provide space at top

;KPWBUF:.BLKB	6		; (5.2D) Password typed in

PWRTRY:	.BLKB	1		; Password retry count
KLLINE.ON: .BLKB 1		; State of KL flag (On/Off)
.IIF DF,SCECOD,SCEADR:	.BLKB	2	; Last failing address
E.BEG:	.BLKB	^O140
ENVBUF:	.BLKB	70		; EB is longest command with 67. chars
SYSEND:	.BLKB	1		; And empty byte to hold end of list
SC.OFF:	.BLKB	1		; Recovery on or off flag
RHSAVE:	.BLKB	40.		; Buffer for saving RH stuff
	.END			; End statement