( case DAY 05.04.2001 )

\ CASE's may be nested
decimal
variable   csp    \ pointer to 
                  \ control stack
6 constant l-cas# \ nesting level
create     s-csp   
l-cas# cells allot \ control stack
s-csp csp !

: +csp ( -> p)    \ all level
  csp @ dup cell+ csp !
;
: -csp ( -> )     \ remove level
  csp @ 1 cells - csp !
;
: !csp ( -> )     \ init level
  sp@ +csp !
;
: csp@ ( -> a)
  csp @ 1 cells - @
;
: ?csp ( -> )  
  sp@ csp@ <> -22 ?throw
  -csp
;
: case ( -> )
  !csp
; immediate
: of
  postpone over postpone =
  [compile] if postpone drop
; immediate
: endof
  [compile] else
; immediate
: endcase
  postpone drop begin sp@ csp@ =
  0=  while  [compile] then  repeat 
  -csp
; immediate
