P* * 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 * * * 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) * STACKP DS 1 ;Pointers QFRONT DS 1 ;Indexes really QBACK DS 1 SSIZE DS 1 ;Size of stack QSIZE DS 1 ;Size of Q DTEMP DS 1 ;Temp storage PUSH STY DTEMP CLC LDY STACKP STA STACK,Y INY STY STACKP INC SSIZE BNE :DONE SEC LDY #20 STY ERROR :DONE LDY DTEMP RTS PULL STY DTEMP LDY STACKP DEY LDA STACK,Y STY STACKP LDY SSIZE DEY STY SSIZE CPY #255 ;Carry set only if Y=255 BCC :CONT LDY #20 STY ERROR :CONT 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 :DONE SEC LDY #18 STY ERROR :DONE 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 BNE :DONE SEC LDY #18 STY ERROR :DONE 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 (POINT),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! * * 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. * * As always, the variable table is in alphabetical order. * * On exit, X contains the index into VARTAB of the * four bytes. * PARSEVAR LDA NUMVARS ;Total number of keywords STA TEMP LDA #0 STA TEMP+1 ;Number of characters matched LDX #00 :LOOP LDA (POINT),Y ;Get character JSR TERMCHAR ;Check if it is a terminating BEQ :DONE ;char i.e. < > & ; space :LOOP2 CMP VARTAB,X ;See if matches a valid keyword BCC :ERR ;If less than, then we have a ;syntax error BEQ :CONT ;A-ha! A match! PHA :LOOP3 INX ;Otherwise, move forwards to LDA VARTAB,X ;next entry BNE :LOOP3 ;Look for null terminator TXA CLC ADC #5 ;Grab the null + four bytes ADC TEMP+1 ;Add number of matched chars TAX PLA 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 INC TEMP+1 INX ;match next character INY BNE :LOOP ;Go until terminating char is found. :DONE ;Check to see if variable was LDA VARTAB,X ;really found, and not just a BNE :ERR ;piece of one, by making sure INX ;null byte is there. RTS * * NEXTCHAR: Advance to next relevant character in the * text. Either skips space or advances to the next line. * * Strategy: advance through the text until a non-space * character is found. If character is 00 then we are at * EOF. If char is ; then advance to end of line. If character * is CHR$(13) then add one to pointer and exit. * * 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: * POINT 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 * NEXTCHAR :LOOP LDA (POINT),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 :DONE RTS * * NEXTSPC * * This guy advances to the next space character, unless * CHR$(13) or EOF is hit.. * NEXTSPC :LOOP LDA (POINT),Y CMP #13 BEQ :DONE CMP #00 BEQ :DONE CMP #32 BEQ :DONE INY BNE :LOOP :DONE RTS * * TERMCHAR * * This simply sets Z if a terminating character is * contained in A. * TERMCHAR 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 :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 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 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 (POINT),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 (POINT),Y CMP #',' ;No indexed immediate allowed! BNE :DONEJMP LDA #6 STA ERROR RTS :DONEJMP JMP :DONE :ADDR LDA #$AD ;LDA $ PHA ;stack = INST LDA (POINT),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 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 (POINT),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 :XCASE PLA ;Must be reading in an argument STA XADDR ;for indexed mode 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 STA XINST :NOXZP LDA (POINT),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 (POINT),Y ;Indexed arg check CMP #'+' ;Check for offsets BNE :MINUS INY JSR NEXTCHAR ;Find next char BCC :ERR LDA (POINT),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 (POINT),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 (POINT),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 (POINT),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 (POINT),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. * VARTEMP DS 2 READVAR LDA (POINT),Y ;First check the easy cases CMP #'g' ;Global vars BEQ :GLOBAL CMP #'l' ;Local vars BEQ :LOCAL CMP #'m' ;Markers BNE :CONT JMP :MARKER :CONT JSR PARSEVAR ;On exit, X is index into LDA ERROR ;variable table BNE :DONE LDA VARTAB,X ;Lo byte STA VARTEMP INX LDA VARTAB,X ;hi byte BEQ :NOX ;If hi=0 then no index CMP #$FF ;If hi=$FF then DATA BNE :NODATA LDA DATALO LDX DATAHI RTS :NODATA STA VARTEMP+1 ;Otherwise, there is! LDA XFLAG ;If this is set, then we BNE :ERRX ;are hosed. LDA #$BD ;LDA ,X STA INST LDA VARTAB+1,X ;Base address of variable STA ADDR ;Make this the LDA LDA VARTAB+2,X STA ADDR+1 LDA VARTEMP LDX VARTEMP+1 DEC XFLAG ;Set flag so this is RTS ;interpreted as an indirect load ;Pretty sneaky I think. :NOX LDA VARTAB+1,X ;No index, so just grab PHA ;address and exit. LDA VARTAB+2,X TAX PLA RTS :GLOBAL 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 :MARKER 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 :ERRX LDA #8 ;Bad index STA ERROR RTS :ERRG LDA #2 ;Syntax error STA ERROR ;i.e. unknown variable 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 DINST DFB 00 ;Destination instruction DLO DFB 00 DHI DFB 00 DXINST DFB 00 DXLO DFB 00 DXHI 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. * * SETSRC: Copies argument output into source variables * SETSRC LDX #5 :LOOP LDA INST,X STA SINST,X DEX BPL :LOOP RTS * * SETDEST: Remarkably similar to SETSRC * SETDEST LDX #5 :LOOP LDA INST,X STA DINST,X DEX BPL :LOOP RTS * * SETQ: Places argument into the queue * SETQ LDX #5 :LOOP LDA INST,X JSR ENQ BCS :RTS DEX BPL :LOOP :RTS RTS * * SRC2ARG: Reverse of SETSRC * SRC2ARG LDX #5 :LOOP LDA SINST,X STA INST,X DEX BPL :LOOP RTS * * DEST2ARG: Remarkably similar to SRC2ARG * DEST2ARG LDX #5 :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 #5 :LOOP JSR DEQ BCS :RTS STA INST,X DEX BPL :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 BEQ :INST ;Just skip it :NEWX LDA SXINST 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 :INST LDA SXHI 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 BEQ :DINST ;Just skip it :NEWX LDA DXINST STA LASTXI JSR CODEOUT LDA DXLO STA LASTXLO JSR CODEOUT LDA DXHI STA LASTXHI LDA DXINST JSR IS2BYTE BEQ :DINST LDA DXHI 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