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
632a6693f2
A2osX/BIN/FORTH.S.CP.txt
Rémy GIBERT 2e4c5e3eb6 Kernel 0.94+
2021-04-11 21:47:48 +02:00

383 lines
6.4 KiB
Plaintext
Raw 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.RUN cpx #KW.CONLY
bcs .1 >= KW.CONLY
cpx #KW.ECOLON.ID
beq .1 END Compilation
>LDYA J.KEYWORDS,x
clc
jmp CP.Emit.JsrYA
.1 jmp (J.KEYWORDS,x)
*--------------------------------------
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/ENDIF later
clc
rts
*--------------------------------------
CP.ELSE jsr CP.PopCodePtr get previous JMP -> ptr1
ldx #KW.IF.ID
jsr CP.Emit.JMP0000 to put jmp -> ENDIF later
jsr CP.UpdatePtr1
clc
rts
*--------------------------------------
CP.ENDIF 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
*--------------------------------------
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.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