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