*      
* This is now a PUT file.  It contains the general
* utility routines for the compiler -- parser,
* readarg, stack/queue stuff, etc.
*
* SLJ 12/5/96
*

*
* Compiler now uses a new strategy: lines are built
* in memory from the text buffer.  This allows for
* text substitutions (DEF) as well as a more flexible
* compilation strategy.
*
* Currently, the maximum expanded line length is
* 256 characters (for simplicity!)
*

*
* Compiler is now 2-pass, to make WAIT work effectively
* in subroutines.  In the first pass, variables are
* defined, subroutines are tagged for WAIT, and
* the compiler doesn't worry if variables aren't
* found.  In the second pass, the compiler doesn't
* worry about defining new variables.
*
* Hence, ADDVAR, PARSEVAR, etc. have been modified
* to adjust to the current compiler pass.
*

CURPOS   DFB 00           ;Current position in the line
TEXTLEN  DFB 00           ;How much text was looked at
BUFLEN   DFB 00           ;Buffer length
LINEBUF  DS 256           ;Lines are built here

LASTX    DFB 00
LASTY    DFB 00           ;Temporary storage for .Y
LASTCHAR DFB 00

*
* Copy a line of text to the line buffer
*
LINE2BUF 
         LDX #00
:LOOP    JSR NOSPACES     ;Get rid of spaces
         BCC :EXIT        ;EOL or EOF
         STX CURPOS       ;For DEFEXPAND
:COPY    LDA (TEXTP),Y    ;Copy text to buffer
         AND #$7F         ;Convert to lower-case
         CMP #96
         BCC :STA         ;Wish I knew a sneaky way
         SBC #32          ;of doing this...
:STA     STA LINEBUF,X
         INY
         INX
         BEQ :ERR
         JSR TERMCHAR     ;Terminating char?
         BNE :COPY
         STA LASTCHAR
         JSR DEFEXPAND    ;Expand DEFines if necessary
         LDA LASTCHAR     ;See if at EOL or EOF
         BEQ :EXIT
         CMP #13
         BEQ :EXIT
         CMP #';'
         BNE :LOOP
         DEY
         DEX              ;Back up so that NOSPACES
         JMP :LOOP        ;will catch it.

:ERR     LDA #44          ;Line overflow
         STA ERROR
         DEX              ;Place CR at end of buffer
         LDA #13
:EXIT    STX BUFLEN
         STA LINEBUF,X    ;Store last character
         STA LASTCHAR
         STY TEXTLEN      ;Main loop will advance TEXTP
         RTS

*
* Expand DEFines, if necessary
*
* Strategy: search word just printed for a match in
*   the variable table
*
DEFEXPAND
         STX LASTX
         STY LASTY

         LDA #<ENDVTAB    ;Old vartab end
         STA VARPNT
         LDA #>ENDVTAB
         STA VARPNT+1

         LDA CURPOS
         PHA
         JSR FINDVAR      ;See if word is in variable list
         PLA
         LDY ERROR
         BNE :NOPE
         LDY VARID
         CPY #$E0         ;Is it a DEFined variable?
         BNE :NOPE

         TAX              ;Otherwise, copy data
         LDA VARADDR      ;Address of string in text
         STA TEMP
         LDA VARADDR+1
         STA TEMP+1
         LDY #00
:COPY    LDA (TEMP),Y     ;Copy text to buffer
         CMP #13          ;End on EOL or ;
         BEQ :EXIT
         CMP #';'
         BEQ :EXIT
         AND #$7F         ;Convert to lower-case
         CMP #96
         BCC :STA
         SBC #32
:STA     STA LINEBUF,X
         INY
         INX
         BNE :COPY
:ERR     DEX              ;Will force an error
         RTS

:NOPE    LDA #00          ;No variable match found
         STA ERROR
         LDX LASTX
         LDY LASTY
         RTS
:EXIT    
         LDA LASTCHAR     ;Insert end char
         STA LINEBUF,X
         INX
         BEQ :ERR
         LDY LASTY
         RTS

*
* Like NEXTCHAR; removes spaces etc. from line
*
* On entry:
*       TEXTP is set to appropriate line
*       Y is set to appropriate index into line
*
* On exit:
*       Z set -> At EOF
*       C clear -> At end of line
*       Y contains index into next relevant character
*
NOSPACES 
:LOOP    LDA (TEXTP),Y
         CMP #32
         BNE :OUT
         INY
         BNE :LOOP
:OUT     
         CMP #00
         BEQ :CLC
         CMP #'_'
         BNE :COM
         JSR :L2          ;Go to end of line
         BEQ :DONE
         TYA
         LDY #00
         CLC
         ADC TEXTP
         STA TEXTP
         BCC :LOOP        ;Find next char!
         INC TEXTP+1
         BNE :LOOP

:COM     CMP #';'
         BNE :NEXT
:L2      INY              ;Find the CHR$(13)
         LDA (TEXTP),Y
         BEQ :CLC         ;Exit on EOF
         CMP #13
         BNE :L2
:NEXT    CMP #13          ;If CHR$(13) then advance
         BNE :DONE
         INC CURLINE      ;Tracks current line.
         INY
:CLC     CLC
:DONE    RTS

*
* Data structure stuff.
*
* These four subroutines handle entering and removing
* data from the program stack and queue.
*
* Communication register is A.
* On exit, Carry set means an error occured
* (i.e. overflow/underflow)
*

*
* To deal with WAIT inside of subroutines, a new queue
* has been added to the top of the stack.  On the first
* pass, subroutine storage addresses are entered into
* this queue; on the second pass, they are read out.
* If nonzero, then the subroutine contains a WAIT,
* and the return address is stored at the address
* read from the queue.
*

NEWQ     DFB $FF          ;Second queue, builds down into stack.
NEWQTOP  DFB $FF          ;Front of queue

STACKP   DS 1             ;Pointers
QFRONT   DS 1             ;Indexes really
QBACK    DS 1
QSIZE    DS 1             ;Size of Q
DTEMP    DS 1             ;Temp storage

ENQNEW   
         STY DTEMP
         LDY NEWQ
         STA STACK,Y
         DEY
         STY NEWQ
         CPY STACKP
         BCC QERR
         CLC
         LDY DTEMP
         RTS

DEQNEW   
         STY DTEMP
         LDY NEWQTOP
         CPY NEWQ
         BEQ QERR
         LDA STACK,Y
         DEC NEWQTOP
         CLC
         BCC STAKDONE

PUSH     
         STY DTEMP
         CLC
         LDY STACKP
         STA STACK,Y
         INY
         STY STACKP
         CPY NEWQ         ;Subroutines build down
         BCC STAKDONE
STAKERR  LDY #20          ;Carry is set
         STY ERROR
STAKDONE LDY DTEMP
         RTS

PULL     
         STY DTEMP
         LDY STACKP
         DEY
         LDA STACK,Y
         STY STACKP
         CPY #255         ;Carry set only if Y=255
         BCS STAKERR
         LDY DTEMP
         RTS

ENQ                       ;Stick something into the back
         CLC              ;of the queue
         STY DTEMP
         LDY QBACK
         STA QUEUE,Y
         INY
         STY QBACK
         INC QSIZE
         BNE QDONE
QERR     SEC
         LDY #18
         STY ERROR
QDONE    LDY DTEMP
         RTS

DEQ                       ;Grab something from the front
         CLC              ;of the queue
         STY DTEMP
         LDY QFRONT
         LDA QUEUE,Y
         INY
         STY QFRONT
         LDY QSIZE
         DEY
         STY QSIZE
         CPY #255
         BEQ QERR
         LDY DTEMP
         RTS


*
* CODEOUT
*
* This little guy outputs the byte in A into the code
* pointed to by CODEP, and increments CODEP.
*
* X Y and A are preserved (but TEMP is hosed :)
*
CODEOUT  
         STY TEMP
         LDY #00
         STA (CODEP),Y
         INC CODEP
         BNE :DONE
         INC CODEP+1
:DONE    LDY TEMP
         RTS

*
* PARSE
*
* This is the main parse routine for commands.  It checks
* to see if it is a legal command by matching against the
* command list.  If it is legal, then the appropriate
* processing address is fetched and jumped to.
*
* The keyword list is in alphabetical order.  Only the
* first three characters are matched, and succeeding
* characters up to the next space are ignored.
*
JUMPADR  DA 0             ;Variable to assemble jump location
PARSE    
         LDA NUMWORDS     ;Total number of keywords
         STA TEMP
         LDA #3
         STA TEMP+1       ;Number of characters to match
         LDX #00
:LOOP    LDA LINEBUF,Y    ;Get character
:LOOP2   CMP KEYWORD,X    ;See if matches a valid keyword
         BCC :ERR         ;If less than, then we have a
                          ;syntax error
         BEQ :CONT        ;A-ha!  A match!
         INX              ;Otherwise, move forwards to
         INX              ;next entry
         INX
         INX
         INX
         DEC TEMP         ;See if we hit end of keyword list
         BNE :LOOP2
:ERR     LDA #02          ;Exit with error set
         STA ERROR
         RTS
:CONT                     ;A successful match
         INX              ;match next character
         INY
         DEC TEMP+1       ;If we haven't yet matched all 3
         BNE :LOOP        ;chars then keep looking
         LDA KEYWORD,X    ;Otherwise, get address
         STA JUMPADR
         INX
         LDA KEYWORD,X
         STA JUMPADR+1
         JSR NEXTSPC      ;Get rid of extra characters
         JSR NEXTCHAR     ;Advance to next relevant character
         JMP (JUMPADR)    ;Off we go!

*-------------------------------

* Variable processing routines
*
* Variables are now much more powerful, in that the
* user can define his own variables, both as labels
* (DEF) and as embedded variables (VAR).
*
* In addition, the start and end of the variable table
* is kept in zero-page, so variables can take up quite
* a lot of memory if necessary.
*

VARID    DFB 00           ;ID byte          -
VARXADDR DA 00            ;Indexed address  -DON'T SPLIT
VARADDR  DA 00            ;Variable address -THESE UP!

*
* Creates a new variable in the variable list.
* Variables are stored as NAME ID INDEX BASE
*
* The ID byte tells what kind of variable this is:
*   $FF Normal
*   $FE DATA
*   $E0 DEFine
*   $E1 SUBroutine
*
* The list ends with a 00.
*
* On entry, CURPOS is assumed to contain the position
* of the variable name within LINEBUF.
*

ADDFLAG  DFB 00

ADDVAR   
         LDA PASS         ;First or second pass?
         BNE :DONE        ;skip on pass 2
         STA ADDFLAG
         LDY CURPOS
         LDA LINEBUF,Y
         CMP #':'         ;Must start with e.g. char
         BCC :ERR
         JSR PARSEVAR
         LDA ADDFLAG      ;Signals that variable doesn't
         BEQ :ERR         ;already exist.

         LDY #00
* STY ERROR
         LDX CURPOS
:LOOP    LDA LINEBUF,X    ;Copy variable name to list
         JSR TERMCHAR     ;Would be better to pad with
         BEQ :ID          ;a space...
         STA (VAREND),Y
         INX
         INY
         BNE :LOOP
:ID      LDA VARID        ;ID byte
         STA (VAREND),Y
         STX CURPOS       ;Advanced to next char
         LDX #00
:LOOP2   INY
         LDA VARXADDR,X   ;And data
         STA (VAREND),Y
         INX
         CPX #4
         BNE :LOOP2
         INY
         LDA #00          ;End with a null byte
         STA (VAREND),Y
         TYA              ;And update VAREND
         CLC
         ADC VAREND
         STA VAREND
         LDA VAREND+1
         ADC #00
         STA VAREND+1
         CMP #$CE         ;Don't want to overflow
         BCC :DONE
         LDA #42          ;Way too many variables
         DFB $2C
:ERR     LDA #40          ;Crappy variable name
         STA ERROR
:DONE    LDY CURPOS
         RTS

*
* And this guy parses variables.  Just to be different,
* variables can have less or more than three chars in
* them.  Each variable name is terminated by a null
* byte, followed by four bytes.  The second byte pair
* is the actual location of the variable.  The first
* byte pair is the index value for that variable.
* For instance, FREQ needs to know which voice is
* currently active, and thus which of the three SID
* registers to use.
*
* The variable table is no longer in alphabetical
* order.
*
* On exit, the four bytes are stored in VARADDR and
* VARXADDR, or else an error is set.  CURPOS is updated
* to the point immediately following the variable.
*
* Note that PARSEVAR needs to be called in both
* compiler passes, to make sure addresses are correct.
*
PARSEVAR 
         LDA #<VARTAB     ;Start at beginning of list
         STA VARPNT
         LDA #>VARTAB
         STA VARPNT+1
         STY CURPOS
FINDVAR  
         LDY #00          ;Check for terminating id byte
         LDA (VARPNT),Y
         BEQ :ERR
         BMI :ERR
:LOOP2   LDX CURPOS
:LOOP    LDA (VARPNT),Y
         BMI :END         ;Variable identifier -- all
         CMP LINEBUF,X    ;chars matched
         BNE :LOOP3
         INY
         INX
         BNE :LOOP
:ERR     LDA ADDFLAG      ;Signal ADDVAR all is well
         BEQ :INC
         LDA PASS         ;If on first pass, don't err
         BEQ :PASS0
         LDA #02          ;Exit with error set
         STA ERROR
:INC     INC ADDFLAG
         RTS

:END     LDA LINEBUF,X
         JSR TERMCHAR     ;Did both strings terminate?
         BEQ :EXIT

:LOOP3   LDA (VARPNT),Y   ;If not then move forwards to
         BMI :NEXT        ;next variable
         INY
         BNE :LOOP3       ;Look for terminator
:NEXT    TYA
         CLC
         ADC #5           ;Grab the id + four bytes
         ADC VARPNT
         STA VARPNT
         BCC FINDVAR
         INC VARPNT+1
         BCS FINDVAR

:EXIT    STX CURPOS
         LDX #00
:L4      LDA (VARPNT),Y   ;Copy bytes
         STA VARID,X
         INY
         INX
         CPX #5           ;id + 4 bytes
         BNE :L4
:DONE    LDY CURPOS
         RTS

:PASS0   LDX CURPOS       ;Pass 0 error -- just skip
:L5      LDA LINEBUF,X    ;to next char
         INX
         JSR TERMCHAR
         BNE :L5
         DEX
         STX CURPOS
         LDX #4           ;And copy dummy subroutine variable
:L6      LDA :DUMMY,X     ;(should cover normal variables
         STA VARID,X      ;as well)
         DEX
         BPL :L6
         BMI :DONE

:DUMMY   DFB $E1,00,00,$FF,$FF

*
* 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.
*
* New: _ extends the line.  When _ is encountered the
*   parser ignores the rest of the line, and proceeds to
*   the next char past the end of the line.
*
* On entry:
*    Y is set to the current position within LINEBUF
*
* On exit:
*       Z set -> At EOF
*       C clear -> At end of line
*       Y contains index into next relevant character
*
NEXTCHAR 
:LOOP    LDA LINEBUF,Y
         CMP #32
         BNE :OUT
         INY
         BNE :LOOP
:OUT     
         CMP #00
         BEQ :CLC
* CMP #'_'
* BNE :COM
* JSR :L2 ;Go to end of line
* BEQ :DONE
* TYA
* LDY #00
* CLC
* ADC POINT
* STA POINT
* BCC :LOOP ;Find next char!
* INC POINT+1
* BNE :LOOP

*:COM CMP #';'
* BNE :NEXT
*:L2 INY ;Find the CHR$(13)
* LDA (POINT),Y
* BEQ :CLC ;Exit on EOF
* CMP #13
* BNE :L2
:NEXT    CMP #13          ;If CHR$(13) then advance
         BNE :DONE
* INC CURLINE ;Tracks current line.
* INY
:CLC     CLC
         TAX              ;Set Z correctly
:DONE    RTS

*
* NEXTSPC
*
* This guy advances to the next space character, unless
* CHR$(13) or EOF is hit..
*
NEXTSPC  
:LOOP    
         LDA LINEBUF,Y
         CMP #13
         BEQ :DONE
         CMP #00
         BEQ :DONE
         CMP #32
         BEQ :DONE
         CMP #'*'         ;For VAR*
         BEQ :DONE
         INY
         BNE :LOOP
:DONE    RTS

*
* TERMCHAR
*
* This simply sets Z if a terminating character is
* contained in A.
*
TERMCHAR 
         CMP #00
         BEQ :DONE
         CMP #' '         ;Check to see if at end of ARG
         BEQ :DONE        ;This really isn't all necessary
         CMP #','         ;it just gives a little more
         BEQ :DONE        ;error information.
         CMP #'<'
         BEQ :DONE
         CMP #'>'
         BEQ :DONE
         CMP #13          ;CR
         BEQ :DONE
         CMP #';'         ;Comment could follow as well
         BEQ :DONE
         CMP #'&'         ;Additional result storage
         BEQ :DONE
         CMP #'-'         ;For test routine
         BEQ :DONE
         CMP #'+'         ;Increment argument
         BEQ :DONE
         CMP #')'         ;Uninvolved operand
:DONE    RTS

*
* READARG
*
* [ARG] is of the form [#[$ %] $](number or variable)[,](ARG)
* Examples:
*     #32     -- Immediate mode, number 32
*     #%0101  -- Immediate mode, number 5
*     #$C000  -- Immediate mode, number 49152
*     $1000   -- Address, 4096
*     $1000,L1 - Indexed address.  LDX L1  LDA $1000,X
*
* # denotes immediate mode, i.e. a number
*   within immediate mode, $ implies hex number and % means
*   binary, default is decimal.
* $ denotes absolute address, in hex.
* , implies indexed addressing.
*
* Reads in an argument [ARG].  Relevant data is built
* and stored in the variables below.  On successful exit
* INST will contain the appropriate form of the LDA
* instruction: immediate  zero page  zp,x  absolute  abs,x
* ADDR will contain the appropriate data, either an address
* or a number for immediate mode.  If indexed mode is called
* for, the appropriate form for the LDX instruction is stored
* in XINST etc.
*
* On entry, .Y should contain the current line pos
*
* On exit, A will contain ADDR and X will contain ADDR+1
*
INST     DFB 0            ;Instruction
ADDR     DA 0             ;Address
XINST    DFB 0            ;If indexed mode, contains index instr
XADDR    DA 0             ;Address to load index with
XADDRX   DA 0             ;Index may be indexed
XFLAG    DFB 0            ;Nonzero if arg is for indexed mode

READARG  
         LDA #00
         STA XINST        ;Will be nonzero only if indexed mode
                          ;is specified.
         LDA LINEBUF,Y
         CMP #'#'         ;Is it immediate mode?
         BNE :ADDR
         LDA #$A9         ;LDA #
         PHA              ;In case this is X-indexed
         INY              ;Advance past the # character
         JSR READNUM      ;Read in number
         PHA              ;Stack is now LO INST
         LDA XFLAG
         BNE :XCASE
         PLA
         STA ADDR
         PLA
         STA INST
         STX ADDR+1
         LDA ERROR
         BNE :DONEJMP
         JSR PLUSOFF      ;Check for "+/-" offsets
         LDA LINEBUF,Y
         CMP #','         ;No indexed immediate allowed!
         BNE :DONEJMP
         LDA #6
         STA ERROR
         RTS
:DONEJMP JMP :DONE

:ADDR    LDA #$AD         ;LDA $
         PHA              ;stack = INST
         LDA LINEBUF,Y
         CMP #'$'
         BNE :VAR
         JSR READNUM      ;An immediate, hex address
         PHA              ;stack = INST ADDRLO
         LDA ERROR
         BEQ :CONT

:ERRDONE PLA              ;Fix up stack
         PLA
         JMP :DONE

:VAR     LDA #00
         STA XINSTFLAG
         JSR READVAR      ;Read in a variable
         PHA              ;stack = INST ADDRLO
         LDA ERROR
         BNE :ERRDONE

:CONT    
         LDA XFLAG        ;Store in INST etc. or XINST
         BNE :XCASE
         PLA
         STA ADDR
         PLA
         STA INST
         STX ADDR+1
         JSR PLUSOFF      ;Handle offsets BEFORE checking
                          ;for ZP
         LDA ADDR+1       ;If high byte of address is zero
         BNE :NOZP        ;then use zero-page form of
         LDA #$A5         ;addressing
         STA INST
:NOZP    LDA LINEBUF,Y
:CONT2   CMP #','         ;Indexed mode, perhaps?
         BNE :DONE
         STA XFLAG        ;Set the indexed mode flag
         LDA INST
         ORA #$10         ;Ax goes to Bx
         STA INST         ;which converts to indexed form
         INY
         JSR NEXTCHAR     ;Advance to next nonspace character
                          ;beyond the comma.
         JMP READARG      ;Read in the X-argument

                          ;Must be reading index mode arg
:XCASE   LDA XINSTFLAG    ;First check if indexed variable
         CMP #$BD         ;is being used
         BNE :C0X
         PLA
         STA XADDRX       ;If so, store as extra address
         STX XADDRX+1
         PLA
         LDA XINSTFLAG
         DEC XINSTFLAG    ;Reset the flag
         BNE :C3X         ;And set XINST to LDA ,X
:C0X     PLA
         STA XADDR
         STX XADDR+1
         PLA
         CMP #$A9
         BNE :C1X
         LDA #$A2         ;Immediate
:C1X     CMP #$AD
         BNE :C2X
         LDA #$AE         ;Absolute
:C2X     STA XINST
         JSR PLUSOFF      ;Handle + offsets
         LDA XADDR+1      ;High byte zero?
         BNE :NOXZP
         LDA #$A6         ;LDX zp
:C3X     STA XINST
:NOXZP   LDA LINEBUF,Y
         CMP #','         ;Can't index an index
         BNE :DONE
         LDA #8
         STA ERROR
:DONE    
         LDA #00
         STA XFLAG
         LDA ADDR
         LDX ADDR+1
         RTS

*
* PLUSOFF -- Gets offset i.e. +/- #arg.  If XFLAG is set
* (and wasn't set by a variable) then offset is added
* to XADDR, otherwise offsets are added to ADDR.
*
PLUSOFF  
:LOOP    
         LDA LINEBUF,Y    ;Indexed arg check
         CMP #'+'         ;Check for offsets
         BNE :MINUS
         INY
         JSR NEXTCHAR     ;Find next char
         BCC :ERR
         LDA LINEBUF,Y
         CMP #'#'         ;Make sure it's immediate
         BEQ :CONT
         LDA #2           ;Syntax error
         STA ERROR
         RTS
:CONT    
         INY
         JSR READNUM      ;Get the number
         PHA
         LDA XFLAG
         BEQ :ADDR        ;If zero, then no X offset
         CMP #$FF         ;Variables set this to $FF
         BNE :ADDX
:ADDR    PLA
         CLC              ;So add to ADDR
         ADC ADDR
         STA ADDR
         TXA
         ADC ADDR+1
         STA ADDR+1
         BCC :LOOP        ;And keep going...
         LDA #36          ;Overflow error
         STA ERROR
         RTS
:ADDX    PLA              ;If not a variable, then add
         CLC              ;to X address
         ADC XADDR
         STA XADDR
         TXA
         ADC XADDR+1
         STA XADDR+1
         BCC :LOOP
         LDA #36          ;Overflow
         STA ERROR
         RTS
:ERR     
         LDA #14
         STA ERROR
:DONE    RTS

:MINUS   CMP #'-'         ;The same, but subtract instead
         BNE :DONE        ;of add!
         INY
         JSR NEXTCHAR     ;Find next char
         BCC :ERR
         LDA LINEBUF,Y
         CMP #'#'         ;Make sure it's immediate
         BEQ :CONT2
         LDA #2           ;Syntax error
         STA ERROR
         RTS
:CONT2   
         INY
         JSR READNUM      ;Get the number
         STA DTEMP
         LDA XFLAG
         BEQ :SUBA        ;If zero, then no X offset
         CMP #$FF         ;Variables set this to $FF
         BNE :SUBX
:SUBA    LDA ADDR
         SEC              ;So subtract from ADDR
         SBC DTEMP
         STA ADDR
         STX DTEMP
         LDA ADDR+1
         SBC DTEMP
         STA ADDR+1
         BCC :OOPS        ;And keep going...
         JMP :LOOP
:SUBX    LDA XADDR        ;If not a variable, then sub
         SEC              ;from X address
         SBC DTEMP
         STA XADDR
         STX DTEMP
         LDA XADDR+1
         SBC DTEMP
         STA XADDR+1
         BCC :OOPS
         JMP :LOOP
:OOPS    LDA #38          ;Underflow error
         STA ERROR
         RTS

*
* READNUM
*
* Returns number in (A, X) = (LO, HI)
* Also sets error if illegal number is present.
*
* Strategy: ans = base*ans + num
* A general multiply routine should be used but it's
* so simple that I don't bother.
*
BASE     DFB 0
READNUM  
         LDA #00
         STA TEMP
         STA TEMP+1
         LDA #10          ;Base 10 = default
         STA BASE
         LDA LINEBUF,Y
         CMP #'$'
         BNE :C1
         LDA #16          ;Hex
         STA BASE
         INY              ;Advance to next char
:C1      CMP #'%'
         BNE :C2
         LDA #2           ;Binary
         STA BASE
         INY
:C2      

:LOOP    
         ASL TEMP
         ROL TEMP+1
         LDA BASE         ;If binary then we are done
         CMP #16
         BNE :BASE10
         ASL TEMP         ;Multiply by 16
         ROL TEMP+1
         ASL TEMP
         ROL TEMP+1
         ASL TEMP
         ROL TEMP+1
         BCS :ERR

:BASE10  CMP #10          ;To mult by ten, use
         BNE :OK          ;10*x = 8*x + 2*x
         LDA TEMP+1
         PHA
         LDA TEMP
         ASL TEMP         ;temp=8*x
         ROL TEMP+1
         ASL TEMP
         ROL TEMP+1
         CLC
         ADC TEMP         ;Add in 2*x
         STA TEMP
         PLA
         ADC TEMP+1
         STA TEMP+1
         BCS :ERR
:OK      
         LDA LINEBUF,Y    ;Now add in the number
         SEC
         SBC #48          ;0 -> 0 etc.
         CMP #10
         BCC :C4
         SBC #07          ;Must be a letter (or an error)
:C4      CMP BASE
         BCS :ERR         ;If number>base then we are in trouble!
                          ;Otherwise add and advance
         ADC TEMP
         STA TEMP
         BCC :C5
         INC TEMP+1
:C5      INY
         LDA LINEBUF,Y
         JSR TERMCHAR     ;Look for terminating character
         BNE :LOOP

:DONE    LDA TEMP
         LDX TEMP+1
         RTS
:ERR     LDA #10
         STA ERROR
         RTS

*
* READVAR
*
* Reads in a variable.  Variables are special in that
* most of them are accessed via an index, i.e.
* LDX blah LDA yak,blah.  An exception is SHADOW,
* the location of the shadow sid.  There may be
* other exceptions too, what the heck do I know.
* (global variables, etc.)
*
* As a collorary, many variables cannot be used with
* indexing.
*
* This procedure will modify INST and ADDR directly
* if an indexed variable is used.
*
* Variables of which there are a lot (e.g. globals)
* are handled special, to save space and time.
*
* Since DEFined variables are translated by
* DEFEXPAND, they should never appear as an argument.
* READVAR generates an error when they are read.
*

XINSTFLAG DFB 00
*VARTEMP DS 2
READVAR  
         LDA LINEBUF,Y    ;First check the easy cases
         CMP #'g'         ;Global vars
         BEQ :GJMP
         CMP #'l'         ;Local vars
         BEQ :LJMP
         CMP #'m'         ;Markers
         BNE :CONT
         JMP :MARKER
:GJMP    JMP :GLOBAL
:LJMP    JMP :LOCAL
:CONT    
         JSR PARSEVAR     ;On exit, contents are stored
         LDA ERROR        ;in VARADDR, VARXADDR
         BNE :DONE
         LDA VARID
         CMP #$E1         ;SUBroutines are OK
         BCC :ERRDEF      ;but not DEFined vars!
         LDA VARXADDR
         ORA VARXADDR+1
         BEQ :NOX         ;If xaddr=0 then no index
         LDX VARID
         INX              ;If $FF then normal
         BEQ :NODATA
         LDA DATALO       ;$FE means DATA
         LDX DATAHI
         RTS
:NODATA                   ;Otherwise, an x index
         LDA XFLAG        ;If this is set, then we
         BNE :INDEX       ;need to store more sneakily
         LDA #$BD         ;LDA ,X
         STA INST
         LDA VARADDR      ;Base address of variable
         STA ADDR         ;Make this the LDA
         LDA VARADDR+1
         STA ADDR+1
:CX      LDA VARXADDR
         LDX VARXADDR+1
         DEC XFLAG        ;Set flag so this is
         RTS              ;interpreted as an indirect load
                          ;Pretty sneaky I think.
:INDEX   LDA #$BD
         STA XINSTFLAG    ;Variable must be an index
         LDA VARADDR
         STA XADDR
         LDA VARADDR+1
         STA XADDR+1
         JMP :CX

:NOX     LDA VARADDR      ;No index, so just grab
         LDX VARADDR+1    ;address and exit.
         RTS

:ERRDEF  LDA #54          ;Bad variable type
         DFB $2C
:ERRX    LDA #8           ;Bad index
         DFB $2C
:ERRG    LDA #2           ;Syntax error
         STA ERROR        ;i.e. unknown variable
         RTS
:GLOBAL  
         JSR ISNUM        ;Make sure not normal variable
:BCC     BCC :CONT
         INY
         JSR READNUM      ;Read the number
         CPX #00
         BNE :ERRG        ;Better not be a hi byte!
         CMP #16          ;And there are only 16
         BCS :ERRG        ;vars 0..15
         LDX #>GLOBVAR
         ADC #<GLOBVAR    ;Otherwise, add number to base
         BCC :DONE
         INX
:DONE    RTS
:LOCAL   
         JSR ISNUM        ;Make sure not normal variable
         BCC :BCC
         INY              ;Local variables have
         JSR READNUM      ;an index, though.
         CPX #00
         BNE :ERRG
         CMP #8           ;Only 8 local vars right now.
         BCS :ERRG
         LDX XFLAG
         BNE :LINDEX
         DEC XFLAG        ;XFLAG -> $FF
         LDX #>LOCALVAR
         ADC #<LOCALVAR
         BCC :CONT1
         INX
:CONT1   STA ADDR         ;Base of table
         STX ADDR+1       ;hi byte
         LDA #$BD         ;LDA ,X
         STA INST
:CONT11  LDA #<LOCOFF     ;Local variable offset
         LDX #>LOCOFF
         RTS

:LINDEX  ADC #<LOCALVAR   ;Carry is clear
         STA XADDR
         LDA #>LOCALVAR
         ADC #00
         STA XADDR+1
         LDA #$BD
         STA XINSTFLAG    ;Variable must be an index
         BNE :CONT11

:MARKER  
         JSR ISNUM        ;Make sure not normal variable
         BCC :BCC
         INY
         JSR READNUM      ;32 markers
         CPX #00          ;Markers are stored (lo hi lo hi)
         BNE :ERRG
         CMP #32
         BCS :ERRG
         ASL              ;So multiply by two
         ADC #<MARKERS
         LDX #>MARKERS
         BCC :CONT2
         INX
:CONT2   RTS


*
* 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    
         STY TEMPY
:LOOP    INY
         LDA LINEBUF,Y
         JSR TERMCHAR
         BEQ :EXIT        ;C set
         CMP #'0'
         BCC :EXIT
         CMP #'9'+1
         BCC :LOOP
         CLC
:EXIT    LDY TEMPY
         RTS

*
* Some very important variables.  These are the source
* and destination instructions and addresses that are
* built from a great many commands.
*

SINST    DFB 00           ;Source instruction
SLO      DFB 00           ;Source address
SHI      DFB 00
SXINST   DFB 00           ;Source indexed mode instruction
SXLO     DFB 00
SXHI     DFB 00
SXLOX    DFB 00           ;Indexed variables allowed
SXHIX    DFB 00

DINST    DFB 00           ;Destination instruction
DLO      DFB 00
DHI      DFB 00
DXINST   DFB 00
DXLO     DFB 00
DXHI     DFB 00
DXLOX    DFB 00
DXHIX    DFB 00

LASTXI   DS 1             ;This stores the last instruction
LASTXLO  DS 1             ;i.e. what X was last loaded with.
LASTXHI  DS 1             ;This way, redundant LDX instructions
                          ;may be eliminated.
LASTXLOX DFB 00
LASTXHIX DFB 00

*
* SETSRC: Copies argument output into source variables
*
SETSRC   
         LDX #7
:LOOP    LDA INST,X
         STA SINST,X
         DEX
         BPL :LOOP
         RTS

*
* SETDEST: Remarkably similar to SETSRC
*
SETDEST  
         LDX #7
:LOOP    LDA INST,X
         STA DINST,X
         DEX
         BPL :LOOP
         RTS

*
* SETQ: Places argument into the queue
*
SETQ     
         LDX #7
:LOOP    LDA INST,X
         JSR ENQ
         BCS :RTS
         DEX
         BPL :LOOP
:RTS     RTS

*
* SRC2ARG: Reverse of SETSRC
*
SRC2ARG  
         LDX #7
:LOOP    LDA SINST,X
         STA INST,X
         DEX
         BPL :LOOP
         RTS

*
* DEST2ARG: Remarkably similar to SRC2ARG
*
DEST2ARG 
         LDX #7
:LOOP    LDA DINST,X
         STA INST,X
         DEX
         BPL :LOOP
         RTS

*
* GETQ: Removes an argument from the queue and places
* it into the INST variables.
*
GETQ     
         LDX #7
:LOOP    JSR DEQ
         BCS :RTS
         STA INST,X
         DEX
         BPL :LOOP
:RTS     RTS

*
* PUSHARG: Pushes argument onto the stack
*
PUSHARG  
         LDX #7
:LOOP    LDA INST,X
         JSR PUSH
         BCS :RTS
         DEX
         BPL :LOOP
:RTS     RTS

*
* Not too difficult to figure out.
*
PULLARG  
         LDX #0           ;But do it in reverse order!
:LOOP    JSR PULL
         BCS :RTS
         STA INST,X
         INX
         CPX #8
         BNE :LOOP
:RTS     RTS

*
* GENCODE outputs the instructions in SINST etc.
*
* GENCODE is now two procedures, one for source
* and one for dest.
*
GENSRC   
         LDA SXINST       ;Is this indexed mode?
         BEQ :INST
         CMP LASTXI       ;Check to see if this would
         BNE :NEWX        ;be redundant.
         LDA SXLO
         CMP LASTXLO
         BNE :NEWX
         LDA SXHI
         CMP LASTXHI
         BNE :NEWX
         LDA SXLOX
         CMP LASTXLOX
         BNE :NEWX
         LDA SXHIX
         CMP LASTXHIX
         BEQ :INST        ;Just skip it

:NEWX    LDA SXINST
         CMP #$BD         ;Indexed index?
         BNE :NEWX2
         LDA #$AE         ;LDX abs
         JSR CODEOUT      ;If so, then generate extra
         LDA SXLOX        ;LDX code
         STA LASTXLOX
         JSR CODEOUT
         LDA SXHIX
         STA LASTXHIX
         JSR CODEOUT
         LDA SXINST

:NEWX2   STA LASTXI       ;Store the last X instruction
         JSR CODEOUT      ;If so, then output code
         LDA SXLO
         STA LASTXLO
         JSR CODEOUT
         LDA SXHI
         STA LASTXHI
         LDA SXINST
         JSR IS2BYTE
         BEQ :C1
         LDA SXHI
         JSR CODEOUT
:C1      LDA SXINST       ;Might need a final TAX
         CMP #$BD
         BNE :INST
         LDA #$AA
         JSR CODEOUT

:INST    LDA SINST
         JSR CODEOUT
         LDA SLO
         JSR CODEOUT
         LDA SINST        ;2 or 3 byte instruction?
         JSR IS2BYTE
         BNE :CONT
         RTS
:CONT    LDA SHI          ;Must be 3 bytes then.
         JMP CODEOUT

TESTFLAG DS 1             ;Flag to test for immediate
                          ;destination (ok for TEST command)
GENDEST  LDA DXINST
         BEQ :DINST
         CMP LASTXI       ;Check to see if this would
         BNE :NEWX        ;be redundant.
         LDA DXLO
         CMP LASTXLO
         BNE :NEWX
         LDA DXHI
         CMP LASTXHI
         BNE :NEWX
         LDA DXLOX
         CMP LASTXLOX
         BNE :NEWX
         LDA DXHIX
         CMP LASTXHIX
         BEQ :DINST       ;Just skip it

:NEWX    LDA DXINST
         CMP #$BD         ;Indexed index?
         BNE :NEWX2
         LDA #$AE         ;LDX abs
         JSR CODEOUT      ;If so, then generate extra
         LDA DXLOX        ;LDX code
         STA LASTXLOX
         JSR CODEOUT
         LDA DXHIX
         STA LASTXHIX
         JSR CODEOUT
         LDA DXINST

:NEWX2   STA LASTXI
         JSR CODEOUT
         LDA DXLO
         STA LASTXLO
         JSR CODEOUT
         LDA DXHI
         STA LASTXHI
         LDA DXINST
         JSR IS2BYTE
         BEQ :C1
         LDA DXHI
         JSR CODEOUT
:C1      LDA DXINST       ;Might need a final TAX
         CMP #$BD
         BNE :DINST
         LDA #$AA
         JSR CODEOUT
:DINST   LDA TESTFLAG     ;Skip the test if set
         BNE :SKIP
         LDA DINST
         AND #$0F         ;Cannot have immediate address
         CMP #09          ;as a destination
         BEQ :ERR
:SKIP    LDA DINST
         JSR CODEOUT
         LDA DLO
         JSR CODEOUT
         LDA DINST        ;2 or 3 bytes?
         JSR IS2BYTE
         BEQ :DONE
         LDA DHI
         JMP CODEOUT      ;And exit
:ERR     LDA #16
         STA ERROR
:DONE    RTS

*
* IS2BYTE -- Checks to see if instruction in A is a 2-byte
* instruction.
*
IS2BYTE                   ;For our purposes
         AND #$0F         ;if it ends in a 9, 5, 6, or 2
         CMP #9           ;then it is a 2-byte instruction
         BEQ :DONE        ;(LDA $xxxx,Y is an exception,
         CMP #5           ;but is not used by compiler)
         BEQ :DONE
         CMP #6
         BEQ :DONE
         CMP #2
:DONE    RTS
