C64-dev/newLang/tests/disk/tokenize-seq.s

; E07-S03: tokenize the SEQ file the editor created on this session's disk.
;
; One fixture, ROUNDTRIP.N8, loaded through the normal source reader so the
; C128 side never sees a host conversion. The dump matches the format of
; tests/lexer/lexer-test.s, so the host can decode it with the reference
; lexer's ConvertFrom-TokenDump:
;   fixture:  $FF, fixture index (0), src_load result
;   token:    kind, line lo, line hi, col, then by kind:
;               EOL, EOF        nothing
;               ERROR           error code
;               IDENT, STRING   raw length, text length, text bytes
;               NUMBER          raw length, value lo, value hi
;               CHAR            raw length, value
;               other           raw length
;   end:      $FE
; Mailbox: PASS when the file loaded and the dump did not overflow;
;   MB_DATA+0/1 dump address, +2/3 dump length.

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

.import mmu_init, mmu_bank0, mmu_shutdown
.import src_load
.import lex_reset, lex_next
.import tok_kind, tok_line, tok_col, tok_len, tok_value, tok_text, tok_text_len, tok_err

DUMP_SIZE = $2000
MAX_TOKENS = 2000

.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

.segment "STARTUP"
.export test_entry, dump
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 #$00
        sta failures
        sta overflow

        lda #$FF
        jsr emit
        lda #$00
        jsr emit
        lda #<f_name
        ldx #>f_name
        ldy #f_name_end - f_name
        jsr src_load
        pha
        jsr emit
        pla
        beq @lex
        inc failures
        jmp @end
@lex:   jsr lex_run
@end:   lda #$FE
        jsr emit

        ; Report before mmu_shutdown: dump_ptr lives in the private zero page,
        ; which the system mapping no longer shows.
        lda #<dump
        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 @done
        sty print_y
        jsr CHROUT
        ldy print_y
        iny
        bne @print
@done:  rts

.segment "CODE"

lex_run:
        jsr lex_reset
        lda #<MAX_TOKENS
        sta budget
        lda #>MAX_TOKENS
        sta budget+1
@token: jsr lex_next
        jsr emit_token
        lda tok_kind
        cmp #TOK_EOF
        beq @done
        lda budget
        bne :+
        dec budget+1
:       dec budget
        lda budget
        ora budget+1
        bne @token
        inc failures
@done:  rts

emit_token:
        lda tok_kind
        jsr emit
        lda tok_line
        jsr emit
        lda tok_line+1
        jsr emit
        lda tok_col
        jsr emit
        lda tok_kind
        cmp #TOK_EOF
        beq @none
        cmp #TOK_EOL
        beq @none
        cmp #TOK_ERROR
        bne @len
        lda tok_err
        jmp emit
@none:  rts
@len:   lda tok_len
        jsr emit
        lda tok_kind
        cmp #TOK_IDENT
        beq @text
        cmp #TOK_STRING
        beq @text
        cmp #TOK_NUMBER
        beq @number
        cmp #TOK_CHAR
        bne @none
        lda tok_value
        jmp emit
@number:
        lda tok_value
        jsr emit
        lda tok_value+1
        jmp emit
@text:  lda tok_text_len
        jsr emit
        ldx #$00
@byte:  cpx tok_text_len
        beq @none
        lda tok_text,x
        stx emit_x
        jsr emit
        ldx emit_x
        inx
        bne @byte

; Append A to the dump; stop writing (and flag) once it is full.
emit:   ldy dump_ptr+1
        cpy #>(dump + DUMP_SIZE)
        bcc @room
        lda #$01
        sta overflow
        rts
@room:  ldy #$00
        sta (dump_ptr),y
        inc dump_ptr
        bne :+
        inc dump_ptr+1
:       rts

.segment "RODATA"
f_name:  .byte "ROUNDTRIP.N8"
f_name_end:

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

.segment "BSS"
failures:       .res 1
overflow:       .res 1
budget:         .res 2
emit_x:         .res 1
print_y:        .res 1
dump:           .res DUMP_SIZE