A2osX/BIN/FORTH.S.CP.txt

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 #SYS.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