; 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 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 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 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 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 #$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 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 #$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 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 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 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 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 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 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 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 #$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 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 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 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: