A2osX/BIN/FORTH.S.CP.txt

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.PushCodePtr		for compiling LOOP later

				clc
				rts
*--------------------------------------
CP.LOOP			lda #$A9				lda #imm
				jsr CP.Emit.Byte
				lda #$00
				jsr CP.Emit.Byte
				jsr CP.Emit.PUSHA				
				
				lda #$A9				lda #imm
				jsr CP.Emit.Byte
				lda #$01
				jsr CP.Emit.Byte
				jsr CP.Emit.PUSHA		pushed n = 1			
*--------------------------------------
CP.pLOOP		>LDYA J.KEYWORDS.ADD	MAX I n	-> MAX NEWI
				jsr CP.Emit.JsrYA
				jsr CP.Emit.LOOP
				jsr CP.Emit.JMPBack
				jsr CP.Emit.LOOPEND
				clc
				rts
*--------------------------------------
CP.I			>LDYA J.KEYWORDS		DUP
			
				clc
				jmp CP.Emit.JsrYA			
*--------------------------------------
CP.LEAVE

				clc
				rts
*--------------------------------------
CP.IF			jsr CP.Emit.TESTTRUE
				jsr CP.Emit.JMP0000		to put jmp -> ELSE/ENDIF later

				clc
				rts
*--------------------------------------
CP.ELSE			jsr CP.PopPtr1			get previous JMP -> ptr1
				jsr CP.Emit.JMP0000		to put jmp -> ENDIF later 
				jsr CP.UpdatePtr1

				clc
				rts
*--------------------------------------
CP.ENDIF		jsr CP.PopPtr1
				jsr CP.UpdatePtr1

				clc
				rts
*--------------------------------------
CP.BEGIN		jsr CP.PushCodePtr

				clc
				rts
*--------------------------------------
CP.UNTIL		jsr CP.Emit.TESTFALSE
				jsr CP.Emit.JMPBack
				jsr CP.Emit.RPDROP2

				clc
				rts
*--------------------------------------
CP.REPEAT		jsr CP.Emit.JMPBack

				clc
				rts
*--------------------------------------
CP.WHILE		jsr CP.Emit.TESTTRUE
				jsr CP.Emit.JMPBack
				jsr CP.Emit.RPDROP2
				
				clc
				rts
*--------------------------------------
CP.PushCodePtr	ldy RP

				lda ZPCodePtr+1
				sta (pData),y
				dey

				lda ZPCodePtr
				sta (pData),y
				dey

				sty RP
				rts
*--------------------------------------
CP.PopPtr1		ldy RP
				iny
				lda (pData),y
				sta ZPPtr1

				iny
				lda (pData),y
				sta ZPPtr1+1

				sty RP

				rts
*--------------------------------------
CP.UpdatePtr1	lda ZPCodePtr
				sta (ZPPtr1)

				ldy #1
				lda ZPCodePtr+1
				sta (ZPPtr1),y
				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

				ldy RP
				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.PUSHA	ldx #CODE.PUSHA.L
				ldy #0

.1				lda CODE.PUSHA,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.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
*--------------------------------------
MAN
SAVE usr/src/bin/forth.s.cp
LOAD usr/src/bin/forth.s
ASM