1\  Test overlapping FCode # error checking, and reaching the max allowable.
2
3\  Updated Wed, 06 Sep 2006 at 18:23 PDT by David L. Paktor
4
5\  A macro to force showing the current  nextfcode
6global-definitions
7    [macro]  show-next-fcode  fcode-push  [if]  [then] #message" ... and dropped off."
8    [ifnexist] fcode-reset
9      [macro] fcode-reset  #message" Faking FCODE-RESET" f[ h# 800 next-fcode ]f
10    [endif]
11device-definitions
12
13fcode-version2
14
15decimal
16headers
17    show-next-fcode
18
190 constant  my_zero
20fload OneTwoFive.fth
21  fcode-push f[ f['] eleven   next-fcode  ]f fcode-pop  fcode-push
22#message" one_twenty-six"    126 constant  one_hundred_and_twenty-six
23#message" one_twenty-seven"  127 constant  one_hundred_and_twenty-seven
24#message" one_twenty-eight"  128 constant  one_hundred_and_twenty-eight
25             f[ f['] eleven   emit-fcode  ]f
26    show-next-fcode
27
28    new-device
29	fcode-reset
30	0 constant  my_zero
31	fload OneTwoFive.fth
32	#message" one_twenty-six"    126 constant  one_hundred_and_twenty-six
33	#message" one_twenty-seven"  127 constant  one_hundred_and_twenty-seven
34	#message" one_twenty-eight"  128 constant  one_hundred_and_twenty-eight
35
36	f[ fcode-push f['] eleven   next-fcode ]f  fcode-pop
37    finish-device
38
39    new-device
40	f[  h# 08c0  next-fcode  ]f
41	0 constant  my_zero
42	fload OneTwoFive.fth
43	f[  fcode-push constant dev-1-lap   ]f
44	#message" one_twenty-six"    126 constant  one_hundred_and_twenty-six
45	#message" one_twenty-seven"  127 constant  one_hundred_and_twenty-seven
46	#message" one_twenty-eight"  128 constant  one_hundred_and_twenty-eight
47	show-next-fcode
48    finish-device
49
50    new-device
51	fcode-pop
52	0 constant  my_zero
53	fload OneTwoFive.fth f[ fcode-push f['] eleven next-fcode fcode-pop ]f
54	f[  fcode-push constant dev-2-lap   ]f
55	#message" one_twenty-six"    126 constant  one_hundred_and_twenty-six
56	#message" one_twenty-seven"  127 constant  one_hundred_and_twenty-seven
57	#message" one_twenty-eight"  128 constant  one_hundred_and_twenty-eight
58	show-next-fcode
59    finish-device
60
61fcode-push   \  Can we do this across FCode Blocks?
62\  And, if we can't, can we preserve it this way?
63f[  constant XFcBlkFcd
64    XFcBlkFcd    \  Push it back...
65 ]f
66
67    new-device
68	f[  dev-1-lap  next-fcode  ]f
69	0 constant  my_zero
70	fload OneTwoFive.fth
71	fcode-push
72	#message" one_twenty-six"    126 constant  one_hundred_and_twenty-six
73	fcode-pop
74	#message" one_twenty-seven"  127 constant  one_hundred_and_twenty-seven
75    finish-device
76    show-next-fcode
77
78fcode-end
79
80\  Have to redefine these...
81global-definitions
82    [macro]  show-next-fcode  fcode-push  [if]  [then] #message" ... and dropped off."
83    [ifnexist] fcode-reset
84      [macro] fcode-reset  #message" Faking FCODE-RESET" f[ h# 800 next-fcode ]f
85    [endif]
86device-definitions
87
88fcode-version2
89	\   Confirm that the FCode numbers continue across FCode Blocks
90	show-next-fcode
91	#message" one_twenty-eight"  128 constant  one_hundred_and_twenty-eight
92
93\  Let's confirm that the reset clears out the lapping messages.
94    new-device
95	\  This is not a reset:
96	f[   h# 800 next-fcode  ]f
97	0 constant  my_zero
98
99	\  This is:
100	fcode-reset
101	fload OneTwoFive.fth
102
103    finish-device
104
105\  Can we use what we pushed on the other side of the block?
106f[  constant wanna-pop
107    wanna-pop   fcode-pop  wanna-pop   0=
108    \  Did it succeed?  If not, there's no point...
109 ]f [if]
110       #message" Could not use FCode pushed on other side of block"
111       #message" Try this...  "   f[  XFcBlkFcd  fcode-pop  ]f
112
113    [else]  \  It sucked seed!
114	new-device
115	0 constant  my_zero
116	fload OneTwoFive.fth
117		show-next-fcode
118	finish-device
119    [endif]
120
121\  Final run:  Exceed the FCode # limit and crash.
122\  Rather than load all the numbers from the start,
123\      let's get a jump on the FCode # assignments.
124f[   h# f80 next-fcode  ]f
125
126\  Get all but the last few...
127
1280 constant  my_zero
129fload OneTwoFive.fth
130
131	show-next-fcode
132#message" one_twenty-six"   126 constant  one_hundred_and_twenty-six
133	show-next-fcode
134#message" one_twenty-seven" 127 constant  one_hundred_and_twenty-seven
135	show-next-fcode
136
137\  This next one pushes the FCode # over the limit and causes a crash.
138\  Let's leave ourselves a way around that, so we can use this in other ways
139\  Allow a command-line symbol called NoCrash to prevent this.
140[ifndef] NoCrash
141    #message" one_twenty-eight"  128 constant  one_hundred_and_twenty-eight
142	show-next-fcode
143[else] \  Otherwise, let's do this test:
144    #message" Overflow the data-stack."
145    f[  decimal   fload  TooManyPushes.fth  f]
146[endif]
147
148fcode-end
149