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

; E04-S03: scalar emitter and arithmetic fixture in x128.
;
; The fixture drives codegen.s directly (parser integration is E04-S04),
; executes the emitted shapes, copies the golden bytes to golden_copy, then
; tests the arithmetic helpers. It runs in the compiler/BASIC mapping; all
; variables and the code buffer are below $A000.
;
; Mailbox data:
;   +0     byte assignment (5A)
;   +1     comparison bit mask (EQ..GE, expected 0E with 5,7)
;   +2/+3  word add ($2221)
;   +4/+5  integer sub ($ECBB)
;   +6     multiply result low ($2EE0 -> E0)
;   +7     arithmetic fault (1 = divide by zero)
; Failure bits: 1 emitter/assignment, 2 add/sub, 4 comparisons,
; 8 short-circuit, 16 multiply, 32 unsigned divide, 64 signed divide,
; 128 divide-by-zero.

.setcpu "6502"
.include "../../src/common/c128.inc"
.include "../../src/common/mailbox.inc"
.include "../../src/common/codegen.inc"
.include "../../src/common/arithmetic.inc"

.import cg_init, cg_len, cg_err, cg_code, cg_here, cg_patch_here
.import cg_lda_imm, cg_ldx_imm, cg_ora_imm
.import cg_lda_abs, cg_ldx_abs, cg_sta_abs, cg_stx_abs
.import cg_adc_abs, cg_sbc_abs, cg_cmp_abs, cg_jsr_abs
.import cg_clc, cg_sec, cg_rts, cg_branch_fwd
.import ar_mul_u16, ar_div_u16, ar_div_i16, ar_a, ar_b, ar_rem, ar_fault

; Fixed bank-0 scratch variables (SCRATCH is unused by this fixture).
V_SRC           = $1B00
V_DST           = $1B01
V_WIDE          = $1B02
V_ADD_A         = $1B04
V_ADD_B         = $1B06
V_ADD_R         = $1B08
V_SUB_A         = $1B0A
V_SUB_B         = $1B0C
V_SUB_R         = $1B0E
V_BYTE_A        = $1B10
V_BYTE_B        = $1B11
V_CMP           = $1B12
V_FLAG          = $1B13
V_EVAL          = $1B14
V_MUL_A         = $1B16
V_MUL_B         = $1B18
V_MUL_R         = $1B1A
V_DIV_A         = $1B1C
V_DIV_B         = $1B1E
V_DIV_R         = $1B20
V_SDIV_A        = $1B22
V_SDIV_B        = $1B24
V_SDIV_R        = $1B26

.macro EMIT_LDA addr
        lda #<(addr)
        ldx #>(addr)
        jsr cg_lda_abs
.endmacro

.macro EMIT_LDX addr
        lda #<(addr)
        ldx #>(addr)
        jsr cg_ldx_abs
.endmacro

.macro EMIT_STA addr
        lda #<(addr)
        ldx #>(addr)
        jsr cg_sta_abs
.endmacro

.macro EMIT_STX addr
        lda #<(addr)
        ldx #>(addr)
        jsr cg_stx_abs
.endmacro

.macro EMIT_ADC addr
        lda #<(addr)
        ldx #>(addr)
        jsr cg_adc_abs
.endmacro

.macro EMIT_SBC addr
        lda #<(addr)
        ldx #>(addr)
        jsr cg_sbc_abs
.endmacro

.macro EMIT_CMP addr
        lda #<(addr)
        ldx #>(addr)
        jsr cg_cmp_abs
.endmacro

.macro EMIT_JSR addr
        lda #<(addr)
        ldx #>(addr)
        jsr cg_jsr_abs
.endmacro

.macro EMIT_LDA_IMM value
        lda #value
        jsr cg_lda_imm
.endmacro

.macro EMIT_ORA_IMM value
        lda #value
        jsr cg_ora_imm
.endmacro

.macro EMIT_BIT value
        EMIT_LDA V_CMP
        EMIT_ORA_IMM value
        EMIT_STA V_CMP
.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_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 fail_mask
        sta MB_CODE
        sta MB_CODE+1

        jsr init_vars
        jsr cg_init

        ; ---------------------------------------------------- golden shape 1: byte assignment
        EMIT_LDA V_SRC
        EMIT_STA V_DST
        jsr cg_rts
        lda cg_len
        sta s2

        ; ---------------------------------------------------- shape 2: byte -> word widening
        EMIT_LDA V_SRC
        EMIT_STA V_WIDE
        EMIT_LDA_IMM $00
        EMIT_STA V_WIDE+1
        jsr cg_rts
        lda cg_len
        sta s3

        ; ---------------------------------------------------- shape 3: word addition
        EMIT_LDA V_ADD_A
        jsr cg_clc
        EMIT_ADC V_ADD_B
        EMIT_STA V_ADD_R
        EMIT_LDA V_ADD_A+1
        EMIT_ADC V_ADD_B+1
        EMIT_STA V_ADD_R+1
        jsr cg_rts
        lda cg_len
        sta s4

        ; ---------------------------------------------------- shape 4: integer subtraction
        EMIT_LDA V_SUB_A
        jsr cg_sec
        EMIT_SBC V_SUB_B
        EMIT_STA V_SUB_R
        EMIT_LDA V_SUB_A+1
        EMIT_SBC V_SUB_B+1
        EMIT_STA V_SUB_R+1
        jsr cg_rts
        lda cg_len
        sta s5

        ; ---------------------------------------------------- shape 5: six comparisons
        EMIT_LDA_IMM $00
        EMIT_STA V_CMP

        ; EQ bit 1
        EMIT_LDA V_BYTE_A
        EMIT_CMP V_BYTE_B
        lda #$D0                       ; BNE skip
        jsr cg_branch_fwd
        sta fix_eq
        EMIT_BIT $01
        lda fix_eq
        jsr cg_patch_here

        ; NE bit 2
        EMIT_LDA V_BYTE_A
        EMIT_CMP V_BYTE_B
        lda #$F0                       ; BEQ skip
        jsr cg_branch_fwd
        sta fix_ne
        EMIT_BIT $02
        lda fix_ne
        jsr cg_patch_here

        ; LT bit 4
        EMIT_LDA V_BYTE_A
        EMIT_CMP V_BYTE_B
        lda #$B0                       ; BCS skip
        jsr cg_branch_fwd
        sta fix_lt
        EMIT_BIT $04
        lda fix_lt
        jsr cg_patch_here

        ; LE bit 8: equal or below goes to set, above skips
        EMIT_LDA V_BYTE_A
        EMIT_CMP V_BYTE_B
        lda #$F0                       ; BEQ set
        jsr cg_branch_fwd
        sta fix_le1
        lda #$90                       ; BCC set
        jsr cg_branch_fwd
        sta fix_le2
        lda #$B0                       ; BCS skip
        jsr cg_branch_fwd
        sta fix_le3
        lda fix_le1
        jsr cg_patch_here
        lda fix_le2
        jsr cg_patch_here
        EMIT_BIT $08
        lda fix_le3
        jsr cg_patch_here

        ; GT bit 16: equal or below skips
        EMIT_LDA V_BYTE_A
        EMIT_CMP V_BYTE_B
        lda #$F0                       ; BEQ skip
        jsr cg_branch_fwd
        sta fix_gt1
        lda #$90                       ; BCC skip
        jsr cg_branch_fwd
        sta fix_gt2
        EMIT_BIT $10
        lda fix_gt1
        jsr cg_patch_here
        lda fix_gt2
        jsr cg_patch_here

        ; GE bit 32
        EMIT_LDA V_BYTE_A
        EMIT_CMP V_BYTE_B
        lda #$90                       ; BCC skip
        jsr cg_branch_fwd
        sta fix_ge
        EMIT_BIT $20
        lda fix_ge
        jsr cg_patch_here
        jsr cg_rts
        lda cg_len
        sta s6

        ; ---------------------------------------------------- shape 6: short-circuit AND
        EMIT_LDA_IMM $00
        EMIT_STA V_EVAL
        EMIT_LDA V_BYTE_A
        lda #$F0                       ; BEQ false
        jsr cg_branch_fwd
        sta fix_and1
        EMIT_LDA_IMM $01
        EMIT_STA V_EVAL
        EMIT_LDA V_BYTE_B
        lda #$F0                       ; BEQ false
        jsr cg_branch_fwd
        sta fix_and2
        EMIT_LDA_IMM $01
        EMIT_STA V_FLAG
        jsr cg_rts
        lda fix_and1
        jsr cg_patch_here
        lda fix_and2
        jsr cg_patch_here
        EMIT_LDA_IMM $00
        EMIT_STA V_FLAG
        jsr cg_rts
        lda cg_len
        sta s7

        ; ---------------------------------------------------- shape 7: short-circuit OR
        EMIT_LDA_IMM $00
        EMIT_STA V_EVAL
        EMIT_LDA V_BYTE_A
        lda #$D0                       ; BNE true
        jsr cg_branch_fwd
        sta fix_or1
        EMIT_LDA_IMM $01
        EMIT_STA V_EVAL
        EMIT_LDA V_BYTE_B
        lda #$D0                       ; BNE true
        jsr cg_branch_fwd
        sta fix_or2
        EMIT_LDA_IMM $00
        EMIT_STA V_FLAG
        jsr cg_rts
        lda fix_or1
        jsr cg_patch_here
        lda fix_or2
        jsr cg_patch_here
        EMIT_LDA_IMM $01
        EMIT_STA V_FLAG
        jsr cg_rts

        lda cg_len
        sta golden_len
        jsr copy_golden
        lda cg_err
        beq @golden_ok
        lda #$01
        jsr fail
        jmp @finish
@golden_ok:

        ; ---------------------------------------------------- run golden shapes
        lda #$00
        jsr run_code
        lda V_DST
        cmp #$5A
        beq @s2
        lda #$01
        jsr fail
@s2:    lda s2
        jsr run_code
        lda V_WIDE
        cmp #$5A
        bne @s2_bad
        lda V_WIDE+1
        bne @s2_bad
        jmp @s3
@s2_bad:
        lda #$01
        jsr fail

@s3:    lda s3
        jsr run_code
        lda V_ADD_R
        cmp #$21
        bne @s3_bad
        lda V_ADD_R+1
        cmp #$22
        bne @s3_bad
        jmp @s4
@s3_bad:
        lda #$02
        jsr fail

@s4:    lda s4
        jsr run_code
        lda V_SUB_R
        cmp #$BB
        bne @s4_bad
        lda V_SUB_R+1
        cmp #$EC
        bne @s4_bad
        jmp @s5
@s4_bad:
        lda #$02
        jsr fail

@s5:    lda s5
        jsr run_code
        lda V_CMP
        cmp #$0E
        beq @s6
        lda #$04
        jsr fail

@s6:    lda #$00
        sta V_BYTE_A
        lda #$01
        sta V_BYTE_B
        lda s6
        jsr run_code
        lda V_FLAG
        bne @s6_bad
        lda V_EVAL
        bne @s6_bad
        jmp @s7
@s6_bad:
        lda #$08
        jsr fail

@s7:    lda #$01
        sta V_BYTE_A
        lda #$00
        sta V_BYTE_B
        lda s7
        jsr run_code
        lda V_FLAG
        cmp #$01
        bne @s7_bad
        lda V_EVAL
        bne @s7_bad
        jmp @arith
@s7_bad:
        lda #$08
        jsr fail

        ; ---------------------------------------------------- arithmetic helpers
@arith:
        jsr cg_init
        EMIT_LDA V_MUL_A
        EMIT_STA ar_a
        EMIT_LDA V_MUL_A+1
        EMIT_STA ar_a+1
        EMIT_LDA V_MUL_B
        EMIT_STA ar_b
        EMIT_LDA V_MUL_B+1
        EMIT_STA ar_b+1
        EMIT_JSR ar_mul_u16
        EMIT_STA V_MUL_R
        EMIT_STX V_MUL_R+1
        jsr cg_rts
        lda cg_err
        beq @mul_run
        lda #$10
        jsr fail
        jmp @div
@mul_run:
        lda #$00
        jsr run_code
        lda V_MUL_R
        cmp #$E0
        bne @mul_bad
        lda V_MUL_R+1
        cmp #$2E
        bne @mul_bad
        jmp @div
@mul_bad:
        lda #$10
        jsr fail

@div:   jsr cg_init
        EMIT_LDA V_DIV_A
        EMIT_STA ar_a
        EMIT_LDA V_DIV_A+1
        EMIT_STA ar_a+1
        EMIT_LDA V_DIV_B
        EMIT_STA ar_b
        EMIT_LDA V_DIV_B+1
        EMIT_STA ar_b+1
        EMIT_JSR ar_div_u16
        EMIT_STA V_DIV_R
        EMIT_STX V_DIV_R+1
        jsr cg_rts
        lda cg_err
        beq @div_run
        lda #$20
        jsr fail
        jmp @sdiv
@div_run:
        lda #$00
        jsr run_code
        bcs @div_bad
        lda V_DIV_R
        cmp #$8E
        bne @div_bad
        lda V_DIV_R+1
        bne @div_bad
        lda ar_rem
        cmp #$06
        bne @div_bad
        lda ar_rem+1
        bne @div_bad
        jmp @sdiv
@div_bad:
        lda #$20
        jsr fail

@sdiv:  jsr cg_init
        EMIT_LDA V_SDIV_A
        EMIT_STA ar_a
        EMIT_LDA V_SDIV_A+1
        EMIT_STA ar_a+1
        EMIT_LDA V_SDIV_B
        EMIT_STA ar_b
        EMIT_LDA V_SDIV_B+1
        EMIT_STA ar_b+1
        EMIT_JSR ar_div_i16
        EMIT_STA V_SDIV_R
        EMIT_STX V_SDIV_R+1
        jsr cg_rts
        lda cg_err
        beq @sdiv_run
        lda #$40
        jsr fail
        jmp @divzero
@sdiv_run:
        lda #$00
        jsr run_code
        bcs @sdiv_bad
        lda V_SDIV_R
        cmp #$F2
        bne @sdiv_bad
        lda V_SDIV_R+1
        cmp #$FF
        bne @sdiv_bad
        jmp @divzero
@sdiv_bad:
        lda #$40
        jsr fail

@divzero:
        lda #$00
        sta V_DIV_B
        sta V_DIV_B+1
        jsr cg_init
        EMIT_LDA V_DIV_A
        EMIT_STA ar_a
        EMIT_LDA V_DIV_A+1
        EMIT_STA ar_a+1
        EMIT_LDA V_DIV_B
        EMIT_STA ar_b
        EMIT_LDA V_DIV_B+1
        EMIT_STA ar_b+1
        EMIT_JSR ar_div_u16
        EMIT_STA V_DIV_R
        EMIT_STX V_DIV_R+1
        jsr cg_rts
        lda cg_err
        beq @dz_run
        lda #$80
        jsr fail
        jmp @finish
@dz_run:
        lda #$00
        jsr run_code
        bcc @dz_bad
        lda ar_fault
        cmp #AR_FAULT_DIV0
        bne @dz_bad
        lda V_DIV_R
        ora V_DIV_R+1
        bne @dz_bad
        jmp @finish
@dz_bad:
        lda #$80
        jsr fail

        ; ---------------------------------------------------- report
@finish:
        lda V_DST
        sta MB_DATA+0
        lda V_CMP
        sta MB_DATA+1
        lda V_ADD_R
        sta MB_DATA+2
        lda V_ADD_R+1
        sta MB_DATA+3
        lda V_SUB_R
        sta MB_DATA+4
        lda V_SUB_R+1
        sta MB_DATA+5
        lda V_MUL_R
        sta MB_DATA+6
        lda ar_fault
        sta MB_DATA+7
        lda fail_mask
        sta MB_CODE
        lda #$00
        sta MB_CODE+1
        lda #MB_ST_FAIL
        ldx fail_mask
        bne @status
        lda #MB_ST_PASS
@status:
        sta MB_STATUS
        ldy #$00
@print: lda message,y
        beq @end
        sty print_y
        jsr CHROUT
        ldy print_y
        iny
        bne @print
@end:   plp
        rts

; A = code-buffer offset. Patch a JSR operand and run the snippet.
run_code:
        clc
        adc #<cg_code
        sta @target+1
        lda #>cg_code
        adc #0
        sta @target+2
@target:
        jsr $FFFF
        rts

copy_golden:
        ldx #$00
@copy:  cpx golden_len
        beq @done
        lda cg_code,x
        sta golden_copy,x
        inx
        bne @copy
@done:  rts

init_vars:
        lda #$5A
        sta V_SRC
        sta V_DST
        lda #$00
        sta V_WIDE
        sta V_WIDE+1
        sta V_CMP
        sta V_FLAG
        sta V_EVAL
        sta ar_fault

        lda #$34
        sta V_ADD_A
        lda #$12
        sta V_ADD_A+1
        lda #$ED
        sta V_ADD_B
        lda #$0F
        sta V_ADD_B+1
        lda #$00
        sta V_ADD_R
        sta V_ADD_R+1

        lda #$00
        sta V_SUB_A
        lda #$10
        sta V_SUB_A+1
        lda #$45
        sta V_SUB_B
        lda #$23
        sta V_SUB_B+1
        lda #$00
        sta V_SUB_R
        sta V_SUB_R+1

        lda #$05
        sta V_BYTE_A
        lda #$07
        sta V_BYTE_B

        lda #$2C
        sta V_MUL_A
        lda #$01
        sta V_MUL_A+1
        lda #$28
        sta V_MUL_B
        lda #$00
        sta V_MUL_B+1
        lda #$00
        sta V_MUL_R
        sta V_MUL_R+1

        lda #$E8
        sta V_DIV_A
        lda #$03
        sta V_DIV_A+1
        lda #$07
        sta V_DIV_B
        lda #$00
        sta V_DIV_B+1
        lda #$00
        sta V_DIV_R
        sta V_DIV_R+1

        lda #$9C
        sta V_SDIV_A
        lda #$FF
        sta V_SDIV_A+1
        lda #$07
        sta V_SDIV_B
        lda #$00
        sta V_SDIV_B+1
        lda #$00
        sta V_SDIV_R
        sta V_SDIV_R+1
        rts

.segment "CODE"
fail:
        ora fail_mask
        sta fail_mask
        rts

.segment "RODATA"
message:        .byte "NOVA128 SCALAR TEST DONE", $0D, $00

.segment "BSS"
fail_mask:      .res 1
print_y:        .res 1
s2:             .res 1
s3:             .res 1
s4:             .res 1
s5:             .res 1
s6:             .res 1
s7:             .res 1
fix_eq:         .res 1
fix_ne:         .res 1
fix_lt:         .res 1
fix_le1:        .res 1
fix_le2:        .res 1
fix_le3:        .res 1
fix_gt1:        .res 1
fix_gt2:        .res 1
fix_ge:         .res 1
fix_and1:       .res 1
fix_and2:       .res 1
fix_or1:        .res 1
fix_or2:        .res 1
.export golden_len
.export golden_copy
golden_len:     .res 1
golden_copy:    .res 256