-\ @(#) case.fth 98/01/26 1.2\r
-\ CASE Statement\r
-\\r
-\ This definition is based upon Wil Baden's assertion that\r
-\ >MARK >RESOLVE ?BRANCH etc. are not needed if one has IF ELSE THEN etc.\r
-\\r
-\ Author: Phil Burk\r
-\ Copyright 1994 3DO, Phil Burk, Larry Polansky, Devid Rosenboom\r
-\\r
-\ The pForth software code is dedicated to the public domain,\r
-\ and any third party may reproduce, distribute and modify\r
-\ the pForth software code or any derivative works thereof\r
-\ without any compensation or license. The pForth software\r
-\ code is provided on an "as is" basis without any warranty\r
-\ of any kind, including, without limitation, the implied\r
-\ warranties of merchantability and fitness for a particular\r
-\ purpose and their equivalents under the laws of any jurisdiction.\r
-\\r
-\ MOD: PLB 6/24/91 Check for missing ENDOF\r
-\ MOD: PLB 8/7/91 Add ?OF and RANGEOF\r
-\ MOD: PLB 11/2/99 Fixed nesting of CASE. Needed to save of-depth on stack as well as case-depth.\r
-\r
-anew TASK-CASE\r
-\r
-variable CASE-DEPTH\r
-variable OF-DEPTH\r
-\r
-: CASE ( n -- , start case statement ) ( -c- case-depth )\r
- ?comp\r
- of-depth @ 0 of-depth ! \ 11/2/99\r
- case-depth @ 0 case-depth ! ( allow nesting )\r
-; IMMEDIATE\r
-\r
-: ?OF ( n flag -- | n , doit if true ) ( -c- addr )\r
- [compile] IF\r
- compile drop\r
- 1 case-depth +!\r
- 1 of-depth +!\r
-; IMMEDIATE\r
-\r
-: OF ( n t -- | n , doit if match ) ( -c- addr )\r
- ?comp\r
- compile over compile =\r
- [compile] ?OF\r
-; IMMEDIATE\r
-\r
-: (RANGEOF?) ( n lo hi -- | n flag )\r
- >r over ( n lo n ) <=\r
- IF\r
- dup r> ( n n hi ) <=\r
- ELSE\r
- rdrop false\r
- THEN\r
-;\r
-\r
-: RANGEOF ( n lo hi -- | n , doit if within ) ( -c- addr )\r
- compile (rangeof?)\r
- [compile] ?OF\r
-; IMMEDIATE\r
-\r
-: ENDOF ( -- ) ( addr -c- addr' )\r
- [compile] ELSE\r
- -1 of-depth +!\r
-; IMMEDIATE\r
-\r
-: ENDCASE ( n -- ) ( old-case-depth addr' addr' ??? -- )\r
- of-depth @\r
- IF >newline ." Missing ENDOF in CASE!" cr abort\r
- THEN\r
-\\r
- compile drop\r
- case-depth @ 0\r
- ?DO [compile] THEN\r
- LOOP\r
- case-depth !\r
- of-depth !\r
-; IMMEDIATE\r
-\r
+\ @(#) case.fth 98/01/26 1.2
+\ CASE Statement
+\
+\ This definition is based upon Wil Baden's assertion that
+\ >MARK >RESOLVE ?BRANCH etc. are not needed if one has IF ELSE THEN etc.
+\
+\ Author: Phil Burk
+\ Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
+\
+\ Permission to use, copy, modify, and/or distribute this
+\ software for any purpose with or without fee is hereby granted.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
+\ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
+\ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
+\ THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
+\ CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING
+\ FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
+\ CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+\ OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+\
+\ MOD: PLB 6/24/91 Check for missing ENDOF
+\ MOD: PLB 8/7/91 Add ?OF and RANGEOF
+\ MOD: PLB 11/2/99 Fixed nesting of CASE. Needed to save of-depth on stack as well as case-depth.
+
+anew TASK-CASE
+
+variable CASE-DEPTH
+variable OF-DEPTH
+
+: CASE ( n -- , start case statement ) ( -c- case-depth )
+ ?comp
+ of-depth @ 0 of-depth ! \ 11/2/99
+ case-depth @ 0 case-depth ! ( allow nesting )
+; IMMEDIATE
+
+: ?OF ( n flag -- | n , doit if true ) ( -c- addr )
+ [compile] IF
+ compile drop
+ 1 case-depth +!
+ 1 of-depth +!
+; IMMEDIATE
+
+: OF ( n t -- | n , doit if match ) ( -c- addr )
+ ?comp
+ compile over compile =
+ [compile] ?OF
+; IMMEDIATE
+
+: (RANGEOF?) ( n lo hi -- | n flag )
+ >r over ( n lo n ) <=
+ IF
+ dup r> ( n n hi ) <=
+ ELSE
+ rdrop false
+ THEN
+;
+
+: RANGEOF ( n lo hi -- | n , doit if within ) ( -c- addr )
+ compile (rangeof?)
+ [compile] ?OF
+; IMMEDIATE
+
+: ENDOF ( -- ) ( addr -c- addr' )
+ [compile] ELSE
+ -1 of-depth +!
+; IMMEDIATE
+
+: ENDCASE ( n -- ) ( old-case-depth addr' addr' ??? -- )
+ of-depth @
+ IF >newline ." Missing ENDOF in CASE!" cr abort
+ THEN
+\
+ compile drop
+ case-depth @ 0
+ ?DO [compile] THEN
+ LOOP
+ case-depth !
+ of-depth !
+; IMMEDIATE
+