;
;memory test program
;
;this memory test will use the default address if starting and
;ending address questions are answered with carriage return.
;memory test can be terminated by  cntl-e
;entering memory test with "p" in tbuf will cause a pause
;during bit pattern fill, and will require any key
;to be pushed to continue. this pause is to allow memory the
;chance to fade out.
;entering memory test with r in tbuf will cause
;only the random number test to be performed.
;
;************************************************************
;
CR	EQU	0DH
LF	EQU	0AH
BDOS	EQU	5
TBUF	EQU	5DH		;command buffer
RETRYS	EQU	14		;# of retrys
WBOOT	EQU	0000H		;warm boot entry point
;
	ORG	0100H		;program run area
;
START:	JMP	START1
;
;console input routine
;
JCONI:	PUSH	B
	PUSH	D
	PUSH	H
	MVI	C,1		;console input function
	CALL	BDOS		;get the character
	CPI	'a'
	JRC	DOSEX
	CPI	'z'+1
	JRNC	DOSEX
	ANI	5FH		;if lower case, make it upper
	JMPR	DOSEX
;
CONST:	PUSH	B
	PUSH	D
	PUSH	H
	MVI	C,11
	JMPR	BDOSE
;
;console output routine
;
CONO:	PUSH	B
	PUSH	D
	PUSH	H
	MOV	E,C		;get the character
	MVI	C,2		;console output function
BDOSE:	CALL	BDOS		;use cpm call
DOSEX:	POP	H
	POP	D
	POP	B
	RET
;
START1:	MVI	B,0AAH		;check for a z80 cpu
	MOV	A,B
	STAI			;save it in the intrp register
	XRA	A		;clear a
	STA	PASFLG		;clear pause flag
	LDAI			;recover the byte
	CMP	B		;do they match?
	JRZ	Z80OK4		;jump if yes
	LXI	D,NOTZ80
	MVI	C,9		;print buffer function
	JMP	BDOS		;print and return to os
;
Z80OK1:	XRA	A		;get a zero
	STA	TBUF		;clear for all options
	STA	PASFLG		;clear pause flag
	JMPR	Z80OK
;
Z80OK2:	MVI	A,'P'		;user wants pause option
	STA	TBUF
	JMPR	Z80OK
;
Z80OK3:	MVI	A,'R'		;user wants r option
	STA	TBUF
	JMPR	Z80OK
;
Z80OK4:	LXI	D,SIG		;sign on
	CALL	PMSG		;print it
Z80OK:	LXI	SP,STACK	;set local stack
	LXI	D,OPTS		;show options
	CALL	PMSG
	MVI	A,RETRYS	;set retry count
	STA	COUNT
	LDAR			;get a byte from refresh register
	STA	SEED		;use as the random seed value
	LDAR			;get another byte
	NEG			;negate it
	STA	SEED+1		;and save it
	LXI	H,1		;set pass counter = 1
	SHLD	PASS
	LDA	TBUF		;check for r or p option
	CPI	'R'		;just random wanted?
	JZ	SETRND		;jump if yes
	CPI	'P'		;pause wanted?
	CZ	SETPAS		;call setup if yes
	CALL	PARMS		;get start and end address
	LDA	TBUF
	CPI	'R'		;if r then go directly to random test
	JZ	RNDW		;go do random numbers
	LXI	D,TEST1
	CALL	PMSG		;print test
	MVI	B,0FFH		;ff test start
	CALL	TESTW		;write test byte
	LDA	PASFLG		;check for pause wanted
	ORA	A		;0 = no
	JRZ	TST1		;jump if not
	LXI	D,PAUSM		;point to pause message
	CALL	PMSG
TRY1:	CALL	CONST
	ORA	A
	JRZ	TRY1
TST1:	CALL	TESTR		;check test byte
	MVI	B,0		;zeros test
	CALL	TESTW		;write test byte 0
	LDA	PASFLG		;check for pause wanted
	ORA	A		;0 = no
	JRZ	TST2		;jump if not
	LXI	D,PAUSM		;point to pause message
	CALL	PMSG
TRY2:	CALL	CONST
	ORA	A
	JRZ	TRY2
TST2:	CALL	TESTR		;test
	LXI	D,TEST3
	CALL	PMSG		;print bit short test
	MVI	A,1		;rotate bit test
LOOP2:	MOV	B,A		;make test byte
	CALL	ROTTST		;do test
	JRNC	LOOP2		;done with 8 bits?
;
;address line test
;
	LXI	D,TEST4
	CALL	PMSG		;print addr. line test
	MVI	B,01010101B	;test byte
	CALL	ADTEST		;test
	MVI	B,10101010B	;test byte
	CALL	ADTEST		;test
	MVI	A,'R'
	STA	TBUF		;put r in tbuf - loop on random test
DORND:	LXI	D,RMSG		;now do random test
	CALL	PMSG
	LXI	D,MSGOK		;point at test compleat message
	CALL	PMSG
	JMP	RNDW		;do random # test
;
SETPAS:	MVI	A,1		;set the flag for pause
	STA	PASFLG
	RET
;
SETRND:	CALL	PARMS
	JMPR	DORND		;do the random test only
;
PARMS:	LXI	D,SMSG		;starting addr. msg.
	CALL	PMSG		;print it
	CALL	GETADD		;get starting addr from conin
	JRNC	LDST1		;flag = 0 then entry was cr
	LXI	D,DFADDS	;get a cr,lf
	CALL	PMSG		;print it
	LXI	H,DEFST		;get defult starting addr.
	PUSH	H
	CALL	PHL		;print default address
	POP	H
LDST1:	SHLD	MEM		;save starting address
	LXI	D,EMSG		;ending addr. msg.
	CALL	PMSG
	CALL	GETADD		;get ending address from keyboard
	JRNC	LDST2		;flag = 0 then was cr
	LXI	D,DFADDE	;get default end address
	CALL	PMSG		;print it
	LHLD	BDOS+1		;get default end (bdos,bios left intact)
	DCX	H		;back off by 2
	PUSH	H		;save ending address
	CALL	PHL		;print default address
	POP	H
LDST2:	SHLD	ENDADD		;save ending address
	RET
;
ERROR:	PUSH	B
	PUSH	D
	PUSH	H
	PUSH	PSW		;save all regs.
	LXI	D,MSG1
	CALL	PMSG
	INX	D
	LDA	COUNT
	CPI	RETRYS
	CZ	PMSG		;print lables
	CALL	PHL		;print hl reg
	MOV	D,B		;get should be data
	CALL	CNVT		;print hex
	MOV	A,B	
	CALL	CNVTB
	POP	PSW
	PUSH	PSW
	MOV	D,A		;get was data
	CALL	CNVT		;print hex
	POP	PSW
	CALL	CNVTB
	LDA	COUNT		;get error count
	DCR	A		;one less
	STA	COUNT		;put back count
	JRNZ	MORET
	LXI	D,MSG4
	CALL	PMSG
	CALL	GETADD		;see if stop or continue
	MVI	A,RETRYS
	STA	COUNT		;reset count
MORET:	POP	H		;get all regs. back and continue test
	POP	D
	POP	B
	RET
;
;print h,l register as ascii
;
PHL:	MOV	D,H
	CALL	CNVT		;make address of error ascii
	MOV	D,L
	CALL	CNVT
	PUSH	B
	CALL	TAB		;print 4 spaces and return
	POP	B
	RET
;
;print string pointed to by d,e
;
PMSG:	LDAX	D		;get byte to be printed
	ORA	A		;end of text?
	RZ
	MOV	C,A		;convention
	CALL	CONO		;goto output
	INX	D
	JMPR	PMSG
;
;fill test memory with test word
;
TESTW:	CALL	LOAD
WLOOP:	CALL	ADCK
	RC
	MOV	M,B		;put test word in memory
	CALL	INXH
	RC
	JMPR	WLOOP
;
LOAD:	LDED	ENDADD		;get ending address
	LHLD	MEM		;get starting address
	RET
;
;read and check test memory for test word
;
TESTR:	LHLD	MEM
	SHLD	TSTLOC
TSTADR:	CALL	CSTAT
RLOOP:	CALL	ADCK
	RC
	MOV	A,M
	CMP	B		;check should be
	CNZ	ERROR
	CALL	INXH
	RC
	JMPR	RLOOP
;
;query console for status
;
CSTAT:	PUSH	H
	PUSH	B
	CALL	CONST		;see if key struck
	ORA	A		;set flags
	JRZ	NOKEY
	CALL	CHKBRK		;check for option key
NOKEY:	POP	B		;no correct option received
	LDED	ENDADD		;get ending address
	POP	H
	RET
;
CHKBRK:	CALL	JCONI		;get key
	CPI	'A'-40H		;cntl-a (clear all options)?
	JZ	Z80OK1		;restart program
	CPI	'P'-40H		;restart with p option?
	JZ	Z80OK2
	CPI	'R'-40H		;restart with r option?
	JZ	Z80OK3
	CPI	'E'-40H		;want to exit program?
	JZ	WBOOT		;exit to o.s.
	RET
;
;address limit check
;
ADCK:	CALL	CONST		;check for console abort
	ORA	A
	JRZ	ADCK1
	CALL	CHKBRK		;key was pushed, check type
ADCK1:	MOV	A,D		;no correct option given
	SUB	H		; so continue with program
	RC
	RNZ
	MOV	A,E
	SUB	L
	RET
;
INXH:	PUSH	B		;save b,c
	LXI	B,1		;get a 1
	DAD	B		;add it to h,l
	POP	B		;recover b,c
	RET
;
;convert reg. d to hex ascii
;
CNVT:	MOV	A,D
	RRC			;get high nibble
	RRC
	RRC
	RRC
	CALL	CNV		;make nibble ascii
	MOV	A,D		;get low nibble
CNV:	ANI	0FH
	ADI	90H
	DAA
	ACI	40H
	DAA
	MOV	C,A
	JMP	CONO		;print and return
;
ROTTST:	PUSH	PSW
	CALL	TESTW
	POP	PSW
	PUSH	PSW
	CALL	TESTR
	POP	PSW
	RLC
	RET
;
ADTEST:	CALL	TESTW		;fill memory with test word
	MOV	A,B
	STA	TSTWRD		;save test word
	CALL	LOAD
	CMA
	MOV	M,A
	SHLD	TSTLOC
	INX	H
	CALL	TSTADR
	LXI	B,1		;start addr. lsb on
LOOP4:	LHLD	MEM
	DAD	B
	RC			;rolled over 65k
	MOV	A,D		;get test addr
	SUB	H		;past end?
	RC			;keep going if no  carry
	JRNZ	INXHA
	MOV	A,E
	SUB	L
	RC
INXHA:	LDA	TSTWRD
	PUSH	B
	MOV	B,A
	CMA			;invert bits
	MOV	M,A		;write to test memory
	SHLD	TSTLOC
	CALL	INXH
	JRC	OVERFL
	CALL	TSTADR		;test
	POP	H
	DAD	H
	RC
	MOV	B,H
	MOV	C,L
	JMPR	LOOP4
;
OVERFL:	POP	B
	RET
;
GETBYT:	CALL	CHAR
	RZ
	CPI	' '		;exit if space typed
	JZ	WBOOT
	CALL	ATOH
	JP	RENTER
	RRC
	RRC
	RRC
	RRC
	MOV	E,A
	PUSH	D
	CALL	CHAR
	POP	D
	JRZ	RENTER
	CALL	ATOH
	JP	RENTER
	ORA	E
	RET
;
CHAR:	CALL	JCONI
	CPI	CR
	STC			;set carry flag (maybe cr)
	RET
;
ATOH:	SUI	'0'
	JM	BAD
	CPI	10
	RM
	SUI	7
	CPI	10
	JM	BAD
	CPI	10H
	RM
BAD:	XRA	A		;set zero flag
	RET
;
RENTER:	POP	H		;fix stack
	LXI	D,IEMSG
	CALL	PMSG
;
;input 4 hex values from console
;
GETADD:	CALL	GETBYT
	RC
	MOV	H,A
	PUSH	H
	CALL	GETBYT
	POP	H
	MOV	L,A
	RET
;
;print reg-a in binary
;
CNVTB:	MOV	E,A		;save a
	MVI	B,2		;two spaces
	CALL	TLOP
	MVI	B,2		;nibble count
PNIBB:	MVI	D,4
ALLBIT:	RALR	E		;rotate reg e left
	MVI	C,'0'		;get a "0"
	JRNC	ZERO
	INR	C		;get a 1
ZERO:	CALL	CONO
	DCR	D
	JRNZ	ALLBIT
	CALL	SPACE		;print space
	DJNZ	PNIBB
TAB:	MVI	B,4
TLOP:	CALL	SPACE
	DJNZ	TLOP
	RET
;
SPACE:	MVI	C,' '
	JMP	CONO
;
;random numder test
;
;write random numbers
;
RNDW:	LHLD	SEED		;get old seed
	SHLD	SEEDST		;save it for later
	SHLD	TSTLOC
	CALL	LOAD
RNDWL:	CALL	RND
	MOV	M,B
	CALL	ADCK
	JRZ	RNDR
	INX	H
	JMPR	RNDWL
;
;read and check random numbers
;
RNDR:	CALL	CSTAT
	LHLD	SEEDST		;start with same seed
	SHLD	SEED		;pass seed to generator
	CALL	LOAD		;get test address
RNDRL:	CALL	RND
	MOV	A,M
	CMP	B
	CNZ	ERROR
	CALL	ADCK
	JRZ	DONER
	INX	H
	JMPR	RNDRL
;
DONER:	MVI	C,CR
	CALL	CONO		;print a cr
	LHLD	PASS
	PUSH	H		;save pass number
	CALL	DECOUT		;print the decimal pass number
	CALL	SPACE
	POP	H
	INX	H		;bump pass number
	SHLD	PASS
	JMPR	RNDW		;execute random forever
;
;generate random number form seed
;
RND:	PUSH	H
	LHLD	SEED
	MOV	A,L
	XRA	H
	MOV	B,A
	RLC
	MOV	L,A
	ADD	H
	MOV	H,A
	SHLD	SEED
	POP	H
	RET
;
DECOUT:	PUSH	B
	PUSH	D
	PUSH	H
	LXI	B,-10
	LXI	D,-1
DX:	DAD	B
	INX	D
	JRC	DX
	LXI	B,10
	DAD	B
	XCHG
	MOV	A,H
	ORA	L
	CNZ	DECOUT
	MOV	A,E
	ADI	'0'
	MOV	E,A
	MVI	C,2
	CALL	BDOS
	POP	H
	POP	D
	POP	B
	RET
;
;messages
;
MSG1:	DB	CR,LF,0,'Location'
	DB	'     Should Be           Was'
	DB	CR,LF,0
MSG4:	DB	CR,LF, '"CR" to continue test, "CNTL-C" to stop ',0
MSGOK:	DB	CR,LF,'         Random Test Pass Number.',0
SMSG:	DB	CR,LF,'Starting Address in Hex (or "CR" for default'
	DB	' or space bar to QUIT) ',0
EMSG:	DB	CR,LF,'Ending Address in Hex   (or "CR" for default'
	DB	' or space bar to QUIT) ',0
IEMSG:	DB	CR,LF,7,'Input Error, Restart- ',0
TEST1:	DB	CR,LF,'Stuck Bit Test',0
TEST3:	DB	CR,LF,'Shorted Bit Test',0
TEST4:	DB	CR,LF,'Address Line Test',0
RMSG:	DB	CR,LF,'Random Number Test',0
DFADDS:	DB	CR,LF,'Start Address (hex) = ',0
DFADDE:	DB	CR,LF,'Ending Address (hex) = ',0
PAUSM:	DB	CR,LF,'Pause - Push any key to continue. ',0
SIG:	DB	CR,LF,LF,'Tarbell Memory Test Program'
	DB	CR,LF,'Version 1.1 of 10-20-81',0
OPTS:	DB	CR,LF,LF,'Program options:'
	DB	CR,LF,'Cntl-E = Stop Program, Return to CP/M'
	DB	CR,LF,'Cntl-A = Clear all Options and Restart Test'
	DB	CR,LF,'Cntl-P = Set PAUSE Option and Restart Test'
	DB	CR,LF,'Cntl-R = Set RANDOM Option and Restart Test'
	DB	CR,LF,LF,0
NOTZ80:	DB	CR,LF,7,'ERROR, you must be using a Z-80.$'
;
STACK	EQU	$		;set a local stack
COUNT:	DS	1		;storage for retry count
TSTWRD:	DS	2
ENDADD:	DS	2		;ending address
MEM:	DS	2		;starting address
TSTLOC:	DS	2
SEED:	DS	2
SEEDST:	DS	2
PASS:	DS	2		;pass counter
PASFLG:	DS	1		;pause flag
;
DEFST	EQU	$		;default start address
	END	START
