Fleet Forth design considerations

[JimBoyd]

The Fleet Forth kernel has all of the words from the Forth-83 standard required word set, the double number word set, and a few others.

Code: Select all

2CONSTANT 2VARIABLE
DMIN      DMAX      D=        D2/       D0=       D<        DU<
+LOOP     LOOP      ?DO       DO        WHILE     REPEAT    UNTIL
AGAIN     BEGIN     ELSE      ELIF      THEN      AHEAD     IF
<RESOLVE  >RESOLVE  <MARK     >MARK     FORTH-83            (
.(        UPDATE    FLUSH     FSAVE     FREEZE    [COMPILE] [']
ABORT"    ."        ,"        ?CHAR     LOAD      LINELOAD  COLD
EMPTY     FORGET    DOPEN     (DOS")    DCLOSE    CMD       (DR/W)
SR/W      CBP       BCMD      DOUT      T&S       D&S       DISKS
SSD       DSD       DIN       DTYPE     DEMIT     ?DISK     (?DISK)
?D        .DERR     (?D)      IOERR     SIOERR    >LF#      >LF#.B
DR#       DRIVE     SARRAY    FORTH     DEFINITIONS         
VOCABULARY          VARIABLE  DOES>     USER      CONSTANT  DEFER
-SET      ID.       :         CREATE    FREE      ;         ?CSP
?PAIRS    ABORT     QUIT      INTERPRET NUMBER    CONVERT   '
NAME      FIND      VFIND     QUERY     LITERAL   ?STACK    COMPILE
?FIND     ?COMP     (ABORT")  WHERE     WHERE?    WORD      (CHAR)
'STREAM   IORESET   $?        U.R       U.        .R        .
S>D       UD.R      UD.       (UD.)     D.R       D.        (D.)
#S        #         SIGN      HOLD      #>        <#        SPACES
SPACE     (;CODE)   ?CR       CR        [         ]         IMMEDIATE
SMUDGE    -TRAILING LATEST    C,        ,         ALLOT     PAD
HERE      KEY       SINGLE    (VALID?)  HEX       DECIMAL   PAGE
(")       (.")      CONFIGURE (IS)      L>NAME    N>LINK    BODY>
>BODY     LINK>     >LINK     NAME>     >NAME     EMPTY-BUFFERS
SAVE-BUFFERS        ERASE     BUFFER    BLOCK     >BT       R/W
MRU       LRU       #BUF      (MSAVE)   (OPEN)    (CHKOUT)  (CHKIN)
2SWAP     2ROT      BOOTCOLORS          ROFF      RON       UMAX
UMIN      MAX       MIN       */        MOD       *         NIP
/         TUCK      /MOD      */MOD     UD/MOD    UM/MOD    M*
UM*       UNDER+    COUNT     2DROP     DROP      OVER      2DUP
-ROT      ?DUP      DUP       PICK      2OVER     SWAP      ROT
TOGGLE    +!        2!        2@        C!        !         C@
@         2*        2/        D+        +         D-        -
1-        2-        1+        2+        DUP>R     R@        2R>
2>R       R>        >R        DIGIT     <>        >         <
U<        =         0<        0>        0<>       0=        OFF
ON        NOT       XOR       OR        AND       DABS      DNEGATE
ABS       NEGATE    J         I         UNLOOP    RP!       SP!
SP@       CLRCHN    CLOSE     FILL      SKIP      SCAN      DEPTH
>HERE     CMOVE     MOVE      CMOVE>    (?KEY)    EXECUTE   TRAVERSE
(EXPECT)  (QTYPE)   (TYPE)    (EMIT)    >LOWER    RR/W      DR/W
VALID?    ERR       INITIAL   QTYPE     TYPE      EMIT      EXPECT
?KEY      PAUSE     COLS      #USER     TIB       LIMIT     T/F
B/BUF     C/L       BL        3         2         VIEW      #LINE
#OUT      #TIB      SCR       CSP       CURRENT   CONTEXT   SPAN
STATE     >IN       BLK       VOC-LINK  FENCE     HLD       DPL
BASE      DP        SPMAX     RP0       SP0       1         0
FALSE     TRUE      (FIND)    NOOP      ACLOSE    ?BRANCH   BRANCH
(>ASSEM)  (>FORTH)  (+LOOP)   ROLL      ?EXIT     0EXIT     EXIT
?LEAVE    LEAVE     (?DO)     (LOOP)    (DO)      CLIT      LIT

Cheers,
Jim

[JimBoyd]

Fleet Forth header and vocabulary structure.
The header structure in Fleet Forth consists of an optional view field, a link field, a name field, a code field, and a parameter field. The view field is created when the variable VIEW is true. Kernel words do not have a view field. The link field of a word points to the link field of the previous word in the vocabulary. The first word in a vocabulary, any vocabulary, has its link field set to zero. The first byte of the name field has the most significant bit set high. The next two bits in the first byte are the immediate bit and the smudge bit. the least significant five bits hold the length of the name for a maximum name length of 31. each character in the name has its most significant bit set to zero except the last. The last character in the name has its most significant bit set to one. having the MSB's of the first and last bytes in the name set to one facilitates traversal of the name field by the word TRAVERSE. This means that Fleet Forth is case insensitive.

Code: Select all

Structure of a word in the dictionary ( ALLOT shown )
+---------------+  Optional view field for user defined words
|               |     no system word has a view field

+---------------+  Link field  points to link field of previous
|     $1B9D     |              word in the dictionary      
+---------------+  Name field length/flags byte
[1]             |     High bit set for traverse
| [0]           |     Immediate bit
|   [0]_________|     Smudge bit
|     [    5    ]     Name length 0..31
+---------------+  Name field first letter
[0]             |    High bit zero
|      A        |
+---------------+
[0]             |
|      L        |
+---------------+
[0]             |
|      L        |
+---------------+
[0]             |
|      O        |
+---------------+  Name field last letter
[1]             |    High bit set for traverse
|      T        |
+---------------+  Code field
|     $2369     |
+-------------+-+  Parameter field
|               |

Vocabularies in Fleet Forth form a tree structure. The parent vocabulary of each new vocabulary is the vocabulary it is defined in.
The first cell of a vocabulary contains a pointer to the link field of the latest word in that vocabulary or zero if no words have been added to that vocabulary. The second cell of a vocabulary contains a pointer to its parent vocabulary. The Forth vocabulary's second cell holds a zero. The third cell of a vocabulary is part of the VOC-LINK chain used by FORGET.

Code: Select all

Vocabulary structure ( new kernel's FORTH vocabulary shown )
+---------------+
|     $249A     |  Code field points to dovocabulary
+-------------+-+
|     $2F21     |  Pointer to latest name in vocabulary
+---------------+
|     $0000     |  Pointer to parent vocabulary
+---------------+
|     $0000     |  Pointer to previously defined vocabulary's 3rd cell
+---------------+       ( part of the VOC-LINK chain )

Newly created vocabulary  ( ASSEMBLER vocabulary when it was first created )
+---------------+
|     $249A     |  Code field points to dovocabulary
+-------------+-+
|     $0000     |  Pointer to latest name in vocabulary
+---------------+
|     $24C7     |  Pointer to parent vocabulary ( FORTH )
+---------------+
|     $24CB     |  Pointer to previously defined vocabulary's 3rd cell
+---------------+       ( part of the VOC-LINK chain )

[JimBoyd]

Some may wonder why I wrote VOCABULARY the way I did. Since Fleet Forth has a tree-like vocabulary structure, wouldn't it have been easier to implement vocabulary like FIG-Forth with a false name in it where (FIND) , the find primitive, would race through a vocabulary, follow the false name's link field to the latest word in the parent vocabulary until the word was found or it ran out of parent vocabularies and the search failed? The reason has to do with the desired behavior. To that end, Fleet Forth has two find primitives. (FIND) searches a vocabulary and, if necessary, any parent vocabularies. VFIND only searches the given vocabulary. CREATE , Fleet Forths word used by all defining words, and FORGET use VFIND to only search the CURRENT vocabulary. It's a good idea to warn of a redefinition but with a tree structured vocabulary implemented like FIG-Forth, a warning about a redefinition will occur even if the word being redefined is in a parent vocabulary. One way to deal with this is to have a variable WARNING, like Blazin' Forth, which is used to allow or suppress warnings about redefinitions. I personally prefer to always be warned about redefinitions but, only when they occur in the CURRENT vocabulary, the one receiving new definitions.
I built a test kernel with the FIG-Forth style vocabulary structure just to see the size difference. Including WARNING and the test for it added 20 bytes, changing the definition of VOCABULARY added 6 bytes, and modifying FORGET so the CURRENT vocabulary isn't forgotten ( Fleet Forth's version only searches the CURRENT vocabulary for the word to be forgotten, so the CURRENT vocabulary is never found )added 10 more bytes for a total of 36 bytes. Eliminating VFIND and streamlining (FIND) saved 39 bytes. 3 bytes saved in the kernel. The overall system for this test build was larger. A word used by WORDS needed another 14 bytes to test for and avoid following the link to a parent vocabulary ( I feel that WORDS should *only* display the words in the CONTEXT vocabulary, not every vocabulary from it back to and including FORTH ). ORDER and VOCS would need a complete rewrite and even more code to work properly. So, not such a great savings after all.
How did having two find primitives only add 39 bytes? Simple, here is the source for (FIND) and VFIND:

Code: Select all

SCR# 13 
// (FIND)
HEX
CODE (FIND)  ( ADR VOC -- ADR2 F )
   DEY,  N 1- STY,  SEC,
   2 ,X LDA,  2 # SBC,  N 2+  STA,
   3 ,X LDA,  0 # SBC,  N 3 + STA,
   0 ,X LDY,  1 ,X LDA,
   INX,  INX,  XSAVE STX,
   BEGIN,
      N    STY,  N 4 + STY,
      N 1+ STA,  N 5 + STA,
      BEGIN,
         0 # LDY,
         N )Y LDA,  TAX,  INY,
         N )Y LDA,

SCR# 14 
// (FIND)                       JAB
      0= NOT WHILE,
         N 1+ STA,  N STX,  INY,
         N )Y LDA,  N 2+ )Y EOR,
         3F # AND,
      CS-DUP 0= UNTIL, // CONTINUE
         BEGIN,
            INY,
            N )Y LDA,  N 2+ )Y EOR,
         0= NOT UNTIL,
         7F # AND,
      0= UNTIL,
         XSAVE LDX,

SCR# 15 
// (FIND)                       JAB
         SEC,
         TYA,  N ADC,  0 ,X STA,
         0 # LDA,
         N 1+ ADC,  1 ,X STA,
         2 # LDY,
         N )Y LDA,  40 # AND,
         0= IF,
            LABEL PUSH.TRUE // -1
            0FF # LDA,  PHA,
            PUSH JMP,
         THEN,
         LABEL PUSH.ONE     //  1
         1 # LDA,   HERE TIS APUSH
         PHA,  0 # LDA,  PUSH JMP,
      THEN,

SCR# 16 
// (FIND)                       JAB
      3 # LDY,
      N 4 + )Y LDA,
      N 1- AND,
   0= NOT WHILE,
      TAX,  DEY,
      N 4 + )Y LDA,
      TAY,  TXA,
   0= UNTIL,   // ALWAYS BRANCH
   THEN,
   XSAVE LDX,
   LABEL PUSH.FALSE         //  0
   0 # LDA,  PHA,
   PUSH JMP,
END-CODE

SCR# 82 
// VFIND FIND NAME '
HEX
CODE VFIND  ( ADR VOC -- ADR2 F )
   -2 ALLOT
   ' (FIND) @ 1+ ,
END-CODE

(FIND) first decrements the Y-register, it is zero upon entering a code word, to $FF and stores it in N-1 ( one of the scratch pad locations in zero page ). VFIND is a word without a body of its own. It's code field points one byte into the body of (FIND), just past the DEY instruction therefore, a zero is stored in N-1.
(FIND)'s outer BEGIN loop handles the transition from a vocabulary to its parent, if it has one. The BEGIN loop inside that handles the search in a vocabulary. Notice that if the value stored in N-1 is $FF and the high byte of the address for the parent vocabulary is not zero, then the parent vocabulary is searched.
Since VFIND stores a zero in N-1, when the code reaches the N 1- AND, on screen 16 the result is always zero so the parent vocabulary, if there is one, is never searched by VFIND, only (FIND). (FIND) and VFIND take the address of the name to be searched for and the address of the VOCABULARY NOT the address of the latest word in the VOCABULARY. Here is the code for FIND:

Code: Select all

: FIND  ( ADR -- ADR2 F )
   CONTEXT @ (FIND)
   ?DUP ?EXIT
   CURRENT @ VFIND ;

By the way, notice that when testing to see if the link field, or the parent vocabulary field, is a valid address or zero, only the high byte is tested.

cheers,
Jim

[JimBoyd]

For reference, here is the find primitive for the test kernel with the FIG-Forth type vocabularies:

Code: Select all

SCR# 14 
// (FIND)                       JAB
HEX
CODE (FIND)  ( ADR VOC -- ADR2 F )
   1 # LDA,  SETUP JSR,  //  SEC,
   // SETUP SETS CARRY -- SIDE EFFECT
   0 ,X LDA,  2 # SBC,  N 2+ STA,
   1 ,X LDA,  0 # SBC,  N 3 + STA,
   XSAVE STX,
   BEGIN,
      0 # LDY,
      N )Y LDA,  TAX,  INY,
      N )Y LDA,
   0= NOT WHILE,
      N 1+ STA,  N STX,  INY,

SCR# 15 
// (FIND)                       JAB
      N )Y LDA,  N 2+ )Y EOR,
      3F # AND,
   CS-DUP 0= UNTIL,   // CONTINUE
      BEGIN,
         INY,
         N )Y LDA,  N 2+ )Y EOR,
      0= NOT UNTIL,
      7F # AND,
   0= UNTIL,
      XSAVE LDX,
      SEC,
      TYA,  N ADC,  0 ,X STA,
      0 # LDA,
      N 1+ ADC,  1 ,X STA,

SCR# 16 
// (FIND)                       JAB
      2 # LDY,
      N )Y LDA,  40 # AND,
      0= IF,
         0FF # LDA,  PHA,
         PUSH JMP,
      THEN,
      1 # LDA,  HERE TIS APUSH
      PHA,  0 # LDA,  PUSH JMP,
   THEN,
   XSAVE LDX,
   0 # LDA,  PHA,
   PUSH JMP,
END-CODE

Which is also the find primitive I had back when my high level FIND was more complicated ( to deal with my vocabulary structure ):

Code: Select all

HEX
: FIND  ( ADR -- ADR2 FLAG )
   CONTEXT
   BEGIN
      @ ?DUP
   WHILE
      TUCK (FIND) ?DUP
      IF  ROT DROP EXIT  THEN
      SWAP 2+
   REPEAT
   CURRENT @ (FIND) ;

I like my present find primitives and high level FIND much better.

[JimBoyd]

I was wondering, given a Commodore 64 ( which means a 6510 processor and no CMOS version, sadly ) is this the fastest (FIND) or can it be made faster?

Code: Select all

HEX
CODE (FIND)  ( ADR VOC -- ADR2 F )
   1 # LDA,  SETUP JSR,
   // SETUP SETS CARRY -- SIDE EFFECT
   0 ,X LDA,  2 # SBC,  N 2+ STA,
   1 ,X LDA,  0 # SBC,  N 3 + STA,
   XSAVE STX,
   BEGIN,
      0 # LDY,
      N )Y LDA,  TAX,  INY,
      N )Y LDA,
   0= NOT WHILE,
      N 1+ STA,  N STX,  INY,
      N )Y LDA,  N 2+ )Y EOR,
      3F # AND,
   CS-DUP 0= UNTIL,   // CONTINUE
      BEGIN,
         INY,
         N )Y LDA,  N 2+ )Y EOR,
      0= NOT UNTIL,
      7F # AND,
   0= UNTIL,
      XSAVE LDX,
      SEC,
      TYA,  N ADC,  0 ,X STA,
      0 # LDA,
      N 1+ ADC,  1 ,X STA,
      2 # LDY,
      N )Y LDA,  40 # AND,
      0= IF,
         0FF # LDA,  PHA,
         PUSH JMP,
      THEN,
      1 # LDA,
      PHA,  0 # LDA,  PUSH JMP,
   THEN,
   XSAVE LDX,
   0 # LDA,  PHA,
   PUSH JMP,
END-CODE

[JimBoyd]

I realize my assembler's notation may be off-putting for some so I hand translated the code for the body of the find primitive. Be warned that I cannot guarantee there were no transcription errors. If the two differ, the source using postfix notation in the prior comment is correct.

Code: Select all

    LDA #1
    JSR SETUP
    LDA 0,X         \ since link fields point to link fields
    SBC #2          \ subtract two from address of name being 
    STA N+2         \ sought so the names both have offset of
    LDA 1,X         \ two
    SBC #0
    STA N+3
    STX XSAVE
MAINLOOP
    LDY #0          \ this (FIND) takes address of a vocabulary
    LDA (N),Y       \ not the address of latest entry in that vocabulary
    TAX             \ so fetch the address from vocabulary or link field
    INY
    LDA (N),Y
    BEQ NOTFOUND    \ if the hi byte is zero, so is the lo byte
    STA N+1         \ since there are no names in zero page
    STX N
    INY
    LDA (N),Y       \ compare the length
    EOR (N+2),Y
    AND #$3F
    BNE MAINLOOP    \ continue with mainloop if different
LOOP
    INY
    LDA (N),Y       \ check names letter by letter
    EOR (N+2),Y
    BEQ LOOP        \ when a difference is found
    AND #$7F        \ check if it's the high bit in dictionary entry
    BNE MAINLOOP    \ if not, back to mainloop to fetch next entry
    LDX XSAVE
    SEC             \ found it!
    TYA             \ so get code field and place on stack
    ADC N
    STA 0,X
    LDA #0
    ADC N+1
    STA 1,X
    LDY #2          \ go back to count byte in dictionary entry
    LDA (N),Y       
    AND #$40        \ and see if word is immediate
    BNE PUSH1
    LDA #$FF        \ push -1 to stack
    PHA
    JMP PUSH
PUSH1               \ push 1 to stack
    LDA #1
    PHA
    LDA #0
    JMP PUSH
NOTFOUND            \ push 0 to stack
    LDX XSAVE
    LDA #0
    PHA
    JMP PUSH

I realize my commenting style isn't the greatest. I'm working on it, so bear with me.

[barrym95838]

I might be able to attempt some optimization if I have access to the source for your SETUP and PUSH subroutines, especially if they differ from the 6502 fig-FORTH subroutines of the same names.

[JimBoyd]

Here is the source for LIT ( which contains PUSH ) and SETUP from my kernel.

Code: Select all

HEX
CODE LIT
   IP )Y LDA,  PHA,  IP INC,
   0= IF,  IP 1+ INC,  THEN,
   IP )Y LDA,
   LABEL IP.INC1
   IP INC,
   0= IF,  IP 1+ INC,  THEN,
   HERE TIS PUSH
   DEX,  DEX,
   HERE TIS PUT
   1 ,X STA,  PLA,  0 ,X STA,
   HERE TIS 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

HEX
CODE CLIT
   IP )Y LDA,  PHA,  TYA,
   IP.INC1 0= BRAN,  // ALWAYS BRAN
// SETUP SETS CARRY AS SIDE EFFECT
HERE TIS 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

And here are the hand translated versions.

Code: Select all

PUSH
    DEX
    DEX
\ PUT STARTS HERE
    STA 1,X
    PLA
    STA 0,X
\ NEXT STARTS HERE
    LDY #1
    LDA (IP),Y
    STA W+1
    DEY
    LDA (IP),Y
    STA W
    CLC
    LDA IP
    ADC #2
    STA IP
    BCS INCREMENT
    JMP W-1
INCREMENT
    INC IP+1
    JMP W-1

SETUP
    ASL A
    STA N-1
LOOP
    LDA 0 ,X
    STA N,Y
    INX
    INY
    CPY N-1
    BNE LOOP
    LDY #0
    RTS

I'm not sure how SETUP and PUSH will affect the speed since they both occur outside the find loop. By the way, the version of FIND I'm currently using is the more complex one already presented in an earlier message. I've run timing tests and both versions of FIND are within a percent or two of each other speed-wise. I presented the earlier one because both versions have the same search loop ( the part that needs to be fast ) and the earlier version is less complex, therefore ( hopefully) has fewer distractions.
I've tested my FIND against Blazin' Forth's by making sure both Forths have about the same number of words in the Forth vocabulary and timing a test which searches for CLIT. My versions take about 2/3 the time.
Part of the speed difference has to do with Blazin' Forth's header structure. In Blazin' Forth, a word's link field points to the previous words name field. When searching the dictionary in Blazin' Forth, to get from one entry to the previous one, two must be subtracted from the address of the name field to get to the link field. This subtraction occurs in the find loop. By having the link field point to the previous words link field in Fleet Forth, the subtraction is performed once and it's performed on the address of the name being sought. The address-2 is stored in N+2, N+3 while the original address remains on the data stack unless the word is found, then its CFA replaces the address on the stack. This subtraction in Fleet Forth's FIND is because the name field of the word being checked has an offset of two from the address of its link field so the address of the text of the word being sought needs an offset of two from the address being used for it.
I hope this makes sense.

Cheers,
Jim

[barrym95838]

I can certainly make it smaller, but I'm not yet convinced that I can make it faster. I'm going to chew on it for awhile, and see what develops.

P.S. Have you considered changing your PUSH to PUSHAY? How about moving it with NEXT to ZP (space permitting)?

[JimBoyd]

barrym95838 wrote:

I can certainly make it smaller, but I'm not yet convinced that I can make it faster. I'm going to chew on it for awhile, and see what develops.

As long as it's not slower.

Quote:

P.S. Have you considered changing your PUSH to PUSHAY?

I thought about that once but I didn't want to rewrite LIT and make it slower. Another reason is the same reason I left the comma's in all those assembler words. I've heard that back in the day, Blazin' Forth was quite popular and it's not the only Forth to use PUSH. There may be a body of code out there. I don't know if it's a big body or a small body of code. In any case, I don't want to introduce incompatibilities in the assembler. As for adding PUSHAY to my system, I'd need to give it some thought. It would have to jump to NEXT so I would have to see if it was faster to push a value on the stack that way.

Quote:

How about moving it with NEXT to ZP (space permitting)?

Hmm, The C64 kernel uses most of zero page above $8F and I'd really like to keep the data and return stacks as large as possible to support multitasking since each task gets a slice of the stacks. That's why the text input buffer does not share page one with the return stack ( it's at $2A7 - $2F6 ).

[BigDumbDinosaur]

JimBoyd wrote:

Hmm, The C64 kernel uses most of zero page above $8F and I'd really like to keep the data and return stacks as large as possible to support multitasking since each task gets a slice of the stacks. That's why the text input buffer does not share page one with the return stack ( it's at $2A7 - $2F6 ).

If you are not using the BASIC interpreter you can take up all zero page from $02 to $8F inclusive without interference. Upon exit from the Forth kernel you will have to jump to the BASIC cold start entry point at $A000 to initialize BASIC's ZP.

[JimBoyd]

BigDumbDinosaur wrote:

If you are not using the BASIC interpreter you can take up all zero page from $02 to $8F inclusive without interference.

I'm not using the BASIC interpreter. Fleet Forth's cold start routine switches out the BASIC ROM and replaces BASIC's routine at $300 with its warm start routine.
Thank you for the info on zero page but I was already aware of it. Fleet Forth uses most of that range for its data stack, some for the scratch pad area N, and some for some of the Forth virtual machine registers. Since Fleet Forth supports multitasking ( background tasks anyway ) the area of zero page used for the data stack gets divided among the foreground task and the background tasks. The reason I'm reluctant to put NEXT in zero page is that it is a routine that is around two dozen bytes long.

Quote:

Upon exit from the Forth kernel you will have to jump to the BASIC cold start entry point at $A000 to initialize BASIC's ZP.

Fleet Forth has a word BYE that returns to basic by way of the processor's system reset hardware vector at $FFFC.

[JimBoyd]

I've just rewritten the code for : (colon) and ; (semicolon) in the Fleet Forth kernel.
SMUDGE , CSP , and ?CSP have been removed. There is a new word, TSB ( toggle smudge bit ) which takes an address and toggles the 5th bit ( value $20 ).
the old versions were.

Code: Select all

: ;  ( -- )
   ?CSP  COMPILE EXIT
   SMUDGE [COMPILE] [ ; IMMEDIATE

: :  ( -- )
   ] SP@ CSP !
   CURRENT @  CONTEXT !
   CREATE  SMUDGE
   ;CODE
   IP 1+ LDA,  PHA,
   IP    LDA,  PHA,
   CLC,
   2 # LDA,  W    ADC,  IP    STA,
       TYA,  W 1+ ADC,  IP 1+ STA,
   NEXT JMP,  END-CODE

The new versions are as follows.

Code: Select all

: ;  ( ADR TRUE -- )
   COMPILE EXIT
   [COMPILE] [
   TRUE ?PAIRS  TSB ; IMMEDIATE

: :  ( -- ADR TRUE )
   CURRENT @  CONTEXT !
   CREATE  LATEST TRUE OVER TSB ]
   ;CODE
   IP 1+ LDA,  PHA,
   IP    LDA,  PHA,
   CLC,
   2 # LDA,  W    ADC,  IP    STA,
       TYA,  W 1+ ADC,  IP 1+ STA,
   NEXT JMP,  END-CODE

?PAIRS takes two numbers and aborts with the message "STRUCTURE MISMATCH" if they are not the same.
This modification also made it necessary to change DOES> , ;CODE , CODE , and END-CODE .
I feel this is more in keeping with the Forth-83 standard.

Code: Select all

:            -- sys                        M,79          "colon"

...  sys is balanced with its corresponding ; .
See: "compilation"  "9.4 Compilation"

And

Code: Select all

 ;            --                            C,I,79   "semi-colon"

          sys --   (compiling)          

...  sys is balanced with its corresponding : .
See:  EXIT  :  "stack, return"  "9.4 Compilation"

It also makes it possible to implement :NONAME without explicitly using [ SMUDE ] in the source and without accidently smudging the latest name and then unsmudging it, as it may be needed by the headless word being compiled by :NONAME .

[JimBoyd]

I haven't implemented :NONAME but I was looking at Leo Brodie's DOER/MAKE from Thinking Forth. I got it working with Fleet Forth but it started me thinking that I might want to change semicolon's ( ; ) sys just a little.

Code: Select all

( ADDR TRUE -- )  There is a dictionary entry which needs revealed.
( FALSE -- )  There is not.

Or possibly

Code: Select all

( ADDR TRUE -- )  There is a dictionary entry which needs revealed.
( FALSE FALSE -- )  There is not.

To keep both versions of semicolon's sys the same size ( same number of stack entries ).
Since TRUE and FALSE are not used as compiler security numbers for any of the control flow words, this shouldn't be a problem.
Any comments?

P.S. Or possibly

Code: Select all

( ADDR TRUE -- )  There is a dictionary entry which needs revealed.
( CFA FALSE -- CFA )  There is not, but there is the CFA of the headless word which gets left on the data stack

[JimBoyd]

JimBoyd wrote:

Fleet Forth has a word BYE that returns to basic by way of the processor's system reset hardware vector at $FFFC.

There is slightly more to BYE than that.

Code: Select all

: BYE  ( -- )
   SAVE-BUFFERS
   ACLOSE
   0FFFC EXECUTE ;

Save the block buffers, close all files, then restart the system.