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: src/sys/boot/ficl/softwords/ifbrack.fr,v 1.3 2002/04/09 17:45:27 dcs Exp $
   6 \ $DragonFly: src/sys/boot/ficl/softwords/ifbrack.fr,v 1.3 2003/11/10 06:08:34 dillon Exp $
   7
   8 hide
   9
  10 : ?[if]   ( c-addr u -- c-addr u flag )
  11     2dup s" [if]" compare-insensitive 0=
  12 ;
  13
  14 : ?[else]   ( c-addr u -- c-addr u flag )
  15     2dup s" [else]" compare-insensitive 0=
  16 ;
  17
  18 : ?[then]   ( c-addr u -- c-addr u flag )
  19     2dup s" [then]" compare-insensitive 0= >r
  20     2dup s" [endif]" compare-insensitive 0= r>
  21     or
  22 ;
  23
  24 set-current
  25
  26 : [else]  ( -- )
  27     1                                     \ ( level )
  28     begin
  29       begin
  30         parse-word dup  while             \ ( level addr len )
  31         ?[if] if                          \ ( level addr len )
  32             2drop 1+                      \ ( level )
  33         else                              \ ( level addr len )
  34             ?[else] if                    \ ( level addr len )
  35                  2drop 1- dup if 1+ endif
  36             else
  37                 ?[then] if 2drop 1- else 2drop endif
  38             endif
  39         endif ?dup 0=  if exit endif      \ level
  40       repeat  2drop                       \ level
  41     refill 0= until                       \ level
  42     drop
  43 ;  immediate
  44
  45 : [if]  ( flag -- )
  46 0= if postpone [else] then ;  immediate
  47
  48 : [then]  ( -- )  ;  immediate
  49 : [endif]  ( -- )  ;  immediate
  50
  51 previous