1 \ @(#) case.fth 98/01/26 1.2
\r
4 \ This definition is based upon Wil Baden's assertion that
\r
5 \ >MARK >RESOLVE ?BRANCH etc. are not needed if one has IF ELSE THEN etc.
\r
8 \ Copyright 1994 3DO, Phil Burk, Larry Polansky, Devid Rosenboom
\r
10 \ The pForth software code is dedicated to the public domain,
\r
11 \ and any third party may reproduce, distribute and modify
\r
12 \ the pForth software code or any derivative works thereof
\r
13 \ without any compensation or license. The pForth software
\r
14 \ code is provided on an "as is" basis without any warranty
\r
15 \ of any kind, including, without limitation, the implied
\r
16 \ warranties of merchantability and fitness for a particular
\r
17 \ purpose and their equivalents under the laws of any jurisdiction.
\r
19 \ MOD: PLB 6/24/91 Check for missing ENDOF
\r
20 \ MOD: PLB 8/7/91 Add ?OF and RANGEOF
\r
21 \ MOD: PLB 11/2/99 Fixed nesting of CASE. Needed to save of-depth on stack as well as case-depth.
\r
28 : CASE ( n -- , start case statement ) ( -c- case-depth )
\r
30 of-depth @ 0 of-depth ! \ 11/2/99
\r
31 case-depth @ 0 case-depth ! ( allow nesting )
\r
34 : ?OF ( n flag -- | n , doit if true ) ( -c- addr )
\r
41 : OF ( n t -- | n , doit if match ) ( -c- addr )
\r
43 compile over compile =
\r
47 : (RANGEOF?) ( n lo hi -- | n flag )
\r
48 >r over ( n lo n ) <=
\r
50 dup r> ( n n hi ) <=
\r
56 : RANGEOF ( n lo hi -- | n , doit if within ) ( -c- addr )
\r
61 : ENDOF ( -- ) ( addr -c- addr' )
\r
66 : ENDCASE ( n -- ) ( old-case-depth addr' addr' ??? -- )
\r
68 IF >newline ." Missing ENDOF in CASE!" cr abort
\r