ifbrack.fr revision 302408 
185892Smike\ ** ficl/softwords/ifbrack.fr
285892Smike\ ** ANS conditional compile directives [if] [else] [then]
385892Smike\ ** Requires ficl 2.0 or greater...
485892Smike\
585892Smike\ $FreeBSD: stable/11/sys/boot/ficl/softwords/ifbrack.fr 94290 2002-04-09 17:45:28Z dcs $
685892Smike
785892Smikehide
885892Smike
985892Smike: ?[if]   ( c-addr u -- c-addr u flag )
1085892Smike    2dup s" [if]" compare-insensitive 0=
1185892Smike;
1285892Smike
1385892Smike: ?[else]   ( c-addr u -- c-addr u flag )
1485892Smike    2dup s" [else]" compare-insensitive 0=
1585892Smike;
1685892Smike
1785892Smike: ?[then]   ( c-addr u -- c-addr u flag )
1885892Smike    2dup s" [then]" compare-insensitive 0= >r
1985892Smike    2dup s" [endif]" compare-insensitive 0= r> 
2085892Smike    or
2185892Smike;
2285892Smike
2385892Smikeset-current
2485892Smike
2585892Smike: [else]  ( -- )
2685892Smike    1                                     \ ( level )
2785892Smike    begin
2885892Smike      begin
2985892Smike        parse-word dup  while             \ ( level addr len )
3085892Smike        ?[if] if                          \ ( level addr len )
3185892Smike            2drop 1+                      \ ( level )
3285892Smike        else                              \ ( level addr len )
3385892Smike            ?[else] if                    \ ( level addr len )
3485892Smike                 2drop 1- dup if 1+ endif
3585892Smike            else
3685892Smike                ?[then] if 2drop 1- else 2drop endif 
3785892Smike            endif
3885892Smike        endif ?dup 0=  if exit endif      \ level
3985892Smike      repeat  2drop                       \ level
4085892Smike    refill 0= until                       \ level
4185892Smike    drop
4285892Smike;  immediate
4385892Smike
4485892Smike: [if]  ( flag -- )
4585892Smike0= if postpone [else] then ;  immediate
4685892Smike
4785892Smike: [then]  ( -- )  ;  immediate
4885892Smike: [endif]  ( -- )  ;  immediate
4985892Smike
5085892Smikeprevious
5185892Smike