* * 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 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 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 # $FF LDX #>LOCALVAR ADC #LOCOFF RTS :LINDEX ADC #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 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