nybble
/
jumpforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

unify AGAIN and REPEAT; allow multiple WHILEs and BEGIN … WHILE … UNTIL

This commit is contained in:
Jesse D. McDonald 2020-10-27 21:18:17 -05:00
parent 1ceedba773
commit 28559fc98c
1 changed files with 21 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
startup.4th
View File

@ -879,17 +879,16 @@ REPLACE-BOOTSTRAP
\ includes no branch. The "orig" value it leaves on the stack (NULL) is ignored \ includes no branch. The "orig" value it leaves on the stack (NULL) is ignored
\ by THEN and marks the end of the list if consumed by ONWARD-IF or ONWARD-AHEAD. \ 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. \ This can be used as a base for control structures with zero or more branches.
\
\ The low-level primitives: : ALWAYS ( C: -- null-orig ) IMMEDIATE
: ALWAYS ( C: -- orig ) IMMEDIATE NULL ; NULL ;
: ONWARD-IF ( C: orig1 -- orig2 ) IMMEDIATE : ONWARD-IF ( C: orig1 -- orig2 ) ( Runtime: flag -- ) IMMEDIATE
POSTPONE 0BRANCH HERE SWAP , ; POSTPONE 0BRANCH HERE SWAP , ;
: ONWARD-AHEAD ( C: orig1 -- orig2 ) IMMEDIATE : ONWARD-AHEAD ( C: orig1 -- orig2 ) IMMEDIATE
POSTPONE BRANCH HERE SWAP , ; POSTPONE BRANCH HERE SWAP , ;
: THEN ( C: orig -- ) IMMEDIATE : THEN ( C: orig -- ) IMMEDIATE
BEGIN ?DUP WHILE HERE OVER - SWAP XCHG REPEAT ; BEGIN ?DUP WHILE HERE OVER - SWAP XCHG REPEAT ;
\ The derived control structures: : IF ( C: -- orig ) ( Runtime: flag -- ) IMMEDIATE
: IF ( C: -- orig ) ( Runtime S: flag -- ) IMMEDIATE
POSTPONE ALWAYS POSTPONE ONWARD-IF ; POSTPONE ALWAYS POSTPONE ONWARD-IF ;
: AHEAD ( C: -- orig ) IMMEDIATE : AHEAD ( C: -- orig ) IMMEDIATE
POSTPONE ALWAYS POSTPONE ONWARD-AHEAD ; POSTPONE ALWAYS POSTPONE ONWARD-AHEAD ;
@ -900,29 +899,26 @@ REPLACE-BOOTSTRAP
\ Examples: \ Examples:
\ <cond1> AND-THEN <cond2> THEN \ <cond1> AND-THEN <cond2> THEN
\ <cond1> OR-ELSE <cond2> THEN \ <cond1> OR-ELSE <cond2> THEN
: AND-THEN ( C: -- orig ) ( Runtime S: flag -- FALSE | <dropped> ) IMMEDIATE : AND-THEN ( C: -- orig ) ( Runtime: flag -- FALSE | <dropped> ) IMMEDIATE
POSTPONE DUP POSTPONE IF POSTPONE DROP ; POSTPONE ?0DUP POSTPONE IF ;
: OR-ELSE ( C: -- orig ) ( Runtime S: flag -- nonzero-flag | <dropped> ) IMMEDIATE : OR-ELSE ( C: -- orig ) ( Runtime: flag -- nonzero-flag | <dropped> ) IMMEDIATE
POSTPONE ?DUP POSTPONE 0= POSTPONE IF ; POSTPONE ?DUP POSTPONE 0= POSTPONE IF ;
\ Unbounded loop: BEGIN <body> AGAIN \ Unbounded loop: BEGIN <body> AGAIN
\ BEGIN places the offset of the start of <code> on the stack. \ Simple conditional loop: BEGIN <condition> UNTIL
\ AGAIN creates a relative branch back to the start of <code>. \ Mid-loop condition(s): BEGIN <cond1> WHILE {<cond2> WHILE}… <body> REPEAT
: BEGIN ( C: -- dest ) IMMEDIATE \ Mixed WHILE/UNTIL loop: BEGIN <cond1> WHILE <cond2> UNTIL
HERE ;
: AGAIN ( C: dest -- ) IMMEDIATE
POSTPONE BRANCH HERE - , ;
\ Simple conditional loop: BEGIN <body> UNTIL : BEGIN ( C: -- null-orig dest ) IMMEDIATE
\ UNTIL consumes the top of the stack and branches back to BEGIN if the value was FALSE. POSTPONE ALWAYS ▪ HERE ;
: UNTIL ( C: dest -- ) ( Runtime S: flag -- ) IMMEDIATE : AGAIN ( C: orig dest -- ) IMMEDIATE
POSTPONE 0BRANCH HERE - , ; POSTPONE BRANCH ▪ HERE - , ▪ POSTPONE THEN ;
: UNTIL ( C: orig dest -- ) ( Runtime: flag -- ) IMMEDIATE
\ Alternate conditional loop: BEGIN <condition> WHILE <body> REPEAT POSTPONE 0BRANCH HERE - , POSTPONE THEN ;
: WHILE ( C: dest -- orig dest ) ( Runtime S: flag -- ) IMMEDIATE : WHILE ( C: orig1 dest -- orig2 dest ) ( Runtime: flag -- ) IMMEDIATE
POSTPONE IF SWAP ; SWAP POSTPONE ONWARD-IF SWAP ;
: REPEAT ( C: orig dest -- ) IMMEDIATE : REPEAT ( C: orig dest -- ) IMMEDIATE
POSTPONE AGAIN POSTPONE THEN ; POSTPONE AGAIN ;
\ Sequential equality tests: \ Sequential equality tests:
\ <x> CASE \ <x> CASE