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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
\ Obvious pun intended...
\ Updated Tue, 17 Oct 2006 at 12:57 PDT by David L. Paktor
alias // \
fcode-version2
headers
// What is this?
//
char G emit
control G emit
control [ emit
global-definitions
\ Each dev-node will create its own debug-flag and alias it to debug-me?
\ Each dev-node will create a macro called my-dev-name giving its device-name
[macro] .fname&dev [function-name] type ." in " my-dev-name type
[macro] name-my-dev my-dev-name device-name
[macro] .dbg-enter debug-me? @ if ." Entering " .fname&dev cr then
[macro] .dbg-leave debug-me? @ if ." Leaving " .fname&dev cr then
device-definitions
\ Top-most device, named billy
[macro] my-dev-name " billy"
name-my-dev
variable debug-bell? debug-bell? off alias debug-me? debug-bell?
: bell
.dbg-enter
[char] G dup
control G 3drop
.dbg-leave
;
: factl recursive ( n -- n! )
." Entering First vers. of " [function-name] type cr
?dup 0= if 1
else dup 1- factl *
then
." Leaving First vers. of " [function-name] type cr
;
: factl ( n -- n! )
." Entering Second vers. of " [function-name] type cr
?dup 0= if 1 factl
else dup 1- recurse *
then
." Leaving Second vers. of " [function-name] type cr
;
variable naught
defer do-nothing
20 value twenty
30 value thirty
40 buffer: forty
50 constant fifty
create three 0 , 00 , h# 000 ,
struct
4 field >four
constant /four
: peril
.dbg-enter
['] noop is do-nothing
100 is thirty
5 is naught
thirty dup - abort" Never Happen"
.dbg-leave
;
: thirty ( new-val -- )
.dbg-enter
dup to thirty
alias .dec .d \ Should this be allowed?
." Dirty" .dec
.dbg-leave
;
tokenizer[
alias fliteral1 fliteral // This should be a harmless remark.
h# deadc0de ]tokenizer fliteral1
\ First subsidiary device, "child" of billy
new-device
instance variable cheryl
[macro] my-dev-name " cheryl"
name-my-dev
instance
\ Third-level device, "grandchild" of billy
new-device
[macro] my-dev-name " meryl"
name-my-dev
variable beryl
variable debug-meryl? debug-meryl? off
alias debug-me? debug-meryl?
: meryl
.dbg-enter
cheryl
alias .deck .dec
alias feral cheryl
alias .heck .h
.dbg-leave
;
finish-device
\ Now we're back to "cheryl"
variable debug-cheryl? debug-cheryl? off
alias debug-me? debug-cheryl?
: queryl
.dbg-enter
over rot dup nip drop swap \ Not the most useful code... ;-}
.dbg-leave
;
finish-device
\ Some interpretation-time after the fact markers...
alias colon :
overload [macro] : ." Cleared " [input-file-name] type ." line " [line-number] .d cr colon
alias semicolon ;
overload [macro] ; semicolon ." Finished defining " [function-name] type cr
\ And we're back to billy.
: droop ( -- )
.dbg-enter \ This will display Entering droop in billy
twenty
tokenizer[
alias .x .h \ Should this generate a warning?
[function-name]
]tokenizer
0 ?do i .x loop
.dbg-leave
; f[ [function-name] ]f
headerless
: ploop ( -- )
.dbg-enter
fifty 0 do i drop 2 +loop
.dbg-leave
;
overload alias : colon
overload alias ; semicolon
fcode-end
|
