Fleet Forth design considerations

[JimBoyd]

The only problem I had with the name 2PICK was the possibility of it being mistaken for the double number version of PICK . I think DPICK is a better name for the double number version of PICK .
I like that the name 2PICK describes what it is doing just as the name DUP>R describes what it is doing.
2PICK performs 2 PICK
DUP>R performs DUP >R
If I needed to perform 3 PICK often enough to justify writing a primitive, there would be no verbal confusion with the name 3PICK , unlike the name FOURTH in your example.

[GARTHWILSON]

For newcomers: I have a list of these at viewtopic.php?p=72734#p72734 .

[JimBoyd]

Fleet Forth's LIT no longer falls through to NEXT and it was rewritten so it no longer has the functionality of PUSH or PUT , which made the combined size of LIT and CLIT smaller. For those new to Forth, Some Forth's for the Commodore 64 have an address in the kernel, PUSH , where a code word pushes the low byte to the return stack, places the high byte in the accumulator and jumps to PUSH (in these Forths, PUSH is a constant in the assembler). The code at PUSH would push the value onto the data stack. PUT is similar but the value overwrites the current top of stack. An excerpt from the source for Fleet Forth's previous kernel.

Code: Select all

   LABEL PUSH
   DEX  DEX
   LABEL PUT
   1 ,X STA  PLA  0 ,X STA
   LABEL NEXT

Fleet Forth has AYPUSH , which takes the low byte in the accumulator and the high byte in the Y-register and pushes that value onto the data stack. AYPUT is similar but the value overwrites the current top of stack. An excerpt from the source for Fleet Forth's current kernel.

Code: Select all

   LABEL APUSH
   0 # LDY
   LABEL AYPUSH
   DEX  DEX
   LABEL AYPUT
   1 ,X STY  0 ,X STA
   NEXT JMP

This excerpt is from the source for Fleet Forth's (FIND) , so both sets of operations were supported in the previous kernel. With the changes to Fleet Forth's kernel, I've tried to remove the dependencies on PUSH and PUT . Some primitives were relatively easy to change without increasing the code size.

Code: Select all

CODE UD/MOD  ( UD1 U1 -- U2 UD2 )
   DEX  DEX
   2 ,X LDA  N 2+ STA  0 ,X STA
   3 ,X LDA  N 3 + STA  1 ,X STA
   2 ,X STY  3 ,X STY
   ' UM/MOD @ 6 + JSR
   1 ,X LDA  PHA        \ swapped these
   0 ,X LDA  PHA        \ two lines
   N 2+ LDA  0 ,X STA
   N 3 + LDA  1 ,X STA
   ' UM/MOD @ 6 + JSR
   ' R> @ JMP  END-CODE

I swapped the order the bytes were pushed to the return stack and replaced the PLA and jump to PUSH with a jump to the body of R> . I did the same thing with ROLL .

Code: Select all

CODE ROLL
   0 ,X LDA
   POP.JMP 0= BRAN
   XSAVE STX  .A ASL  TAY
   XSAVE ADC
   // POP.JMP  0< BRAN
   TAX  INX  INX
   1 ,X LDA  PHA  0 ,X LDA  PHA
   BEGIN
      $FF ,X LDA  1 ,X STA
      DEX  DEY
   0= UNTIL
   ' R> @ 2+ JMP  END-CODE

By the way, POP.JMP is a label in the header-less word TRAVERSE .

Code: Select all

NH
CODE TRAVERSE  ( ADR1 DIR -- ADR2 )
   BEGIN
      CLC
      0 ,X LDA 2 ,X ADC 2 ,X STA
      1 ,X LDA 3 ,X ADC 3 ,X STA
      2 X) LDA
   0< UNTIL
   LABEL POP.JMP
   POP JMP  END-CODE

I took a different approach with @ . This is the original source.

Code: Select all

CODE @  ( ADR -- N )
   0 X) LDA  PHA  0 ,X INC
   0= IF  1 ,X INC  THEN
   0 X) LDA
   PUT JMP  END-CODE

And here is the new source.

Code: Select all

CODE @  ( ADR -- N )
   0 ,X LDA  N STA
   1 ,X LDA  N 1+ STA
   LABEL (N)PUT
   N )Y LDA  0 ,X STA  INY
   N )Y LDA  1 ,X STA
   NEXT JMP  END-CODE

Six bytes bigger and slightly faster than the original in the previous kernel; however, BLOCK , which starts out as a code word, is six bytes smaller because it now has a jump to the label (N)PUT in @ .
A few days ago I got an idea that I thought was either clever or mad. I thought what if I replace N in @ and BLOCK with W ?
I could change CONSTANT from this:

Code: Select all

: CONSTANT  ( N -- )
   CREATE , ;CODE  ( -- N )
   LABEL DO.CONSTANT
   2 # LDY
   W )Y LDA  PHA  INY
   W )Y LDA
   PUSH JMP  END-CODE

to this:

Code: Select all

: CONSTANT  ( N -- )
   CREATE , ;CODE  ( -- N )
   LABEL DO.CONSTANT
   2 # LDY
   DEX  DEX
   (W)PUT JMP  END-CODE

This would save 4 bytes and remove one more reference to PUSH . The loop index word, I , is the last place where PUSH is referenced. In the new kernel it is:

Code: Select all

CODE I  ( -- LOOP-INDEX )
   XSAVE STX  TSX  CLC
   $101 ,X LDA  $103 ,X ADC  PHA
   $102 ,X LDA  $104 ,X ADC
   XSAVE LDX
   LABEL PUSH
   TAY  PLA  AYPUSH JMP  END-CODE

Now that CONSTANT doesn't need to jump to PUSH , it can be coded as this:

Code: Select all

CODE I  ( -- LOOP-INDEX )
   XSAVE STX  TSX  CLC
   $101 ,X LDA  $103 ,X ADC  TAY
   $102 ,X LDA  $104 ,X ADC
   XSAVE LDX
   DEX  DEX
   1 ,X STA  0 ,X STY
   NEXT JMP  END-CODE

It's 4 bytes bigger than the version in the new kernel and 5 bytes bigger than the version in the previous kernel, but it's faster.

[Dr Jefyll]

JimBoyd wrote:

I like that the name 2PICK describes what it is doing just as the name DUP>R describes what it is doing.
2PICK performs 2 PICK
DUP>R performs DUP >R

I too like the idea of a compound name that describes what the compound word does. And I wrote a bunch of them years ago, but I had a slightly different naming convention.

Using my convention, it would be 2&PICK that performs 2 PICK and DUP&>R that performs DUP >R. The ampersand has a special significance that's recognized by the reader, making it clear what's going on.

Quote:

If I needed to perform 3 PICK often enough to justify writing a primitive, there would be no verbal confusion with the name

If you have a lot of these compound primitives, it's not unlikely that verbal confusion will crop up. By contrast, the ampersand system is immune to that, although I'll admit it may look a little clunky on the screen -- less terse.


Parenthetically: I recall musing that the ampersand could be more than just a hint to the human. Based on the ampersand, the compiler could quite easily be given an extra level of FINDing capability.

The premise is: the source code might be from some other time or place, and might include a compound word that's not implemented on that particular Forth system. For example, imagine 2&PICK is encountered in the source, but the word isn't found. The name would be scanned and any ampersands replaced by spaces. Then, one by one, we'd FIND the now-unglued constituent pieces! The compiler adapts to the unfamilar compound word.

But the benefit is modest. Moreover, it's perhaps not very Forth-like to grant superpowers to the ampersand. Interesting muse, though!

-- Jeff

[GARTHWILSON]

I've used the _ character for visual separation without Forth treating them as separate words. Early Forth always used the hyphen, probably because the _ was not on the keyboards. The search for & and replacing with a space makes sense, if the need arises.

Hmmm... I just had a thought, and looked at the IBM437 character set I use, and character $FF also displays as a blank, so maybe I could have Forth words that have a non-breaking space in them. It could be confusing though, LOL.

[JimBoyd]

After rewriting Fleet Forth's CONSTANT I started thinking about 2CONSTANT . In Fleet Forth, 2CONSTANT is a CREATE DOES> word. For just 9 more bytes, it can be a CREATE ;CODE word.
Here is the source for 2CONSTANT .

Code: Select all

: 2CONSTANT  ( D -- )
   CREATE , , 
   DOES>     ( -- D )
      2@ ;

And here is the source for a CREATE ;CODE version.

Code: Select all

: 2CONSTANT  ( D -- )
   CREATE
      , ,
   ;CODE     ( -- D )
      DEX  DEX
      4 # LDY
      W )Y LDA  0 ,X STA  INY
      W )Y LDA  1 ,X STA
      DO.CONSTANT JMP  END-CODE

DO.CONSTANT is a metacompiler label in the source for CONSTANT .

Code: Select all

: CONSTANT  ( N -- )
   CREATE , ;CODE  ( -- N )
   LABEL DO.CONSTANT
   2 # LDY
   DEX  DEX
   (W)PUT JMP  END-CODE
: VALUE  ( N -- )
   CONSTANT  ;CODE  ( -- N )
   DO.CONSTANT JMP
   END-CODE

I just don't know if 2CONSTANT would be used often enough to justify the change. I haven't found a single instance of a double constant in my own code.

[JimBoyd]

I'm so used to using >FORTH when I want to run high level Forth in a primitive that I overlooked a case where it was not necessary.
Here is the source for Fleet Forth's EXECUTE .

Code: Select all

CODE EXECUTE  ( ADR -- )
   0 ,X LDA  1 ,X LDY
   INX  INX
   LABEL (EXECUTE)
   W STA  W 1+ STY
   0 # LDY
   W 1- JMP  END-CODE

Because the Y-register needs to be set back to zero, it is two bytes larger than a version which does not use it. EXECUTE is defined like this because R/W has two places where it branches six bytes into the body of EXECUTE to the code following the metacompiler label (EXECUTE) . The Accumulator and Y-register hold the low and high bytes respectively of the word to execute (a pair of deferred words) without returning to R/W.

The word (T&S) is defined in the system loader. It is smaller as a code word than as a high level word.

Code: Select all

CODE (T&S)  ( ADR BLK# -- S/T ADR S T D DSI )
   DRB LDY  DPT ,Y LDA
   0< IF
      >FORTH  T&S81 EXIT
      >ASSEM -2 ALLOT
   THEN
   >FORTH  T&S41 ;
' (T&S) IS T&S

This extends T&S so it supports blocks on the Commodore 1581 drive as well as the 1541 and 1571.
Each place where I've used >FORTH only needs to execute one word then exit, and not a longer high level Forth thread. I can use Fleet Forth's EXECUTE just as I did in R/W. The destination address for JMP is six bytes into the body of EXECUTE .

Code: Select all

CODE (T&S)  ( ADR BLK# -- S/T ADR S T D DSI )
   DRB LDY  DPT ,Y LDA
   0< IF
      ' T&S81 SPLIT SWAP
      # LDA  # LDY
      ' EXECUTE @ 6 + JMP
   THEN
   ' T&S41 SPLIT SWAP
   # LDA  # LDY
   ' EXECUTE @ 6 + JMP
   END-CODE
' (T&S) IS T&S

The SWAP after SPLIT is personal preference. I like to load the Accumulator before the Y-register if they hold two bytes of a 16 bit value. SWAP could be left off and this line:
# LDA # LDY
would be:
# LDY # LDA

This version of (T&S) is the same size but faster.
This is what the disassembly looks like:

Code: Select all

(T&S)
 16015  2252    LDY ' DRB >BODY
 16018 10000 ,Y LDA ' DPT >BODY
 16021 16030    BPL
 16023    55  # LDA
 16025    62  # LDY
 16027  3873    JMP ' EXECUTE >BODY 6 +
 16030   234  # LDA
 16032    39  # LDY
 16034  3873    JMP ' EXECUTE >BODY 6 +
22 

Commodore 64 drives start at device 8 and go up from there. My setup (a simulation on VICE) has three disk drives. Device 10, the third drive, is a 1581. In the drives property table DPT , that would be entry 2, so this line sets device 10 to a Commodore 1581 drive for block access.

Code: Select all

$83 DPT 2+ C!

To summarize: With Fleet Forth's version of EXECUTE , when a word which isn't a primitive needs to be effectively branched to, it is more efficient to use EXECUTE than >FORTH .

[JimBoyd]

Dr Jefyll wrote:

Parenthetically: I recall musing that the ampersand could be more than just a hint to the human. Based on the ampersand, the compiler could quite easily be given an extra level of FINDing capability.

The premise is: the source code might be from some other time or place, and might include a compound word that's not implemented on that particular Forth system. For example, imagine 2&PICK is encountered in the source, but the word isn't found. The name would be scanned and any ampersands replaced by spaces. Then, one by one, we'd FIND the now-unglued constituent pieces! The compiler adapts to the unfamilar compound word.

But the benefit is modest. Moreover, it's perhaps not very Forth-like to grant superpowers to the ampersand. Interesting muse, though!

-- Jeff

Interesting muse, indeed! I did think of a case where granting the ampersand special powers might not be such a good idea. Some Forths have the word T&S to map a block to the initial track and sector for that block. Suppose Forth source with T&S is loaded on a system without this word. This system does; however, have two unrelated words, T and S .

[JimBoyd]

Fleet Forth has the following control flow manipulation words:

Code: Select all

CS-DUP
CS-DROP
CS-SWAP
CS-ROT

as well as a pair of words to transfer control flow data to and from the auxiliary stack.
These four were chosen over AnsForth's CS-PICK and CS-ROLL because they are code words without bodies. They are immediate aliases for the following.

Code: Select all

2DUP
2DROP
2SWAP
2ROT

The inclusion of CS-DROP allows defining a word such as AFT without knowing the number of cells used for control flow data. Drop the control flow data for a backward branch and the branch is not compiled. Drop the control flow data for a forward branch and the new word could crash the system. On the Forth-83 systems I've seen, a BRANCH to address zero is compiled because >MARK is usually defined as the following (when it doesn't add the compiler security data)

Code: Select all

: >MARK  ( -- ADDR )
   HERE 0 , ;

and IF , for example, is defined with >MARK .

Code: Select all

: IF  ( flag -- )
      ( -- sys )  \ compiling
   COMPILE ?BRANCH
   >MARK <possible compiler security data> ; IMMEDIATE

The Forth-83 Standard states:

Code: Select all

>MARK        -- addr                       C,83   "forward-mark"
     Used at the source of a forward branch.  Typically used
     after either BRANCH or ?BRANCH .  Compiles space in the
     dictionary for a branch address which will later be resolved
     by >RESOLVE .

so >MARK could even have this definition.

Code: Select all

: >MARK  ( -- ADDR )
   HERE  2 ALLOT ;

The following will compile successfully. Depending on how >MARK is defined, it may crash at run time.

Code: Select all

: CRASH
   FALSE
   IF  CS-DROP ;

This trivial example reveals a potential problem. Trying to implement tricky control flow mechanisms and not quite getting it right, or being careless with existing control flow structures, such as trying multiple uses of AFT in a FOR NEXT loop could also cause the compilation of a branch to a non valid address.
Why does >MARK comma a zero in the dictionary on some systems? It's a place holder, obviously. Why zero?
I'm going to try the following with the next build of Fleet Forth's kernel.

Code: Select all

NH
CREATE BAD.BRANCH
]  TRUE ABORT" BAD BRANCH"  [
: >MARK  ( -- ADR 1 )
   HERE 1  BAD.BRANCH , ;

NH (no header) is a metacompiler word which causes the next target word to be headerless. The name can be found while metacompiling, but will not be in the target system. The 1 in this definition of >MARK is because Fleet Forth compiler security is handled by the words >MARK >RESOLVE <MARK and <RESOLVE to keep it minimal so it stays out of the way of the programmer as much as possible. BAD.BRANCH is just a code field which, like all variables, points to its body. The body is just a fragment of threaded code which aborts every time with the message "BAD BRANCH", although any meaningful message could be used.
This is the address >MARK will compile rather than zero. The error isn't caught at compile time, but it is at run time.
The Forth-83 Standard does not specify what is to be compiled for the place holder. It's an extra one to two dozen bytes, depending on the length of the error message. There is no additional overhead and no extra restrictions. This may be a worthwhile addition to any Forth-83 Standard system meant to be used by more than just the author of said system, especially if it's used by someone who likes to experiment in Forth.

[JimBoyd]

I presented the code for a primitive version of CO .
As I was looking at the source for Fleet Forth's subroutine, (>FORTH) , I realized how similar it is to the primitive version of CO . They both swap the top address on the return stack with the address in IP with one difference. Since the JSR instruction saves the return address-1, (>FORTH) adds one to the return stack address before storing it in IP . A little rearranging of the code for (>FORTH) from this

Code: Select all

SUBR (>FORTH)  ( -- )
   CLC
   PLA  1 # ADC  N STA
   PLA  0 # ADC  TAY
   IP 1+ LDA  PHA
   IP    LDA  PHA
   N LDA
   IP    STA
   IP 1+ STY
   NEXT JMP  END-CODE

to this

Code: Select all

SUBR (>FORTH)  ( -- )
   CLC
   PLA  1 # ADC  TAY
   PLA  0 # ADC  N STA
   IP 1+ LDA  PHA
   IP    LDA  PHA
   N LDA
   IP STY
   IP 1+ STA
   NEXT JMP  END-CODE

and I can shorten it without making it slower since EXIT falls through to NEXT , the address interpreter.

Code: Select all

SUBR (>FORTH)  ( -- )
   CLC
   PLA  1 # ADC  TAY
   PLA  0 # ADC
   LABEL (CO)
   N STA
   IP 1+ LDA  PHA
   IP    LDA  PHA
   N LDA
   IP STY
   ' EXIT @ 4 + JMP
   END-CODE

I've also place a metacompiler label just before N STA .
I can now shorten CO from this:

Code: Select all

// CO  --  COROUTINES
CODE CO  (  R: ADR1 -- ADR2 )
         ( IP: ADR2 -- ADR1 )
   PLA  TAY  PLA  N STA
   IP 1+ LDA  PHA
   IP    LDA  PHA
   IP STY  N LDA
   ' EXIT @ 4 + JMP
   END-CODE

to this:

Code: Select all

// CO  --  COROUTINES
CODE CO  (  R: ADR1 -- ADR2 )
         ( IP: ADR2 -- ADR1 )
   PLA  TAY  PLA
   (CO) JMP  END-CODE

I haven't tested this yet, I saw this last night and it was getting late.
I realize it looks strange to assemble a JSR to a subroutine which jumps to NEXT rather than returning. It's the only way to get the address to store into IP to start high level Forth.
This technique is also used by Fleet Forth's COLD and WARM start routines to begin high level Forth.

I also realized that if the pair JSR RTS used the actual return address, I wouldn't even need the subroutine (>FORTH) , just the primitive version of CO. >FORTH need not have been this:

Code: Select all

ASSEMBLER
: >FORTH  ( -- )
   ?EXEC
   (>FORTH) JSR
   [ FORTH ]
   CURRENT @ CONTEXT !
   ] ; IMMEDIATE

It could have been this:

Code: Select all

ASSEMBLER
: >FORTH  ( -- )
   ?EXEC
   [ ' CO @ ] LITERAL JSR
   [ FORTH ]
   CURRENT @ CONTEXT !
   ] ; IMMEDIATE

[JimBoyd]

I came across the word NUF? in an article from around 1986. It has similar functionality to Fleet Forth's DONE? . Here is how NUF? would be defined in Fleet Forth.

Code: Select all

: NUF?  ( -- F )
   ?KEY DUP 0EXIT
   DROP
   KEY 3 = ;

Compared to Fleet Forth's DONE?

Code: Select all

: DONE?  ( -- F )
   ?KEY DUP 0EXIT
   3 = ?DUP ?EXIT
   KEY 3 = ;

NUF? is three cells smaller and it works a little differently. The number 3 is the Petscii code returned by the C64's RUN/STOP key.
If no key was pressed, DONE? exits returning a false flag.
If the RUN/STOP key was pressed, DONE? exits returning a true flag.
If any other key was pressed, DONE? waits for a key press. It returns a true flag if the RUN/STOP key is pressed. For any other key, it returns a false flag.

If no key was pressed, NUF? also exits returning a false flag.
If any key was pressed, it doesn't matter if it was the RUN/STOP key, NUF? waits for a key press. It returns a true flag if the RUN/STOP key is pressed. For any other key, it returns a false flag.

[JimBoyd]

I will discuss Fleet Forth's control flow words built around the branch primitives BRANCH and ?BRANCH which use the following words to mark and resolve an address.

Code: Select all

<MARK ... <RESOLVE
>MARK ... >RESOLVE

BRANCH is followed by an inline address. It always branches to this address. ?BRANCH is also followed by an inline address. If the top element of the data stack is zero, It will branch to this address. If not, it will increment IP , Forth's instruction pointer, past this inline address.
Fleet Forth's control flow words are like building blocks. Other than the DO LOOPs, there are six fundamental control flow words.

Code: Select all

BEGIN
AGAIN
UNTIL
IF
AHEAD
THEN

BEGIN marks the target of a backward branch which is resolved by AGAIN or UNTIL . AGAIN compiles BRANCH and UNTIL compiles ?BRANCH . AGAIN and UNTIL resolve the address placed on the stack by BEGIN or any other word which uses <MARK .
IF and AHEAD are for forward branches and leave an address to be patched by THEN. IF compiles ?BRANCH and AHEAD compiles BRANCH. THEN resolves the address from a single IF , a single AHEAD or any word which uses >MARK .
Here are the control flow structures possible with these six words.

Code: Select all

   BEGIN ... AGAIN
   BEGIN ... UNTIL
   IF ... THEN
   AHEAD ... THEN

If a branch word which branches on true is added, there would be two more fundamental control flow words.

Code: Select all

NIF
NUNTIL

or something similar. The prospective names are irrelevant for this post. There would be two more control flow structures.

Code: Select all

   BEGIN ... NUNTIL
   NIF ... THEN

Fairly simple and seemingly limited; however, these six words plus immediate versions of DUP DROP SWAP and ROT for the control flow stack can be used to build all the other control flow words. These control flow stack manipulators are CS-DUP CS-DROP CS-SWAP and CS-ROT . Since there is compiler security (a single number on top of the address), each element of the control flow stack is a double number. Fleet Forth's control flow stack is the data stack, which means the control flow stack manipulators are aliases. They have no bodies of their own, each one's code field points to the body of the word it is aliasing.
CS-DUP is an alias for 2DUP
CS-DROP is an alias for 2DROP
CS-SWAP is an alias for 2SWAP
CS-ROT is an alias for 2ROT

The other control flow words can be built from these fundamental control flow words.
WHILE is just IF CS-SWAP

Code: Select all

: WHILE  ( CS1 -- CS2 CS1 )
   [COMPILE] IF  [COMPILE] CS-SWAP ; IMMEDIATE

In Fleet Forth it's defined like this.

Code: Select all

: WHILE  ( CS1 -- CS2 CS1 )
   [COMPILE] IF  2SWAP ; IMMEDIATE

REPEAT is AGAIN THEN

Code: Select all

: REPEAT  ( CS2 CS1 -- )
   [COMPILE] AGAIN  [COMPILE] THEN ; IMMEDIATE

Code: Select all

   BEGIN      ( begin.cs )
      
   WHILE      ( if.cs begin.cs )
   
   AGAIN      ( if.cs ) \ BEGIN was resolved
   
   THEN       ( -- ) \ IF (within WHILE) was resolved

REPEAT combines AGAIN and THEN in a single word. Multiple WHILEs can be in a BEGIN loop, but each one needs resolved by a THEN . It wasn't until after Fleet Forth's WHILE and REPEAT were implemented that I found I had inadvertently achieved Ansi compliance with their implementation. Sometimes conforming to multiple standards just happens.

ELSE is just AHEAD CS-SWAP THEN

Code: Select all

: ELSE  ( CS1 -- CS2 )
   [COMPILE] AHEAD [COMPILE] CS-SWAP [COMPILE] THEN ; IMMEDIATE

Or as it's defined in Fleet Forth.

Code: Select all

: ELSE  ( CS1 -- CS2 )
   [COMPILE] AHEAD  2SWAP  [COMPILE] THEN ; IMMEDIATE

ELIF is IF CS-SWAP THEN

Code: Select all

: ELIF  ( CS1 -- CS2 )
   [COMPILE] IF  2SWAP  [COMPILE] THEN ; IMMEDIATE

In Fleet Forth two bytes are saved by defining ELIF as this.

Code: Select all

: ELIF  ( CS1 -- CS2 )
   [COMPILE] WHILE  [COMPILE] THEN ; IMMEDIATE

Code: Select all

   IF     ( if.cs )
   
   ELSE   ( ahead.cs ) \ IF was resolved
   
   THEN   ( -- ) \ AHEAD (within ELSE) was resolved

When the auxiliary stack is loaded, there are two more control flow stack manipulation words.
CS>A moves control flow data to the auxiliary stack.
A>CS moves control flow data from the auxiliary stack.

I recently read an article about Forth control structures in the July 1986 issue of Dr Dobbs Journal. The article was "A Forth Standards Proposal: Extended Control Structures" by George W Shaw II. The author sites what he believes are five shortcomings in Forth's control structures. I find his proposed solution overly complex.
The first three shortcomings concern LEAVE . To paraphrase the author: The standard control structures can't handle multiple LEAVEs without retesting the exit condition, nor the loop termination separately from LEAVE , nor can LEAVE exit through multiple levels of DO LOOPs.
One of the author's proposed extensions.

Code: Select all

   DO  IF  LEAVES  ... LOOP  THEN

Apparently, LEAVES has a built in THEN and the THEN after LOOP resolves the branch from LEAVES .

The Forth-83 Standard LEAVE can't do this; however, the Standard IF along with UNLOOP AHEAD and an auxiliary stack can.

Code: Select all

   DO  IF  UNLOOP AHEAD CS>A  THEN ... LOOP  A>CS THEN

or without AHEAD

Code: Select all

   DO  IF  UNLOOP  ELSE CS>A  THEN ... LOOP  A>CS THEN

Fleet Forth's BLOCK branches out of a ?DO LOOP .

Code: Select all

CODE BLOCK  ( BLK -- ADR )
   DEY
   BLK/BUF STY
   ' MRU >BODY    LDA  W    STA
   ' MRU >BODY 1+ LDA  W 1+ STA
   6 # LDY
   W )Y LDA  0 ,X CMP
   0= IF
      INY  W )Y LDA  1 ,X CMP
      0= IF
         INY  (W)PUT JMP
      THEN
   THEN
   >FORTH
   #BUF 1+ 2
   ?DO
      DUP I >BT @ =
      IF
         DROP I UNLOOP
         AHEAD CS>A
      THEN
   LOOP
      LRU 2+ 2+ @
      IF
         LRU 2@ 0 B/BUF R/W
         LRU 2+ 2+ OFF
      THEN
      BLK/BUF C@
      IF
         LRU ON
         LRU 2+ @ OVER 1 B/BUF R/W
      THEN
      LRU ! #BUF
   A>CS THEN
   DUP >BT MRU 6 CMOVE
   MRU 1 >BT ROT 6 * CMOVE>
   MRU 2+ @ ;

Here is an explanation for what it is doing.

Code: Select all

CODE BLOCK  ( BLK -- ADR )
   DEY           \ store $FF in zero page location BLK/BUF.
                 \ BUFFER's cfa points to the following.
   BLK/BUF STY   \ BUFFER will store a zero at BLK/BUF.
   
   if the requested block is the most recently used,
   replace the block number with the buffer address for that block
   ends with a jump to an address which jumps to NEXT.
   if the requested block is not the most recently used
   >FORTH  \ transition to high level Forth.
   #BUF 1+ 2
   ?DO
      search buffer table for matching block number.
      if it's found, drop the block number
      and branch out of the loop with the index.
      IF
         DROP I UNLOOP
         AHEAD CS>A  \ save control flow data to the auxiliary stack.
      THEN
   LOOP
      it's not in the buffer table.
      save the least recently used block to mass storage.
      BLK/BUF C@  \ is this BLOCK or BUFFER?
      if this is block, read in the requested block.
      LRU ! #BUF  \ store block number in the table
                  \ at the entry for the least recently used block.
                  \ and place the address for this entry on the stack.
   A>CS THEN      \ resolve the branch from the loop.
   the stack now has the number for the table entry
   with the desired block.
   move that entry to the top of the buffer table
   and slide the others down.
   place the buffer address of that block on the data stack.
   ;

As for simply exiting a word from within a DO LOOP nested within another DO LOOP

Code: Select all

   DO
      <DO-SOMETHING>
      DO
         <DO-SOMETHING> <TEST>
         IF
            UNLOOP UNLOOP EXIT
         THEN
         <DO-SOMETHING>
      LOOP
      <DO-SOMETHING>
   LOOP

As for branching out of a nested BEGIN loop

Code: Select all

   BEGIN
      <DO-SOMETHING>
      BEGIN
         <DO-SOMETHING> <TEST0>
      IF CS>A
         <DO-SOMETHING> <TEST1>
      UNTIL
      <DO-SOMETHING> <TEST2>
   UNTIL
   <DO-SOMETHING>
   A>CS THEN
   <IF-BRANCHES-HERE>

The last two shortcomings sited are that the standard control structures can't handle multiple WHILE exits separately from each other or from UNTIL without retesting the exit condition.
This is not an issue with the WHILE from Fleet Forth and the Ansi Standard.

Code: Select all

   BEGIN
      <DO-SOMETHING> <TEST0>
   WHILE
      <DO-SOMETHING> <TEST1>
   WHILE
      <DO-SOMETHING> <TEST2>
   WHILE
      <DO-SOMETHING>
   UNTIL
   <UNTIL-EXIT-FROM-LOOP> EXIT
   THEN
   <LAST-WHILE> EXIT
   THEN
   <SECOND-WHILE> EXIT
   THEN
   <FIRST-WHILE> ;

Although Fleet Forth's assembler uses reverse polish notation and control flow similar to Ragsdale's assembler, it is not based on his assembler.
The control flow words for Fleet Forth's assembler are modeled on the high level Forth control flow words presented here. The control flow data is also two items, an address and a security code. The security codes used for the assembler control flow words are different.
Fleet Forth's control flow words, like the Ansi Standard control flow words, are the blocks upon which other control flow words can be built. This is, in my opinion, a more elegant solution than the one presented by George W. Shaw II.

[JimBoyd]

JimBoyd wrote:

Want to see something scary? With Fleet Forth I can do this.

Code: Select all

0 >R CR .S CR .AS R> CR . CR 
EMPTY 
EMPTY 
0 
 OK

With the new interpreter, this no longer works in Fleet Forth. I did mention it was not portable.

[JimBoyd]

I just noticed that Tali Forth doesn't transfer the stack pointer to the X-register to update the loop index in place. It pulls the index off the return stack. I tried that method with Fleet Forth's (LOOP) and (+LOOP) . The resulting code was smaller and somewhat faster, especially for (+LOOP) .
Fleet Forth's DO LOOPs store three parameters on the return stack based on a suggestion from GARTHWILSON. Fleet Forth's previous (LOOP) and (+LOOP) with some details and code removed for clarity.

Code: Select all

CODE (LOOP)
   XSAVE STX  TSX  $101 ,X INC
   0= IF  // BRANCHING OUT OF WORD
   SEC  TYA
   LABEL I.HI+A
   $102 ,X ADC  $102 ,X STA
   VS IF  // BRANCHING OUT OF WORD
   XSAVE LDX
   LABEL LEAVE.BODY
   PLA  PLA  PLA  PLA
   LABEL EXIT.BODY
   PLA  IP STA   PLA  IP 1+ STA
   CS>A  CS>A
   LABEL NEXT
\ fall through to NEXT

CODE (+LOOP)  ( N -- )
   INX  INX  XSAVE STX
   $0FF ,X LDY  $0FE ,X LDA
   TSX  CLC
   $101 ,X ADC  $101 ,X STA
   TYA  0 # LDY
   I.HI+A JMP
   END-CODE

\ Section of code between ?BRANCH and BRANCH
      A>CS THEN  A>CS THEN  \ Branch from (LOOP) to here
      XSAVE LDX
      LABEL BRANCH.BODY
\ fall through to BRANCH

I did not indent after either occurrence of IF because I am using them to conditionally branch out of (LOOP) and into another primitive.
Here are the new versions of (LOOP) and (+LOOP)

Code: Select all

CODE (LOOP)
   PLA  TAY  INY
   0= IF  // BRANCHING OUT OF WORD \ BRANCH1
   SEC  PLA  0 # ADC
   VS IF  // BRANCHING OUT OF WORD \ BRANCH2 -- compiles BVC
   VS NOT IF                       \         -- compiles BVS
      LABEL  LEAVE.BODY
      PLA  PLA
   THEN
   PLA  PLA
   LABEL EXIT.BODY
   PLA  IP STA   PLA  IP 1+ STA
   CS-SWAP CS>A CS>A
   LABEL NEXT
\ fall through to NEXT

CODE (+LOOP)  ( N -- )
   INX  INX  CLC
   PLA  $FE ,X  ADC  TAY
   PLA  $FF ,X  ADC
   VS IF  CS>A                     \ BRANCH3 -- compiles BVC
   LEAVE.BODY 2+ VS BRAN           \         -- compiles BVS
   END-CODE

\ The section of code between ?BRANCH and BRANCH
      A>CS THEN  A>CS THEN         \ BRANCH2 and BRANCH3 branch to here   
      PHA
      A>CS THEN                    \ BRANCH1 branches to here
      TYA  PHA  0 # LDY
      LABEL BRANCH.BODY
\ fall through to BRANCH

The two PLA instructions which are skipped over are to support LEAVE . This adds four bytes to (LOOP) but eliminates the need to add five bytes to LEAVE .

All comments beginning with a backslash '\' were added to hopefully aid in understanding.

[JimBoyd]

As I mentioned previously, Fleet Forth uses >FORTH to transition from the cold-start routine to high level Forth. Here is the tail end of Fleet Forth's cold start routine.

Code: Select all

   WARM  SPLIT SWAP
      # LDA  $300 STA     \ store address of warm-start routine
      # LDA  $301 STA     \ at $300
   (WARM) JSR
   >FORTH
   EMPTY 0 DRIVE CONFIGURE
   12 SPACES
   [ HERE 18 + >A ]
   ." C64 FLEET FORTH  COPYRIGHT (C) 1995-2022 BY JAMES BOYD "
   [ HERE 1- >A ]
   INITIAL QUIT -;        \ don't compile EXIT
   $D A> C!  $D0D A> !    \ replace some blanks in startup message string with CR.

-; (dash semicolon) works like ; (semicolon) but without compiling EXIT .
This is what is assembled and compiled by the source fragment above.

Code: Select all

 10947   134  # LDA  N 1+
 10949   768    STA
 10952    42  # LDA
 10954   769    STA
 10957 10829    JSR ' BOOTCOLORS >BODY 19 +
 10960  3382    JSR ' (>FORTH) >BODY
 10963 10773 EMPTY
 10965  3293 0
 10967  9935 DRIVE
 10969  9311 CONFIGURE
 10971  3308 CLIT 12 
 10974  6662 SPACES
 10976  7787 (.") C64 FLEET FORTHMMCOPYRIGHT (C) 1995-2022 BY JAMES BOYDM
 11034  2955 INITIAL
 11036  8621 QUIT

I know how Blazin' Forth handles the transition. How do other ITC Forths handle it?