*      
* misc.s -- Miscellaneous commands
*
* Once again, this is in a new file because we
* are out of memory!
*
* 6/23/98 slj
*

*
* BMUL
*   ASL byte
*
BMUL     
         JSR READARG
         LDA ERROR
         BNE :DONE
         LDX INST         ;Convert INST to INC
         CPX #$A9         ;No immediate mode
         BEQ :ERR1
         INX
         TXA
         AND #$1F
         STA INST
         JSR SETSRC
         JMP GENSRC       ;...and exit.
:ERR1    LDA #16          ;Bad dest
         STA ERROR
:DONE    RTS

*
* WMUL
*   Word MUL
*       ASL ARG
*       ROL ARG+1
*
WMUL     JSR BMUL
         LDA SINST        ;ASL -> ROL
         ORA #$20
         INC SLO
         BNE :CONT
         INC SHI
         TAX
         LDA SINST        ;Yup, $FF check again
         AND #$0F
         CMP #$06         ;ZP?
         BNE :CONT
         TXA
         ORA #$08
:CONT    STA SINST
         JMP GENSRC

*
* BDIV
*   LSR byte
*
BDIV     
         JSR BDIV2
         JMP GENSRC
BDIV2    
         JSR READARG
         LDA ERROR
         BNE :DONE
         LDX INST         ;Convert INST to INC
         CPX #$A9         ;No immediate mode
         BEQ :ERR1
         INX
         TXA
         EOR #$E0         ;Ax->4x
         STA INST
         JMP SETSRC       ;Set and exit...
:ERR1    LDA #16          ;Bad dest
         STA ERROR
:DONE    RTS

*
* WDIV
*   Word DIV
*       LSR ARG+1
*       ROR ARG
*
WDIV     JSR BDIV2

         INC SLO
         BNE :CONT
         INC SHI
         LDA SINST        ;Yup, $FF check again
         AND #$0F
         CMP #$06         ;ZP?
         BNE :CONT
         LDA SINST
         ORA #$08
         STA SINST
:CONT    JSR GENSRC

         LDA SLO
         BNE :C2
         DEC SHI
:C2      DEC SLO
         LDA SINST        ;LSR -> ROR
         ORA #$20
         STA SINST
         JMP GENSRC

*
* BINC
*   INC byte
*
BINC     
         JSR READARG
         LDA ERROR
         BNE :DONE
         LDX INST         ;Convert INST to INC
         CPX #$A9         ;No immediate mode
         BEQ :ERR1
         INX
         TXA
         ORA #$E0
         STA INST
         JSR SETSRC
         JMP GENSRC       ;...and exit.
:ERR1    LDA #16          ;Bad dest
         STA ERROR
:DONE    RTS

*
* WINC
*   Word INC
*       INC ARG
*       BNE :C1   ;Note no X reload here
*       INC ARG+1
*   :C1
*
WINC     JSR BINC
         LDA #$D0         ;BNE
         JSR CODEOUT
         LDX #2           ;+2 or +3?
         LDA SINST        ;If this is ZP, then +2
         AND #$0F
         CMP #$06
         BEQ :INCADR
         INX              ;Otherwise, +3
:INCADR  
         INC SLO
         BNE :CONT
         INC SHI
         LDA SINST        ;Yup, $FF check again
         AND #$0F
         CMP #$06         ;ZP?
         BNE :CONT
         LDA SINST
         ORA #$08
         STA SINST
         INX              ;Branch +3
:CONT    TXA
         JSR CODEOUT      ;Branch size
         JMP GENSRC

*
* BDEC
*   DEC byte
*
BDEC     
         JSR READARG
         LDA ERROR
         BNE :DONE
         LDX INST         ;Convert INST to DEC
         CPX #$A9         ;No immediate mode
         BEQ :ERR1
         INX
         TXA
         AND #$1F
         ORA #$C0
         STA INST
         JSR SETSRC
         JMP GENSRC       ;...and exit.
:ERR1    LDA #16          ;Illegal dest
         STA ERROR
:DONE    RTS

*
* WDEC
*   Word DEC
*       LDA ARG
*       BNE :C1
*       DEC ARG+1 ;No X reload, so always 2 or 3 bytes
*   :C1 DEC ARG
*
WDEC     
         JSR READARG
         LDA ERROR
         BNE :DONE
         JSR SETSRC
         JSR SETDEST      ;Economize
         JSR GENSRC       ;LDA ARG
         LDA #$D0         ;BNE
         JSR CODEOUT

         LDX SINST        ;Convert INST to DEC
         CPX #$A9         ;No immediate mode
         BEQ :ERR1
         INX
         TXA
         AND #$1F
         ORA #$C0
         STA SINST
         STA DINST        ;Same instr.
         LDX #2           ;Branch distance
         AND #$0F         ;Check to see if ZP
         CMP #$06
         BEQ :CONT2
         INX              ;Branch +3
:CONT2   
         INC SLO          ;Source will be ARG+1
         BNE :CONT
         INC SHI
         CMP #$06         ;ZP?
         BNE :CONT
         LDA SINST
         ORA #$08
         STA SINST
         INX              ;Branch +3
:CONT    TXA
         JSR CODEOUT
         JSR GENSRC
         JMP GENDEST

:ERR1    LDA #16          ;Illegal dest
         STA ERROR
:DONE    RTS


*
* BTEST
*   DEST - SRC  (But use a CMP)
*
* Uses MASK and EXTRAOP variables in OPERATORS
*
BTEST    
         LDA #$C0         ;Convert to CMP
         STA MASK
         LDA #00
         STA EXTRAOP      ;No SEC
READTEST 
         JSR READDOUB
         LDA ERROR
         BNE :DONE
         LDA PARENFLAG
         BNE :ERR16
         INC TESTFLAG     ;Make GENDEST skip the immediate
         JSR GENDEST      ;mode check
         DEC TESTFLAG
         LDA SINST        ;Convert instruction to SBC/CMP
         AND #%00011111
         ORA MASK
         STA SINST
         LDA EXTRAOP
         BEQ :SKIP
         JSR CODEOUT
:SKIP    JSR GENSRC       ;And CMP/SBC src
:DONE    LDA QSIZE        ;Nonzero queue means extra
         BEQ :RTS         ;destinations were read in
:ERR16   LDA #16          ;bad dest
         STA ERROR
:RTS     RTS

:ERR     LDA #2
         STA ERROR
         RTS
:EOLERR  LDA #14
         STA ERROR
         RTS
*
* WTEST
*   Word version of TEST
* Uses TEMPY in player routine
*
WTEST    
         LDA #$E0         ;SBC
         STA MASK
         LDA #$38         ;SEC
         STA EXTRAOP
         JSR READTEST     ;Beautiful
         LDA #$8D         ;STA
         JSR CODEOUT
         LDA #<TEMPY      ;TEMPY
         JSR CODEOUT
         LDA #>TEMPY
         JSR CODEOUT
         LDA SINST
         CMP #$E9         ;Immediate mode?
         BNE :CONT
         LDA SHI
         STA SLO
         JMP :NEXT
:CONT    INC SLO
         BNE :NEXT
         INC SHI
         AND #$0F
         CMP #$05         ;Zero page mode?
         BNE :NEXT        ;It is possible that
         LDA SINST        ;addr equaled $00FF
         ORA #$08         ;so convert to absolute
         STA SINST
:NEXT    
         LDA DINST
         CMP #$A9         ;Immediate?
         BNE :CONT2
         LDA DHI
         STA DLO
         JMP :NEXT2
:CONT2   INC DLO
         BNE :NEXT2
         INC DHI
         AND #$0F
         CMP #$05         ;Zero page mode?
         BNE :NEXT        ;It is possible that
         LDA DINST        ;addr equaled $00FF
         ORA #$08         ;so convert to absolute
         STA DINST
:NEXT2   
         INC TESTFLAG     ;Skip immediate dest test
         JSR GENDEST
         DEC TESTFLAG
         JSR GENSRC
         LDA #$0D         ;ORA TEMPY -- sets Z correctly
         JSR CODEOUT
         LDA #<TEMPY
         JSR CODEOUT
         LDA #>TEMPY
         JSR CODEOUT
         RTS

*
* COMMENT
*
* Comment just takes the text up until the end of line
* and embeds it right into the code.
*
COMMENT  
         JSR NEXTCHAR
:LOOP    LDA LINEBUF,Y
         BEQ :DONE
         CMP #13
         BEQ :DONE
         JSR CODEOUT
         INY
         BNE :LOOP
:DONE    RTS

*
* EMBED
*
* EMBED embeds whatever numbers (bytes) come after
* it straight into the code.
*
EMBED    
         LDA #00          ;Might be instructions that
         STA LASTXI       ;modify X.
         JSR NEXTCHAR
         BCC :DONE
         JSR READNUM
         CPX #00
         BNE :ERR
         LDX ERROR
         BNE :DONE
         JSR CODEOUT
         JMP EMBED
:ERR     LDA #24
         STA ERROR
:DONE    RTS

*
* LOOP
*
* LOOP marks the beginning of a loop.  So, the current
* address is placed on the stack, as well as a marker
* saying that the address is a loop address.
*
* The terminating UNTIL will then fetch this address
* and deal with it.
*
LOOP     
         LDA #00          ;Could loop back to here.
         STA LASTXI       ;So may need to reload X
         LDA CODEP+1
         JSR PUSH
         BCS :DONE
         LDA CODEP
         JSR PUSH
         BCS :DONE
         LDA #LOOPFLAG
         JMP PUSH
:DONE    RTS

*
* READFLAG
*
* READFLAG looks for a flag and returns the corresponding
* opcode in A.  Only the first three chars are relevant.
*
READFLAG 
         JSR NEXTCHAR
         BCC :OOPS
         LDA LINEBUF,Y
         CMP #'p'
         BNE :NEG
         INY
         LDA LINEBUF,Y
         CMP #'o'
         BNE :ERR
         INY
         LDA LINEBUF,Y
         CMP #'s'
         BNE :ERR
         JSR NEXTSPC
         LDA #$B0         ;BCS
         RTS

:NEG     CMP #'n'
         BNE :EQU
         INY
         LDA LINEBUF,Y
         CMP #'e'
         BNE :ERR
         INY
         LDA LINEBUF,Y
         CMP #'g'
         BNE :Q
         JSR NEXTSPC
         LDA #$90         ;BCC
         RTS
:Q       
         CMP #'q'
         BNE :ERR
         JSR NEXTSPC
         LDA #$D0         ;BNE
         RTS

:EQU     CMP #'e'
         BNE :ERR
         INY
         LDA LINEBUF,Y
         CMP #'q'
         BNE :ERR
         INY
         LDA LINEBUF,Y
         CMP #'u'
         BNE :ERR
         JSR NEXTSPC
         LDA #$F0         ;BEQ
         RTS

:OOPS    LDA #14
         STA ERROR
         RTS
:ERR     LDA #2
         STA ERROR
         RTS

*
* UNTIL
*
* UNTIL needs a flag as argument (POS NEG EQU NEQ)
* It uses a branch instruction when possible, but
* will use a JMP otherwise.
*
UNTIL    
         JSR READFLAG     ;Returns instruction in A
         STA SINST
         JSR PULL
         BCS :BIGERR
         CMP #LOOPFLAG
         BNE :ERR
         JSR PULL
         BCS :DONE
         STA SLO
         JSR PULL
         BCS :DONE
         STA SHI
         LDA CODEP        ;Now check to see if we can
         SEC              ;use a branch instead of
         SBC SLO          ;a jump
         STA TEMP
         LDA CODEP+1
         SBC SHI
         BNE :JMP         ;Must be <128 for a branch
         LDA TEMP
         CMP #127
         BCS :JMP         ;too big
         EOR #$FF         ;Make it negative
         TAX
         DEX              ;Subtract two more for the inst
         LDA SINST
         EOR #$20         ;Interchange BNE<->BEQ or
         JSR CODEOUT      ;BPL<->BMI
         TXA
         JMP CODEOUT      ;and exit.

:JMP     LDA SINST        ;Oh well, take a jump then
         JSR CODEOUT      ;Branch
         LDA #03          ;+3
         JSR CODEOUT
         LDA #$4C         ;JMP
         JSR CODEOUT
         LDA SLO          ;to loop address
         JSR CODEOUT
         LDA SHI
         JMP CODEOUT      ;And exit.

:ERR     LDA #26
         STA ERROR
:DONE    RTS
:BIGERR  LDA #28
         STA ERROR
         RTS

*
* FOREVER
*
* Stay a while... stay FOREVER!
*
FOREVER  
         JSR PULL
         BCS :BIGERR
         CMP #LOOPFLAG    ;Make sure we're not tangled up
         BNE :OOPS
         LDA #$4C         ;JMP
         JSR CODEOUT
         JSR PULL
         BCS :DONE
         JSR CODEOUT
         JSR PULL
         BCS :DONE
         JSR CODEOUT
         JMP NOMORECHARS
:OOPS    LDA #26
         STA ERROR
:DONE    RTS
:BIGERR  LDA #28
         STA ERROR
         RTS

*
* WHEN
*   WHEN is my if/then conditional.  WHEN FLAG
*   WHENs must end with a WELSE or WEND.
*
* WHEN always uses a branch to move around.  For a version
* with longer range, use LWHEN, which uses a JMP.
*
WHEN     
         JSR READFLAG
         EOR #$20         ;BNE<->BEQ  BPL<->BMI
         JSR CODEOUT
         LDA CODEP+1      ;Stick current address on
         JSR PUSH         ;stack
         BCS :DONE
         LDA CODEP
         JSR PUSH
         BCS :DONE
         LDA #WHENFLAG
         JSR PUSH
         BCS :DONE
         JSR CODEOUT
:DONE    RTS

*
* LONGWHEN
*
* When, but uses a JMP instead of a branch.
*
LONGWHEN 
         JSR READFLAG
         JSR CODEOUT      ;Branch
         LDA #3           ;+3
         JSR CODEOUT
         LDA #$4C         ;JMP
         JSR CODEOUT
         LDA CODEP+1      ;Address to be fixed up
         JSR PUSH
         BCS :DONE
         LDA CODEP
         JSR PUSH
         BCS :DONE
         LDA #LONGFLAG
         JSR PUSH
         JSR CODEOUT      ;JMP dummy address
         JSR CODEOUT
:DONE    RTS

*
* LONGFIX
*
* Fix up the address and such for a long WHEN
* i.e. it is a JMP, address on stack.
*
FIXTEMP  DS 1
LONGFIX  
         JSR PULL         ;Grab address
         STA TEMP         ;(Stack err would have occured
         JSR PULL         ;already)
         STA TEMP+1
         STY FIXTEMP
         LDY #00
         LDA CODEP        ;Jump to current address
         STA (TEMP),Y
         INY
         LDA CODEP+1
         STA (TEMP),Y
         LDY FIXTEMP
         RTS

*
* SHORTFIX
*
* Fix up a short i.e. branched jump, address
* on stack.
*
SHORTFIX 
         JSR PULL         ;Address to fix up
         STA TEMP
         JSR PULL
         STA TEMP+1
         LDA CODEP
         CLC              ;Subtract an extra one
         SBC TEMP         ;because PC would be at
         STA FIXTEMP      ;old addr+1
         LDA CODEP+1
         SBC TEMP+1
         BNE :ERR         ;It better be zero!
         BCC :WOW         ;Now THAT would be bad!
         LDA FIXTEMP
         CMP #128         ;No larger than 127
         BCS :ERR
         STY FIXTEMP      ;Otherwise, stick the correct
         LDY #00          ;branch distance in there!
         STA (TEMP),Y
         LDY FIXTEMP
         RTS

:ERR     LDA #34
         STA ERROR
         RTS

:WOW     LDA #12
         STA ERROR
         RTS


*
* ELSE
*   Terminates the current WHEN, fixes up its address,
*   and starts up a new block of code to be fixed up
*   by a WEND
*
ELSE     
         LDA #00          ;Anything that branches needs to
         STA LASTXI       ;clear this
         LDA #$4C         ;JMP
         JSR CODEOUT
         LDA CODEP+1      ;Need the current address
         STA SHI
         LDA CODEP
         STA SLO
         JSR CODEOUT      ;JMP Address, to be fixed up
         JSR CODEOUT
         JSR PULL         ;Get the WHEN address off of
         BCS :ERR         ;the stack
         CMP #LONGFLAG
         BNE :NOPE
         JSR LONGFIX      ;Fix up when address
         JMP :CONT
:NOPE    CMP #WHENFLAG
         BNE :HMM
         JSR SHORTFIX
:CONT    
         LDA SHI          ;Now put address to be fixed up
         JSR PUSH         ;i.e. where the WHEN should
         BCS :DONE        ;jump to when finished.
         LDA SLO
         JSR PUSH
         BCS :DONE
         LDA #ELSEFLAG
         JSR PUSH
:DONE    JMP NEXTCOM      ;Any following commands?

:HMM     CMP #LOOPFLAG
         BNE :HELP
         LDA #26
         STA ERROR
         RTS
:HELP    LDA #12          ;I am really confused
         STA ERROR        ;maybe an ELSE ELSE or something.
         RTS
:ERR     LDA #32
         STA ERROR
         RTS

*
* WEND
*
* End a WHEN LWHEN or ELSE thingie.
*
WEND     
         LDA #00          ;Anything that branches needs to
         STA LASTXI       ;clear this
         JSR PULL         ;Get address to fix up
         BCS :OOPS
         CMP #WHENFLAG    ;Shorty
         BNE :CONT
         JSR SHORTFIX     ;Fix it up!
         JMP NOMORECHARS
:CONT    CMP #LOOPFLAG
         BEQ :TANGLE
         CMP #ELSEFLAG
         BNE :CONT2
:LONG    JSR LONGFIX
         JMP NOMORECHARS
:CONT2   CMP #LONGFLAG
         BEQ :LONG
         LDA #12          ;Now THAT is weird.
         STA ERROR
         RTS
:OOPS    LDA #32
         STA ERROR
         RTS
:TANGLE  LDA #26
         STA ERROR
         RTS

*
* DELAY
*   Puts a short delay loop into the code, i.e.
*      LDA ARG
*      TAX
*      DEX
*      BNE -3
*
DELAY    
         JSR READARG
         JSR SETSRC
         JSR GENSRC
         LDA #00
         STA LASTXI
         LDA #$AA         ;TAX
         JSR CODEOUT
         LDA #$CA         ;DEX
         JSR CODEOUT
         LDA #$D0         ;BNE
         JSR CODEOUT
         LDA #253         ;-3
         JSR CODEOUT
         JMP NOMORECHARS  ;...and exit

*
* DATA
*   DATA is my one label for use by the program.
*   It MUST occur before it is used.
*
DATALO   DS 1
DATAHI   DS 1
DATA     
         LDA #00          ;JSR etc. might alter .X
         STA LASTXI
         LDA CODEP
         STA DATALO
         LDA CODEP+1
         STA DATAHI
NEXTCOM  JSR NEXTCHAR     ;Any following commands?
         BCC :RTS
         JMP PARSE
:RTS     RTS

*
* WAIT
*   Returns control back to the player routine.
*   Execution will resume at the instruction following
*   the WAIT command.
*
WAITFLAG DFB 00           ;For use with subroutines

WAIT     
         LDA #00
         STA LASTXI
         LDA #$20         ;JSR
         STA WAITFLAG
         JSR CODEOUT
         LDA #<RETURN
         JSR CODEOUT
         LDA #>RETURN
         JSR CODEOUT      ;and exit
         JMP NOMORECHARS

*
* Compiler is now two-pass.  The first pass determines
* if WAITs etc. are present in subroutines.  If so,
* PLADDR is executed at the start of the subroutine
* and PHADDR at the end (SEND).
*
* On entry, (.A, .X) = (lo,hi) of storage address.
*

PLADDR   
         STA PLADDR1+1    ;Low byte
         STA PLADDR4+1
         CLC
         ADC #4
         STA PLADDR2+1
         STA PLADDR3+1
         TXA              ;High byte
         STA PLADDR1+2
         STA PLADDR4+2
         ADC #00
         STA PLADDR2+2
         STA PLADDR3+2

         LDX #00          ;.Y = current position in line
:LOOP    LDA PLACODE,X
         JSR CODEOUT
         INX
         CPX #11
         BNE :LOOP
         RTS

* Code to push address back on stack

PHADDR   
         LDX #00
:LOOP2   LDA PHACODE,X
         JSR CODEOUT
         INX
         CPX #20
         BNE :LOOP2
:DONE    RTS

PLACODE  LDX CURFIELD
         PLA
PLADDR1  STA $C000,X
         PLA
PLADDR2  STA $C001,X

PHACODE  LDX CURFIELD
PLADDR3  LDA $C001,X
         PHA
PLADDR4  LDA $C000,X
         PHA
         RTS
         DFB 0,0,0,0,0,0,0,0

*
* DONE
*   Basically creates an infinite loop.
*   Should be used at the end of programs, to end them!
*
DONE     
         LDA #00          ;Could occur in a subroutine
         STA LASTXI
         JSR WAIT
         LDA #$68         ;PLA -- PHA is done before
         JSR CODEOUT      ;each macro call

         LDA #$60         ;RTS
         JSR CODEOUT
         JMP NOMORECHARS

*
* ENTRY
*   Sets the current location as the new entry point
*   for the macro.
*
ENTFLAG  DFB 00           ;Warning flag, due to subroutines
ENTRYP   ENT
ENTLO    DS 1
ENTHI    DS 1
ENTRY    
         INC ENTFLAG
         LDA SUBFLAG      ;Not allowed in subroutine
         BNE :ERR
         LDA #00
         STA LASTXI
         LDA CODEP
         STA ENTLO
         LDA CODEP+1
         STA ENTHI
         JMP NOMORECHARS

:ERR     LDA #46
         STA ERROR
         RTS

*
* Variable routines
*

*
* VAR -- Basically does an EMBED and assigns the new
*        variable to the address

NEWVAR   
         LDA SUBFLAG      ;Not allowed in subroutines
         BNE :ERROR       ;will screw up with WAIT

         LDA #$FF         ;Variable ID -- normal var
         STA VARID
         LDX #01          ;Number of bytes
         LDA LINEBUF,Y
         CMP #'*'         ;VAR*n is optional
         BNE :EMBED
         INY
         JSR READNUM
         CPX #00          ;High byte
         BNE :ERR
         LDX ERROR
         BNE :DONE
         TAX              ;Number of bytes
         BEQ :ERR
:EMBED   JSR SETVARAD     ;Set variable address to CODEP
:LOOP    JSR CODEOUT      ;Output some zeros
         DEX
         BNE :LOOP
         JSR NEXTCHAR     ;Find variable name
         BCC :ERR2
         STY CURPOS
         JMP ADDVAR       ;Add variable to list

:ERROR   LDA #46          ;Not in a subroutine
         DFB $2C
:ERR     LDA #4           ;Bad arg
         DFB $2C
:ERR2    LDA #14          ;Rest of the line?
         STA ERROR
:DONE    RTS

SETVARAD LDA CODEP        ;Set variable address to CODEP
         STA VARADDR
         LDA CODEP+1
         STA VARADDR+1
         LDA #00
         STA VARXADDR
         STA VARXADDR+1
         RTS
*
* DEFine a new variable -- DEF newlabel value
*

DEF      
         LDA #$E0         ;Variable ID -- DEF
         STA VARID
         TYA              ;Remember where variable name is
         PHA

         JSR NEXTSPC
         JSR NEXTCHAR     ;Make sure text exists
         BCC :ERR14
         LDY #00          ;Now find address of text!
         STY VARXADDR
         STY VARXADDR+1
         JSR NOSPACES     ;Find the DEF
         JSR :LOOP        ;Move beyond it
         JSR NOSPACES     ;Find the variable name
         JSR :LOOP
         JSR NOSPACES     ;Find the text
         TYA              ;.Y should now point to it
         CLC
         ADC TEXTP
         STA VARADDR      ;Address of the expanded text
         LDA TEXTP+1
         ADC #00
         STA VARADDR+1

         PLA
         STA CURPOS
         TAY
         JMP ADDVAR       ;Add variable to the list

:ERR14   PLA
         LDA #14          ;Rest of the line?
         STA ERROR
         RTS

:LOOP    INY              ;Advance to next space
         LDA (TEXTP),Y
         CMP #32
         BNE :LOOP
         RTS

*
* Subroutine commands.  Yes!  Subroutines!  Cool!
*
* Commands like DONE WAIT and ENTRY are not allowed,
* so a flag is needed.
*

SUBFLAG  DFB 00           ;Tells if we are in a sub or not

SUB      
         LDA #00
         STA LASTXI
         STA WAITFLAG
         LDA SUBFLAG      ;Can't be nested
         BNE :ERROR

         LDA PASS         ;Emit PLA code if 2nd pass and
         BEQ :CONT        ;WAIT will occur
         JSR DEQNEW       ;high byte
         TAX
         JSR DEQNEW       ;low byte
         CPX #00
         BEQ :CONT
         JSR PLADDR

:CONT    INC SUBFLAG
         LDA #$E1
         STA VARID
         JSR SETVARAD     ;Set var address to CODEP
         STY CURPOS
         JMP ADDVAR
* JMP NOMORECHARS

:ERROR   LDA #46          ;Not in a subroutine
         STA ERROR
         RTS

SEND     
         LDA #00
         STA LASTXI
         LDA SUBFLAG
         BEQ :ERR2
         DEC SUBFLAG
         LDX PASS
         BEQ :PASS0
         LDA WAITFLAG     ;2nd pass -- did a WAIT occur?
         BEQ :RTSOUT      ;No, so just RTS
         JSR PHADDR
         BEQ :DONE        ;Always taken

:PASS0   LDA WAITFLAG     ;1st pass, if WAIT occured then
         BEQ :ENQ
         JSR PLADDR       ;need to emit both PLA and PHA
         JSR PHADDR       ;code to get addresses right
         LDA CODEP
         SEC
         SBC #8           ;PLA storage
         TAX
         LDA CODEP+1
         SBC #00
:ENQ     JSR ENQNEW       ;High byte, zero if no WAIT
         TXA
         JSR ENQNEW       ;Low byte

         LDA WAITFLAG     ;Emit RTS if no WAIT
         BNE :DONE
:RTSOUT  LDA #$60         ;RTS
         JSR CODEOUT
:DONE    JMP NOMORECHARS

:ERR2    LDA #50          ;SEND but no sub
         STA ERROR
         RTS

JSUB     
         LDA #00
         STA LASTXI
         JSR READARG      ;Get address
         LDA ERROR
         BNE :RTS
         JSR SETSRC
         LDA XINST
         BNE :XERR        ;No indexed!
         LDA INST
         CMP #$A9         ;Nor immediate
         BEQ :ERR
         JSR NEXTCHAR     ;Check for empty
         BCS :SERR
         LDA SUBFLAG
         BEQ :CONT
         STA WAITFLAG     ;Save return address
:CONT    LDA #$20         ;Otherwise fine by me!
         JSR CODEOUT
         LDA SLO
         JSR CODEOUT
         LDA SHI
         JSR CODEOUT
         JMP NOMORECHARS

:XERR    LDA #6           ;Index not allowed
         DFB $2C
:ERR     LDA #16          ;Illegal dest
         DFB $2C
:SERR    LDA #2
         STA ERROR
:RTS     RTS


NOMORECHARS
         JSR NEXTCHAR     ;Line should be empty!
         BCC :RTS
         LDA #2
         STA ERROR
:RTS     RTS

*
* Kernal routines.
*

*
* ILOAD
*   Load instrument specified in ARG
*
ILOAD    
         JSR READARG
         JSR SETSRC
         JSR GENSRC
         LDA #00
         STA LASTXI
         LDA #$AA         ;TAX
         JSR CODEOUT
         LDA #<LOADINST
         LDX #>LOADINST
         JMP GENSUB

*
* A utility routine used by the GET pointer
* routines which call the kernal.
*
* SETPOINT -- A X -> ARG ARG+1
*
SETPOINT 
         JSR READARG
         JSR SETDEST
         LDA DINST
         AND #%00011111
         ORA #%10000000
         STA DINST
         CMP #$89         ;STA immediate would be really bad.
         BEQ :ERR
         LDA DXINST
         BNE :ERR         ;As would an indexed instruction
         LDA #00
         STA LASTXI
         JSR GENDEST
         INC DINST        ;Converts STA to STX
                          ;(X contains hi byte)
         INC DLO
         BNE :CONT
         LDA DHI
         BNE :CONT2       ;If zero, then this was ZP
         LDA #$8E         ;STX abs
         STA DINST
:CONT2   INC DHI
:CONT    JMP GENDEST      ;Exit
:ERR     LDA #16          ;Illegal dest
         STA ERROR
         RTS
*
* Similarly, a routine which gets pointer info
* from ARG (reads ARG into A and ARG+1 into X).
*
GETPOINT 
         JSR READARG
         JSR SETDEST
         LDA DINST
         CMP #$A9         ;LDA immediate would be really bad.
         BEQ :ERR
         LDA DXINST
         BNE :ERR         ;As would an indexed instruction
         LDA #00
         STA LASTXI
         JSR GENDEST
         INC DINST        ;Converts LDA to LDX
                          ;(X will contain hi byte)
         INC DLO
         BNE :CONT
         LDA DHI
         BNE :CONT2       ;If zero, then this was ZP
         LDA #$8E         ;LDX abs
         STA DINST
:CONT2   INC DHI
:CONT    JMP GENDEST      ;Exit
:ERR     LDA #22          ;Bad src
         STA ERROR
         RTS
*
* GETP
*   Get pointer and store in ARG, ARG+1
*
GET      
         LDA #<GETP
         LDX #>GETP
         JSR GENSUB
         JMP SETPOINT
*
* SETP
*   Set pointer current voice to ARG, ARG+1
*
SET      
         LDA #00
         STA LASTXI
         JSR GETPOINT     ;Get the pointer from ARG
         LDA #<SETP
         LDX #>SETP
         JMP GENSUB

*
* V1GETP, V2GETP, V3GETP
*   Like GETP, but specifically for voice 1
*
V1GET    
         LDA #<V1GETP
         LDX #>V1GETP
         JSR GENSUB
         JMP SETPOINT     ;Copy A,X -> ARG, ARG+1
V2GET    
         LDA #<V2GETP
         LDX #>V2GETP
         JSR GENSUB
         JMP SETPOINT
V3GET    
         LDA #<V3GETP
         LDX #>V3GETP
         JSR GENSUB
         JMP SETPOINT

SUBADDR  DA 0
GENSUB                    ;Generate subroutine call
         STA SUBADDR      ;as stored in (A,X)=(lo,hi)
         STX SUBADDR+1
         LDA #00
         STA LASTXI
         LDA #$20         ;JSR
         JSR CODEOUT
         LDA SUBADDR
         JSR CODEOUT
         LDA SUBADDR+1
         JMP CODEOUT

*
* V1SETP, V2SETP, V3SETP
*   Like SETP, but specific to voice 1 etc.
*
V1SET    
         JSR GETPOINT     ;ARG,ARG+1 -> A,X
         LDA #<V1SETP
         LDX #>V1SETP
         JMP GENSUB

V2SET    
         JSR GETPOINT     ;ARG,ARG+1 -> A,X
         LDA #<V2SETP
         LDX #>V2SETP
         JMP GENSUB
V3SET    
         JSR GETPOINT     ;ARG,ARG+1 -> A,X
         LDA #<V3SETP
         LDX #>V3SETP
         JMP GENSUB

