NEW AUTO 3,1 *-------------------------------------- KW.Lookup >LDYA L.KEYWORDS >STYA ZPPtr1 >LDYA ZPCLBufPtr >STYA ZPPtr2 ldx #0 .1 ldy #$ff .2 jsr .7 get next valid char in src text bcs .3 .20 jsr ToUpperCase eor (ZPPtr1),y match table char ? asl compare only 7 bits bne .4 no match...get next table keyword bcc .2 not last char in this keyword jsr .7 next char in text... bcc .4 valid....failed .8 tya Keyword Len clc rts .3 dey lda (ZPPtr1),y was last char in this keyword ? bmi .8 iny .41 jsr IncPtr1 skip chars to next keyword .4 lda (ZPPtr1) bpl .41 jsr IncPtr1 .6 inx lda (ZPPtr1) Array Ending 0, lookup failed bne .1 .9 sec rts .7 iny lda (ZPPtr2),y Get Src text char... beq .9 end of text jsr IsSpaceOrCR bcc .9 end of valid chars clc rts *-------------------------------------- KW.DUP lda pStack beq .9 cmp #$FF beq .9 cmp #1 bcc .99 lda (pStack) tax ldy #1 lda (pStack),y >PUSHA txa >PUSHA clc rts .9 lda #E.STACKERROR sec rts .99 lda #E.STKOVERFLOW sec rts *-------------------------------------- KW.DROP lda pStack beq .9 inc pStack beq .9 inc pStack clc rts .9 lda #E.STACKERROR sec rts *-------------------------------------- KW.SWAP ldy #3 lda (pStack),y pha dey #2 lda (pStack),y pha lda (pStack) tax pla sta (pStack) txa sta (pStack),y #2 dey #1 lda (pStack),y tax pla sta (pStack),y iny iny #3 txa sta (pStack),y clc rts *-------------------------------------- KW.OVER lda pStack sec sbc #2 bcc .9 ldy #3 lda (pStack),y >PUSHA lda (pStack),y >PUSHA clc rts .9 lda #E.STKOVERFLOW sec rts *-------------------------------------- KW.ROT *-------------------------------------- KW.mDUP *-------------------------------------- KW.gR *-------------------------------------- KW.Rg *-------------------------------------- KW.R clc rts *-------------------------------------- KW.Add jsr CheckStackPop4 bcs .9 clc ldy #2 lda (pStack),y adc (pStack) sta (pStack),y inc pStack lda (pStack),y adc (pStack) sta (pStack),y inc pStack clc .9 rts *-------------------------------------- KW.DAdd >FPU ADD32 clc rts *-------------------------------------- KW.Sub jsr CheckStackPop4 bcs .9 sec ldy #2 lda (pStack),y sbc (pStack) sta (pStack),y inc pStack lda (pStack),y sbc (pStack) sta (pStack),y inc pStack clc .9 rts *-------------------------------------- KW.Mul jsr CheckStackPop4 bcs .9 >PULLW ZPPtr1 >PULLW ZPPtr2 stz ZPPtr3 stz ZPPtr3+1 ldx #16 .1 lsr ZPPtr2+1 ror ZPPtr2 bcc .2 clc lda ZPPtr1 adc ZPPtr3 sta ZPPtr3 lda ZPPtr1+1 adc ZPPtr3+1 sta ZPPtr3+1 .2 asl ZPPtr1 rol ZPPtr1+1 dex bne .1 >PUSHW ZPPtr3 clc .9 rts *-------------------------------------- KW.Div *-------------------------------------- KW.Mod *-------------------------------------- KW.DivMod *-------------------------------------- KW.MulDivMod *-------------------------------------- KW.MulDiv clc rts *-------------------------------------- KW.MAX jsr CheckStackPop4 bcs .9 lda (pStack) LO ldy #2 cmp (pStack),y dey #1 lda (pStack),y HI iny iny #3 sbc (pStack),y bcc .1 jsr KW.SWAP .1 jmp KW.DROP .9 rts *-------------------------------------- KW.MIN jsr CheckStackPop4 bcs .9 lda (pStack) LO ldy #2 cmp (pStack),y dey #1 lda (pStack),y HI iny iny #3 sbc (pStack),y bcs .1 jsr KW.SWAP .1 jmp KW.DROP .9 rts *-------------------------------------- KW.ABS *-------------------------------------- KW.DABS clc rts *-------------------------------------- KW.MINUS lda (pStack) LO eor #$ff sec adc #0 sta (pStack) ldy #1 lda (pStack),y HI eor #$ff adc #0 sta (pStack),y clc rts *-------------------------------------- KW.DMINUS lda (pStack) LO eor #$ff sec adc #0 sta (pStack) ldy #1 lda (pStack),y HI eor #$ff adc #0 sta (pStack),y iny lda (pStack),y eor #$ff adc #0 sta (pStack),y iny lda (pStack),y eor #$ff adc #0 sta (pStack),y clc rts *-------------------------------------- KW.AND jsr CheckStackPop4 bcs .9 ldy #2 lda (pStack),y and (pStack) sta (pStack),y inc pStack lda (pStack),y and (pStack) sta (pStack),y inc pStack clc .9 rts *-------------------------------------- KW.OR jsr CheckStackPop4 bcs .9 ldy #2 lda (pStack),y ora (pStack) sta (pStack),y inc pStack lda (pStack),y ora (pStack) sta (pStack),y inc pStack clc .9 rts *-------------------------------------- KW.XOR jsr CheckStackPop4 bcs .9 ldy #2 lda (pStack),y eor (pStack) sta (pStack),y inc pStack lda (pStack),y eor (pStack) sta (pStack),y inc pStack clc .9 rts *-------------------------------------- KW.LWR jsr CheckStackPop4 bcs .9 ldy #2 lda (pStack),y cmp (pStack) inc pStack lda (pStack),y sbc (pStack),y inc pStack ror lda #0 sta (pStack) ldy #1 sta (pStack),y clc .9 rts *-------------------------------------- KW.GTR jsr CheckStackPop4 bcs .9 ldy #2 lda (pStack),y cmp (pStack) inc pStack lda (pStack),y sbc (pStack),y inc pStack lda #0 ror eor #$80 sta (pStack) ldy #1 sta (pStack),y clc .9 rts *-------------------------------------- KW.EQ jsr CheckStackPop4 bcs .9 ldy #2 lda (pStack),y sec sbc (pStack) tax inc pStack lda (pStack),y sbc (pStack),y inc pStack bcc .1 txa bne .1 sec .HS 90 BCC .1 clc lda #0 ror sta (pStack) ldy #1 sta (pStack),y clc .9 rts *-------------------------------------- KW.NEGATIVE ldy #1 lda (pStack),y asl lda #0 ror sta (pStack) sta (pStack),y clc rts *-------------------------------------- KW.ZERO clc ldy #1 lda (pStack),y ora (pStack) bne .9 sec .9 lda #0 ror sta (pStack) sta (pStack),y clc rts *-------------------------------------- KW.. jsr KW.DUP bcs .9 ldy #2 lda L.FMT.int16 sta (pStack),y iny lda L.FMT.int16+1 sta (pStack),y >PUSHBI 2 >SYSCALL PrintF * clc .9 rts *-------------------------------------- KW..R *-------------------------------------- KW.D. *-------------------------------------- KW.D.R clc rts *-------------------------------------- KW.CR >PUSHW L.MSG.ECHOCRLF >PUSHBI 0 >SYSCALL PrintF rts *-------------------------------------- KW.SPACE lda #C.SPACE >SYSCALL PutChar rts *-------------------------------------- KW.SPACES >PULLA beq .8 .1 dec pha lda #C.SPACE >SYSCALL PutChar pla bne .1 .8 clc rts *-------------------------------------- KW.PRINT >LDYAI 256 >SYSCALL GetMem bcs .9 >STYA ZPPtr1 phx ldy #$ff clc .1 iny lda (ZPCLBufPtr),y beq .2 sta (ZPPtr1),y eor #'" bne .1 sec .2 sta (ZPPtr1),y tya adc ZPCLBufPtr sta ZPCLBufPtr bcc .3 inc ZPCLBufPtr+1 .3 >LDYA ZPPtr1 >SYSCALL PutS pla >SYSCALL freemem jmp NextChar .9 rts *-------------------------------------- KW.DUMP *-------------------------------------- KW.TYPE *-------------------------------------- KW.COUNT *-------------------------------------- KW.TERMINAL clc rts *-------------------------------------- KW.KEY >SYSCALL GetChar bcs .9 >PUSHA .9 rts *-------------------------------------- KW.EMIT >PULLA >SYSCALL PutChar rts *-------------------------------------- KW.EXPECT *-------------------------------------- KW.WORD *-------------------------------------- KW.NUMBER *-------------------------------------- KW.STARTSTR *-------------------------------------- KW.STRADD *-------------------------------------- KW.STRDBL *-------------------------------------- KW.SIGN *-------------------------------------- KW.ENDSTR *-------------------------------------- KW.HOLD *-------------------------------------- KW.DECIMAL *-------------------------------------- KW.HEX *-------------------------------------- KW.OCTAL clc rts *-------------------------------------- KW.FETCHW lda (pStack) sta ZPAddrPtr ldy #1 lda (pStack),y sta ZPAddrPtr+1 lda (ZPAddrPtr) sta (pStack) lda (ZPAddrPtr),y sta (pStack),y clc rts *-------------------------------------- KW.STOREW jsr CheckStackPop4 bcs .9 >PULLW ZPAddrPtr >PULLA sta (ZPAddrPtr) >PULLA ldy #1 sta (ZPAddrPtr),y * clc .9 rts *-------------------------------------- KW.FETCHB >PULLW ZPAddrPtr lda (ZPAddrPtr) >PUSHA clc rts *-------------------------------------- KW.STOREB >PULLW ZPAddrPtr >PULLA sta (ZPAddrPtr) clc KW.STOREB.RTS rts *-------------------------------------- KW.FETCHPRINTW jsr KW.FETCHW bcs KW.STOREB.RTS jmp KW.. *-------------------------------------- KW.ADDTOW jsr KW.FETCHW bcs KW.STOREB.RTS jsr KW.Add bcs KW.STOREB.RTS jmp KW.STOREW *-------------------------------------- KW.CMOVE clc rts *-------------------------------------- KW.FILL >PULLA bra KW.FILL2 KW.ERASE lda #0 bra KW.FILL2 KW.BLANKS lda #C.SPACE KW.FILL2 tax >PULLA tay >PULLW ZPAddrPtr txa .1 dey sta (ZPAddrPtr),y cpy #0 bne .1 clc rts *-------------------------------------- KW.HERE >PUSHW ZPDataPtr clc rts *-------------------------------------- KW.PAD >PUSHW ZPOutputPtr clc rts *-------------------------------------- KW.ALLOT KW.nCOMPILE KW.QUOTE KW.FORGET KW.DEFINITIONS KW.VOCABULARY KW.FORTH KW.EDITOR KW.ASSEMBLER KW.VLIST clc rts *-------------------------------------- KW.BCOLON bit bCompile bmi KW.COLON.SYN >PUSHB.G hSList >PUSHW ZPCLBufPtr >SYSCALL SListNewKey bcs .9 >STYA ZPKeyID txa jsr NextKW lda #SYM.T.CODE sta ZPType >LDYA ZPCodePtr >STYA ZPAddrPtr >PUSHB.G hSList >PUSHW ZPKeyID >PUSHWI ZPType >PUSHWI 4 >SYSCALL SListAddData bcs .9 sec ror bCompile clc .9 rts KW.COLON.SYN lda #E.SYN sec rts *-------------------------------------- KW.ECOLON bit bCompile bpl KW.COLON.SYN lda #$60 jsr EmitByte stz bCompile clc rts *-------------------------------------- KW.VARIABLE lda pStack cmp #$FE bcc .99 >PUSHB.G hSList >PUSHW ZPCLBufPtr >SYSCALL SListNewKey bcs .9 >STYA ZPKeyID txa jsr NextKW lda #SYM.T.VAR sta ZPType >LDYA ZPDataPtr >STYA ZPAddrPtr >PUSHB.G hSList >PUSHW ZPKeyID >PUSHWI ZPType >PUSHWI 4 >SYSCALL SListAddData bcs .9 >PULLA sta (ZPDataPtr) >PULLA ldy #1 sta (ZPDataPtr),y lda ZPDataPtr clc adc #2 sta ZPDataPtr bcc .9 inc ZPDataPtr+1 clc .9 rts .99 lda #E.STACKERROR sec rts *-------------------------------------- KW.CONSTANT *-------------------------------------- KW.ACODE *-------------------------------------- KW.FCODE clc rts *-------------------------------------- KW.DO tsx lda $101,x clc adc #0 pha lda $102,x adc #0 ldy RP sta (pData),y dey pla sta (pData),y dey >PULLA start tax >PULLA sta (pData),y dey txa sta (pData),y dey >PULLA end+1 tax >PULLA sta (pData),y dey txa sta (pData),y dey sty RP clc rts *-------------------------------------- KW.LOOP lda #1 ldx #0 KW.LOOPax ldy RP iny end+1 iny iny start clc adc (pData),y sta (pData),y pha iny txa adc (pData),y sta (pData),y tax pla ldy RP iny end+1 cmp (pData),y txa iny sbc (pData),y bcs .8 lda RP clc adc #5 tay lda (pData),y sta ZPPtr1 iny lda (pData),y sta ZPPtr1+1 pla pla jmp (ZPPtr1) .8 lda RP clc adc #6 sta RP * clc rts *-------------------------------------- PW.pLOOP >PULLA tax >PULLA bra KW.LOOPax *-------------------------------------- KW.I ldy RP iny end+1 iny iny start lda (pData),y tax iny lda (pData),y >PUSHA txa >PUSHA clc rts *-------------------------------------- KW.LEAVE clc rts *-------------------------------------- KW.IF clc rts *-------------------------------------- KW.ELSE clc rts *-------------------------------------- KW.ENDIF clc rts *-------------------------------------- KW.BEGIN *-------------------------------------- KW.UNTIL *-------------------------------------- KW.REPEAT *-------------------------------------- KW.WHILE clc rts *-------------------------------------- KW.COMMENT clc rts *-------------------------------------- MAN SAVE usr/src/bin/forth.s.kw LOAD usr/src/bin/forth.s ASM