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