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 clc 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