6502.org

Posted: **Thu Jul 30, 2015 1:35 am**

I just realized the hard way that Forth doesn't have a BREAK statement for indefinite loops, and am now a bit lost on how best to proceed.

Here's what I'm trying to do. For the Crude 65816 Emulator, I'm trying to create a, well, crude I/O handler so that if a byte is stored to a "special" address, it doesn't go to memory, but Something Else (TM) happens. (Actually, at the moment that would only be putchr, but we have to start somewhere.) My current idea is to create a zero-terminated array with the special 65816 addresses and associated executive tokens (xt) of the handlers. Like:

Code: Select all

create store-addresses
    00fff00 , ' putchar-6522-#1 ,
    00fff0f , ' putchar-6522-#2 ,    
    0 ,   \ marks end of table

With a zero to mark the end of the table, I though, I can just add more routines into the table without having to count. How clever, I told myself, now I can simply walk through the loop until we reach zero, and break if the address given is the same as one in the table. In pseudocode:

Code: Select all

: special-store? ( target-65addr -- 0|xt)
    get first 65addr from table
    BEGIN
    65addr-from-table <>0 WHILE
         target-65addr 65addr-from-table = IF get-associated-xt BREAK THEN
         get next 65addr-from-table
    REPEAT ;

(Note special case problem: I/O address could not be 000000) Except that there is no BREAK in Forth for indefinite loops. Oops. There is a rather complicated structure BEGIN-WHILE-UNTIL-THEN (see https://groups.google.com/forum/#!topic ... GfHu2R_cS8) to leave a loop if two different conditions are met, but this seems so unelegant ("a bit odd" is what they're calling on the Forth mailing list, where people are not easily fazed) that I'm having trouble believing that is the best way.

Plan B would to use a counted ?DO/LOOP structure, which would be annoying because I'd have to keep track of how many elements there are in the table (but would take care of the special case problem). Plan C would be to execute the xt from inside the loop, and then just continue through the rest of the table in case there are two or more handlers associated with that address; but that seems silly. Of course, as long as we're talking about only two or such addresses, IF ELSE THEN construct would do (plan D), but that's not really expandable.

So by now I'm wondering if this might be the completely wrong way to solve this problem? Thanks!

Posted: **Thu Jul 30, 2015 2:45 am**

I've had occasion to do BEGIN-WHILE-UNTIL-THEN a couple of times, but it seems like I solved it some other way. There's also the possibility of multiple WHILEs, although I've never written the innards for that. You can also use a DO...LOOP with no intention of reaching the limit, especially if you want it for the index value that keeps getting incremented (or decremented), along with UNLOOP or LEAVE or ?LEAVE. You can have as many of these in the loop as you like.

Posted: **Thu Jul 30, 2015 3:30 am**

How about something in the way of a BEGIN ... WHILE ... IF ... EXIT THEN ... REPEAT or similar? I'd post the core of my old block editor, which uses exactly this kind of table, but it uses R> DROP EXIT to return to the caller's caller from one of the main words, and I'm fairly sure that's not legal these days.

Posted: **Thu Jul 30, 2015 3:49 am**

Yep, and IF EXIT THEN can be shortened to ?EXIT. It requires factoring the BEGIN...WHILE...REPEAT section out as a separate word, but it's another good option. In my '816 (actually '802) ITC Forth, ?EXIT is:

Code: Select all

        HEADER "?EXIT", NOT_IMMEDIATE     ; ( f -- )     IF R> DROP THEN
?EXIT:  PRIMITIVE
        INX_INX                 ; Here we increment first to make things
        LDA     $FFFE,X         ; easier after the comparison.
        BNE     unnest + 2      ; The $FFFE,X won't work if you have
        GO_NEXT                 ; more than one bank!!  * * * * *
 ;-------------------

Posted: **Thu Jul 30, 2015 4:11 am**

I think for now I'm going to go with the ?DO/LOOP with LEAVE for just the few entries and figure out something else in the second interation, and then maybe deal with BEGIN-WHILE-UNTIL-THEN at that point. There is an impolite quote by Hemingway about the "first draft of everything" that probably applies here ...

For the record, and this is way too complicated for this simple case, I think there might be a way of getting around counting stuff by hand and using magic numbers: We can save the count in the first cell of the array we created. So we start with:

Code: Select all

create store-addresses
    0 ,    \ this is the counter

Before, we've defined something like

Code: Select all

: addentry ( xt 65addr array)
    dup 1 swap +!    \ increase counter
    dup @  cells *  2*  +  (xt 65addr newaddr) \ gives us first free cell by adding the counter * cells
    tuck ! cell+ ! ;

(EDIT: fixed stack sequence) (I think I'm off by a cell someplace, but I hope you get the general idea). Now after defining the array, we use this word to add stuff instead of just using the comma notation. Later, ?DO/LOOP can easily retrieve the number of elements when given the array's location by looking up the first cell.

Way too much effort, but yes, it is possible

. It's moments like these when you understand why people would pick, say, Python over Forth:

Code: Select all

def putchar_6522_1():  
    print( "Got to 6522 one") 

def putchar_6522_2(): 
    print( "Got to 6522 two") 

store_addrs = { 0x00ff00 : putchar_6522_1 , 0x00ff0f : putchar_6522_2 }

def special_store(addr):
    try:
        myfunction = store_addrs[addr]
        myfunction()
    except KeyError:
        print ("(Not an I/O address, storing in memory)")

# testing
special_store(0x00ff00)
special_store(0x00e000)

Now that took me all of ten minutes, including the time spent on remembering that PRINT now requires brackets in Python 3. Of course, there is no way that Python will run on an 8-bit CPU, but still, there is certainly a price being able to do this stuff with limited resources

. Thanks for the suggestions, will try to remember to post the final version here after the rewrite. Now off to bed, my brain hurts after all of this ...

Posted: **Thu Jul 30, 2015 5:12 am**

You could make the first cell of the table be the count, something like:

Code: Select all

CREATE  STORE-ADDRESSES
   HERE  0 ,                          \ Start with a count byte, init'd as 0.
      00FFF00 , ' putchar-6522-#1 ,
      00FFF0F , ' putchar-6522-#2 ,
      <etc.>                          \ (Put is as many as you like, and the
   HERE OVER -  2- 4 / SWAP !         \ count gets adjusted automatically.)

Posted: **Thu Jul 30, 2015 6:06 am**

Or you could use a linked-list. Less space-efficient, but you can add new entries and override old entries over time (not necessarily useful for your base scenario, but it was useful for me at one point).

Code: Select all

( Block editor /// -- command table definitions) HEX
VARIABLE edit-key-table

( edit-key-table is a linked-list of three-cell elements.
  1.] The link to the next cell.
  2.] The char-code of the key, with merged bucky bits.
  3.] The execution token to EXECUTE when the key is hit. )

: keylist <BUILDS , DOES> ( xt char-code -- )
    @ DUP @ HERE ROT ! ( link new entry )
    , , , ; ( store new entry in dictionary space )

edit-key-table keylist edkey!

Followed, a couple of blocks later, by things such as ' charbs 08 edkey! and ' chardel 5300 edkey! for the basic editor commands. And then a few blocks after that I defined another "keylist", added new commands to the edit-key-table, and so on.

Posted: **Sat Aug 01, 2015 2:18 pm**

GARTHWILSON wrote:

You could make the first cell of the table be the count, something like:

Ah, that is a much better solution than mine, thank you. Will see about running with that.

Posted: **Sat Aug 01, 2015 4:14 pm**

So I ended up doing it a little differently:

Code: Select all

create store-addrs
   here 0 ,
   putchr ,  ' printchar , \ ## add new routines below this line ## 

   \ save address of last entry in table in its first entry
   here  swap !

Here, we work with the addresses, not the number of entries. This gets rid of those nasty divisions and we don't have to worry about cell size right now. The routine itself is then:

Code: Select all

: special-store? ( n 65addr -- n 65daddr 0|xt)
   false           \ default return value
   store-addrs     ( n 65addr 0 addr-s)
   dup @           ( n 65addr 0 addr-s addr-e ) \ start and end of table
   swap cell+      ( n 65addr 0 addr-e addr-s+cell)        
   ?do             ( n 65addr 0 )
      over i @     ( n 65addr 0 65addr 65addr )
      = if  drop i cell+ @  leave then      
   [ cell 2* ] literal +loop ;

Now I think that in the last line, I've told the compiler to calculate cell 2* just once during compile time and then to push it on the stack instead of calculating it every single time over again. If yes, I'm somewhat proud of myself for thinking of this

. Anyway, this works. Since I'll be using the same structure for the read-routines, and the only difference will be the starting address of the table, I'll probably be rewriting it again later slightly. Thanks again for the help!

Posted: **Sun Sep 30, 2018 8:24 pm**

GARTHWILSON wrote:

I've had occasion to do BEGIN-WHILE-UNTIL-THEN a couple of times, but it seems like I solved it some other way. There's also the possibility of multiple WHILEs, although I've never written the innards for that.

Huh? I implemented conditional words and indefinite loops in my Forth-83 Forth in what I thought was the easiest way. Multiple WHILE's are available without additional code.
I built these words around the mark and resolve words:

Code: Select all

: >MARK  ( -- ADR 1 )
   HERE 0 , 1 ;
: <MARK  ( -- ADR 2 )
   ?COMP
   HERE 2 ;
: >RESOLVE  ( ADR 1 -- )
   ?COMP
   1 ?PAIRS  HERE SWAP ! ;
: <RESOLVE  ( ADR 2 -- )
   2 ?PAIRS  , ;

The compiler security is not meant to force a certain way of using the IF words or the BEGIN words. It is just to make certain that a >MARK is resolved by a >RESOLVE and a <MARK is resolved by a <RESOLVE. Also to make sure the control flow words are only used while compiling.
Here are the IF words:

Code: Select all

: IF  ( -- ADR CS )
   COMPILE ?BRANCH
   >MARK ; IMMEDIATE
: AHEAD  ( -- ADR CS )
   COMPILE BRANCH
   >MARK ; IMMEDIATE
: THEN  ( ADR CS -- )
   >RESOLVE ; IMMEDIATE
: ELIF  ( ADR1 CS -- ADR2 CS )
   [COMPILE] IF  2SWAP
   [COMPILE] THEN ; IMMEDIATE
: ELSE  ( ADR1 CS -- ADR2 CS )
   [COMPILE] AHEAD  2SWAP
   [COMPILE] THEN ; IMMEDIATE

And here are the indefinite loop words:

Code: Select all

: BEGIN  ( -- ADR CS )
   <MARK ; IMMEDIATE
: AGAIN  ( ADR CS -- )
   COMPILE BRANCH
   <RESOLVE ; IMMEDIATE
: UNTIL  ( ADR CS -- )
   COMPILE ?BRANCH
   <RESOLVE ; IMMEDIATE
: REPEAT  ( ADR1 CS1 ADR2 CS2 -- )
   [COMPILE] AGAIN
   [COMPILE] THEN ; IMMEDIATE
: WHILE  ( ADR1 CS1 -- ADR2 CS2 )
   [COMPILE] IF  2SWAP ; IMMEDIATE

Notice that a BEGIN-WHILE- REPEAT loop is no different from a BEGIN-WHILE-AGAIN THEN loop.
A BEGIN-WHILE-UNTIL-THEN loop is straightforward:

Code: Select all

: TEST
   BEGIN
      <do something that leaves a flag on stack>
   WHILE
      <do something else that leaves flag on stack>
   UNTIL
      <made it through loop>
   THEN ;

Or even

Code: Select all

: TEST
   BEGIN
      <do something that leaves a flag on stack>
   WHILE
      <do something else that leaves flag on stack>
   UNTIL
      <made it through loop>
   ELSE
      <left loop at while>
   THEN ;

Here is an example of multiple WHILE's. Just keep in mind that each WHILE is paired with a matching THEN and one of them is built into REPEAT.

Code: Select all

 : WTEST
    BEGIN
       NOOP TRUE
    WHILE
       NOOP TRUE
    WHILE
       NOOP TRUE
    WHILE
       NOOP
    REPEAT
       CR
    THEN
       CR
    THEN
    CR ;

It doesn't do anything useful, but SEE shows what got compiled and where each WHILE ( ?BRANCH ) branched.

Code: Select all

SEE WTEST 
WTEST
 5A84 NOOP
 5A86 TRUE
 5A88 ?BRANCH 5AA6 
 5A8C NOOP
 5A8E TRUE
 5A90 ?BRANCH 5AA4 
 5A94 NOOP
 5A96 TRUE
 5A98 ?BRANCH 5AA2 
 5A9C NOOP
 5A9E BRANCH 5A84 
 5AA2 CR
 5AA4 CR
 5AA6 CR
 5AA8 EXIT
 OK

Hopefully, someone will find this useful.

Cheers,
Jim

Posted: **Sun Sep 30, 2018 9:05 pm**

scotws wrote:

There is a rather complicated structure BEGIN-WHILE-UNTIL-THEN (see https://groups.google.com/forum/#!topic ... GfHu2R_cS8) to leave a loop if two different conditions are met, but this seems so unelegant ("a bit odd" is what they're calling on the Forth mailing list, where people are not easily fazed) that I'm having trouble believing that is the best way.

Really? There's an example of it's use in the definition of XC-SIZE in Annex E: Reference Implementations, E.25 The optional Extended-Character word set.
[EDIT] Here's the url: https://forth-standard.org/standard/implement

Posted: **Wed Oct 10, 2018 11:03 am**

Good point. I'll have to take a look at that, thanks.

Posted: **Tue Nov 27, 2018 4:01 am**

scotws wrote:

I just realized the hard way that Forth doesn't have a BREAK statement for indefinite loops, and am now a bit lost on how best to proceed.

I just saw Ulrich Hoffmann's BREAK/CONTINUE for Forth-94 He states that when his package is loaded, the system will no longer be a standard one though. It also seems complicated.
With control structures that use >MARK >RESOLVE <MARK and <RESOLVE ( assuming they all leave or consume the same size control flow data ), the same behavior can be implemented with the help of an auxiliary stack and some words to transfer control flow data between the control flow stack and the auxiliary stack.
CS>A moves control flow data from the control flow stack to the auxiliary stack.
A>CS moves control flow data from the auxiliary stack to the control flow stack.
A hypothetical example:

Code: Select all

: SOME-LOOP
    .
    .
    .
   BEGIN  // CONTINUE here
      CS-DUP  // duplicate control flow data for BEGIN
      CS>A    // and move it to the auxiliary stack
    .
    .
    .
   // after some other control flow words ( among others )
   IF
   // CONTINUE from here
         A>CS AGAIN
   THEN
    .
    .
    .
   // Is this the desired result?
   IF
   // BREAK from here
      AHEAD  CS>A
   THEN
    .
    .
    .
   // end of loop
   REPEAT
   // BREAK to here
   A>CS THEN
   // rest of definition
    .
    .
;

AHEAD is like IF but it compiles BRANCH rather than ?BRANCH.

Code: Select all

   IF
      A>CS AGAIN
   THEN

Can be shortened to

Code: Select all

   0= A>CS UNTIL

And

Code: Select all

   IF
      AHEAD CS>A
   THEN

Can be shortened to

Code: Select all

   0= IF CS>A

for more efficient code

Admittedly, this wouldn't be very standard either and I'm away from my PC right now so I haven't tested this yet.

Cheers,
Jim

Posted: **Sun Dec 02, 2018 10:36 pm**

It is possible to obtain the behavior of a CONTINUE statement in a simple ( relatively speaking) and efficient way. Here is a fragment of code from my kernel.

Code: Select all

      BEGIN,
         0 # LDY,
         N )Y LDA,  TAX,  INY,
         N )Y LDA,
      0= NOT WHILE,
         N 1+ STA,  N STX,  INY,
         N )Y LDA,  N 2+ )Y EOR,
         3F # AND,
      CS-DUP 0= UNTIL, // CONTINUE
         BEGIN,
            INY,
            N )Y LDA,  N 2+ )Y EOR,
         0= NOT UNTIL,
         7F # AND,
      0= UNTIL,

By duplicating the control flow data for BEGIN, the first 0= UNTIL, behaves like a continue at the beginning of the loop if the result is not zero statement. Of course, there can't be any other control flow data in the way. The WHILE, is not a problem because its control flow data gets placed under the control flow data for BEGIN, . High level control flow words behave similarly, at least in Fleet Forth.

Cheers,
Jim

Posted: **Wed Feb 13, 2019 8:53 pm**

scotws wrote:

It's moments like these when you understand why people would pick, say, Python over Forth:

Code: Select all

def putchar_6522_1():  
    print( "Got to 6522 one") 

def putchar_6522_2(): 
    print( "Got to 6522 two") 

store_addrs = { 0x00ff00 : putchar_6522_1 , 0x00ff0f : putchar_6522_2 }

def special_store(addr):
    try:
        myfunction = store_addrs[addr]
        myfunction()
    except KeyError:
        print ("(Not an I/O address, storing in memory)")

# testing
special_store(0x00ff00)
special_store(0x00e000)

Now that took me all of ten minutes, including the time spent on remembering that PRINT now requires brackets in Python 3. Of course, there is no way that Python will run on an 8-bit CPU, but still, there is certainly a price being able to do this stuff with limited resources

. Thanks for the suggestions, will try to remember to post the final version here after the rewrite. Now off to bed, my brain hurts after all of this ...

After taking another look at this, I realized that some of my CREATE words used in my decompiler would make an easy solution possible. I think that once you gain experience with Forth, not only will thinking in Forth be easier, you will build up a repertoire of useful algorithms, techniques, and CREATE words that, while not part of your Forth system, will be available in source form.

Cheers,
Jim

6502.org

Looping in a world without a BREAK statement

Looping in a world without a BREAK statement

Re: Looping in a world without a BREAK statement

Re: Looping in a world without a BREAK statement

Re: Looping in a world without a BREAK statement

Re: Looping in a world without a BREAK statement

Re: Looping in a world without a BREAK statement

Re: Looping in a world without a BREAK statement

Re: Looping in a world without a BREAK statement

Re: Looping in a world without a BREAK statement

Re: Looping in a world without a BREAK statement

Re: Looping in a world without a BREAK statement

Re: Looping in a world without a BREAK statement

Re: Looping in a world without a BREAK statement

Re: Looping in a world without a BREAK statement

Re: Looping in a world without a BREAK statement