P*      
* El Cheapo Assembler
*
* A simple and straightforward assembler by
* one s. judd 1998
*

         REL
         DSK '@0:cheapo'

TEXT     EXT
CODEFLAG EXT
PRINTNUM EXT
STROUT   EXT
                          ; ORG $1000

VARTAB   = $C000
FILEBUF  = $8600

POINT    = $FE
CODEP    = $FB
TEXTP    = $F9
VARPNT   = $F7

COD      = $50

TEMPY    = $C0
TEMP     = $C1

FAC1     = $60
FAC2     = $69

SETLFS   = $FFBA
SETNAM   = $FFBD
OPEN     = $FFC0
CLOSE    = $FFC3
CHKIN    = $FFC6
CLRCHN   = $FFCC
CHROUT   = $FFD2
STOP     = $FFE1
GETIN    = $FFE4

* Errors

BADLINE  = 1
BADOP    = 2
BADMODE  = 3
BADNUM   = 4
BADVAR   = 5
BADVMEM  = 6              ;Too many variables
SYNERR   = 7
BADFIX   = 8
PHASERR  = 9
DUPVAR   = 10
BADBRAN  = 11
BADARG   = 12
ILVAR    = 13
NOQUOTE  = 14
DISKERR  = 15
PUTON    = 16
PUTMEM   = 17

ASSEMBLE ENT
INIT     
         LDA #1
         STA PASS

         LDA #00
         STA ERROR
         STA VARTAB
         STA DFBFLAG
         STA CODEFLAG
         STA PRFLAG
         LDA #$FF
         STA SREG
         STA DOFLAG
         STA FILEOPEN
         STA ATEOF

INIT2    
         LDA #00          ;Default $C000
         STA CURLINE
         STA CURLINE+1
         STA NBYTES
         STA NBYTES+1
         STA CODEP
         STA CODEP+2
         STA COD
         STA DORG
         STA DORG+2
         STA REGFLAG
         LDA #$C0
         STA CODEP+1
         STA DORG+1

         LDA #08          ;Always $010800
         STA COD+1
         LDA #1
         STA COD+2
         STA XLEN
         STA MLEN
         LDA #$FF
         STA SREG

         LDA TEXT
         STA TEXTP
         LDA TEXT+1
         STA TEXTP+1

         LDA #<VARTAB
         STA LASTGLOB
         LDA #>VARTAB
         STA LASTGLOB+1

READ     JSR STOP
         BEQ :EXIT2
         JSR READFILE
         INC CURLINE
         BNE :C1
         INC CURLINE+1
:C1      LDA PASS
         BNE :CONT
         JSR PRADDR
:CONT    LDY #00
         LDA DOFLAG
         BNE :CONT2
         JSR DOREME       ;C set means ELSE or FIN found.
         BCS :NEXT
         BCC :PRLINE
:CONT2   
         STY NOUT
         LDA (TEXTP),Y
         AND #$7F
         BEQ :DONE
         CMP #'*'
         BEQ :COM
         CMP #';'
         BEQ :COM
         CMP #13
         BEQ :CR          ;C is *set*
         CMP #32
         BEQ :GETOP
         JSR ADDVAR
         LDX ERROR
         BNE PRERR
:GETOP   JSR NEXTCHAR
         BCC :PRLINE
         JSR GETOP
         LDX ERROR
         BNE PRERR
:NEXT    JSR NEXTCHAR
         BCS :ERR         ;Should be no more valid chars
         BEQ :DONE
:PRLINE  LDA PASS
         BNE :ADD
         JSR PRLINE
:CLC     CLC
:ADD     TYA
         ADC TEXTP        ;And advance...
         STA TEXTP
         BCC READ
         INC TEXTP+1
         BCS READ
:DONE    DEC PASS
         BMI :EXIT
         JMP INIT2
:EXIT    JMP EXIT
:EXIT2   JMP CLOSEFILE

:CR      INY
         CLC
         BCC :PRLINE

:COM     JSR NEXTLINE
         BCC :PRLINE

:ERR     LDX #BADLINE     ;Garbage in the line
PRERR    
         TXA
         ASL
         TAX
         LDA ERRTAB,X
         STA POINT
         LDA ERRTAB+1,X
         STA POINT+1

         JSR CLOSEFILE

         JSR STROUT
         DFB 13
         TXT 'Line ',00
         LDA CURLINE      ;Line number
         LDX CURLINE+1
         LDY #10          ;Base
         JSR PRINTNUM
         JSR STROUT
         TXT ': ',00
         LDY #00
:L1      LDA (TEXTP),Y    ;Line
         JSR CHROUT
         CMP #13
         BEQ :C1
         INY              ;Horribly mangled lines won't
         BNE :L1          ;error
:C1      JSR CHROUT       ;Extra CR
         LDY #00
:L2      LDA (POINT),Y    ;Error
         JSR CHROUT
         INY
         CMP #13
         BNE :L2

         RTS

EXIT     JSR STROUT
         DFB 13
         TXT 'assembly sucessful -- ',00
         LDA NBYTES
         LDX NBYTES+1
         LDY #10
         JSR PRINTNUM
         JSR STROUT
         TXT ' bytes',0d
         TXT '$',00
         LDA DORG
         LDX DORG+1
         LDY #16
         JSR PRINTNUM
         JSR STROUT
         TXT '-$',00
         LDA DORG
         CLC
         ADC NBYTES
         PHA
         LDA DORG+1
         ADC NBYTES+1
         TAX
         PLA
         LDY #16
         JSR PRINTNUM

         LDA NBYTES
         STA CODEEND
         LDA NBYTES+1
         CLC
         ADC #08          ;0800+NBYTES
         STA CODEEND+1
         DEC CODEFLAG     ;Successful assemble
         RTS

         TXT 'hola d00d'

ASSERR   ENT
ERROR    DFB 00
PASS     DFB 00
NOUT     DFB 00           ;Number of bytes outputted
SREG     DFB $FF          ;Status register
REGFLAG  DFB 00
XLEN     DFB 01           ;length of LDX #
MLEN     DFB 01           ;length of LDA #

ASSLINE  ENT
CURLINE  DA 00            ;Current line

DORG     ENT
         DS 3             ;"Master" ORG

CODELEN  ENT
NBYTES   DA 00

CODEEND  ENT
         DA 00

PRFLAG   DFB 00           ;To print, or not to print...
DOFLAG   DFB $FF          ;Do be do be do (0=OFF)
FILEOPEN DFB $FF
ATEOF    DFB $FF
LASTLINE DA 00
LASTTEXT DA 00
SAVETEXT DFB 00

*
* If a PUT file is open, then read from file
*
READFILE 
         LDA FILEOPEN
         BNE :RTS
         LDA SAVETEXT
         BNE :C1
         DEC SAVETEXT
         LDA TEXTP
         STA LASTTEXT
         LDA TEXTP+1
         STA LASTTEXT+1
:C1      LDA ATEOF
         AND #$40
         BNE :DONE
         LDA #<FILEBUF
         STA TEXTP
         LDA #>FILEBUF
         STA TEXTP+1

         LDX #00
:L1      STX TEMP
         JSR GETIN
         LDX TEMP
         STA FILEBUF,X
         CMP #13
         BEQ :EOL
         INX
         BNE :L1
:EOL     LDA $90
         STA ATEOF
:RTS     RTS

:DONE    
CLOSEFILE
         LDA FILEOPEN
         BNE :RTS
         LDA #2
         JSR CLOSE
         JSR CLRCHN
         LDA LASTTEXT
         STA TEXTP
         LDA LASTTEXT+1
         STA TEXTP+1
         LDA LASTLINE
         STA CURLINE
         LDA LASTLINE+1
         STA CURLINE+1
         LDA #$FF
         STA FILEOPEN
:RTS     RTS

*
* Print out the just-assembled line
*
PRLINE   
         STY TEMPY
         LDY PRFLAG
         BNE :DONE
* LDY #00
         LDA #32
         LDX NOUT         ;Line up spaces
         CPX #4
         BEQ :CONT
:L2      JSR CHROUT
         JSR CHROUT
         JSR CHROUT
         INX
         CPX #4
         BCC :L2
:CONT    
         LDA (TEXTP),Y
         CMP #';'
         BEQ :REST
         CMP #'*'
         BEQ :REST
         LDX #9           ;Columns
         JSR :PRINT
         BCC :DONE

         LDX #4
         JSR :PRINT       ;Print opcode
         BCC :DONE

:REST    LDA (TEXTP),Y    ;Print rest of line
         JSR CHROUT
         INY
         CPY TEMPY
         BCC :REST

:DONE    JSR GETIN
         CMP #'_'
         BNE :DONE2
         EOR PRFLAG
         STA PRFLAG
:DONE2   LDY TEMPY
         RTS

:PRINT   
:LOOP    LDA (TEXTP),Y    ;Print label
         JSR CHROUT
         INY
         DEX
         AND #$7F
         CMP #32
         BCC :RTS         ;Space or CR terminates
         BNE :LOOP
:LOOP2   DEX              ;Move to next column
         BMI :RTS
         JSR CHROUT
         SEC
         BCS :LOOP2
:RTS     RTS              ;C clear -> CR

*
* CODEOUT
*
* This little guy outputs the byte in A into the code
* pointed to by CODEP, and increments CODEP.
*
* CODEP = code address, COD = physical address
*
* X Y and A are preserved (but TEMPy is hosed :)
*
CODEOUT  
         STY TEMPY
         INC NBYTES
         BNE :C0
         INC NBYTES+1
:C0      INC CODEP
         BNE :C1
         INC CODEP+1
:C1      LDY PASS
         BNE :DONE
         PHA
         LDA NOUT
         CMP #4
         BCC :CONT
         STY NOUT         ;New line
         LDA #13
         JSR CHROUT
         JSR PRADDR
:CONT    PLA
                          ; STA (COD),Y ;.Y = 0
         DFB $87          ;STA []
         DFB COD
         LDY PRFLAG
         BNE :INC
         PHA
         JSR PRHEX
         LDA #32
         JSR CHROUT
         PLA
:INC     INC NOUT
         INC COD
         BNE :DONE
         INC COD+1
:DONE    LDY TEMPY
         RTS

PRHEX    PHA
         LSR
         LSR
         LSR
         LSR
         JSR :PR
         PLA
         AND #$0F
:PR      CMP #10
         SED
         ADC #00
         CLD
         ADC #48
         JMP CHROUT


*
* TERMCHAR
*
* Check for a character which can legally terminate
* a variable.
*
TERMCHAR 
         LDA (TEXTP),Y
         CMP #224
         BEQ :DONE
         AND #$7F
         CMP #13
         BEQ :DONE
         CMP #' '
         BEQ :DONE
         CMP #','         ;Indexed mode
         BEQ :DONE
         CMP #')'         ;zp
         BEQ :DONE
         CMP #']'         ;zp long
         BEQ :DONE
         CMP #'+'
         BEQ :DONE
         CMP #'-'
:DONE    RTS

*
* GETOP
*
* GETOP is the opcode parser.  It just searches the
* opcode table and calls the appropriate parse routine.
*
* The opcodes must be stored in alphabetical order,
* 5 bytes per entry:
*
*    3 byte mnemonic, 2 byte address
*

MNEM     DFB 0,0,0
JUMPADR  DA 0
OPCODE   DFB 00

GETOP    
         LDA (TEXTP),Y
         CMP #'='
         BNE :NOPE
         INY
         JMP IEQU

:NOPE    LDA #<OPTAB
         STA POINT
         LDA #>OPTAB
         STA POINT+1

         LDX #$00
:L1      LDA (TEXTP),Y
         AND #$7F
         CMP #96
         BCC :SKIP
         AND #$5F         ;Convert to lower-case
:SKIP    STA MNEM,X
         INY
         INX
         CPX #3
         BNE :L1
         STY TEMPY

         LDY #$00
         LDX #00
:LOOP    LDA MNEM,X       ;Get character
:LOOP2   CMP (POINT),Y    ;See if matches a valid keyword
         BCC :ERR         ;If less than, then we have a
                          ;syntax error
         BEQ :CONT        ;A-ha!  A match!
         LDA POINT        ;Otherwise, move forwards
         ADC #5           ;carry is set
         STA POINT
         BCC :LOOP
         INC POINT+1
         BNE :LOOP
:ERR     LDA #BADOP       ;Bad opcode
         STA ERROR
         RTS
:CONT                     ;A successful match
         INX              ;match next character
         INY
         CPX #3
         BNE :LOOP
         LDA (POINT),Y    ;Otherwise, get address
         STA JUMPADR
         INY
         LDA (POINT),Y
         STA JUMPADR+1
         INY
         LDA (POINT),Y    ;Opcode
         LDY TEMPY
         JMP (JUMPADR)    ;Off we go!

*
* Output opcode and argument
*
* On entry, .A = opcode and TEMP=arg length
*
PCODE    
         LDX #$FF
:LOOP    JSR CODEOUT
         INX
         LDA ARG1,X
         CPX TEMP
         BCC :LOOP
RTS1     RTS
PRADDR   
         LDA PRFLAG
         BNE RTS1
         LDA FILEOPEN
         BNE :C1
         LDA #'>'
         JSR CHROUT
:C1      LDA #':'
         JSR CHROUT
         LDA CODEP+1
         JSR PRHEX
         LDA CODEP
         JSR PRHEX
         LDA #32
         JMP CHROUT

*
* LDA type instructions.  STA is handled as a special case
*

LDATYPE  
         STA OPCODE
         JSR READARG
         LDX ARGTYPE
         LDA LDATAB,X     ;Corrections to base opcode
         BMI :ERR
         LDX MLEN         ;First check immediate
         CMP #$09
         BEQ :STX
         LDX #1           ;arg length
         CMP #$0D         ;abs might change it
         BEQ :ABS
         CMP #$1D         ;same for abs,x
         BEQ :ABS
         CMP #$19         ;and abs,y is always 2 bytes
         BNE :OUT
         LDX #2
:OUT     CPX ARGLEN       ;Make sure argument isn't larger
         BCC :ERR         ;than possible e.g. LDA ($1234)
:STX     STX TEMP
         ORA OPCODE
         CMP #$89         ;This would be STA #
         BEQ :ERR
         JMP PCODE

:ABS     LDX ARGLEN       ;low nybble is 5, D, or F
         CPX #2
         BEQ :OUT
         AND #$F5         ;zp -- takes 0D -> 05
         CPX #1
         BEQ :OUT
         ORA #$0F
         LDX #03          ;Juuuuust in case!
         BNE :OUT

:ERR     LDA #BADMODE     ;Illegal addressing mode
         STA ERROR
         RTS

* Argument types:
*   0 = no arg   1 = immediate  2 = absolute
*   3 = abs,x    4 = abs,y      5 = abs,s
*   6 = abs,abs
*   7 = (zp)     8 = (zp),y     9 = (zp,x)
*  10 = (zp,s),y 11= [zp]      12 = [zp],y

*
* Opcodes are constructed by ORAing below with "base"
* opcode.  High bit set means illegal addressing mode.
*
LDATAB   DFB $FF,$09,$0D,$1D,$19,$03
         DFB $FF,$12,$11,$01,$13,$07,$17

*
* JSR instruction
*
IJSR     
         JSR READARG
         LDX ARGTYPE
         CPX #2           ;abs
         BNE :IND
         LDA #$22         ;JSR long
         LDX ARGLEN
         CPX #3
         BEQ :OUT
         LDA #$20
:X2      LDX #2
:OUT     STX TEMP
         JMP PCODE
:IND     LDA #$FC
         CPX #9           ;JSR (addr,x)
         BEQ :X2
:ERR     LDA #BADMODE     ;Illegal addressing mode
         STA ERROR
         RTS

* Implied instructions
* ... are handled automatically!

* ASL type instructions
* Also BIT, LDX, LDY

IBIT     
ASLTYPE  
         STA OPCODE
         JSR READARG
         LDX ARGTYPE
         BEQ :ACC
         DEX              ;immed -- BIT LDX LDY only
         BEQ :BIT
         DEX              ;zp or addr
         BEQ :ADDR
         DEX              ;zp,x or addr,x
         BNE :ERR
         LDA #$14         ;zp,x
         DFB $2C
:ADDR    LDA #$04         ;zp
         LDX ARGLEN
         STX TEMP
         DEX
         BEQ :ORA
         DEX
         BNE :ERR         ;2 bytes max
         ORA #$0C
:ORA     ORA OPCODE
:JMP     JMP PCODE

:ACC     STX TEMP
         LDA #$0A
         LDX OPCODE
         BMI :DEC         ;DEC and INC have different form
         CPX #$20         ;BIT
         BNE :ORA
         BEQ :ERR
:DEC     
         CPX #$C0         ;LDX and LDY < $C0
         BCC :ERR
         LDA #$1A
         CPX #$E0         ;INC
         BEQ :JMP
         LDA #$3A
         BNE :JMP

:BIT     LDX XLEN
         LDA OPCODE
         BPL :C1
         STX TEMP
         CMP #$C0         ;LDX LDY check
         BCC :JMP
         BCS :ERR         ;INC/DEC
:C1      LDX MLEN
         STX TEMP
         CMP #$20         ;BIT
         BNE :ERR
         LDA #$89
         BEQ :JMP

:ERR     LDA #BADMODE     ;Illegal addressing mode
         STA ERROR
         RTS

* Branch instructions, PER

LONGREL  
BRANCH   
         PHA
         JSR READARG
         PLA
         STA OPCODE
         LDX ARGTYPE
         CPX #2           ;Abs only
         BNE :ERR
         DEX
         SEC
         AND #$02         ;BRL/PER
* STA TEMP
         BEQ :SHORT
         INX
         CLC              ;long is arg-*-3
:SHORT   LDA ARG1
         SBC #2
         STA ARG1
         BCS :C1
         DEC ARG1+1
:C1      STX TEMP

         LDA ARGLEN
         CMP #3
         BCS :ERR2
         LDA ARG1
         SEC
         SBC CODEP        ;arg-*-2
         STA ARG1
         LDA ARG1+1
         SBC CODEP+1
         BVS :ERR2
         STA ARG1+1

         DEX              ;Arg length
         BNE :LONG

         LDA ARG1         ;0-$007F and $FFFF-$FF80 only
         CLC
         ADC #$80         ;+128 gives 0-$00FF
         LDA ARG1+1
         ADC #00
         BNE :ERR2

:LONG    LDA OPCODE
         JMP PCODE

:ERR     LDX ERROR
         BNE :RTS
         LDX #BADMODE
         DFB $2C
:ERR2    LDX #BADBRAN
         STX ERROR
:RTS     RTS

* BRK and COP can in principle have an argument, so
* what the heck.

IBRK     
         PHA
         JSR READARG
         PLA
         LDX ARGTYPE
         BEQ :JMP
         CPX #2
         BNE :ERR         ;Bizarre
:JMP     LDX ARGLEN
         STX TEMP
         JMP PCODE
:ERR     LDX #BADMODE
         STX ERROR
         RTS

* CPX and CPY

ICPX     
         PHA
         JSR READARG
         PLA
         LDX ARGTYPE
         DEX
         BEQ :IMMED
         DEX
         BNE :ERR
         ORA #$04
         LDX ARGLEN
         CPX #1
         BEQ :JMP
         ORA #$0C
         CPX #2
         BNE :ERR
:IMMED   LDX XLEN
:JMP     STX TEMP
         JMP PCODE
:ERR     LDX #BADMODE
         STX ERROR
         RTS

* Go ahead, and juuu-ump

IJMP     
         JSR READARG
         LDX ARGTYPE
         CPX #12
         BCS :ERR
         LDA :TAB,X
         BMI :CHK
         LDX #2
         CMP #$4C
         BNE :STX
         CPX ARGLEN
         BCS :STX
         INX
         ORA #$10         ;Long jmp
:STX     CPX ARGLEN       ;e.g. (long)
         BCC :ERR
         STX TEMP
         JMP PCODE

:CHK     LDX #$02
         CMP #$DC
         BEQ :STX
:ERR     LDX #BADMODE
         STX ERROR
         RTS

:TAB     DFB $FF,$FF,$4C,$FF,$FF,$FF,$FF
         DFB $6C,$FF,$7C,$FF,$DC

* Long jump/jsr

IJML     
         PHA
         JSR READARG
         PLA
         LDX ARGTYPE
         CPX #2
         BNE ERR1
         INX
         STX TEMP
         JMP PCODE

IMOVE    
         JSR CODEOUT
         JSR READARG
         LDA ARGTYPE
         CMP #6
         BNE ERR1
         LDA ARG1+1
         ORA ARG1+2
         BNE ERR1
         LDA ARG2+1
         ORA ARG2+2
         BNE ERR1
         LDA ARG1
         JSR CODEOUT
         LDA ARG2
         JMP CODEOUT
ERR1     LDX #BADMODE
         STX ERROR
         RTS
IPEA     
         PHA
         JSR READARG
         PLA
         LDX ARGTYPE
         CPX #2
         BNE ERR1
IPEA1    CPX ARGLEN
         BCC ERR1
         STX TEMP
         JMP PCODE

IPEI     
         PHA
         JSR READARG
         PLA
         LDX ARGTYPE
         CPX #7
         BNE ERR1
         LDX #1
         BNE IPEA1

IREP     
         STA OPCODE
         JSR READARG
         LDX REGFLAG
         BMI :CONT2
         LDA OPCODE
         CMP #$C2
         BNE :SEP
         LDA ARG1
         EOR #$FF
         AND SREG
         STA SREG
         JMP :CONT
:SEP     LDA ARG1
         ORA SREG
         STA SREG
:CONT    JSR SETREG       ;.A = SREG
:CONT2   LDA OPCODE
         LDX ARGTYPE
         CPX #1
         BNE ERR1
         BEQ IPEA1

ISTX     
         PHA
         JSR READARG
         PLA
         LDX ARGTYPE
         CPX #2
         BNE :C1
         LDX ARGLEN
         CPX #3
         BCS ERR2
         CPX #2
         BNE :STX
         ORA #$0C
:STX     STX TEMP
         JMP PCODE

:C1      CPX #5
         BCS ERR2
         CMP :TAB1,X
         BNE ERR2
         ORA #$10
         LDX #1
         CMP ARGLEN
         BEQ :STX
         BNE ERR2

:TAB1    DFB 00,00,00,$84,$86

ISTZ     
         JSR READARG
         LDX ARGTYPE
         CPX #2
         BNE :C1
         LDA #$9C
         CPX ARGLEN
         BEQ :STX
         BCC ERR2
         DEX
         LDA #$64
:STX     STX TEMP
         JMP PCODE

:C1      LDA #$9E
         CPX #3
         BNE ERR2
         LDX #2
         CPX ARGLEN
         BEQ :STX
         BCC ERR2
         DEX
         LDA #$74
         BNE :STX

ERR2     LDX #BADMODE
         STX ERROR
         RTS
ITRB     
         PHA
         JSR READARG
         PLA
         LDX #2
         CPX ARGTYPE
         BEQ ERR2
         CPX ARGLEN
         BEQ :C1
         BCC ERR2
         DEX
         DFB $2C
:C1      ORA #$0C
:STX     STX TEMP
         JMP PCODE

*
* Pseudo-opcodes
*
DFBFLAG  DFB 00
DFBLEN   DFB 00

                          ;Define address (.A = length)
IDFB     STA DFBLEN       ;Define byte
         INC DFBFLAG
:LOOP    JSR READARG
         LDA ARGTYPE
         BEQ ERR3
         CMP #3
         BCS ERR3
         LDA ARG1
         JSR CODEOUT
         LDX DFBLEN
         DEX
         BEQ :CHK
         LDA ARG1+1       ;Address
         JSR CODEOUT
         DEX
         BEQ :CHK
         LDA ARG1+2
         JSR CODEOUT
:CHK     JSR CHKCOM
         BNE :DONE
         INY
         BNE :LOOP

:DONE    DEC DFBFLAG
         RTS

ERR3     LDA #BADARG
         STA ERROR
         RTS

DSBYTE   DFB 00
IDS                       ;Define storage
         JSR NEXTCHAR
         BCC ERR3
         INC DFBFLAG      ;Handle commas special
         LDA #00
         STA DSBYTE
         LDA (TEXTP),Y
         CMP #'^'         ;Fill to end of page
         BEQ :FILL
         JSR READARG
         LDX ARG1         ;Number of bytes
         LDA ARGTYPE
         CMP #2
         BNE ERR3
:CHK     JSR CHKCOM
         BNE :C2
         TXA
         PHA
         INY
         JSR READARG
         PLA
         TAX
         LDA ARGTYPE
         CMP #2
         BNE ERR3
         LDA ARG1
         STA DSBYTE
:C2      TXA
         BEQ :RTS
         LDA DSBYTE
:L2      JSR CODEOUT
         DEX
         BNE :L2
:RTS     DEC DFBFLAG
         RTS

:FILL    LDA #00
         SEC
         SBC CODEP        ;Number of bytes
         TAX
         INY
         BNE :CHK


VSAVE    DFB 0,0          ;Variable table position
IEQU                      ;Equate
         STY TEMPY
         LDY #00          ;First make sure a label is
         LDA (TEXTP),Y    ;present
         AND #$7F
         CMP #32
         BEQ :ERR
         LDA VARPNT       ;Label present means ADDVAR just
         STA VSAVE        ;added to list and VARPNT points
                          ;exactly to it.
         LDA VARPNT+1
         STA VSAVE+1

         LDY TEMPY
         JSR READARG
         LDA ARGTYPE
         CMP #2
         BNE :ERR2
         LDA VSAVE
         STA VARPNT
         LDA VSAVE+1
         STA VARPNT+1
         STY TEMPY
         JSR ROMOUT
         LDY #03
:L1      LDA ARG1-1,Y
         STA (VARPNT),Y
         DEY
         BNE :L1
         LDA #$FE         ;Change variable type
         STA (VARPNT),Y
         JSR ROMIN
         LDY TEMPY
         RTS

:ERR2    LDA #BADARG
         DFB $2C
:ERR     LDA #BADVAR
         STA ERROR
         RTS

ITXT     
         JSR NEXTCHAR
         BCC :ERR
         LDA (TEXTP),Y
         CMP #39          ;single quote
         BEQ :OK
         CMP #34
         BNE :ERR
:OK      STA TEMP
:LOOP    INY
         LDA (TEXTP),Y
         CMP TEMP
         BEQ :DONE
         JSR CODEOUT
         CMP #13
         BNE :LOOP
         LDA #NOQUOTE
         DFB $2C
:ERR     LDA #BADARG      ;Oops
         STA ERROR
         RTS
:DONE    INY
         JSR CHKCOM       ;Hex bytes may follow
         BNE :RTS
         INY
         JSR READHEX
         JSR CODEOUT
         LDA ERROR
         BNE :DONE
:RTS     RTS

IREG     
         JSR NEXTCHAR
         BCC ERR4
         LDA (TEXTP),Y
         AND #$5F
         CMP #'o'
         BEQ RONOFF
         JSR READARG
         LDX ARGTYPE
         CPX #1
         BNE ERR4
         BEQ SETREG
         LDA ARG1
         STA SREG
SETREG   LDX #1
         PHA
         AND #$20
         BNE :C1
         INX
:C1      STX MLEN
         LDX #1
         PLA
         AND #$10
         BNE :C2
         INX
:C2      STX XLEN
         RTS

RONOFF   INY
         LDA (TEXTP),Y
         AND #$5F
         CMP #'n'
         BNE :OFF
         LDA #00
         STA REGFLAG
:INY     INY
         RTS
:OFF     CMP #'f'
         BNE ERR4
         LDA #$FF
         STA REGFLAG
         INY
         LDA (TEXTP),Y    ;Might as well check...
         CMP #'f'
         BEQ :INY
ERR4     LDA #BADARG
         STA ERROR
         RTS

IORG     
         JSR READARG
         LDX ARGTYPE
         BEQ :REORG
         CPX #2
         BNE ERR4
:LOOP    LDA ARG1,X
         STA CODEP,X
         DEX
         BPL :LOOP
         LDA NBYTES       ;If first ORG then set DORG
         ORA NBYTES+1
         BNE :RTS
         LDX #2
:L2      LDA CODEP,X
         STA DORG,X
         DEX
         BPL :L2
:RTS     RTS

:REORG   LDA DORG
         CLC
         ADC NBYTES
         STA CODEP
         LDA DORG+1
         ADC NBYTES+1
         STA CODEP+1
         LDA DORG+2
         ADC #00
         STA CODEP+2
         RTS

IHEX     
         JSR NEXTCHAR
:LOOP    JSR READHEX
         BCS :RTS
         JSR CODEOUT
         LDA (TEXTP),Y
         AND #$7F
         BEQ :RTS
         CMP #13
         BEQ :RTS
         CMP #32
         BEQ :RTS
         INY
         BNE :LOOP
         INC ERROR        ;Strange...
:RTS     RTS

* Read a hex byte
* On exit: C set -> error

READHEX  
         LDA #00
         STA TEMP
         JSR :READ
         BCS :RTS         ;Error
         ASL
         ASL
         ASL
         ASL
         STA TEMP
:READ    LDA (TEXTP),Y
         AND #$7F
         SEC
         SBC #48
         CMP #10
         BCC :C1
         SBC #7
:C1      CMP #16
         BCC :RTS
         LDA #BADNUM
         STA ERROR
         DEY
:RTS     ORA TEMP
         INY
         RTS

* Conditional assembly instructions

IDO      
         JSR READARG
         LDX ARGTYPE
         CPX #2           ;abs
         BNE DOERR
         LDA ARG1
         ORA ARG1+1
         ORA ARG1+2
         STA DOFLAG
         RTS

DOERR    LDA #BADARG
         STA ERROR
         RTS

IELSE    
         LDA DOFLAG
         BNE :C1
         LDA #$FF
:C1      EOR DOFLAG
         STA DOFLAG
         LDA (TEXTP),Y
         CMP #$0D
         BEQ :RTS
         INY
:RTS     RTS

DOREME                    ;Check for ELSE or FIN
         JSR NEXTCHAR
         BCC IFINRTS
         LDA (TEXTP),Y
         AND #$5F
         CMP #'e'
         BNE :FIN
         INY
         LDA (TEXTP),Y
         AND #$5F
         CMP #'l'
         BNE :NEXT
         INY
         LDA (TEXTP),Y
         AND #$5F
         CMP #'s'
         BNE :NEXT
         INY
         BNE IELSE
:NEXT    JMP NEXTLINE

:FIN     CMP #'f'
         BNE :NEXT
         INY
         LDA (TEXTP),Y
         CMP #'i'
         BNE :NEXT
         INY
         LDA (TEXTP),Y
         CMP #'n'
         BNE :NEXT
         INY
IFIN     
         LDA #$FF
         STA DOFLAG
IFINRTS  RTS

* Disk i/o ops

IPUT     
         LDA FILEOPEN
         BEQ :ERR3
         LDA TEXTP+1
         CMP #>FILEBUF
         BCS :ERR4
         JSR NEXTCHAR
         BCC DOERR
         CMP #39          ;'
         BEQ :CONT
         CMP #34
         BNE DOERR
:CONT    STA TEMP
         TYA
         ADC TEXTP        ;C is set
         STA FAC1
         LDA TEXTP+1
         ADC #00
         STA FAC1+1

         LDX #00
:L1      INY
         LDA (TEXTP),Y
         CMP TEMP
         BEQ :OUT
         CMP #13
         BEQ :ERR
         INX
         BNE :L1
:OUT     INY
         STY TEMPY
         TXA              ;Length
         LDX FAC1
         LDY FAC1+1
         JSR SETNAM
         LDA #2
         TAY
         LDX $BA
         JSR SETLFS
         LDX #2
         JSR OPEN
         BCS :ERR2
         LDX #2
         JSR CHKIN
         LDA CURLINE
         STA LASTLINE
         LDA CURLINE+1
         STA LASTLINE+1
         LDA #00
         STA CURLINE
         STA CURLINE+1
         STA FILEOPEN
         STA ATEOF
         STA SAVETEXT
         RTS
:ERR4    LDA #PUTMEM
         DFB $2C
:ERR3    LDA #PUTON
         DFB $2C
:ERR2    LDA #DISKERR
         DFB $2C
:ERR     LDA #NOQUOTE
         STA ERROR
         RTS



*-------------------------------
*
* Variable processing routines
*
*-------------------------------

*
* ROMOUT and ROMIN -- Vartab can lie under roms
*

ROMOUT   PHA
         SEI
         LDA #$38
         STA $01
         PLA
         RTS

ROMIN    PHA
         LDA #$36
         STA $01
         PLA
         CLI
         RTS


*
* ADDVAR
*
* Addvar is used to add variables to the variable table.
* Variables have the form
*
*    name type lo med hi
*
* where type has high bit set.  The list is
* terminated with a null byte.  Current types are:
*
*   $FF  Normal label
*   $FE  EQUated label
*

LOCFLAG  DFB 00
LASTGLOB DA 00            ;pointer

ADDVAR   
         JSR ROMOUT
         LDA PASS
         BEQ :PASS2
         JSR FINDVAR
         BCS :ERROR
         JSR COPYVAR
         BCC :ERROR
         STY TEMPY
         LDA #$FF
         LDY #$00
         STA (VARPNT),Y
:LOOP    LDA CODEP,Y
         INY
         STA (VARPNT),Y
         CPY #3
         BNE :LOOP
         INY
         LDA #00
         STA (VARPNT),Y   ;end of variables
         BEQ :SAVELOC
:ERROR   LDA ERROR
         BNE :RTS         ;Out of mem
         LDA #DUPVAR
         STA ERROR
:RTS     JMP ROMIN

:PASS2                    ;Compare with earlier value to
                          ;check for phase errors
         JSR FINDVAR      ;FINDVAR sets LOCFLAG
         BCC :ERROR
         STY TEMPY
         LDY #00
         LDA (VARPNT),Y
         CMP #$FE         ;Don't worry about equates
         BEQ :LDY
         LDY #3
:L2      LDA CODEP-1,Y
         CMP (VARPNT),Y
         BNE :ERR2
         DEY
         BNE :L2
:SAVELOC 
         LDA LOCFLAG      ;If global, then save address
         BEQ :LDY         ;of next var.
         LDA VARPNT
         CLC
         ADC #4
         STA LASTGLOB
         LDA VARPNT+1
         ADC #00
         STA LASTGLOB+1
:LDY     LDY TEMPY
         JMP ROMIN

:ERR2    LDA #PHASERR
         STA ERROR
         JMP ROMIN

COPYVAR  
         LDX #00
         LDY TEMPY
         LDA (TEXTP),Y
         CMP #':'         ;Must start with : or letter
         BEQ :STA
         BNE :CMP
:L1      LDA (TEXTP),Y
         CMP #224         ;tab
         BEQ :DONE
         AND #$7F
         CMP #32
         BEQ :DONE        ;Only space or CR terminates var
         CMP #$0D
         BEQ :DONE
         CMP #48
         BCC :ERROR
         CMP #58
         BCC :STA
:CMP     CMP #65
         BCC :ERROR
         AND #$5F         ;Valid chars are 0-9, a-z ] [ etc.
:STA     STA (VARPNT,X)
         INY
         INC VARPNT
         BNE :L1
         INC VARPNT+1
         BNE :L1
         LDA #BADVMEM     ;WAY too many vars
         DFB $2C
:ERROR   LDA #ILVAR
         STA ERROR
         CLC
         RTS
:DONE    SEC
         RTS

*
* Find a variable in the variable list.  If found,
*
* On exit:
*    C set -> Variable found, VARPNT points to last char
*    C clr -> Variable not found, VARPNT points to end
*             of variable list.
*
* In both cases, .Y is advanced to the character
* immediately following the variable, and TEMPY
* contains the first character of the variable.
* This way, expressions like BLAH+12 may be
* correctly evaluated even if BLAH has not yet
* been defined.
*
* The list is terminated with a null byte.
*

FINDVAR  
         LDA #<VARTAB     ;Start at beginning of list
         STA VARPNT
         LDA #>VARTAB
         STA VARPNT+1
         STY TEMPY
         LDA (TEXTP),Y
         SEC
         SBC #':'
         STA LOCFLAG
         BNE :GLOBAL
         LDA LASTGLOB     ;Start search from last global
         STA VARPNT
         LDA LASTGLOB+1
         STA VARPNT+1
:GLOBAL  
         LDX #00
:LOOP2   LDY TEMPY
         LDA (VARPNT,X)
         BEQ :EXIT
         CMP #':'         ;Local variable check
         BEQ :LOOP
         LDA LOCFLAG      ;Exit if next global reached
         BEQ :EXIT
:LOOP    LDA (VARPNT,X)
         BMI :MATCH       ;matched all chars
         CMP (TEXTP),Y
         BEQ :NEXT
         CMP #65          ;Upper-case perhaps?
         BCC :NEXTVAR
         LDA (TEXTP),Y
         AND #$5F         ;lower-case
         CMP (VARPNT,X)
         BEQ :NEXT        ;minor kludge

:NEXTVAR LDY #$FF         ;otherwise advance to next variable
:L3      INY
         LDA (VARPNT),Y
         BPL :L3
         TYA
         CLC
         ADC #4           ;Hopefully no 250-character
         ADC VARPNT       ;variables :)
         STA VARPNT
         BCC :LOOP2
         INC VARPNT+1
         BCS :LOOP2

:NEXT    INY              ;Advance to next char
         INC VARPNT
         BNE :LOOP
         INC VARPNT+1
         BNE :LOOP

:MATCH                    ;Make sure really at the
         JSR TERMCHAR     ;last char
         BNE :NEXTVAR
         SEC              ;Thar she is
         RTS

:EXIT    JSR TERMCHAR     ;Advance to next char
         BEQ :CLC
         INY
         BNE :EXIT
:CLC     CLC
         RTS

*
* NEXTCHAR: Advance to next relevant character in the
* text.  Either skips space or advances to the next line.
*
* Strategy: advance through the text until a non-space
* character is found.  If character is 00 then we are at
* EOF.  If char is ; then advance to end of line.  If character
* is CHR$(13) then add one to pointer and exit.
*
* On entry:
*    Y is set to the current position within TEXTP
*
* On exit:
*       Z set -> At EOF
*       C clear -> At end of line
*       Y contains index into next relevant character
*
NEXTCHAR 
:LOOP    LDA (TEXTP),Y
         CMP #224
         BEQ :INY
         AND #$7F
         CMP #32
         BNE :OUT
:INY     INY
         BNE :LOOP
:OUT     
         CMP #00
         BEQ :CLC
:COM     CMP #';'
         BEQ NEXTLINE
:NEXT    CMP #13          ;If CHR$(13) then advance
         BEQ :INY2
         SEC
         RTS
:INY2    INY
:CLC     CLC
         TAX              ;Set Z correctly
         RTS

* Move to the end of the line + 1

NEXTLINE INY
         LDA (TEXTP),Y
         AND #$7F
         CMP #13
         BNE NEXTLINE
         CLC
         INY              ;Better not be zero!
         RTS

*
* READARG
*
* READARG parses the operand.  It first checks for any
* leading character, and if it doesn't find one assumes
* that the data is an absolute address or variable.
*
* Basic mathematical operations (+ - / *) are supported
* in a first-come first-serve basis.
*
* Argument types:
*   0 = no arg   1 = immediate  2 = absolute
*   3 = abs,x    4 = abs,y      5 = abs,s
*   6 = abs,abs
*   7 = (zp)     8 = (zp),y     9 = (zp,x)
*  10 = (zp,s),y 11= [zp]      12 = [zp],y
*

ARGLEN   DFB 00
ARGTYPE  DFB 00           ;Argument type (abs, zp, etc.)
ARG1     DFB 0,0,0,0      ;Main argument
ARG2     DFB 0,0,0,0      ;MVN/MVP arguments
PREFIX   DFB 00           ;Prefix char < > ! ^

READARG  
         JSR NEXTCHAR
         BCC :EMPTY
* LDA (TEXTP),Y
         CMP #'#'         ;Is it immediate mode?
         BEQ IMMED
         CMP #'('
         BEQ :ZP
         CMP #'['
         BEQ :ZPLONG
         CMP #'a'         ;Check for accumulator
         BEQ :CHECK
         CMP #'A'
         BNE ADDRESS
:CHECK   INY
         LDA (TEXTP),Y
         AND #$7F
         CMP #32
         BEQ :EMPTY
         CMP #13
         BNE ADDR2
:EMPTY   LDA #00
         STA ARGLEN
         STA ARGTYPE
         DEY              ;Y=end of line + 1
         RTS
:ZP      JMP ZP
:ZPLONG  JMP ZPLONG

IMMED    LDA #01
         STA ARGTYPE
         STA ARGLEN
         INY
         JSR GETARG
         LDA PREFIX
         BEQ :RTS
         CMP #'>'
         BEQ :S1
         CMP #'^'
         BEQ :S2
         CMP #'<'
         BEQ :RTS
         LDX #BADFIX
         STX ERROR
:RTS     RTS
:S1      LDA ARG1+1
         STA ARG1
         LDA ARG1+2
         STA ARG1+1
         LDA #00
         STA ARG1+2
         RTS
:S2      LDA ARG1+2
         STA ARG1
         LDA #00
         STA ARG1+1
         STA ARG1+2
         RTS

ADDR2    DEY
ADDRESS  LDA #2
         STA ARGTYPE
         LDA #1
         STA ARGLEN       ;Assume ZP
         JSR GETARG
         JSR CHKCOM       ;Check for ,
         BNE :DONE
         LDA DFBFLAG      ;DFB handles commas special
         BNE :DONE
         JSR COMX         ;Check for ,X
         BEQ :INC1
         JSR COMY
         BEQ :INC2
         JSR COMS
         BEQ :INC3
         INY
         JSR ARG2ARG
         JSR GETARG       ;MVP and MVN perhaps
         DEY              ;For INY below
         INC ARGTYPE
:INC3    INC ARGTYPE
:INC2    INC ARGTYPE
:INC1    INC ARGTYPE
         INY
:DONE    
CALCLEN  LDA PREFIX
         BNE :FIX
         LDX ARGLEN
         LDA ARG1+1
         BEQ :C1
         LDX #2
:C1      LDA ARG1+2
         BEQ :C2
         LDX #3
:C2      STX ARGLEN
         RTS
:TAB     TXT '<!>'
:FIX     LDX #3
:L1      CMP :TAB-1,X
         BEQ :STX
         DEX
         BNE :L1
         LDX #BADFIX
         STX ERROR
:STX     STX ARGLEN
         RTS

ZPLONG   LDA #11
         STA ARGTYPE
         LDA #1
         STA ARGLEN
         INY
         JSR GETARG
         JSR CHKSQR
         BNE :ERR
         INY
         JSR CHKCOM
         BNE :DONE
         JSR COMY
         BNE :ERR
         INC ARGTYPE
         INY
:DONE    JMP CALCLEN
:ERR     JMP LINERR

ZP       LDA #7
         STA ARGTYPE
         LDA #1
         STA ARGLEN
         INY
         JSR GETARG
         JSR CHKPAR
         BNE :C1
:CHECKY  INY
         JSR CHKCOM
         BNE :DONE
         JSR COMY         ;(zp),y ?
         BNE :ERR
         INC ARGTYPE
:INY     INY
:DONE    JMP CALCLEN

:C1      LDA #9
         STA ARGTYPE
         JSR CHKCOM       ;(zp,.) instructions
         BNE :ERR
         JSR COMX
         BNE :COMS
         INY
         JSR CHKPAR       ;(zp,x)
         BEQ :INY
:ERR     JMP LINERR

:COMS    JSR COMS
         BNE :ERR
         INC ARGTYPE      ;(zp,s),y
         INY
         JSR CHKPAR
         BNE :ERR
         BEQ :CHECKY

LINERR   LDA #SYNERR
         STA ERROR
         RTS

CHKSQR   LDA #']'
         DFB $2C
CHKPAR   LDA #')'
         DFB $2C
CHKCOM   LDA #','
         CMP (TEXTP),Y
         RTS

COMX     INY
         LDA (TEXTP),Y
         AND #$5F
         CMP #'x'
         BEQ :DONE
         DEY
         LDA #$FF
:DONE    RTS

COMY     INY
         LDA (TEXTP),Y
         AND #$5F
         CMP #'y'
         BEQ :DONE
         DEY
         LDA #$FF
:DONE    RTS

COMS     INY
         LDA (TEXTP),Y
         CMP #'s'
         BEQ :DONE
         CMP #'S'
         BEQ :DONE
         DEY
         LDA #$FF
:DONE    RTS

ARG2ARG  LDX #2
:LOOP    LDA ARG1,X
         STA ARG2,X
         DEX
         BPL :LOOP
         RTS


* Read in an address, immediate or variable

GETARG   
         LDA (TEXTP),Y
         LDX #3           ;Check for prefix chars
:CT      CMP :TAB1,X
         BEQ :STA
         DEX
         BPL :CT
         LDA #00
         DEY
:STA     STA PREFIX
         INY
         JSR :GET

:EXTRA   LDA (TEXTP),Y    ;Check for + - * /
         AND #$7F
         CMP #32
         BEQ :RTS
         CMP #'+'
         BEQ :ADD
         CMP #'-'
         BEQ :SUB
         CMP #'*'
         BEQ :TIMES
         CMP #'/'
         BEQ :DIV
:RTS     JMP FAC2ARG
:GET     LDA (TEXTP),Y
         JSR ISNUM
         BCS :ADDR
         CMP #'%'
         BEQ :ADDR
         CMP #'$'
         BEQ :ADDR
         CMP #'*'
         BEQ :STAR
         CMP #34
         BEQ :ASCII
         CMP #39
         BEQ :ASCII
         JMP READVAR
:ADDR    JMP READNUM

:STAR    LDX #02
:SL1     LDA CODEP,X
         STA FAC1,X
         DEX
         BPL :SL1
         INY
         RTS

:ASCII   PHA
         INY
         LDA #00
         STA FAC1+1
         STA FAC1+2
         LDA (TEXTP),Y
         STA FAC1
         INY
         PLA
         CMP (TEXTP),Y
         BNE :ERR1
         INY
         RTS
:ERR1    LDA #BADARG
         STA ERROR
         RTS

:TIMES   
:DIV     
         JMP :EXTRA

:ADD     
         JSR FAC2FAC
         INY
         JSR :GET
         CLC
         LDA FAC2
         ADC FAC1
         STA FAC1
         LDA FAC2+1
         ADC FAC1+1
         STA FAC1+1
         LDA FAC2+2
         ADC FAC1+2
         STA FAC1+2
         JMP :EXTRA
:SUB     
         JSR FAC2FAC
         INY
         JSR :GET
         SEC
         LDA FAC2
         SBC FAC1
         STA FAC1
         LDA FAC2+1
         SBC FAC1+1
         STA FAC1+1
         LDA FAC2+2
         SBC FAC1+2
         STA FAC1+2
         JMP :EXTRA

:TAB1    TXT '<>!^'

FAC2ARG  LDX #3
:L1      LDA FAC1,X
         STA ARG1,X
         DEX
         BPL :L1
         RTS

FAC2FAC  LDX #3
:L       LDA FAC1,X
         STA FAC2,X
         DEX
         BPL :L
         RTS

*
* READNUM
*
* Calculates number and stores result in FAC1
*
* Strategy: ans = base*ans + num
* Custom multiply routine for speed.
*
BASE     DFB 0
READNUM  
         LDA #00
         STA FAC1
         STA FAC1+1
         STA FAC1+2
         LDX #10          ;Base 10 = default
         LDA (TEXTP),Y
         CMP #'$'
         BNE :C1
         LDX #16          ;Hex
         INY              ;Advance to next char
:C1      CMP #'%'
         BNE :C2
         LDX #2           ;Binary
         INY
:C2      STX BASE         ;.X = base

:LOOP    
         LDA (TEXTP),Y    ;Check for valid number
         CMP #58
         BCC :SBC
         AND #$5F         ;Convert to lower-case
         SBC #8
:SBC     SBC #47          ;0 -> 0 etc.
:C4      CMP BASE
         BCS :DONE        ;number > base so exit
         STA TEMP

         LDA FAC1+2
         ASL FAC1
         ROL FAC1+1
         ROL
         BCS :ERR
         CPX #16          ;If binary then we are done
         BNE :BASE10
         ASL FAC1         ;Multiply by 16
         ROL FAC1+1
         ROL
         BCS :ERR
         ASL FAC1
         ROL FAC1+1
         ROL
         BCS :ERR
         ASL FAC1
         ROL FAC1+1
         ROL
         BCS :ERR

:BASE10  CPX #10          ;To mult by ten, use
         BNE :OK          ;10*x = 8*x + 2*x
* LDA FAC1+2
         PHA
         LDA FAC1+1
         PHA
         LDA FAC1
         ASL FAC1         ;temp=8*x
         ROL FAC1+1
         ROL FAC1+2
         BCS :ERR
         ASL FAC1
         ROL FAC1+1
         ROL FAC1+2
         BCS :ERR
         ADC FAC1         ;Add in 2*x
         STA FAC1
         PLA
         ADC FAC1+1
         STA FAC1+1
         PLA
         ADC FAC1+2
         BCS :ERR
:OK      STA FAC1+2

         LDA TEMP         ;Add in the number
         CLC
         ADC FAC1
         STA FAC1
         BCC :C5
         INC FAC1+1
         BNE :C5
         INC FAC1+2
:C5      INY
         BNE :LOOP
:ERR     LDA #BADNUM
         STA ERROR
:DONE    RTS

*
* READVAR
*
* Reads in a variable, by searching through the variable
* list.  Current variable storage is:
*
*    name lo med hi
*
* where name is dextral char inverted
*

READVAR  
         JSR ROMOUT
         JSR FINDVAR
         BCC :ERR
         STY TEMPY
         LDY #01
:L1      LDA (VARPNT),Y
         STA FAC1-1,Y
         INY
         CPY #4
         BNE :L1
         LDY TEMPY
         JMP ROMIN

:ERR     LDA PASS         ;Assume 2-byte variable
         BEQ :ERR2        ;if on first pass
         LDA #00
         STA ERROR
         LDX #2
:L2      LDA CODEP,X      ;CODEP will ensure branches
         STA FAC1,X       ;work.
         DEX
         BPL :L2
         LDA #2
         STA ARGLEN
         JMP ROMIN

:ERR2    LDA #BADVAR
         STA ERROR
         JMP ROMIN

*
* These routines checks for a decimal number in the
* code, to differentiate e.g. l1 from l1a
*
* On exit, Carry clear indicates that it is not
* a number.
*
ISNUM    
         CMP #'0'
         BCC :EXIT
         CMP #'9'+1
         ROL              ;Invert carry
         EOR #$01
         ROR
:EXIT    RTS

*
* Opcode table.  Format is:
*
*    3 byte mnemonic, 2 byte routine address, base opcode
*

OPTAB    
         TXT 'adc'
         DA LDATYPE
         DFB $60

         TXT 'and'
         DA LDATYPE
         DFB $20

         TXT 'asl'
         DA ASLTYPE
         DFB $02

         TXT 'bcc'
         DA BRANCH
         DFB $90

         TXT 'bcs'
         DA BRANCH
         DFB $B0

         TXT 'beq'
         DA BRANCH
         DFB $F0

         TXT 'bge'        ;BCS
         DA BRANCH
         DFB $B0

         TXT 'bit'
         DA IBIT
         DFB $20

         TXT 'blt'        ;bcc
         DA BRANCH
         DFB $90

         TXT 'bmi'
         DA BRANCH
         DFB $30

         TXT 'bne'
         DA BRANCH
         DFB $D0

         TXT 'bpl'
         DA BRANCH
         DFB $10

         TXT 'bra'
         DA BRANCH
         DFB $80

         TXT 'brk'
         DA IBRK
         DFB $00

         TXT 'brl'
         DA LONGREL
         DFB $82

         TXT 'bvc'
         DA BRANCH
         DFB $50

         TXT 'bvs'
         DA BRANCH
         DFB $70

         TXT 'clc'
         DA CODEOUT
         DFB $18

         TXT 'cld'
         DA CODEOUT
         DFB $D8

         TXT 'cli'
         DA CODEOUT
         DFB $58

         TXT 'clv'
         DA CODEOUT
         DFB $B8

         TXT 'cmp'
         DA LDATYPE
         DFB $C0

         TXT 'cop'
         DA IBRK
         DFB $02

         TXT 'cpx'
         DA ICPX
         DFB $E0

         TXT 'cpy'
         DA ICPX
         DFB $C0

         TXT 'da '
         DA IDFB
         DFB $02

         TXT 'db '
         DA IDFB
         DFB $01

         TXT 'dea'
         DA CODEOUT
         DFB $3A

         TXT 'dec'
         DA ASLTYPE
         DFB $C2

         TXT 'dex'
         DA CODEOUT
         DFB $CA

         TXT 'dey'
         DA CODEOUT
         DFB $88

         TXT 'dfb'
         DA IDFB
         DFB $01

         TXT 'dla'        ;Long addr
         DA IDFB
         DFB $03          ;length

         TXT 'do '
         DA IDO           ;I now pronounce you bit and byte
         DFB $00

         TXT 'ds '
         DA IDS
         DFB $03

         TXT 'dw '
         DA IDFB
         DFB $02

         TXT 'els'
         DA IELSE
         DFB $00

         TXT 'eor'
         DA LDATYPE
         DFB $40

         TXT 'equ'
         DA IEQU
         DFB $00

         TXT 'fin'
         DA IFIN
         DFB $FF

         TXT 'hex'
         DA IHEX
         DFB $00

         TXT 'ina'
         DA CODEOUT
         DFB $1A

         TXT 'inc'
         DA ASLTYPE
         DFB $E2

         TXT 'inx'
         DA CODEOUT
         DFB $E8

         TXT 'iny'
         DA CODEOUT
         DFB $C8

         TXT 'jml'
         DA IJML
         DFB $5C

         TXT 'jmp'
         DA IJMP
         DFB $4C

         TXT 'jsl'
         DA IJML
         DFB $22

         TXT 'jsr'
         DA IJSR
         DFB $20

         TXT 'lda'
         DA LDATYPE
         DFB $A0

         TXT 'ldx'
         DA IBIT
         DFB $A2

         TXT 'ldy'
         DA IBIT
         DFB $A0

         TXT 'lsr'
         DA ASLTYPE
         DFB $42

         TXT 'mvn'
         DA IMOVE
         DFB $54

         TXT 'mvp'
         DA IMOVE
         DFB $44

         TXT 'nop'
         DA CODEOUT
         DFB $EA

         TXT 'ora'
         DA LDATYPE
         DFB $00

         TXT 'org'
         DA IORG
         DFB $00

         TXT 'pea'
         DA IPEA
         DFB $F4

         TXT 'pei'
         DA IPEI
         DFB $D4

         TXT 'per'
         DA LONGREL
         DFB $62

         TXT 'pha'
         DA CODEOUT
         DFB $48

         TXT 'phb'
         DA CODEOUT
         DFB $8B

         TXT 'phd'
         DA CODEOUT
         DFB $0B

         TXT 'phk'
         DA CODEOUT
         DFB $4B

         TXT 'php'
         DA CODEOUT
         DFB $08

         TXT 'phx'
         DA CODEOUT
         DFB $DA

         TXT 'phy'
         DA CODEOUT
         DFB $5A

         TXT 'pla'
         DA CODEOUT
         DFB $68

         TXT 'plb'
         DA CODEOUT
         DFB $AB

         TXT 'pld'
         DA CODEOUT
         DFB $2B

         TXT 'plp'
         DA CODEOUT
         DFB $28

         TXT 'plx'
         DA CODEOUT
         DFB $FA

         TXT 'ply'
         DA CODEOUT
         DFB $7A

         TXT 'put'
         DA IPUT
         DFB $00

         TXT 'reg'
         DA IREG
         DFB $00

         TXT 'rep'
         DA IREP
         DFB $C2

         TXT 'rol'
         DA ASLTYPE
         DFB $22

         TXT 'ror'
         DA ASLTYPE
         DFB $62

         TXT 'rti'
         DA CODEOUT
         DFB $40

         TXT 'rtl'
         DA CODEOUT
         DFB $6B

         TXT 'rts'
         DA CODEOUT
         DFB $60

         TXT 'sbc'
         DA LDATYPE
         DFB $E0

         TXT 'sec'
         DA CODEOUT
         DFB $38

         TXT 'sed'
         DA CODEOUT
         DFB $F8

         TXT 'sei'
         DA CODEOUT
         DFB $78

         TXT 'sep'
         DA IREP
         DFB $E2

         TXT 'sta'
         DA LDATYPE
         DFB $80

         TXT 'stp'
         DA CODEOUT
         DFB $DB

         TXT 'stx'
         DA ISTX
         DFB $82

         TXT 'sty'
         DA ISTX
         DFB $80

         TXT 'stz'
         DA ISTZ
         DFB $64

         TXT 'tax'
         DA CODEOUT
         DFB $AA

         TXT 'tay'
         DA CODEOUT
         DFB $A8

         TXT 'tcd'
         DA CODEOUT
         DFB $5B

         TXT 'tcs'
         DA CODEOUT
         DFB $1B

         TXT 'tdc'
         DA CODEOUT
         DFB $7B

         TXT 'trb'
         DA ITRB
         DFB $14

         TXT 'tsb'
         DA ITRB
         DFB $04

         TXT 'tsc'
         DA CODEOUT
         DFB $3B

         TXT 'tsx'
         DA CODEOUT
         DFB $BA

         TXT 'txa'
         DA CODEOUT
         DFB $8A

         TXT 'txs'
         DA CODEOUT
         DFB $9A

         TXT 'txt'
         DA ITXT
         DFB $00

         TXT 'txy'
         DA CODEOUT
         DFB $9B

         TXT 'tya'
         DA CODEOUT
         DFB $98

         TXT 'tyx'
         DA CODEOUT
         DFB $BB

         TXT 'wai'
         DA CODEOUT
         DFB $CB

         TXT 'wdm'
         DA IBRK
         DFB $42

         TXT 'xba'
         DA CODEOUT
         DFB $EB

         TXT 'xce'
         DA CODEOUT
         DFB $FB

         DFB $FF,$FF,$FF  ;Will force opcode match to fail

         DO 0
TEXT     TXT ' org $c000',0d
         TXT 'chrout = $ffd2',0d
         TXT 'start',0d
         TXT ' ldx #$00',0d
         TXT ':loop lda :text,x',0d
         TXT ' jsr chrout',0d
         TXT ' inx',0d
         TXT ' cmp #$0d',0d
         TXT ' bne :loop',0d
         TXT ' rts',0d
         DFB 13
         TXT ':text hex 05 ;white',0d
         TXT ' dfb 147    ;clear screen',0d
         TXT ' txt "Hello World!",0d',0d
         TXT ' org $80e0',0d
         TXT 'blah ds 3',0d
         TXT ' ds 3,$ea',0d
         TXT ' da $ffd2,$1234',0d
         TXT ' dla $123456',0d
         TXT ' lda blah ',0d
         TXT ' ds ^ ',0d
         TXT ' org ',0d
         TXT 'end         ;should be $c0x0',0d
         TXT ' jmp end',0d
         TXT ' bpl *-1',0d
         TXT ' jml start',0d
         DFB 00
         FIN

         DO 0
TEXT     TXT 'blah cmp [$ea],y',0d
         TXT ' bpl :l1',0d
         TXT 'test = $ffd2',0d
         TXT ':l1 lda #"a"  ;nothing special',0d
         TXT ' jsr test',0d
         TXT 'blah2',0d
         TXT ':l1 and !$123456',0d
         TXT ' jsr :l1',0d
         TXT ' rts',0d
         TXT ' jsr bLaH+$030+15-%10',0d ;blah+$3d
         TXT ' brl blah',0d
         TXT ' bra blah+4',0d
         TXT ' jmp Blah2',0d
         TXT ' brk',0d
         TXT ' jmp $123456',0d
         DFB 13,13
         DFB 00
         FIN

ERRTAB   DA :ERR1
         DA :ERR1
         DA :ERR2
         DA :ERR3
         DA :ERR4
         DA :ERR5
         DA :ERR6
         DA :ERR7
         DA :ERR8
         DA :ERR9
         DA :ERR10
         DA :ERR11
         DA :ERR12
         DA :ERR13
         DA :ERR14
         DA :ERR15
         DA :ERR16
         DA :ERR17

:ERR1    TXT 'What'
         DFB 39
         TXT 's that junk in the line?',0d
:ERR2    TXT 'Bad opcode',0d
:ERR3    TXT 'Bad address mode',0d
:ERR4    TXT 'Bad number',0d
:ERR5    TXT 'Unknown label',0d
:ERR6    TXT 'How the hell many variables do you need?',0d
:ERR7    TXT 'Syntax error',0d
:ERR8    TXT 'Bad prefix! Bad! No biscuit!',0d
:ERR9    TXT 'Hey, cool, a phase error',0d
:ERR10   TXT 'Duplicate label',0d
:ERR11   TXT 'Bad branch',0d
:ERR12   TXT 'Bad argument',0d
:ERR13   TXT 'Call me picky, but i just don'
         DFB 39
         TXT 't like that label.',0d
:ERR14   TXT 'Missing delimiter',0d
:ERR15   TXT 'Disk error',0d
:ERR16   TXT 'A putz put PUT in a PUT',0d
:ERR17   TXT 'Out of memory',0d

* What we have here is a failure to communicate.
* Well bub,
