diff --git a/jumpforth.S b/jumpforth.S index 8a15684..4e3e252 100644 --- a/jumpforth.S +++ b/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 diff --git a/startup.4th b/startup.4th index ba8b174..d2a2526 100644 --- a/startup.4th +++ b/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 "name" -- ) ' STATE @ IF POSTPONE LITERAL POSTPONE DEFER! ELSE DEFER! THEN ; +: ACTION-OF ( "name" -- ; -- xt ) IMMEDIATE + ' STATE @ IF POSTPONE LITERAL POSTPONE DEFER@ ELSE DEFER@ THEN ; + +: DEFERS ( "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| ( "name1…namen|" -- ; 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