ifbrack.fr revision 51786
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 51786 1999-09-29 04:43:16Z dcs $ 651786Sdcs 751786Sdcshidden dup >search ficl-set-current 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