blob: 89d478cff7ef0b9cd49e3a21a1a18fa80671add6 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
\ tag: Forth preprocessor
\
\ Forth preprocessor
\
\ Copyright (C) 2003, 2004 Samuel Rydh
\
\ See the file "COPYING" for further information about
\ the copyright and warranty status of this work.
\
0 value prep-wid
0 value prep-dict
0 value prep-here
: ([IF])
begin
begin parse-word dup 0= while
2drop refill
repeat
2dup " [IF]" strcmp 0= if 1 throw then
2dup " [IFDEF]" strcmp 0= if 1 throw then
2dup " [ELSE]" strcmp 0= if 2 throw then
2dup " [THEN]" strcmp 0= if 3 throw then
" \\" strcmp 0= if linefeed parse 2drop then
again
;
: [IF] ( flag -- )
if exit then
1 begin
['] ([IF]) catch case
\ EOF (FIXME: this does not work)
\ -1 of ." Missing [THEN]" abort exit endof
\ [IF]
1 of 1+ endof
\ [ELSE]
2 of dup 1 = if 1- then endof
\ [THEN]
3 of 1- endof
endcase
dup 0 <=
until drop
; immediate
: [ELSE] 0 [ ['] [IF] , ] ; immediate
: [THEN] ; immediate
:noname
0 to prep-wid
0 to prep-dict
; initializer
: [IFDEF] ( <word> -- )
prep-wid if
parse-word prep-wid search-wordlist dup if nip then
else 0 then
[ ['] [IF] , ]
; immediate
: [DEFINE] ( <word> -- )
parse-word here get-current >r >r
prep-dict 0= if
2000 alloc-mem here!
here to prep-dict
wordlist to prep-wid
here to prep-here
then
prep-wid set-current prep-here here!
$create
here to prep-here
r> r> set-current here!
; immediate
: [0] 0 ; immediate
: [1] 1 ; immediate
|
