Hash :
ed679850
Author :
Date :
2006-10-30T17:01:46
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 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182
\ Obvious pun intended...
\ Updated Mon, 09 Oct 2006 at 09:57 PDT by David L. Paktor
[flag] Local-Values
f[ ." This is a test" ]f
fcode-version1
global-definitions
headers
h# 130 constant _local-storage-size_
headerless
device-definitions
fload TotalLocalValuesSupport.fth
noop noop noop
headers
[char] G emit
control G emit
control [ emit
: bell
char G dup
control G dup emit 3drop
;
f[
[macro] bell #message" Beep"^G-Beep"^G Yu Rass!"
]f
recursive
: factl ( n -- n! )
?dup 0= if 1
control G to bell
else dup 1- factl *
then
;
global-definitions
[macro] bell f[ bell ]f
[macro] swell bell
device-definitions
[macro] yell bell
offset16
bell offset16
: factl ( n -- n! )
?dup 0= if 1 factl
control G to bell
else dup 1- recurse *
then
;
recurse
: bell recursive ( n -- Sigma[n..1] )
?dup if dup 1- bell +
else 0 to bell
then
;
: cussed
i
j
;
: mussed 10 0 do i . loop ;
: sussed 3 0 do 10 0 do i . j . loop loop ;
: trussed ( a b c -- )
{ _a _b _c | _d _e }
10 0 do i .
_a _b + i * dup -> d
_c * to _e
j . loop
['] _a
f['] _e
f[ f['] _b
f['] dup emit-fcode
h# 0f emit-fcode ]f
_a _b + _c * [']
factl catch if ." Run in circles, scream and shout!" then
;
: DMA-ALLOC ( n -- vaddr ) " dma-alloc" $call-parent ;
: HOOBARTH ( n -- vaddr ) " hoobarth" $call-parent ;
: MY-END0 ( -- n ) ['] end0 ;
: SETUP-HOOBARTH ( ??? -- ??? )
h# 40 ['] dma-alloc catch if
." Fooey!"
then
h# 50 ['] hoobarth catch if
." Ptooey!"
then
['] roll
['] my-end0
['] bogus-case
;
overload alias end0 my-end0
: another-end0 ['] end0 ;
;
new-device
: hells
bells
factl
yell
swell
7 to swell
;
finish-device
variable naught
defer do-nothing
30 value thirty
40 buffer: forty
50 constant fifty
create three 0 , 0 , 0 ,
struct
4 field >four
constant /four
f['] do-nothing get-token
f[']
f['] noop set-token
f['] MooGooGaiPan
#message Just when you thought it couldn't get any wierder...
: peril
['] noop is do-nothing
overload 0 to my-self
100 is thirty
5 is naught
60 to fifty
9 to three
5 is >four
90 to forty
90 to ninety
90 to noop
27
['] 3drop to do-nothing
['] ninety to do-nothing
;
: thirty ( new-val -- )
dup to thirty
\ Should alias inside a colon be allowed?
alias .dec
.d
." Dirty" .dec
;
: droop ( -- )
twenty
tokenizer[
\ Alias inside a colon should generate a warning.
alias
.x
.h
]tokenizer
0 ?do i .x loop
;
: ploop ( -- )
fifty 0 do i drop 2 +loop
\ Should doing this inside a colon-def'n be allowed?:
tokenizer[ h# 517 constant five-seventeen ]tokenizer
five-seventeen
127 to ?leave
503 to (.)
['] 3drop
to spaces
f['] external
to abs
d# 36
to base
;
f[ [ifexists] emit-date
[message] About to tokenize Tokenizer's creation-stamp
[then]
alias fedt emit-date
fedt
]f
." My parent is " my-parent u. cr
fcode-end