*
 ORG 0C900H
 XEQ 0C900H
*
RTRN EQU 0C004H
SOUT EQU 0C019H
SINP EQU 0C01FH
VDADD EQU 0C11CH
*
* PROCESSOR TECHNOLOGY 48KRA-1 TEST *
*
BEGIN LXI SP,0CBFFH
*
* ANNNOUNCE TEST *
*
 LXI H,MSG1
 CALL STRNG
*
* CONTINUOUS OR SINGLE PASS *
*
 XRA A
 STA CFLAG
 CALL GET
 CPI 'C'
 JNZ INIT
*
 PUSH PSW
 MVI A,0FFH
 STA CFLAG
 POP PSW
*
INIT EQU $  INITIALIZATION
 CALL PUT
 CALL CRLF
*
 LXI H,0
 SHLD ROW1
 SHLD ROW2
 SHLD BDADR  Test board at address 0
*
CONT LHLD COUNT
 INR H
 MVI A,39H
 CMP H
 JNC C1
 INR L
 MVI H,30H
C1 SHLD COUNT
 LXI H,MSG2  IN PROGRESS
 CALL STRNG
 SUB A
 STA PAGE
 STA FILL
*
MAIN EQU $
 LDA FILL
 RLC
 CALL WRITE
 SUB A
 STC
*
LOOP1 EQU $
 PUSH PSW
 CALL NXTPG
 MVI E,2
*
TEST1 EQU $
 CALL TEST
 DCR E
 JNZ TEST1
 LDA FILL
 RLC
 CALL READ
 POP PSW
 RAR
 JNC LOOP1
 CMP A
 MVI A,0FFH
*
LOOP2 EQU $
 PUSH PSW
 CALL NXTPG
 MVI E,2
*
TEST2 EQU $
 CALL TEST
 DCR E
 JNZ TEST2
 LDA FILL
 RLC
 CALL READ
 POP PSW
 RAR
 JC LOOP2
 CALL NXTPG
 LDA PAGE
 ORA A
 JNZ MAIN
 LDA FILL
 CMA
 STA FILL
 ORA A
 JNZ MAIN
*
 CALL MAP  OUTPUT CHIP MAP
*
 LDA CFLAG
 ORA A
 JZ RTRN
 JMP CONT
*
* SUBROUTINES
*
MAP EQU $
 CALL CRLF
 LHLD ROW1
 CALL LINE
 MOV L,H
 CALL LINE
 LHLD ROW2
 CALL LINE
 CALL CRLF
 RET
*
LINE MVI D,4
*
PAIR MOV A,L
 RAR
 MOV L,A
 CALL CHIP
 MOV A,L
 RAR
 MOV L,A
 CALL CHIP
 CALL SPAC1
 DCR D
 JNZ PAIR
 CALL CRLF
 RET
*
SPAC1 MVI A,' '
 JMP MARK1
*
CHIP MVI A,'G'
 JNC MARK1
 MVI A,'X'
*
MARK1 CALL PUT
 CMP A
 RET
*
STRNG MOV A,M
 INX H
 CPI 0
 RZ .
 CALL PUT
 JMP STRNG
*
PUT PUSH H
 MOV B,A
 CALL SOUT
 POP H
 RET
*
GET CALL SINP
 JZ GET
 ANI 7FH
 RET
*
CRLF MVI A,0DH
 CALL PUT
 MVI A,0AH
 CALL PUT
 RET
*
NXTPG PUSH PSW
 CALL SINP
 CPI 1BH  See if ESC was typed
 JNZ N1
 CALL MAP
 JMP RTRN
N1 LDA PAGE
 ADI 40H
 CPI 0C0H
 JNZ NXTP1
 XRA A
*
NXTP1 STA PAGE
 POP PSW
 RET
*
GETPG PUSH PSW
 LDA PAGE
 LHLD BDADR
 ADD H
 MOV H,A
 POP PSW
 RET
*
TEST CALL WRITE
 CALL READ
 CALL NXTPG
 CALL VDADD  Show some activity
 MOV A,M
 ADI 80H  Blink the cursor
 MOV M,A
 RET
*
WRITE PUSH PSW
 CALL GETPG
 MVI D,40H
WRIT1 PUSH PSW
 MOV M,A
 XRA M
 CNZ BITER
 POP PSW
 RAL
 INR L
 JNZ WRIT1
 INR H
 DCR D
 JNZ WRIT1
 POP PSW
 RET
*
READ PUSH PSW
 CALL GETPG
 MVI D,40H
READ1 PUSH PSW
 XRA M
 CNZ BITER
 POP PSW
 RAL
 INR L
 JNZ READ1
 INR H
 DCR D
 JNZ READ1
 POP PSW
 RET
*
BITER PUSH H
 MOV B,A
 LDA PAGE
 RLC
 RLC
 NOP
 NOP
 LXI H,BITS
 ADD L
 MOV L,A
 MOV A,M
 ORA B
 MOV M,A
 POP H
 RET
*
MSG1 DB 0BH
 DW 2020H
 DW 2020H
 ASC " PROCESSOR TECHNOLOGY 48KRA-1 TEST"
 DW 0A0DH
 ASC "COPYRIGHT (C) 1978,"
 ASC " PROCESSOR TECHNOLOGY CORP."
 DW 0A0DH
 DW 0A0DH
 ASC "TYPE 'C' TO RUN CONTINUOUSLY"
 ASC " AND ACCUMULATE ERRORS."
 DW 0A0DH
 ASC "STRIKE ANY OTHER KEY TO RUN ONE PASS."
 DW 0A0DH
 DB 0
*
MSG2 ASC "48KRA-1 TEST IN PROGRESS.  PASS NO. "
COUNT DW 3030H
 DW 0A0DH
 DB 0
*
CFLAG DS 1
BDADR DS 2
BITS EQU $
ROW1 DS 2
ROW2 DS 2
PAGE DS 1
FILL DS 1
*