add a form of LOCALS|…| for named local variables

jumpforth.S

@@ -1045,6 +1045,24 @@ defcode ZBRANCH,"0BRANCH"
    lodsl
    NEXT
 
+.macro deflocals idx:req,fetch_label:req,fetch_name:req,store_label:req,store_name:req
+defcode \fetch_label,\fetch_name
+   pushl ((\idx + 1) * 4)(%ebp)
+   NEXT
+defcode \store_label,\store_name
+   popl ((\idx + 1) * 4)(%ebp)
+   NEXT
+.endm
+
+deflocals 0,FETCH_L0,"L0@",STORE_L0,"L0!"
+deflocals 1,FETCH_L1,"L1@",STORE_L1,"L1!"
+deflocals 2,FETCH_L2,"L2@",STORE_L2,"L2!"
+deflocals 3,FETCH_L3,"L3@",STORE_L3,"L3!"
+deflocals 4,FETCH_L4,"L4@",STORE_L4,"L4!"
+deflocals 5,FETCH_L5,"L5@",STORE_L5,"L5!"
+deflocals 6,FETCH_L6,"L6@",STORE_L6,"L6!"
+deflocals 7,FETCH_L7,"L7@",STORE_L7,"L7!"
+
 defcode EXIT
    POPRSP %esi
    NEXT

startup.4th

@@ -1820,8 +1820,16 @@ 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
+
+DEFER FIND-HOOK  ( c-addr u -- c-addr u 0 | xt 1 | xt -1 )
+{ 0 } ' FIND-HOOK DEFER!
+
+>>FORTH
+
 \ Apply SEARCH-WORDLIST to each word list in the current search order
 : FIND  ( c-addr u -- c-addr u 0 | xt 1 | xt -1 )
+   FIND-HOOK ?DUP IF EXIT THEN
    2>R GET-ORDER
    BEGIN
       ?DUP
@@ -1863,6 +1871,12 @@ BOOTSTRAP-GET-ORDER SET-ORDER
       ( Interpret: xt "<spaces?>name" -- )
    ' STATE @ IF POSTPONE LITERAL POSTPONE DEFER! ELSE DEFER! THEN ;
 
+: ACTION-OF  ( "<spaces?>name" -- ; -- xt )  IMMEDIATE
+   ' STATE @ IF POSTPONE LITERAL POSTPONE DEFER@ ELSE DEFER@ THEN ;
+
+: DEFERS  ( "<spaces?>name" -- ; i*x -- j*x )  IMMEDIATE
+   ' DEFER@ COMPILE, ;
+
 \ When compiling, append code to store to the data field area of the named value.
 \ When interpreting, store to the data field directly.
 \ An ambiguous condition exists if the name was not created with VALUE.
@@ -2166,6 +2180,69 @@ DEFINITIONS
 \ *****************************************************************************
 
 ALSO UTILITY
+ALSO SYSTEM
+
+>> SYSTEM
+
+STRUCT
+   CELL%     FIELD LOCAL>LINK
+   CELL%     FIELD LOCAL>LENGTH
+   CHAR% 0 * FIELD LOCAL>NAME-ADDR
+ENDSTRUCT LOCAL%
+: LOCAL%  ( u -- align bytes )  >R LOCAL% R> + ;
+
+: LOCAL>NAME  ( local -- c-addr u )  DUP LOCAL>NAME-ADDR SWAP LOCAL>LENGTH @ ;
+
+NULL VALUE LOCAL-NAMES
+
+8 CONSTANT #LOCALS
+#LOCALS ARRAY LOCAL-FETCHERS
+#LOCALS ARRAY LOCAL-STORERS
+
+MARKER REVERT
+{ #LOCALS 0 ?DO ' I LOCAL-FETCHERS ! ' I LOCAL-STORERS ! LOOP } EXECUTE
+   L0@ L0!   L1@ L1!   L2@ L2!   L3@ L3!
+   L4@ L4!   L5@ L5!   L6@ L6!   L7@ L7!
+REVERT
+
+: LOCAL-INDEX  ( c-addr u1 -- u2 TRUE | FALSE )
+   LOCAL-NAMES #LOCALS 0 ?DO
+      DUP NULL= IF LEAVE THEN
+      >R 2DUP R@ LOCAL>NAME COMPARE R> SWAP 0= IF
+         DROP 2DROP I TRUE UNLOOP EXIT
+      THEN
+      LOCAL>LINK @
+   LOOP ▪ DROP ▪ 2DROP ▪ FALSE ;
+
+: LOCAL-LOOKUP  ( c-addr u -- c-addr u 0 | xt 1 | xt -1 )
+   2DUP FALSE >R
+   DUP 1 > IF ▪ 2DUP + 1- C@ [[ CHAR ! ]] = IF ▪ 1- RDROP TRUE >R ▪ THEN ▪ THEN
+   LOCAL-INDEX 0= IF RDROP 0 EXIT THEN
+   R> 2NIP IF LOCAL-STORERS ELSE LOCAL-FETCHERS THEN @ 1 ;
+
+{ LOCAL-LOOKUP ?DUP 0= IF DEFERS FIND-HOOK THEN } IS FIND-HOOK
+
+>> FORTH
+
+: LOCALS|  ( "<spaces?>name1…<spaces>namen<spaces>|" -- ; xn … x1 -- )   IMMEDIATE
+   LOCAL-NAMES ▪ NULL TO LOCAL-NAMES
+   0 BEGIN
+      PARSE-NAME
+      2DUP "|" COMPARE 0<>
+   WHILE
+      DUP LOCAL% %ALLOCATE
+      LOCAL-NAMES OVER LOCAL>LINK !
+      2DUP LOCAL>LENGTH !
+      >R R@ LOCAL>NAME-ADDR SWAP CMOVE
+      R> TO LOCAL-NAMES
+      1+
+   REPEAT ▪ 2DROP ▪ POSTPONE LITERAL POSTPONE N>R ;
+
+: UNLOCALS   IMMEDIATE   POSTPONE NRDROP ;
+
+: ENDLOCALS   IMMEDIATE
+   LOCAL-NAMES BEGIN ?DUP WHILE DUP LOCAL>LINK @ SWAP FREE REPEAT
+   TO LOCAL-NAMES ▪ POSTPONE UNLOCALS ;
 
 \ Define a threaded word which also displays its name and the data stack when called
 >> UTILITY