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
|
\ Test scope of "aliased" name in device-node
\ along w/ excess of "finish-device"
\ Updated Mon, 31 Oct 2005 at 13:19 PST by David L. Paktor
\
[flag] Local-Values
show-flags
fcode-version2
fload LocalValuesSupport.fth
headers
\ Should an alias to a core-function be local to the device-node
\ in which it was made, or global to the whole tokenization?
\ After talking w/ Jim L., answer is: Global.
\ An alias to a core-function goes into the core vocab.
\ But! When new-device or finish-device is used inside a
\ colon-definition, it should not change the tok'z'n-time vocab...
alias foop dup \ Here's a classic case
alias pelf my-self \ Here's another
\ And here are two just to screw you up!
alias >> lshift
alias << rshift
: troop ." Dup to my-self" foop to pelf ;
alias snoop troop
: croup foop snoop ;
: make-rope-name ( slip-number -- )
{ _slip }
" roper_" encode-string
_slip (.) encode-string encode+ name
;
: slip-prop ( slip-number -- )
{ _slip }
_slip not d# 24 >>
_slip d# 16 >> +
_slip not 1 << h# 0ff and 8 >> +
_slip +
encode-int " slipknot" property
;
hex
create achin \ Table of slip-numbers for each device
12 c, 13 c, 14 c,
56 c, 43 c, 50 c, 54 c,
0 c, \ 0-byte is list-terminator
: make-name-and-prop ( slip-number -- )
foop
make-rope-name
slip-prop
;
: tie-one-on ( slip-number -- )
new-device make-name-and-prop
;
[message] Define a method that creates subsidiaries...
: spawn-offspring ( -- )
achin
begin ( addr )
dup c@ ?dup while ( addr slip )
tie-one-on
finish-device
1+ \ Bump to next entry
repeat drop
;
: more-offs ( -- addr count )
" "( \ Another table of offsprings' slip-numbers
)YUMA"( \ Some of them are letters
85 92 13 \ Some are not
)" \ That is all
;
: tap-it-out ( n -- n+1 )
finish-device
1+
;
: spawn-more
0 more-offs bounds do
new-device i c@
make-name-and-prop
tap-it-out
loop
encode-int " num-offs" property
;
[message] Subsidiary (child) device-node
new-device
create eek! 18 c, 17 c, 80 c, 79 c,
: freek eek! 4 bounds ?do i c@ . 1 +loop ;
: greek -1 if freek then ;
[message] About to access method from parent node
: hierareek
eek!
freek
achin
greek
;
: ikey hierareek freek greek ;
\ Does (Should) the new device know about its parent's aliases?
: bad-refs
croup
foop
snoop
foop
to pelf
;
[message] end child node
finish-device
[message] Access methods from the root node again
: refs-good-again
croup
foop
snoop
foop
to pelf
;
[message] An extra finish-device
finish-device
[message] Are we still here?
: spoof
bad-refs
foop
refs-good-again
;
\ That is all...
fcode-end
|
