; E06-S05: interface method call fixture in x128. ; ; Runs under CR=$0E on the E06-S01 value ABI, the E06-S02 trampoline, the ; E06-S03 table shape, and the E06-S04 conversion API. It checks: ; - two classes dispatch the same interface slot to different methods, and ; self is the underlying object ($1111 / $2222), not the value record; ; - one class dispatches through two of its interface tables, so the same ; object reaches different methods by table pointer alone; ; - a callee can itself make an interface call and pass on a one-byte result; ; - a byte argument and a two-byte argument arrive at FP+2..FP+4, a two-byte ; result comes back in A/X, and the caller's frame stack is restored. ; ; The slots are the compile-time interface slots (resolved by the compiler's ; iface_slot in the table fixture); the table pointer is read at run time from ; the value, which is what lets one call site reach two classes. ; ; MB_DATA flags 0..3 report the four 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_push_word, frame_discard .import if_call, 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_NE beq :+ jmp @fail : .endmacro ; A/X = self. A method whose self is not its class's object counts the miss ; and returns failure instead of reporting a result. .macro SELF_IS lo, hi cmp #lo bne @selfbad cpx #hi beq @selfok @selfbad: inc self_bad lda #$00 ldx #$00 rts @selfok: .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 "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 sta self_bad sta a_calls sta b_calls sta leaf_calls ldx #$03 @flags: sta MB_DATA,x dex bpl @flags lda MMU_CR sta saved_cr lda #CR_RAM0_KERNAL sta MMU_CR lda #PR_CLEAR jsr pr_char TEXT title, title_len jsr pr_cr ; 1: one call site, two classes, two methods. PHASE 1 lda #val_a_foo ldy #0 jsr if_call sta result_a lda if_error FAIL_NE lda result_a cmp #$A0 FAIL_NE lda a_calls cmp #1 FAIL_NE lda #val_b_foo ldy #0 jsr if_call sta result_a lda if_error FAIL_NE lda result_a cmp #$B0 FAIL_NE lda b_calls cmp #1 FAIL_NE lda self_bad FAIL_NE lda #$01 sta MB_DATA+0 ; 2: one class, two interface tables, different methods. PHASE 2 lda #val_a_bar ldy #0 jsr if_call sta result_a lda if_error FAIL_NE lda result_a cmp #$C0 FAIL_NE lda a_calls cmp #2 FAIL_NE lda self_bad FAIL_NE lda #$01 sta MB_DATA+1 ; 3: an interface call inside a method, one-byte result passed on. PHASE 3 lda #val_a_foo ldy #1 jsr if_call sta result_a lda if_error FAIL_NE lda result_a cmp #$5B FAIL_NE lda a_calls cmp #3 FAIL_NE lda leaf_calls cmp #1 FAIL_NE lda self_bad FAIL_NE lda #$01 sta MB_DATA+2 ; 4: arguments and a two-byte result through an interface call. PHASE 4 jsr frame_init lda #$34 ldx #$12 jsr frame_push_word ; arg1 = $1234 FAIL_CS lda #$07 jsr frame_push_byte ; arg0 = 7 FAIL_CS lda #val_a_foo ldy #2 jsr if_call sta result_a stx result_x lda if_error FAIL_NE lda #$03 ldx #$00 jsr frame_discard lda result_a cmp #$3B ; $1234 + 7 FAIL_NE lda result_x cmp #$12 FAIL_NE lda FRAME_SP cmp #FRAME_STACK_TOP FAIL_NE lda a_calls cmp #4 FAIL_NE lda self_bad FAIL_NE lda #$01 sta MB_DATA+3 TEXT ok_msg, ok_len 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 fail_msg, fail_len jsr pr_cr @restore: lda saved_cr sta MMU_CR plp rts .segment "CODE" ; IFOO slot 0 of class A: byte result, self checked. m_a0: SELF_IS $11, $11 inc a_calls lda #$A0 ldx #$00 rts ; IFOO slot 1 of class A: calls leaf through val_leaf and adds one. m_a1: SELF_IS $11, $11 inc a_calls lda #val_leaf ldy #$00 jsr if_call sta child stx child_x lda if_error bne @bad lda child clc adc #$01 ldx #$00 rts @bad: inc self_bad lda #$00 ldx #$00 rts ; IFOO slot 2 of class A: (byte, word) -> word sum. m_addw: SELF_IS $11, $11 inc a_calls lda #$00 ldx #$00 jsr frame_enter bcs @bad ldy #$02 lda (FRAME_FP),y sta tmp iny lda (FRAME_FP),y clc adc tmp sta res_lo iny lda (FRAME_FP),y adc #$00 sta res_hi jsr frame_leave lda res_lo ldx res_hi clc rts @bad: lda #$00 ldx #$00 sec rts ; IBAR slot 0 of class A: a different method for the same object. m_abar: SELF_IS $11, $11 inc a_calls lda #$C0 ldx #$00 rts ; IFOO slot 0 of class B. m_b0: SELF_IS $22, $22 inc b_calls lda #$B0 ldx #$00 rts ; Target of the nested call. m_leaf: inc leaf_calls lda #$5A ldx #$00 rts .segment "DATA" ; Object pointers are only identities here; the methods compare them. val_a_foo: .word $1111, tab_a_foo val_a_bar: .word $1111, tab_a_bar val_b_foo: .word $2222, tab_b_foo val_leaf: .word $9999, tab_leaf tab_a_foo: .word m_a0, m_a1, m_addw tab_a_bar: .word m_abar tab_b_foo: .word m_b0 tab_leaf: .word m_leaf .assert tab_a_bar - tab_a_foo = 3 * IF_SLOT_SIZE, error, "IFOO table size" .assert tab_b_foo - tab_a_bar = 1 * IF_SLOT_SIZE, error, "IBAR table size" .segment "RODATA" title: .byte "NOVA128 IFCALL TEST" title_len = * - title ok_msg: .byte "IFCALL OK" ok_len = * - ok_msg fail_msg: .byte "IFCALL FAIL" fail_len = * - fail_msg .segment "BSS" saved_cr: .res 1 a_calls: .res 1 b_calls: .res 1 leaf_calls: .res 1 self_bad: .res 1 result_a: .res 1 result_x: .res 1 child: .res 1 child_x: .res 1 tmp: .res 1 res_lo: .res 1 res_hi: .res 1 test_end: