6502.org

Posted: **Wed Jan 28, 2015 10:21 pm**

In a different thread, there was a discussion on how to code DO/LOOP and friends such as ?DO and LEAVE (and IF, THEN, ELSE while we are at it) in STC Forth. Though the basic mechanisms are clear, it might be helpful to have the discussion all in one place.

As a brute-force overview, these are the possible combinations we're talking about that will have to work, from simplest to most complicated (LOOP is merely shorthand for 1 +LOOP, so we'll use "LOOP" for both here):

Code: Select all

1. IF THEN
2. IF ELSE THEN
3. DO LOOP
4. ?DO LOOP
5. DO LEAVE LOOP
6. ?DO LEAVE LOOP
7. DO IF LEAVE THEN LOOP
8. ?DO IF LEAVE THEN LOOP
9. DO IF LEAVE ELSE THEN LOOP
10. DO IF ELSE LEAVE THEN LOOP
11. ?DO IF LEAVE ELSE THEN LOOP
12. ?DO IF ELSE LEAVE THEN LOOP

(We ignore UNLOOPing for the moment as part of LOOP and/or LEAVE) If you examine this word by word, you can see that

IF, THEN, DO, LEAVE always take exactly one action
ELSE, ?DO always take exactly two actions
LOOP can take between one and three actions (argh).

For example, in variant 12, LOOP resolves a backward conditional branch to ?DO (the "normal" loop behavior), resolves a forward conditional branch from ?DO (if TOS and NOS are equal and the loop is not invoked), and resolves a forward unconditional branch from LEAVE (emergency exit). Note we have to land exactly after the LOOP word so we can add stuff like a final DROP in the word.

If we use the Data Stack as the control-flow stack, we need a way to tell LOOP what it has to call how many times and when. Making the whole thing more difficult is that it makes sense to use the Return Stack to hold the limit and start values of ?DO/DO with the "V-flag fudge" which makes ANS-loop behavior (the Laxen & Perry F83 method). Even worse, because a loop is the last place we want to be slow, it would be nice to do as much as possible directly in assembler (though it should be easier to use Forth and pseudocode for the examples). Oh, and the STC is going to fool around with the Return Stack a lot, too.

I'd like to use this thread to discuss how to do this, starting in the next entry where I'll take care of the easy cases. I'll include a bit more explanation of what they do for those people who are new to this part of Forth.

Posted: **Wed Jan 28, 2015 10:40 pm**

Starting with IF-THEN, a bit more detail for those new to this sort of thing:

At compile-time, IF ads a "conditional forward branch" to the word being created, traditionally called 0BRANCH. Then, during run-time, if the value on the Data Stack is false (flag is zero), the branch is taken ("branch on zero", therefore the zero). The target of the that branch will be added by THEN. But how does THEN know where to save the address IF jumps to? After the 0BRANCH has been compiled, the Compiler Pointer (CP) -- the pointer that tells Forth where we are in the memory -- marks where that address will have to go. HERE puts the CP on the Data Stack, so we do that, during compile time. Then, we compile a dummy value (usually 0) to reserve the space we need.

The whole thing ends up looking like this in ANS Forth:

Code: Select all

: IF   POSTPONE 0BRANCH HERE 0 , ; IMMEDIATE

Note this is a compile-only word (in Tali Forth, there's an additional word COMPILE-ONLY that handles that; YFMV) and it is "immediate", so it is executed during compilation. However, POSTPONE blocks the execution of the following word, so 0BRANCH is compiled after all. Older Forths tend to use [COMPILE] here (I think). If POSTPONE is making your brain hurt, that's fine, it does that at first.

Anway, after compiling IF, we end up with a dummy value as the branch target and the address of that same dummy value on the stack. Sooner or later, we reach THEN.

Code: Select all

: THEN  HERE SWAP ! ; IMMEDIATE

Note that THEN doesn't actually compile anything at the location in memory where it is at. It's job is to help IF out of the mess it created. THEN assumes that the top of the Data Stack (TOS) during compile time contains the address that IF provided. HERE again gives us the location of the CP, but this time we get the target of IF's jump. We SWAP it with the address from IF, and our ! ("store") saves it right behind the IF's 0BRANCH where it belongs. That finishes the IF-THEN construction.

The ELSE of IF-ELSE-THEN can be coded like this:

Code: Select all

: ELSE  POSTPONE BRANCH HERE 0 , HERE ROT ! ; IMMEDIATE

If we have taken the IF branch, we have to jump over the alternative at this point, so we add the unconditional branch BRANCH, push the location of the next cell on the stack for THEN, and save a dummy value 0 (ANS Forth has its own name for this sequence, AHEAD). Now we have to tell IF where to land if we didn't continue after ELSE, which is right after the dummy value we just saved. Basically, this now a version of THEN with ROT instead of SWAP, because we're juggling one more thing on the stack. In fact, another version of ELSE you'll see is

Code: Select all

: ELSE POSTPONE AHEAD SWAP THEN ; IMMEDIATE

Note the "hidden" second SWAP in THEN. I like the first version better because it seems slightly less confusing. ANS Forth uses 1 CS-ROLL instead of SWAP.

Finally we come to the THEN, which takes the address provided by the first part of ELSE (not by IF any more!) and does the store thing to resolve that unconditional forward branch.

Those were cases 1 and 2. Now for the simple DO/LOOP stuff.

Posted: **Wed Jan 28, 2015 11:11 pm**

So, DO/LOOP --

We start off by compiling a word with a name such as (DO) that sets up the loop by modifying limit and start on the Data Stack (see viewtopic.php?f=9&t=2026 ) and putting them on the Return Stack -- but we don't care about that part at the moment. What it also does is throw out the current address it is at as the destination for the LOOP's jump back. In other words, a simple HERE. We get something like

Code: Select all

: DO   POSTPONE (DO) HERE ; IMMEDIATE

When discussing control-flow, there is a synonym of HERE called BEGIN in ANS Forth.

LOOP then compiles its own private word (LOOP) which does the loop control stuff we're also not interested in at the moment. What we need to know is that after that, we compile a conditional branch backwards, which uses the address provided by DO. We can save this with a simple , ("comma"). Otherwise, we're done with the loop. Cleaning up involves cleaning limit and start off the Return Stack again, so we UNLOOP. Assuming 0BRANCH is part of (LOOP), this gives us something like

Code: Select all

: LOOP  POSTPONE (LOOP) , POSTPONE UNLOOP ; IMMEDIATE

In fact, what you can do is make LOOP a special case of +LOOP:

Code: Select all

: LOOP POSTPONE 1 POSTPONE (+LOOP) , POSTPONE UNLOOP ; IMMEDIATE

That's a lot of POSTPONEs, we'll make it cleaner in assembler.

So far, so good. Now we're coming to the part -- variant 4 on the list -- were I'm starting to get stuck. ?DO needs to see if TOS and NOS are the same and jump over the complete loop (because ANS Forth redefined the loop behavior of FIG Forth, it would loop through the complete integer space if this were the case. Yes, this seems like a questionable change, but we're sort of stuck with it). So, in pseudo-code (not in working Forth), we should have something like

Code: Select all

: ?DO  POSTPONE (?DO) POSTPONE INVERT POSTPONE 0BRANCH HERE 0 , POSTPONE (DO) HERE ; IMMEDIATE

Again, I haven't tested this. What it does is mark the origin a forward conditional branch (IF could be part of (?DO) because of this) that LOOP has to resolve so we can skip the whole loop. Otherwise, it continues as a normal (DO).

I'm going to stop here for the moment because I want to test this before going on -- and because now the fun starts: Somehow, we have to tell LOOP that it has a second branch to take care of, and do it elegantly. Can't figure out a clean way to do that yet.

Of course, I'd be most grateful for comments, suggestions and corrections so far!

Posted: **Thu Jan 29, 2015 3:38 pm**

I took a simpler view of loop constructs. The DO and LOOP words can be based on the compiler words, BEGIN and UNTIL.

BEGIN is just the immediate version of HERE while UNTIL compiles 0BRANCH and sets the destination address equal to that left on the stack by BEGIN.

If I were to simulate the DO-LOOP* structure using BEGIN-UNTIL then the DO section would look like

Code: Select all

BEGIN 2>R

while the LOOP section would look like

Code: Select all

2R> 1+ 2DUP <= UNTIL 2DROP

It is then a relatively simple matter to define DO and LOOP that lays down the code just described:

Code: Select all

: DO POSTPONE BEGIN POSTPONE 2>R ; IMMEDIATE
: LOOP POSTPONE 2R> POSTPONE 1+ POSTPONE 2DUP POSTPONE <= POSTPONE UNTIL POSTPONE 2DROP ; IMMEDIATE

You would almost certainly make these words assembly language code and in the case of LOOP, probably lay down calls to (LOOP) and UNLOOP to conserve space. Note that this code does not allow for any LEAVE words which would complicate the LOOP construct.

* In my own forth, I did not include DO-LOOP as I think they are counter-intuitive (work differently to how counted loops would work in BASIC or PASCAL). However, I used a similar technique to code FOR-NEXT.

Posted: **Thu Jan 29, 2015 6:39 pm**

Quote:

In a different thread, there was a discussion on how to code DO/LOOP and friends such as ?DO and LEAVE [...]

The split is at viewtopic.php?p=36533#p36533, in the topic "Introducing Tali Forth for the 65c02 (ALPHA)".

Quote:

and resolves a forward unconditional branch from LEAVE (emergency exit).

Just have do (the internal compiled by DO) start by putting the end address on the return stack at run time, before putting the loop limit and index on it. Then LEAVE or ?LEAVE (however many you want have in the loop) uses that to know where to branch to. The only address LOOP fills in is at do. LEAVE and ?LEAVE just put down one cell (two bytes), with no following address. Your J will need to be modified if it does not already allow for the end address to be put on the return stack by do.

Posted: **Thu Jan 29, 2015 7:46 pm**

Another way to do it would be like CASE, where each END-OF increments the number of END-OFs on the data stack during compilation and puts its own address under the count, so END-CASE goes through and fills them all in, knowing how many from the count at the top of the stack. To make my CASE structure in my Forth-like assembly-language structure macros simpler, I did not use the virtual data stack in the assembler to keep track of OF...END_OFs. Instead, there's just one array for the CASE statement to use for this, meaning there's the small disadvantage that you can't have multiple CASE structures nested. (I didn't anticipate nesting CASE structures, but then I did need to nest them once, so I put the second one in another subroutine called in one of the first CASE's OF...END_OF set. The assembly macro CASE structure can be nested inside a non-CASE structure though, and vice-versa. Most other structures can be nested.)

Posted: **Fri Jan 30, 2015 5:42 am**

GARTHWILSON wrote:

Just have do (the internal compiled by DO) start by putting the end address on the return stack at run time, before putting the loop limit and index on it.

Brilliant! It answers all the questions I had about LEAVE. In fact, if you put the end address - 1 on the return stack then LEAVE becomes a simple macro in STC forth:

Code: Select all

: LEAVE PLA, PLA, PLA, PLA, RTS, ; IMMEDIATE

Posted: **Fri Jan 30, 2015 8:54 am**

GARTHWILSON wrote:

Just have do (the internal compiled by DO) start by putting the end address on the return stack at run time, before putting the loop limit and index on it.

Garth, I think you just nailed it. Brilliant. I'm going to have to interact with actual physical objects in the real world the next few days, but will try to code this ASAP and then will update stuff here. Thanks!

Posted: **Wed Feb 04, 2015 8:49 am**

I've been playing with do (internal compiled by DO) in STC for LEAVE or ?LEAVE to just remove the index and limit on the stack and do an RTS to pick up right after the end of the loop, and for the 6502, do is extremely long! (Before, I had only done it in ITC.) Fortunately it only runs when you're setting up the loop, but still...

Posted: **Mon Feb 09, 2015 7:19 am**

Yes, it turns out the devil is very much in the details. But it does work -- I've gotten DO with LOOP/+LOOP and LEAVE up and running (as in, basic tests work), hope to get ?DO done today as well, and then I'll update stuff here.

Posted: **Mon Feb 09, 2015 1:27 pm**

So, DO/LOOP again ...

Based on Garth's insight, we write DO and friends in pure assembler, not high-level Forth, and begin each loop in run-time by saving the address after the whole loop construct to the Return Stack. That way, LEAVE and ?DO know where to jump to when called. On top of that address, we place the fudged limit and start values (see above).

The key to staying sane (relatively speaking) while designing these constructs is to first make a list of what we want to happen at compile-time and what at run-time. Let's start with a simple DO/LOOP.

DO at compile-time:

Remember current address (in other words, HERE) on the Return Stack (!) so we can later compile the code for the post-loop address to the Return Stack
Compile some dummy values to reserve the space for said code
Compile the run-time code; we'll call that fragment (DO)
Push the current address (the new HERE) to the Data Stack so LOOP knows where the loop contents begin

DO at run-time (called (DO) here):

Take limit and start off Data Stack, fudge them and push them to the Return Stack

The one thing that might be unexpected is that DO saves the current address for delayed code compilation to the Return Stack, not the Data Stack. This avoids having to juggle stuff on the Data Stack if we use IF and friends.

Before we go into the details, we take a loop at what LOOP/+LOOP is going to do. Since LOOP is just a special case of +LOOP with an index of one, we can generalize for both.

LOOP at compile-time:

Compile the run-time part; we'll call that (+LOOP)
Consume the address that is on top of the Data Stack as the jump target for normal looping and compile it
Compile UNLOOP for when we're done with the loop, getting rid of the limit/start and post-loop addresses on the Return Stack (more on UNLOOP later)
Get the address on the top of the Return Stack which points to the dummy code compiled by DO
At that address, compile the code that pushes the address after the list construct to the Return Stack at run-time

LOOP at run-time (called (+LOOP) here):

Add loop step to count
Loop again if we haven't crossed the limit, otherwise continue after loop

At one glance, we can see that the complicated stuff happens at compile-time. This is good, because we only have to do that once for each loop.

In the next entry, we'll go into the actual code.

Posted: **Mon Feb 09, 2015 1:51 pm**

Now for the messy details of DO/LOOP, starting with DO:

When we say we remember the current address on the Return Stack, we have to remember that a STC implementation, the top of the Return Stack is blocked with the address that called DO in the first place. So we have to shuffle stuff around:

Code: Select all

                ply             ; LSB
                sty TMPADR
                ply             ; MSB

                ; now we can save HERE 
                lda CP+1        ; MSB first
                pha
                lda CP
                pha             ; then LSB

                ; put RTS address back before something bad happens
                phy             ; MSB
                ldy TMPADR
                phy             ; LSB

The rest is actually straight-forward, but longish. We need to compile something like

Code: Select all

LDA MSB
PHA
LDA LSB
PHA

later, with MSB and LSB the address after the loop. So we reserve six bytes of space.

Code: Select all

                lda #$05        ; we don't really care about the value 
                tay

*               sta (CP),y
                dey
                bpl -

                ; update CP
                inc             ; we used 5 as a dummy value, this is why 
                clc
                adc CP
                sta CP
                bcc +
                inc CP+1

Then the actual codes gets a little more complicated, because we combine the routines for ?DO and DO -- if this is ?DO, we first compile the (?DO) check for TOS/NOS being equal, and then both versions compile (DO) and the routine that pushes HERE on the Data Stack for LOOP to pick up.

We'll look at LOOP next, which is where it gets messy.

The easy part is compiling (+LOOP), the address off the stack (a simple , -- "COMMA"), and UNLOOP. Now, to finish compiling the DO code, we need that address that we pushed on the Return Stack. Except that it is again buried under the RTS for this routine. As above, we shuffle stuff around, saving the address to zero page at TMPADR1 and TMPADR1+1.

But wait! We're not done with housekeeping stuff. Because of the way the 65c02 uses the RTS addresses, we don't save the address, but the address minus one. With eight bits, this is a pain:

Code: Select all

                sec
                lda CP
                sbc #$01        ; DEC doesn't affect C-flag
                sta TMPADR1
                lda CP+1
                bcs +
                dec
*               sta TMPADR1+1

Then, and only then, can we save the code in DO.

Code: Select all

               ldy #$00

                lda #$A9        ; opcode for LDA immediate
                sta (TMPADR),y
                iny
                lda TMPADR1+1   ; MSB
                sta (TMPADR),y
                iny
                lda #$48        ; Opcode for PHA
                sta (TMPADR),y
                iny

                lda #$A9        ; opcode for LDA immediate
                sta (TMPADR),y
                iny
                lda TMPADR1     ; LSB
                sta (TMPADR),y
                iny
                lda #$48        ; Opcode for PHA
                sta (TMPADR),y

(This can probably be optimized, but at the moment, I'm happy it works.) So much of the basics. In the next entry, we'll look at some of the details.

Posted: **Mon Feb 09, 2015 2:01 pm**

Some of the other details like UNLOOP and LEAVE:

The nice thing about having DO and LOOP doing all the heavy lifting is that the rest becomes simple. The additional fragment for (?DO) is little more than comparing the TOS and NOS and cleaning up if they are equal:

Code: Select all

                jsr l_2dup
                jsr l_equal     ; gives us ( n1 n2 f ) 

                lda 1,x         ; just need one byte of flag
                beq _do_do      ; if not equal, just continue with (DO)

                ; we're equal, so dump everything and jump beyond the loop
                ; first, dump six entries off of the Data Stack
                txa
                clc
                adc #$06        
                tax

                ; second, abort the whole loop. We don't have the 
                ; limit/start parameters on the Return Stack yet, just the 
                ; address that points to the end of the loop. Dump the 
                ; RTS of ?DO and then just RTS ourselves
                pla
                pla
                rts

_do_do:         inx             ; clear flag from EQUAL off stack
                inx             ; this merges into (DO)

Ah, the simple joy of immature label names. UNLOOP is now trivial, consisting of six PLAs (four for the limit/count of DO, two for the address after the stack), and LEAVE is just four PLAs (four for the limit/count) and one RTS. If they are natively compiled, they don't even have to be IMMEDIATE words, though of course they remain compile-only.

I've uploaded the actual code to https://github.com/scotws/TaliForth -- still ALPHA, and I'm pretty sure there bugs in there somewhere. But it has passed the simple tests. I'll be including a file LOOPS.TXT with Tali when I get around to it with the details presented here. And thanks again to Garth!

Posted: **Tue Feb 10, 2015 5:55 am**

These are the bits I would have to add to DO and LOOP to make LEAVE work on my system.

Code: Select all

: DO HERE  0 #, LDA, PHA, 0 #, LDA, PHA, ...... ; IMMEDIATE

: LOOP ..... HERE 1-
  [  STACK 3 + ,X LDA, IY STA, STACK 4 + ,X LDA, IY 1+ STA, 
     1 #, LDY, STACK 2 + ,X LDA, IY ),Y STA,
     4 #, LDY, STACK 1 + ,X LDA, IY ),Y STA,
     INX, INX, INX, INX,
  ] ; IMMEDIATE

: LEAVE PLA, PLA, PLA, PLA, RTS, ; IMMEDIATE

Resolving the code laid down by DO is based on this calculation:
0 LDA
1 0 ( hi)
2 PHA
3 LDA
4 0 (lo)
5 PHA

I still have to code the rest of the DO and LOOP to test it but without an editor, this is proving difficult.

Posted: **Tue Feb 10, 2015 8:23 am**

GARTHWILSON wrote:

I've been playing with do (internal compiled by DO) in STC for LEAVE or ?LEAVE to just remove the index and limit on the stack and do an RTS to pick up right after the end of the loop, and for the 6502, do is extremely long! (Before, I had only done it in ITC.) Fortunately it only runs when you're setting up the loop, but still...

Here it is, below, written from a standpoint of doing things in assembly (hence the macros) in a very Forth-like way; and I specifically made it to take no variables except N which Forth already used. Perhaps I could shorten it up by making better use of N. I don't think I've ever put such a long piece of code in a forum post since it's always a pain to go through someone else's code, but here it is. Loop limit and index are kept on the return stack in the traditional Forth way. What gets laid down for DO in the first case, which makes do very long due to the need to grab the address after the JSR instruction and adjust the return address, is:

Code: Select all

        JSR  do
        DWL  <address of first instruction after the loop, minus 1, for leave's RTS>

"DWL" (above) in the C32 assembler is "Define data Word(s), Low byte first." So DO takes 5 bytes: three for the JSR and 2 for the end address. ?DO would lay down 5 bytes also. In assembly, I would use macros, and the LOOP or +LOOP macro would go back and fill in the address following the JSR do. These are not tested.

Code: Select all

 ; JSRs to "do" below are intended to be followed with the address of the first
 ; instruction after the loop, so LEAVE and ?LEAVE can delete the loop limit and
 ; index (and optionally set the LOOP_LEAVE flag variable) and then use RTS to
 ; branch out of the loop.


                        ; ( lim index -- )
do:     LDA  3,X        ; Get the loop limit high byte and
        PHA             ; push it onto the return stack,
        LDA  2,X        ; followed by the low byte.  Return
        PHA             ; address underneath will get changed.
        INX             ; Remove limit cell from data stack.
        INX

        LDA  1,X        ; Get initial loop index high byte
        PHA             ; and push it onto return stack,
        LDA  0,X        ; followed by the low byte.
        PHA
        INX             ; Remove index cell from data stack.
        INX

                        ; The following 3 lines are a shorter,
 ;      JSR  SWAP       ; slower alternative to the above 12.
 ;      JSR  toR        ; Transfer loop limit to return stack,
 ;      JSR  toR        ; followed by initial loop index.

        PHX             ; Preserve data stack pointer X
           TSX          ; while we set Y up for
           TXA          ; return stack direct
           TAY          ; indexed addressing.
        PLX             ; Restore X as data stack pointer.

        LDA  106,Y      ; Make copy of initial return addr.
        PHA             ; High byte might get incremented
        STA  N+1        ; later, after low byte does below.

        LDA  105,Y      ; Get low byte of initial return addr.
        STA  N          ; (This line is for after "do1".)
        CLC             ; It is assumed the D flag is clear.
        ADC  #2         ; Add 2 to get past loop end addr data.
        PHA             ; Complete the pushed address revision.

        BCC  do1        ; If incrementing above produced carry,
        LDA  N+1
        INA             ; then increment high byte too.
        STA  $00FF,Y    ; This line is abs,Y, not ZP,Y.
                        ; Now return address is ready for RTS.
do1:    LDA  105,Y      ; Orig return ADH is already in N+1,
        INA             ; so now get low byte, increment it,
        STA  N          ; and store it in temporary space.

        BNE  do2        ; If incrementing it made it roll over,
        INC  N+1        ; then increment the high byte too.

do2:    LDA  (N)        ; Get the pair of bytes pointed to by N
        STA  105,Y      ; and store it where orig rtn addr was.
        PHY             ; It's now the exit addr of the loop.
           LDY  #1
           LDA  (N),Y
        PLY
        STA  106,Y

        RTS
 ;------------------

 ; That was incredibly long.  A Macro alternative is:

DO:     MACRO  loop_end_adr
        LDA  >{loop_end_adr-1}   ; high byte
        PHA
        LDA  <{loop_end_adr-1}   ; then low byte
        PHA

        LDA  3,X     ; Move loop limit and index
        PHA          ; to the return stack.
        LDA  2,X
        PHA
        LDA  1,X
        PHA
        LDA  0,X
        PHA

        INX          ; Delete the no-longer-used
        INX          ; cells from the data stack.
        INX
        INX
        ENDM
 ;------------------

 ; or even this:

DO:     MACRO  loop_end_adr
        LDA  >{loop_end_adr-1}   ; high byte
        PHA
        LDA  <{loop_end_adr-1}   ; then low byte
        PHA

        JSR  SWAP       ; slower alternative to the above 12.
        JSR  toR        ; Transfer loop limit to return stack,
        JSR  toR        ; followed by initial loop index.

        ENDM
 ;------------------


 ; These allow multiple LEAVEs and ?LEAVEs.  LEAVE and ?LEAVE could be macros
 ; that would assemble BRA or JMP instructions to the end, but it would be quite
 ; a challenge to allow multiple ones.  The more-complex DO and ?DO above make
 ; multiple LEAVEs and ?LEAVEs simple.

?do:        (not written yet)

loop:       (not written yet)

plus_loop:  (not written yet)

I:      PHX             ; ( -- n )      Call I with JSR.
           TSX          ; Preserve X for data stack pointer while
           TXA          ; we get the return stack pointer into Y
           TAY          ; for indexing so we can have both at once.
        PLX

        DEX             ; Put additional cell
        DEX             ; on data stack.

        LDA  102,Y      ; Get loop index and put it
        STA  0,X        ; on the data stack, low byte
        LDA  103,Y      ; and then high byte.
        STA  1,X

        RTS
 ;------------------

J:      PHX             ; ( -- n )      Call J with JSR.
           TSX          ; Preserve X for data stack pointer while
           TXA          ; we get the return stack pointer into Y
           TAY          ; for indexing so we can have both at once.
        PLX

        DEX             ; Put additional cell
        DEX             ; on data stack.

        LDA  108,Y      ; Get index of next loop out and
        STA  0,X        ; put it on the data stack, low byte
        LDA  109,Y      ; and then high byte.
        STA  1,X

        RTS
 ;------------------

LEAVE:  MACRO           ; These two are macros partly so you don't have to
        JMP  leave      ; remember to use JMP with leave and JSR with ?leave.
        ENDM
 ;-------------

?LEAVE: MACRO
        JSR  ?leave
        ENDM
 ;-------------

                        ; ( -- )        Use leave with JMP, not JSR.
leave:  PLA             ; Remove the loop index (counter) from the
        PLA             ; hardware stack.  (Low byte, then high byte.)

        PLA             ; Remove the loop limit from the hardware
        PLA             ; stack.  (Low byte, then high byte.)

 ;      LDA  #$FF       ; Add these 2 lines if you want to later be able to tell
 ;      STA  LOOP_LEAVE ; if the loop was aborted.  Add STZ LOOP_LEAVE in LOOP
                        ;                   and +LOOP where they drop through.
        RTS             ; DO had stacked the ending address-1; so RTS removes
 ;--------------        ;      and increments it, and jumps past end of loop.


?leave: LDA  0,X        ; ( f -- )      Use ?leave with JSR, unlike leave.
        ORA  1,X        ; If both bytes of the cell are zero,
        BEQ  ql1        ; just return without doing anything.

        PLA             ; Remove return address since we're not
        PLA             ; going to return to where ?LEAVE was called.

        PLA             ; Remove the loop index (counter) from the
        PLA             ; hardware stack.  (Low byte, then high byte.)

        PLA             ; Remove the loop limit from the hardware
        PLA             ; stack.  (Low byte, then high byte.)

 ;      LDA  #$FF       ; Add these 2 lines if you want to later  * * * * *
 ;      STA  LOOP_LEAVE ; be able to tell if the loop was aborted.

ql1:    INX             ; Remove the top cell
        INX             ; from the data stack.

        RTS             ; Where this jumps to depends on what was in TOS!
 ;--------------

Obviously the '816 would take far fewer instructions, due to being able to handle 16 bits at once, plus its stack-relative addressing modes. NMOS 6502 would take more.

LOOP will lay down:

Code: Select all

        JSR  loop
        DWL  <address of top of loop>

and +LOOP would lay down 5 bytes also, the same length. Note that +LOOP does not really work the same way when the increment is negative as it does when it's positive. It drops through when it crosses the line between the limit and limit minus 1, which is is different between positive and negative increment amounts.

BTW, the 6502 Forth I "cut my teeth on" used lower case for internals like do compiled by DO and so on, which I prefer because if you want to use them in a comment with ( instead of \, the closing parenthesis of (do) won't fool it into trying to compile or interpret the rest of the comment. I seem to remember having worked with an assembler one time that was not case-sensitive (bad idea!) and there I put an _ in front of the lower-case internal to differentiate, like _do.

6502.org

On coding DO/LOOP and friends in a STC Forth

On coding DO/LOOP and friends in a STC Forth

Re: On coding DO/LOOP and friends in a STC Forth

Re: On coding DO/LOOP and friends in a STC Forth

Re: On coding DO/LOOP and friends in a STC Forth

Re: On coding DO/LOOP and friends in a STC Forth

Re: On coding DO/LOOP and friends in a STC Forth

Re: On coding DO/LOOP and friends in a STC Forth

Re: On coding DO/LOOP and friends in a STC Forth

Re: On coding DO/LOOP and friends in a STC Forth

Re: On coding DO/LOOP and friends in a STC Forth

Re: On coding DO/LOOP and friends in a STC Forth

Re: On coding DO/LOOP and friends in a STC Forth

Re: On coding DO/LOOP and friends in a STC Forth

Re: On coding DO/LOOP and friends in a STC Forth

Re: On coding DO/LOOP and friends in a STC Forth