Apple-2-SW/A2osX
1
0
Fork 0
mirror of https://github.com/A2osX/A2osX.git synced 2024-11-26 13:49:18 +00:00
Code Issues Projects Releases Wiki Activity
a372872bb9
A2osX/BIN/FORTH.S.KW.txt

997 lines
15 KiB
Plaintext
Raw Normal View History

Kernel 0.94
2020-11-19 15:34:02 +00:00
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
Kernel 0.94
2020-11-23 22:05:27 +00:00
beq .9
cmp #$FF
beq .9
cmp #1
bcc .99
Kernel 0.94
2020-11-19 15:34:02 +00:00
lda (pStack)
tax
ldy #1
lda (pStack),y
>PUSHA
txa
>PUSHA
clc
rts
Kernel 0.94
2020-11-23 22:05:27 +00:00
.9 lda #E.STACKERROR
Kernel 0.94
2020-11-19 15:34:02 +00:00
sec
rts
Kernel 0.94
2020-11-23 22:05:27 +00:00
.99 lda #E.STKOVERFLOW
sec
rts
Kernel 0.94
2020-11-19 15:34:02 +00:00
*--------------------------------------
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
*--------------------------------------
Kernel 0.94
2020-11-23 22:05:27 +00:00
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
Kernel 0.94
2020-11-19 15:34:02 +00:00
*--------------------------------------
KW.Div
*--------------------------------------
KW.Mod
*--------------------------------------
KW.DivMod
*--------------------------------------
KW.MulDivMod
*--------------------------------------
Kernel 0.94
2020-11-23 22:05:27 +00:00
KW.MulDiv
clc
rts
Kernel 0.94
2020-11-19 15:34:02 +00:00
*--------------------------------------
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
Kernel 0.94
2020-11-23 22:05:27 +00:00
ror
lda #0
Kernel 0.94
2020-11-19 15:34:02 +00:00
sta (pStack)
Kernel 0.94
2020-11-23 22:05:27 +00:00
ldy #1
sta (pStack),y
Kernel 0.94
2020-11-19 15:34:02 +00:00
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
Kernel 0.94
2020-11-23 22:05:27 +00:00
lda #0
ror
Kernel 0.94
2020-11-19 15:34:02 +00:00
eor #$80
sta (pStack)
Kernel 0.94
2020-11-23 22:05:27 +00:00
ldy #1
sta (pStack),y
Kernel 0.94
2020-11-19 15:34:02 +00:00
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
Kernel 0.94
2020-11-23 22:05:27 +00:00
lda #0
Kernel 0.94
2020-11-19 15:34:02 +00:00
ror
sta (pStack)
Kernel 0.94
2020-11-23 22:05:27 +00:00
ldy #1
sta (pStack),y
Kernel 0.94
2020-11-19 15:34:02 +00:00
clc
.9 rts
*--------------------------------------
Kernel 0.94
2020-11-23 22:05:27 +00:00
KW.NEGATIVE ldy #1
lda (pStack),y
Kernel 0.94
2020-11-19 15:34:02 +00:00
Kernel 0.94
2020-11-23 22:05:27 +00:00
asl
lda #0
Kernel 0.94
2020-11-19 15:34:02 +00:00
ror
sta (pStack)
Kernel 0.94
2020-11-23 22:05:27 +00:00
sta (pStack),y
Kernel 0.94
2020-11-19 15:34:02 +00:00
clc
rts
*--------------------------------------
Kernel 0.94
2020-11-23 22:05:27 +00:00
KW.ZERO clc
ldy #1
lda (pStack),y
ora (pStack)
Kernel 0.94
2020-11-19 15:34:02 +00:00
bne .9
sec
Kernel 0.94
2020-11-23 22:05:27 +00:00
.9 lda #0
Kernel 0.94
2020-11-19 15:34:02 +00:00
ror
sta (pStack)
Kernel 0.94
2020-11-23 22:05:27 +00:00
sta (pStack),y
Kernel 0.94
2020-11-19 15:34:02 +00:00
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
Kernel 0.94
2020-11-23 22:05:27 +00:00
.9 rts
Kernel 0.94
2020-11-19 15:34:02 +00:00
*--------------------------------------
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
*--------------------------------------
Kernel 0.94
2020-11-23 22:05:27 +00:00
KW.HERE >PUSHW ZPDataPtr
Kernel 0.94
2020-11-19 15:34:02 +00:00
clc
rts
*--------------------------------------
Kernel 0.94
2020-11-23 22:05:27 +00:00
KW.PAD >PUSHW ZPOutputPtr
Kernel 0.94
2020-11-19 15:34:02 +00:00
clc
rts
*--------------------------------------
KW.ALLOT
KW.nCOMPILE
KW.QUOTE
KW.FORGET
KW.DEFINITIONS
KW.VOCABULARY
KW.FORTH
KW.EDITOR
KW.ASSEMBLER
KW.VLIST
clc
rts
*--------------------------------------
Kernel 0.94
2020-11-23 22:05:27 +00:00
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
Kernel 0.94
2020-11-19 15:34:02 +00:00
clc
Kernel 0.94
2020-11-23 22:05:27 +00:00
.9 rts
KW.COLON.SYN lda #E.SYN
sec
Kernel 0.94
2020-11-19 15:34:02 +00:00
rts
*--------------------------------------
Kernel 0.94
2020-11-23 22:05:27 +00:00
KW.ECOLON bit bCompile
bpl KW.COLON.SYN
lda #$60
jsr EmitByte
stz bCompile
Kernel 0.94
2020-11-19 15:34:02 +00:00
clc
rts
*--------------------------------------
Kernel 0.94
2020-11-23 22:05:27 +00:00
KW.VARIABLE lda pStack
cmp #$FE
bcc .99
>PUSHB.G hSList
Kernel 0.94
2020-11-19 15:34:02 +00:00
>PUSHW ZPCLBufPtr
>SYSCALL SListNewKey
bcs .9
>STYA ZPKeyID
txa
jsr NextKW
Kernel 0.94
2020-11-23 22:05:27 +00:00
lda #SYM.T.VAR
sta ZPType
>LDYA ZPDataPtr
>STYA ZPAddrPtr
Kernel 0.94
2020-11-19 15:34:02 +00:00
>PUSHB.G hSList
>PUSHW ZPKeyID
Kernel 0.94
2020-11-23 22:05:27 +00:00
>PUSHWI ZPType
>PUSHWI 4
Kernel 0.94
2020-11-19 15:34:02 +00:00
>SYSCALL SListAddData
bcs .9
>PULLA
Kernel 0.94
2020-11-23 22:05:27 +00:00
sta (ZPDataPtr)
Kernel 0.94
2020-11-19 15:34:02 +00:00
>PULLA
ldy #1
Kernel 0.94
2020-11-23 22:05:27 +00:00
sta (ZPDataPtr),y
Kernel 0.94
2020-11-19 15:34:02 +00:00
Kernel 0.94
2020-11-23 22:05:27 +00:00
lda ZPDataPtr
Kernel 0.94
2020-11-19 15:34:02 +00:00
clc
adc #2
Kernel 0.94
2020-11-23 22:05:27 +00:00
sta ZPDataPtr
Kernel 0.94
2020-11-19 15:34:02 +00:00
bcc .9
Kernel 0.94
2020-11-23 22:05:27 +00:00
inc ZPDataPtr+1
Kernel 0.94
2020-11-19 15:34:02 +00:00
clc
.9 rts
Kernel 0.94
2020-11-23 22:05:27 +00:00
.99 lda #E.STACKERROR
sec
rts
Kernel 0.94
2020-11-19 15:34:02 +00:00
*--------------------------------------
KW.CONSTANT
*--------------------------------------
KW.ACODE
*--------------------------------------
KW.FCODE
Kernel 0.94
2020-11-23 22:05:27 +00:00
clc
rts
Kernel 0.94
2020-11-19 15:34:02 +00:00
*--------------------------------------
Kernel 0.94
2020-11-23 22:05:27 +00:00
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
Kernel 0.94
2020-11-19 15:34:02 +00:00
*--------------------------------------
Kernel 0.94
2020-11-23 22:05:27 +00:00
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
Kernel 0.94
2020-11-19 15:34:02 +00:00
*--------------------------------------
Kernel 0.94
2020-11-23 22:05:27 +00:00
PW.pLOOP >PULLA
tax
>PULLA
bra KW.LOOPax
Kernel 0.94
2020-11-19 15:34:02 +00:00
*--------------------------------------
Kernel 0.94
2020-11-23 22:05:27 +00:00
KW.I ldy RP
iny end+1
iny
iny start
lda (pData),y
tax
iny
lda (pData),y
>PUSHA
txa
>PUSHA
clc
rts
Kernel 0.94
2020-11-19 15:34:02 +00:00
*--------------------------------------
KW.LEAVE
Kernel 0.94
2020-11-23 22:05:27 +00:00
clc
rts
Kernel 0.94
2020-11-19 15:34:02 +00:00
*--------------------------------------
Kernel 0.94
2020-11-23 22:05:27 +00:00
KW.IF
clc
rts
Kernel 0.94
2020-11-19 15:34:02 +00:00
*--------------------------------------
Kernel 0.94
2020-11-23 22:05:27 +00:00
KW.ELSE
clc
rts
Kernel 0.94
2020-11-19 15:34:02 +00:00
*--------------------------------------
KW.ENDIF
Kernel 0.94
2020-11-23 22:05:27 +00:00
clc
rts
Kernel 0.94
2020-11-19 15:34:02 +00:00
*--------------------------------------
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
Reference in New Issue Copy Permalink