eliminate *-WORDLIST & replace with VOCABULARY-style words

jumpforth.S

@@ -226,13 +226,8 @@ defvar IN,0,">IN"
 defvar CP       /* "compilation pointer", next free byte in the heap */
 defvar BRK      /* the (current) end of the heap */
 
-/* The word list containing all the standard FORTH words */
-/* Initially it just mirrors the primitive list */
-/* The rest will be populated by the startup.4th script */
-defvar FORTH_WORDLIST,last_primitive,"FORTH-WORDLIST"
-
-/* The current compilation word list, initially FORTH-WORDLIST */
-defvar CURRENT,data_FORTH_WORDLIST
+/* The current compilation word list, initially BOOTSTRAP-WORDLIST */
+defvar CURRENT,data_BOOTSTRAP_WORDLIST
 
 /* ( a -- ) */
 defcode DROP
@@ -1236,6 +1231,9 @@ defcode BREAK
    .section .data
 bootstrap_data_begin:
 
+/* The word list containing all the primitive words */
+defvar PRIMITIVE_WORDLIST,last_primitive,"PRIMITIVE-WORDLIST"
+
 /* The list of basic non-primitive words used to bootstrap the startup.4th file */
 defvar BOOTSTRAP_WORDLIST,last_word,"BOOTSTRAP-WORDLIST"
 
@@ -1367,7 +1365,7 @@ defword ISBOOTSTRAP,"BOOTSTRAP?",F_HIDDEN
 /* ( -- widn ... wid1 n ) Return the current search order */
 /* Redefining this word with DEFER! will change the bootstrap search order */
 defword GET_ORDER,"GET-ORDER",F_HIDDEN
-   .int BOOTSTRAP_WORDLIST,FORTH_WORDLIST,CURRENT,FETCH,LIT,3,EXIT
+   .int BOOTSTRAP_WORDLIST,PRIMITIVE_WORDLIST,CURRENT,FETCH,LIT,3,EXIT
 
 /* ( c-addr u wid -- 0 | xt 1 | xt -1 ) */
 /* 0 = not found; 1 = non-immediate; -1 = immediate */

startup.4th

@@ -1,35 +1,21 @@
-\ Keep internal system definitions and ABI constants out of the main word list
-CP @ 0 ,  DUP CURRENT !  CONSTANT SYSTEM-WORDLIST
-CP @ 0 ,                 CONSTANT UTILITY-WORDLIST
-CP @ 0 ,                 CONSTANT LINUX-WORDLIST
-BOOTSTRAP-WORDLIST       CONSTANT BOOTSTRAP-WORDLIST
+\ Create the FORTH word list, which includes the name FORTH and all the primitives
+CURRENT @ @                        ( save the latest word in the bootstrap word list )
+CREATE FORTH CURRENT @ @ ,         ( create FORTH with itself as the initial value   )
+CURRENT @ XCHG                     ( restore bootstrap list & get address of FORTH   )
+PRIMITIVE-WORDLIST @ OVER CELL - ! ( set the link field to the last primitive word   )
+CELL 2* + CURRENT !                ( make FORTH the current compilation word list    )
 
-\ Use this list until we get around to defining the real GET-ORDER
-: STARTUP-ORDER  ( -- widn ... wid1 n )
-   BOOTSTRAP-WORDLIST
-   LINUX-WORDLIST
-   UTILITY-WORDLIST
-   SYSTEM-WORDLIST
-   FORTH-WORDLIST
-   5 ;
-' STARTUP-ORDER ' BOOTSTRAP-GET-ORDER DEFER!
-
-FORTH-WORDLIST CURRENT !
+\ Create the other startup word lists
+\ These and FORTH will be edited later to have the DOES> effect of
+\ changing the search order just like words defined with VOCABULARY
+CREATE SYSTEM 0 ,
+CREATE UTILITY 0 ,
+CREATE LINUX 0 ,
 
 \ Get and set the current compilation word list
 : GET-CURRENT  ( -- wid )  CURRENT @ ;
 : SET-CURRENT  ( wid -- )  CURRENT ! ;
 
-SYSTEM-WORDLIST SET-CURRENT
-
-\ Shorthand for selecting the current compilation word list until >> is defined
-: >>SYSTEM   SYSTEM-WORDLIST SET-CURRENT ;
-: >>UTILITY   UTILITY-WORDLIST SET-CURRENT ;
-: >>FORTH   FORTH-WORDLIST SET-CURRENT ;
-: >>LINUX   LINUX-WORDLIST SET-CURRENT ;
-
->>FORTH
-
 \ Reserved for "invalid address" or "object not present"
 \ Signifies (the absence of) a memory address, not a number
 0 CONSTANT NULL
@@ -56,7 +42,17 @@ SYSTEM-WORDLIST SET-CURRENT
 \ Return the next address in the compilation/data area
 : HERE  ( -- addr )  CP @ ;
 
->>UTILITY
+\ Use this list until we get around to defining the real GET-ORDER
+: STARTUP-ORDER  ( -- widn ... wid1 n )
+   [ BOOTSTRAP-WORDLIST ] LITERAL
+   [ LINUX ] LITERAL
+   [ UTILITY ] LITERAL
+   [ SYSTEM ] LITERAL
+   [ FORTH ] LITERAL
+   5 ;
+' STARTUP-ORDER ' BOOTSTRAP-GET-ORDER DEFER!
+
+UTILITY SET-CURRENT
 
 \ Field accessors for execution tokens
 : >BODY   ( xt -- a-addr   )  [ 2 CELLS ] LITERAL + ;
@@ -66,7 +62,16 @@ SYSTEM-WORDLIST SET-CURRENT
 : >FLAGS  ( xt -- c-addr   )  [ CELL 1+ ] LITERAL - ;
 : >NAME   ( xt -- c-addr u )  >FLAGS DUP C@ F_LENMASK AND TUCK - SWAP ;
 
->>SYSTEM
+' FORTH >BODY SET-CURRENT
+
+\ Given the xt of a word defined with VOCABULARY, return the word list identifier
+\ This allows the use of vocabulary words with SET-ORDER or SEARCH-WORDLIST
+: >WORDLIST  ( vocabulary-xt -- wid )  >BODY ;
+
+' SYSTEM >WORDLIST SET-CURRENT
+
+\ Set the current compilation word list to the given vocabulary
+: (DEFINITIONS)  ( vocabulary-xt -- )  >WORDLIST SET-CURRENT ;
 
 \ Set or clear the HIDDEN flag for word with the given execution token
 : (HIDE)  ( xt -- )  >FLAGS DUP C@ F_HIDDEN OR SWAP C! ;
@@ -78,7 +83,7 @@ SYSTEM-WORDLIST SET-CURRENT
 \ This is only used during early startup
 ' STARTUP-ORDER (HIDE)
 
->>FORTH
+' FORTH (DEFINITIONS)
 
 : IMMEDIATE?  ( xt -- flag )  >FLAGS C@ F_IMMED  AND 0<> ;
 : HIDDEN?     ( xt -- flag )  >FLAGS C@ F_HIDDEN AND 0<> ;
@@ -109,7 +114,7 @@ SYSTEM-WORDLIST SET-CURRENT
 -256 CONSTANT EXCP-HEAP-OVERFLOW
 -257 CONSTANT EXCP-DEFER-UNINITIALIZED
 
->>SYSTEM
+' SYSTEM (DEFINITIONS)
 
 \ THROWN-STRING holds the address and size of the string passed to FAIL
 \ It may also be used to hold context strings for other system exception codes
@@ -122,7 +127,7 @@ NULL 0 THROWN-STRING 2!
 DEFER THROW-UNWIND  ( k*x n -- i*x <noreturn> )
 ' BAILOUT ' THROW-UNWIND DEFER!
 
->>FORTH
+' FORTH (DEFINITIONS)
 
 \ QUIT needs to be defined after INTERPRET
 DEFER QUIT
@@ -164,14 +169,14 @@ DEFER QUIT
 \ If the word list is empty the result will be zero
 : LATEST  ( -- xt | NULL )  GET-CURRENT @ ;
 
->>UTILITY
+' UTILITY (DEFINITIONS)
 
 \ Set the given xt as the most recent word in the compilation word list
 \ Since this replaces the head of a linked list it may affect the entire list,
 \ not just the most recent word
 : LATEST!  ( xt -- )  GET-CURRENT ! ;
 
->>FORTH
+' FORTH (DEFINITIONS)
 
 \ Set the latest defined word as immediate
 \ Note that IMMEDIATE is itself an immediate word
@@ -189,17 +194,17 @@ DEFER QUIT
    1- ▪ DUP U2/      OR ▪ DUP  2 RSHIFT OR ▪ DUP 4 RSHIFT OR
       ▪ DUP 8 RSHIFT OR ▪ DUP 16 RSHIFT OR ▪ 1+ ;
 
->>UTILITY
+' UTILITY (DEFINITIONS)
 
 : DEFERRED?  ( xt -- )  >CFA @ ▪ DODEFER <> ▪ EXCP-TYPE-MISMATCH AND ▪ THROW ;
 
->>FORTH
+' FORTH (DEFINITIONS)
 
 \ Fetch and store the target of the deferred word denoted by deferred-xt
 : DEFER@  ( deferred-xt -- xt )  DUP DEFERRED? ▪ >DFA @ ;
 : DEFER!  ( xt deferred-xt -- )  DUP DEFERRED? ▪ >DFA ! ;
 
->>LINUX
+' LINUX (DEFINITIONS)
 
 \ Next we'll be defining a lot of constants for system calls and other ABI data
 \ CONSTANT is still a bootstrap word here, but ⇒ is just temporary
@@ -631,7 +636,7 @@ DEFER QUIT
 : SYSCALL5-RETRY   [ ' SYSCALL5 ] LITERAL 5 SYSCALL-RETRY ;
 : SYSCALL6-RETRY   [ ' SYSCALL6 ] LITERAL 6 SYSCALL-RETRY ;
 
->>FORTH
+' FORTH (DEFINITIONS)
 
 \ Write a character array to the given file descriptor
 \ Repeat write syscall until entire string is written
@@ -717,13 +722,13 @@ DEFER QUIT
 \ Emit a horizontal tab character
 : TAB  ( -- "<tab>" )  HT EMIT ;
 
->>UTILITY
+' UTILITY (DEFINITIONS)
 
 \ The implementation-dependent End-of-Line string
 \ Here this is just a LF (Unix convention) but it could be CR (Mac) or CR+LF (DOS)
 : (EOL)  ( -- c-addr u )  "\n" ;
 
->>FORTH
+' FORTH (DEFINITIONS)
 
 \ Emit the implementation-dependent End-of-Line string
 : EOL  ( -- "<eol>" )  (EOL) TYPE ;
@@ -736,12 +741,12 @@ DEFER QUIT
 : BYE  ( -- <noreturn> )
    BEGIN 0 SYS_EXIT SYSCALL1 DROP AGAIN ;
 
->>SYSTEM
+' SYSTEM (DEFINITIONS)
 
 \ When growing the data area, round the end address up to a multiple of this size
 65536 CONSTANT DATA-SEGMENT-ALIGNMENT
 
->>FORTH
+' FORTH (DEFINITIONS)
 
 \ Allocate n consecutive bytes from the end of the data area
 \ If necessary use the brk system call to grow the data area
@@ -844,7 +849,7 @@ DEFER QUIT
 \ by THEN and marks the end of the list if consumed by ONWARD-IF or ONWARD-AHEAD.
 \ This can be used as a base for control structures with zero or more branches.
 
->>UTILITY
+' UTILITY (DEFINITIONS)
 
 : (ALWAYS)  ( C: -- null-orig )  IMMEDIATE
    NULL ;
@@ -860,7 +865,7 @@ DEFER QUIT
 : (AHEAD)  ( C: -- orig ; flag -- )  IMMEDIATE
    POSTPONE (ALWAYS) POSTPONE (ONWARD-AHEAD) ;
 
->>FORTH
+' FORTH (DEFINITIONS)
 
 \          <cond1> IF      <code1>
 \ {ELSE-IF <cond2> THEN-IF <code2>}…
@@ -961,7 +966,7 @@ CREATE LEAVE-ORIG NULL ,
 : I   1 RPICK ;
 : J   3 RPICK ;
 
->>SYSTEM
+' SYSTEM (DEFINITIONS)
 
 \ With 32-bit cells, a double-cell number has 64 bits
 \ Space is reserved for binary output with a leading minus sign and a trailing space
@@ -980,7 +985,7 @@ CREATE PNO-POINTER PNO-BUFFER-END ,
 \ THROW if there are less than u bytes remaining in the PNO buffer
 : PNO-CHECK  ( u -- )  PNO-REMAINING U> IF EXCP-PNO-OVERFLOW THROW THEN ;
 
->>FORTH
+' FORTH (DEFINITIONS)
 
 : <#   PNO-BUFFER-END PNO-POINTER ! ;
 : HOLD  ( char -- )  PNO-POINTER 1 DUP PNO-CHECK OVER -! @ C! ;
@@ -1005,7 +1010,7 @@ CREATE PNO-POINTER PNO-BUFFER-END ,
 \ Example: 12345 0 <# 3 #DFP #> ≡ "12.345"
 : #DFP  ( ud1 u -- ud2 )  BEGIN ?DUP WHILE 1- >R # R> REPEAT [[ CHAR . ]] HOLD #S ;
 
->>FORTH
+' FORTH (DEFINITIONS)
 
 \ Display the unsigned double-cell number at the top of the stack, right-aligned
 : DU.R  ( ud n -- "<digits>" )  >R <# #S BL R> #PAD #> TYPE ;
@@ -1028,7 +1033,7 @@ CREATE PNO-POINTER PNO-BUFFER-END ,
 : DEPTH  ( -- n )  SP@ S0 SWAP - CELL / ;
 : RDEPTH  ( -- n )  RSP@ CELL+ R0 SWAP - CELL / ;
 
->>SYSTEM
+' SYSTEM (DEFINITIONS)
 
 : STARTUP-UNWIND  ( k*x n -- i*x <noreturn> )
    "Exception " TYPE-ERR DUP ABS 0 <# (EOL) HOLDS #S ROT SIGN #> TYPE-ERR
@@ -1037,11 +1042,11 @@ CREATE PNO-POINTER PNO-BUFFER-END ,
 
 ' STARTUP-UNWIND ' THROW-UNWIND DEFER!
 
->>UTILITY
+' UTILITY (DEFINITIONS)
 
 CREATE DISPLAY-ITEM-LIMIT 6 ,
 
->>FORTH
+' FORTH (DEFINITIONS)
 
 \ Display the content of the data stack
 : .S  ( -- "<text>" )
@@ -1115,7 +1120,7 @@ CREATE DISPLAY-ITEM-LIMIT 6 ,
    THEN
    >NUMBER-BASE ;
 
->>UTILITY
+' UTILITY (DEFINITIONS)
 
 \ Parse a signed number; to succeed the entire input string must be consumed
 : PARSENUMBER  ( c-addr u -- 0 | n 1 | d 2 )
@@ -1133,7 +1138,7 @@ CREATE DISPLAY-ITEM-LIMIT 6 ,
 
 ' PARSENUMBER ' BOOTSTRAP-PARSENUMBER DEFER!
 
->>SYSTEM
+' SYSTEM (DEFINITIONS)
 
 \ Copy the bootstrap SOURCE values into variables to allow changing the input buffer
 CREATE INPUT-BUFFER SOURCE 2,
@@ -1142,7 +1147,7 @@ CREATE INPUT-BUFFER SOURCE 2,
 \ Any other values are implementation-defined, for example FD numbers for file input
 CREATE CURRENT-SOURCE-ID -1 ,
 
->>FORTH
+' FORTH (DEFINITIONS)
 
 \ Report the current input buffer region and SOURCE-ID
 : SOURCE  ( -- c-addr u )  INPUT-BUFFER 2@ ;
@@ -1153,7 +1158,7 @@ CREATE CURRENT-SOURCE-ID -1 ,
 : SAVE-INPUT  ( -- xu ... x1 u )  >IN @ 1 ;
 : RESTORE-INPUT  ( xu ... x1 u -- flag )  OVER >IN ! NDROP TRUE ;
 
->>SYSTEM
+' SYSTEM (DEFINITIONS)
 
 CREATE EXCEPTION-STACK NULL ,
 
@@ -1167,12 +1172,12 @@ CREATE EXCEPTION-STACK NULL ,
    R> CURRENT-SOURCE-ID ! ▪ 2R> INPUT-BUFFER 2! ▪ NR> RESTORE-INPUT DROP
    R> SWAP >R SP! R> ;
 
->>UTILITY
+' UTILITY (DEFINITIONS)
 
 \ Returns TRUE if currently executing inside CATCH, or FALSE otherwise
 : CATCHING?  ( -- flag )  EXCEPTION-STACK @ NULL<> ;
 
->>FORTH
+' FORTH (DEFINITIONS)
 
 \ Run xt while trapping calls to THROW, ABORT, FAIL, etc.
 \ On success has the effect of xt and also leaves the value 0 on top of the stack
@@ -1198,7 +1203,7 @@ CREATE EXCEPTION-STACK NULL ,
 
 : PARSE-AREA  ( -- c-addr u )  SOURCE >IN @ /STRING ;
 
->>UTILITY
+' UTILITY (DEFINITIONS)
 
 : PARSE-EMPTY?  ( -- flag )  SOURCE NIP >IN @ = ;
 
@@ -1212,7 +1217,7 @@ CREATE EXCEPTION-STACK NULL ,
 : SKIP-SPACES  ( "<spaces?>" -- )
    BEGIN ▪ PARSE-EMPTY? 0= WHILE ▪ PEEK-CHAR SPACE? WHILE ▪ SKIP-CHAR ▪ REPEAT ;
 
->>FORTH
+' FORTH (DEFINITIONS)
 
 \ Comments; ignore all characters until the next EOL or ) character, respectively
 : \  ( "ccc<eol>" -- )  IMMEDIATE BEGIN NEXT-CHAR LF = UNTIL ;
@@ -1238,7 +1243,7 @@ DEFER REFILL
 : CHAR  ( "<spaces?>name" -- c )
    PARSE-NAME DROP C@ ;
 
->>SYSTEM
+' SYSTEM (DEFINITIONS)
 
 \ Create the header for a word in the data space and return its xt
 \ The word is NOT added to the current compilation word list
@@ -1256,7 +1261,7 @@ DEFER REFILL
 \ The default target for DEFER words until initialized with DEFER! or IS
 : (DEFER-UNINITIALIZED)   EXCP-DEFER-UNINITIALIZED THROW ;
 
->>UTILITY
+' UTILITY (DEFINITIONS)
 
 \ Use to create words programmatically without reading the name from the input
 : (CREATE)  ( c-addr u -- )
@@ -1268,7 +1273,7 @@ DEFER REFILL
 : (:)  ( c-addr u -- )
    (CREATE) LATEST ▪ DUP (HIDE) ▪ DOCOL SWAP >CFA ! ▪ POSTPONE ] ;
 
->>FORTH
+' FORTH (DEFINITIONS)
 
 \ Append "<addr> (DOES) EXIT" to the current definition
 \ where <addr> is the next address after the "EXIT" as a literal number
@@ -1281,7 +1286,7 @@ DEFER REFILL
 : ;   IMMEDIATE
    POSTPONE EXIT POSTPONE [ LATEST DUP >NAME NIP IF (UNHIDE) ELSE DROP THEN ;
 
->>UTILITY
+' UTILITY (DEFINITIONS)
 
 \ Create a deferred word; the target is stored in the DFA field
 \ The default target throws an exception — replace it using DEFER! or IS
@@ -1331,7 +1336,7 @@ DEFER REFILL
 : MARK  ( "<spaces?>name" )  IMMEDIATE
    PARSE-NAME STATE @ IF POSTPONE SLITERAL POSTPONE (MARK) ELSE (MARK) THEN ;
 
->>FORTH
+' FORTH (DEFINITIONS)
 
 \ The utility words defined previously, but with the name read from the parse area
 : CREATE      PARSE-NAME (CREATE) ;
@@ -1357,7 +1362,7 @@ DEFER REFILL
 1 ALIGNED 1 CELLS 2CONSTANT CELL%
 1 ALIGNED 2 CELLS 2CONSTANT 2CELL%
 
->>UTILITY
+' UTILITY (DEFINITIONS)
 
 \ Extra field type descriptors for FFI structs
 \ Each type is naturally aligned (contrast int64% vs 2CELL%)
@@ -1382,7 +1387,7 @@ DEFER REFILL
    ▪  DUP ALIAS signed-long-long%
    ▪      ALIAS unsigned-long-long%
 
->>FORTH
+' FORTH (DEFINITIONS)
 
 \ Within STRUCT … ENDSTRUCT, define a field with the given alignment and size
 \ Each field word has runtime effect ( struct-addr -- field-addr)
@@ -1489,7 +1494,7 @@ DEFER REFILL
 \ [THEN] is just a placeholder to terminate [IF] or [ELSE]; no compilation effect
 : [THEN]   IMMEDIATE ;
 
->>SYSTEM
+' SYSTEM (DEFINITIONS)
 
 \ Orders 0 ... 17 with sizes 32 bytes ... 4 MiB
 32 CONSTANT BUDDY-MIN-BYTES
@@ -1554,7 +1559,7 @@ BUDDY-ORDERS ARRAY BUDDY-HEADS
 
 VARIABLE TOTAL
 
->>UTILITY
+' UTILITY (DEFINITIONS)
 
 : BUDDY-STATS
    0 TOTAL !
@@ -1567,7 +1572,7 @@ VARIABLE TOTAL
 
 ' TOTAL (HIDE)
 
->>LINUX
+' LINUX (DEFINITIONS)
 
 4 KB CONSTANT PAGESIZE
 
@@ -1579,7 +1584,7 @@ VARIABLE TOTAL
 2 CONSTANT MAP_PRIVATE
 32 CONSTANT MAP_ANONYMOUS
 
->>UTILITY
+' UTILITY (DEFINITIONS)
 
 \ Simple wrapper for munmap() that retries on EINTR
 : MMAP-UNMAP  ( addr length -- )
@@ -1601,7 +1606,7 @@ VARIABLE TOTAL
    R@ OVER R@ - MMAP-UNMAP
    DUP R> R@ 2* + SWAP R> + TUCK - MMAP-UNMAP ;
 
->>SYSTEM
+' SYSTEM (DEFINITIONS)
 
 STRUCT
    CELL%      FIELD MEMBLOCK>SIZE
@@ -1620,7 +1625,7 @@ ENDSTRUCT MEMBLOCK%
 : DATA>MEMBLOCK  ( obj-addr -- memblock-addr )
    MEMBLOCK-DATA-OFFSET - DUP MEMBLOCK-CHECK-MAGIC ;
 
->>FORTH
+' FORTH (DEFINITIONS)
 
 : ALLOCATE  ( size -- obj-addr )
    DUP 0= IF EXIT THEN
@@ -1644,7 +1649,7 @@ ENDSTRUCT MEMBLOCK%
       DUP BUDDY-ORDERS U< IF BUDDY-FREE ELSE MMAP-UNMAP THEN
    THEN ;
 
->>UTILITY
+' UTILITY (DEFINITIONS)
 
 : OBJECT-SIZE  ( obj-addr -- size )
    DUP IF
@@ -1654,7 +1659,7 @@ ENDSTRUCT MEMBLOCK%
       MEMBLOCK-DATA-OFFSET -
    THEN ;
 
->>FORTH
+' FORTH (DEFINITIONS)
 
 \ If size is 0 then free obj-addr1 (which may be NULL) and return NULL
 \ Otherwise if obj-addr1 is NULL then allocate size bytes
@@ -1689,7 +1694,7 @@ ENDSTRUCT MEMBLOCK%
 : DUPLICATE  ( c-addr u -- obj-addr u )
    DUP ALLOCATE >R >R 2R@ CMOVE 2R> ;
 
->>SYSTEM
+' SYSTEM (DEFINITIONS)
 
 \ Execute the closure captured at a-addr
 \ The memory at a-addr consists of a cell count, an xt, and >=0 cells of data
@@ -1699,7 +1704,7 @@ ENDSTRUCT MEMBLOCK%
 : (CLOSURE)  ( i*x a-addr -- j*x )
    DUP @ SWAP CELL+ N@ EXECUTE ;
 
->>FORTH
+' FORTH (DEFINITIONS)
 
 \ Read one cell and increment
 : @(+)  ( a-addr1 -- a-addr2 x )  DUP CELL+ SWAP @ ;
@@ -1734,7 +1739,7 @@ ENDSTRUCT MEMBLOCK%
 \ The content is indeterminate and must be initialized before the first use
 : %VARIABLE  ( align bytes "<spaces?>name" -- )  %ALLOT CONSTANT ;
 
->>SYSTEM
+' SYSTEM (DEFINITIONS)
 
 \ This structure describes one entry in the search order linked list
 STRUCT
@@ -1745,7 +1750,9 @@ ENDSTRUCT ORDER%
 VARIABLE CURRENT-ORDER
 NULL CURRENT-ORDER !
 
->>FORTH
+DEFER MINIMUM-ORDER
+
+' FORTH (DEFINITIONS)
 
 \ Return the current search order
 : GET-ORDER  ( -- widn ... wid1 n )
@@ -1774,27 +1781,16 @@ NULL CURRENT-ORDER !
 
 \ Set the current search order
 : SET-ORDER  ( widn ... wid1 n | -n -- )
-   DUP 0< IF DROP FORTH-WORDLIST 1 THEN
+   DUP 0< IF DROP MINIMUM-ORDER THEN
    \ Free the previous search order linked list
    NULL CURRENT-ORDER XCHG BEGIN ?DUP WHILE DUP ORDER>LINK @ SWAP FREE REPEAT
    \ Build the new search order linked list
    0 OVER ?DO I PICK PUSH-ORDER -1 +LOOP NDROP ;
 
-\ Prepare the initial search order
-BOOTSTRAP-GET-ORDER SET-ORDER
-
-\ Use the real search order as the bootstrap search order from now on
-' GET-ORDER ' BOOTSTRAP-GET-ORDER DEFER!
-
-\ Create a new wordlist
-\ In this implementation a word list is just a pointer to the most recent word
-: WORDLIST  ( -- wid )
-   ALIGN HERE NULL , ;
-
 \ Make the first list in the search order the current compilation word list
 : DEFINITIONS   PEEK-ORDER SET-CURRENT ;
 
-\ Run a function for each word in the given wordlist
+\ Run a function for each word in the given word list
 \ xt Execution:  ( i*x word-xt -- stop-flag j*x )
 : WITH-WORDLIST  ( i*x wid xt -- j*x )
    >R @ BEGIN ?DUP WHILE
@@ -1833,18 +1829,43 @@ BOOTSTRAP-GET-ORDER SET-ORDER
    "Current: " TYPE GET-CURRENT U. EOL ;
 : PREVIOUS   POP-ORDER DROP ;
 
-\ Define a new named wordlist
+\ Create a unnamed word list
+\ In this implementation a word list is just a pointer to the most recent word
+: WORDLIST  ( -- wid )
+   ALIGN HERE NULL , ;
+
+\ Define a new named word list
 \ Executing the word will replace the first item in the search order
 : VOCABULARY  ( "<spaces?>name" )
    CREATE NULL ,
    DOES>   POP-ORDER DROP PUSH-ORDER ;
 
-\ Names to select the predefined word lists
+' SYSTEM (DEFINITIONS)
+
+VOCABULARY ROOT
+{ [[ ' ROOT >WORDLIST ]] 1 } ' MINIMUM-ORDER DEFER!
+
+\ Redefine the predefined word lists as named vocabularies
 \ FORTH is a Search-Order extension word
-: FORTH   FORTH-WORDLIST POP-ORDER DROP PUSH-ORDER ;
-: LINUX   LINUX-WORDLIST POP-ORDER DROP PUSH-ORDER ;
-: UTILITY   UTILITY-WORDLIST POP-ORDER DROP PUSH-ORDER ;
-: SYSTEM   SYSTEM-WORDLIST POP-ORDER DROP PUSH-ORDER ;
+: CONVERT  ( xt -- )
+   [[ ' ROOT >CFA @ ]] OVER >CFA !
+   [[ ' ROOT >DFA @ ]] SWAP >DFA ! ;
+
+' FORTH CONVERT
+' UTILITY CONVERT
+' SYSTEM CONVERT
+' LINUX CONVERT
+
+' CONVERT (HIDE)
+
+\ Prepare the initial search order
+BOOTSTRAP-WORDLIST ▪ ' LINUX >WORDLIST ▪ ' UTILITY >WORDLIST
+   ' SYSTEM >WORDLIST ▪ ' FORTH >WORDLIST ▪ DUP ▪ 6 SET-ORDER
+
+\ Use the real search order as the bootstrap search order from now on
+' GET-ORDER ' BOOTSTRAP-GET-ORDER DEFER!
+
+FORTH DEFINITIONS
 
 \ Create a word to revert the search order, data space, and compilation word list
 \ to their respective states from immediately before the marker was defined.
@@ -1855,12 +1876,19 @@ BOOTSTRAP-GET-ORDER SET-ORDER
    CREATE ▪ DUP 4 + ▪ DUP 1+ ▪ HERE ▪ OVER CELLS ALLOT ▪ N!
    DOES>   @(+) SWAP N@ ▪ SET-ORDER ▪ SET-CURRENT ▪ LATEST! ▪ CP ! ;
 
->>SYSTEM
+SYSTEM DEFINITIONS
 
 DEFER FIND-HOOK  ( c-addr u -- c-addr u 0 | xt 1 | xt -1 )
 { 0 } ' FIND-HOOK DEFER!
 
->>FORTH
+ROOT DEFINITIONS
+
+' ONLY      ALIAS ONLY
+' FORTH     ALIAS FORTH
+' SET-ORDER ALIAS SET-ORDER
+' >WORDLIST ALIAS >WORDLIST
+
+FORTH DEFINITIONS
 
 \ Apply SEARCH-WORDLIST to each word list in the current search order
 : FIND  ( c-addr u -- c-addr u 0 | xt 1 | xt -1 )
@@ -1876,21 +1904,18 @@ DEFER FIND-HOOK  ( c-addr u -- c-addr u 0 | xt 1 | xt -1 )
    REPEAT
    2R> 0 ;
 
->>UTILITY
+UTILITY DEFINITIONS
 
 \ Same as FIND except that unknown words are reported and result in a call to THROW
 : FIND-OR-THROW  ( c-addr u -- xt 1 | xt -1 )
    FIND ?DUP 0= IF EXCP-UNDEFINED-WORD -ROT THROW-STRING THEN ;
 
->>FORTH
+FORTH DEFINITIONS
 
 \ Read a word from the input (during runtime) and return its execution token
 \ Aborts if the word is not found in the current (runtime) search order list
 : '  ( "<spaces?>name" -- xt )  PARSE-NAME FIND-OR-THROW DROP ;
 
-\ "Append to"; set the compilation namespace to the given vocabulary (e.g. FORTH)
-: >>  ( "<spaces?>name" -- )  ' ALSO EXECUTE DEFINITIONS PREVIOUS ;
-
 \ Read a word and append its compilation semantics to the current definition.
 : POSTPONE  ( "<spaces?>name" -- )  IMMEDIATE
    PARSE-NAME FIND-OR-THROW 0< IF
@@ -1953,7 +1978,7 @@ DEFER FIND-HOOK  ( c-addr u -- c-addr u 0 | xt 1 | xt -1 )
 : PRESERVED  ( i*x xt addr -- j*x )
    DUP @ >R >R CATCH 2R> ! RETHROW ;
 
->> SYSTEM
+SYSTEM DEFINITIONS
 
 \ The size of this buffer will determine the maximum line length
 4096 CONSTANT TERMINAL-BUFFER-BYTES
@@ -1963,7 +1988,7 @@ TERMINAL-BUFFER-BYTES ALLOCATE CONSTANT TERMINAL-BUFFER
 2VARIABLE TIB-LEFTOVER
 NULL 0 TIB-LEFTOVER 2!
 
->> FORTH
+FORTH DEFINITIONS
 
 \ Attempt to replace the parse area with the next line from the current source
 \ Return TRUE if the parse area was refilled, or FALSE otherwise
@@ -2003,7 +2028,7 @@ NULL 0 TIB-LEFTOVER 2!
    DUP IF 0 >IN ! THEN
    0<> ;
 
->> UTILITY
+UTILITY DEFINITIONS
 
 \ Parse up to limit digits in the given base, appending them to u1 to produce u2.
 : ESCAPED-DIGITS  ( u1 base limit -- u2 )
@@ -2036,12 +2061,12 @@ NULL 0 TIB-LEFTOVER 2!
       ENDCASE
    THEN ;
 
->> SYSTEM
+SYSTEM DEFINITIONS
 
 2VARIABLE STRING-BUFFER
 NULL 0 STRING-BUFFER 2!
 
->> UTILITY
+UTILITY DEFINITIONS
 
 \ Read a literal character string up to the next double-quote character
 \ The string is stored in a transient buffer and will become invalid when
@@ -2066,7 +2091,7 @@ NULL 0 STRING-BUFFER 2!
       ROT 2DUP + ESCAPED-CHAR SWAP C! -ROT 1+
    REPEAT ▪ NIP ;
 
->> SYSTEM
+SYSTEM DEFINITIONS
 
 : ?STACK   SP@ S0 > IF ▪ S0 SP! ▪ EXCP-STACK-UNDERFLOW THROW ▪ THEN ;
 
@@ -2106,14 +2131,14 @@ NULL 0 STRING-BUFFER 2!
       ?STACK
    REPEAT ;
 
->> FORTH
+FORTH DEFINITIONS
 
 : EVALUATE  ( i*x c-addr u -- j*x )
    SAVE-INPUT N>R ▪ SOURCE 2>R ▪ SOURCE-ID >R
    0 >IN ! ▪ INPUT-BUFFER 2! ▪ -1 CURRENT-SOURCE-ID ! ▪ INTERPRET
    R> CURRENT-SOURCE-ID ! ▪ 2R> INPUT-BUFFER 2! ▪ NR> RESTORE-INPUT DROP ;
 
->> LINUX
+LINUX DEFINITIONS
 
 ' unsigned-char% ALIAS cc%
 ' unsigned-int%  ALIAS speed%
@@ -2132,11 +2157,11 @@ ENDSTRUCT termios%
 
 0x5401 CONSTANT IOCTL_TCGETS
 
->> SYSTEM
+SYSTEM DEFINITIONS
 
 termios% %VARIABLE SCRATCH-TERMIOS
 
->> FORTH
+FORTH DEFINITIONS
 
 : TTY?  ( fd -- flag )
    IOCTL_TCGETS SCRATCH-TERMIOS SYS_IOCTL SYSCALL3 0= ;
@@ -2158,7 +2183,7 @@ STDIN TTY? CONSTANT INTERACTIVE?
       [THEN]
    AGAIN ;
 
->> SYSTEM
+SYSTEM DEFINITIONS
 
 32 CONSTANT #REPORTERS
 #REPORTERS 2ARRAY REPORTERS  ( reporter-xt exception-code )
@@ -2176,7 +2201,7 @@ REVERT
       THEN ▪ 2DROP
    LOOP ▪ DROP NULL FALSE ;
 
->> UTILITY
+UTILITY DEFINITIONS
 
 \ Set the reporter for the given exception code
 : REPORTER!  ( xt n -- )  ( xt: -- )
@@ -2191,7 +2216,7 @@ REVERT
       DUP ▪ ABS 0 <# #S ROT SIGN #> ▪ TYPE-ERR EOL ;
    THEN ;
 
->> SYSTEM
+SYSTEM DEFINITIONS
 
 { ( no message for ABORT )                 } EXCP-ABORT REPORTER!
 { THROWN-STRING 2@ TYPE-ERR "\n" TYPE-ERR  } EXCP-FAIL REPORTER!
@@ -2221,24 +2246,25 @@ REVERT
 \ Process the rest of the startup file and then switch to terminal input
 { PARSE-AREA EVALUATE QUIT } EXECUTE
 
-FORTH-WORDLIST 1 SET-ORDER
-DEFINITIONS
-
 \ *****************************************************************************
 \ Bootstrapping is complete
 \ From this point on we only execute threaded FORTH words defined in this file
 \ *****************************************************************************
 
+ONLY FORTH
 ALSO UTILITY
 ALSO SYSTEM
+ALSO
 
->> SYSTEM
+SYSTEM DEFINITIONS
 
 STRUCT
    CELL%     FIELD LOCAL>LINK
    CELL%     FIELD LOCAL>LENGTH
    CHAR% 0 * FIELD LOCAL>NAME-ADDR
 ENDSTRUCT LOCAL%
+
+\ Parameterize LOCAL% to include the length of the name
 : LOCAL%  ( u -- align bytes )  >R LOCAL% R> + ;
 
 : LOCAL>NAME  ( local -- c-addr u )  DUP LOCAL>NAME-ADDR SWAP LOCAL>LENGTH @ ;
@@ -2276,7 +2302,7 @@ REVERT
 \ immediately following the NULL-terminated array of argument pointers
 ARGV ARGC 1+ CELLS+ CONSTANT ENVIRON
 
->> FORTH
+FORTH DEFINITIONS
 
 \ Convert a C string to a FORTH string by counting the characters
 : CSTRING  ( c-addr -- c-addr u )  0 BEGIN 2DUP + C@ WHILE 1+ REPEAT ;
@@ -2317,11 +2343,11 @@ ARGV ARGC 1+ CELLS+ CONSTANT ENVIRON
    LOCAL-NAMES BEGIN ?DUP WHILE DUP LOCAL>LINK @ SWAP FREE REPEAT
    TO LOCAL-NAMES ▪ POSTPONE UNLOCALS ;
 
->> UTILITY
+UTILITY DEFINITIONS
 
 : (TRACE)  ( xt -- )  >NAME TYPE SPACE .S ;
 
->> FORTH
+FORTH DEFINITIONS
 
 \ Define a threaded word which also displays its name and the data stack when called
 : :TRACE  ( "<spaces?>name" -- )  : LATEST POSTPONE LITERAL POSTPONE (TRACE) ;
@@ -2359,7 +2385,7 @@ ARGV ARGC 1+ CELLS+ CONSTANT ENVIRON
       "∷" TYPE U.
    THEN ;
 
->> UTILITY
+UTILITY DEFINITIONS
 
 \ Display a string in escaped (double-quoted) format, without the delimiters
 : CONTROL-CHAR?  ( ch -- flag )  DUP 32 U< SWAP 127 = OR ;
@@ -2390,7 +2416,7 @@ ARGV ARGC 1+ CELLS+ CONSTANT ENVIRON
       ELSE NIP THEN
    THEN NIP ;
 
->> UTILITY
+UTILITY DEFINITIONS
 
 \ Display the threaded code which starts at a-addr
 \ Continues until it encounters a reference to EXIT beyond any forward branches
@@ -2447,7 +2473,7 @@ ARGV ARGC 1+ CELLS+ CONSTANT ENVIRON
       SWAP "CREATE " TYPE >NAME TYPE " … ;CODE … END-CODE\n" TYPE
    ENDCASE ;
 
->> FORTH
+FORTH DEFINITIONS
 
 : SEE  ( "<spaces?>name" -- )  ' (SEE) ;
 
@@ -2462,7 +2488,7 @@ ARGV ARGC 1+ CELLS+ CONSTANT ENVIRON
 \ node at the beginning of a list, or NULL if the list is empty. &link is the
 \ address of either a cell holding the head of the list or a node's link field.
 
->> UTILITY
+UTILITY DEFINITIONS
 
 \ Put the even items from head into head1 and the odd items into head2
 : SPLIT  ( head link-xt -- head1 head2 )
@@ -2488,7 +2514,7 @@ ARGV ARGC 1+ CELLS+ CONSTANT ENVIRON
       ( S: head1 head2' &link2  R: link-xt compare-xt head )
    AGAIN ;
 
->> FORTH
+FORTH DEFINITIONS
 
 \ Return TRUE if the given list is sorted, or FALSE otherwise
 : SORTED?  ( head link-xt compare-xt -- flag )
@@ -2518,7 +2544,7 @@ ARGV ARGC 1+ CELLS+ CONSTANT ENVIRON
 : MERGE-SORT>  ( head1 link-xt compare-xt -- head2 )
    [[ ' NEGATE ]] COMPOSE DUP >R MERGE-SORT R> FREE-CLOSURE ;
 
->> UTILITY
+UTILITY DEFINITIONS
 
 \ AA Tree, a variation on the Red-Black Tree
 \ <https://en.wikipedia.org/wiki/AA_tree>
@@ -2541,7 +2567,7 @@ STRUCT
    CELL% FIELD AA>COMPARE  ( aa-compare-xt )
 ENDSTRUCT AA-TREE%
 
->> SYSTEM
+SYSTEM DEFINITIONS
 
 : AA-INIT-LEAF  ( aa-node -- )
    NULL OVER AA>LEFT ! ▪ NULL OVER AA>RIGHT ! ▪ 1 SWAP AA>LEVEL ! ;
@@ -2653,7 +2679,7 @@ ENDSTRUCT AA-TREE%
       right-xt FREE-CLOSURE
    ENDLOCALS ;
 
->> UTILITY
+UTILITY DEFINITIONS
 
 : NEW-AA-TREE  ( aa-value-xt aa-compare-xt -- aa-tree )
    AA-TREE% %ALLOCATE ▪ TUCK AA>COMPARE ! ▪ TUCK AA>VALUE ! ▪ NULL OVER AA>ROOT ! ;
@@ -2691,6 +2717,8 @@ ENDSTRUCT AA-TREE%
 : AA-#NODES  ( aa-tree -- u )
    >R 0 { NIP >R EXECUTE R> EXECUTE 1+ } [[ ' ▪ ]] R> AA-TRAVERSE ;
 
+LINUX DEFINITIONS
+
 STRUCT
    unsigned-long-long% FIELD stat64>dev
    unsigned-char% 4 *  FIELD stat64>__pad0
@@ -2713,7 +2741,7 @@ STRUCT
    unsigned-long-long% FIELD stat64>ino
 ENDSTRUCT stat64%
 
->> FORTH
+FORTH DEFINITIONS
 
 ALSO LINUX
 O_RDONLY CONSTANT R/O  ( -- fam )
@@ -2743,8 +2771,7 @@ PREVIOUS
 
 : FILE-STATUS  ( c-addr u -- x ) ;
 
-FORTH-WORDLIST 1 SET-ORDER
-DEFINITIONS
+ONLY FORTH DEFINITIONS
 
 : BANNER   "JumpForth version " TYPE VERSION . ", by Jesse McDonald\n" TYPE ;