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