*      
* This routine reads in a double argument, e.g.
*      ARG > ARG or ARG < ARG
*
* If the & extension is used in the source arg an
* error will be generated.
* If the & extension is used in the dest arg,
* the subsequent arguments are placed in the
* queue.
*
* A new address mode, () > arg, is now available.
* The only routines which can use it are the
* operator routines, so it is handled by this
* routine.
*

PARENFLAG DFB 00          ;Parenthesis mode

READDOUB 
         LDA #00
         STA PARENFLAG
         LDA LINEBUF,Y    ;Check for () mode
         CMP #'('
         BNE :NORMAL
:PAREN   
         LDA PARENFLAG
         BNE :BRA         ;No nesting allowed
         INY
         JSR NEXTCHAR     ;Get rid of any spaces
         JSR :NORMAL      ;Read the inner arguments
         LDA ERROR
         BNE :RTS
         INC PARENFLAG    ;Parenthesis mode
         LDA QSIZE        ;Check for & inside the parens
         BNE :SRCERR
         LDA LINEBUF,Y    ;Check for closing )
         CMP #')'
:BRA     BNE :SRCERR
         INY
         JSR NEXTCHAR     ;Find the director
         LDA LINEBUF,Y
         CMP #'>'         ;Must be this one
         BNE :DESTERR
         JSR DEST2ARG     ;Push dest (arg2) on the stack
         JSR PUSHARG
         JMP :LOOP        ;And read remaining args into dest

:NORMAL  JSR READARG
         LDA ERROR
         BNE :RTS
         JSR NEXTCHAR     ;Advance to next char
         BCC :ERR
         LDA LINEBUF,Y
         CMP #'&'         ;Is this an extension?
         BNE :WAHKAR
         JSR SETQ         ;Stick arg into queue
         INY
         JSR NEXTCHAR
         BCC :ERR
         LDA LINEBUF,Y
         CMP #'#'         ;Can't be immediate extension!
         BNE :NORMAL
:DESTERR LDA #16          ;(Extensions are always dests)
         STA ERROR
:RTS     RTS
:WAHKAR  
         CMP #'>'         ;Is this arg source?
         BNE :WAHKA
         LDA QSIZE
         BNE :SRCERR      ;Can't have extensions as SRC
         JSR SETSRC       ;Set SOURCE=ARG

:LOOP    INY              ;Advance past the > or &
         JSR NEXTCHAR
         BCC :ERR
* GENDEST will catch this, and TEST needs it gone.
* LDA LINEBUF,Y
* CMP #'#' ;No immediate dests
* BEQ :DESTERR
         JSR READARG
         LDA ERROR
         BNE :DONE
         JSR NEXTCHAR     ;Maybe there's a &
         LDA LINEBUF,Y
         CMP #'&'
         BNE :CONT
         JSR SETQ         ;If so, then put arg in queue
         BCC :LOOP        ;...and advance!
:CONT    JMP SETDEST      ;(and exit)

:SRCERR  LDA #22          ;Bad source
         STA ERROR
         RTS

:WAHKA   CMP #'<'
         BEQ :CONT2
         LDA #2
         STA ERROR
         RTS
:CONT2   
         JSR SETDEST
         INY              ;Advance past the <
         JSR NEXTCHAR
         BCC :ERR
         JSR READARG
         LDA ERROR
         BNE :DONE
         JSR NEXTCHAR     ;Maybe there's a &
         LDA LINEBUF,Y
         CMP #'&'
         BEQ :SRCERR      ;Oops
:CONT3   JMP SETSRC       ;(and exit)

:ERR     LDA #14
         STA ERROR
:DONE    RTS

*
* BMOVE: Move a byte from one location to another
*    (SRC) -> (DEST)
*
BMOVE    
         JSR READDOUB     ;Read in the arguments
         LDA ERROR
         BNE :DONE
         LDA PARENFLAG
         BNE BERRY

         JSR GENSRC       ;Now generate the proper code!
:QLOOP   LDA DINST        ;Convert dest instr to STA
         AND #%10011111
         STA DINST
         JSR GENDEST
         LDA QSIZE        ;Handle extra instructions
         BEQ :DONE        ;that may be in the queue
         JSR GETQ         ;Get address out of queue
         BCS :DONE        ;error on C=1
         JSR SETDEST      ;Set it as destination
         JMP :QLOOP
:DONE    RTS

BERRY    LDA #22
         STA ERROR
         RTS

*
* WMOVE: Move a word (two sequential bytes) from
* one location to another.  This is basically
* equivalent to
*    BMOVE ARG1 > ARG2
*    BMOVE ARG1+1 > ARG2+1
*
ITEMP    DS 1             ;Just a handy temp storage
WMOVE    
         JSR READDOUB     ;Read in the arguments
         LDA ERROR
         BNE :DONE
         LDA PARENFLAG    ;Parenthesis mode not allowed
         BNE BERRY

         LDA QSIZE        ;Need to be a little trickier
         STA ITEMP        ;so we can reuse addresses.

         JSR GENSRC       ;Now generate the proper code!
:QLOOP   LDA DINST        ;Convert dest instr to STA
         AND #%10011111
         STA DINST
         JSR GENDEST
         LDA ITEMP        ;Handle extra instructions
         BEQ :DONE        ;that may be in the queue
         SEC              ;Update queue size
         SBC #6
         STA ITEMP
         JSR DEST2ARG
         JSR SETQ         ;Put current dest into queue
         JSR GETQ         ;Get new address out of queue
         BCS :DONE        ;error on C=1
         JSR SETDEST      ;Set it as destination
         JMP :QLOOP
:DONE                     ;Now do the address+1 byte
         LDA SINST        ;Handled differently if LDA #
         CMP #$A9
         BNE :INCADD
         LDA SHI          ;Use the high byte
         STA SLO
         JMP :CONT1
:INCADD  
         INC SLO          ;Increment the address
         BNE :CONT1
         INC SHI
         CMP #$A5         ;Zero page mode?
         BNE :CONT1       ;It is possible that
* LDA SINST ;addr equaled $00FF
         ORA #$08         ;Convert ZP->Absolute
         STA SINST
:CONT1   JSR GENSRC

:QLOOP2                   ;Instruction is now set up properly
         INC DLO
         BNE :CONT2
         INC DHI
         LDA DINST
         AND #$0F
         CMP #05          ;ZP?
         BNE :CONT2
         LDA DINST
         ORA #$08
         STA DINST
:CONT2   JSR GENDEST
         LDA QSIZE
         BEQ :ALLDONE
         JSR GETQ         ;Get address etc.
         BCS :DONE
         JSR SETDEST
         JMP :QLOOP2
:ALLDONE RTS

*
* The binary operators are all basically identical in
* operation.  Two variables need to be set up; see
* the notes below for WOPER.
*
* (In particular see why it is DEST oper SRC -> DEST)
*
MASK     DS 1
EXTRAOP  DS 1

BOPER    
         JSR READDOUB     ;Read in the arguments
         LDA ERROR
         BNE :DONE
* Because of the way & clauses are handled, the first
* address is the first in the queue, and the current
* address is the last one read.  So we need to fix
* that up.
         JSR DEST2ARG
         JSR SETQ         ;1st arg is at front of queue
         JSR GETQ
         JSR SETDEST

         LDA PARENFLAG    ;Check for () mode
         BEQ :NORMAL
         JSR SETQ         ;Back in the queue
         JSR PULLARG      ;Grab arg off of stack
         JSR SETDEST

:NORMAL  JSR GENDEST      ;Now generate the proper code!
         LDA SINST        ;Convert dest instr to ADC
         AND #%00011111   ;or whatever.
         ORA MASK
         STA SINST
         LDA EXTRAOP
         BEQ :SKIP
         JSR CODEOUT
:SKIP    JSR GENSRC       ;ADC stuff
* LDA #00 ;STA immediately, X is already
* STA DXINST ;set correctly, so skip it.

         LDA PARENFLAG
         BNE :QCHECK      ;Only STA to queue addresses
:QLOOP   LDA DINST        ;Convert instruction to STA
         AND #%00011111
         ORA #%10000000
         STA DINST
         JSR GENDEST      ;And STA it to dest.
:QCHECK  LDA QSIZE        ;Handle extra instructions
         BEQ :DONE        ;that may be in the queue
         JSR GETQ         ;Get address out of queue
         BCS :DONE        ;error on C=1
         JSR SETDEST      ;Set it as destination
         JMP :QLOOP
:DONE    RTS

*
* Since almost all the word operators have 90% of their
* code in common, this is now a subroutine.  Two variables
* need to be set up, MASK and EXTRAOP.  MASK is used to
* convert LDA to whatever instruction it is supposed to
* be, e.g.
*         LDA INST
*         AND #$00011111
*         ORA MASK
* EXTRAOP is for ADC and SBC, and is an extra opcode to
* execute (in particular, CLC/SEC).  If zero, it is
* not output.
*
* Because of the way in which WSUB works, the roles
* of DEST and SRC need to be interchanged; things are
* still stored in DEST, but the operation is
* DEST SRC -> DEST as opposed to SRC DEST -> DEST
*
WOPER    
         JSR READDOUB     ;Read in the arguments
         LDA ERROR
         BNE :DONE

         JSR DEST2ARG     ;Again, make sure first address
         JSR SETQ         ;is first.
         JSR GETQ
         JSR SETDEST

         LDA PARENFLAG    ;Check for () mode
         BEQ :NORMAL
         JSR SETQ         ;Back in the queue
         JSR PULLARG      ;Grab arg off of stack
         JSR SETDEST      ;It will be passed into the queue

:NORMAL  LDA QSIZE        ;Need to be a little trickier
         STA ITEMP        ;so we can reuse addresses.

         JSR GENDEST      ;Start with DEST
         JSR GENOPER      ;Generate ADC xxx STA xxx etc.

:QLOOP   LDA ITEMP        ;Handle extra instructions
         BEQ :DONE        ;that may be in the queue
         SEC              ;Update queue size
         SBC #8
         STA ITEMP
         JSR DEST2ARG     ;DINST -> INST
         JSR SETQ         ;Put current address into queue
         BCS :RTS
         JSR GETQ         ;Get new address out of queue
         BCS :RTS         ;error on C=1
         JSR SETDEST      ;Set it as destination
         LDA DINST        ;Convert dest instr to STA
         AND #%00011111
         ORA #%10000000
         STA DINST
         JSR GENDEST
         JMP :QLOOP

:DONE    LDA #00          ;Now do the address+1 byte
         STA EXTRAOP      ;No CLC/SEC second time
         LDA SINST
         AND #$0F         ;Strip away any mask etc.
         CMP #$09         ;If immediate mode, then use
         BNE :INCADR      ;the high byte.
         LDA SHI
         STA SLO
         JMP :CONT1
:RTS     RTS
:INCADR  
         INC SLO          ;Increment the address
         BNE :CONT1
         INC SHI
         CMP #$05         ;Zero page mode?
         BNE :CONT1       ;It is possible that
         LDA SINST        ;addr equaled $00FF
         ORA #$08         ;Convert ZP->Absolute
         STA SINST
:CONT1   
         JSR DEST2ARG     ;Get correct address back out.
         JSR SETQ
         BCS :ALLDONE

:NORM2   JSR GETQ         ;This is the first addy in the
         BCS :ALLDONE     ;list now
         JSR SETDEST
:NINC    INC DLO          ;Increment the address
         BNE :CONT3
         INC DHI
         LDA DINST
         AND #$0F
         CMP #$05         ;Zero page mode?
         BNE :CONT3       ;It is possible that
         LDA DINST        ;addr equaled $00FF
         ORA #$08         ;Convert ZP->Absolute
         STA DINST
:CONT3                    ;Now convert DEST back to LDA
         LDA DINST
         AND #$1F
         ORA #$A0
         STA DINST
         JSR GENDEST
         JSR GENOPER

:QLOOP2  LDA QSIZE
         BEQ :ALLDONE
         JSR GETQ         ;Instruction is now set up properly
         BCS :ALLDONE     ;i.e. to STA
         JSR SETDEST
         INC DLO
         BNE :CONT2
         INC DHI
         LDA DINST
         AND #$0F
         CMP #$05         ;Zero page mode?
         BNE :CONT2       ;It is possible that
         LDA DINST        ;addr equaled $00FF
         ORA #$08         ;Convert ZP->Absolute
         STA DINST
:CONT2   JSR GENDEST
         JMP :QLOOP2
:ALLDONE RTS

*
* GENOPER generates the ADC xxx STA xxx piece of
* code
*
* It actually does (Operation) SRC  STA DEST
*
GENOPER  
         LDA SINST
         AND #%00011111   ;Convert to ADC, etc.
         ORA MASK
         STA SINST
         LDA EXTRAOP
         BEQ :SKIP
         JSR CODEOUT
:SKIP    JSR GENSRC
         LDA PARENFLAG    ;Skip STA if required
         BNE :RTS
         LDA DINST        ;Convert to STA
         AND #%00011111
         ORA #%10000000
         STA DINST
         JSR GENDEST
:RTS     RTS

*
* BADD: Add SRC+DEST, result in DEST.
*    SRC + DEST -> DEST
*
BADD     
         LDA #%01100000
         STA MASK
         LDA #$18         ;CLC
         STA EXTRAOP
         JMP BOPER

*
* WADD:
*   SRC + DEST -> DEST
*
WADD     
         LDA #%01100000
         STA MASK
         LDA #$18         ;CLC
         STA EXTRAOP
         JMP WOPER

*
* BSUB
*    DEST - SRC -> DEST
*
BSUB     
         LDA #$E0
         STA MASK
         LDA #$38         ;SEC
         STA EXTRAOP
         JMP BOPER
*
* WSUB
*    Word subtract
*
WSUB     
         LDA #$E0
         STA MASK
         LDA #$38
         STA EXTRAOP
         JMP WOPER

*
* BAND
*    SRC AND DEST -> DEST
*
BAND     
         LDA #$20
         STA MASK
         LDA #00
         STA EXTRAOP
         JMP BOPER
*
* WAND
*    Word AND
*
WAND     
         LDA #$20
         STA MASK
         LDA #00
         STA EXTRAOP
         JMP WOPER

*
* BOR
*  SRC OR DEST -> DEST
*
BOR      
         LDA #$00
         STA MASK
         STA EXTRAOP
         JMP BOPER
*
* WOR
*   Word OR
*
WOR      
         LDA #$00
         STA MASK
         STA EXTRAOP
         JMP WOPER

*
* BEOR
*   SRC EOR DEST -> DEST
*
BEOR     
         LDA #$40
         STA MASK
         LDA #00
         STA EXTRAOP
         JMP BOPER
*
* WEOR
*   Word OR
*
WEOR     
         LDA #$40
         STA MASK
         LDA #00
         STA EXTRAOP
         JMP WOPER