******************************** * Start special compiler words 2 ******************************** * * Word "if" - Conditional execution (compiler subroutine) * WORD11 ASC 'if ' DW IF IF BRK ; Special executable compiler subroutine LDA #$20 ; JSR IF JSR OUTBYTE LDA #IFSUB JSR OUTBYTE LDA #/IFSUB JSR OUTBYTE LDA #$D0 ; BNE (three bytes ahead to true (nonzero)) JSR OUTBYTE LDA #$03 JSR OUTBYTE LDA #$4C ; JMP (to false (zero)) JSR OUTBYTE LDY COUTPUT ; Push patch location LDX COUTPUT+1 JSR PUSHCOMP LDY #$01 ; Compiler state $0001 (wait for ELSE) LDX #$00 JSR PUSHCOMP LDA #$00 ; (JMP) $0000 JSR OUTBYTE JSR OUTBYTE RTS * IFSUB JSR POPDATA STX TEMP TYA ORA TEMP RTS * * Word "else" - False part of conditional (compiler subroutine) * WORD12 ASC 'else ' DW ELSE ELSE BRK ; Special executable compiler subroutine JSR POPCOMP CPY #$01 BEQ :OK LDA #$06 ; "ELSE without matching IF" JMP PRTERR :OK JSR POPCOMP ; Fetch the patch location for IF STY PNTR STX PNTR+1 LDA #$4C ; Compile JMP to where execution merges JSR OUTBYTE LDY COUTPUT ; Push patch location LDX COUTPUT+1 JSR PUSHCOMP LDY #$02 ; Compiler state $0002 (waiting for THEN) LDX #$00 JSR PUSHCOMP LDA #$00 ; (JMP) $0000 JSR OUTBYTE JSR OUTBYTE LDA COUTPUT ; Patch the JMP to false section for IF STA (PNTR) LDY #$01 LDA COUTPUT+1 STA (PNTR),Y RTS * * Word "then" - Resume execution after conditional * WORD13 ASC 'then ' DW THEN THEN BRK ; Special executable compiler subroutine JSR POPCOMP ; Should be in compiler state $0002 CPY #$02 BEQ :OK LDA #$07 JMP PRTERR :OK JSR POPCOMP STY PNTR STX PNTR+1 LDA COUTPUT STA (PNTR) LDA COUTPUT+1 LDY #$01 STA (PNTR),Y RTS * * Word "do" - Start of DO - LOOP/+LOOP * WORD14 ASC 'do ' DW DO DO BRK ; Special executable compiler subroutine LDA #$20 ; JSR DOSUB JSR OUTBYTE LDA #DOSUB JSR OUTBYTE LDA #/DOSUB JSR OUTBYTE LDY COUTPUT ; Push address to LOOP/+LOOP back to LDX COUTPUT+1 JSR PUSHCMP2 LDY #$03 ; Compiler state $0003 - waiting for LDX #$00 ; LEAVE, LOOP or +LOOP JMP PUSHCMP2 * DOSUB JSR POPDATA ; Get loop initial counter value JSR PUSHRETN ; Push it to return stack JSR POPDATA ; Get loop limit counter value JMP PUSHRETN ; Push it to return stack * * Subroutine PATCHLV used by LOOP/+LOOP to patch LEAVES * PATCHLV JSR POPCMP2 CPY #$04 ; Check for LEAVEs to be patched BNE :NOTLEAV JSR POPCMP2 ; There is a LEAVE to be patched STY PNTR STX PNTR+1 LDA COUTPUT CLC ADC #$08 STA (PNTR) LDA COUTPUT+1 ADC #$00 LDY #$01 STA (PNTR),Y BRA PATCHLV :NOTLEAV JMP PUSHCMP2 ; It's not a $0004 so push it back ; and exit * * Word "loop" - End of DO-LOOP * WORD15 ASC 'loop ' DW LOOP LOOP BRK ; Special executable compiler subroutine JSR PATCHLV ; Patch any LEAVEs that need to be done JSR POPCMP2 ; Should be in compiler state $0003 CPY #$03 BEQ :OK LDA #$0F ; "LOOP without DO" JMP PRTERR :OK LDA #$20 ; JSR LOOPSUB JSR OUTBYTE LDA #LOOPSUB JSR OUTBYTE LDA #/LOOPSUB JSR OUTBYTE LDA #$F0 ; BEQ three bytes ahead JSR OUTBYTE LDA #$03 JSR OUTBYTE LDA #$4C ; JMP (patch area) JSR OUTBYTE JSR POPCMP2 STX TEMP TYA JSR OUTBYTE LDA TEMP JMP OUTBYTE * LOOPSUB JSR POPRETN ; Pop loop counter limit value STY PNTR STX PNTR+1 JSR POPRETN ; Pop loop counter current value INY BNE :SKIPINC INX :SKIPINC CPY PNTR BNE :NOTFIN CPX PNTR+1 BNE :NOTFIN RTS :NOTFIN JSR PUSHRETN LDY PNTR LDX PNTR+1 JSR PUSHRETN LDA #$FF ; Make BNE true RTS * * Word "+loop" - End of DO-+LOOP * WORD16 ASC '+loop ' DW PLOOP PLOOP BRK ; Special executable compiler subroutine JSR PATCHLV ; Patch any LEAVEs that need to be done JSR POPCMP2 ; Should be in compiler state $0003 CPY #$03 BEQ :OK LDA #$0F ; "+LOOP without DO" JMP PRTERR :OK LDA #$20 ; JSR PLOOPSUB JSR OUTBYTE LDA #PLOOPSUB JSR OUTBYTE LDA #/PLOOPSUB JSR OUTBYTE LDA #$F0 ; BEQ three bytes ahead JSR OUTBYTE LDA #$03 JSR OUTBYTE LDA #$4C ; JMP (patch area) JSR OUTBYTE JSR POPCMP2 STX TEMP TYA JSR OUTBYTE LDA TEMP JMP OUTBYTE * PLOOPSUB JSR POPRETN ; Pop loop counter limit value STY PNTR STX PNTR+1 JSR POPRETN ; Pop loop counter current value STY PNTR2 STX PNTR2+1 JSR POPDATA ; Pop increment value TYA CLC ADC PNTR2 TAY TXA ADC PNTR2+1 TAX CPY PNTR BNE :NOTFIN CPX PNTR+1 BNE :NOTFIN RTS :NOTFIN JSR PUSHRETN LDY PNTR LDX PNTR+1 JSR PUSHRETN LDA #$FF ; Make BNE true RTS * * Word "leave" - Terminate DO - LOOP/+LOOP immediately * WORD17 ASC 'leave ' DW LEAVE LEAVE BRK ; Special executable compiler word JSR POPCMP2 ; Should be in compiler state $0003 CPY #$03 ; (waiting for a LOOP/+LOOP) BEQ :OK ; or in state $0004 CPY #$04 ; (other LEAVEs on stack) BEQ :OK LDA #$0F ; "LEAVE without DO" JMP PRTERR :OK JSR PUSHCMP2 ; Push compiler state $0003 back on stack LDA #$4C ; JMP absolute (to be patched) JSR OUTBYTE LDY COUTPUT ; Patch area LDX COUTPUT+1 JSR PUSHCMP2 LDY #$04 ; Set compiler state $0004 LDX #$00 JSR PUSHCMP2 LDA #$00 ; Finish off JMP JSR OUTBYTE JMP OUTBYTE * * Word "i" - get counter value of innermost loop * and leave it on the stack * WORD18 ASC 'i ' DW I I LDA RETITEMS BEQ :ERROR LDX RETSTACK LDA RETNAREA+3,X TAY LDA RETNAREA+4,X TAX JMP PUSHDATA :ERROR LDA #06 ; "Return stack underflow" JMP PRTERR * * Word "j" - get counter value of next innermost loop * and leave it on the stack * WORD19 ASC 'j ' DW J J LDA RETITEMS BEQ :ERROR LDX RETSTACK LDA RETNAREA+7,X TAY LDA RETNAREA+8,X TAX JMP PUSHDATA :ERROR LDA #06 ; "Return stack underflow" JMP PRTERR * * Word "begin" - part of BEGIN - UNTIL/WHILE-REPEAT * WORD20 ASC 'begin ' DW BEGIN BEGIN BRK ; Special executable compiler code LDY COUTPUT ; Save marker location LDX COUTPUT+1 JSR PUSHCOMP LDY #$04 ; Set compiler state $0004 LDX #$00 JMP PUSHCOMP * * Word "until" - part of BEGIN-UNTIL * WORD21 ASC 'until ' DW UNTIL UNTIL BRK ; Special executable compiler code JSR POPCOMP ; Make sure we're in compiler state $0004 CPY #$04 BEQ :OK LDA #$10 ; "UNTIL without BEGIN" JMP PRTERR :OK LDA #$20 ; JSR IFSUB (borrow it since it's same) JSR OUTBYTE LDA #IFSUB JSR OUTBYTE LDA #/IFSUB JSR OUTBYTE LDA #$D0 ; BNE (three bytes ahead) JSR OUTBYTE LDA #$03 JSR OUTBYTE LDA #$4C ; JMP (marker location) JSR OUTBYTE JSR POPCOMP STX TEMP TYA JSR OUTBYTE LDA TEMP JMP OUTBYTE * * Word "while" - part of BEGIN-WHILE-REPEAT * WORD22 ASC 'while ' DW WHILE WHILE BRK ; Special executable compiler code JSR POPCOMP ; Make sure we're in compiler state $0004 CPY #$04 BEQ :OK LDA #$10 ; "while without begin" JMP PRTERR :OK LDA #$20 ; JSR IFSUB JSR OUTBYTE LDA #IFSUB JSR OUTBYTE LDA #/IFSUB JSR OUTBYTE LDA #$D0 ; BNE (three bytes ahead) JSR OUTBYTE LDA #$03 JSR OUTBYTE LDA #$4C ; JMP (out of loop - patch area) JSR OUTBYTE LDY COUTPUT ; Push patch area onto compiler stack LDX COUTPUT+1 JSR PUSHCOMP LDA #$00 ; Finish off JMP instruction JSR OUTBYTE JSR OUTBYTE LDY #$05 ; Set compiler mode $0005 LDX #$00 JMP PUSHCOMP * * Word "repeat" - part of BEGIN-WHILE-REPEAT * WORD23 ASC 'repeat ' DW REPEAT REPEAT BRK ; Special executable compiler word JSR POPCOMP ; Make sure we're in compiler state $0005 CPY #$05 BEQ :OK LDA #$11 ; "repeat without begin-while" JMP PRTERR :OK LDA #$4C ; JMP (back to beginning) JSR OUTBYTE JSR POPCOMP ; Pop patch area out of loop STY PNTR2 STX PNTR2+1 JSR POPCOMP ; Pop marked area for beginning STX TEMP ; and finish off JMP TYA JSR OUTBYTE LDA TEMP JSR OUTBYTE LDA COUTPUT ; Patch area for out of loop STA (PNTR2) LDA COUTPUT+1 LDY #$01 STA (PNTR2),Y RTS * * Subroutine used by ." and lit" * STROUT STA TEMP2 STX TEMP3 JSR SKIP2SPC ; Skip to string LDA (WORDPNTR) CMP #$0D BEQ :ERROR INC WORDPNTR BNE :SKIPINC INC WORDPNTR+1 :SKIPINC LDA (WORDPNTR) CMP #$0D BEQ :ERROR LDY #$FF ; Look for ending quote :LOOP INY LDA (WORDPNTR),Y CMP #$0D BEQ :ERROR CMP TEMP3 ; Delimiter BNE :LOOP STY TEMP ; Save string length BIT TEMP2 BPL :NOCOUNT TYA JSR OUTBYTE :NOCOUNT TYA ; Output string TAX LDY #$00 :LOOP2 LDA (WORDPNTR),Y JSR OUTBYTE INY DEX BNE :LOOP2 BIT TEMP2 ; Null-terminate if necessary BMI :NONULL TXA JSR OUTBYTE :NONULL LDA TEMP ; Update WORDPNTR SEC ADC WORDPNTR STA WORDPNTR BCC :SKPINC2 INC WORDPNTR+1 :SKPINC2 RTS :ERROR LDA #$0C ; "No ending quote found for expression" JMP PRTERR * * Word /."/ - Print out a text string * WORD24 ASC '.' ASC '"' ASC ' ' DW PRDQUOTE PRDQUOTE BRK ; Special executable compiler word LDA #$20 ; JSR MSGOUT JSR OUTBYTE LDA #MSGOUT JSR OUTBYTE LDA #/MSGOUT JSR OUTBYTE LDA #$00 LDX #$22 JMP STROUT :ERROR LDA #$0C ; "No ending quote found for ."" JMP PRTERR * * Word /"/ - End of print string * WORD25 ASC '" ' DW QUOTE QUOTE BRK ; Special executable compiler word LDA #$19 ; /End quote without ."/ JMP PRTERR * * Word "string" - compiles counted string literal * into dictionary * WORD26 ASC 'string ' DW STRING STRING BRK ; Special executable compiler word LDA #$20 ; JSR STRSUB JSR OUTBYTE LDA #STRSUB JSR OUTBYTE LDA #/STRSUB JSR OUTBYTE LDA #$00 LDX #$7E ; Tilde JMP STROUT * STRSUB PLA STA WORDPNTR PLA STA WORDPNTR+1 LDY #$01 ; Output variable's name :LOOP LDA (WORDPNTR),Y BEQ :EOL JSR OUTBYTE INY BRA :LOOP :EOL TYA CLC ADC WORDPNTR TAX LDA WORDPNTR+1 ADC #$00 PHA PHX RTS * * Word /lit"/ - compiles counted string, returns address * WORD27 ASC 'lit' HEX 22 ASC ' ' DW LITQUOTE LITQUOTE BRK ; Special executable compiler word LDA COUTPUT CLC ADC #$09 STA PNTR LDA COUTPUT+1 ADC #$00 STA PNTR+1 LDA #$A0 ; LDY #string JSR OUTBYTE LDA COUTPUT LDA PNTR JSR OUTBYTE LDA #$A2 ; LDX #/string JSR OUTBYTE LDA PNTR+1 JSR OUTBYTE LDA #$20 ; JSR PUSHDATA JSR OUTBYTE LDA #PUSHDATA JSR OUTBYTE LDA #/PUSHDATA JSR OUTBYTE LDA #$80 ; BRA opcode JSR OUTBYTE LDA COUTPUT STA PNTR2 LDA COUTPUT+1 STA PNTR2+1 LDA #$00 JSR OUTBYTE LDA #$80 ; Output string LDX #$22 ; Double quote JSR STROUT LDA TEMP INC STA (PNTR2) RTS * * Word "(" - Start of comment * WORD28 ASC '( ' DW LEFTPAR LEFTPAR BRK ; Special executable compiler word LDY #$FF ; Find right parentheses :LOOP INY LDA (WORDPNTR),Y CMP #$0D BEQ :ERROR CMP #')' BNE :LOOP INY ; Move word text pointer past TYA ; right parentheses CLC ADC WORDPNTR STA WORDPNTR BNE :SKIPINC INC WORDPNTR+1 :SKIPINC RTS :ERROR JMP PRTERR ; "No matching right parentheses ; for comment" ; (Accumulator is already $0D) * * Word ")" - End of comment * WORD29 ASC ') ' DW RIGHTPAR RIGHTPAR LDA #$1A ; "Right parentheses without matching JMP PRTERR ; left parentheses" * * Word "'" - Throw address of next word on stack * WORD30 HEX 27 ASC ' ' DW TICK TICK BRK ; Special executable compiler word JSR SKIP2SPC ; Move pointer to next word JSR SKIPSPCS LDA #$20 ; JSR TICKSUB JSR OUTBYTE LDA #TICKSUB JSR OUTBYTE LDA #/TICKSUB JSR OUTBYTE JSR TEXTOUT ; Output word text LDA #' ' ; Space-terminate text JSR OUTBYTE JMP SKIP2SPC ; Move pointer past word * TICKSUB PLA ; Fetch text address STA WORDPNTR PLA STA WORDPNTR+1 INC WORDPNTR BNE :SKIPINC INC WORDPNTR+1 :SKIPINC JSR CALCHASH ; Calculate hash of text JSR CHKWORD ; Look it up BCC :ERROR LDY PNTR ; Throw address of word on stack LDX PNTR+1 JSR PUSHDATA JMP RESUME ; Resume execution after text :ERROR LDA #07 ; "Word not found" JMP PRTERR ******************************** * End special compiler words 2 ********************************