Fleet Forth design considerations

[JimBoyd]

Back near the end of 2020 I presented the source code for Fleet Forth's new (ABORT") , which is so much faster than the old version when there is no error.

Code: Select all

CODE (ABORT")  ( F -- )
   0 ,X LDA,  1 ,X ORA,
   0= IF,
      IP )Y LDA,  SEC,
      IP ADC,  IP STA,
      CS IF,  IP 1+ INC,  THEN,
      POP JMP,
   THEN,
   >FORTH
   WHERE CR R@ S?
   ABORT ;
   -2 ALLOT

The following snippet of code skips Fleet Forth's instruction pointer, IP , over an inline counted string.

Code: Select all

   IP )Y LDA,  SEC,
   IP ADC,  IP STA,
   CS IF,  IP 1+ INC,  THEN,

There are two other words in Fleet Forth which skip over an inline string. They are (.") and (") .

Code: Select all

: (.")  ( -- )
   R> COUNT 2DUP + >R TYPE ;
: (")  ( -- ADR )
   R> DUP COUNT + >R ;

Fleet Forth's kernel can be made smaller by taking the string skipping code out of (ABORT") and placing it in (") .

Code: Select all

: (")  ( -- ADR )
   R@
   >ASSEM
   IP )Y LDA  SEC
   IP ADC  IP STA
   CS IF  IP 1+ INC  THEN
   NEXT JMP  END-CODE
: (.")  ( -- )
   R@ COUNT TYPE
   BRANCH
   [ ' (") >BODY 2+ , ] ; -2 ALLOT

The new (") is six bytes bigger and the new (.") is four bytes smaller.
The newest (ABORT") is twelve bytes smaller for a net savings of ten bytes.

Code: Select all

CODE (ABORT")  ( F -- )
   INX  INX
   $FE ,X LDA  $FF ,X ORA
   ' (") >BODY 4 +  0= BRAN
   >FORTH
   WHERE  CR R> S?
   ABORT ; -2 ALLOT

(ABORT") is still fast. When there is no error, this version of (ABORT") should be two cycles faster. The branch does not cross a page boundary, my metacompiler reports page boundary crossings. I get a print file of the metacompiler messages by typing LOGGER before loading the kernel source.

There is also this code in ?BRANCH

Code: Select all

      LABEL 2.IP.+!
      CLC
      IP LDA  2 # ADC  IP STA
      NEXT CS NOT BRAN
      IP 1+ INC
      NEXT 0= NOT BRAN  // ALWAYS

which skips IP over a cell.
Note: LABEL creates a label in the metacompiler's host vocabulary with the present value of THERE , the target's HERE , as its value. It does not increase the size of the target in any way.
This code fragment, 2.IP.+! can also be used by (IS) , the word compiled by IS , and COMPILE .
The original source.

Code: Select all

: (IS)
   R> DUP 2+ >R @ >BODY ! ;
: COMPILE
   ?COMP R> DUP 2+ >R @ , ;

And the new.

Code: Select all

: (IS)  ( -- )
   R@ @ >BODY !
   LABEL SKIP.CELL
   >ASSEM
   2.IP.+! JMP  END-CODE
: COMPILE
   ?COMP  R@ @ ,  BRANCH
   [ SKIP.CELL , ] ; -2 ALLOT

The new (IS) is three bytes smaller and the new COMPILE is four bytes smaller.

[JimBoyd]

I mentioned in this post that I was going to write an experimental kernel. I've written the experimental kernel and I like it. Here is the source for the following words:
?EXIT 0EXIT ?LEAVE (LOOP) ?BRANCH

Code: Select all

CODE ?EXIT  ( F -- )
   INX  INX
   $FE ,X LDA  $FF ,X ORA
   0= IF CS>A
   0= NOT IF CS>A  END-CODE
CODE 0EXIT  ( F -- )
   INX  INX
   $FE ,X LDA  $FF ,X ORA
   0= NOT IF CS>A
   0= IF CS>A  END-CODE
CODE ?LEAVE  ( F -- )
   INX  INX
   $FE ,X LDA  $FF ,X ORA
   0= IF CS>A
   0= NOT IF CS>A  END-CODE

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
   A>CS A>CS THEN
   LABEL LEAVE.BODY
   PLA  PLA  PLA  PLA
   A>CS A>CS THEN
   A>CS A>CS THEN
   LABEL EXIT.BODY
   PLA  IP STA   PLA  IP 1+ STA
   THEN  THEN  THEN   CS>A  CS>A
   LABEL NEXT
   1 # LDY
   IP )Y LDA  W 1+ STA  DEY
   IP )Y LDA  W    STA  CLC
   IP LDA  2 # ADC  IP STA
   CS NOT IF
      W 1- JMP
   THEN
   IP 1+ INC
   W 1- JMP  END-CODE

CODE ?BRANCH  ( F -- )
   INX  INX
   $FE ,X LDA  $FF ,X ORA
   0= NOT IF
      LABEL 2.IP.+!
      CLC
      IP LDA  2 # ADC  IP STA
      NEXT CS NOT BRAN
      IP 1+ INC
      NEXT 0= NOT BRAN  // ALWAYS
      A>CS THEN  A>CS THEN
      LABEL XBRANCH
      XSAVE LDX
   THEN
   IP )Y LDA  PHA  INY
   IP )Y LDA  IP 1+ STA
   PLA  IP STA
   NEXT 2+ JMP  END-CODE

The label XBRANCH is no longer needed since it is now only used in the phrase XBRANCH 2+ . I will remove it and add a label just under the line with XSAVE LDX . This new label will be BRANCH.BODY . Of course, I'll need to change the two occurrences of XBRANCH 2+ to BRANCH.BODY .

In Fleet Forth, an item of control flow data consists of an address and a security number. The words which supply the address and security number are
>MARK <MARK
the words which use the address and security number are
>RESOLVE <RESOLVE
The control flow security is to make sure that a >MARK is matched with a >RESOLVE and a <MARK is matched with a <RESOLVE . These two conditions are to make sure that branches are properly resolved, avoiding an upcoming system crash. As long as they are met, control flow words can be used in any way the programmer sees fit.

The word CS>A copies one item of control flow data to the auxiliary stack and the word A>CS copies one item of control flow data from the auxiliary stack.
Using the auxiliary stack to temporarily hold the control flow data makes it easier to write branches out of the words ?EXIT 0EXIT and ?LEAVE and into the body of (LOOP) . It also makes it easier to write two branches out of (LOOP) and into the body of ?BRANCH (really into the part that has the code for BRANCH ).

Here is the source for the words BRANCH LEAVE and EXIT , which have no bodies.

Code: Select all

CODE BRANCH  ( -- )
   -2 ALLOT XBRANCH 2+ ,
END-CODE
CODE LEAVE  ( -- )
   -2 ALLOT  LEAVE.BODY ,
END-CODE
CODE EXIT  ( -- )
   -2 ALLOT  EXIT.BODY ,
END-CODE

With the new kernel, EXIT and LEAVE fall through to NEXT because their code is in the body of (LOOP) .
(LOOP) falls through to NEXT when the DO LOOP terminates.

Here is the new source for LIT .

Code: Select all

CODE LIT  ( -- W )
   DEX  DEX
   IP )Y LDA  0 ,X STA  INY
   IP )Y LDA  1 ,X STA
   2.IP.+! JMP  END-CODE

2.IP.+! is a metacompiler label for the address in ?BRANCH which, as the label name implies, adds two to IP .

Here is the new source for CLIT .

Code: Select all

CODE CLIT  ( -- B )
   IP )Y LDA
   IP INC
   0= IF  IP 1+ INC  THEN
   AYPUSH JMP
// SETUP SETS CARRY AS SIDE EFFECT
LABEL SETUP
   .A ASL  N 1- STA
   BEGIN
      0 ,X LDA  N ,Y STA
      INX  INY  N 1- CPY
   0= UNTIL
   0 # LDY
   RTS  END-CODE

Placing the code for SETUP right after CLIT was done as a convenience (or laziness on my part). I could just as well have placed END-CODE after the jump to AYPUSH with HSUBR SETUP (headerless subroutine) used rather than LABEL SETUP .

LIT and CLIT are used in LITERAL .

Code: Select all

: LITERAL  ( N -- )
   DUP SPLIT NIP
   IF  COMPILE LIT , EXIT  THEN
   COMPILE CLIT C, ; IMMEDIATE

I have removed the constants PUSH and PUT from Fleet Forth's assembler. Fleet Forth has AYPUSH to push a cell on the data stack with the low byte in the accumulator and high byte in the Y-register, and the word AYPUT to replace a cell on the data stack. If the high byte were in the accumulator, I would have named them YAPUSH and YAPUT to reflect the (low byte, high byte) order of the 16 bit cell.
It seemed awkward to me to have AYPUSH AYPUT as well as PUSH PUT in the assembler, almost like Fleet Forth's kernel was not a single unified design. With the new kernel, a jump to PUSH and PUT now cost three more clocks cycles, so I got rid of them.
If a code word needs them, the following code fragments can be defined.

Code: Select all

SUBR PUSH  ( -- W )
   TAY  PLA
   AYPUSH JMP
END-CODE

SUBR PUT  ( -- W )
   TAY  PLA
   AYPUT JMP
END-CODE

These are used just like the constants PUSH and PUT in the FIG Forth assembler.

I have a disk of Blazin' Forth utilities ported to Fleet Forth. When I modified the words using PUSH and PUT to use AYPUSH and AYPUT , they were smaller. These words were a more natural fit for AYPUSH and AYPUT than PUSH and PUT .

The experimental kernel was slightly smaller until I saw how I could squeeze a few more cycles out of the code portion of BLOCK and made a few other speed/size trade offs before rebuilding once again. The experimental kernel is now about three bytes bigger than the other one.
I'm going to run a few more tests, maybe look for potential optimizations. My metacompiler reports where a branch crosses a page boundary, I'd like to minimize the occurrence of those. They're not so bad when the branch is not part of a loop, but I really don't like the extra cycle in a loop. As I said, I like this experimental kernel. It is Fleet Forth's new kernel.

[JimBoyd]

In this post I discussed Fleet Forth's WORD .
I think UMIN and 2PICK were the only non-standard words which I didn't define.
UMIN is the unsigned version of MIN .
Fleet Forth's 2PICK has the same stack effect as the phrase '2 PICK'.
Here is Fleet Forth's 2PICK

Code: Select all

CODE 2PICK  ( N1 N2 N3 -- N1 N2 N3 N1 )
   4 ,X LDA  5 ,X LDY
   AYPUSH JMP  END-CODE

Fleet Forth's double number version of PICK is DPICK
As with Mosaic Forth's DPICK , it is zero based and copies the double number whose high cell is the Nth item on the data stack, not counting N. This double number could also be thought of as a pair of single numbers.

Code: Select all

DPICK  ( D WN-1 . . . W0 +N -- D WN-1 . . . W0 D )

Here is another way to look at it. Not counting N, PICK skips the top N numbers on the stack and copies the next one to push onto the stack.
2PICK skips the top number, the next to top number and copies the third number to push onto the stack.
DPICK also skips the top N numbers on the stack but it copies two cells ( a double or a pair of singles ) to push onto the stack.

[BruceRMcF]

In xForth I use THIRD for what you have called 2PICK. FOURTH is what would be 3PICK in that naming system, but I stop at THIRD, so the verbal confusion of FOURTH and FORTH is not an issue.

[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.