C64-dev/newLang/tests/codegen/member-test.s

; E05-S04: fields, self, and concrete calls in x128.
;
; members.s emits method-body fragments; this fixture generates several and
; executes them against two objects of the same class layout (descriptor word
; at +0, byte field at +2, word field at +3..4):
;
;   1. a field writer storing the immediates in gen_count/gen_lo/gen_hi,
;      run on both objects, then read back through emitted byte and word
;      loaders, which proves offsets and independent state;
;   2. a caller that loads a receiver reference with mb_point, pushes arguments
;      on the frame stack, and calls a real method with self in A/X, which
;      proves the direct-JSR call ABI and argument discard;
;   3. the same caller shape with a word result, stored by the call site.
;
; Mailbox data:
;   +0  field store/load offsets verified (1)
;   +1  the two objects kept independent state (1)
;   +2  concrete call ABI and argument discard verified (1)
;   +3  word result preserved across the call path (1)
;   +4  word result low byte ($78)
;   +5  word result high byte ($56)
; Failure bits: 1 emitter, 2 store/offset, 4 independence, 8 call ABI,
; 16 result.

.setcpu "6502"
.include "../../src/common/c128.inc"
.include "../../src/common/mailbox.inc"
.include "../../src/common/print.inc"
.include "../../src/common/codegen.inc"
.include "../../src/common/flow.inc"
.include "../../src/common/frames.inc"
.include "../../src/common/members.inc"

.import cg_init, cg_err, cg_code, cg_rts
.import cg_lda_imm, cg_ldx_imm, cg_jsr_abs, cg_sta_abs, cg_stx_abs
.import fl_err, fl_enter, fl_leave, fl_discard
.import mb_init, mb_point, mb_self_load, mb_self_store
.import mb_ld_field, mb_st_field, mb_call, mb_call_word
.import mb_err
.import frame_init, frame_enter, frame_leave, frame_discard, frame_push_byte, frame_push_word
.import pr_char, pr_text, pr_cr

COUNT_OFF       = 2             ; byte field
TOTAL_OFF       = 3             ; word field
OBJ_SIZE        = 5

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

; Branch to a global label even when it is out of relative range.
.macro ON_CARRY target
        bcc :+
        jmp target
:
.endmacro

.macro ON_NE target
        beq :+
        jmp target
:
.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"
set_ptr:        .res 2             ; receiver for the hand-written methods

.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

        jsr clear_state
        jsr frame_init
        jsr mb_init

        ; Runtime addresses the emitted prologue and call helpers need.
        lda #<frame_enter
        sta fl_enter
        lda #>frame_enter
        sta fl_enter+1
        lda #<frame_leave
        sta fl_leave
        lda #>frame_leave
        sta fl_leave+1
        lda #<frame_discard
        sta fl_discard
        lda #>frame_discard
        sta fl_discard+1

        ; ---------------------------------------- 1. field store on both objects
        lda #3
        sta gen_count
        lda #$34
        sta gen_lo
        lda #$12
        sta gen_hi
        jsr cg_init
        jsr gen_store
        ON_CARRY emitter_error
        jsr run_a

        lda obj_a+COUNT_OFF
        cmp #3
        ON_NE store_fail
        lda obj_a+TOTAL_OFF
        cmp #$34
        ON_NE store_fail
        lda obj_a+TOTAL_OFF+1
        cmp #$12
        ON_NE store_fail

        lda #7
        sta gen_count
        lda #$78
        sta gen_lo
        lda #$56
        sta gen_hi
        jsr cg_init
        jsr gen_store
        ON_CARRY emitter_error
        jsr run_b

        lda obj_b+COUNT_OFF
        cmp #7
        ON_NE store_fail
        lda obj_b+TOTAL_OFF
        cmp #$78
        ON_NE store_fail
        lda obj_b+TOTAL_OFF+1
        cmp #$56
        ON_NE store_fail

        ; A must be untouched by writing B.
        lda obj_a+COUNT_OFF
        cmp #3
        ON_NE indep_fail
        lda obj_a+TOTAL_OFF
        cmp #$34
        ON_NE indep_fail
        lda obj_a+TOTAL_OFF+1
        cmp #$12
        ON_NE indep_fail

        ; ------------------------------------- field loads through the emitter
        jsr cg_init
        jsr gen_read_count
        ON_CARRY emitter_error
        jsr run_a
        sta v_count_a
        jsr run_b
        sta v_count_b
        lda v_count_a
        cmp #3
        ON_NE store_fail
        lda v_count_b
        cmp #7
        ON_NE indep_fail

        jsr cg_init
        jsr gen_read_total
        ON_CARRY emitter_error
        jsr run_a
        sta v_lo_a
        stx v_hi_a
        jsr run_b
        sta v_lo_b
        stx v_hi_b
        lda v_lo_a
        cmp #$34
        ON_NE store_fail
        lda v_hi_a
        cmp #$12
        ON_NE store_fail
        lda v_lo_b
        cmp #$78
        ON_NE indep_fail
        lda v_hi_b
        cmp #$56
        ON_NE indep_fail

        lda #$01
        sta MB_DATA+0
        sta MB_DATA+1

        ; ------------------------------- 2. concrete call with arguments
        lda FRAME_SP
        sta sp_before
        lda FRAME_SP+1
        sta sp_before+1

        lda #<ref_a
        sta call_ref
        lda #>ref_a
        sta call_ref+1
        lda #9
        sta call_count
        lda #$CD
        sta call_lo
        lda #$AB
        sta call_hi

        jsr cg_init
        jsr gen_call_set
        ON_CARRY emitter_error
        lda #$00
        jsr run_plain

        lda obj_a+COUNT_OFF
        cmp #9
        ON_NE call_fail
        lda obj_a+TOTAL_OFF
        cmp #$CD
        ON_NE call_fail
        lda obj_a+TOTAL_OFF+1
        cmp #$AB
        ON_NE call_fail
        lda FRAME_SP
        cmp sp_before
        ON_NE call_fail
        lda FRAME_SP+1
        cmp sp_before+1
        ON_NE call_fail
        lda obj_b+COUNT_OFF            ; B was not the receiver
        cmp #7
        ON_NE call_fail

        lda #$01
        sta MB_DATA+2

        ; ------------------------------------- 3. word result at the call site
        lda #<ref_b
        sta call_ref
        lda #>ref_b
        sta call_ref+1
        jsr cg_init
        jsr gen_call_total
        ON_CARRY emitter_error
        lda #$00
        jsr run_plain

        lda res_lo
        sta MB_DATA+4
        lda res_hi
        sta MB_DATA+5
        lda res_lo
        cmp #$78
        ON_NE result_fail
        lda res_hi
        cmp #$56
        ON_NE result_fail
        lda #$01
        sta MB_DATA+3
        jmp report

emitter_error:
        lda #$01
        jmp fail
store_fail:
        lda #$02
        jmp fail
indep_fail:
        lda #$04
        jmp fail
call_fail:
        lda #$08
        jmp fail
result_fail:
        lda #$10
        jmp fail
fail:
        ora fail_mask
        sta fail_mask

report:
        lda saved_cr
        sta MMU_CR
        lda fail_mask
        sta MB_CODE
        lda #$00
        sta MB_CODE+1
        ldx fail_mask
        bne @fail
        lda #MB_ST_PASS
        sta MB_STATUS
        TEXT msg_ok, 9
        jmp @end
@fail:
        lda #MB_ST_FAIL
        sta MB_STATUS
        TEXT msg_fail, 11
@end:   jsr pr_cr
        plp
        rts

; ------------------------------------------------------------- state
clear_state:
        lda #$00
        sta fail_mask
        sta res_lo
        sta res_hi
        sta v_count_a
        sta v_count_b
        ldx #OBJ_SIZE - 1
@a:     sta obj_a,x
        dex
        bpl @a
        ldx #OBJ_SIZE - 1
@b:     sta obj_b,x
        dex
        bpl @b
        sta obj_a+0                    ; descriptor words stay zero here: these
        sta obj_b+0                    ; fixtures exercise fields, not classes
        lda #<obj_a
        sta ref_a
        lda #>obj_a
        sta ref_a+1
        lda #<obj_b
        sta ref_b
        lda #>obj_b
        sta ref_b+1
        rts

; --------------------------------------------------------- generators
; store self.count = gen_count; self.total = gen_hi:gen_lo
gen_store:
        jsr mb_self_store
        ON_CARRY gen_out
        lda gen_count
        jsr cg_lda_imm
        ON_CARRY gen_out
        lda #COUNT_OFF
        ldx #MB_BYTE
        jsr mb_st_field
        ON_CARRY gen_out
        lda gen_lo
        jsr cg_lda_imm
        ON_CARRY gen_out
        lda gen_hi
        jsr cg_ldx_imm
        ON_CARRY gen_out
        lda #TOTAL_OFF
        ldx #MB_WORD
        jsr mb_st_field
        ON_CARRY gen_out
        jmp cg_rts
gen_out:
        sec
        rts

; return self.count
gen_read_count:
        jsr mb_self_store
        ON_CARRY gen_out
        lda #COUNT_OFF
        ldx #MB_BYTE
        jsr mb_ld_field
        ON_CARRY gen_out
        jmp cg_rts

; return self.total
gen_read_total:
        jsr mb_self_store
        ON_CARRY gen_out
        lda #TOTAL_OFF
        ldx #MB_WORD
        jsr mb_ld_field
        ON_CARRY gen_out
        jmp cg_rts

; receiver = *call_ref; push(word call_hi:call_lo); push(byte call_count);
; call setter(3 bytes). Demonstrates the caller ABI from generated code.
gen_call_set:
        lda call_ref
        ldx call_ref+1
        jsr mb_point
        ON_CARRY gen_out
        lda call_lo
        jsr cg_lda_imm
        ON_CARRY gen_out
        lda call_hi
        jsr cg_ldx_imm
        ON_CARRY gen_out
        lda #<frame_push_word
        ldx #>frame_push_word
        jsr cg_jsr_abs
        ON_CARRY gen_out
        lda call_count
        jsr cg_lda_imm
        ON_CARRY gen_out
        lda #<frame_push_byte
        ldx #>frame_push_byte
        jsr cg_jsr_abs
        ON_CARRY gen_out
        lda #<setter
        ldx #>setter
        ldy #3
        jsr mb_call
        ON_CARRY gen_out
        jmp cg_rts

; receiver = *call_ref; result = total(). The call site stores A/X, so the
; word result has to survive the call epilogue.
gen_call_total:
        lda call_ref
        ldx call_ref+1
        jsr mb_point
        ON_CARRY gen_out
        lda #<total_of
        ldx #>total_of
        ldy #0
        jsr mb_call_word
        ON_CARRY gen_out
        lda #<res_lo
        ldx #>res_lo
        jsr cg_sta_abs
        ON_CARRY gen_out
        lda #<res_hi
        ldx #>res_hi
        jsr cg_stx_abs
        ON_CARRY gen_out
        jmp cg_rts

; ------------------------------------------------------------ methods
; set(count as byte, total as word): self in A/X.
setter:
        sta cur_self
        stx cur_self+1
        lda #$00
        ldx #$00
        jsr frame_enter
        bcs @fault
        lda cur_self
        sta set_ptr
        lda cur_self+1
        sta set_ptr+1
        ldy #2
        lda (FRAME_FP),y
        ldy #COUNT_OFF
        sta (set_ptr),y
        ldy #3
        lda (FRAME_FP),y
        ldy #TOTAL_OFF
        sta (set_ptr),y
        ldy #4
        lda (FRAME_FP),y
        ldy #TOTAL_OFF+1
        sta (set_ptr),y
        jsr frame_leave
        clc
        rts
@fault: sec
        rts

; total() as word: A = low, X = high.
total_of:
        sta cur_self
        stx cur_self+1
        lda #$00
        ldx #$00
        jsr frame_enter
        bcs @fault
        lda cur_self
        sta set_ptr
        lda cur_self+1
        sta set_ptr+1
        ldy #TOTAL_OFF
        lda (set_ptr),y
        pha
        ldy #TOTAL_OFF+1
        lda (set_ptr),y
        tax
        pla
        pha
        txa
        pha
        jsr frame_leave
        pla
        tax
        pla
        clc
        rts
@fault: sec
        rts

; ------------------------------------------------------------- runners
; A = code offset; A/X = self for the snippet.
run_self:
        clc
        adc #<cg_code
        sta @target+1
        lda #>cg_code
        adc #$00
        sta @target+2
        lda run_ptr
        ldx run_ptr+1
@target:
        jsr $FFFF
        rts

; A = code offset; no receiver.
run_plain:
        clc
        adc #<cg_code
        sta @target+1
        lda #>cg_code
        adc #$00
        sta @target+2
@target:
        jsr $FFFF
        rts

run_a:
        lda #<obj_a
        sta run_ptr
        lda #>obj_a
        sta run_ptr+1
        lda #$00
        jmp run_self

run_b:
        lda #<obj_b
        sta run_ptr
        lda #>obj_b
        sta run_ptr+1
        lda #$00
        jmp run_self

.segment "RODATA"
msg_ok:         .byte "MEMBER OK"
msg_fail:       .byte "MEMBER FAIL"

.segment "BSS"
saved_cr:       .res 1
fail_mask:      .res 1
gen_count:      .res 1
gen_lo:         .res 1
gen_hi:         .res 1
call_ref:       .res 2
call_count:     .res 1
call_lo:        .res 1
call_hi:        .res 1
run_ptr:        .res 2
sp_before:      .res 2
res_lo:         .res 1
res_hi:         .res 1
v_count_a:      .res 1
v_count_b:      .res 1
v_lo_a:         .res 1
v_hi_a:         .res 1
v_lo_b:         .res 1
v_hi_b:         .res 1
obj_a:          .res OBJ_SIZE
obj_b:          .res OBJ_SIZE
ref_a:          .res 2
ref_b:          .res 2
cur_self:       .res 2
test_end: