粘贴箱: VTL-2_CoCo_translit.asm

格式

Asm

提交日期

2022-09-19 20:15

Publication Period

Unlimited

         OPT 6809
 *       VTL-2 for 6809
 *       A transliteration of VTL-2 for 6801
 *       V-3.6
 *       9-23-76
 *       BY GARY SHANNON
 *       & FRANK MCCOY
 *       COPYWRIGHT 1976, THE COMPUTER STORE
 *
 *       Transliteration and modifications for Color Computer
 *       including original modifications for MC-10
 *       by Joel Matthew Rees
 *       Copyright 2022, Joel Matthew Rees
 *
 *       Modifications explained at 
 * https://joels-programming-fun.blogspot.com/2022/09/vtl-2-part-5-transliterating-to-6809.html
 *
 *       Note that this is a travesty of a program, 
 *       since it is 6809 code, but does not make any use of the 6809's added resources.
 * 
 *
 *       DEFINE LOCATIONS IN MONITOR
 * INCH  EQU     $FF00   ; per VTL.ASM
 * EINCH EQU     $F012   ; exorsim mdos Input byte with echo unless AECHO is set
 * INCH  EQU     $F015   ; exorsim mdos Input char with echo (F012 -> strip bit 7)
 * POLCAT        EQU     $FF24   ; from VTL.ASM
 * OUTCH EQU     $FF81   ; from VTL.ASM
 * EOUTCH        EQU     $F018   ; exorsim mdos Output character with NULs
 * OUTS  EQU     $FF82   ; from VTL.ASM
 * EPCRLF        EQU     $F021   ; Primarily for forced initialization in exorsim.
 *
 *       FOR SBC6800:
 *BREAK  EQU     $1B     ; BREAK KEY
 *       For MC-10 and Color Computer:
 BREAK   EQU     $03
 *       For exorsim
 *ACIACS EQU     $FCF4   ; exorcisor
 *ACIADA EQU     $FCF5   ; exorcisor
 *
 *       A few interpreter variables in the direct page won't hurt, said the spider to the fly.
 *       (See SNDDUR and PLYTMR in particular.)
 *       (Really need to move these. Use DP after all? IRQ, at least, uses extended mode addressing.)
 *       (Yes, I can hear voices of complaint that it's not as "tight" as it could be.)
 *       (This allows us to save more ROM space and uses DP that would otherwise go wasted.)
 *       (Trade-offs.)
 *       (It also helps us understand the code, so we can do a better 6809 transliteration.)
 *       (I hope the names are meaningful.)
 *
 *       In .c10 format, the following as ORG and RMBs caused object code output, 
 *       which will prevent the code from loading on the MC-10.
 *       Changed to EQU for the MC10 and left this way for the initial CoCo code.
 *
 *       Does not really make specific use of the DP register.
 *       ORG     $C0     ; Move this according to your environment's needs, but not on CoCo.
 * Change this to move the registers:
 DPBASE  EQU     $C4     ; PIA mask at $C2? Avoid it, anyway.
 * PARSET        RMB     2       ; Instead of SAVE0 in TERM/NXTRM
 PARSET  EQU     DPBASE+2
 * CVTSUM        RMB     2       ; Instead of SAVE1 in CBLOOP
 CVTSUM  EQU     PARSET+2
 * MLDVCT        EQU     CVTSUM  ; Instead of SAVE1 in mul/div (1 byte only)
 MLDVCT  EQU     CVTSUM
 * DIVQUO        RMB     2       ; Instead of SAVE2 in DIV
 DIVQUO  EQU     MLDVCT+2
 * MPLIER        EQU     DIVQUO  ; Instead of SAVE2 in MULTIP
 MPLIER  EQU     DIVQUO
 * EVALPT        RMB     2       ; Instead of SAVE3
 EVALPT  EQU     MPLIER+2
 * CNVPTR        RMB     2       ; Instead of SAVE4
 CNVPTR  EQU     EVALPT+2
 * VARADR        RMB     2       ; Instead of SAVE6
 VARADR  EQU     CNVPTR+2
 * OPRLIN        RMB     2       ; Instead of SAVE7
 OPRLIN  EQU     VARADR+2
 * EDTLIN        RMB     2       ; Instead of SAVE8
 EDTLIN  EQU     OPRLIN+2
 * INSPTR        RMB     2       ; Instead of SAVE10 (maybe? Will some VTL programs want it back?)
 INSPTR  EQU     EDTLIN+2
 * SAVLIN        RMB     2       ; Instead of SAVE11
 SAVLIN  EQU     INSPTR+2
 * SRC   RMB     2       ; For copy routine
 SRC     EQU     SAVLIN+2
 * DST   RMB     2       ; ditto
 DST     EQU     SRC+2
 STKMRK  EQU     DST+2   ; to restore the stack on each pass.
 DPALLOC EQU     STKMRK+2        ; total storage declared in the direct page
 *
 *******!!!!!! CoCo: Check that we have avoided $00E2, as well, since it is used as PLYTMR by an interrupt routine.
 *             CoCo: Also, $008D is used as SNDDUR by BASIC.
 *
 *       SET ASIDE FOUR BYTES FOR USER
 *       DEFINED INTERUPT ROUTINE IF NEEDED
 ZERO    EQU     $1600   ; Dodge BASIC and video use RAM.
         ORG     ZERO
 * ZERO probably no longer needs to be at even $100, but we'll put it there for good luck.
         RMB     4       ; INTERUPT VECTOR (probably not unnecessary? Implicit non-use in interpreter.)
 AT      RMB     2       ; CANCEL & C-R
 *
 *       GENERAL PURPOSE STORRGE
 VARS    RMB     52      ; VARIABLES(A-Z)
 BRAK    RMB     2       ; [
 * SAVE10 has me worried about implicit linkage in VTL programs. Might need to leave it here.
 SAVE10  RMB     2       ; BACK SLASH
 BRIK    RMB     2       ; ]
 UP      RMB     2       ; ^
 SAVE11  RMB     2       ; Need something in each SAVE to reserve space
 *                       ; to keep the math straight. 
 *                       ; Leave the SAVEs declared as they are.
 *
 SAVE14  RMB     2       ; SPACE (originally unused)
 EXCL    RMB     2       ; !
 QUOTE   RMB     2       ; "
 DOLR    RMB     2       ; #
 DOLLAR  RMB     2       ; $
 REMN    RMB     2       ; %
 AMPR    RMB     2       ; &
 QUITE   RMB     2       ; '
 PAREN   RMB     2       ; (
 PARIN   RMB     2       ; )
 STAR    RMB     2       ; *
 PLUS    RMB     2       ; +
 COMA    RMB     2       ; ,
 MINS    RMB     2       ; -
 PERD    RMB     2       ; .
 SLASH   RMB     2       ; /
 *
 SAVE0   RMB     2       ; unused
 SAVE1   RMB     2       ; unused
 SAVE2   RMB     2       ; unused
 SAVE3   RMB     2       ; unused
 SAVE4   RMB     2       ; unused
 SAVE5   RMB     2       ; unused (PSH/PULX)
 SAVE6   RMB     2       ; unused
 SAVE7   RMB     2       ; unused
 SAVE8   RMB     2       ; unused
 SAVE9   RMB     2       ; unused (PSH/PULX)
 COLN    RMB     2       ; :
 SEMI    RMB     2       ; ;
 LESS    RMB     2       ; <
 EQAL    RMB     2       ; =
 GRRT    RMB     1       ; >
 DECB_1  RMB     1
 *
 DECBUF  RMB     4
 LASTD   RMB     1
 DELIM   RMB     1
 LINLEN  EQU     72
 LINBUF  RMB     LINLEN+1
 BUFOFF  EQU     LINBUF-ZERO     ; Unmagic 87. Some assemblers will cough at this.
 *
 STACK   EQU     ZERO+$F0
         ORG     STACK
         RMB     1       ; 6809 stack pointer points to last item pushed.
 *
 VPRGM   EQU     STACK+$10       ; buffer zone, really
         ORG     VPRGM
 MI      RMB     4       ; INTERUPT VECTORS ; again, probably not relevant here.
 NMI     RMB     4
 PRGM    EQU     *       ; PROGRAM STARTS HERE
 * Must have some RAM here.
 *
 CODESG  EQU     $3800   ; 16K-2K for breathing room in 16K system (2K for now, adjust later.)
         ORG     CODESG
 *
 * The COLD boot can be removed or ignored to restore the original behavior, 
 * but if you do that don't forget to set & (AMPR) and * (STAR) values
 * by hand immediately after STARTing.
 *
 * Also, instead of PROBEing, if you know the limits for a particular ROM
 * application, you can set STAR directly:
 *       LDX     #PRGM
 *       STX     AMPR
 *       LDX     #RAMLIM
 *       STX     STAR
 * START ...
 * 
 COLD    STS     STKMRK  ; Mark the stack, 
 *       LDS     #STACK  ; Maybe use BASIC's stack. (S on 6809 points to last pushed.)
 *       JSR     TRMINI
         LDX     #PRGM   ; initialize program area base
         STX     AMPR
         LDA     #$5A    ; Probe RAM limit
         LDB     #$A5
         BRA     PROBET
 PROBE   STA     0,X
         CMPA    0,X
         BNE     NOTRAM
         STB     0,X
         CMPB    0,X
         BNE     NOTRAM          ; all bits seem to be R/W.
         LEAX    1,X
 PROBET  CMPX    #COLD
         BLO     PROBE   ; CMPX on 6809 works right.
 NOTRAM  LEAX    -1,X
         STX     STAR
 START
 *       LDS     #STACK  ; re-initialize at beginning of each evaluate
         LDS     STKMRK  ; from mark instead of constant
         STS     SEMI    ; DBG Comment this out when we no longer need to see the stack pointer BASIC gives us.
         CLRA            ; NUL delimiter
         LDX     #OKM
         LBSR    STRING
 *
 LOOP    CLRA
         STA     DOLR
         STA     DOLR+1
         LBSR    CVTLN
         BCC     STMNT   ; NO LINE# THEN EXEC
         BSR     EXEC
         BEQ     START
 *
 LOOP2   BSR     FIND    ; FIND LINE
 EQSTRT  BEQ     START   ; IF END THEN STOP
         LDX     0,X     ; LOAD REAL LINE #
         STX     DOLR    ; SAVE IT
         LDX     SAVLIN  ; GET LINE
         LEAX    3,X     ; BUMP PAST LINE # and SPACE
         BSR     EXEC    ; EXECUTE IT
         BEQ     LOOP3   ; IF ZERO, CONTINUE
         LDX     [SAVLIN]        ; FIND LINE
 *       LDX     0,X     ; GET IT
         CMPX    DOLR    ; HAS IT CHANGED?
         BEQ     LOOP3   ; IF NOT GET NEXT
 *
         LEAX    1,X     ; INCREMENT OLD LINE#
         STX     EXCL    ; SAVE FOR RETURN
         BRA     LOOP2   ; CONTINUE
 *
 LOOP3   BSR     FND3    ; FIND NEXT LINE
         BRA     EQSTRT  ; CONTINUE
 *
 EXEC    STX     OPRLIN  ; EXECUTE LINE
         LBSR    VAR2
         LEAX    1,X
 *
 SKIP    LDA     0,X     ; GET FIRST TERM
         BSR     EVIL    ; EVALUATE EXPRESSION
 OUTX    LDX     DOLR    ; GET LINE #
         RTS
 *
 EVIL    CMPA    #$22    ; IF " THEN BRANCH
         BNE     EVALU
         LEAX    1,X
 STRGT   LBRA    STRING  ; TO PRINT IT
 *
 STMNT   STX     EDTLIN  ; SAVE LINE #
         STD     DOLR
         LDX     DOLR
         BNE     SKP2    ; IF LINE# <> 0
 *
         LDX     #PRGM   ; LIST PROGRAM
 LST2    CMPX    AMPR    ; END OF PROGRAM
         BEQ     EQSTRT
         STX     SAVLIN  ; LINE # FOR CVDEC
         LDD     0,X
         LBSR    PRNT2
         LDX     SAVLIN
         LEAX    2,X
         LBSR    PNTMSG
         LBSR    CRLF
         BRA     LST2
 *
 NXTXT   LDX     SAVLIN  ; GET POINTER
         LEAX    1,X     ; BUMP PAST LINE#
 LOOKAG  LEAX    1,X     ; FIND END OF LINE
         TST     0,X
         BNE     LOOKAG
         LEAX    1,X
         RTS
 *
 FIND    LDX     #PRGM   ; FIND LINE
 FND2    STX     SAVLIN
         CMPX    AMPR
         BEQ     RTS1
 *       LDA     1,X     ; almost missed this.
 *       SUBA    DOLR+1  ; This was necessary because no SUBD
 *       LDA     0,X     ; and CPX does not affect C flag on 6800
 *       SBCA    DOLR
 *       PSHS    B               ; B does not seem to be in use.
         LDD     0,X     ; Use D because we think we want to keep X.
         SUBD    DOLR
 *       PULS    B
         BCC     SET
 FND3    BSR     NXTXT
         BRA     FND2
 *
 SET     LDA     #$FF    ; SET NOT EQUAL
 RTS1
         RTS
 *
 EVALU   LBSR    EVAL    ; EVALUATE LINE
         PSHS    A,B     ; A is pushed after B
         LDX     OPRLIN
         LBSR    CONVP
         PULS    A
         CMPB    #'$     ; STRING?
         BNE     AR1
         PULS    B
         LBRA    OUTCH   ; THEN PRINT IT
 AR1     SUBB    #'?     ; PRINT?
         LBEQ    PRNT
 AR11    INCB            ; MACHINE LANGUAGE?
         PULS    B
         BNE     AR2
         SWI             ; THEN INTERUPT (Need to fix this for CoCo -- and for MC-10.)
 *
 AR2     STD     0,X     ; STORE NEW VALUE
         BNE     AR2RND  ; Initialize/don't get stuck on zero.
         INCB            ; Keep it known cheap.
 *       ADDD    QUITE   ; RANDOMIZER    ; NO! Don't do this.
 AR2RND  ADDB    QUITE   ; RANDOMIZER    ; Adding the low byte to the high byte
         ADCA    QUITE+1 ;               ; is cheap but intentional.
         STD     QUITE
         RTS
 *
 SKP2
         BSR     FIND    ; FIND LINE
         BEQ     INSRT   ; IF NOT THERE
         LDX     0,X     ; THEN INSERT
         CMPX    DOLR    ; NEW LINE
         BNE     INSRT
 *
         BSR     NXTXT   ; SETUP REGISTERS
 *       LDS     SAVLIN  ; FOR DELETE
         STX     SRC     ; Patience! we can use Y here after we make sure this runs.
         LDX     SAVLIN
         STX     DST
 *
 DELT    LDX     SRC
         CMPX    AMPR    ; DELETE OLD LINE
         BEQ     FITIT
         LDA     ,X+
         STX     SRC
 *       PSHA
 *       INX
 *       INS
 *       INS
         LDX     DST
         STA     ,X+
         STX     DST
         BRA     DELT
 *
 * FITIT STS     AMPR    ; STORE NEW END
 FITIT   LDX     DST
         STX     AMPR    ; STORE NEW END
 *
 INSRT
         LDX     EDTLIN  ; COUNT NEW LINE LENGTH
         LDB     #$03
         TST     0,X
         BEQ     GOTIT   ; IF NO LINE THEN STOP
 CNTLN   INCB            ; count bytes
         LEAX    1,X
         TST     0,X     ; Find trailing NUL
         BNE     CNTLN
 *
 OPEN    CLRA            ; CALCULATE NEW END
         ADDD    AMPR
         STD     INSPTR
         SUBD    STAR
         LBCC    START   ; IF TOO BIG THEN STOP
         LDX     AMPR
 *       LDS     INSPTR  ; Remember that the 6800/6801 stack is postdecrement push.
 *       STS     AMPR
         LDD     INSPTR  ; The 6809 stack is predecrement push, but that doesn't matter here.
         STD     AMPR
         STD     DST
         LEAX    1,X     ; SLIDE OPEN GAP
 SLIDE   LEAX    -1,X    ; going down
         STX     SRC
         LDB     0,X
 *       PSHB            ; stack blast it
         LDX     DST
         STB     0,X     ; mimic 6800 push
         LEAX    -1,X
         STX     DST
         LDX     SRC
         CMPX    SAVLIN
         BHI     SLIDE
 *
 * DON   LDS     DOLR    ; STORE LINE #
 *       STS     0,X
 DON
         LDD     DOLR    ; STORE LINE #
         STD     0,X     ; Note MSB1st byte order implicit dependency here.
         STX     DST     ; will skip by offset on store
 *       LDS     EDTLIN  ; GET NEW LINE
 *       DES             ; pre-increment
         LDD     EDTLIN  ; GET NEW LINE
         STD     SRC
 *
 *MOVL   INX             ; INSERT NEW LINE (skip over LINE # hi byte)
 *       PULB
 *       STAB    1,X     ; (skips over low byte, BTW)
 MOVL    LDX     SRC
         LDB     ,X+
         STX     SRC
         LDX     DST
         LEAX    1,X             ; skip over what was already stored (too tricky for words).
         STX     DST
         STB     1,X     ; note offset store
         BNE     MOVL    ; until NUL stored
 *
 GOTIT
 *       LDS     #STACK  ; Ready for a new line of input.
         LDS     STKMRK  ; restore from mark
         LBRA    LOOP
 *
 * RSTRT LBRA    START   ; warm start over
 *
 PRNT    PULS    B       ; PRINT DECIMAL
 PRNT2   LDX     #DECBUF ; CONVERT TO DECIMAL
         STX     CNVPTR
         LDX     #PWRS10
 CVD1    PSHS    X
         LDX     0,X
         STX     VARADR
         LDX     #VARADR
         LBSR    DIVIDE
         PSHS    A
         LDX     CNVPTR
         LDA     DIVQUO+1
         ADDA    #'0
         STA     0,X
         PULS    A
         LEAX    1,X
         STX     CNVPTR
         PULS    X
         LEAX    2,X
         TST     1,X
         BNE     CVD1
 *
         LDX     #DECB_1
         COM     5,X     ; ZERO SUPPRESS
 ZRSUP   LEAX    1,X
         LDB     0,X
         CMPB    #'0
         BEQ     ZRSUP
         COM     LASTD
 *
 PNTMSG  CLRA            ; ZERO FOR DELIM
 STRTMS  STA     DELIM   ; STORE DELIMTER
 *
 OUTMSG  LDB     ,X+     ; GENERAL PURPOSE PRINT
         CMPB    DELIM
         BEQ     CTLC
         LBSR    OUTCH
         BRA     OUTMSG
 *
 CTLC
         LBSR    POLCAT  ; POL FOR CHARACTER
         BCC     RTS2    ; return wherever we came from
         LBSR    INCH
         CMPB    #BREAK  ; BREAK KEY?
         LBEQ    START
 *
 INCH2   LBRA    INCH
 *
 STRING  BSR     STRTMS  ; PRINT STRING LITERAL
         LDA     0,X
         CMPA    #';
         BEQ     OUTD
         LBRA    CRLF
 *
 EVAL    BSR     GETVAL  ; EVALUATE EXPRESSION
 *
 NXTRM   PSHS    A
         LDA     0,X     ; END OF LINE?
         BEQ     OUTN
         CMPA    #')
 OUTN    PULS    A
         BEQ     OUTD
         BSR     TERM
         LDX     PARSET
         BRA     NXTRM
 *
 TERM    PSHS    A               ; GET VALUE
         PSHS    B
         LDA     0,X
         PSHS    A
         LEAX    1,X
         BSR     GETVAL
         STD     EVALPT
         STX     PARSET
         LDX     #EVALPT
         PULS    A
         PULS    B
 *
         CMPA    #'*     ; SEE IF *
         BNE     EVAL2
         PULS    A       ; MULTIPLY
 MULTIP  STD     MPLIER  ; 2'S COMPLEMENT
         LDB     #$10
         STB     MLDVCT
         CLRA
         CLRB
 *
 MULT    LSR     MPLIER
         ROR     MPLIER+1
         BCC     NOAD
 MULTI   ADDD    0,X
 NOAD    ASL     1,X
         ROL     0,X
         DEC     MLDVCT
         BNE     MULT    ; LOOP TIL DONE
 RTS2    RTS
 *
 GETVAL  LBSR    CVBIN   ; GET VALUE
         BCC     OUTV
         CMPB    #'?     ; OF LITERAL
         BNE     VAR
         PSHS    X       ; OR INPUT
         LBSR    INLN
         BSR     EVAL
         PULS    X
 OUTD    LEAX    1,X
 OUTV    RTS
 *
 VAR     CMPB    #'$     ; OR STRING
         BNE     VAR1
         LBSR    INCH
         CLRA
         LEAX    1,X
         RTS
 *
 VAR1    CMPB    #'(
         BNE     VAR2
         LEAX    1,X
         BRA     EVAL
 *
 VAR2    BSR     CONVP   ; OR VARIABLE
         LDD     0,X     ; OR ARRAY ELEMENT
         LDX     VARADR  ; LOAD OLD INDEX
         RTS
 *
 ARRAY   LBSR    EVAL    ; LOCATE ARRAY ELEMENT
         ASLB
         ROLA
         ADDD    AMPR
         BRA     PACK
 *
 CONVP   LDB     ,X+     ; GET LOCATION
         PSHS    B
         CMPB    #':
         BEQ     ARRAY   ; OF VARIABLE OR
         CLRA            ; ARRAY ELEMENT
         ANDB    #$3F    ; mask out-of-variable-range
         ADDB    #$02    ; bump past "interrupt vectors"
         ASLB            ; make into offset (would be address in DP in original)
         ADDD    #ZERO   ; The 6801 can do this right.
 *
 PACK    STX     VARADR  ; STORE OLD INDEX
         STD     CNVPTR
         LDX     CNVPTR  ; LOAD NEW INDEX
         PULS    B
         RTS
 *
 EVAL2   CMPA    #'+     ; ADDITION
         BNE     EVAL3
         PULS    A
 ADD     ADDD    0,X
         RTS
 *
 EVAL3   CMPA    #'-     ; SUBTRACTION
         BNE     EVAL4
         PULS    A
 SUBTR   SUBD    0,X
         RTS
 *
 EVAL4   CMPA    #'/     ; SEE IF IT'S DIVIDE
         BNE     EVAL5
         PULS    A
         BSR     DIVIDE
         STD     REMN
         LDD     DIVQUO
         RTS
 *
 EVAL5   SUBA    #'=     ; SEE IF EQUAL TEST
         BNE     EVAL6
         PULS    A
         SUBD    0,X     ; missed this in the 6801 code!
         BNE     NOTEQ
         TSTB
         BEQ     EQL
 NOTEQ   LDB     #$FF
 EQL     BRA     COMBOUT
 *
 EVAL6   DECA            ; SEE IF LESS THAN TEST
         PULS    A
         BEQ     EVAL7
 *
 SUB2    SUBD    0,X
         ROLB
 COMOUT  CLRA
         ANDB    #$01
         RTS
 *
 EVAL7   BSR     SUB2    ; GT TEST
 COMBOUT COMB
         BRA     COMOUT
 *
 PWRS10  FCB     $27     ; 10000
         FCB     $10
         FCB     $03     ; 1000
         FCB     $E8
         FCB     $00     ; 100
         FCB     $64
         FCB     $00     ; 10
         FCB     $0A
         FCB     $00     ; 1
         FCB     $01
 *
 DIVIDE  CLR     MLDVCT  ; DEVIDE 16-BITS
 GOT     INC     MLDVCT
         ASL     1,X
         ROL     0,X
         BCC     GOT
         ROR     0,X
         ROR     1,X
         CLR     DIVQUO
         CLR     DIVQUO+1
 DIV2    SUBD    0,X
         BCC     OK
         ADDD    0,X
         ANDCC   #$FE
         BRA     DIVNOC  ; instead of the trick
 * The 6809 CMPX affects all relevant flags, can't use this trick.
 * And the op-codes are different in the 6809, too.
 *       FCB     $9C     ; CMPX
 OK      ORCC    #$01
 DIVNOC  ROL     DIVQUO+1
         ROL     DIVQUO
         DEC     MLDVCT
         BEQ     DONE
         LSR     0,X
         ROR     1,X
         BRA     DIV2
 *
 TSTN    LDB     0,X     ; TEST FOR NUMERIC
         CMPB    #$3A
         BPL     NOTDEC
         CMPB    #'0
         BGE     DONE
 NOTDEC  ORCC    #$01
         RTS
 DONE    ANDCC   #$FE
 DUN     RTS
 *
 CVTLN   BSR     INLN
 *
 CVBIN   BSR     TSTN    ; CONVERT TO BINARY
         BCS     DUN
 CONT    CLRA
         CLRB
 CBLOOP  ADDB    0,X
         ADCA    #$00
         SUBB    #'0
         SBCA    #$00
         STD     CVTSUM
         LEAX    1,X
         PSHS    B
         BSR     TSTN
         PULS    B
         BCS     DONE
         ASLB
         ROLA
         ASLB
         ROLA
         ADDD    CVTSUM
         ASLB
         ROLA
         BRA     CBLOOP
 *
 INLN6   CMPB    #'@     ; CANCEL
         BEQ     NEWLIN
         LEAX    1,X             ; '.'
         CMPX    #ZERO+LINLEN+2  ; (Here's part of what we had to fix for moving the variables.)
         BNE     INLN2
 NEWLIN  BSR     CRLF
 *
 INLN    LDX     #ZERO+2 ; INPUT LINE FROM TERMINAL
 INLN5   LEAX    -1,X
         CMPX    #ZERO   ; Make this explicit to enable variables moved out of DP.
         BEQ     NEWLIN  ; (Was implicit zero compare X from DEX, now explicit.)
 INLN2   LBSR    INCH    ; INPUT CHARACTER
         STB     BUFOFF-1,X      ; STORE IT
         CMPB    #$5F    ; BACKSPACE?
         BEQ     INLN5
 *
 INLIN3  CMPB    #$0D    ; CARRIAGE RETURN
         BMI     INLN2
         BNE     INLN6
 *
 INLIN4  CLR     BUFOFF-1,X      ; CLEAR LAST CHAR
         LDX     #LINBUF
         BRA     LF
 *
 * CRLF  JSR     EPCRLF
 CRLF    LDB     #$0D    ; CARR-RET
         BSR     OUTCH2
 LF      LDB     #$0A    ; LINE FEED
 OUTCH2  BRA     OUTCH
 *
 OKM     FCB     $0D
         FCB     $0A
         FCC     'OK'
         FCB     $00
 *
 *TRMINI LDAB #40
 *TRMILP JSR EPCRLF
 *       DECB
 *       BNE TRMILP
 *       RTS
 *
 * Color Computer BASIC ROM vectors
 INCHV   EQU     $A000   ; Scan keyboard 
 OUTCHV  EQU     $A002   ; Write char to screen
 *
 *       RECEIVER POLLING
 POLCAT  PSHS    A
         JSR     [INCHV] ; at any rate, don't wait. 
         TFR     A,B     ; because the source I'm working with expects it in B 
         ORCC    #$01
         BNE     POLCATR ; Don't wait.
         ANDCC   #$FE
 POLCATR PULS    A
         RTS
 *POLCAT LDAB    ACIACS
 *       ASRB
 *       RTS
 *
 *       INPUT ONE CHAR INTO B ACCUMULATOR
 INCH    BSR     POLCAT
         BCC     INCH    ; Wait here.
         BSR     OUTCH   ; echo
         RTS
 *
 *       OUTPUT ONE CHAR 
 OUTCH   PSHS    B,A
         TFR     B,A
         JSR     [OUTCHV]
         PULS    A,B
         RTS
 *
         ORG COLD
 *
         END