report.i65

;**** report 6502 funtional test errors to standard I/O ****
;
;this include file is part of the 6502 functional tests
;it is used when you configure report = 1 in the tests
;
;to adopt the standard output vectors of your test environment
;you must modify the rchar and rget subroutines in this include
;
;I/O hardware may have to be initialized in report_init

;print message macro - \1 = message location
        .macro rprt arggg
        ldx #0
        lda arg
loop:   jsr rchar
        inx
        lda arggg,x
        bne loop
        .endmacro

;        .macro  trap
;        jsr my_error_handler
;        .endmacro
;        .macro  trap_eq
;        bne :+
;        trap           ;failed equal (zero)
;:
;        .endmacro

;trap    macro
;        jsr my_error_handler
;        endm
;trap_eq macro
;        bne skip\?
;        trap           ;failed equal (zero)
;skip\?
;        endm

;initialize I/O as required (example: configure & enable ACIA)
report_init:
        ;nothing to initialize
        rprt rmsg_start
        rts
        
;show stack (with saved registers), zeropage and absolute memory workspace
;after an error was trapped in the test program
report_error:
;save registers
        php
        pha
        txa
        pha
        tya
        pha
        cld
;show stack with index to registers at error
        rprt rmsg_stack
        tsx
        inx
        lda #1      ;address high
        jsr rhex
        txa         ;address low
        jsr rhex
rstack:  jsr rspace
        lda $100,x  ;stack data
        jsr rhex
        inx
        bne rstack
        jsr rcrlf   ;new line
;show zero page workspace
        lda #0
        jsr rhex
        lda #zpt
        tax
        jsr rhex
rzp:     jsr rspace
        lda 0,x
        jsr rhex
        inx
        cpx #zp_bss
        bne rzp
        jsr rcrlf
;show absolute workspace
        lda #hi(data_segment)
        jsr rhex
        lda #lo(data_segment)
        jsr rhex
        ldx #0
rabs:    jsr rspace
        lda data_segment,x
        jsr rhex
        inx
        cpx #(data_bss-data_segment)
        bne rabs
;ask to continue
        rprt rmsg_cont
rerr1:   jsr rget
        cmp #'S'
        beq rskip
        cmp #'C'
        bne rerr1        
;restore registers
        pla
        tay
        pla
        tax
        pla 
        plp
        rts
;skip the current test
rskip:   lda #$f0            ;already end of tests?
        cmp test_case
        beq rerr1           ;skip is not available
        ldx #$ff            ;clear stack
        txs
        inc test_case       ;next test
        lda #lo(start)      ;find begin of test
        sta zpt
        lda #hi(start)
        sta zpt+1
rskipl1: ldy #4              ;search pattern
rskipl2: lda (zpt),y         ;next byte
        cmp rmark,y
        bne rskipnx         ;no match
        dey
        bmi rskipf          ;found pattern        
        cpy #1              ;skip immediate value
        bne rskipl2
        dey
        beq rskipl2
        
rskipnx: inc zpt             ;next RAM location
        bne rskipl1
        inc zpt+1
        bne rskipl1

rskipf:  ldy #1              ;pattern found - check test number
        lda (zpt),y         ;test number
        cmp #$f0            ;end of last test?
        beq rskipe          ;ask to rerun all
        cmp test_case       ;is next test?
        bne rskipnx         ;continue searching
rskipe:  jmp (zpt)           ;start next test or rerun at end of tests
        
rmark:   lda #0              ;begin of test search pattern
        sta test_case

;show test has ended, ask to repeat
report_success:
    .if rep_int = 1
        rprt rmsg_priority
        lda data_segment    ;show interrupt sequence
        jsr rhex
        jsr rspace
        lda data_segment+1
        jsr rhex
        jsr rspace
        lda data_segment+2
        jsr rhex
    .endif
        rprt rmsg_success
rsuc1:   jsr rget
        cmp #'R'
        bne rsuc1        
        rts

;input subroutine
;get a character from standard input 
;adjust according to the needs in your test environment
rget:                ;get character in A
;rget1
;        lda $bff1   ;wait RDRF
;        and #8
;        beq rget1
;not a real ACIA - so RDRF is not checked
;        lda $bff0   ;read acia rx reg
        lda $f004   ;Kowalski simulator default
;the load can be replaced by a call to a kernal routine
;        jsr $ffcf   ;example: CHRIN for a C64
        cmp #'a'    ;lower case
        bcc rget1
        and #$5f    ;convert to upper case
rget1:   rts

;output subroutines
rcrlf:   lda #10
        jsr rchar
        lda #13
        bne rchar

rspace:  lda #' '
        bne rchar
        
rhex:    pha         ;report hex byte in A
        lsr a       ;high nibble first
        lsr a
        lsr a
        lsr a
        jsr rnib
        pla         ;now low nibble
        and #$f

rnib:    clc         ;report nibble in A
        adc #'0'    ;make printable 0-9
        cmp #'9'+1
        bcc rchar
        adc #6      ;make printable A-F

;send a character to standard output 
;adjust according to the needs in your test environment
;register X needs to be preserved!
rchar:               ;report character in A
;        pha         ;wait TDRF
;rchar1  lda $bff1
;        and #$10
;        beq rchar1
;        pla
;not a real ACIA - so TDRF is not checked
;        sta $bff0   ;write acia tx reg
        sta $f001   ;Kowalski simulator default
;the store can be replaced by a call to a kernal routine
;        jsr $ffd2   ;example: CHROUT for a C64
        rts

rmsg_start:
        db  10,13,"Started testing",10,13,0
rmsg_stack:
        db  10,13,"regs Y  X  A  PS PCLPCH",10,13,0
rmsg_cont:
        db  10,13,"press C to continue or S to skip current test",10,13,0
rmsg_success:
        db  10,13,"All tests completed, press R to repeat",10,13,0
    .if rep_int = 1
rmsg_priority:
        db  10,13,"interrupt sequence (NMI IRQ BRK) ",0
    .endif