Apple-2-SW
/
A2osX
mirror of https://github.com/A2osX/A2osX.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity
A2osX/BIN/FORTH.S.CP.txt

467 lines
7.8 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

NEW
AUTO 3,1
*--------------------------------------
CP.JSRX lda #$20 JSR
jsr CP.Emit.Byte
lda I.KEYWORDS,x
jsr CP.Emit.Byte
lda I.KEYWORDS+1,x
jmp CP.Emit.Byte
*--------------------------------------
CP.ECOLON lda #$60 RTS
jsr CP.Emit.Byte
stz bCompile
clc
rts
*--------------------------------------
CP.INVALID lda #E.CSYN
sec
rts
*--------------------------------------
* : TEST ." hello" CR ;
*--------------------------------------
CP.PRINT ldy #$ff
.1 iny
lda (ZPCLBufPtr),y
beq CP.INVALID
cmp #'"'
beq .2
sta (ZPDataPtr),y
bra .1
.2 lda #0
sta (ZPDataPtr),y
phy
>LDYA ZPDataPtr
jsr CP.Emit.LDYAI
ldx #_PutS
jsr CP.Emit.SYSCALL
pla
pha
sec skip "
adc ZPCLBufPtr
sta ZPCLBufPtr
bcc .3
inc ZPCLBufPtr+1
.3 pla
sec include \0
adc ZPDataPtr
sta ZPDataPtr
bcc .4
inc ZPDataPtr+1
.4
clc
rts
*--------------------------------------
CP.DO jsr CP.Emit.DO I,n -> RP
ldy RP
lda ZPCodePtr+1
sta (pData),y
dey
lda ZPCodePtr
sta (pData),y
dey push CodePtr=DOTEST on RP for LOOP/LEAVE
sty RP
jsr CP.Emit.DOTEST CODE: I < n ?
ldx #KW.DO.ID
jsr CP.Emit.JMP0000 to put jmp LOOPEND
clc
rts
*--------------------------------------
CP.LOOP lda #$00
jsr CP.Emit.PUSHBI >PUSHBI 0
lda #$01 >PUSHBI 1
jsr CP.Emit.PUSHBI
*--------------------------------------
CP.pLOOP ldy RP
iny
bmi .9
lda (pData),y
cmp #KW.DO.ID
bne .9
phy
jsr CP.Emit.LOOP CODE: I=I+n
ply
iny POP LOOPEND@ -> Ptr1
lda (pData),y
sta ZPPtr1
iny
lda (pData),y
sta ZPPtr1+1
jsr CP.Emit.JMPBack CODE: JMP to DOTEST
sty RP discard ID DOTEST@ LOOPEND@
jsr CP.UpdatePtr1 update JMP LOOPEND@ with CodePtr
jsr CP.Emit.LOOPEND
clc
rts
.9 lda #E.NODO
sec
rts
*--------------------------------------
CP.I jsr CP.Emit.I
clc
rts
*--------------------------------------
CP.LEAVE ldy RP
.1 iny
bmi .9
lda (pData),y
cmp #KW.DO.ID
beq .2
iny
iny
bpl .1 skip 3 bytes on RP
.9 lda #E.NODO
sec
rts
.2 phy
jsr CP.Emit.LEAVE set I = END on RP
ply
iny skip LOOPEND ptr
iny
jsr CP.Emit.JMPBack jmp DOTEST
clc
rts
*--------------------------------------
CP.IF jsr CP.Emit.TESTTRUE
ldx #KW.IF.ID
jsr CP.Emit.JMP0000 to put jmp -> ELSE/THEN later
clc
rts
*--------------------------------------
CP.ELSE jsr CP.PopCodePtr get previous JMP -> ptr1
ldx #KW.IF.ID
jsr CP.Emit.JMP0000 to put jmp -> THEN later
jsr CP.UpdatePtr1
clc
rts
*--------------------------------------
CP.THEN jsr CP.PopCodePtr
jsr CP.UpdatePtr1
clc
rts
*--------------------------------------
CP.BEGIN jsr CP.PushCodePtr X = BEGIN ID
clc
rts
*--------------------------------------
CP.UNTIL jsr CP.Emit.TESTFALSE
bra CP.WHILE.1
*--------------------------------------
CP.REPEAT ldy RP
iny
bmi CP.E.NOBEGIN
jsr CP.Emit.JMPBack
clc
rts
*--------------------------------------
CP.WHILE jsr CP.Emit.TESTTRUE
CP.WHILE.1 ldy RP
iny
bmi CP.E.NOBEGIN
jsr CP.Emit.JMPBack
jsr CP.Emit.RPDROP2
clc
rts
*--------------------------------------
CP.E.NOBEGIN lda #E.NOFOR
sec
rts
*--------------------------------------
KW.gR
*--------------------------------------
KW.Rg
*--------------------------------------
KW.R
lda #E.SYN
sec
rts
*--------------------------------------
CP.Emit.JMP0000 lda #$4C JMP
jsr CP.Emit.Byte
jsr CP.PushCodePtr
lda #0
jsr CP.Emit.Byte
jsr CP.Emit.Byte
rts
*--------------------------------------
CP.Emit.JMPBack lda #$4C JMP
jsr CP.Emit.Byte
iny
lda (pData),y
jsr CP.Emit.Byte
iny
lda (pData),y
jmp CP.Emit.Byte
*--------------------------------------
CP.Emit.RPDROP2 ldx #CODE.RPDROP2.L
ldy #0
.1 lda CODE.RPDROP2,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.TESTTRUE
ldx #CODE.TESTTRUE.L
ldy #0
.1 lda CODE.TESTTRUE,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.TESTFALSE
ldx #CODE.TESTFALSE.L
ldy #0
.1 lda CODE.TESTFALSE,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.PULLA ldx #CODE.PULLA.L
ldy #0
.1 lda CODE.PULLA,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.PUSHBI pha
lda #$A9 lda #imm
jsr CP.Emit.Byte
pla
jsr CP.Emit.Byte
*--------------------------------------
CP.Emit.PUSHA ldx #CODE.PUSHA.L
ldy #0
.1 lda CODE.PUSHA,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.DO ldx #CODE.DO.L
ldy #0
.1 lda CODE.DO,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.DOTEST ldx #CODE.DOTEST.L
ldy #0
.1 lda CODE.DOTEST,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.LOOP ldx #CODE.LOOP.L
ldy #0
.1 lda CODE.LOOP,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.LOOPEND ldx #CODE.LOOPEND.L
ldy #0
.1 lda CODE.LOOPEND,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.I ldx #CODE.I.L
ldy #0
.1 lda CODE.I,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.LEAVE ldx #CODE.LEAVE.L
ldy #0
.1 lda CODE.LEAVE,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.LDYAI pha
lda #$A0 LDY #imm
jsr CP.Emit.Byte
tya
jsr CP.Emit.Byte
lda #$A9 LDA #imm
jsr CP.Emit.Byte
pla
jmp CP.Emit.Byte
*--------------------------------------
CP.Emit.SYSCALL lda #$A2 LDX #imm
jsr CP.Emit.Byte
txa
jsr CP.Emit.Byte
lda #$20 JSR
jsr CP.Emit.Byte
lda #A2osX.SYSCALL
jsr CP.Emit.Byte
lda /A2osX.SYSCALL
jmp CP.Emit.Byte
*--------------------------------------
CP.Emit.JsrYA pha
lda #$20
jsr CP.Emit.Byte
tya
jsr CP.Emit.Byte
pla
*--------------------------------------
CP.Emit.Byte sta (ZPCodePtr)
inc ZPCodePtr
bne .8
inc ZPCodePtr+1
.8 rts
*--------------------------------------
CP.PushCodePtr ldy RP
lda ZPCodePtr+1
sta (pData),y
dey
lda ZPCodePtr
sta (pData),y
dey
txa
sta (pData),y
dey
sty RP
rts
*--------------------------------------
CP.PopCodePtr ldy RP
iny
lda (pData),y
cmp #KW.IF.ID
bne .9
iny
lda (pData),y
sta ZPPtr1
iny
lda (pData),y
sta ZPPtr1+1
sty RP
clc
rts
.9 lda #E.NOIF
sec
rts
*--------------------------------------
CP.UpdatePtr1 lda ZPCodePtr
sta (ZPPtr1)
ldy #1
lda ZPCodePtr+1
sta (ZPPtr1),y
rts
*--------------------------------------
MAN
SAVE usr/src/bin/forth.s.cp
LOAD usr/src/bin/forth.s
ASM
Reference in New Issue View Git Blame Copy Permalink