sys/boot/ficl/softwords/ifbrack.fr

   1 \ ** ficl/softwords/ifbrack.fr
   2 \ ** ANS conditional compile directives [if] [else] [then]
   3 \ ** Requires ficl 2.0 or greater...
   4 \
   5 \ $FreeBSD$
   6
   7 hide
   8
   9 : ?[if]   ( c-addr u -- c-addr u flag )
  10     2dup s" [if]" compare-insensitive 0=
  11 ;
  12
  13 : ?[else]   ( c-addr u -- c-addr u flag )
  14     2dup s" [else]" compare-insensitive 0=
  15 ;
  16
  17 : ?[then]   ( c-addr u -- c-addr u flag )
  18     2dup s" [then]" compare-insensitive 0= >r
  19     2dup s" [endif]" compare-insensitive 0= r>
  20     or
  21 ;
  22
  23 set-current
  24
  25 : [else]  ( -- )
  26     1                                     \ ( level )
  27     begin
  28       begin
  29         parse-word dup  while             \ ( level addr len )
  30         ?[if] if                          \ ( level addr len )
  31             2drop 1+                      \ ( level )
  32         else                              \ ( level addr len )
  33             ?[else] if                    \ ( level addr len )
  34                  2drop 1- dup if 1+ endif
  35             else
  36                 ?[then] if 2drop 1- else 2drop endif
  37             endif
  38         endif ?dup 0=  if exit endif      \ level
  39       repeat  2drop                       \ level
  40     refill 0= until                       \ level
  41     drop
  42 ;  immediate
  43
  44 : [if]  ( flag -- )
  45 0= if postpone [else] then ;  immediate
  46
  47 : [then]  ( -- )  ;  immediate
  48 : [endif]  ( -- )  ;  immediate
  49
  50 previous