A2osX/BIN/FORTH.S.KW.txt

1166 lines
17 KiB
Plaintext
Raw Normal View History

2020-11-19 15:34:02 +00:00
NEW
AUTO 3,1
*--------------------------------------
KW.Lookup >LDYA L.KEYWORDS
>STYA ZPPtr1
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
ldx #0
.1 ldy #$ff
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
.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
2020-11-29 13:16:39 +00:00
jsr NextKW
2021-05-04 17:31:21 +00:00
clc
2020-11-19 15:34:02 +00:00
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
2020-12-02 15:22:57 +00:00
inx
2020-11-19 15:34:02 +00:00
lda (ZPPtr1) Array Ending 0, lookup failed
bne .1
.9 sec
rts
.7 iny
2020-12-15 13:23:22 +00:00
lda (ZPCLBufPtr),y Get Src text char...
2020-11-19 15:34:02 +00:00
beq .9 end of text
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
jmp IsSpaceOrCR CS=end of valid chars
2020-11-19 15:34:02 +00:00
*--------------------------------------
2021-04-30 15:25:19 +00:00
KW.INVALID lda #E.CSYN
sec
rts
*--------------------------------------
2021-04-29 11:56:34 +00:00
KW.qDUP lda (pStack)
2020-12-02 15:22:57 +00:00
ldy #1
ora (pStack),y
bne KW.DUP
2021-05-04 17:31:21 +00:00
2020-12-02 15:22:57 +00:00
clc
rts
*--------------------------------------
2020-11-19 15:34:02 +00:00
KW.DUP lda pStack
2020-11-23 22:05:27 +00:00
beq .9
cmp #$FF
2020-12-02 15:22:57 +00:00
bcs .9
2021-05-04 17:31:21 +00:00
2020-12-02 15:22:57 +00:00
cmp #2
2020-11-23 22:05:27 +00:00
bcc .99
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
ldy #1
lda (pStack),y
>PUSHA
2020-12-02 15:22:57 +00:00
lda (pStack),y
2020-11-19 15:34:02 +00:00
>PUSHA
clc
rts
2021-05-04 17:31:21 +00:00
2020-11-23 22:05:27 +00:00
.9 lda #E.STACKERROR
2020-11-19 15:34:02 +00:00
sec
rts
2021-05-04 17:31:21 +00:00
2020-11-23 22:05:27 +00:00
.99 lda #E.STKOVERFLOW
sec
2021-05-04 17:31:21 +00:00
rts
2020-11-19 15:34:02 +00:00
*--------------------------------------
KW.DROP lda pStack
beq .9
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
inc pStack
beq .9
inc pStack
2020-12-02 15:22:57 +00:00
2020-11-19 15:34:02 +00:00
clc
rts
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
.9 lda #E.STACKERROR
sec
rts
*--------------------------------------
KW.SWAP ldy #3
lda (pStack),y
pha
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
dey #2
lda (pStack),y
pha
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
lda (pStack)
tax
pla
sta (pStack)
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
txa
sta (pStack),y #2
dey #1
lda (pStack),y
tax
pla
sta (pStack),y
iny
iny #3
txa
sta (pStack),y
2020-12-02 15:22:57 +00:00
2020-11-19 15:34:02 +00:00
clc
rts
*--------------------------------------
2020-12-02 15:22:57 +00:00
KW.OVER jsr CheckStackPop4
bcs .9
2021-05-04 17:31:21 +00:00
2020-12-02 15:22:57 +00:00
cmp #2
bcc .99
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
ldy #3
lda (pStack),y
>PUSHA
lda (pStack),y
>PUSHA
2020-12-02 15:22:57 +00:00
2020-11-19 15:34:02 +00:00
clc
rts
2020-12-02 15:22:57 +00:00
.99 lda #E.STKOVERFLOW
2020-11-19 15:34:02 +00:00
sec
2020-12-02 15:22:57 +00:00
.9 rts
2020-11-19 15:34:02 +00:00
*--------------------------------------
2020-12-02 15:22:57 +00:00
KW.ROT lda pStack
beq .9
2021-05-04 17:31:21 +00:00
2020-12-02 15:22:57 +00:00
cmp #$FB
bcs .9
2021-05-04 17:31:21 +00:00
2020-12-02 15:22:57 +00:00
ldy #5
lda (pStack),y n1 HI
pha
dey
lda (pStack),y n1 LO
pha
2021-05-04 17:31:21 +00:00
2020-12-02 15:22:57 +00:00
.1 dey
2021-05-04 17:31:21 +00:00
2020-12-02 15:22:57 +00:00
lda (pStack),y
iny
iny
sta (pStack),y
dey
dey
bne .1
iny
2021-05-04 17:31:21 +00:00
2020-12-02 15:22:57 +00:00
pla
sta (pStack)
pla
sta (pStack),y
2021-05-04 17:31:21 +00:00
2020-12-02 15:22:57 +00:00
clc
rts
2021-05-04 17:31:21 +00:00
2020-12-02 15:22:57 +00:00
.9 lda #E.STACKERROR
sec
2021-05-04 17:31:21 +00:00
rts
2020-11-19 15:34:02 +00:00
*--------------------------------------
KW.Add jsr CheckStackPop4
bcs .9
2021-05-04 17:31:21 +00:00
>FPU iADD
2020-11-19 15:34:02 +00:00
clc
.9 rts
*--------------------------------------
2021-05-04 17:31:21 +00:00
KW.DAdd >FPU lADD
2020-11-19 15:34:02 +00:00
clc
rts
*--------------------------------------
KW.Sub jsr CheckStackPop4
bcs .9
2021-05-04 17:31:21 +00:00
>FPU iSUB
2020-11-19 15:34:02 +00:00
clc
.9 rts
*--------------------------------------
2021-05-04 17:31:21 +00:00
KW.DSub >FPU lSUB
2021-04-29 11:56:34 +00:00
clc
rts
*--------------------------------------
2020-11-23 22:05:27 +00:00
KW.Mul jsr CheckStackPop4
bcs .9
2021-05-04 17:31:21 +00:00
>FPU iMUL
2020-11-23 22:05:27 +00:00
clc
.9 rts
2020-11-19 15:34:02 +00:00
*--------------------------------------
2020-11-29 13:16:39 +00:00
KW.Div jsr KW.DivMoD.1
bcs .9
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
>LDYA ZPPtr2
jsr KW.PushWSigned
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
clc
2021-05-04 17:31:21 +00:00
.9 rts
2020-11-19 15:34:02 +00:00
*--------------------------------------
2020-11-29 13:16:39 +00:00
KW.Mod jsr KW.DivMoD.1
bcs .9
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
>PUSHW ZPPtr3
2021-05-04 17:31:21 +00:00
.9 rts
2020-11-19 15:34:02 +00:00
*--------------------------------------
2020-11-29 13:16:39 +00:00
KW.DivMod jsr KW.DivMoD.1
bcs .9
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
>PUSHW ZPPtr3
>LDYA ZPPtr2
jsr KW.PushWSigned
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
clc
2021-05-04 17:31:21 +00:00
.9 rts
2020-11-19 15:34:02 +00:00
*--------------------------------------
KW.MulDivMod
*--------------------------------------
2021-05-04 17:31:21 +00:00
KW.MulDiv
2020-11-29 13:16:39 +00:00
lda #E.SYN
sec
rts
*--------------------------------------
KW.DivMoD.1 jsr CheckStackPop4
bcs .9
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
jsr KW.GetPtr1Ptr2Sign
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
stz ZPPtr3
stz ZPPtr3+1
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
ldx #16
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
.1 asl ZPPtr2
rol ZPPtr2+1
rol ZPPtr3
rol ZPPtr3+1
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
sec
lda ZPPtr3
sbc ZPPtr1
pha
lda ZPPtr3+1
sbc ZPPtr1+1
bcs .2
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
pla
dex
bne .1
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
bra .8
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
.2 sta ZPPtr3+1
pla
sta ZPPtr3
inc ZPPtr2
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
dex
bne .1
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
.8 clc
2021-05-04 17:31:21 +00:00
.9 rts
2020-11-29 13:16:39 +00:00
*--------------------------------------
KW.GetPtr1Ptr2Sign
>PULLW ZPPtr1
sta Sign
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
asl
bcc .1
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
lda ZPPtr1
clc
eor #$ff
adc #1
sta ZPPtr1
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
lda ZPPtr1+1
eor #$ff
adc #0
sta ZPPtr1+1
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
.1 >PULLW ZPPtr2
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
asl
bcc .8
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
lda ZPPtr2
clc
eor #$ff
adc #1
sta ZPPtr2
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
lda ZPPtr2+1
eor #$ff
adc #0
sta ZPPtr2+1
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
lda Sign
eor #$80
sta Sign
.8 rts
*--------------------------------------
KW.PushWSigned bit Sign
bpl .8
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
pha
tya
2021-05-04 17:31:21 +00:00
2020-11-23 22:05:27 +00:00
clc
2020-11-29 13:16:39 +00:00
eor #$ff
adc #1
tay
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
pla
eor #$ff
adc #0
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
.8 >PUSHYA
2020-11-23 22:05:27 +00:00
rts
2020-11-19 15:34:02 +00:00
*--------------------------------------
KW.MAX jsr CheckStackPop4
bcs .9
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
lda (pStack) LO
ldy #2
2021-05-04 17:31:21 +00:00
cmp (pStack),y
2020-11-19 15:34:02 +00:00
dey #1
lda (pStack),y HI
iny
iny #3
sbc (pStack),y
bcc .1
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
jsr KW.SWAP
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
.1 jmp KW.DROP
2021-05-04 17:31:21 +00:00
.9 rts
2020-11-19 15:34:02 +00:00
*--------------------------------------
KW.MIN jsr CheckStackPop4
bcs .9
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
lda (pStack) LO
ldy #2
2021-05-04 17:31:21 +00:00
cmp (pStack),y
2020-11-19 15:34:02 +00:00
dey #1
lda (pStack),y HI
iny
iny #3
sbc (pStack),y
bcs .1
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
jsr KW.SWAP
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
.1 jmp KW.DROP
2021-05-04 17:31:21 +00:00
.9 rts
2020-11-19 15:34:02 +00:00
*--------------------------------------
2020-11-29 13:16:39 +00:00
KW.ABS ldy #1
lda (pStack),y HI
2021-04-30 15:25:19 +00:00
bpl KW.NEGATE.8
2020-11-19 15:34:02 +00:00
*--------------------------------------
2021-04-29 11:56:34 +00:00
KW.NEGATE lda (pStack) LO
2020-11-19 15:34:02 +00:00
eor #$ff
sec
adc #0
sta (pStack)
ldy #1
lda (pStack),y HI
eor #$ff
adc #0
sta (pStack),y
2021-04-30 15:25:19 +00:00
KW.NEGATE.8 clc
2020-11-19 15:34:02 +00:00
rts
*--------------------------------------
2021-04-30 15:25:19 +00:00
KW.DABS ldy #3
lda (pStack),y HI
bpl KW.DNEGATE.8
*--------------------------------------
2021-04-29 11:56:34 +00:00
KW.DNEGATE lda (pStack) LO
2020-11-19 15:34:02 +00:00
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
2021-04-30 15:25:19 +00:00
KW.DNEGATE.8 clc
2020-11-19 15:34:02 +00:00
rts
*--------------------------------------
KW.AND jsr CheckStackPop4
bcs .9
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
ldy #2
lda (pStack),y
and (pStack)
sta (pStack),y
inc pStack
lda (pStack),y
and (pStack)
sta (pStack),y
inc pStack
2021-06-05 15:48:54 +00:00
* clc
2020-11-19 15:34:02 +00:00
.9 rts
*--------------------------------------
KW.OR jsr CheckStackPop4
bcs .9
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
ldy #2
lda (pStack),y
ora (pStack)
sta (pStack),y
inc pStack
lda (pStack),y
ora (pStack)
sta (pStack),y
inc pStack
2021-06-05 15:48:54 +00:00
* clc
2020-11-19 15:34:02 +00:00
.9 rts
*--------------------------------------
KW.XOR jsr CheckStackPop4
bcs .9
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
ldy #2
lda (pStack),y
eor (pStack)
sta (pStack),y
inc pStack
lda (pStack),y
eor (pStack)
sta (pStack),y
inc pStack
2021-06-05 15:48:54 +00:00
* clc
2020-11-19 15:34:02 +00:00
.9 rts
*--------------------------------------
KW.LWR jsr CheckStackPop4
bcs .9
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
ldy #2
lda (pStack),y
cmp (pStack)
inc pStack
lda (pStack),y
2020-12-02 15:22:57 +00:00
sbc (pStack)
2020-11-19 15:34:02 +00:00
inc pStack
2021-04-11 19:47:48 +00:00
inc pStack
2020-11-23 22:05:27 +00:00
lda #0
2021-04-11 19:47:48 +00:00
ror
2021-06-05 15:48:54 +00:00
eor #$80
2020-11-19 15:34:02 +00:00
sta (pStack)
2021-04-11 19:47:48 +00:00
2021-06-05 15:48:54 +00:00
* clc
2020-11-19 15:34:02 +00:00
.9 rts
*--------------------------------------
KW.GTR jsr CheckStackPop4
bcs .9
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
ldy #2
lda (pStack),y
cmp (pStack)
inc pStack
lda (pStack),y
2020-12-02 15:22:57 +00:00
sbc (pStack)
2020-11-19 15:34:02 +00:00
inc pStack
2021-04-11 19:47:48 +00:00
inc pStack
2020-11-23 22:05:27 +00:00
lda #0
ror
2021-06-05 15:48:54 +00:00
2020-11-19 15:34:02 +00:00
sta (pStack)
2021-06-05 15:48:54 +00:00
* clc
2020-11-19 15:34:02 +00:00
.9 rts
*--------------------------------------
2021-05-04 17:31:21 +00:00
* : TL BEGIN DUP . 1 - DUP 0 = UNTIL ;
2021-04-11 19:47:48 +00:00
*--------------------------------------
2020-11-19 15:34:02 +00:00
KW.EQ jsr CheckStackPop4
bcs .9
2021-04-11 19:47:48 +00:00
* clc
2020-11-19 15:34:02 +00:00
ldy #2
lda (pStack),y
2021-04-11 19:47:48 +00:00
eor (pStack)
2020-11-26 19:47:57 +00:00
2020-11-19 15:34:02 +00:00
inc pStack
2021-06-05 15:48:54 +00:00
tax
bne .1
2020-11-19 15:34:02 +00:00
lda (pStack),y
2021-04-11 19:47:48 +00:00
eor (pStack)
2020-11-26 19:47:57 +00:00
bne .1
2021-06-05 15:48:54 +00:00
2020-11-19 15:34:02 +00:00
sec
2021-05-04 17:31:21 +00:00
2021-06-05 15:48:54 +00:00
.1 lda #0
ror
inc pStack
inc pStack
2020-11-19 15:34:02 +00:00
sta (pStack)
2021-06-05 15:48:54 +00:00
* clc
2020-11-19 15:34:02 +00:00
.9 rts
*--------------------------------------
2021-04-11 19:47:48 +00:00
KW.NEGATIVE inc pStack
2020-11-19 15:34:02 +00:00
clc
rts
*--------------------------------------
2020-11-23 22:05:27 +00:00
KW.ZERO clc
2021-04-11 19:47:48 +00:00
2021-05-19 12:44:47 +00:00
>PULLA
2020-11-23 22:05:27 +00:00
ora (pStack)
2020-11-19 15:34:02 +00:00
bne .9
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
sec
2020-11-23 22:05:27 +00:00
.9 lda #0
2020-11-19 15:34:02 +00:00
ror
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
sta (pStack)
2021-05-04 17:31:21 +00:00
2021-04-11 19:47:48 +00:00
* clc
2020-11-19 15:34:02 +00:00
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
2021-04-15 14:03:04 +00:00
.9 rts
*--------------------------------------
KW.U. jsr KW.DUP
bcs .9
ldy #2
lda L.FMT.uint16
sta (pStack),y
iny
lda L.FMT.uint16+1
sta (pStack),y
>PUSHBI 2
>SYSCALL PrintF
* clc
2020-11-19 15:34:02 +00:00
.9 rts
*--------------------------------------
KW..R
2021-04-30 15:25:19 +00:00
lda #E.SYN
sec
rts
2020-11-19 15:34:02 +00:00
*--------------------------------------
2021-04-30 15:25:19 +00:00
KW.D. >PUSHW L.FMT.int32
ldy #5
ldx #4
.1 lda (pStack),y
>PUSHA
dex
bne .1
>PUSHBI 4
>SYSCALL PrintF
2021-05-04 17:31:21 +00:00
2021-04-30 15:25:19 +00:00
>RET 4
2020-11-19 15:34:02 +00:00
*--------------------------------------
KW.D.R
2020-11-29 13:16:39 +00:00
lda #E.SYN
sec
2020-11-19 15:34:02 +00:00
rts
*--------------------------------------
KW.CR >PUSHW L.MSG.ECHOCRLF
2021-05-04 17:31:21 +00:00
>PUSHBI 0
2020-11-19 15:34:02 +00:00
>SYSCALL PrintF
rts
*--------------------------------------
KW.SPACE lda #C.SPACE
>SYSCALL PutChar
rts
*--------------------------------------
KW.SPACES >PULLA
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
beq .8
.1 dec
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
pha
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
lda #C.SPACE
>SYSCALL PutChar
pla
bne .1
.8 clc
rts
*--------------------------------------
KW.PRINT >LDYAI 256
>SYSCALL GetMem
bcs .9
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
>STYA ZPPtr1
phx
ldy #$ff
2021-05-04 17:31:21 +00:00
clc
2020-11-19 15:34:02 +00:00
.1 iny
lda (ZPCLBufPtr),y
beq .2
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
sta (ZPPtr1),y
eor #'"
bne .1
2021-05-19 12:44:47 +00:00
2020-11-19 15:34:02 +00:00
sec
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
.2 sta (ZPPtr1),y
2021-05-04 17:31:21 +00:00
tya
2020-11-19 15:34:02 +00:00
adc ZPCLBufPtr
sta ZPCLBufPtr
bcc .3
inc ZPCLBufPtr+1
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
.3 >LDYA ZPPtr1
>SYSCALL PutS
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
pla
2020-12-15 13:23:22 +00:00
>SYSCALL FreeMem
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
.9 rts
*--------------------------------------
KW.KEY >SYSCALL GetChar
bcs .9
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
>PUSHA
2021-05-04 17:31:21 +00:00
2020-11-23 22:05:27 +00:00
.9 rts
2020-11-19 15:34:02 +00:00
*--------------------------------------
KW.EMIT >PULLA
>SYSCALL PutChar
rts
*--------------------------------------
2021-08-10 13:36:07 +00:00
KW.EXPECT >PULLW ZPPtr1 n
>PULLW ZPAddrPtr
lda ZPPtr1+1
bmi .8 n < 0, no action
eor #$ff
sta ZPPtr1+1
lda ZPPtr1
eor #$ff
sta ZPPtr1
ldy #0
.1 inc ZPPtr1
bne .2
inc ZPPtr1+1
beq .6
.2 phy
>SYSCALL GetChar
ply
cmp #C.CR
beq .7
phy
pha
>SYSCALL PutChar
pla
ply
iny
sta (ZPAddrPtr),y
bra .1
.6 tya
beq .8
sta (ZPAddrPtr)
.7 lda #0
sta (ZPAddrPtr),y
.8 clc
rts
*--------------------------------------
KW.COUNT lda (pStack)
sta ZPAddrPtr
sec
adc #0
sta (pStack)
ldy #1
lda (pStack),y
sta ZPAddrPtr+1
adc #0
sta (pStack),y
lda #0
>PUSHA
lda (ZPAddrPtr)
>PUSHA
clc
rts
*--------------------------------------
KW.TYPE >PULLW ZPPtr1 n
>PULLW ZPAddrPtr
ldy #$ff
.1 iny
lda (ZPAddrPtr),y
bne .1
cpy ZPPtr1
bcs .8
iny
2021-08-10 13:36:07 +00:00
lda (ZPAddrPtr),y
pha
lda #0
sta (ZPAddrPtr),y
jsr .8
pla
sta (ZPAddrPtr),y
clc
rts
.8 ldy #S.PS.hStdOut
lda (pPS),y
>PUSHA
>PUSHW ZPAddrPtr
>SYSCALL fputs
clc
rts
2020-11-19 15:34:02 +00:00
*--------------------------------------
KW.WORD
*--------------------------------------
2021-08-10 13:36:07 +00:00
KW.DUMP
lda #E.SYN
sec
rts
*--------------------------------------
KW.TERMINAL
lda #E.SYN
sec
rts
*--------------------------------------
2020-11-19 15:34:02 +00:00
KW.NUMBER
*--------------------------------------
KW.STARTSTR
*--------------------------------------
KW.STRADD
*--------------------------------------
KW.STRDBL
*--------------------------------------
KW.SIGN
*--------------------------------------
KW.ENDSTR
*--------------------------------------
KW.HOLD
*--------------------------------------
KW.DECIMAL
*--------------------------------------
KW.HEX
*--------------------------------------
2020-11-29 13:16:39 +00:00
KW.OCTAL lda #E.SYN
sec
2020-11-19 15:34:02 +00:00
rts
*--------------------------------------
2021-04-15 14:03:04 +00:00
KW.FETCHSP lda pStack+1
ldy pStack
bne .1
2021-05-04 17:31:21 +00:00
2021-04-15 14:03:04 +00:00
inc
.1 >PUSHYA
clc
rts
*--------------------------------------
2020-11-19 15:34:02 +00:00
KW.FETCHW lda (pStack)
sta ZPAddrPtr
ldy #1
lda (pStack),y
sta ZPAddrPtr+1
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
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
2020-11-29 13:16:39 +00:00
lda #E.SYN
sec
2020-11-19 15:34:02 +00:00
rts
*--------------------------------------
KW.FILL >PULLA
bra KW.FILL2
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
KW.ERASE lda #0
bra KW.FILL2
KW.BLANKS lda #C.SPACE
KW.FILL2 tax
>PULLA
tay
>PULLW ZPAddrPtr
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
txa
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
.1 dey
sta (ZPAddrPtr),y
cpy #0
bne .1
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
clc
rts
*--------------------------------------
2020-11-23 22:05:27 +00:00
KW.HERE >PUSHW ZPDataPtr
2020-11-19 15:34:02 +00:00
clc
rts
*--------------------------------------
2020-12-02 15:22:57 +00:00
KW.PAD >PUSHW ZPOutputBufPtr
2020-11-19 15:34:02 +00:00
clc
rts
2021-05-04 17:31:21 +00:00
2020-12-02 15:22:57 +00:00
KW.ALLOT.9 lda #E.STACKERROR
sec
2021-05-04 17:31:21 +00:00
rts
2020-12-02 15:22:57 +00:00
*--------------------------------------
KW.ALLOT lda #SYM.T.VAR
sta ZPType
lda pStack
beq KW.ALLOT.9
cmp #$FF
bcs KW.ALLOT.9
2021-05-04 17:31:21 +00:00
2020-12-02 15:22:57 +00:00
>PUSHB.G hSList
>PUSHW ZPCLBufPtr
>SYSCALL SListNewKey
bcs .9
2021-05-04 17:31:21 +00:00
2020-12-02 15:22:57 +00:00
>STYA ZPKeyID
2021-05-04 17:31:21 +00:00
2020-12-02 15:22:57 +00:00
txa
jsr NextKW
2021-05-04 17:31:21 +00:00
2020-12-02 15:22:57 +00:00
>LDYA ZPDataPtr
>STYA ZPAddrPtr
2021-05-04 17:31:21 +00:00
2020-12-02 15:22:57 +00:00
>PULLA
clc
adc ZPDataPtr
sta ZPDataPtr
2021-05-04 17:31:21 +00:00
2020-12-02 15:22:57 +00:00
>PULLA
adc ZPDataPtr+1
sta ZPDataPtr+1
2021-05-04 17:31:21 +00:00
2020-12-02 15:22:57 +00:00
>PUSHB.G hSList
>PUSHW ZPKeyID
>PUSHWI ZPType
>PUSHWI 4
>SYSCALL SListAddData
2021-05-04 17:31:21 +00:00
2020-12-02 15:22:57 +00:00
.9 rts
2020-11-19 15:34:02 +00:00
*--------------------------------------
KW.nCOMPILE
KW.QUOTE
KW.FORGET
KW.DEFINITIONS
KW.VOCABULARY
KW.FORTH
KW.EDITOR
KW.ASSEMBLER
2020-11-29 13:16:39 +00:00
lda #E.SYN
sec
2020-11-26 19:47:57 +00:00
rts
*--------------------------------------
2021-04-30 15:25:19 +00:00
KW.VLIST stz ZPPtr1
stz ZPPtr1+1
2021-05-04 17:31:21 +00:00
2021-04-30 15:25:19 +00:00
.1 >LDYA ZPPtr1
>STYA ZPKeyID
2021-05-04 17:31:21 +00:00
2020-12-02 15:22:57 +00:00
>PUSHB.G hSList
2021-04-30 15:25:19 +00:00
>PUSHW ZPKeyID
2020-12-02 15:22:57 +00:00
>PUSHW ZPOutputBufPtr
>SYSCALL SListGetByID
bcs .8
2021-05-04 17:31:21 +00:00
2021-04-30 15:25:19 +00:00
>STYA ZPPtr1 Save Next ID
2020-12-02 15:22:57 +00:00
2021-04-30 15:25:19 +00:00
jsr CS.RUN.GetSymbolData
2020-12-02 15:22:57 +00:00
bcs .9
>PUSHW L.MSG.DUMP2
>PUSHW ZPOutputBufPtr
ldx #4
bit ZPType
bmi .2
2021-04-30 15:25:19 +00:00
2020-12-02 15:22:57 +00:00
dex
dex
bvs .2
2021-04-30 15:25:19 +00:00
2020-12-02 15:22:57 +00:00
dex
dex
2021-04-30 15:25:19 +00:00
2020-12-02 15:22:57 +00:00
.2 >PUSHW L.MSG.TYPES,x
>PUSHW ZPAddrPtr
>PUSHBI 6
>SYSCALL PrintF
jmp .1
2021-05-04 17:31:21 +00:00
2021-04-30 15:25:19 +00:00
.8 clc
2021-05-04 17:31:21 +00:00
.9 rts
2020-12-02 15:22:57 +00:00
KW.VC.9 lda #E.STACKERROR
sec
2021-05-04 17:31:21 +00:00
rts
2020-11-19 15:34:02 +00:00
*--------------------------------------
2020-11-29 13:16:39 +00:00
KW.VARIABLE lda #SYM.T.VAR
bra KM.VC
*--------------------------------------
KW.CONSTANT lda #SYM.T.CONST
2020-11-23 22:05:27 +00:00
2020-11-29 13:16:39 +00:00
KM.VC sta ZPType
lda pStack
2020-12-02 15:22:57 +00:00
beq KW.VC.9
cmp #$FF
bcs KW.VC.9
2021-05-04 17:31:21 +00:00
2020-12-02 15:22:57 +00:00
>PUSHB.G hSList
2020-11-23 22:05:27 +00:00
>PUSHW ZPCLBufPtr
>SYSCALL SListNewKey
bcs .9
2021-05-04 17:31:21 +00:00
2020-11-23 22:05:27 +00:00
>STYA ZPKeyID
2021-05-04 17:31:21 +00:00
2020-11-23 22:05:27 +00:00
txa
jsr NextKW
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
bit ZPType
bvs .1
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
>PULLW ZPAddrPtr
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
bra .2
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
.1 >PULLA
sta (ZPDataPtr)
>PULLA
ldy #1
sta (ZPDataPtr),y
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
>LDYA ZPDataPtr
2020-11-23 22:05:27 +00:00
>STYA ZPAddrPtr
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
lda ZPDataPtr
clc
adc #2
sta ZPDataPtr
bcc .2
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
inc ZPDataPtr+1
.2 >PUSHB.G hSList
2020-11-23 22:05:27 +00:00
>PUSHW ZPKeyID
>PUSHWI ZPType
>PUSHWI 4
>SYSCALL SListAddData
2020-11-19 15:34:02 +00:00
2020-11-23 22:05:27 +00:00
.9 rts
2020-11-19 15:34:02 +00:00
*--------------------------------------
2021-04-30 15:25:19 +00:00
KW.BCOLON >PUSHB.G hSList
2020-11-19 15:34:02 +00:00
>PUSHW ZPCLBufPtr
>SYSCALL SListNewKey
bcs .9
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
>STYA ZPKeyID
2020-11-29 13:16:39 +00:00
2020-11-19 15:34:02 +00:00
txa
jsr NextKW
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
lda #SYM.T.CODE
2020-11-23 22:05:27 +00:00
sta ZPType
2021-05-04 17:31:21 +00:00
2020-11-29 13:16:39 +00:00
>LDYA ZPCodePtr
2020-11-23 22:05:27 +00:00
>STYA ZPAddrPtr
2021-05-04 17:31:21 +00:00
2020-11-19 15:34:02 +00:00
>PUSHB.G hSList
>PUSHW ZPKeyID
2020-11-23 22:05:27 +00:00
>PUSHWI ZPType
>PUSHWI 4
2020-11-19 15:34:02 +00:00
>SYSCALL SListAddData
bcs .9
2020-11-29 13:16:39 +00:00
sec
ror bCompile
2020-11-19 15:34:02 +00:00
clc
.9 rts
*--------------------------------------
KW.ACODE
*--------------------------------------
KW.FCODE
2020-11-23 22:05:27 +00:00
2020-11-29 13:16:39 +00:00
lda #E.SYN
sec
2020-11-23 22:05:27 +00:00
rts
2020-11-19 15:34:02 +00:00
*--------------------------------------
MAN
SAVE usr/src/bin/forth.s.kw
LOAD usr/src/bin/forth.s
ASM