bb6b2dcd |
1 | \ @(#) condcomp.fth 98/01/26 1.2\r |
2 | \ Conditional Compilation support\r |
3 | \\r |
4 | \ Words: STRINGS= [IF] [ELSE] [THEN] EXISTS?\r |
5 | \\r |
6 | \ Lifted from X3J14 dpANS-6 document.\r |
7 | \r |
8 | anew task-condcomp.fth\r |
9 | \r |
10 | : [ELSE] ( -- )\r |
11 | 1\r |
12 | BEGIN \ level\r |
13 | BEGIN\r |
14 | BL WORD \ level $word\r |
15 | COUNT DUP \ level adr len len\r |
16 | WHILE \ level adr len\r |
17 | 2DUP S" [IF]" COMPARE 0=\r |
18 | IF \ level adr len\r |
19 | 2DROP 1+ \ level'\r |
20 | ELSE \ level adr len\r |
21 | 2DUP S" [ELSE]"\r |
22 | COMPARE 0= \ level adr len flag\r |
23 | IF \ level adr len\r |
24 | 2DROP 1- DUP IF 1+ THEN \ level'\r |
25 | ELSE \ level adr len\r |
26 | S" [THEN]" COMPARE 0=\r |
27 | IF\r |
28 | 1- \ level'\r |
29 | THEN\r |
30 | THEN\r |
31 | THEN\r |
32 | ?DUP 0= IF EXIT THEN \ level'\r |
33 | REPEAT 2DROP \ level\r |
34 | REFILL 0= UNTIL \ level\r |
35 | DROP\r |
36 | ; IMMEDIATE\r |
37 | \r |
38 | : [IF] ( flag -- )\r |
39 | 0=\r |
40 | IF POSTPONE [ELSE]\r |
41 | THEN\r |
42 | ; IMMEDIATE\r |
43 | \r |
44 | : [THEN] ( -- )\r |
45 | ; IMMEDIATE\r |
46 | \r |
47 | : EXISTS? ( <name> -- flag , true if defined )\r |
48 | bl word find\r |
49 | swap drop\r |
50 | ; immediate\r |