ifbrack.fr revision 76116 
151786Sdcs\ ** ficl/softwords/ifbrack.fr
251786Sdcs\ ** ANS conditional compile directives [if] [else] [then]
351786Sdcs\ ** Requires ficl 2.0 or greater...
451786Sdcs
551786Sdcs\ $FreeBSD: head/sys/boot/ficl/softwords/ifbrack.fr 76116 2001-04-29 02:36:36Z dcs $
651786Sdcs
776116Sdcshide
851786Sdcs
951786Sdcs: ?[if]   ( c-addr u -- c-addr u flag )
1051786Sdcs    2dup 2dup
1151786Sdcs    s" [if]" compare 0= >r
1251786Sdcs    s" [IF]" compare 0= r> 
1351786Sdcs    or
1451786Sdcs;
1551786Sdcs
1651786Sdcs: ?[else]   ( c-addr u -- c-addr u flag )
1751786Sdcs    2dup 2dup
1851786Sdcs    s" [else]" compare 0= >r
1951786Sdcs    s" [ELSE]" compare 0= r> 
2051786Sdcs    or
2151786Sdcs;
2251786Sdcs
2351786Sdcs: ?[then]   ( c-addr u -- c-addr u flag )
2451786Sdcs    2dup 2dup
2551786Sdcs    s" [then]" compare 0= >r
2651786Sdcs    s" [THEN]" compare 0= r> 
2751786Sdcs    or
2851786Sdcs;
2951786Sdcs
3051786Sdcsset-current
3151786Sdcs
3251786Sdcs: [else]  ( -- )
3351786Sdcs    1                                     \ ( level )
3451786Sdcs    begin
3551786Sdcs      begin
3651786Sdcs        parse-word dup  while             \ ( level addr len )
3751786Sdcs        ?[if] if                          \ ( level addr len )
3851786Sdcs            2drop 1+                      \ ( level )
3951786Sdcs        else                              \ ( level addr len )
4051786Sdcs            ?[else] if                    \ ( level addr len )
4151786Sdcs                 2drop 1- dup if 1+ endif
4251786Sdcs            else
4351786Sdcs                ?[then] if 2drop 1- else 2drop endif 
4451786Sdcs            endif
4551786Sdcs        endif ?dup 0=  if exit endif      \ level
4651786Sdcs      repeat  2drop                       \ level
4751786Sdcs    refill 0= until                       \ level
4851786Sdcs    drop
4951786Sdcs;  immediate
5051786Sdcs
5151786Sdcs: [if]  ( flag -- )
5251786Sdcs0= if postpone [else] then ;  immediate
5351786Sdcs
5451786Sdcs: [then]  ( -- )  ;  immediate
5551786Sdcs
5651786Sdcsprevious
57