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