C64-dev/newLang/tests/names/names-test.s

; E02-S03: name-table test in x128.
;
; For each fixture: src_load, names_init, then lex to EOF. Every identifier is
; interned; when the previous token is class/interface/program/method/var it
; is also declared. The dump records, per identifier:
;   $01 id   use        $02 id   declaration        $03 code   error
; then at EOF:  $FD, names_count, guard flag (1 = guard bytes intact), and
; for each ID 1..count: flags, length, spelling bytes.
; Fixture header: $FF, index, src_load result. End of dump: $FE.
; The guard is 8 bytes of bank-1 TABLES placed directly after the name table
; (this module links after names.s), filled with $A5 before every fixture.
; Mailbox: MB_DATA+0/1 dump address, +2/3 length; PASS = loads ok, no overflow.

.setcpu "6502"
.include "../../src/common/c128.inc"
.include "../../src/common/mailbox.inc"
.include "../../src/common/tokens.inc"
.include "../../src/common/names.inc"

.import mmu_init, mmu_bank0, mmu_shutdown, mmu_peek1, mmu_poke1
.importzp mmu_ptr
.import src_load
.import lex_reset, lex_next, tok_kind, tok_col, tok_len
.import names_init, name_intern, name_declare, name_get, names_count
.import name_out, name_out_len, name_out_flags

DUMP_SIZE = $3000
GUARD_SIZE = 8

.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"
dump_ptr:       .res 2
fx_ptr:         .res 2

.segment "TABLES"
guard:          .res GUARD_SIZE

.segment "STARTUP"
.export test_entry, dump, guard
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_PLATFORM
        sta MB_PRODUCER
        lda #MB_ST_RUNNING
        sta MB_STATUS

        jsr mmu_init
        jsr mmu_bank0
        lda #<dump
        sta dump_ptr
        lda #>dump
        sta dump_ptr+1
        lda #<fixtures
        sta fx_ptr
        lda #>fixtures
        sta fx_ptr+1
        lda #$00
        sta failures
        sta overflow
        sta fx_index

@fixture:
        lda #$FF
        jsr emit
        lda fx_index
        jsr emit
        ldy #0
        lda (fx_ptr),y
        sta name_lo
        iny
        lda (fx_ptr),y
        tax
        iny
        lda (fx_ptr),y
        tay
        lda name_lo
        jsr src_load
        pha
        jsr emit
        pla
        beq @run
        inc failures
        jmp @advance
@run:   jsr run_fixture
@advance:
        clc
        lda fx_ptr
        adc #3
        sta fx_ptr
        bcc :+
        inc fx_ptr+1
:       inc fx_index
        lda fx_index
        cmp #FIXTURE_COUNT
        bne @fixture

        lda #$FE
        jsr emit
        lda #<dump                 ; report while the private ZP is mapped
        sta MB_DATA+0
        lda #>dump
        sta MB_DATA+1
        sec
        lda dump_ptr
        sbc #<dump
        sta MB_DATA+2
        lda dump_ptr+1
        sbc #>dump
        sta MB_DATA+3
        jsr mmu_shutdown
        lda failures
        ora overflow
        sta MB_CODE
        ldy #ok_msg - messages
        lda MB_CODE
        bne @fail
        lda #MB_ST_PASS
        bne @report
@fail:  ldy #fail_msg - messages
        lda #MB_ST_FAIL
@report:
        sta MB_STATUS
        plp
@print: lda messages,y
        beq @end
        sty print_y
        jsr CHROUT
        ldy print_y
        iny
        bne @print
@end:   rts

.segment "CODE"

run_fixture:
        jsr names_init
        jsr set_guard_ptr
        ldy #GUARD_SIZE - 1
@fill:  lda #$A5
        jsr mmu_poke1
        dey
        bpl @fill
        jsr lex_reset
        lda #TOK_EOL
        sta prev_kind
@token: jsr lex_next
        lda tok_kind
        cmp #TOK_EOF
        beq @eof
        cmp #TOK_IDENT
        bne @remember
        lda tok_col
        ldx tok_len
        jsr name_intern
        bcc @interned
        pha
        lda #$03
        jsr emit
        pla
        jsr emit
        jmp @remember
@interned:
        sta last_id
        jsr is_declaration
        bcs @declare
        lda #$01
        jsr emit
        lda last_id
        jsr emit
        jmp @remember
@declare:
        lda last_id
        ldx tok_len
        ldy tok_col
        jsr name_declare
        lda #$02
        jsr emit
        lda last_id
        jsr emit
@remember:
        lda tok_kind
        sta prev_kind
        jmp @token

@eof:   lda #$FD
        jsr emit
        lda names_count
        jsr emit
        jsr set_guard_ptr          ; guard intact?
        ldy #GUARD_SIZE - 1
        lda #$01
        sta guard_ok
@check: jsr mmu_peek1
        cmp #$A5
        beq :+
        lda #$00
        sta guard_ok
:       dey
        bpl @check
        lda guard_ok
        jsr emit
        lda #$01
        sta last_id
@names: lda last_id
        cmp names_count
        beq :+
        bcs @done
:       jsr name_get
        lda name_out_flags
        jsr emit
        lda name_out_len
        jsr emit
        ldx #$00
@spell: cpx name_out_len
        beq @next
        lda name_out,x
        stx emit_x
        jsr emit
        ldx emit_x
        inx
        bne @spell
@next:  inc last_id
        bne @names                 ; IDs stop at 255, so this always loops
@done:  rts

; C=1 when the previous token introduces a declaration name.
is_declaration:
        lda prev_kind
        ldx #decl_count - 1
@find:  cmp decl_kinds,x
        beq @yes
        dex
        bpl @find
        clc
        rts
@yes:   sec
        rts

set_guard_ptr:
        lda #<guard
        sta mmu_ptr
        lda #>guard
        sta mmu_ptr+1
        rts

emit:   ldy dump_ptr+1
        cpy #>(dump + DUMP_SIZE)
        bcc @room
        lda #$01
        sta overflow
        rts
@room:  sty emit_y
        ldy #$00
        sta (dump_ptr),y
        ldy emit_y
        inc dump_ptr
        bne :+
        inc dump_ptr+1
:       rts

.segment "RODATA"
decl_kinds:
        .byte KW_CLASS, KW_INTERFACE, KW_PROGRAM, KW_METHOD, KW_VAR
decl_count = * - decl_kinds

fixtures:
.macro FIXTURE name
        .local text, done
        .word text
        .byte done - text
        .pushseg
        .segment "DATA"
text:   .byte name
done:
        .popseg
.endmacro
        FIXTURE "NAMES.N8"
        FIXTURE "COLLIDE.N8"
        FIXTURE "FULL.N8"
FIXTURE_COUNT = 3

messages:
ok_msg:    .byte "NOVA128 NAMES TEST OK", $0D, $00
fail_msg:  .byte "NOVA128 NAMES TEST FAIL", $0D, $00

.segment "BSS"
failures:       .res 1
overflow:       .res 1
fx_index:       .res 1
name_lo:        .res 1
prev_kind:      .res 1
last_id:        .res 1
guard_ok:       .res 1
emit_x:         .res 1
emit_y:         .res 1
print_y:        .res 1
dump:           .res DUMP_SIZE