C64-dev/newLang/tests/source/source-test.s

; E02-S01: source-reader test in x128.
;
; Loads each fixture from drive 8 with src_load. For a successful load it
; replays the source twice (src_rewind + src_next_line) and records the line
; count and a Fletcher-16 checksum of the delivered lines, each terminated by
; $0D. For a failed load it records the error and checks that no source
; survives. Every record is 16 bytes in `results`:
;   +0 result code       +1 DOS status code   +2 KERNAL error
;   +3 error line (2)    +5 error column      +6 LDTND after src_load
;   +7 lines (2)         +9 src_len (2)       +11 Fletcher s1, +12 s2
;   +13 flag: OK -> both passes identical; error -> next_line gave EOF
;   +14 src_line_no after the last line (2)
; Mailbox: PASS when every result code matches its expectation and every
; flag is 1; MB_DATA+0 = fixture count, MB_DATA+1/2 = address of results.
; The host checks every other field against values it computes itself.

.setcpu "6502"
.include "../../src/common/c128.inc"
.include "../../src/common/mailbox.inc"
.include "../../src/common/source.inc"

.import mmu_init, mmu_bank0, mmu_shutdown, kcall_inline
.import src_load, src_rewind, src_next_line
.import src_line, src_line_len, src_line_no, src_len
.import src_err_line, src_err_col, src_kernal_err, src_dos_code
.import __COMPILER_ZP_PAGE__

REC_SIZE = 16

.segment "LOADADDR"
        .word $1C01

.segment "EXEHDR"
        .word basic_end
        .word 10
        .byte $9E
        .byte "7181"
        .byte $00
basic_end:
        .word $0000

.segment "MAILBOX"
        .res MB_SIZE

.segment "ZEROPAGE"
fx_ptr:         .res 2             ; current fixture table entry
rec_ptr:        .res 2             ; current result record

.segment "STARTUP"
.export test_entry, results
test_entry:
        php
        sei
        ldx #MB_SIZE - 1
        lda #$00
@clr:   sta MB_BASE,x
        dex
        bpl @clr
        lda #MB_MAGIC0_VALUE
        sta MB_MAGIC0
        lda #MB_MAGIC1_VALUE
        sta MB_MAGIC1
        lda #MB_PROD_PLATFORM
        sta MB_PRODUCER
        lda #MB_ST_RUNNING
        sta MB_STATUS

        jsr mmu_init
        jsr mmu_bank0

        lda #$00
        sta failures
        sta fx_index
        lda #<fixtures
        sta fx_ptr
        lda #>fixtures
        sta fx_ptr+1
        lda #<results
        sta rec_ptr
        lda #>results
        sta rec_ptr+1

@next:  ldy #0                     ; entry: name lo, name hi, length, expected
        lda (fx_ptr),y
        sta name_lo
        iny
        lda (fx_ptr),y
        sta name_hi
        iny
        lda (fx_ptr),y
        sta name_len
        iny
        lda (fx_ptr),y
        sta expected
        jsr run_fixture
        clc
        lda fx_ptr
        adc #4
        sta fx_ptr
        bcc :+
        inc fx_ptr+1
:       clc
        lda rec_ptr
        adc #REC_SIZE
        sta rec_ptr
        bcc :+
        inc rec_ptr+1
:       inc fx_index
        lda fx_index
        cmp #FIXTURE_COUNT
        bne @next

        jsr mmu_shutdown
        lda #FIXTURE_COUNT
        sta MB_DATA+0
        lda #<results
        sta MB_DATA+1
        lda #>results
        sta MB_DATA+2
        lda failures
        sta MB_CODE
        ldy #ok_msg - messages
        lda failures
        bne @fail
        lda #MB_ST_PASS
        bne @report
@fail:  ldy #fail_msg - messages
        lda #MB_ST_FAIL
@report:
        sta MB_STATUS
        plp
@print: lda messages,y
        beq @end
        sty print_y
        jsr CHROUT
        ldy print_y
        iny
        bne @print
@end:   rts

.segment "CODE"

; Load one fixture and fill its record (rec_ptr).
run_fixture:
        ldx #REC_SIZE - 1
        lda #$00
@zero:  sta record,x
        dex
        bpl @zero

        jsr show_name
        lda name_lo
        ldx name_hi
        ldy name_len
        jsr src_load
        sta record+0
        lda src_dos_code
        sta record+1
        lda src_kernal_err
        sta record+2
        lda src_err_line
        sta record+3
        lda src_err_line+1
        sta record+4
        lda src_err_col
        sta record+5
        lda __COMPILER_ZP_PAGE__ * 256 + LDTND   ; system ZP via the swap
        sta record+6
        lda src_len
        sta record+9
        lda src_len+1
        sta record+10

        lda record+0
        bne @failed
        jsr replay                 ; pass A
        lda count
        sta record+7
        lda count+1
        sta record+8
        lda s1
        sta record+11
        lda s2
        sta record+12
        lda src_line_no
        sta record+14
        lda src_line_no+1
        sta record+15
        jsr replay                 ; pass B must match exactly
        lda count
        cmp record+7
        bne @check
        lda count+1
        cmp record+8
        bne @check
        lda s1
        cmp record+11
        bne @check
        lda s2
        cmp record+12
        bne @check
        inc record+13
        bne @check
@failed:
        jsr src_rewind             ; nothing may be delivered after a failure
        jsr src_next_line
        bcc @check
        inc record+13

@check: lda record+0
        cmp expected
        bne @bad
        lda record+13
        cmp #$01
        beq @store
@bad:   inc failures
@store: ldy #REC_SIZE - 1
@copy:  lda record,y
        sta (rec_ptr),y
        dey
        bpl @copy
        lda record+0
        ora #'0'
        jsr kcall_inline
        .word CHROUT
        lda #$0D
        jsr kcall_inline
        .word CHROUT
        rts

; One pass over the source: count lines, Fletcher-16 over line bytes + $0D.
replay: lda #$00
        sta count
        sta count+1
        sta s1
        sta s2
        jsr src_rewind
@line:  jsr src_next_line
        bcs @done
        inc count
        bne :+
        inc count+1
:       ldy #$00
@byte:  cpy src_line_len
        beq @eol
        lda src_line,y
        jsr fletcher
        iny
        bne @byte
@eol:   lda #SRC_EOL
        jsr fletcher
        jmp @line
@done:  rts

; s1 = (s1 + A) mod 255; s2 = (s2 + s1) mod 255. Preserves Y.
fletcher:
        clc
        adc s1
        adc #$00                   ; end-around carry: 256 = 1 (mod 255)
        cmp #$FF
        bne :+
        lda #$00
:       sta s1
        clc
        adc s2
        adc #$00
        cmp #$FF
        bne :+
        lda #$00
:       sta s2
        rts

show_name:
        ldy #$00
@ch:    cpy name_len
        beq @sp
        lda name_lo
        sta @rd+1
        lda name_hi
        sta @rd+2
@rd:    lda $FFFF,y                ; patched
        sty print_y
        jsr kcall_inline
        .word CHROUT
        ldy print_y
        iny
        bne @ch
@sp:    lda #' '
        jsr kcall_inline
        .word CHROUT
        rts

.segment "RODATA"
; name address, name length, expected result code
fixtures:
        .word f_decls
        .byte f_decls_end - f_decls, SRC_OK
        .word f_nofinal
        .byte f_nofinal_end - f_nofinal, SRC_OK
        .word f_edge
        .byte f_edge_end - f_edge, SRC_OK
        .word f_longln
        .byte f_longln_end - f_longln, SRC_ERR_LINE_TOO_LONG
        .word f_manyln
        .byte f_manyln_end - f_manyln, SRC_ERR_TOO_MANY_LINES
        .word f_big
        .byte f_big_end - f_big, SRC_ERR_FILE_TOO_LARGE
        .word f_missing
        .byte f_missing_end - f_missing, SRC_ERR_DISK
        .word f_decls
        .byte f_decls_end - f_decls, SRC_OK     ; again, after failures
FIXTURE_COUNT = (* - fixtures) / 4

; Unshifted PETSCII letters ($41-$5A) are what c1541 stores for lowercase.
f_decls:   .byte "DECLS.N8"
f_decls_end:
f_nofinal: .byte "NOFINAL.N8"
f_nofinal_end:
f_edge:    .byte "EDGE.N8"
f_edge_end:
f_longln:  .byte "LONGLN.N8"
f_longln_end:
f_manyln:  .byte "MANYLN.N8"
f_manyln_end:
f_big:     .byte "BIG.N8"
f_big_end:
f_missing: .byte "MISSING.N8"
f_missing_end:

messages:
ok_msg:    .byte "NOVA128 SOURCE TEST OK", $0D, $00
fail_msg:  .byte "NOVA128 SOURCE TEST FAIL", $0D, $00

.segment "BSS"
results:        .res REC_SIZE * FIXTURE_COUNT
record:         .res REC_SIZE
failures:       .res 1
fx_index:       .res 1
name_lo:        .res 1
name_hi:        .res 1
name_len:       .res 1
expected:       .res 1
count:          .res 2
s1:             .res 1
s2:             .res 1
print_y:        .res 1