6502.org • Fleet Forth design considerations - Page 7

Page 7 of 25

Re: Fleet Forth design considerations

Posted: Tue Jun 02, 2020 9:12 pm

by JimBoyd

From the first version of Fleet Forth onward I've implemented what I think is the best EMPTY. I say this because I've seen what is a really bad implementation of EMPTY ( ahem, Blazin' Forth ).
When Fleet Forth cold starts after being loaded from disk, some of the user variables, up to and including DP the dictionary pointer, are initialized with default values from what some would call the 'boot area'. The first three user variable locations are reserved for multitasking.

Code: Select all

// FORTH SOURCE - BOOT AREA
HEX
LABEL BOOT
//  SET CURRENT COLORS FOR TARGET
HOST D020    C@ 0F AND TARGET C,
HOST D021    C@ 0F AND TARGET C,
HOST  286    C@ 0F AND TARGET C,
LABEL USER.DATA
// SYSTEM USER AREA BOOTUP VALUES
USER.AREA ,           // ENTRY
  0 ,                 // WAKE?
  0 ,                 // TOS
1FF ,                 // RP0
 7E ,                 // SP0
 1E ,                 // SPLIM
// AUXILIARY STACK
AUX.BASE AUX.SIZE + , // AP0
AUX.BASE ,            // APLIM
HERE TIS 'THERE
  0 ,                 // DP

This initial value for DP is used by EMPTY. This value CAN change. FORGET will set it to the minimum of its current address and HERE so this 'empty point' is never greater than the top of the dictionary. Saving the system as a new Forth will change the address of this location to the current value of DP.
EMPTY fetches this address from the boot area and sets FENCE equal to it then branches into FORGET to let FORGET do the heavy lifting of trimming back the VOC-LINK and vocabularies. 'THERE is a metacompiler label holding the address of this location.

Code: Select all

: EMPTY  ( -- )
   FORTH DEFINITIONS
   [ 'THERE ] LITERAL @
   DUP FENCE !
// BRANCH INTO FORGET
   BRANCH [ (FORGET) , ]
   ; -2 ALLOT

: FORGET  ( -- )
   SINGLE
   NAME  CURRENT @ DUP CONTEXT !
   VFIND 0= ?HUH  >LINK
   LABEL (FORGET)        \ EMPTY branches to this location
   DUP>R FENCE @ U<  R@
   LIT
   LABEL KERNEL-FENCE
   [ 0 , ]  // WILL BE PATCHED
   // REST OF FORGET

The above is from the source the metacompiler uses to build a new kernel.
The new kernel is built in virtual memory ( the C64's REU ) and LABELs are compiled in host memory ( that's how I can have labels in the middle of a definition ).

Re: Fleet Forth design considerations

Posted: Wed Jun 03, 2020 9:46 pm

by JimBoyd

I made a correction to Fleet Forth's EMPTY . FORGET turns off multitasking in case some of the tasks are forgotten. EMPTY did not turn off multitasking ( though it should have). I've moved SINGLE, the word that turns multitasking off, in FORGET to the point where EMPTY branches into the body of FORGET.

Code: Select all

: EMPTY  ( -- )
   FORTH DEFINITIONS
   [ 'THERE ] LITERAL @
   DUP FENCE !
// BRANCH INTO FORGET
   BRANCH [ (FORGET) , ]
   ; -2 ALLOT

: FORGET  ( -- )
   NAME  CURRENT @ DUP CONTEXT !
   VFIND 0= ?HUH  >LINK
   LABEL (FORGET)        \ EMPTY branches to this location
   SINGLE
   DUP>R FENCE @ U<  R@
   LIT
   LABEL KERNEL-FENCE
   [ 0 , ]  // WILL BE PATCHED
   // REST OF FORGET

Re: Fleet Forth design considerations

Posted: Fri Jun 05, 2020 8:19 pm

by JimBoyd

Normally, when a deferred word's vector ( the word that a deferred word executes ) is forgotten, that deferred word points to a word that no longer exists. In Fleet Forth, there is a table of all the deferred words in the kernel as well as their default vectors. when FORGET is executed ( or EMPTY or COLD ), the table is checked from beginning to end to see if any of the deferred words had a vector that was forgotten. If a deferred word has a vector that was forgotten, the deferred word is reset to its default vector.
This works great for deferred words in the Forth kernel, but it's no help for deferred words added to the system. I'm thinking about adding a variable, DEFER-LINK , to the kernel. Each deferred word defined outside the kernel would have an extra cell which would be part of a chain much like vocabularies are with VOC-LINK. Some new functionality would be added to FORGET. It would trim the DEFER-LINK, like it does with VOC-LINK, and each deferred word in the link would be checked to see if its vector is defined after what will be the new HERE. Any such deferred words would be reset to the word -SET.
I'm trying to decide if the protection against a possible crash from forgetting a deferred word's vector is worth an extra two bytes per deferred word and some extra code in the kernel. Any advice?

Re: Fleet Forth design considerations

Posted: Sun Jun 07, 2020 9:26 pm

by JimBoyd

Since I'm using VICE to simulate a Commodore 64, I copied everything to a new folder and built a new kernel and system with 'forget protection' for deferred words. Now I can compare the two versions of Fleet Forth. Each deferred word ( not the ones in the kernel ) is now two bytes bigger. The kernel is 52 bytes bigger: 46 more bytes in FORGET, 4 more bytes in DEFER, 4 bytes for the headerless variable DEFER-LINK, and 2 bytes saved by removing the deferred word RR/W from the table of kernel deferred words and making it the first deferred word added to the DEFER-LINK chain.
The table for kernel deferred words uses 4 bytes per deferred word: 2 bytes for the address of the body of the deferred word and 2 bytes for the address of the deferred word's default vector.
(RR/W) is not defined in the kernel since someone without a ram expander would not want the overhead of that word. The deferred word RR/W is in the kernel because it is needed by R/W, the block read/write word. Since (RR/W) is not defined in the kernel, the default vector of RR/W is the word -SET , therefore removing it from the table and making it the first of the deferred words in the DEFER-LINK chain does not change what happens when RR/W's vector is forgotten.
Now, except for all but one of the kernel deferred words, when a deferred word's vector is forgotten, the deferred word's vector is reset to -SET , the vector it had when it was created. -SET aborts with a message that the deferred word is 'NOT SET'. If the deferred word is interpreted, the actual message will be 'EXECUTE NOT SET'. If compiled into another word, the message will be '<name of deferred word> NOT SET'.
Here is the new DEFER.

Code: Select all

HEX
: -SET  ( -- )
   WHERE
   R@ 2- @ >NAME CR RON ID.
   ." _ NOT SET" ABORT ; -2 ALLOT
: DEFER  ( -- )
   CREATE ['] -SET ,
   DEFER-LINK ADD
   ;CODE
   2 # LDY,
   W )Y LDA,  PHA,  INY,  W )Y LDA,
   0 # LDY,
   W 1+ STA,  PLA,  W STA,
   W 1- JMP,
END-CODE

That underscore character in the definition of -SET is because the C64 character would not print ( or print.dump, in the case of VICE ). It turns reverse video off.

And here is the new FORGET.

Code: Select all

: FORGET  ( -- )
   NAME  CURRENT @ DUP CONTEXT !
   VFIND 0= ?HUH  >LINK
   LABEL (FORGET)
   SINGLE
   DUP>R FENCE @ U<  R@
   LIT
   LABEL KERNEL-FENCE
   [ 0 , ]  // WILL BE PATCHED
   U< OR
   ABORT" PROTECTED"
   VOC-LINK R@ TRIM
   VOC-LINK @
   BEGIN
      DUP 2- 2- R@ TRIM
      @ ?DUP 0=
   UNTIL
   DEFER-LINK R@ TRIM
   DEFER-LINK @
   BEGIN
      DUP 2- @ R@ U< 0=
      IF
         ['] -SET OVER 2- !
      THEN
      @ ?DUP 0=
   UNTIL
   R> DUP DP ! [ 'THERE ] LITERAL @
   UMIN [ 'THERE ] LITERAL !
// RESET ANY DEFERRED WORD WITH
// CFA ABOVE HERE
   HERE [ END.FORGET ] LITERAL
// BRANCH INTO IORESET
   BRANCH [ (IORESET) , ]
   ; -2 ALLOT

And the 'helper' words.

Code: Select all

: ADD  ( ADR -- )
   HERE OVER @ ,
   SWAP! ;

: TRIM  ( ADR LIMIT -- )
   OVER
   BEGIN
      @ 2DUP SWAP U<
   UNTIL
   NIP
   SWAP! ;

@Garth: When I saw SWAP! I thought that was cool so I added it to my kernel ( both of the current ones ).

Re: Fleet Forth design considerations

Posted: Sun Jun 28, 2020 8:06 pm

by JimBoyd

whartung wrote:

You want to share any details about your meta compiler? How it works, what challenges you ran in to, things like that?

I'm sorry if my explanations were less detailed than you would like. Since I originally wrote a metacompiler about a quarter of a century ago, writing this one has not felt like blazing new territory for me with the strong impressions of obstacles overcome. It has been more like following a faint trail down a side alley of memory lane.
If there are specifics that you would like to know more about, don't hesitate to ask. Given something specific to focus on, I'll do my best to piece together what I had to do to arrive at my current solution.

Re: Fleet Forth design considerations

Posted: Sat Jul 04, 2020 8:29 pm

by JimBoyd

I found out by way of a typo that my zero overhead data stack underflow protection for the Forth words DROP , 2DROP , (DO) , (?DO) and anything that jumps to POP ( DROP ) or POPTWO ( 2DROP ) didn't quite work out. If a code word pops several items off of an empty stack, the error handling can cause problems because WHERE needs a stable stack to work properly and some of the words in WHERE will clip the stack underflow. I meant to type DOPEN which takes no parameters and returns none. It opens the currently selected drive for BLOCK access. I typed OPEN by mistake and it takes five parameters and returns one. This deep of a stack underflow caused problems ( one of my constants used in WHERE got reset to a different value because ! ( store ) stored to the wrong address ). I decided that if my Forth was going to have any data stack underflow protection, instead of clipping the underflow it should ABORT but I needed the stack to be in a good state for the error handling.
Here is the source for ?STACK , the word that aborts when the stack under or overflows.

Code: Select all

HEX
: ?STACK  ( -- )
   DEPTH 0<
   ABORT" STACK EMPTY!"
   SP@ SPLIM @ U<
   ABORT" STACK FULL!" ;
' ?STACK DO.?STACK !

Depth returns a negative one ( TRUE ) if there was an underflow.
My solution to that problem was to redefine DEPTH . DEPTH is a code word so it doesn't access the data stack until it places a result on it. The new DEPTH reports the number of items on the stack as before, so long as the stack hasn't had an underflow. If there is an underflow, DEPTH clears the stack then places a negative one ( TRUE ) on the stack.
Here is the code:

Code: Select all

HEX
CODE DEPTH  ( NX -- NX N )
   TXA,
   ' SP0 >BODY C@ # LDY,
   CLC,  UP )Y SBC,
   .A ROR,  7F # EOR,
   APUSH 0< NOT BRAN,
   UP )Y LDA,  TAX,
   PUSH.TRUE 0< NOT BRAN,
END-CODE

I realize that this code looks a little strange with clearing the carry before a subtraction with the operands reversed and then toggling all the bits but the high bit after the roll to the right, but I needed to be able to branch on positive to APUSH and still fall through if the number of items on the stack was less than zero.
After rewriting DEPTH , the error handling was easy.
Here is the new code for 2DROP .

Code: Select all

HEX
CODE 2DROP ( N1 N2 -- )
   HERE TIS POPTWO
   INX,  INX,
   HERE TIS POP
   INX,  INX,
   NEXT 0< NOT BRAN,
   LABEL RUNG1
   // WILL BE PATCHED
   0 JSR,           // >FORTH
   LABEL DO.?STACK
   0 ,              // ?STACK
END-CODE

The JSR to zero will be patched when (>FORTH) is defined so it is a JSR to (>FORTH). The zero following is a place holder for ?STACK to be patched in.
Here is the disassembly.

Code: Select all

2DROP
  889         INX
  88A         INX
  88B         INX
  88C         INX
  88D  843 ^^ BPL NEXT
  88F  BED    JSR
  892 1F02 ?STACK
  894 FUTURE EXPANSION
B

SEE had a little trouble with this due to the forward JSR. $0BED is the address of the subroutine at (>FORTH) which causes a transition to high level Forth. Since there is an underflow, ?STACK will abort.
Neither (>FORTH) nor do.colon affect or are affected by the data stack. The new DEPTH doesn't pop anything from the data stack. It doesn't push anything on a data stack that had an underflow before fixing the underflow.

(DO) and (?DO) were modified to branch to the address of (>FORTH) JSR, ( JSR (>FORTH) ) if the branch elsewhere falls through.

Code: Select all

HEX
CODE (DO)  ( N1 N2 -- )
   INY,
   IP )Y LDA,  PHA,  DEY,
   IP )Y LDA,  PHA,  CLC,
   3 ,X LDA,  80 # ADC,  PHA,
   3 ,X STA,  2 ,X LDA,  PHA,  SEC,
   0 ,X LDA,  2 ,X SBC,  TAY,
   1 ,X LDA,  3 ,X SBC,  PHA,
   TYA,  PHA,
   INX,  INX,  INX,  INX,
   IP.INC2 0< NOT BRAN,
   LABEL RUNG2
   RUNG1   0< BRAN,
END-CODE

CODE (?DO)
   0 ,X LDA,  2 ,X CMP,
   ' (DO) @ 0= NOT BRAN,
   1 ,X LDA,  3 ,X CMP,
   ' (DO) @ 0= NOT BRAN,
   INX,  INX,  INX,  INX,
   XBRANCH 2+ 0< NOT BRAN,
   RUNG2      0< BRAN,
END-CODE

If (?DO) causes an underflow, it branches to the address labeled RUNG2 and from there branches to the label RUNG1. If (DO) causes a stack underflow, it branches to the address labeled RUNG1. RUNG1 is the address of the transition to high level and the stack check.
Here is a test run to show that the new DEPTH works as expected.

Code: Select all

 OK
CR DEPTH .S >IN OFF 
    0 
    0     1 
    0     1     2 
    0     1     2     3 
    0     1     2     3     4 
    0     1     2     3     4     5 
    0     1     2     3     4     5     6 
    0     1     2     3     4     5     6     7 
    0     1     2     3     4     5     6     7     8 
    0     1     2     3     4     5     6     7     8     9 
    0     1     2     3     4     5     6     7     8     9    10 
    0     1     2     3     4     5     6     7     8     9    10 
   11 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23    24 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23    24    25 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23    24    25    26 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23    24    25    26    27 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23    24    25    26    27    28 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23    24    25    26    27    28    29 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23    24    25    26    27    28    29    30 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23    24    25    26    27    28    29    30    31 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23    24    25    26    27    28    29    30    31    32 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23    24    25    26    27    28    29    30    31    32 
   33 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23    24    25    26    27    28    29    30    31    32 
   33    34 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23    24    25    26    27    28    29    30    31    32 
   33    34    35 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23    24    25    26    27    28    29    30    31    32 
   33    34    35    36 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23    24    25    26    27    28    29    30    31    32 
   33    34    35    36    37 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23    24    25    26    27    28    29    30    31    32 
   33    34    35    36    37    38 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23    24    25    26    27    28    29    30    31    32 
   33    34    35    36    37    38    39 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23    24    25    26    27    28    29    30    31    32 
   33    34    35    36    37    38    39    40 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23    24    25    26    27    28    29    30    31    32 
   33    34    35    36    37    38    39    40    41 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23    24    25    26    27    28    29    30    31    32 
   33    34    35    36    37    38    39    40    41    42 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23    24    25    26    27    28    29    30    31    32 
   33    34    35    36    37    38    39    40    41    42    43 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23    24    25    26    27    28    29    30    31    32 
   33    34    35    36    37    38    39    40    41    42    43 
   44 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23    24    25    26    27    28    29    30    31    32 
   33    34    35    36    37    38    39    40    41    42    43 
   44    45 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23    24    25    26    27    28    29    30    31    32 
   33    34    35    36    37    38    39    40    41    42    43 
   44    45    46 
    0     1     2     3     4     5     6     7     8     9    10 
   11    12    13    14    15    16    17    18    19    20    21 
   22    23    24    25    26    27    28    29    30    31    32 
   33    34    35    36    37    38    39    40    41    42    43 
   44    45    46    47 
CR DEPTH .S >IN OFF
            ^^^
STACK FULL!
CODE TEST  OK
INX, INX, >FORTH DEPTH ;  OK
CODE TEST2  OK
INX, INX, INX, INX, >FORTH DEPTH ;  OK
CODE TEST3  OK
INX, INX, INX, INX, INX, INX,  OK
>FORTH DEPTH ;  OK
TEST  OK
.S 65535  OK
TEST2  OK
.S 65535  OK
SP!  OK
TEST2  OK
.S 65535  OK
SP!  OK
TEST3  OK
.S 65535  OK
CONSOLE

Re: Fleet Forth design considerations

Posted: Sat Jul 04, 2020 8:49 pm

by GARTHWILSON

That's an interesting idea to use BPL NEXT as a zero-overhead underflow check!

Do you really get much need for it though? I just have INTERPRETER check for empty stack, which means the check doesn't happen while compiled code is running, only after it comes back to the command line. There has been little need for anything more. I have a few bytes of unused ZP space for protection under the data stack so an underflow of a cell or two won't overwrite anything I need.

Re: Fleet Forth design considerations

Posted: Sun Jul 05, 2020 8:10 pm

by JimBoyd

Since the 6510 does not have the branch always ( BRA ) instruction, 2drop would have ended with a jump to NEXT. Replacing the JMP with a branch to NEXT if positive followed by the JSR and two bytes of high level Forth code only adds four bytes to 2DROP. Nothing is added to DROP since it has no body, just a code field that points two bytes into the body of 2DROP.
The jump at the end of (DO) is replaced with two back to back complementary branches for a cost there of one byte. The jump at the end of (?DO) is replaced with two more back to back complementary branches for a cost of another byte. A total of six bytes extra code and no run time penalty when there is no underflow.
Not all words that remove stack items have the underflow test. Words that move parameters from the stack to the scratchpad area N do not test for underflow ( it would have added to the run time of SETUP ).
Do I need underflow protection for only some primitives? Maybe not. Since the interpreter checks the stack immediately after executing a word, the example with the typo would have been resolved with just the improvement to DEPTH .
I hope others will be interested in Fleet Forth, so is the underflow protection worth keeping for only six extra bytes total? Given that not all primitives which remove items from the data stack are protected, I'm not sure.

The underflow protection seemed like a good idea at the time. Now that I think about it and consider that other people may be using Fleet Forth, It ( the underflow protection ) could encourage bad habits since not all primitives are protected and no primitive has overflow protection.

Re: Fleet Forth design considerations

Posted: Sun Jul 05, 2020 8:15 pm

by barrym95838

To my inexperienced eye, the current cost-to-benefit ratio seems to lean in favor of keeping the protection.

Re: Fleet Forth design considerations

Posted: Sun Jul 05, 2020 10:06 pm

by JimBoyd

Thank you.
I was wondering if anyone had an opinion, one way or the other, about the FORGET protection for DEFERred words ( resetting a deferred word's vector to -SET if it's vector will be forgotten. It resulted in a kernel that was fifty two bytes larger and adds two more bytes per deferred word.

Re: Fleet Forth design considerations

Posted: Tue Jul 07, 2020 12:23 am

by JimBoyd

The latest version of the Fleet Forth kernel has a new definition for # .
The original high level version had a body that was thirty three bytes. The next version had a transition to assembly and back to high level Forth. It was four bytes smaller.

Code: Select all

HEX
: #  ( D1 -- D2 )
   BASE @ UD/MOD ROT
   >ASSEM
   0 ,X LDA,  0A # CMP,
   CS IF,
      6 # ADC,
   THEN,
   30 # ADC,  0 ,X STA,
   >FORTH
   HOLD ;

The latest version has a transition to assembly but no transition back to high level Forth.

Code: Select all

HEX
: #  ( D1 -- D2 )
   BASE @ UD/MOD ROT
   >ASSEM
   0 ,X LDA,  0A # CMP,
   CS IF,
      6 # ADC,
   THEN,
   30 # ADC,  0 ,X STA,
   SEC,
   ' HLD >BODY C@ # LDY,
   DEX,  DEX,
   UP )Y LDA,  1 # SBC,  UP )Y STA,
   0 ,X STA,  INY,
   UP )Y LDA,  0 # SBC,  UP )Y STA,
   1 ,X STA,
   2 ,X LDA,  0 X) STA,
   POPTWO JMP,  END-CODE

Although the body of this version is bigger, the overall increase in kernel size is only one byte.

Re: Fleet Forth design considerations

Posted: Wed Jul 08, 2020 8:53 pm

by JimBoyd

Since Fleet Forth is an ITC Forth, here is the source for # , HOLD , and C!

Code: Select all

HEX
: #  ( D1 -- D2 )
   BASE @ UD/MOD ROT
   >ASSEM
   0 ,X LDA,  0A # CMP,
   CS IF,
      6 # ADC,
   THEN,
   30 # ADC,  0 ,X STA,
LABEL HOLD.BODY
   SEC,
   ' HLD >BODY C@ # LDY,
   DEX,  DEX,
   UP )Y LDA,  1 # SBC,  UP )Y STA,
   0 ,X STA,  INY,
   UP )Y LDA,  0 # SBC,  UP )Y STA,
   1 ,X STA,
LABEL C!.BODY
   2 ,X LDA,  0 X) STA,
   POPTWO JMP,  END-CODE
CODE HOLD  ( C -- )
   -2 ALLOT HOLD.BODY , END-CODE
CODE C!   ( C ADR -- )
   -2 ALLOT C!.BODY , END-CODE

HOLD has a code field that points into the body of # and C! also has a code field that points into # ( and HOLD ).
I don't know if there is a name for this technique.

Re: Fleet Forth design considerations

Posted: Fri Jul 24, 2020 11:32 pm

by JimBoyd

At one time I had considered making some of the primitives in Fleet Forth headerless. Words like LIT , CLIT , (DO) , (?DO) etc.
This is the story of why I decided against that.
Fleet Forth has, in the system loader, a word, WITH-WORDS , that allows performing actions on each word in the CONTEXT vocabulary. Kind of like ANSForth's TRAVERSE-WORDLIST but different. WITH-WORDS works like this:

Code: Select all

: #WORDS  ( -- U )  \ leave the number of words in the CONTEXT vocabulary on the data stack.
   0                \ perform everything before WITH-WORDS only once.
   WITH-WORDS       \ place name field on data stack
   DROP 1+ ;        \ do everything from WITH-WORDS to first EXIT encountered 
                    \ for each word in the CONTEXT vocabulary.

After looking at ANSForth's TRAVERSE-WORDLIST, I was thinking that it might be nice to be able to execute something after WITH-WORDS finishes with the vocabulary so #WORDS would display the total number of words in the CONTEXT vocabulary instead of leaving the result on the stack. I suppose I could write this:

Code: Select all

: #WORDS  ( -- U )  \ leave the number of words in the CONTEXT vocabulary on the data stack.
   0                \ perform everything before WITH-WORDS only once.
   WITH-WORDS       \ place name field on data stack
   DROP 1+ ;        \ do everything from WITH-WORDS to first EXIT encountered 
                    \ for each word in the CONTEXT vocabulary.

: #WORDS  ( -- )  \ redefine #WORDS
   #WORDS U. ;

I could even give the first #WORDS a different name like (#WORDS) . After reading M.L.Gassanenko's article, I started kicking around the idea of placing the address of part of a colon definition on the return stack. When WITH-WORDS finishes with the vocabulary and exits, it will exit to the address of the threaded code on the return stack:

Code: Select all

: NOW
   COMPILE LIT  >MARK  COMPILE >R ; IMMEDIATE
: LATER
   COMPILE EXIT  >RESOLVE ; IMMEDIATE

: #WORDS  ( -- )
   NOW 0 WITH-WORDS
   DROP 1+
   LATER U. ;

The word NOW can be anywhere before WITH-WORDS:

Code: Select all

: #WORDS  ( -- )
   0 NOW WITH-WORDS
   DROP 1+
   LATER U. ;

#WORD's body looks like this:

Code: Select all

SEE #WORDS
 598A  BD6 0
 598C  829 LIT 599A
 5990 1215 >R
 5992 42DB WITH-WORDS
 5994  89B DROP
 5996 12A1 1+
 5998  963 EXIT
10
 OK
599A :DIS
 599A 1C92 U.
 599C  963 EXIT
4
 OK

I don't know if NOW and LATER will be useful. Maybe this experiment will lead to other interesting ideas. I know I could not have experimented with this if I had made LIT , among others, headerless.
[That color change is easier on the eyes! @Garth. Thanks for the example.]

Re: Fleet Forth design considerations

Posted: Fri Aug 07, 2020 10:08 pm

by JimBoyd

I made a version of Fleet Forth with TYPE defined as a colon definition to see the difference in speed and size.
The new TYPE is about 20% slower than the old version. Words that use TYPE , such as DUMP and WORDS , are about 5% slower.
The new kernel is 31 bytes smaller and the system as a whole is over 160 bytes smaller. This is due to having fewer DEFERred words that need revectored for printing and logging in the system loader.
WORDS is still fast enough on a one Megahertz C64 (WORDS will display 589 words in 11.9 seconds) that WITH-WORDS still needs to have DONE? in the definition to allow suspending the output. The same goes for DUMP (when displaying more than will fit on the C64 screen).

Re: Fleet Forth design considerations

Posted: Fri Aug 07, 2020 11:00 pm

by JimBoyd

JimBoyd wrote:

I was wondering if anyone had an opinion, one way or the other, about the FORGET protection for DEFERred words ( resetting a deferred word's vector to -SET if it's vector will be forgotten. It resulted in a kernel that was fifty two bytes larger and adds two more bytes per deferred word.

I'm considering removing the FORGET protection for deferred words. The deferred words in the kernel are already protected and I haven't needed the protection for anything else. If someone else needs the protection, the following could be defined:

Code: Select all

VARIABLE DEFER-LINK
DEFER-LINK OFF      // NOT REALLY NEEDED IN FLEET FORTH
: DEFER-TRIM  ( -- )
   DEFER-LINK HERE TRIM
   DEFER-LINK @
   BEGIN
      DUP 2- @ HERE U< 0=
      IF
         ['] -SET OVER 2- !
      THEN
      @ ?DUP 0=
   UNTIL ;

DEFER , FORGET , and EMPTY could be redefined:

Code: Select all

: DEFER  ( -- )
   DEFER
   DEFER-LINK ADD ;
: FORGET  ( -- )
   FORGET
   DEFER-TRIM ;
: EMPTY  ( -- )
   EMPTY
   DEFER-TRIM ;

COLD could be redefined as well, but If the system is saved, the original COLD will be executed upon start-up. The original COLD will execute the original EMPTY. One way around this is to set INITIAL to DEFER-TRIM

Code: Select all

' DEFER-TRIM IS INITIAL

Instead of redefining FORGET and EMPTY , another possibility is to execute DEFER-TRIM from the console after each use of FORGET or EMPTY or after a COLD start.
Maybe instead of doing all this, it would be best to just be careful with deferred words.
Any opinions?