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
|
\ Test case of a branch going over too large a range
\ Body generated by the "Verbal Bottles of Beer" script (Arg of 1 does it.)
\ Test transition from eight-bit offsets to sixteen-bit offsets
fcode-version1 \ Eight-bit offsets.
headers
: too-large-case ( n -- )
." Let's give it a large back-reference too."
begin ." We've just begun"
." 1 0 do " cr 1 0 do
dup ." if " cr
if
dup ." case"
case
0 of ." Just a short case" cr endof
." default. The Big One!" cr
fload TooLargeBranch_off08_body.fth
endcase
." then" cr
then
." Loop back and forward" cr loop
." And here we are!" cr
exit
." Well, we needed some way out!" cr
again ." Back to the fuchsia." cr
;
\ Let's make a small jump, just to see what normal looks like
: control-example
." Here's the beguine"
begin
dup ." if "
if
dup ." case"
case
0 of ." Short case" cr endof
." No default." cr
endcase
." then"
then
." Way out"
exit
." Jump back"
again ." Never do this"
;
fcode-end
fcode-version2 \ Sixteen-bit offsets.
: odd-size-case ( n -- )
." With a back-reference."
begin ." We've begun"
dup ." blah-if "
if
dup ." blah-case"
case
0 of ." A very short case" cr endof
." A big default." cr
fload TooLargeBranch_off08_body.fth
endcase
." blah-then" cr
then
." blah-some way out."
exit
." Back again" cr
again ." Done. are you happy?" cr
;
fcode-end
|
