PDP-10.its/src/kshack/subrtn.m80

.SBTTL ****KS10 CONSOLE SUBROUTINE FILE
;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

.IF	DF,SCECOD
	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 BITS RETURNED IN ACCUM
	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 COMPLIMENT
	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 .EQ. 0, THEN ALL OK
	JZ	SOFTERR	;IF NOTHING, GO TRY FOR THE SOFT ERROR RECOVERY
;GET TO HERE IF ERROR IS CONSIDERED NON-RECOVERABLE
NR:	PLINE	NRSCE		;"?NR-SCE". NON RECOVERABLE-SOFT CRAM ERROR
.ENDC


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
.IF	DF,SCECOD
;COMMAND LIST FOR READING UBA INFO
UBA.RD:	UBA. 763,001
	ENDLST

;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 & 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 THE SPOT WE ARE IN IN THE RHSAVE AREA
	CALL	CHNXCT		;DO IT..ONE 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
	JMP	NULLJ		;GO
.ENDC
;ROUTINE TO CHECK IF CURRENT RAM ADDRESS IS THE DESIRED BREA
;ADDRESS..
BREAK:	PUSH	D	;"D,E" HAS POINTER TO DESIRED ADDR, SAVE IT PLEASE
	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 THE 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 REPLACE 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
P8BIT1:	PUSH	B
	PUSH	D
	PUSH	PSW
	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
	POP	D
	POP	B
	POP	H
	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
	PUSH	B
	PUSH	D
	PUSH	H

	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	;DONE..NOW RESTORE ALL REGS
	POP	D
	POP	B
	POP	PSW
	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
	PUSH	B
	PUSH	D
	PUSH	H
	CALL	OCTAL	;CREATE 36-BIT BUFFER AS AN OCTAL CHARACTER STRING
	.BYTE	5	;5BYTES 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
	PCHAR	COMMA	;PRINT ",,"
P36RH:	CALL	PHALF	;PRINT 18 MORE BITS...
	POP	H	;NOW RESTORE ALL THE REGS
	POP	D
	POP	B
	POP	PSW
	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
	PUSH	B
	PUSH	D
	PUSH	H
	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
;COVERSION DESIRED WITH 2 TRAILING PARAMETERS-CHARS PLACED ON STACK, MSB-LSB
;	CALL	ROUTINE
;	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
	JNZ	OCTL3
;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
;	CALL	SHR36
;	.BYTE	XX	;NUM PLACES TO SHIFT

SHR36:	MVI	A,5	;A SHIFT 36 REQUIRES 5 BYTES TO BE MOVED
SHR24:
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	SP
	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
	DCX	SP
	PUSH	D
	PUSH	H

	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"
	RET
;ROUTINE TO ASSEMBLE 16-BIT ARGUMENT
;PLACE TO PUT 16-BIT DATA PASSED AS A TRAILING
;ARG... "B,C" IS MESSED UP BY THIS ROUTINE

;	CALL	ARG16
ARG96:	MVI	A,12.	;NUMB BYTES USED IN ARG96 IS 12
	JMP	ARGBG1

.ARG36:	MVI	A,5	;NUMB BYTES USED IN ARG36 IS 5
	JMP	ARGBEG

.ARG16:	MVI	A,2	;NUMB BYTES USED IN ARG16 IS 2
ARGBEG:	POP	H	;GET H,L FROM TRAP HANDLER
ARGBG1:	STA	CHRCNT	;SAVE IT
	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
	MOV	D,H
	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
	INX	D

	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

;DONT 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 8-TIMES..NOW 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 CAN..NOW 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

DLIST:	.ADDR	.MOV5B	;+0
	.ADDR	.CRLF	;+2
	.ADDR	.ARG16	;+4
	.ADDR	.RUN..	;+6
	.ADDR	.ARG36	;+8.
	.ADDR	.CLRRM	;+10.
.SBTTL **** CLRB EXECUTE CODE ****
CLRBYT:	MVI	H,^O40	;THIS HALF GENERATES THE "20000'S" WEIGHT OF ADDRESS
	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

.SBTTL **** SOME ERROR CODES ****
RRARG:	PLINE	RAG	;"?REQUIRES ARG"
	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 MICRO-CODE AFTER A BOOT

C.BTERR: ADI	1*2	;FAILURE DURING THE READING OF THE MICRO-CODE

B.BTERR: ADI	1*2	;FAILURE DURING THE 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 THE HI ORDER BYTE OF THE NUMB
	CLRB	NOPNT	;RESTORE PRINTING
	PLINE	BTFAIL	;PRINT MESSAGE "?BT "
	LXI	H,ERRCD	;POINT TO THE ERROR CODE
	CALL	P16	;PRINT THE 16-BIT NUMBER
	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 DONT CHANGE STATE
	ORA	M	;THROW CURRENT STATE WITH FAULT BIT
	MOV	M,A	;PUT STUFF BACK
	MVI	A,8*2	;FAILURE DURING THE LOADING OF THE 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 DONT MASH ANYTHING
	XRA	A	;CLEAR ACCUM
	CMA		;ACCUM = -1
RNCOM:	STA	RNFLG	;DATA TO RUN FLAG
	RET		;AND OUT

CLRRN:	MVI	B,0	;WE DONT 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	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

;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 ARG. 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 DIFFER, 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 2 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"
	INX	H
	MOV	B,M	;HI ORDER SOURCE TO "B"
	INX	H

TARG1:	MOV	E,M	;LO ORDER SOURCE TO "E"
	INX	H
	MOV	D,M	;HI ORDER SOURCE TO "D"
	INX	H

	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:
;	CALL RDATT
;	DW XXX	;XXX IS PLACE TO MOVE THE 36 BITS OF DATA
;ACCUMULATOR IS DESTROYED, REG PAIR "D,E" IS INCREMENTED BY 5.
RDATT:
	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"
RDATP:
	PUSH	D	;SAVE "D,E"
	IN	D2835	;***** I/O RD "0" (BITS 28-35) *****
	CMA
	STAX	D	;SAVE IN RAM
	INX	D	;UP PNTR TO NEXT BYTE
	IN	D2027	;***** I/O RD "1" (BITS 20-27) *****
	CMA
	STAX	D	;SAVE IN RAM
	INX	D	;UP PNTR TO NEXT BYTE
	IN	D1219	;*****I/O RD "2" (BITS 12-19) *****
	CMA
	STAX	D	;SAVE IN RAM
	INX	D	;UP PNTR
	IN	D0411	;***** I/O RD "3" (BITS 4-11) *****
	CMA
	STAX	D	;SAVE
	INX	D	;UP PNTR
	IN	D0003	;***** I/O RD "103" (BITS 0-03) *****
	CMA
	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 ADDR
;EITHER PASSED AS A TRAILING PARAMETER, OR PASSED IN "D,E"
;CALL IS:
;	CALL WDATT
;	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 ADDR
;EITHER PASSED AS A TRAILING PARAMETER, OR PASSED IN "D,E"
;CALL IS:
;	CALL ADATT
;	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 NEXT 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

.SBTTL	SUBROUTINE TIME DELAY
;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
;ARGUEMENT, 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
.SBTTL	STRING COMPARE ROUTINE
;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.
	JMP	STRCMP	;LOOP

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
.SBTTL	UART MODE MODIFICATIONS
;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:	MVI	B,0	;THE PASS LIGHTS OFF IN REGISTER "B"
	CALL	KL.LAMP	;AND GO DO THE LIGHTS
	CALL	HANGUP	;CLEAR KLINIK LINE
	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 WONT DO "MODE4"
	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
	SHLD	E.BUF
	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 ANYTHING ELSE, SEE WHAT WE ARE DOING NOW
	ANI	.MODE0!.MODE1	;IF MODES 0 OR 1, MUST INTERRUPT KS10
	JZ	SETM2X	;IF NOT, DONT BOTHER KS10 AT ALL

	MVI	A,KL.ACTIVE ;MUST INFORM THE TEN THAT 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 MOE TWO TO THE STATE FLAG ALSO
SETM:	STA	CSLMODE
SETDIS:	SHLD	MODDIS	;AND SET TO KLINIK DISPATCHER
	RET		;AND ALL DONE
;LITTLE ROUTINE TO HANG UP THE KLINIK LINE
HANGUP:	LDA	STATE	;GET CURRENT STATE
	ANI	^O7	;OFF THE "DTR" SIGNAL
	OUT	DTR	;CLR DTR
	MVI	A,CARRLOSS ;TELL KS10 THAT KLINIK CARRIER HAS GONE AWAY
	CALL	WRD34	;DEPOSIT INTO WORD 34
	LXI	H,200. * 2 ;SET A TIMEING 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 IS .EQ. 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 SOMETHING HERE IF THE MAILING FLAG SET
	ANA	A	;SET 8080 FLAGS
	RZ		;NO FLAG, NO SENDY....

	EI		;ABSOLUTLY MUST ALLOW INTERRUPTS, IN CASE HOST DIES
	LDA	ENVMNO	;FIRST THING TO DO IS COMPLIMENT THE MESSAGE NUMBER
	CMA		;FLIP
	ANI	^O177	;NO SIGN BITS ALLOWED
	STA	ENVMNO	;PUT IT BACK

	LXI	H,ENVBUF ;FIRST THING TO DO IS COMPUTE CHECKSUM FOR THE 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		;COMPLIMENT
	INR	A	;MAKE TWOS COMPLIMENT
	ANI	^O77	;AND ONLY SIX BITS COUNT

;NOW MUST DECIDE IF YOU NEED TO ASCII-IZE THE CHECKSUM
	CPI	^O75	;75,76,77 DONT 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
	KCHAR	SYNC

	LXI	D,ENVMNO ;NOW SEND THE REST 
	CALL	KLINE1
	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 THE 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
DECEX1:
DECEX2:
	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
.SBTTL	MODE 4 FOR DECIDING TO COLLECT AN ENVELOPE OR CTY 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
MODE4:
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)
M4.1:
	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 THE ENVELOPE COLLECTOR
	SHLD	MODDIS	;SET UP FOR INTERRUPT HANDLER TO FIND
.SBTTL	ENVELOPE COLLECTOR
;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 WE JUST
	DCR	C	;  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 NOT .EQ. 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 COMMAND ENVELOPE EXECUTED RESETS THE ENV NUMBER
	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

ACK:	KLINE	M.ACK
	RET		;DONE WITH THIS
M.ACK:	.BYTE	SYNC	;SYNC
	.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
NACK:	KLINE	M.NACK
	RET		;BACK TO CALLER

M.NACK:	.BYTE	SYNC	;SYNC
	.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, DONT 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 POINTER 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 LINE FEED, 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
DONE.BUF:
Z.TBUF: LXI	H,0	;WE NEED TO CLEAR SOME BUFFERS
	SHLD	SYSIN	;CLEAR POINTER
SETOUT:	SHLD	SYSOUT	; AND CLEAR POINTER
	RET
.SBTTL **** MORE ERROR ESCAPES ****
NOACK:	PLINE	NOA	;"PRINT NO DATA ACK"

	LXI	H,1	;ERR CODE IS 1
ERRRTN:	SHLD	ERRCD	;SET ERROR CODE
	ENDCMD

NOARB:	XRA	A	;CLR ACCUM
	OUT	BUSCTL	;***** I/O WRT 210/0 *****
	PLINE	NBR	;"?NO BUS RESP"

	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 OUT NIXOM BIT AFTER THE REPORT
	PLINE	NXMMSG	;"PRINT ?NXM"
	LXI	H,3	;ERROR CODE 3

	JMP	ERRRTN	;SET ERROR CODE