1 1 2 3 5 8 ...

cmpl_subroutine:
                lda #$20        ; compile "JSR" opcode first
                byte $2c        ; "bit $4ca9" opcode
cmpl_jump:
                lda #$4c        ; compile "JMP" opcode first
                ; Compile the opcode in A
                sta (cp)
cmpl_word:
                ; The cmpl_word routine is the body of all these routines
                ; and compiles the value on the Return Stack
                ply             ; LSB of return address
                pla             ; MSB of return address
                iny
                bne +
                inc
*
                sty tmp1
                sta tmp1+1     

                ldy #1
                pla             ; LSB of word to compile
                sta (cp),y
                iny
                pla             ; MSB of word to compile
                sta (cp),y

                tya
                sec             ; advance cp by three bytes
                adc cp
                sta cp
                bcc +
                inc cp+1
*
                jmp (tmp1)

dodefer:
.scope
        ; """Execute a DEFER statement at runtime: Execute the address we
        ; find after the caller in the Data Field
        ; """
                ; The xt we need is stored in the two bytes after the JSR
                ; return address, which is what is on top of the Return
                ; Stack. So all we have to do is replace our return jump
                ; with what we find there
                pla             ; LSB
                sta tmp1
                pla             ; MSB
                sta tmp1+1

                ldy #1
                lda (tmp1),y
                sta tmp2
                iny
                lda (tmp1),y
                sta tmp2+1

                jmp (tmp2)      ; This is actually a jump to the new target
.scend

dodoes:
.scope
        ; """Execute the runtime portion of DOES>. See DOES> and
        ; docs/create-does.txt for details and
        ; http://www.bradrodriguez.com/papers/moving3.htm
        ; """
        ; Assumes the address of the CFA of the original defining word
                ; (say, CONSTANT) is on the top of the Return Stack. Save it
                ; for a later jump, adding one byte because of the way the
                ; 6502 works
                ply             ; LSB
                pla             ; MSB
                iny
                bne +
                inc
*
                sty tmp2
                sta tmp2+1
               
                ; Next on the Return Stack should be the address of the PFA of
                ; the calling defined word (say, the name of whatever constant we
                ; just defined). Move this to the Data Stack, again adding one.
                dex
                dex
               
                ply
                pla
                iny
                bne +
                inc
*
                sty 0,x         ; LSB
                sta 1,x         ; MSB

                ; This leaves the return address from the original main routine
                ; on top of the Return Stack. We leave that untouched and jump
                ; to the special code of the defining word. Its RTS instruction
                ; will take us back to the main routine
                jmp (tmp2)
.scend

branch_runtime:
.scope
                ; The address on the Return Stack points to the last byte
                ; of the JSR address, one byte below the branch literal
                pla
                sta tmpbranch
                pla
                sta tmpbranch+1

                ; Keep in mind: the address we just popped points one byte
                ; lower than the branch literal we want to grab
                ldy #1
                lda (tmpbranch),y  ; LSB
                sta tmp1
                iny
                lda (tmpbranch),y  ; MSB
                sta tmp1+1

                jmp (tmp1)
.scend

literal_runtime:
.scope
                ; During runtime, we push the value following this word back
                ; on the Data Stack. The subroutine jump that brought us
                ; here put the address to return to on the Return Stack -
                ; this points to the data we need to get. This routine is
                ; also called (LITERAL) in some Forths
                dex
                dex

                ; The 65c02 stores <RETURN-ADDRESS>-1 on the Return Stack,
                ; so we are actually popping the address-1 of the literal
                pla             ; LSB
                sta tmp1
                pla             ; MSB
                sta tmp1+1

                ; Fetch the actual literal value and push it on Data stack
                ldy #1
                lda (tmp1),y    ; LSB
                sta 0,x
                iny
                lda (tmp1),y    ; MSB
                sta 1,x

                ; Adjust return address and push back on the Return Stack
                tya
                clc
                adc tmp1
                tay
                lda tmp1+1
                adc #0
                pha
                phy

                rts
.scend

xt_negate:     
                lda #0
                sec
                sbc 0,x         ; LSB
                sta 0,x

                lda #0
                sbc 1,x         ; MSB
                sta 1,x

z_negate:       rts

zero_branch_runtime:
        ; """In some Forths, this is called (0BRANCH)"""
.scope
                ; See if the flag is zero, which is the whole purpose of
                ; this all
                inx
                inx

                lda $fe,x
                ora $ff,x
                bne _skip
_zero:
                ; Flag is FALSE, so we take the jump to the address given
                ; in the two bytes following the JSR
                pla
                sta tmpbranch
                pla
                sta tmpbranch+1

                ; Keep in mind: the address we just popped points one byte
                ; lower than the branch literal we want to grab
                ldy #1
                lda (tmpbranch),y
                sta tmp1
                iny
                lda (tmpbranch),y
                sta tmp1+1

                jmp (tmp1)      ; Execute the branch

_skip:
                ; Flag is TRUE, so we skip over the branch address and
                ; proceed with the part between IF and THEN
                pla             ; LSB
                clc
                adc #2
                tay
                pla             ; MSB
                adc #0          ; only need carry
                pha
                phy

                rts
.scend

 aaa 100 10 do i dup 20 = if ." twenty " then . loop ;  ok
aaa 10 11 12 13 14 15 16 17 18 19 IM
 size (decimal): -10

000A  03 00 03 00 9C 07 1C F0  16 F0 00 00 00 00 10 00
001A  00 00 2A 07 2C 09 03 02  18 00 76 00 00 00 2C 09
002A  14 00 00 00 00 00 00 00  00 00 00 00 00 00 00 00

: aaa 100 10 do i 20 = if ." twenty " then loop ;  ok
aaa twenty  ok

: aaa 100 10 do i dup 20 = if ." twenty " then . loop ;

i   ( u )
dup ( u u )
20  ( u u 20 )
=   ( u f )
if  ." twenty " then ( u )
.   (  )

: .twenty ( u -- ) 20 = if ." twenty " then ;

: aaa  ( -- ) 100 10 do i dup .twenty . loop ;