C64-dev/newLang/tests/runtime/dispatch-test.s

; E06-S02: indirect-call trampoline fixture in x128.
;
; Runs under CR=$0E. It checks:
;   - three targets chosen at runtime from value records dispatch correctly,
;     with A/X results and self = the object pointer;
;   - nested dispatch returns through three levels;
;   - recursive dispatch through 8 levels returns the right count;
;   - SP, software frame, frame arguments, IRQ vectors, and the I/D flags are
;     unchanged across a dispatch;
;   - null, table-less, and zero-entry targets fault without executing
;     anything, and a later dispatch still works;
;   - a full hardware stack is refused with IF_ERR_STACK and recovers after SP
;     is restored;
;   - 12-level recursion stays above FRAME_HW_MIN and restores the frame.
;
; MB_DATA flags 0..6 report the seven phases.

.setcpu "6502"
.include "../../src/common/c128.inc"
.include "../../src/common/mailbox.inc"
.include "../../src/common/print.inc"
.include "../../src/common/frames.inc"
.include "../../src/common/interfaces.inc"

.import pr_char, pr_cr, pr_text
.import frame_init, frame_enter, frame_leave, frame_push_byte, frame_discard
.import if_call
.import if_error

.macro TEXT src, len
        lda #<src
        ldx #>src
        ldy #len
        jsr pr_text
.endmacro

.macro PHASE n
        lda #n
        sta MB_CODE
        lda #$00
        sta MB_CODE+1
.endmacro

.macro FAIL_CS
        bcc :+
        jmp @fail
:
.endmacro

.macro FAIL_CC
        bcs :+
        jmp @fail
:
.endmacro

.macro FAIL_NE
        beq :+
        jmp @fail
:
.endmacro

.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"
vp:     .res 2
pv:     .res 2

.segment "STARTUP"
.export test_entry, test_end
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_PROGRAM
        sta MB_PRODUCER
        lda #MB_ST_RUNNING
        sta MB_STATUS
        lda #$00
        sta MB_CODE
        sta MB_CODE+1

        lda MMU_CR
        sta saved_cr
        lda #CR_RAM0_KERNAL
        sta MMU_CR
        lda #PR_CLEAR
        jsr pr_char
        TEXT title, 21
        jsr pr_cr

        ; 1: three targets selected at runtime, self and A/X checked.
        PHASE 1
        lda #$00
        sta idx
        sta impl_calls
        sta impl_self_bad
        tsx
        stx sp_before
@pick:  lda idx
        asl a
        asl a
        clc
        adc #<vals
        sta vp
        lda #>vals
        adc #$00
        sta vp+1
        lda vp
        ldx vp+1
        ldy #$00
        jsr if_call
        sta result_a
        stx result_x
        lda if_error
        FAIL_NE
        tsx
        txa
        cmp sp_before
        FAIL_NE
        lda idx
        tay
        lda result_a
        cmp exp_ids,y
        FAIL_NE
        lda exp_ids,y
        clc
        adc #$01
        cmp result_x
        FAIL_NE
        inc idx
        lda idx
        cmp #$03
        bne @pick
        lda impl_calls
        cmp #$03
        FAIL_NE
        lda impl_self_bad
        FAIL_NE
        lda #$01
        sta MB_DATA+0

        ; 2: three-level nested dispatch.
        PHASE 2
        lda #<val_one
        ldx #>val_one
        ldy #$00
        jsr if_call
        sta result_a
        stx result_x
        lda if_error
        FAIL_NE
        lda result_a
        cmp #$33
        FAIL_NE
        lda result_x
        cmp #$31
        FAIL_NE
        lda #$01
        sta MB_DATA+1

        ; 3: recursive dispatch through 8 levels.
        PHASE 3
        jsr frame_init
        lda #$FF
        sta rec_min_sp
        lda #$00
        sta rec_entries
        lda #$08
        jsr frame_push_byte
        FAIL_CS
        lda #<val_rec
        ldx #>val_rec
        ldy #$00
        jsr if_call
        sta result_a
        lda if_error
        FAIL_NE
        lda #$01
        ldx #$00
        jsr frame_discard
        lda result_a
        cmp #$08
        FAIL_NE
        lda rec_entries
        cmp #$09
        FAIL_NE
        lda FRAME_SP
        cmp #<FRAME_STACK_TOP
        FAIL_NE
        lda FRAME_SP+1
        cmp #>FRAME_STACK_TOP
        FAIL_NE
        lda #$01
        sta MB_DATA+2

        ; 4: SP, frame, arguments, vectors, and I/D survive a dispatch.
        PHASE 4
        php
        pla
        sta p_before
        lda $0314
        sta v_before
        lda $0315
        sta v_before+1
        lda #$AB
        jsr frame_push_byte
        FAIL_CS
        lda #$CD
        jsr frame_push_byte
        FAIL_CS
        tsx
        stx sp_before
        lda FRAME_SP
        sta fsp_before
        lda FRAME_SP+1
        sta fsp_before+1
        lda #<val_a
        ldx #>val_a
        ldy #$00
        jsr if_call
        sta result_a
        stx result_x
        lda if_error
        FAIL_NE
        lda result_a
        cmp #$A0
        FAIL_NE
        lda result_x
        cmp #$A1
        FAIL_NE
        tsx
        txa
        cmp sp_before
        FAIL_NE
        lda FRAME_SP
        cmp fsp_before
        FAIL_NE
        lda FRAME_SP+1
        cmp fsp_before+1
        FAIL_NE
        lda FRAME_SP
        sta pv
        lda FRAME_SP+1
        sta pv+1
        ldy #$00
        lda (pv),y
        cmp #$CD
        FAIL_NE
        iny
        lda (pv),y
        cmp #$AB
        FAIL_NE
        lda $0314
        cmp v_before
        FAIL_NE
        lda $0315
        cmp v_before+1
        FAIL_NE
        php
        pla
        and #$0C
        sta p_after
        lda p_before
        and #$0C
        cmp p_after
        FAIL_NE
        lda #$02
        ldx #$00
        jsr frame_discard
        lda FRAME_SP
        cmp #<FRAME_STACK_TOP
        FAIL_NE
        lda FRAME_SP+1
        cmp #>FRAME_STACK_TOP
        FAIL_NE
        lda #$01
        sta MB_DATA+3

        ; 5: faults never execute a target, and dispatch recovers.
        PHASE 5
        lda impl_calls
        sta calls_before
        tsx
        stx sp_before
        lda #<val_null
        ldx #>val_null
        ldy #$00
        jsr if_call
        FAIL_CC
        sta result_a
        stx result_x
        lda if_error
        cmp #IF_ERR_NULL
        FAIL_NE
        lda result_a
        FAIL_NE
        lda result_x
        FAIL_NE
        tsx
        txa
        cmp sp_before
        FAIL_NE

        lda #<val_notable
        ldx #>val_notable
        ldy #$00
        jsr if_call
        FAIL_CC
        sta result_a
        stx result_x
        lda if_error
        cmp #IF_ERR_TABLE
        FAIL_NE
        lda result_a
        FAIL_NE
        lda result_x
        FAIL_NE
        tsx
        txa
        cmp sp_before
        FAIL_NE

        lda #<val_zero
        ldx #>val_zero
        ldy #$00
        jsr if_call
        FAIL_CC
        sta result_a
        stx result_x
        lda if_error
        cmp #IF_ERR_ENTRY
        FAIL_NE
        lda result_a
        FAIL_NE
        lda result_x
        FAIL_NE
        lda impl_calls
        cmp calls_before
        FAIL_NE

        lda #<val_a
        ldx #>val_a
        ldy #$00
        jsr if_call
        sta result_a
        lda if_error
        FAIL_NE
        lda result_a
        cmp #$A0
        FAIL_NE
        lda #$01
        sta MB_DATA+4

        ; 6: a full hardware stack is refused, then SP is restored.
        PHASE 6
        tsx
        stx sp_saved
@fill:  lda #$00
        pha
        tsx
        cpx #(FRAME_HW_MIN - 1)
        bne @fill
        lda #<val_a
        ldx #>val_a
        ldy #$00
        jsr if_call
        FAIL_CC
        sta result_a
        stx result_x
        lda if_error
        cmp #IF_ERR_STACK
        FAIL_NE
        lda result_a
        FAIL_NE
        lda result_x
        FAIL_NE
        ldx sp_saved
        txs
        tsx
        cpx sp_saved
        FAIL_NE
        lda #<val_a
        ldx #>val_a
        ldy #$00
        jsr if_call
        sta result_a
        lda if_error
        FAIL_NE
        lda result_a
        cmp #$A0
        FAIL_NE
        lda #$01
        sta MB_DATA+5

        ; 7: 12-level recursion stays above the stack floor.
        PHASE 7
        lda #$FF
        sta rec_min_sp
        lda #$00
        sta rec_entries
        lda #$0C
        jsr frame_push_byte
        FAIL_CS
        lda #<val_rec
        ldx #>val_rec
        ldy #$00
        jsr if_call
        sta result_a
        lda if_error
        FAIL_NE
        lda #$01
        ldx #$00
        jsr frame_discard
        lda result_a
        cmp #$0C
        FAIL_NE
        lda rec_entries
        cmp #$0D
        FAIL_NE
        lda rec_min_sp
        cmp #FRAME_HW_MIN
        FAIL_CC
        lda FRAME_SP
        cmp #<FRAME_STACK_TOP
        FAIL_NE
        lda FRAME_SP+1
        cmp #>FRAME_STACK_TOP
        FAIL_NE
        lda #$01
        sta MB_DATA+6

        TEXT dispatch_ok, 11
        jsr pr_cr
        lda #MB_ST_PASS
        sta MB_STATUS
        lda #$00
        sta MB_CODE
        sta MB_CODE+1
        jmp @restore

@fail:
        lda #MB_ST_FAIL
        sta MB_STATUS
        TEXT dispatch_fail, 13
        jsr pr_cr
@restore:
        lda saved_cr
        sta MMU_CR
        plp
        rts

; Three runtime-selected targets. Each checks that A/X is its object pointer,
; then returns an id pair ($?0/$?1).
impl_a:
        cmp #$11
        bne @bad
        cpx #$11
        beq @ok
@bad:   inc impl_self_bad
@ok:    inc impl_calls
        lda #$A0
        ldx #$A1
        rts

impl_b:
        cmp #$22
        bne @bad
        cpx #$22
        beq @ok
@bad:   inc impl_self_bad
@ok:    inc impl_calls
        lda #$B0
        ldx #$B1
        rts

impl_c:
        cmp #$33
        bne @bad
        cpx #$33
        beq @ok
@bad:   inc impl_self_bad
@ok:    inc impl_calls
        lda #$C0
        ldx #$C1
        rts

; Nested chain: one -> two -> three, each level adding its own offset.
impl_three:
        inc impl_calls
        lda #$30
        ldx #$31
        rts

impl_two:
        inc impl_calls
        lda #<val_three
        ldx #>val_three
        ldy #$00
        jsr if_call
        sta child
        lda if_error
        bne @err
        lda child
        clc
        adc #$02
        rts
@err:   lda #$00
        ldx #$00
        sec
        rts

impl_one:
        inc impl_calls
        lda #<val_two
        ldx #>val_two
        ldy #$00
        jsr if_call
        sta child
        lda if_error
        bne @err
        lda child
        clc
        adc #$01
        rts
@err:   lda #$00
        ldx #$00
        sec
        rts

; Recursive target: A/X = self, depth arrives at FP+2. Returns depth in A, X=0.
impl_rec:
        lda #$00
        ldx #$00
        jsr frame_enter
        bcc @in
        sec
        rts
@in:    inc rec_entries
        tsx
        cpx rec_min_sp
        bcs :+
        stx rec_min_sp
:       ldy #$02
        lda (FRAME_FP),y
        beq @zero
        sec
        sbc #$01
        jsr frame_push_byte
        bcs @bad_stack
        lda #<val_rec
        ldx #>val_rec
        ldy #$00
        jsr if_call
        sta child
        lda if_error
        bne @bad_nested
        lda #$01
        ldx #$00
        jsr frame_discard
        lda child
        clc
        adc #$01
        sta child
        jsr frame_leave
        lda child
        ldx #$00
        clc
        rts
@zero:  jsr frame_leave
        lda #$00
        ldx #$00
        clc
        rts
@bad_stack:
        jsr frame_leave
        sec
        rts
@bad_nested:
        lda #$01
        ldx #$00
        jsr frame_discard
        jsr frame_leave
        sec
        rts

.segment "DATA"
vals:           .word $1111, tab_a
                .word $2222, tab_b
                .word $3333, tab_c
.assert * - vals = 12, error, "three value records"
exp_ids:        .byte $A0, $B0, $C0
tab_a:          .word impl_a
tab_b:          .word impl_b
tab_c:          .word impl_c
val_a:          .word $1111, tab_a
val_one:        .word $4444, tab_one
tab_one:        .word impl_one
val_two:        .word $5555, tab_two
tab_two:        .word impl_two
val_three:      .word $6666, tab_three
tab_three:      .word impl_three
val_rec:        .word $7777, tab_rec
tab_rec:        .word impl_rec
val_null:       .word $0000, $0000
val_notable:    .word $1111, $0000
tab_zero:       .word $0000
.assert * - tab_zero = IF_SLOT_SIZE, error, "one slot per table"
val_zero:       .word $2222, tab_zero

.segment "RODATA"
title:          .byte "NOVA128 DISPATCH TEST"
dispatch_ok:    .byte "DISPATCH OK"
dispatch_fail:  .byte "DISPATCH FAIL"

.segment "BSS"
saved_cr:       .res 1
idx:            .res 1
impl_calls:     .res 1
impl_self_bad:  .res 1
result_a:       .res 1
result_x:       .res 1
sp_before:      .res 1
sp_saved:       .res 1
p_before:       .res 1
p_after:        .res 1
fsp_before:     .res 2
v_before:       .res 2
calls_before:   .res 1
child:          .res 1
rec_min_sp:     .res 1
rec_entries:    .res 1
test_end: