C64-dev/newLang/demo/n8check.s

; n8check.s - DEMO driver: check one Nova128 source file on the C128.
;
; This is not the Nova128 compiler (N128C, still to come). It runs the
; front end that exists today - source reader, lexer, name table, and the
; declaration/member/scope parser (E02, E03-S01, E03-S02) - on a file named
; at the prompt, shows any diagnostics on screen, and writes NAME.ERR. It
; generates no code: the code generator is epic E04.
;
; Mailbox: producer $02, status PASS (no errors) or FAIL, code = errors.

.setcpu "6502"
.include "../src/common/c128.inc"
.include "../src/common/mailbox.inc"
.include "../src/common/source.inc"
.include "../src/common/errors.inc"

.import mmu_init, mmu_bank0, mmu_shutdown, kcall_inline
.import src_load, src_err_line, src_err_col, src_dos_code
.import names_init
.import diag_init, diag_report, diag_finish, diag_line, diag_col
.import diag_arg1, diag_arg1_len
.import parse_file

NAME_MAX = 16

.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"
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_COMPILER
        sta MB_PRODUCER
        lda #MB_ST_RUNNING
        sta MB_STATUS
        jsr mmu_init
        jsr mmu_bank0
        jsr main
        jsr mmu_shutdown
        plp
        rts

.segment "CODE"
main:   ldx #msg_title - msgs
        jsr print
        ldx #msg_prompt - msgs
        jsr print
        jsr read_name
        lda name_len
        bne :+
        rts                        ; empty name: nothing to do
:       ldx #msg_checking - msgs
        jsr print

        jsr names_init
        lda #<name_buf
        ldx #>name_buf
        ldy name_len
        jsr diag_init              ; scratches a stale NAME.ERR
        lda #<name_buf
        ldx #>name_buf
        ldy name_len
        jsr src_load
        bcc @parse
        jsr report_load            ; A = SRC_ERR_*
        jmp @done
@parse: jsr parse_file
@done:  jsr diag_finish            ; A = errors reported
        sta errors
        sta MB_CODE
        cmp #$00
        bne @bad
        ldx #msg_ok - msgs
        jsr print
        lda #MB_ST_PASS
        sta MB_STATUS
        rts
@bad:   lda errors
        jsr print_dec
        ldx #msg_errors - msgs
        jsr print
        ldx #$00                   ; base name, then .ERR
@base:  cpx base_len
        beq :+
        lda name_buf,x
        stx save_x
        jsr chrout
        ldx save_x
        inx
        bne @base
:       ldx #msg_errfile - msgs
        jsr print
        lda #MB_ST_FAIL
        sta MB_STATUS
        rts

; Map a source-reader failure (A = SRC_ERR_*) to its diagnostic.
report_load:
        cmp #SRC_ERR_DISK
        bne @limit
        lda src_dos_code           ; "DOS nn"
        ldx #$00
@tens:  cmp #10
        bcc :+
        sbc #10
        inx
        bne @tens
:       ora #'0'
        sta dos_text+1
        txa
        ora #'0'
        sta dos_text
        lda #<dos_text
        sta diag_arg1
        lda #>dos_text
        sta diag_arg1+1
        lda #2
        sta diag_arg1_len
        lda #$00
        sta diag_line
        sta diag_line+1
        sta diag_col
        lda #E_DSK_SOURCE_UNREADABLE
        jmp diag_report
@limit: tax                        ; 2/3/4 -> E002/E001/E003
        lda load_codes-2,x
        pha
        lda src_err_line
        sta diag_line
        lda src_err_line+1
        sta diag_line+1
        lda src_err_col
        sta diag_col
        pla
        jmp diag_report

; Read a line from the keyboard into name_buf (screen editor input).
read_name:
        lda #$00
        sta name_len
@key:   jsr kcall_inline
        .word CHRIN
        cmp #$0D
        beq @end
        ldx name_len
        cpx #NAME_MAX
        bcs @key
        sta name_buf,x
        inc name_len
        bne @key
@end:   lda #$0D
        jsr chrout
        lda name_len               ; base_len = length without ".N8"
        sta base_len
        cmp #3
        bcc @out
        tax
        lda name_buf-3,x
        cmp #'.'
        bne @out
        lda name_buf-2,x
        and #$7F
        cmp #'N'
        bne @out
        lda name_buf-1,x
        cmp #'8'
        bne @out
        dex
        dex
        dex
        stx base_len
@out:   rts

; Print the $00-terminated message at msgs+X.
print:  lda msgs,x
        beq @done
        stx save_x
        jsr chrout
        ldx save_x
        inx
        bne print
@done:  rts

; Print A (0-99) in decimal; at most 21 errors are ever reported.
print_dec:
        ldx #$00
@t:     cmp #10
        bcc @units
        sbc #10
        inx
        bne @t
@units: pha
        txa
        beq :+
        ora #'0'
        jsr chrout
:       pla
        ora #'0'
        jmp chrout

chrout: jsr kcall_inline
        .word CHROUT
        rts

.segment "RODATA"
load_codes:
        .byte E_SRC_FILE_TOO_LARGE, E_SRC_LINE_TOO_LONG, E_SRC_TOO_MANY_LINES
msgs:
msg_title:    .byte $0D, "NOVA128 CHECK (DEMO: FRONT END ONLY)", $0D, $00
msg_prompt:   .byte "SOURCE FILE?", $0D, $00
msg_checking: .byte "CHECKING...", $0D, $00
msg_ok:       .byte "NO ERRORS: DECLARATIONS, MEMBERS,", $0D
              .byte "SCOPES AND ACCESS ARE VALID.", $0D
              .byte "(NO CODE YET - CODE GENERATION IS E04)", $0D, $00
msg_errors:   .byte " ERROR(S); LIST IN ", $00
msg_errfile:  .byte ".ERR", $0D, $00

.segment "BSS"
name_buf:  .res NAME_MAX
name_len:  .res 1
base_len:  .res 1
errors:    .res 1
save_x:    .res 1

.segment "DATA"
dos_text:  .byte "00"