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

44
startup.4th
View File

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