6502.org

Posted: **Tue Oct 25, 2022 1:59 am**

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.

Posted: **Wed Nov 02, 2022 10:50 pm**

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.

Posted: **Sun Nov 13, 2022 9:15 pm**

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.

Posted: **Thu Nov 24, 2022 3:05 am**

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?

Posted: **Fri Nov 25, 2022 11:01 pm**

Surely I'm not the only one to write an indirect threaded code (ITC) implementation of Forth on this forum, or am I?

Posted: **Fri Nov 25, 2022 11:03 pm**

Blazin' Forth handles the transition from cold start to high level Forth by storing the address of the Forth thread in IP and jumping to the body of a primitive which would have been in the Forth thread.
If I didn't have >FORTH in Fleet Forth, I would push the address of the Forth thread onto the return stack and jump to the body of EXIT .
Here are three examples showing these techniques.
Using >FORTH to transition to high level Forth thread.

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.

Pushing the address of the Forth thread onto the return stack and jumping to the body of EXIT .

Code: Select all

   LABEL COLD.THREAD
 ] EMPTY 0 DRIVE CONFIGURE
   12 SPACES
   [ HERE 18 + >A ]
   ." C64 FLEET FORTH  COPYRIGHT (C) 1995-2022 BY JAMES BOYD "
   [ HERE 1- >A ]
   INITIAL QUIT  [
   $D A> C!  $D0D A> !    \ replace some blanks in startup message string with CR.

   ...
   WARM  SPLIT SWAP
      # LDA  $300 STA     \ store address of warm-start routine
      # LDA  $301 STA     \ at $300
   (WARM) JSR
   COLD.THREAD SPLIT      \ push address of Forth thread
   # LDA  PHA             \ onto return stack
   # LDA  PHA
   ' EXIT @ JMP
   END-CODE

Storing the address of the Forth thread in IP and jumping to the body of 0

Code: Select all

   LABEL COLD.THREAD
 ] EMPTY DRIVE CONFIGURE  \ zero will already be on data stack
   12 SPACES
   [ HERE 18 + >A ]
   ." C64 FLEET FORTH  COPYRIGHT (C) 1995-2022 BY JAMES BOYD "
   [ HERE 1- >A ]
   INITIAL QUIT  [
   $D A> C!  $D0D A> !    \ replace some blanks in startup message string with CR.

   ...
   WARM  SPLIT SWAP
      # LDA  $300 STA     \ store address of warm-start routine
      # LDA  $301 STA     \ at $300
   (WARM) JSR
   COLD.THREAD SPLIT
   # LDA  IP 1+ STA
   # LDA  IP STA
   ' 0 @ JMP              \ 0 is not a constant in Fleet Forth.
   END-CODE               \ CFA of 0 points to code which
                          \ places a zero on the data stack.

In the first example the compiler security provided by colon and semicolon (or dash semicolon) is available. In the other two examples, it is not.

Posted: **Fri Nov 25, 2022 11:59 pm**

JimBoyd wrote:

Surely I'm not the only one to write an indirect threaded code (ITC) implementation of Forth on this forum, or am I?

I got into Forth on the HP-71 hand-held computer in about 1990, then on the 6502 the next year, starting with a metacompiler my employer bought which compiled basically Forth-83. The metacompiler had lots of deficiencies and bugs, so I modified and extended it heavily. I would like to publish my work on that one as an assembly-language source code, but I would still need to remove some material the metacompiler supplier might be able to claim a copyright on, meaning there would definitely be some work to do on it. It's not a high priority.

Some years after I was heavily into that, I started writing my 65816 Forth from scratch. It has been operational for 25 years, but only one person has used it much, and that was a technician in the Pratt & Whitney turbine-engine plant in Canada. He used it on the Mensch computer of the 1990's with a 65265 microcontroller. I've hardly used this Forth myself, for a couple of reasons. I let it collect dust for a couple of years at a time, then spend a little time further developing it until another big work project comes along, and then it goes back into mothballs for a couple more years or more. It runs two to three times the speed of my '02 Forth at a given clock rate. My only operation of it has been on my workbench computer than has a 65802 on it, meaning it only has access to bank 0, the first 64KB. I've written words for long accesses, but have not had any hardware to prove them on. At the moment, I am very slowly working on a PCB for a new workbench computer with far more of everything—a real 65816, 768 times as much RAM, hopefully 20MHz (or more if I can get it) (which would mean 40-60 times the Forth execution speed of a C64), more I/O of every kind, etc.—and then I can finish up the '816 Forth and publish it. It is intended for all code to run in bank 0 (which I find is plenty), and the rest of memory is for data, all contiguous, so for example you could have a multi-megabyte array with no interruptions for I/O or anything else.

Both my '02 and '816 Forths are ITC. The '816 Forth has hundreds of primitives (ie, words defined in assembly language), far more than the '02 Forth has. Since the '02 doesn't handle 16-bit quantities nearly as efficiently as the '816 does, many of words were just too impractical to have as primitives (ie, defined in assembly language) on the '02. They just take too many instructions, too much memory. The '816 OTOH makes it practical to have far more as primitives. Besides the obvious advantages of more compact code and faster execution, there were many cases on the '816 where it was actually easier to write words as primitives than as secondaries.

Posted: **Sat Nov 26, 2022 1:00 am**

GARTHWILSON wrote:

I would like to publish my work on that one as an assembly-language source code, but I would still need to remove some material the metacompiler supplier might be able to claim a copyright on, meaning there would definitely be some work to do on it. It's not a high priority.

GARTHWILSON wrote:

Both my '02 and '816 Forths are ITC.

I'm not asking you to show any code. I am curious, when your computer goes from the reset/cold start routine to Forth's QUIT loop (or high level Forth which leads to the QUIT loop), is it by one of the three methods I presented or something else?

Would any other implementer of an ITC Forth like to mention which method is used to transition from the reset/cold start routine to high level Forth?

Posted: **Sat Nov 26, 2022 2:37 am**

The reset routine includes loading NEXT into ZP so I can use self-modifying code to eliminate some indirection and make NEXT faster, and putting the PFA of COLD into IP and then jumping to NEXT. COLD sets up some things in Forth, then ends with ABORT, and ABORT ends with QUIT.

I don't have anything called WARM, but I have COLD ask in the LCD, "New/Old/Init Ap?" corresponding to three keys. "New" does the usual thing, re-initializing everything including the dictionary pointer. "Old" leaves the dictionary pointer alone but does all the same stuff about initializing interrupt vectors, alarms, key-repeat speed, the delay before key-repeat starts, and other such things. "Init-Ap" does like "Old" but then also calls the word whose CFA is stored in the INIT-AP variable. These allow a very fast recovery from a crash, since most crashes don't go writing garbage all over memory but are instead the result of some loop exit condition never being met, and I usually realize right away what I did and can fix it immediately.

Posted: **Sat Nov 26, 2022 3:50 am**

I hadn't thought of jumping to NEXT . Scott Ballantyne's Blazin' Forth puts the PFA of the high level part of its cold start routine in IP then jumps to RP!
My Fleet Forth clears the return stack in the low level portion of COLD before calling a few Commodore 64 kernal routines before using >FORTH to transition to high level. The high level portion ends with QUIT . The data stack and auxiliary stack are cleared by a subroutine called by the low level portion of COLD .
Fleet Forth does not have a word called WARM . It is a label used by the metacompiler.
Since Fleet Forth is for the C64, it is loaded from disk. It has one line of BASIC, a BASIC fuse to launch the cold start routine.

Code: Select all

10 SYS XXXX

XXXX is the address of the cold start routine. The address of the warm start routine is stored at address $300 so it will run whenever the RUN/STOP and RESTORE keys are pressed at the same time. This is handy if I accidentally start an infinite loop, for example. The warm start routine leaves the dictionary and block buffers (and their tables) alone. It acts like an ABORT after initializing a few things such as setting base to DECIMAL , turning off multitasking, and storing the indirect jump opcode $6C at W-1.

Posted: **Sat Dec 10, 2022 1:58 am**

Here is a breakdown of Fleet Forth's FORGET . For the sake of clarity, every double slash (used by Fleet Forth for an end of line comment) was converted to a backslash.

Code: Select all

: FORGET  ( -- )
   NAME  CURRENT @ DUP CONTEXT !
   VFIND ?HUH  >LINK

NAME parses the text stream for a blank delimited string and manages the case since Fleet Forth is case insensitive. The string is stored as a counted string at HERE .
The CONTEXT VOCABULARY is set equal to the CURRENT VOCABULARY and VFIND is used to perform the search. VFIND is a primitive without a body with a code field which points one byte into the body of (FIND) . Unlike (FIND) , VFIND will NOT search parent vocabularies. ?HUH aborts with the message "WHAT?" if the name was not found. >LINK takes the CFA of the word and returns the LFA , the link field address, which is the word's first field.

Code: Select all

   LABEL (FORGET)
   SINGLE
   DUP>R FENCE @
   LIT
   LABEL KERNEL-FENCE
   [ 0 , ]  \ WILL BE PATCHED
   UMAX U<
   ABORT" PROTECTED"

The word EMPTY branches to the address at the LABEL (FORGET) . SINGLE switches off multitasking by setting the deferred word PAUSE to the no-op NOOP . A copy of the address is saved to the return stack and tested against FENCE and FORGET's internal fence. If it is less than either, FORGET aborts with the message "PROTECTED".

Code: Select all

   VOC-LINK R@ TRIM
   VOC-LINK @
   BEGIN
      DUP 2- 2- R@ TRIM
      @ ?DUP 0=
   UNTIL

A Fleet Forth VOCABULARY has three cells in its parameter field. The first cell points to the link field of the latest word defined in this VOCABULARY, the second cell points to the parent of this VOCABULARY , and the third cell is part of the VOC-LINK chain of all vocabularies.
The VOC-LINK chain is trimmed to remove all vocabularies which are defined after the forget point, then each of the remaining vocabularies are trimmed to remove all words which are defined after the forget point.

Code: Select all

   R> DUP DP ! [ 'THERE ] LITERAL @
   UMIN [ 'THERE ] LITERAL !

The dictionary pointer DP is set to the forget point and the empty point is set to the lesser of the previous empty point and the forget point.

Code: Select all

\ RESET ANY SYSTEM DEFERRED WORD
\ WITH CFA ABOVE HERE
   HERE [ END.FORGET ] LITERAL
\ BRANCH INTO IORESET
   BRANCH [ (IORESET) , ] -;

Each deferred word in the kernel has its PFA and default vector stored in a table of deferred words. This last section of FORGET pushes HERE and the ending address of the table onto the data stack and branches to IORESET . Any deferred word with a vector defined after the new HERE will be reset to its default vector.
This is the last line of source for Fleet Forth's kernel. It patches FORGET's internal fence, protecting all kernel words.

Code: Select all

HERE KERNEL-FENCE !

To be clear, the last thing the metacompiler does is execute FINISH-FORTH , but that's in block #1.
Fleet Forth's FORGET does exactly what I want and it works great; however, if I've forgotten anything or if anyone has a suggestion for an improvement, please let me know.

Code: Select all

SEE FORGET
FORGET
 10666  7700 NAME
 10668  2603 CURRENT
 10670  3549 @
 10672  5002 DUP
 10674  2589 CONTEXT
 10676  3587 !
 10678  7718 VFIND
 10680  8033 ?HUH
 10682  6627 >LINK
 10684  8616 SINGLE
 10686  4753 DUP>R
 10688  2530 FENCE
 10690  3549 @
 10692  2497 LIT 12017 
 10696  5926 UMAX
 10698  4390 U<
 10700  7825 (ABORT") PROTECTED
 10712  2674 VOC-LINK
 10714  4726 R@
 10716  8824 TRIM
 10718  2674 VOC-LINK
 10720  3549 @
 10722  5002 DUP
 10724  4789 2-
 10726  4789 2-
 10728  4726 R@
 10730  8824 TRIM
 10732  3549 @
 10734  4981 ?DUP
 10736  4597 0=
 10738  2259 ?BRANCH 10722 
 10742  4658 R>
 10744  5002 DUP
 10746  2846 DP
 10748  3587 !
 10750  2497 LIT 2077 
 10754  3549 @
 10756  5905 UMIN
 10758  2497 LIT 2077 
 10762  3587 !
 10764  7357 HERE
 10766  2497 LIT 3054 
 10770  2489 BRANCH 9703  ' IORESET >BODY 6 +
108 
 OK

SEE uses the current BASE , which was DECIMAL , to display numbers.

Posted: **Sun Dec 11, 2022 9:20 pm**

There is an interesting property of Fleet Forth's DO LOOP's. Detailed information is provided on Fleet Forth's DO LOOP's here.
Consider the word used to remove trailing blanks from the count of a string's address count pair, -TRAILING

Code: Select all

: -TRAILING  ( ADR CNT1 -- ADR CNT2 )
   DUP 0
   ?DO
      2DUP + 1- C@ BL <> ?LEAVE
      1-
   LOOP ;

Here is what gets compiled:

Code: Select all

SEE -TRAILING
-TRAILING
  6748  5002 DUP
  6750  3293 0
  6752  2358 (?DO) 6776 
  6756  5284 2DUP
  6758  4884 +
  6760  4815 1-
  6762  3576 C@
  6764  2709 BL
  6766  4474 <>
  6768  2128 ?LEAVE
  6770  4815 1-
  6772  2149 (LOOP) 6756 
  6776  2469 EXIT
30 
 OK

If the count is zero (?DO) will branch to the address which is stored in the cell which follows. This address (address 6776) is also present when (DO) is compiled. It is the address which is pushed on the return stack for any LEAVE or ?LEAVE . It is also the address used by (LOOP) if the DO LOOP runs to completion. If a different address is stored in the cell after (?DO) , the EXIT at address 6776 will not be reached.
Here is the word SPACE

Code: Select all

: SPACE  ( -- )  BL EMIT ;

Simple and to the point, it emits one space character.

Code: Select all

SEE SPACE
SPACE
  6661  2709 BL
  6663  2931 EMIT
  6665  2469 EXIT
6 
 OK

Notice that address 6665 in SPACE also has the word EXIT . If the address after the (?DO) in -TRAILING is replaced with this address, -TRAILING will work exactly as before. The only difference is the EXIT at the end of -TRAILING will not be reached. Not by (?DO) if the count of the string is zero, not by ?LEAVE if there are no more blanks in the string, and not by (LOOP) if the loop runs to completion. They will all branch to address 6665.
The following modification to the source will result in that change.

Code: Select all

: -TRAILING  ( ADR CNT1 -- ADR CNT2 )
   DUP 0
   ?DO
      2DUP + 1- C@ BL <> ?LEAVE
      1-
   LOOP -;
   ' SPACE >BODY 4 +  HERE 2- @ 2- !

Dash semicolon -; finishes the definition without compiling EXIT . The phrase
' SPACE >BODY 4 +
returns the address where there is an EXIT , address 6665 in this case.
HERE 2- @ 2-
backs up to the address of the branch used by (LOOP) and follows it then backs up to the address of the branch used by (?DO) .
Finally, store ! changes the address to 6665.

Code: Select all

SEE -TRAILING
-TRAILING
  6748  5002 DUP
  6750  3293 0
  6752  2358 (?DO) 6665 
  6756  5284 2DUP
  6758  4884 +
  6760  4815 1-
  6762  3576 C@
  6764  2709 BL
  6766  4474 <>
  6768  2128 ?LEAVE
  6770  4815 1-
  6772  2149 (LOOP) 6756 
28 
 OK

Okay, a minor savings of two bytes; however, there is no cost in performance. Here is another example. Fleet Forth's ID. TYPE and QTYPE . QTYPE is used by LIST since a BLOCK might not contain a screen of source. It could be virtual memory or some other type of data.

Code: Select all

: ID.  ( NFA -- )
   1+
   BEGIN
      COUNT $7F 2DUP AND QEMIT >
   UNTIL
   DROP PAUSE ;
: TYPE  ( ADR CNT -- )
   0
   ?DO
      COUNT EMIT
   LOOP
   DROP PAUSE ;
: QTYPE  ( ADR CNT -- )
   0
   ?DO
      COUNT QEMIT
   LOOP
   DROP PAUSE ;

The following modification shaves six bytes off of TYPE and six bytes off of QTYPE .

Code: Select all

: ID.  ( NFA -- )
   1+
   BEGIN
      COUNT $7F 2DUP AND QEMIT >
   UNTIL
   [ HERE >A ]
   DROP PAUSE ;
: TYPE  ( ADR CNT -- )
   0
   ?DO
      COUNT EMIT
   LOOP -;
   A@ HERE 2- @ 2- !
: QTYPE  ( ADR CNT -- )
   0
   ?DO
      COUNT QEMIT
   LOOP -;
   A> HERE 2- @ 2- !

Since this technique is the epitome of highly non portable code, I will most likely confine its use to Fleet Forth's kernel and system loader.
To be clear, this type of DO LOOP places three parameters on the return stack: The address in the cell following (?DO) or (DO) , the loop limit, and the loop index (actually modified versions of the limit and index).
The loop words (?DO) LEAVE ?LEAVE (LOOP) and (+LOOP) all leave the loop by way of this address. (?DO) uses that address to avoid the loop entirely if the limit and initial index are identical.
If this type of DO LOOP were the norm, it would be interesting to see what other creative use could be made of it.

Posted: **Mon Dec 12, 2022 1:15 am**

JimBoyd wrote:

Dash semicolon -; finishes the definition without compiling EXIT .

Nice! Do other Forths use that too, ie, is it somewhat common practice, or just your own?

(I would call that hyphen though, as a dash is longer ( — versus - ). On typewriters, since they were usually monospaced, we used to do a dash with two hyphens in a row.)

Quote:

If this type of DO LOOP were the norm, it would be interesting to see what other creative use could be made of it.

...as is always the case with Forth. I continue to be surprised, now after 30+ years, by creative and useful techniques that can be done in Forth, things that definitely don't initially meet the eye and aren't in books except maybe "Thinking Forth" (which I really should re-read every few years but don't).

Posted: **Tue Dec 13, 2022 1:00 am**

GARTHWILSON wrote:

JimBoyd wrote:

Dash semicolon -; finishes the definition without compiling EXIT .

Nice! Do other Forths use that too, ie, is it somewhat common practice, or just your own?

I saw it somewhere but I don't remember where. I'm reasonably certain it was -; but it could have been ;- . I'm going with -; because I think it looks better. As for how common it is, I don't know.

Posted: **Sun Jan 08, 2023 10:39 pm**

Fleet Forth now has a slightly smaller version of NUMBER? with the same functionality.
This is the previous version.

Code: Select all

: NUMBER?  ( ADR -- D FLAG )
   RB
   DUP 1+ C@ ASCII # - DUP 3 U<
   IF
      BASE.TABLE + C@ BASE !
      1+ DUP
   THEN
   DROP
   DPL ON  0 0 ROT
   1+
   COUNT ASCII - <> DUP>R +
   COUNT DIGIT NIP >R
   2-
   BEGIN
      CONVERT DUP C@ VALID?
   WHILE
      DPL OFF
      DUP 1+ C@ VALID?
   UNTIL
   THEN
   C@ BL =  R> AND
   R>  ?EXIT
   >R DNEGATE R> ;

It takes the address of a counted string and returns a double number and a flag. The flag is true if conversion was successful.

Code: Select all

DIGIT  ( CHAR -- N TRUE )
       ( CHAR -- CHAR FALSE )

CONVERT  ( D1 ADR1 -- D2 ADR2 )

CONVERT returns the address of the first unconvertible character. This is exactly what I want. It takes the address one byte prior to the first character it will attempt to convert, so I replaced CONVERT with the phrase 1- CONVERT and bumped the address up one byte.
Instead of just testing the first character to see if it is a valid digit, also make it the first digit by placing a copy of the flag to the return stack and replacing
0 0 ROT with AND 0 ROT
Since the loop starts with 1- CONVERT , I was able to make the rest of the loop more efficient.

Code: Select all

: NUMBER?  ( ADR -- D FLAG )
   RB
   1+ DUP C@ ASCII # - DUP 3 U<
   IF
      BASE.TABLE + C@ BASE !
      COUNT
   THEN
   DROP
   DPL ON
   COUNT ASCII - <> DUP>R +
   COUNT DIGIT DUP>R  AND 0
   ROT
   BEGIN
      1- CONVERT COUNT VALID?
   WHILE
      DPL OFF
      DUP C@ VALID?
   UNTIL
   THEN
   1- C@ BL =  R> AND
   R>  ?EXIT
   >R DNEGATE R> ;

This version of NUMBER? accepts the same numeric strings as valid, but it is 8 bytes smaller.

6502.org

Fleet Forth design considerations

Re: Fleet Forth design considerations

Re: Fleet Forth design considerations

Re: Fleet Forth design considerations

Re: Fleet Forth design considerations

Re: Fleet Forth design considerations

Re: Fleet Forth design considerations

Re: Fleet Forth design considerations

Re: Fleet Forth design considerations

Re: Fleet Forth design considerations

Re: Fleet Forth design considerations

Re: Fleet Forth design considerations

Re: Fleet Forth design considerations

Re: Fleet Forth design considerations

Re: Fleet Forth design considerations

Re: Fleet Forth design considerations