xref: /illumos-gate/usr/src/common/ficl/softcore/ifbrack.fr (revision bde334a8dbd66dfa70ce4d7fc9dcad6e1ae45fe4)
1\ ** ficl/softwords/ifbrack.fr
2\ ** ANS conditional compile directives [if] [else] [then]
3\ ** Requires ficl 2.0 or greater...
4
5hide
6
7: ?[if]   ( c-addr u -- c-addr u flag )
8    2dup s" [if]" compare-insensitive 0=
9;
10
11: ?[else]   ( c-addr u -- c-addr u flag )
12    2dup s" [else]" compare-insensitive 0=
13;
14
15: ?[then]   ( c-addr u -- c-addr u flag )
16    2dup s" [then]" compare-insensitive 0= >r
17    2dup s" [endif]" compare-insensitive 0= r>
18    or
19;
20
21set-current
22
23: [else]  ( -- )
24    1                                     \ ( level )
25    begin
26      begin
27        parse-word dup  while             \ ( level addr len )
28        ?[if] if                          \ ( level addr len )
29            2drop 1+                      \ ( level )
30        else                              \ ( level addr len )
31            ?[else] if                    \ ( level addr len )
32                 2drop 1- dup if 1+ endif
33            else
34                ?[then] if 2drop 1- else 2drop endif
35            endif
36        endif ?dup 0=  if exit endif      \ level
37      repeat  2drop                       \ level
38    refill 0= until                       \ level
39    drop
40;  immediate
41
42: [if]  ( flag -- )
430= if postpone [else] then ;  immediate
44
45: [then]  ( -- )  ;  immediate
46: [endif]  ( -- )  ;  immediate
47
48previous
49