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

add OF? for logical tests in CASE structures

This commit is contained in:
Jesse D. McDonald 2020-11-05 17:01:39 -06:00
parent 0ee566ea39
commit 50fe63b104
1 changed files with 6 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
startup.4th
View File

@ -915,12 +915,15 @@ DEFER QUIT
\ a forward reference to the ENDOF (as with IF ... THEN) above the ENDCASE counter. \ a forward reference to the ENDOF (as with IF ... THEN) above the ENDCASE counter.
\ \
\ Begin by creating a placeholder for the unresolved ENDOF forward references \ Begin by creating a placeholder for the unresolved ENDOF forward references
: CASE ( C: -- NULL ) IMMEDIATE : CASE ( C: -- null-orig ) IMMEDIATE
POSTPONE (ALWAYS) ; POSTPONE (ALWAYS) ;
\ At runtime test the flag on top of the stack; branch to ENDOF if false
: OF? ( C: orig-case -- orig-case orig-of ; x flag -- x ) IMMEDIATE
POSTPONE (ALWAYS) POSTPONE (ONWARD-IF) POSTPONE DROP ;
\ At runtime compare the values on the top of the stack; branch to ENDOF if unequal \ At runtime compare the values on the top of the stack; branch to ENDOF if unequal
\ Keep the first value for the next OF if unequal, otherwise consume both \ Keep the first value for the next OF if unequal, otherwise consume both
: OF ( C: orign ... orig1 n -- orign ... orig1 n orig-of ) IMMEDIATE : OF ( C: orign ... orig1 n -- orign ... orig1 n orig-of ) IMMEDIATE
POSTPONE OVER POSTPONE = POSTPONE (ALWAYS) POSTPONE (ONWARD-IF) POSTPONE DROP ; POSTPONE OVER POSTPONE = POSTPONE OF? ;
\ Create a forward branch to ENDCASE and resolve the one from OF \ Create a forward branch to ENDCASE and resolve the one from OF
: ENDOF ( C: orig-case1 orig-of -- orig-case2 ) IMMEDIATE : ENDOF ( C: orig-case1 orig-of -- orig-case2 ) IMMEDIATE
SWAP POSTPONE (ONWARD-AHEAD) SWAP POSTPONE (THEN) ; SWAP POSTPONE (ONWARD-AHEAD) SWAP POSTPONE (THEN) ;
@ -2000,7 +2003,7 @@ NULL 0 TIB-LEFTOVER 2!
[[ CHAR " ]] OF [[ CHAR " ]] ENDOF [[ CHAR " ]] OF [[ CHAR " ]] ENDOF
[[ CHAR ' ]] OF [[ CHAR ' ]] ENDOF [[ CHAR ' ]] OF [[ CHAR ' ]] ENDOF
[[ CHAR \ ]] OF [[ CHAR \ ]] ENDOF [[ CHAR \ ]] OF [[ CHAR \ ]] ENDOF
TO-LOWER [[ CHAR x ]] OF DUP TO-LOWER [[ CHAR x ]] = OF?
NEXT-CHAR 16 >DIGIT-BASE 0= "Invalid \\x… escape sequence" ?FAIL NEXT-CHAR 16 >DIGIT-BASE 0= "Invalid \\x… escape sequence" ?FAIL
16 1 ESCAPED-DIGITS 16 1 ESCAPED-DIGITS
ENDOF ENDOF