refactor word header so only >NAME involves variable-length data

jumpforth.S

@@ -110,14 +110,8 @@ DODOES:
    PUSHRSP %esi
    /* Load address of DOES> body from DFA into %esi */
    movl 4(%eax),%esi
-   /* Load name length byte into %eax and mask out flag bits */
+   /* Load address of word body (after DFA) onto stack */
-   xor %ebx,%ebx
+   add $8,%eax
-   movb 12(%eax),%bl
-   andb $F_LENMASK,%bl
-   /* Calculate %eax + 13 + %ebx and round up to next cell for address of body */
-   lea 16(%eax,%ebx),%eax
-   andl $-4,%eax
-   /* Push body address on the data stack */
    push %eax
    /* Execute the DOES> code */
    NEXT
@@ -132,19 +126,19 @@ DODOES:
 .macro defname label:req,codeword:req,dataword:req,name="",flags=0
    .section .data
    .align 4
-   .globl \label
+   .skip (-(9f-8f+1) & 3),0
-\label :
-   .int \codeword
-   .int \dataword
-   .int link
-   .set link,\label
-   .byte \flags+(9f-8f)
 .ifeqs "\name",""
 8: .ascii "\label"
 .else
 8: .ascii "\name"
 .endif
-9: .align 4
+9: .byte \flags+(9b-8b)
+   .int link
+   .globl \label
+\label :
+   .set link,\label
+   .int \codeword
+   .int \dataword
 .endm
 
 .macro defword label:req,name="",flags=0
@@ -1254,37 +1248,37 @@ defword STREQU,"=S",F_HIDDEN
 1: .int TWODROP,DROP,FALSE,EXIT               /* FALSE                  R:           */
 2: .int TWODROP,DROP,TRUE,EXIT                /* TRUE                   R:           */
 
-/* ( xt -- cfa-addr ) Address of the codeword field */
+/* ( xt -- a-addr ) Body a.k.a. data-field address (next cell after the dataword field) */
-defword TCFA,">CFA",F_HIDDEN
+defword TBODY,">BODY",F_HIDDEN
-   .int EXIT
+   .int LIT,8,ADD,EXIT
 
 /* ( xt -- dfa-addr ) Address of the dataword field */
 defword TDFA,">DFA",F_HIDDEN
    .int CELL,ADD,EXIT
 
-/* ( xt -- link-addr ) Address of the dataword field */
+/* ( xt -- cfa-addr ) Address of the codeword field */
+defword TCFA,">CFA",F_HIDDEN
+   .int EXIT
+
+/* ( xt -- link-addr ) Address of the link field */
 defword TLINK,">LINK",F_HIDDEN
-   .int LIT,8,ADD,EXIT
+   .int LIT,4,SUB,EXIT
 
 /* ( xt -- flags-addr ) Address of the flag/length byte */
 defword TFLAGS,">FLAGS",F_HIDDEN
-   .int LIT,12,ADD,EXIT
+   .int LIT,5,SUB,EXIT
 
 /* ( xt -- name-addr name-len ) Address and length of the name field */
 defword TNAME,">NAME",F_HIDDEN
-   .int TFLAGS,DUP,ADD1,SWAP,FETCHBYTE,__F_LENMASK,AND,EXIT
+   .int TFLAGS,DUP,FETCHBYTE,__F_LENMASK,AND,TUCK,SUB,SWAP,EXIT ;
-
-/* ( xt -- a-addr ) Data-field address (next cell after the name) */
-defword TBODY,">BODY",F_HIDDEN
-   .int TNAME,ADD,ALIGNED,EXIT
 
 /* ( xt -- flag ) Is the F_IMMED flag set? */
 defword ISIMMEDIATE,"IMMEDIATE?",F_HIDDEN
-   .int LIT,12,ADD,FETCHBYTE,__F_IMMED,AND,LIT,0,NEQU,EXIT
+   .int TFLAGS,FETCHBYTE,__F_IMMED,AND,ZNEQU,EXIT
 
 /* ( xt -- flag ) Is the F_HIDDEN flag set? */
 defword ISHIDDEN,"HIDDEN?",F_HIDDEN
-   .int LIT,12,ADD,FETCHBYTE,__F_HIDDEN,AND,LIT,0,NEQU,EXIT
+   .int TFLAGS,FETCHBYTE,__F_HIDDEN,AND,ZNEQU,EXIT
 
 /* ( xt -- flag ) Is the xt a non-primitive bootstrap word? */
 defword ISBOOTSTRAP,"BOOTSTRAP?",F_HIDDEN
@@ -1418,13 +1412,15 @@ defword QUIT,,F_HIDDEN
 defword LATEST,,F_HIDDEN
    .int CURRENT,FETCH,FETCH,EXIT
 
+defword COMMANAME,"NAME,",F_HIDDEN
+   .int TUCK,ALIGN,HERE,OVER,ADD,ADD1,NEGATE,CELL,SUB1,AND,BOOTSTRAP_ALLOT
+   .int HERE,OVER,BOOTSTRAP_ALLOT,SWAP,CMOVE,COMMABYTE,EXIT
+
 /* CREATE depends on various bootstrap words */
 defword CREATE
-   .int ALIGN,HERE
+   .int PARSE_NAME,COMMANAME,LATEST,COMMA
-   .int LIT,DODATA,COMMA,LIT,0,COMMA,LATEST,COMMA
+   .int HERE,CURRENT,FETCH,STORE
-   .int PARSE_NAME,DUP,COMMABYTE,HERE,SWAP,DUP,BOOTSTRAP_ALLOT,CMOVE
+   .int __DODATA,COMMA,HERE,CELL,ADD,COMMA,EXIT
-   .int ALIGN,HERE,OVER,TDFA,STORE
-   .int CURRENT,FETCH,STORE,EXIT
 
 /*
 ** These next few words aren't strictly necessary for bootstrapping but

startup.4th

@@ -59,12 +59,12 @@ SYSTEM-WORDLIST SET-CURRENT
 >>UTILITY
 
 \ Field accessors for execution tokens
-: >CFA ( xt -- a-addr ) ;
+: >BODY  ( xt -- a-addr   ) [ 2 CELLS ] LITERAL + ;
 : >DFA   ( xt -- a-addr   ) CELL+ ;
-: >LINK ( xt -- a-addr ) 2 CELLS+ ;
+: >CFA   ( xt -- a-addr   ) ;
-: >FLAGS ( xt -- c-addr ) 3 CELLS+ ;
+: >LINK  ( xt -- a-addr   ) CELL- ;
-: >NAME ( xt -- c-addr u ) >FLAGS DUP 1+ SWAP C@ F_LENMASK AND ;
+: >FLAGS ( xt -- c-addr   ) [ CELL 1+ ] LITERAL - ;
-: >BODY ( xt -- a-addr ) >NAME + ALIGNED ;
+: >NAME  ( xt -- c-addr u ) >FLAGS DUP C@ F_LENMASK AND TUCK - SWAP ;
 
 >>SYSTEM
 
@@ -769,6 +769,13 @@ DEFER QUIT
 \ Allocate bytes from the data area (less than one cell) to cell-align the address
 : ALIGN ( -- ) CELL ALIGN-TO ;
 
+\ Compile the name field of a word header, which is a counted string _right_ aligned
+\ to a cell boundary, with the length at the _end_ of the string. Example:
+\   [ x x x N ][ A M E 4 ]
+: NAME, ( c-addr u -- )
+   TUCK ▪ ALIGN HERE OVER + 1+ ▪ NEGATE CELL 1- AND ALLOT
+   HERE ▪ OVER ALLOT ▪ SWAP CMOVE ▪ C, ;
+
 \ Append the effect of the token on top of the stack to the current definition.
 \ Here it's equivalent to , since words are just arrays of execution tokens.
 \ Once COMPILE, has been defined we can use POSTPONE for non-immediate words.
@@ -1194,7 +1201,7 @@ DEFER REFILL
 \ The word is NOT added to the current compilation word list
 \ The start and end of the header are both cell-aligned
 : (CREATE-RAW) ( c-addr u link dfa cfa -- xt )
-   ALIGN HERE >R , , , DUP F_LENMASK UMIN C, HERE SWAP DUP ALLOT CMOVE ALIGN R> ;
+   2>R >R ▪ F_LENMASK UMIN NAME, ▪ R> , ▪ 2R> , , ▪ HERE 2 CELLS- ;
 
 \ Called when a word using DOES> is executed (not compiled) to set
 \ the runtime behavior of the most recently defined word
@@ -1651,15 +1658,16 @@ ENDSTRUCT MEMBLOCK%
 \ the closure is no longer needed. When executed, the closure xt will place
 \ xu ... x1 on the data stack and then execute the captured xt1.
 : CLOSURE ( xu ... x1 xt1 u -- xt2 )
-   1+ DUP 5 + CELLS ALLOCATE DUP >R
+   1+ DUP 5 + CELLS ALLOCATE DUP 2 CELLS+ >R
-   DODOES !(+) [[ ' (CLOSURE) >DFA @ ]] !(+) NULL !(+) 0 !(+) OVER !(+) N! R> ;
+   \ name(0) link(NULL) codeword dataword #words xt x1 x2 x3 …
+   0 !(+) NULL !(+) DODOES !(+) [[ ' (CLOSURE) >DFA @ ]] !(+) OVER !(+) N! R> ;
 
 \ Return a closure which executes xt1 followed by xt2
 : COMPOSE ( xt1 xt2 -- xt3 )
    { >R EXECUTE R> EXECUTE } 2 CLOSURE ;
 
-\ In the future the closure object and its xt may not share the same address
+\ The xt points to the codeword, which is two cells above the base of the object
-' FREE ALIAS FREE-CLOSURE
+: FREE-CLOSURE  ( closure-xt -- )  2 CELLS- FREE ;
 
 \ Reserve data or heap space for a data structure given alignment and size
 \ It is assumed that ALLOCATE (but not ALLOT) returns an address suitably
@@ -2183,15 +2191,15 @@ HIDE (TRACE)
       THEN
    ENDCASE LOOP DROP ;
 
-\ Recognize the pattern BRANCH a:{c-a} b:{word} {code…} c:LIT d:{b}
+\ Recognize the pattern BRANCH a:{c-a} {name} {link} b:{codeword} {…} c:LIT d:{b}
 \ This pattern is generated by the { … } inline :NONAME syntax
 : NONAME-LITERAL? ( a-addr -- flag )
    @(+) [[ ' BRANCH ]] = AND-THEN
-      @(+) DUP 0> AND-THEN
+      DUP @ DUP 5 CELLS >= AND-THEN
-         ( S: addr-b offset-c-a )
+         ( S: addr-a offset-c-a )
-         OVER CELL- + @(+) [[ ' LIT ]] = AND-THEN
+         OVER + @(+) [[ ' LIT ]] = AND-THEN
-            ( S: addr-b addr-d )
+            ( S: addr-a addr-d )
-            @ OVER = AND-THEN
+            @ SWAP 3 CELLS+ OVER = AND-THEN
                DUP WORD?
             THEN
          ELSE NIP THEN
@@ -2222,11 +2230,11 @@ ALSO UTILITY
          ENDOF
          OVER CELL- NONAME-LITERAL? IF
             DROP DUP @ OVER + 2 CELLS+ DUP R> UMAX >R SWAP
-            "{ " TYPE CELL+ >DFA @ UNTHREAD "} " TYPE
+            "{ " TYPE 3 CELLS+ >DFA @ UNTHREAD "} " TYPE
          ELSE
             DUP [[ ' BRANCH ]] = OR-ELSE DUP [[ ' 0BRANCH ]] = THEN IF
                >NAME TYPE SPACE
-               @(+) DUP "{" TYPE DUP 0> IF "+" TYPE THEN . "} " TYPE
+               @(+) DUP "{" TYPE DUP 0>= IF "+" TYPE THEN . "} " TYPE
                OVER CELL- + R> UMAX >R
             ELSE
                DUP WORD? AND-THEN DUP IMMEDIATE? THEN IF