;*******************************************************************
;
;	MNEMONIC - A MULTI-PASS MEMORY TESTER FOR CP/M
;
;		COPYRIGHT 1978, BY
;		WILLIAM T. PRECHT & ASSOCIATES
;		1102 S. EDSON
;		LOMBARD, IL  60148
;
;********************************************************************
;MODIFIED 1/11/81 BY CHARLES H. STROM FOR OPERATION WITH MEMORY-
;MAPPED CONSOLE I/O AND WITHOUT A FRONT PANEL. SEE CONDITIONAL
;SWITCHES BELOW.
;********************************************************************
;
	ORG	100H	; ORG FOR CP/M TPA
;
; USER MODIFIABLE EQUATES FOLLOW
;
MEMMAP	EQU	0	;TRUE FOR MEMORY-MAPPED CONSOLE
PANEL	EQU	1	;TRUE FOR FRONT PANEL
;
EXITA	EQU	0F800H	; COLD BOOT ADDR
CONSD	EQU	04H	; CONSOLE DATA PORT OR MEMORY LOCATION
CONST	EQU	05H	; CONSOLE STATUS PORT OR MEMORY LOCATION
CONSI	EQU	02H	; READY BIT FOR KYBD (ACTIVE HIGH)
CONSO	EQU	01H	; READY BIT FOR CONSOLE OUTPUT (ACTIVE HIGH)
SSWD	EQU	20H	; SENSE SW 5 = DETAIL ERROR LIST
SSWS	EQU	10H	; S.S. 4 = DO SLOW TEST
;
;END OF USER MODIFIABLE EQUATES
;
STAK	EQU	1000H	; STACK ADDR - PRESERVE THIS
STAKH	EQU	10H	; STACK H/O ADDR - USED TO COMPARE TO PARMS
;
;*******************************************************************
;
	JMP	START	; BYPASS JUMP TABLE
;
EXIT	JMP	EXITA	; EXIT JUMP - GO TO COLD BOOT ADDR
KEYIN	JMP	ZKEYIN	; CUSTOM CONSOLE INPUT
KSTAT	JMP	ZKSTAT	;   "       "    READY TEST
TYPE	JMP	ZTYPE	;   "       "    OUTPUT
;
;********************************************************************
;
;		CONSOLE KEYBOARD INPUT ROUTINE
;
;********************************************************************
;
ZKEYIN	EQU	$
	CALL	KSTAT	; TEST CHAR READY
	JNC	KEYIN	;  NOT READY, LOOP
	IF	MEMMAP
	LDA	CONSD
	ENDIF
	IF	NOT MEMMAP
	IN	CONSD	; READ CONSOLE DATA
	ENDIF
	ANI	7FH	; STRIP PARITY
	CALL	TYPE	; ECHO IT TO TERMINAL
	IF	NOT PANEL
	CPI	'S'	;S FOR SLOW/FAST TOGGLE
	JNZ	XCOMP
	LDA	SLOWTOGL
	XRI	1
	STA	SLOWTOGL
	RET
XCOMP	CPI	'X'	;X FOR DETAILED/NORMAL LIST TOGGLE
	RNZ
	LDA	XAMTOGL
	XRI	1
	STA	XAMTOGL
	RET
	ENDIF
	RET
;
ZKSTAT	EQU	$
	IF	MEMMAP
	LDA	CONST
	ENDIF
	IF	NOT MEMMAP
	IN	CONST	; READ CONSOLE STATUS PORT
	ENDIF
	ANI	CONSI	;  TEST INPUT READY BIT
	RZ		;  NOPE, RET
	STC		;  YUP, SET CARRY
	RET
;
;********************************************************************
;
;		CONSOLE OUTPUT ROUTINE
;
;********************************************************************
;
ZTYPE	EQU	$
	CALL	TYPEC	; TYPE CHAR
	CPI	0DH	; Q. CARR RTN?
	RNZ		;  NO, RETURN
	MVI	A,0AH	; GET LINE FEED
	CALL	TYPEC	;  SEND IT
	RET
;
TYPEC	EQU	$
	PUSH	PSW	; SAVE CHAR 2B TYPED
TYPEL	IF	MEMMAP
	LDA	CONST
	ENDIF
	IF	NOT MEMMAP
	IN	CONST	; READ CONSOLE STATUS
	ENDIF
	ANI	CONSO	; TEST OUTPUT READY BIT
	JZ	TYPEL	;  NOPE, LOOP
	POP	PSW	;  ELSE, GET CHAR
	IF	MEMMAP
	STA	CONSD
	ENDIF
	IF	NOT MEMMAP
	OUT	CONSD	;  TYPE IT
	ENDIF
	RET
;
;
;*******************************************************************
;
;		START - PROGRAM BEGINS; DO INIT
;
;*******************************************************************
;
START	EQU	$
	LXI	SP,STAK	; GET STACK ADDR
	CALL	PMSG1	; TYPE VERSION MSG
	JMP	SPARM	; BYPASS CONTINUOUS TEST 1ST TIME
;
;*******************************************************************
;
;		MAIN PROGRAM LOOP
;
;********************************************************************
;
LOOP	EQU	$
	CALL	KSTAT	; TEST CONSOLE READY
	JNC	CONTIN	;  NO, LOOP TILL INTERRUPTED
	IF	MEMMAP
	LDA	CONSD
	ENDIF
	IF	NOT MEMMAP
	IN	CONSD	;  CLEAR INTERRUPTING DATA
	ENDIF
SPARM	EQU	$
	CALL	GPARM	; GET ADDRS TO TEST
	JC	SPARM	;  LET'S TRY GETTING THOSE PARMS AGAIN
	CALL	QUICK	; DO QUICK TEST FOR MEM PRESENT
CONTIN	EQU	$
	CALL	RANDS	; SAVE RANDOM SEED
	CALL	GPATT	; GEN RANDOM PATTERNS IN EACH LOC
	CALL	KSTAT	; TEST KYBD READY
	JC	LOOPP	;  YES, PRINT MATRIX AND EXIT
	CALL	RANDR	; RESET RAND TO SEED
	CALL	TPATT	; TEST PATTERNS
	CALL	KSTAT	; TEST KYBD READY
	JC	LOOPP	;  YES, PRINT MATRIX AND EXIT
	CALL	SLOW	; DO SUPER-SLOW MEM TEST
	CALL	KSTAT	; TEST KYBD READY
	JC	LOOPP	;  YES, PRINT MATRIX AND EXIT
	LHLD	PASSC	; GET 16-BIT PASS COUNTER
	INX	H	;  PLUS 1
	SHLD	PASSC	;   AND STORE IT BACK
	CALL	PRTPASS	; PRINT PASS COUNT
	JMP	LOOPX	;  ELSE, GO TO LOOP EXIT
;
LOOPP	EQU	$
	CALL	PRMAT	; PRINT ERROR MATRIX
;
LOOPX	EQU	$
	JMP	LOOP	; LOOP TILL INTERRUPTED
;
;
;********************************************************************
;
;		GPARM - GET ADDRESS PARAMETERS
;
;********************************************************************
;
GPARM	EQU	$
	CALL	INIT	; INIT ERROR MATRIX
	CALL	GTSTA	; GET START ADDR
	RC		;  CARRY=ERROR, SO RETURN
	CALL	GTEND	; GET END ADDR
	RC		;  CARRY, PROBLEM
	RET
;
;********************************************************************
;
;		GPATT - GET RANDOM PATTERN TO ADDRESS SPACE
;
;********************************************************************
;
GPATT	EQU	$
	LHLD	AEND	; GET END ADDR TO H-L
	XCHG		;  SWAP IT TO D-E
	LHLD	ASTRT	; GET STARTING ADDR TO H-L
GPAT2	EQU	$
	CALL	KSTAT	; TEST KYBD READY
	RC		;  YUP, EXIT
	CALL	RANDB	; GET RANDOM BYTE
	CALL	STNDX	; STORE CHAR, BUMP INDEX
	JC	GPAT2	;  LT MAX, LOOP
	RET
;
;********************************************************************
;
;		TPATT - TEST RANDOM PATTERN PREVIOUSLY GENERATED
;
;********************************************************************
;
TPATT	EQU	$
	LHLD	AEND	; GET END ADDR TO H-L
	XCHG		;  SWAP IT TO D-E
	LHLD	ASTRT	; GET STARTING ADDR
TPAT2	EQU	$
	CALL	RANDB	; GET RANDOM BYTE
	MOV	B,M	; GET CHAR FROM MEM TO B
	CMP	B	; TEST EXPECTED TO ACTUAL
	JZ	TPAT3	;  EQ, ON
	CALL	TYPEA	; RECORD ADDR AND FAILURE
	CALL	STMAT	;  AND STORE IN ERROR MATRIX
;
TPAT3	EQU	$
	CALL	KSTAT	; TEST KYBD STATUS
	RC		;  YES, EARLY EXIT
	CALL	INDEX	; BUMP MEM PTR
	JC	TPAT2	;  LT MAX, LOOP
	RET
;
;********************************************************************
;
;		STNDX - STORE BYTE IN MEMORY, BUMP INDEX
;
;********************************************************************
;
STNDX	EQU	$
	MOV	M,A	; STORE CHAR IN MEM
	JMP	INDEX	;  BUMP MEM PTR AND EXIT
;
;********************************************************************
;
;		INDEX - BUMP H-L, COMPARE TO D-E (ENDING ADDR)
;
;********************************************************************
;
INDEX	EQU	$
	MOV	A,H	; GET H/O OF CURR ADDR
	CMP	D	; TEST TO H/O OF END
	JC	INXIT	;  LT, ONWARD
	JNZ	INXIT	;  NOT ZERO, END
	MOV	A,L	; TEST L/O
	CMP	E	;  TO L/O OF END
	JC	INXIT	;  LT, ON
;
;		H-L = D-E
;			RESET ZERO AND CARRY FLAGS
;
	MVI	A,0	; GET ZERO
	DCR	A	; RESET ZERO FLAG
	ORA	A	;  AND CARRY
	RET
;
INXIT	EQU	$
	INX	H	; BUMP MEM PTR
	RET
;
;********************************************************************
;
;		STMAT - STORE BIT DIFFERENCES IN ERROR MATRIX
;
;********************************************************************
;
STMAT	EQU	$
	PUSH	PSW	; SAVE CHAR
	PUSH	H	; SAVE H-L
	PUSH	D	;  AND
	PUSH	B	;   REST
	MOV	B,A	; MOVE BYTE READ TO B
	MOV	C,M	; MOVE BYTE WRITTEN TO C
	MOV	A,H	; GET H/O ERROR ADDR
	PUSH	PSW	; SAVE H/O
	LHLD	ASTRT	; STARTING TEST ADDR
	MOV	A,H	; GET H/O TO ACC
	ANI	0FCH	; STRIP L/O 2 BITS
	MOV	H,A	; REPLACE H/O
	POP	PSW	; RESTORE H/O ERR ADDR
	SUB	H	; 256-BYTE DIFF
	ANI	0FCH	; CLEAR L/O 2 BITS
	MVI	H,0	; SETUP H-L
	MOV	L,A	;  TO FORM
	DAD	H	;   K INDEX TO MATRIX
	DAD	H	;    AGAIN
	LXI	D,MATRX	; MATRIX START
	DAD	D	; FORM K INDEX
	SHLD	MINDX	; STORE MATRIX INDEX
	LHLD	ERRCT	; GET ERROR COUNT
	INX	H	;  PLUS 1
	SHLD	ERRCT	;   AND STORE IT BACK
	LXI	D,8	; BIT COUNT TO D
STMA2	EQU	$
	MOV	A,B	; GET BYTE READ
	RRC		; SHIFT L/O INTO CARRY
	MOV	B,A	; RETURN BYTE READ
	MOV	A,C	; GET BYTE WRITTEN
	JC	STMC1	; BIT WAS SET IN READ - SEE IF WRITTEN
	RRC		; SHIFT BYTE WRITTEN L/O BIT INTO CARRY
	MOV	C,A	; RETURN BYTE WRITTEN
	JNC	STMCO	;  NOT CARRY, BIT MATCHES
	JMP	STMBT	;  CARRY, FLAG ERR
STMC1	EQU	$
	RRC		; SHIFT WRITTEN BIT INTO CARRY
	MOV	C,A	; RETURN BYTE WRITTEN
	JC	STMCO	;  CARRY, BIT MATCHES
STMBT	EQU	$
	PUSH	D	; SAVE ERR CTR
	MVI	H,0	; SETUP
	MOV	L,E	;  H-L
	DCR	L	; TAKE BIT COUNT - 1
	DAD	H	;  * 2
	XCHG		; SWAP TO D-E
	LHLD	MINDX	; MATRIX K INDEX
	DAD	D	;  DISPLACE BIT LOC
	MOV	E,M	; GET L/O OF ERROR CTR
	INX	H	; BUMP PTR
	MOV	D,M	; GET H/O 
	INX	D	; INCR DBL CTR
	MOV	M,D	; REPLACE H/O
	DCX	H	; DECR MEM PTR
	MOV	M,E	; REPLACE L/O
	POP	D	; RESTORE D-E
;
STMCO	EQU	$
	DCR	E	; MINUS BIT COUNTER
	JNZ	STMA2	;  LOOP TILL ALL BITS TESTED
	POP	B	; RESTORE
	POP	D	;  ALL
	POP	H	;   REGS
	POP	PSW	;    AND CHAR
	RET
;
;********************************************************************
;
;		PMSG1 - TYPE VERSION MESSAGE AND INSTRUCTIONS
;
;********************************************************************
;
PMSG1	EQU	$
	LXI	H,MSG1	; GET VERSION MESSAGE
	CALL	LINE	; TYPE LINE
	RET
;
MSG1	DB	0DH
	DB	'WTP&A MNEMONIC  - VERSION 2.1',0DH
	DB	0DH
	DB	'ANY MEMORY FROM 1000H TO FFFFH CAN BE TESTED.',0DH
	DB	'TEST WILL RUN CONTINUOUSLY '
	DB	'UNTIL A KEY IS STRUCK.',0DH
IF PANEL
	DB	'TURN ON S.S. 5 TO GET DETAILED ERROR LIST;',0DH
	DB	' S.S. 4 TO DO SUPER-SLOW TEST.',0DH
ENDIF
IF NOT PANEL
	DB	'AT "START ADDRESS" PROMPT ENTER;',0DH
	DB	'S - To toggle test SPEED normal/super slow;',0DH
	DB      'X - To toggle normal/detailed EXAMINATION of errors'
ENDIF
	DB	0DH,0DH
	DB	'WHEN A KEY IS STRUCK, ALL CUMULATIVE ERRORS',0DH
	DB	' WILL BE SUMMARIZED BY BIT POSITION',0DH
	DB	' WITHIN 1K BOUNDARIES.',0DH
	DB	0DH
	DB	'(ALL INPUTS AND OUTPUTS ARE IN HEX.)',0DH
	DB	0DH
	DB	00
;
;********************************************************************
;
;		PMSGS - PRINT STARTING ADDR REQ MSG
;
;********************************************************************
;
PMSGS	EQU	$
	LXI	H,MSGS	; GET START ADDR REQ MSG
	CALL	LINE	; TYPE LINE
	RET
;
MSGS	DB	'START ADDR (HEX) ?',0DH,00
;
;********************************************************************
;
;		PMSGE - TYPE ENDING ADDR REQ MSG
;
;********************************************************************
;
PMSGE	EQU	$
	LXI	H,MSGE	; GET ENDING ADDR REQ MSG
	CALL	LINE	; TYPE LINE
	RET
;
MSGE	DB	'END ADDR (HEX) ?',0DH,00
;
;********************************************************************
;
;		LINE - TYPE A LINE TERMINATED BY X'00'
;
;********************************************************************
;
LINE	EQU	$
	MOV	A,M	; GET CHAR FROM MSG
	CPI	00	; Q. MSG END?
	JZ	LINEX	;  YUP, WRAP UP
	CALL	TYPE	;  ELSE, TYPE CHAR
	INX	H	; BUMP PTR
	JMP	LINE	;   LOOP TILL MSG END
;
LINEX	EQU	$
	RET
;
;********************************************************************
;
;		GTSTA - GET MEMORY STARTING ADDRESS
;
;********************************************************************
;
GTSTA	EQU	$
	CALL	PMSGS	; SEND STARTING REQ MSG
	CALL	RDADR	; READ ADDR FROM CONSOLE
	JC	GTSTA	;  CARRY=ERROR, SO REPROMPT
	CALL	PACKA	; PACK ADDR INTO ADDRH
	LHLD	ADDRH	; GET PACKED ADDR
	SHLD	ASTRT	;  SAVE IT IN STARTING ADDR
	MOV	A,H	; GET H/O OF START ADDR
	CPI	STAKH	; TEST TO STACK ADDR
	RET
;
;********************************************************************
;
;		GTEND - GET ENDING ADDRESS
;
;********************************************************************
;
GTEND	EQU	$
	CALL	PMSGE	; SEND ENDING REQ MSG
	CALL	RDADR	; READ ADDR FROM CONSOLE
	JC	GTEND	;  CARRY=ERROR, SO REPROMPT
	CALL	PACKA	; PACK ADDR INTO ADDRH
	LHLD	ADDRH	; GET PACKED ADDR
	SHLD	AEND	;  SAVE IT IN ENDING ADDR
	XCHG		; SWAP TO D-E
	LHLD	ASTRT	; GET STARTING ADDR TO H-L
	MOV	A,D	; GET H/O OF ENDING ADDR
	CMP	H	; TEST TO H/O OF START
	RC		;  LT, ERROR
	RNZ		;  NOT ZERO, GO ON
	MOV	A,E	; GET L/O OF END
	CMP	L	; TEST TO L/O OF START
	RC		;  LT, ERROR
	ORA	A	; CLEAR CARRY
	RET
;
;********************************************************************
;
;		RDADR - READ 4-BYTE ADDRESS FROM CONSOLE,
;			CONVERT IT TO HEX AND STORE IT.
;
;********************************************************************
;
RDADR	EQU	$
	LXI	H,NRAND	; RANDOMLY CREATE NRAND
	LXI	D,ADDRA	; ADDR TO FILL
	MVI	B,4	; CHAR COUNT
;
RDSTA	EQU	$
	CALL	KSTAT	; TEST KYBD STATUS
	JC	RDBYT	;  CARRY= CHAR READY
	INR	M	;  ELSE, ADD TO NRAND DIGIT
	JMP	RDSTA	;  LOOP TILL CHAR
;
RDBYT	EQU	$
	CALL	KEYIN	; READ CHAR
	CALL	TESTK	; TEST VALIDITY
	JC	RDERR	;  NG, RESTART
	STAX	D	;  OK, STORE CHAR
	INX	D	; BUMP ADDRA PTR
	INX	H	;  AND NRAND PTR
	DCR	B	; MINUS LTH COUNTER
	JNZ	RDSTA	;  LOOP TILL DONE
	MVI	A,0DH	; CARR RTN
	CALL	TYPE	;  TYPE IT
	RET
;
RDERR	EQU	$
	PUSH	H	; SAVE H-L (NRAND DIGIT)
	LXI	H,MSGKE	; GET ERR MSG ADDR
	CALL	LINE	; TYPE LINE
	POP	H	; RESTORE H-L
	STC		; SHOW ERROR
	RET
;
MSGKE	DB	0DH
IF PANEL	
	DB	'YOU WANTA TRY THAT AGAIN?',0DH
ENDIF
	DB	00
;
;********************************************************************
;
;		TESTK - TEST KEYIN CHARACTER.
;			IF CTL-C, DO COLD BOOT
;
;********************************************************************
;
TESTK	EQU	$
	CPI	03H	; CTL-C?
	JZ	EXIT	;  YUP, GET OUT
	CPI	'0'	; NUMERIC
	JC	TSKNG	;  NOPE, ERR
	CPI	'9'+1	; REALLY NUMERIC?
	JNC	TSKAF	;  NO, TEST A-F
	SUI	30H	; ADJUST TO BINARY
	ORA	A	; RESET CARRY
	RET
;
TSKAF	EQU	$
	CPI	'A'	; TEST "A"
	JC	TSKNG	;  LT, ERR
	CPI	'F'+1	; TEST "F"
	JNC	TSKNG	;  GT F, ERR
	SUI	37H	; SUBTRACT 55
	ORA	A	; RESET CARRY
	RET
;
TSKNG	EQU	$
	STC
	RET
;
;********************************************************************
;
;		PACKA - PACK ADDRESS KEYED-IN
;
;********************************************************************
;
PACKA	EQU	$
	LXI	H,ADDRA	; GET PARTIALLY-CONVERTED ADDR
	CALL	PACKB	; PACK A BYTE
	MOV	D,A	; PUT IT OVER THERE FOR THE NONCE
	CALL	PACKB	; PACK 2ND BYTE
	MOV	E,A	; COMBINE
	XCHG		;  THEM INTO H-L
	SHLD	ADDRH	; SAVE THEM IN ADDRH
	RET
;
PACKB	EQU	$
	MOV	A,M	; GET CHAR FROM INPUT
	RLC		; ROTATE
	RLC		;  IT
	RLC		;   TO
	RLC		;    H/O
	ANI	0F0H	; CLEAR L/O
	MOV	B,A	; SAVE IT IN B
	INX	H	; BUMP MEM PTR
	MOV	A,M	; GET NEXT CHAR
	ORA	B	;  OR ON H/O FROM B
	INX	H	;  BUMP MEM PTR AGAIN
	RET
;
;********************************************************************
;
;		RANDS - SAVE RANDOM NUMBER FOR LATER RESTORATION
;
;********************************************************************
;
RANDS	EQU	$
	LXI	H,NRAND+3	; PT TO L/O OF 4-BYTE RANDOM NUMBER
	MVI	A,01		; ENSURE
	ORA	M		;  THAT L/O OF NRAND
	MOV	M,A		;   ENDS IN 1
	LXI	D,NRNDS+3	;  POINT D TO RAND SAVE
	JMP	RNDS2		; GO TO COMMON MOVE RTN
;
RANDR	EQU	$
	LXI	H,NRNDS+3	; FROM ADDR = RAND SAVE
	LXI	D,NRAND+3	;  TO ADDR = RANDOM NUMBER
;
RNDS2	EQU	$
	MVI	B,4	; COUNT = 4
;
RNDSL	EQU	$
	MOV	A,M	; GET CHAR FROM SOURCE
	STAX	D	; COPY IT TO DEST
	DCX	D	; DECR
	DCX	H	;  BOTH PTRS
	DCR	B	; MINUS COUNT
	JNZ	RNDSL	;  LOOP TILL DONE
	RET
;
;
;********************************************************************
;
;		DATA AREAS
;
;********************************************************************
;
NRAND	DS	4	; PSEUDO-RANDOM NUMBER
NRNDS	DS	4	; RAND SAVE AREA
;
MLTPR	DW	0A5A5H	; RANDOM MULTIPLIER
;
PRDAD	DW	0	; PARTIAL PRODUCT A*D
PRDBD	DW	0	;   "        "    B*D
PRDBC	DW	0	;   "        "    B*C
;
ADDRA	DS	4	; ADDR INPUT
ADDRH	DS	2	; HEX EQUIV. OF ADDRA
;
ASTRT	DS	2	; HEX STARTING ADDR
AEND	DS	2	; HEX ENDING ADDR
ATEST	DS	2	; HEX TEST ADDR FOR "SLOW"
;
MINDX	DW	0	; K INDEX TO ERROR MATRIX
;
PASSC	DW	0	; PASS COUNTER
ERRCT	DW	0	; ERROR COUNTER
;
	DS	2
MATRX	DS	1024	; ERROR MATRIX (64K * 16)
	DS	2
SLOWTOGL	DB	0	;SLOW TEST TOGGLE
XAMTOGL		DB	0	;DETAILED LIST TOGGLE
;
;
;********************************************************************
;
;		GENERATE RANDOM BYTE
;
;********************************************************************
;
RANDB	EQU	$
	PUSH	D	; SAVE
	PUSH	H	;   REGS
	LDA	MLTPR+1	; GET MULTIPLIER L/O
	MOV	C,A	;  SAVE IN C
	LDA	NRAND+3	; GET NRAND L/O
	MOV	B,A	;  SAVE IN B
	CALL	MULT	; GET 16-BIT PRODUCT IN H-L
	SHLD	PRDBD	;  STORE 1ST PARTIAL PRODUCT
	LDA	MLTPR+1	; GET MULTIPLIER H/O
	MOV	C,A	;  SAVE IN C
	LDA	NRAND+2	; GET NRAND DIG
	MOV	B,A	;  SAVE IN B
	CALL	MULT	; DO MULTIPLICATION
	SHLD	PRDBC	;  SAVE PARTIAL PRODUCT
	LDA	MLTPR	; GET MULTIPLIER L/O
	MOV	C,A	;  SAVE IN C
	LDA	NRAND+3	; GET NRAND L/O
	MOV	B,A	;  SAVE IN B
	CALL	MULT	; DO MULTIPLICATION
	SHLD	PRDAD	;  SAVE 3RD PARTIAL PROD
	LDA	PRDBD	; GET NEW L/O DIGIT
	STA	NRAND+3	;  UPDATE NRAND L/O
	LXI	H,0	; GET CLEAR SUM
	MVI	B,0	; CLEAR H/O OF ADDEND
	LDA	PRDBD+1	; GET H/O OF PROD BD
	MOV	C,A	;  TO L/O OF ADDEND
	DAD	B	; ADD INTO SUM
	LDA	PRDBC	; GET L/O OF PROD BC
	MOV	C,A	;  TO L/O OF ADDEND
	DAD	B	; ADD INTO SUM
	LDA	PRDAD	; GET L/O OF PROD AD
	MOV	C,A	;  TO L/O OF ADDEND
	DAD	B	; ADD INTO SUM
	MOV	A,L	; GET L/O OF SUM
	STA	NRAND+2	; UPDATE NRAND TO NEW VALUE
	POP	H	; RESTORE
	POP	D	;  REGS
	RET
;
;********************************************************************
;
;		MULT B * C = PROD IN H-L
;
;********************************************************************
;
MULT	EQU	$
	PUSH	D	; SAVE D-E
	MOV	A,B	; COPY MULTIPLICAND TO A
	MVI	B,0	; CLEAR UPPER ADDEND
	LXI	H,0	; INIT PRODUCT TO ZERO
	MVI	D,8	; MULTIPLIER BIT COUNT
MULT2	EQU	$
	DAD	H	; SHIFT PRODUCT LEFT
	RLC		; MULTIPLIER BIT TO CARRY
	JNC	MULTC	;  SKIP IF BIT ZERO
	DAD	B	;  ELSE, ADD MPCND TO PARTIAL PRODUCT
MULTC	EQU	$
	DCR	D	; DECR BIT COUNT
	JNZ	MULT2	;  LOOP TILL DONE
	POP	D	; RESTORE D-E
	RET
;
;********************************************************************
;
;		PRMAT - PRINT ERROR BIT MATRIX
;
;********************************************************************
;
PRMAT	EQU	$
	CALL	PRTPASS	; PRINT PASS COUNT
	LHLD	ERRCT	; GET ERROR COUNT
	MOV	A,H	; GET H/O
	ORA	A	; Q. 0?
	JNZ	PRMAH	;  NO, GO THRU MATRIX
	MOV	A,L	; GET L/O
	ORA	A	; Q. ZERO?
	JZ	PRMAX	;  YES, BYPASS MATRIX SEARCH
PRMAH	EQU	$
	LXI	H,MSGBH	; GET BIT ERR MSG HEADER
	CALL	LINE	;  TYPE IT
	LHLD	ASTRT	; GET STARTING ADDR
	MOV	A,H	; GET H/O
	ANI	0FCH	; MASK OFF L/O 2 BITS
	MOV	H,A	;  AND MOVE IT BACK
	XCHG		;  MOVE TO D-E
	LXI	H,MATRX	; POINT TO ERROR MATRIX
	MVI	B,64	; COUNT OF K'S TO SEARCH
PRMA3	EQU	$
	MVI	C,8	; # OF BIT COUNTERS PER K
	PUSH	H	; SAVE CURRENT K INDEX TO MATRIX
PRMA4	EQU	$
	MOV	A,M	; GET BIT COUNTER
	ORA	A	; Q. ZERO?
	JNZ	PRMA5	;  NO, MUST PRINT THIS K
	INX	H	;  ELSE, BUMP TO NEXT BIT CTR
	MOV	A,M	; GET H/O OF BIT CTR
	ORA	A	; TEST ZERO
	JNZ	PRMA5	;  NO, PRINT K
	INX	H	;  YES, BUMP MEM PTR
	DCR	C	; MINUS BIT COUNTER
	JNZ	PRMA4	;  NOT DONE TESTING THIS K, LOOP
	JMP	PRMA7	;  ELSE, TRY NEXT K
PRMA5	EQU	$
	POP	H	; RESTORE STARTING K INDEX
	MVI	C,8	; RESTART BIT COUNTER
	XCHG		; GET CURR K ADDR
	PUSH	H	;  SAVE IT
	MVI	L,0	; PRINT K ADDR ON EVEN BOUNDARY
	MVI	A,' '	; BLANK FOR SPACING
	CALL	TYPE	;  TYPE IT
	CALL	TYPEB	; TYPE IT
	LXI	H,MSG2B	; 2 BLANKS
	CALL	LINE	;  TYPE THEM
	POP	H	; RESTORE K ADDR
	XCHG		;  THEN SWAP BACK
PRMA6	EQU	$
	PUSH	D	; SAVE TARGET ADDR
	MOV	E,M	; GET 1ST BYTE TO E
	INX	H	; BUMP MEM PTR
	MOV	D,M	; GET 2ND BYTE
	XCHG		; SWAP TO H-L
	CALL	TYPEB	; TYPE CTR AS THO ADDR
	XCHG		; SWAP BACK
	POP	D	; RESTORE D-E
	INX	H	; BUMP MEM PTR
	DCR	C	; MINUS COUNT
	JNZ	PRMA6	;  LOOP TILL DONE
	MVI	A,0DH	; CARR RTN
	CALL	TYPE	; TYPE IT
	JMP	PRMA8	;  AND GO TEST NEXT MATRIX LVL
;
PRMA7	EQU	$
	POP	H	; RESTORE H-L
	PUSH	B	; SAVE COUNTERS
	LXI	B,16	; GET OFFSET TO NEXT K
	DAD	B	; BUMP H-L
	POP	B	; RESTORE COUNTERS
PRMA8	EQU	$
	DCR	B	; MINUS K COUNTER
	JZ	PRMAX	; ZERO, DONE
	XCHG		; GET START ADDR
	PUSH	B	; SAVE BIT COUNTERS
	LXI	B,400H	; GET K BOUNDARY
	DAD	B	; ADJUST START ADDR
	XCHG		; SWAP BACK
	POP	B	; RESTORE BIT COUNTERS
	JMP	PRMA3	;  LOOP TILL DONE
;
PRMAX	EQU	$
	RET
;
MSGBH	DB	'K ADDR   B7   B6   B5   B4'
	DB	'   B3   B2   B1   B0'
	DB	0DH,00
;
;********************************************************************
;
;		PRTPASS - PRINT PASS COUNTER AND TOTAL ERRORS
;
;********************************************************************
;
PRTPASS	EQU	$
	LXI	H,MSGPC	; GET PASS COUNT MSG ADDR
	CALL	LINE	; TYPE IT
	LHLD	PASSC	; GET PASS COUNTER
	CALL	TYPEB	;  TYPE IT
	LXI	H,MSGER	; ERROR COUNT MESSAGE
	CALL	LINE	; TYPE LINE
	LHLD	ERRCT	; GET ERROR COUNTER
	CALL	TYPEB	;  TYPE COUNT OF ERRORS
	MVI	A,0DH	; CARR RTN
	CALL	TYPE	;  END LINE
	RET
;
MSGPC	DB	'PASSES COMPLETED = ',00
MSGER	DB	'; COUNT OF ERROR BYTES = ',00
	DB	00
;
;********************************************************************
;
;		TYPEH - TYPE A BYTE IN 2-DIGIT HEX
;
;********************************************************************
;
TYPEH	EQU	$
	PUSH	B	; SAVE COUNT
	MOV	B,A	; SAVE CHAR IN B
	ANI	0F0H	; STRIP L/O
	RRC		; SHIFT
	RRC		;  TO
	RRC		;   L/O
	RRC		;    4 BITS
	CALL	TYPHH	; TYPE HEX
	MOV	A,B	; GET CHAR BACK
	ANI	0FH	; NOW STRIP H/O
	CALL	TYPHH	; TYPE HEX
	POP	B	; RESTORE COUNT
	RET
;
TYPHH	EQU	$
	ADI	90H	; DO
	DAA		;  HEX TO ASCII
	ACI	40H	;   ADJUSTMENT
	DAA		;    TRICK
	CALL	TYPE	; TYPE ADJUSTED HEX CHAR
	RET
;
;********************************************************************
;
;		QUICK - DO QUICK TEST OF MEMORY RANGE
;			USING X'FF' AND X'00'
;
;********************************************************************
;
QUICK	EQU	$
	MVI	C,0FFH	; USE FOXES FIRST
	CALL	QTEST	; DO QUICK TEST
	CALL	KSTAT	; TEST KYBD READY
	RC		;  YES, EXIT
	MVI	C,00H	; NOW USE ZEROS
	CALL	QTEST	; DO QUICK TEST AGAIN
	RET
;
QTEST	EQU	$
	LHLD	AEND	; GET END ADDR TO H-L
	XCHG		;  SWAP IT TO D-E
	LHLD	ASTRT	; GET STARTING ADDR
QTES2	EQU	$
	CALL	KSTAT	; TEST KYBD READY
	RC		;  YES, EXIT
	MOV	A,C	; GET STORING VALUE
	CALL	STNDX	; STORE CHAR IN MEM, BUMP INDEX
	JC	QTES2	;  LT, MORE
	LHLD	ASTRT	; GET START ADDR AGAIN
QTES3	EQU	$
	CALL	KSTAT	; TEST KYBD READY
	RC		;  YES, EXIT
	MOV	A,C	; GET STORED VALUE
	MOV	B,M	;  GET CHAR FROM MEM
	CMP	B	;  TEST EACH DIGIT AGAINST EXPECTED
	JZ	QTES4	;  EQ, ON
	CALL	TYPEA	;  ELSE, TYPE ERR VALS
	CALL	STMAT	; STORE BIT ERRORS IN MATRIX
QTES4	EQU	$
	CALL	INDEX	; BUMP INDEX
	JC	QTES3	;  LT, AGAIN
	RET
;
;********************************************************************
;
;		SLOW - DO SUPER-SLOW MEM TEST.
;			FIRST, MARCH A 1 BIT THRU A FLD OF ZEROS,
;			TESTING EACH OTHER BYTE IN THE RANGE FOR
;			A CHANGE.
;			THEN, MARCH A ZERO BIT THRU A FLD OF ONES,
;			TESTING AS ABOVE.
;
;********************************************************************
;
SLOW	EQU	$
	IF	PANEL
	IN	255	; READ SENSE SWS
	ANI	SSWS	; TEST SLOW SELECTED
	ENDIF
	IF 	NOT PANEL
	LDA	SLOWTOGL
	ANI	01	;DO SLOW TEST IF SLOWTOGL=1
	ENDIF
	RZ
	MVI	B,00	; ZEROS TO MEM FOR 1ST PHASE
	CALL	SETMEM	;  CLEAR ADDR SPACE
	MVI	C,01	; BIT REG
SLOW2	EQU	$
	CALL	SLOWT	; DO SLOW TEST
	CALL	KSTAT	; TEST FOR INTERRUPTION
	RC		;  YES, GO
	MOV	A,C	; GET BIT REG
	RLC		; SHIFT BIT
	JC	SLOW3	; WHEN BIT REACHES CARRY, DONE
	MOV	C,A	; REPLACE BIT
	JMP	SLOW2	;  NOT DONE, CONTINUE
SLOW3	EQU	$
	MVI	B,0FFH	; ALL ONES
	CALL	SETMEM	;  TO ADDR SPACE
	MVI	C,0FEH	; BIT REG TO A L/O ZERO
SLOW4	EQU	$
	CALL	SLOWT	; DO SLOW TEST
	CALL	KSTAT	; TEST FOR INTERRUPTION
	RC		;  YES, GO
	MOV	A,C	; GET BIT REG
	RLC		; SHIFT 0 BIT LEFTWARDS
	JNC	SLOW5	; WHEN ZERO REACHES CARRY, DONE
	MOV	C,A	; REPLACE BIT REG
	JMP	SLOW4	;  NOT DONE, CONTINUE
;
SLOW5	EQU	$
	MVI	B,08	; COUNT OF BELLS
SLOWB	EQU	$
	MVI	A,07H	; BELL CHAR
	CALL	TYPE	;  SOUND IT
	CALL	KSTAT	; TEST KYBD READY
	JC	SLOWX	;  YES, CLEANUP
	LXI	H,0	; LONG WAIT
SLOW6	EQU	$
	DCR	L	;
	JNZ	SLOW6	;
	DCR	H	;
	JNZ	SLOW6	;
	DCR	B	; MINUS BELL COUNT
	JNZ	SLOWB	;  NOT DONE, RING AGAIN
SLOWX	EQU	$
	MVI	A,0DH	; CR
	CALL	TYPE	; TYPE IT
	RET
;
SLOWT	EQU	$
	LHLD	ASTRT	; GET STARTING ADDR FOR TEST
	SHLD	ATEST	; STORE IT AT TEST ADDR
SLOWT2	EQU	$
	LHLD	ATEST	; GET TEST ADDR
	MOV	M,C	; STORE BIT REG AT TEST BYTE
	LHLD	AEND	; ENDING ADDR TO H-L
	XCHG		;  SWAP IT TO D-E
	LHLD	ASTRT	; GET STARTING ADDR
SLOWS2	EQU	$
	MOV	A,M	; GET BYTE FROM MEM
	CMP	B	; TEST TO EXPECTED
	JZ	SLOWS5	;  EQ, ON
	PUSH	B	; SAVE B-C
	MOV	C,A	;  SAVE CHAR READ (ERROR)
	XCHG		; CURRENT ADDR TO D-E
	LHLD	ATEST	; GET TEST ADDR TO H-L
	MOV	A,H	; GET H/O ADDR OF TEST BYTE
	CMP	D	;  TEST TO D
	JNZ	SLOWS3	;   NOT EQ, ON
	MOV	A,L	; GET L/O
	CMP	E	;  TEST L/O OF TEST ADDR
	JNZ	SLOWS3	;  NOT EQUAL, PRT ERROR
	JMP	SLOWS4	;  AND BYPASS ERROR PRT
SLOWS3	EQU	$
	MOV	A,B	; SWAP EXPECTED TO ACC
	MOV	B,C	; INSERT VALUE READ IN ERROR
	CALL	TYPEA	; TYPE ADDR
	CALL	STMAT	; STORE IN ERR MATRIX
SLOWS4	EQU	$
	POP	B	; RESTORE B-C
	LHLD	AEND	; GET ENDING ADDR
	XCHG		; CURRENT ADDR BACK TO H-L
SLOWS5	EQU	$
	INX	H	; BUMP MEM PTR
	MOV	A,H	; GET H/O OF CURR ADDR
	CMP	D	; TEST TO H/O OF END ADDR
	JC	SLOWS2	;  LT, CONTINUE
	MOV	A,L	; GET L/O OF CURR ADDR
	CMP	E	; TEST TO L/O OF END ADDR
	JC	SLOWS2	;  LT, ON
SLOWSX	EQU	$
	CALL	KSTAT	; TEST FOR INTERRUPTION
	RC		;  YES, GO
	LHLD	ATEST	; GET TEST ADDR
	MOV	M,B	; REPLACE TEST BYTE
	INX	H	; BUMP TEST ADDR
	SHLD	ATEST	;  AND RESAVE IT
	XCHG		; SWAP TEST ADDR TO D-E
	LHLD	AEND	; GET END ADDR TO H-L
	MOV	A,D	; GET H/O OF TEST ADDR
	CMP	H	; TEST TO H/O OF END ADDR
	JC	SLOWT2	;  LT, ON
	JNZ	SLOWTX	;  NOT EQ, DONE
	MOV	A,E	; GET L/O OF TEST ADDR
	CMP	L	;  TEST TO L/O OF END ADDR
	JC	SLOWT2	;  LT, ON
	JZ	SLOWT2	;  EQ, 1 MORE TIME
SLOWTX	EQU	$
	RET
;
;********************************************************************
;
;		SETMEM - SET ADDR SPACE TO VALUE IN B
;
;********************************************************************
;
SETMEM	EQU	$
	LHLD	AEND	; GET ENDING ADDR
	XCHG		;  TO D-E
	LHLD	ASTRT	; GET STARTING ADDR
SETM2	EQU	$
	MOV	M,B	; FILL MEM BYTE
	CALL	INDEX	; BUMP PTR
	JC	SETM2	;  LT, LOOP
	RET
;
;********************************************************************
;
;		INIT - SETUP MATRIX
;
;********************************************************************
;
INIT	EQU	$
	LXI	H,MATRX	; GET ERROR MATRIX ADDR
	LXI	B,1024	;  GET MATRIX LENGTH
	XRA	A	; GET ZERO
INIT2	EQU	$
	MOV	M,A	; STORE ZERO IN ERROR MATRIX BYTE
	INX	H	; BUMP MEM PTR
	DCR	C	; MINUS L/O OF COUNT
	JNZ	INIT2	; INNER LOOP
	DCR	B	; MINUS COUNT
	JNZ	INIT2	;  LOOP TILL DONE
	LXI	H,0	; ZEROS TO
	SHLD	PASSC	;  PASS COUNTER
	SHLD	ERRCT	;   AND ERROR COUNTER
	RET
;
;********************************************************************
;
;		TYPEA - TYPE ERROR ADDR, WROTE, READ
;
;********************************************************************
;
TYPEA	EQU	$
	PUSH	PSW	; SAVE CHAR 2B TYPED
	IF	PANEL
	IN	255	; READ SENSE SWS
	ANI	SSWD	; TEST DETAIL LIST SENSE SW
	ENDIF
	IF	NOT PANEL
	LDA	XAMTOGL
	ANI	01	; DO DETAILED LIST IF XAMTOGL=1
	ENDIF
	JZ	TYPAX	;  YES, DON'T DETAIL ERRS
	PUSH	H	; SAVE ADDR OF ERROR
	LHLD	ERRCT	; GET ERROR COUNTER
	MOV	A,H	; GET H/O
	ORA	A	; Q. ZERO?
	JNZ	TYPA2	;  NO, ALREADY PRINTED HEADER
	MOV	A,L	; GET L/O
	ORA	A	; Q. ZERO?
	JNZ	TYPA2	;  NO, BYPASS
	LXI	H,MSGEH	; GET ERROR HEADER MSG
	CALL	LINE	;  TYPE IT
TYPA2	EQU	$
	POP	H	; RESTORE ERROR ADDR
	CALL	TYPEB	; CONVERT AND TYPE H-L
	PUSH	H	; SAVE H-L AGAIN
	LXI	H,MSG2B	; 2 BLANKS
	CALL	LINE	;  TYPE IT
	POP	H	; RESTORE H-L
	POP	PSW	; GET CHAR
	PUSH	PSW	;  RESAVE IT
	CALL	TYPEH	; TYPE IT
	PUSH	H	; SAVE H-L AGAIN
	LXI	H,MSG3B	; 3 BLANKS
	CALL	LINE	;  TYPE IT
	POP	H	; RESTORE H-L
	MOV	A,B	; GET CHAR READ
	CALL	TYPEH	; TYPE IT
	MVI	A,0DH	; CARR RTN
	CALL	TYPE	;  SEND IT
TYPAX	EQU	$
	POP	PSW	; RESTORE CHAR
	RET
;
MSGEH	DB	'ADDR WROTE READ',0DH
	DB	00
MSG3B	DB	' '
MSG2B	DB	'  ',00
;
;********************************************************************
;
;		TYPEB - TYPE 2-BYTE ADDRESS IN H-L
;
;********************************************************************
;
TYPEB	EQU	$
	MOV	A,H	; GET H/O OF ADDR
	CALL	TYPEH	; TYPE IT
	MOV	A,L	; GET L/O
	CALL	TYPEH	;  TYPE IT
	MVI	A,' '	; BLANK
	CALL	TYPE	;  FOR SEPARATION
	RET
;
	END
