P*------------------------------- * * compiler.s * * This program is the macro compiler. It just * goes through the code, compiling as it goes! * * SLJ begun: 11/17/96 * finished: * * ORG $8000 REL DSK 'compiler' PUT "playvars.i.s" ;Player variables ;(global/local variables, etc.) POINT EQU $61 ;Pointer into the code text CODEP EQU $63 ;Pointer to code location TEMP EQU $65 ;Temporary location/pointer *ERROR EQU $FB STACK EQU $CE00 ;My stack... QUEUE EQU $CF00 ;...and my queueueu LOOPFLAG EQU 01 ;Is this a loop address? WHENFLAG EQU 2 ELSEFLAG EQU 3 LONGFLAG EQU 4 * KERNAL CHROUT EQU $FFD2 HELLO TXT 'compiling...' DFB 13,13,00 COMPILER ENT ;Entry point INIT LDY #00 :L1 LDA HELLO,Y BEQ :DONE JSR CHROUT INY BNE :L1 :DONE * LDA #$00 * STA POINT * STA CODEP STA CURLINE STA STACKP STA QFRONT STA QBACK STA SSIZE STA QSIZE STA LASTXI ;Last LDX instruction. STA LASTXLO STA LASTXHI STA TESTFLAG ;Flag for TEST command JSR ENTRY * LDA #$20 ;Source at $2000 * STA POINT+1 * LDA #$C2 ;Code at $C200 * STA CODEP+1 * * Main program loop * MAIN LDY #00 STY ERROR :RDCHAR JSR NEXTCHAR ;Find next relevant char BEQ :ATEOF ;Z set means end of file BCC :SKIP ;Blank line, spare chars, etc. JSR PARSE ;Parse the next command LDX ERROR BNE :ERR ;ERROR=0 means all is fine :SKIP TYA ;Move pointer forwards CLC ADC POINT STA POINT BCC :CONT INC POINT+1 :CONT JMP MAIN :ATEOF LDA SSIZE ;Anything still on the stack? BEQ :DONE LDX #30 BNE :PRERR ;Oops, print error. :DONE LDY #00 :LOOP9 LDA :TEXT,Y BEQ :RTS JSR CHROUT INY BNE :LOOP9 :RTS RTS :ERR STY TEMP ;Print out the line where the LDY #00 ;error occured :L10 CPY TEMP BEQ :LOUT LDA (POINT),Y JSR CHROUT CMP #13 ;It is possible to move through BEQ :PRERR ;the entire line. INY BNE :L10 :LOUT LDA #18 ;Reverse on JSR CHROUT LDA (POINT),Y ;The exact spot of the error :L11 JSR CHROUT INY LDA (POINT),Y BEQ :C2 ;Can be at EOF CMP #13 BNE :L11 LDA #32 :L12 JSR CHROUT INY CPY #40 BCC :L12 :C2 LDA #13 JSR CHROUT LDA #146 ;RvsOff JSR CHROUT :PRERR LDA ERRLIST,X ;Find the address of the error STA TEMP ;text. INX LDA ERRLIST,X STA TEMP+1 LDY #00 :LOOP LDA (TEMP),Y BEQ :CR JSR CHROUT INY BNE :LOOP :CR LDA #32 :C1 JSR CHROUT ;Clear to end of line INY CPY #40 BCC :C1 LDA #13 JMP CHROUT ;And exit :TEXT TXT 'compilation successful! ' DFB 13,13,00 ERROR ENT ;Enrty point DFB 00 ;This will contain error number CURLINE ENT DFB 00 ;This is the current line compiler ;is processing. PUT "computil.h.s" ;Compiler utilities -- ;parser routines, stack/queue, ;readarg, etc. PUT "operators.c.s" ;Operator commands ;ADD MOV AND etc. * * 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 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 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 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 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 (POINT),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 (POINT),Y CMP #'p' BNE :NEG INY LDA (POINT),Y CMP #'o' BNE :ERR INY LDA (POINT),Y CMP #'s' BNE :ERR JSR NEXTSPC LDA #$B0 ;BCS RTS :NEG CMP #'n' BNE :EQU INY LDA (POINT),Y CMP #'e' BNE :ERR INY LDA (POINT),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 (POINT),Y CMP #'q' BNE :ERR INY LDA (POINT),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 JMP CODEOUT :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 RTS :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 JMP SHORTFIX ;Fix it up! :CONT CMP #LOOPFLAG BEQ :TANGLE CMP #ELSEFLAG BNE :CONT2 :LONG JMP LONGFIX :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 JMP CODEOUT ;...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 CODEP STA DATALO LDA CODEP+1 STA DATAHI RTS * * WAIT * Returns control back to the player routine. * Execution will resume at the instruction following * the WAIT command. * WAIT LDA #00 STA LASTXI LDA #$20 ;JSR JSR CODEOUT LDA #RETURN JMP CODEOUT ;and exit * * DONE * Basically creates an infinite loop. * Should be used at the end of programs, to end them! * DONE LDA CODEP STA SLO LDA CODEP+1 STA SHI JSR WAIT LDA #$68 ;PLA -- PHA is done before JSR CODEOUT ;each macro call LDA #$60 ;RTS JMP CODEOUT * * ENTRY * Sets the current location as the new entry point * for the macro. * ENTRYP ENT ENTLO DS 1 ENTHI DS 1 ENTRY LDA #00 STA LASTXI LDA CODEP STA ENTLO LDA CODEP+1 STA ENTHI RTS * * Kernal routines. * * * ILOAD * Load instrument specified in ARG * ILOAD JSR READARG JSR SETSRC JSR GENSRC LDA #$AA ;TAX JSR CODEOUT LDA #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 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 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 JSR GENSUB JMP SETPOINT * * SETP * Set pointer current voice to ARG, ARG+1 * SET JSR GETPOINT ;Get the pointer from ARG LDA #SETP JMP GENSUB * * V1GETP, V2GETP, V3GETP * Like GETP, but specifically for voice 1 * V1GET LDA #V1GETP JSR GENSUB JMP SETPOINT ;Copy A,X -> ARG, ARG+1 V2GET LDA #V2GETP JSR GENSUB JMP SETPOINT V3GET LDA #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 JMP GENSUB V2SET JSR GETPOINT ;ARG,ARG+1 -> A,X LDA #V2SETP JMP GENSUB V3SET JSR GETPOINT ;ARG,ARG+1 -> A,X LDA #V3SETP JMP GENSUB PUT "keywords.i.s"