{block 24}
macro
swap
687
2,
;
0
?dup
c031
2,
;
if
74
2,
here
;
-if
79
2,
here
;
a
?dup
c28b
2,
;
a!
?lit
if
ba
1,
,
;
then
d08b
2,
drop
;
2*
e0d1
2,
;
a,
2*
2*
,
;
@
?lit
if
?dup
58b
2,
a,
;
then
85048b
3,
0
,
;
!
?lit
if
?lit
if
5c7
2,
swap
a,
,
;
then
589
2,
a,
drop
;
then
a!
950489
3,
0
,
drop
;
nip
4768d
3,
;
+
?lit
if
5
1,
,
;
then
603
2,
nip
;
or
633
binary
?lit
if
swap
2
+
1,
,
;
then
2,
nip
;
and
623
binary
;
u+
?lit
if
681
2,
,
;
then
44601
3,
drop
;
?
?lit
a9
1,
,
;
pentium
macros:
1,
2,
3,
,
compile
1-4
bytes
drop
lodsd,
flags
unchanged,
why
sp
is
in
esi
over
sp
4
+
@
swap
sp
xchg
0
0
0
xor,
macro
0
identical
to
number
0
a
2
0
mov,
never
used?
a!
0
2
mov,
unoptimized
@
eax
4
*,
unoptimized
!
edx
4
*
nop
used
to
thwart
look-back
optimization
-
ones-complement
2*
2/
if
jz,
flags
set,
max
127
bytes,
leave
address
-if
jns,
same
then
fix
address
-
in
kernel
push
eax
push
pop
eax
pop
u+
add
to
2nd
number,
literal
or
value
?
test
bits,
set
flags,
literal
only!
macros
over
?dup
4468b
3,
;
push
50
1,
drop
;
pop
?dup
58
1,
;
-
d0f7
2,
;
for
push
begin
;
*next
swap
next
75240cff
0next
,
here
-
+
1,
4c483
3,
;
-next
79240cff
0next
;
i
?dup
24048b
3,
;
*end
swap
end
eb
1,
here
-
+
1,
;
+!
?lit
if
?lit
if
581
2,
swap
a,
,
;
then
501
2,
a,
drop
;
then
a!
950401
3,
0
,
drop
;
nop
90
1,
;
align
here
-
3
and
drop
if
nop
align
;
then
;
or!
a!
950409
3,
0
,
drop
;
*
6af0f
3,
nip
;
*/
c88b
2,
drop
f9f72ef7
,
nip
;
/mod
swap
99
1,
16893ef7
,
;
/
/mod
nip
;
mod
/mod
drop
;
for
n
push
count
onto
return
stack,
falls
into
begin
begin
-a
current
code
address
-
byte
*next
aa-aa
swap
for
and
if
addresses
next
a
decrement
count,
jnz
to
for,
pop
return
stack
when
done
-next
a
same,
jns
-
loop
includes
0
i
-n
copy
loop
index
to
data
stack
end
a
jmp
to
begin
+!
na
add
to
memory,
2
literals
optimized
align
next
call
to
end
on
word
boundary
or!
na
inclusive-or
to
memory,
unoptimized
*
mm-p
32-bit
product
*/
mnd-q
64-bit
product,
then
quotient
/mod
nd-rq
remainder
and
quotient
/
nd-q
quotient
mod
nd-r
remainder
time
-n
pentium
cycle
countegas
15240000
to
get
actual
clock
rate
compiled
macros
2/
f8d1
2,
;
time
?dup
310f
2,
;
forth
@
@
;
!
!
;
+
+
;
*/
*/
;
*
*
;
/
/
;
2/
2/
;
dup
dup
;
arithmetic
negate
-
1
+
;
min
less
if
drop
;
then
swap
drop
;
abs
dup
negate
max
less
if
swap
then
drop
;
v+
vv-v
push
u+
pop
+
;
writes
acn
for
write
next
drop
drop
;
reads
acn
for
read
next
drop
drop
;
oadf
qwerty
save
0
dup
nc
@
writes
stop
;
these
macros
may
be
white,
others
may
not
@
etc
arithmetic
negate
n-n
when
you
just
cant
use
-
min
nn-n
minimum
abs
n-u
absolute
value
max
nn-n
maximum
v+
vv-v
add
2-vectors
nc
-a
number
of
cylinders
booted
save
write
colorforth
to
bootable
floppy
oadf
save
as
spelled
by
qwerty.
for
typing
with
blank
screen
colors
etc
block
100
*
;
white
ffffff
color
;
red
ff0000
color
;
green
ff00
color
;
blue
ff
color
;
silver
bfbfbf
color
;
black
0
color
;
magenta
ff00ff
color
;
screen
0
dup
at
1024
768
box
;
5*
5
for
2emit
next
;
cf
25
dup
at
red
1
3
c
3
a
5*
green
14
2
1
3
3e
5*
;
logo
show
black
screen
800
710
blue
box
600
50
at
1024
620
red
box
200
100
at
700
500
green
box
text
cf
keyboard
;
empty
empt
logo
;
block
n-a
block
number
to
word
address
colors
specified
as
rgb:
888
screen
fills
screen
with
current
color
at
xy
set
current
screen
position
box
xy
lower-right
of
colored
rectangle
dump
compiles
memory
display
print
compiles
screen
print
icon
compiles
icon
editor
logo
displays
colorforth
logo
show
background
task
executes
following
code
repeatedly
keyboard
displays
keypad
and
stack
dump
x
290946
y
2106432
one
dup
@
h.
space
dup
h.
cr
;
lines
for
one
-1
+
next
drop
;
dump
x
!
r
show
blue
screen
x
@
15
+
16
text
lines
keyboard
;
it
@
+
@
dup
h.
space
;
lines
for
white
i
x
it
i
y
it
or
drop
if
red
then
i
h.
cr
-next
;
cmp
show
blue
screen
text
19
lines
red
x
@
h.
space
y
@
h.
keyboard
;
u
16
+xy
dup
x
+!
y
+!
;
d
-16
+xy
;
ati
f4100000
ff7fc000
or
byte
4
/
dump
;
fix
for
0
over
!
1
+
next
;
dump
does
not
say
empty,
compiles
on
top
of
application
x
-a
current
address
one
a-a
line
of
display
lines
an
dump
a
background
task
continually
displays
memory
u
increment
address
d
decrement
ati
address
of
agp
graphic
registers
byte
a
byte
address
dump
fix
an-a
test
word
icons
macro
@w
8b66
3,
;
!w
a!
28966
3,
drop
;
*byte
c486
2,
;
forth
ic
70
cu
191
sq
xy
@
10000
/mod
16
+
swap
16
+
box
17
0
+at
;
loc
ic
@
16
24
8
*/
*
18
block
4
*
+
;
0/1
8000
?
if
green
sq
;
then
blue
sq
;
row
dup
@w
*byte
16
for
0/1
2*
next
drop
-17
16
*
17
+at
;
ikon
loc
24
for
row
2
+
next
drop
;
adj
17
*
swap
;
cursor
cu
@
16
/mod
adj
adj
over
over
at
red
52
u+
52
+
box
;
ok
show
black
screen
cursor
18
dup
at
ikon
text
ic
@
h.
keyboard
;
36
load
ok
h
draw
big-bits
icon
@w
a-n
fetch
16-bit
word
from
byte
address
!w
na
store
same
*byte
n-n
swap
bytes
ic
-a
current
icon
cu
-a
cursor
sq
draw
small
square
xy
-a
current
screen
position,
set
by
at
loc
-a
location
of
current
icons
bit-map
0/1
n-n
color
square
depending
on
bit
15
row
a-a
draw
row
of
icon
+at
nn
relative
change
to
screen
position
ikon
draw
big-bits
icon
adj
nn-nn
magnify
cursor
position
cursor
draw
red
box
for
cursor
ok
background
task
to
continually
draw
icon,
icon
number
at
top sr
4210752
4210752
4210752
edit
+ic
1
ic
+!
;
-ic
ic
@
-1
+
0
max
ic
!
;
bit
cu
@
2/
2/
2/
2/
2*
loc
+
10000
cu
@
f
and
1
+
for
2/
next
*byte
;
toggle
bit
over
@w
or
swap
!w
;
td
toggle
d
16
wrap
cu
@
+
16
24
*
dup
u+
/mod
drop
cu
!
;
tu
toggle
u
-16
wrap
;
tr
toggle
r
1
wrap
;
tl
toggle
l
-1
wrap
;
nul
;
h
pad
nul
nul
accept
nul
tl
tu
td
tr
l
u
d
r
-ic
nul
nul
+ic
nul
nul
nul
nul
nul
nul
nul
nul
nul
nul
nul
nul
2500
,
110160c
,
110160c
,
2b000023
,
0
,
0
,
0
,
edit
icon
png
empty
w
54
h
32
d
4
frame
1e80000
;
file
42
load
40
load
-crc
a
here
over
negate
+
crc
.
;
crc
-crc
;
wd
-a
here
3
and
drop
if
0
1,
wd
;
then
here
2
2/s
;
bys
n-a
.
here
swap
,
;
plte
45544c50
48
bys
0
3,
ff0000
3,
ff00
3,
ffff00
3,
ff
3,
ff00ff
3,
ffff
3,
ffffff
3,
0
3,
c00000
3,
c000
3,
c0c000
3,
c0
3,
c000c0
3,
c0c0
3,
c0c0c0
3,
crc
;
png
awh
d
@
/
h
!
d
@
/
w
!
wd
swap
474e5089
,
a1a0a0d
,
ihdr
52444849
13
bys
w
@
.
h
@
.
304
,
0
1,
crc
plte
idat
54414449
0
bys
swap
deflate
crc
iend
444e4549
0
bys
crc
wd
over
negate
+
;
at
1024
*
+
2*
frame
+
;
full
4
d
!
0
dup
at
1024
768
png
;
pad
1
d
!
46
-9
+
22
*
nop
25
-4
+
30
*
at
9
22
*
nop
4
30
*
png
;
lz77
9jro@w a
8b66
3,
;
*byte
c486
2,
;
!b
a!
289
2,
drop
;
forth
*bys
dup
16
2/s
*byte
swap
ffff
and
*byte
10000
*
+
;
.
*bys
,
;
+or
over
-
and
or
;
0/1
10
?
if
1e
and
1e
or
drop
if
7
;
then
f
;
then
0
and
;
4b
dup
0/1
9
and
over
6
2/s
0/1
a
and
+or
swap
11
2/s
0/1
c
and
+or
8
or
;
pix
dup
@w
d
@
2*
u+
4b
;
row
1,
dup
w
@
2/
dup
1
+
dup
2,
-
2,
0
dup
1,
+adl
for
pix
16
*
push
pix
pop
or
dup
1,
+adl
next
drop
+mod
d
@
1024
2
*
*
+
;
deflate
178
2,
1
0
adl!
h
@
-1
+
for
0
row
next
1
row
drop
ad2
@
*byte
2,
ad1
@
*byte
2,
here
over
4
+
negate
+
*bys
over
-4
+
!b
;
crc
macro
2/s
?lit
e8c1
2,
1,
;
1@
8a
2,
;
forth
ad1
48546
ad2
48600
array
-a
pop
2
2/s
;
bit
n-n
1
?
if
1
2/s
edb88320
or
;
then
1
2/s
;
fill
nn
for
dup
8
for
bit
next
,
1
+
next
drop
;
table
-a
align
array
0
256
fill
crc
an-n
-1
swap
for
over
1@
over
or
ff
and
table
+
@
swap
8
2/s
or
1
u+
next
-
nip
;
+adl
n
ff
and
ad1
@
+
dup
ad2
@
+
adl!
ad2
!
ad1
!
;
+mod
ad1
@
65521
mod
ad2
@
65521
mod
adl!
;
dos
file
blks
256
*
;
w/c
18
blks
;
buffer
604
block
;
size
-a
buffer
0
1
reads
buffer
98f
+
;
set
n
!
buffer
0
1
writes
;
cyls
n-nn
1
swap
w/c
-1
+
+
w/c
/
;
put
an
dup
2*
2*
size
set
cyls
writes
stop
;
get
a
size
@
3
+
2/
2/
cyls
reads
stop
;
.com
0
63
blocks
put
;
blks
n-n
size
in
blocks
to
words
w/c
-n
words
per
cylinder
buffer
-a
1
cylinder
required
for
floppy
dma
size
-a
locate
size
of
2nd
file.
floppy
has
first
filler
then
file
allocated.
filler
is
2048
bytes,
to
fill
out
cylinder
0.
names
at
most
8
letters,
all
caps.
directory
starts
at
buffer
980
+
set
n
size.
file
must
be
larger
than
your
file.
cyls
n-nn
starting
cylinder
1
and
number
of
cylinders
put
an
write
file
from
address
get
a
read
file
to
address
north
bridge
macro
4@
dup
ed
1,
;
4!
ef
1,
drop
;
forth
dev
14336
nb
0
dev
!
;
sb
3800
dev
!
;
agp
800
dev
!
;
ess
6800
dev
!
;
ric
7800
dev
!
;
win
8000
dev
!
;
ati
10000
dev
!
;
add
cf8
a!
4!
cfc
a!
;
q
80000000
+
add
4@
;
en
8004
q
-4
and
or
4!
;
dv
dup
800
*
q
swap
1
+
;
regs
dev
@
19
4
*
+
20
for
dup
q
h.
space
dup
h.
cr
-4
+
next
drop
;
devs
0
33
for
dup
q
dup
1
+
drop
if
dup
h.
space
drop
dup
8
+
q
dup
h.
space
over
h.
cr
then
drop
800
+
next
drop
;
pci
q
;
ok
show
black
screen
text
regs
cr
devs
cr
dev
@
h.
cr
6800
pci
h.
keyboard
;
u
40
dev
+!
;
d
-64
dev
+!
;
test
ff00
+
a!
4@
;
ok
ascii
macro
1@
8a
2,
;
forth
string
pop
;
cf-ii
string
6f747200
,
696e6165
,
79636d73
,
7766676c
,
62707664
,
71757868
,
336a7a6b
,
37363534
,
2d313938
,
2f322e30
,
2b213a3b
,
3f2c2a40
,
ch
fffffff0
and
unpack
cf-ii
+
1@
ff
and
;
ii-cf
string
2a00
,
0
,
2b2d0000
,
2725232e
,
1b262224
,
1f1e1d1c
,
28292120
,
2f000000
,
3a43355c
,
3d3e3440
,
484a3744
,
3336393c
,
38314742
,
3f414632
,
493b45
,
0
,
a13052c
,
d0e0410
,
181a0714
,
306090c
,
8011712
,
f111602
,
190b15
,
chc
ffffffe0
+
ii-cf
+
1@
ff
and
;
clock
macro
p@
ec
1,
;
p!
ee
1,
drop
;
forth
ca
70
a!
p!
71
a!
;
c@
ca
0
p@
;
c!
ca
p!
;
hi
10
c@
80
and
drop
if
;
then
hi
;
lo
0
p@
80
and
drop
if
lo
;
then
;
bcd
c@
16
/mod
10
*
+
;
hms0
4
bcd
100
*
2
bcd
+
100
*
0
bcd
+
;
hms
hms0
2
ms
dup
hms0
or
drop
if
drop
hms
;
then
;
ymd
9
bcd
100
*
8
bcd
+
100
*
7
bcd
+
;
day
6
c@
-1
+
;
cal
hi
lo
time
-
hi
lo
time
+
748
;
lan
empty
3f8
54
load
init
no
block
4
*
1024
;
send
no
for
dup
1@
xmit
1
+
next
drop
;
receive
no
for
rcv
over
1!
1
+
next
drop
;
no
18
7
18
*
;
backup
no
for
dup
send
1
+
next
drop
;
accept
no
for
dup
receive
1
+
next
drop
;
sr
4210752
4210752
4210752
serial
3f8
2e8
1050
macro
p@
a!
dup
ec
1,
;
p!
a!
ee
1,
drop
;
1@
8a
2,
;
1!
a!
288
2,
drop
;
forth
r
0
+
+
;
9600
12
;
115200
1
;
b/s
83
3
r
p!
9600
0
r
p!
0
1
r
p!
3
3
r
p!
;
init
b/s
16550
1
2
r
p!
0
4
r
p!
;
xmit
n
5
r
p@
20
and
drop
if
0
r
p!
;
then
pause
xmit
;
cts
6
r
p@
30
and
30
or
drop
if
cts
;
then
xmit
;
st
6
r
p@
xbits
30
and
10
/
dup
1
and
2*
2*
+
2/
;
st!
4
r
p!
;
?rcv
5
r
p@
1
and
drop
if
0
r
p@
then
;
rcv
?rcv
if
;
then
pause
rcv
;
p@
p-n
fetch
byte
from
port
p!
np
store
byte
to
port
1@
a-n
fetch
byte
from
byte
address
1!
na
store
byte
to
byte
address
r
n-p
convert
relative
to
absolute
port
address.
base
port
on
stack
at
compile
time.
compiled
as
literal
at
yellow-green
transition
9600
115200
baud-rate
divisors.
these
are
names,
not
numbers
b/s
set
baud
rate.
edit
to
change
init
initialize
uart
xmit
n
wait
for
ready
and
transmit
byte
cts
n
wait
for
clear-to-send
then
xmit
st
-n
fetch
status
byte
xbits
n-n
exchange
status
bits
st!
n
store
control
byte
?rcv
fetch
byte
if
ready.
set
flag
to
be
tested
by
if
rcv
-n
wait
for
ready
and
fetch
byte
hexagon
col
14712896
del
2105376
lin
dup
2/
2/
dup
2*
line
;
hex
xy
@
7
and
over
2/
for
lin
7
+
next
over
for
lin
next
swap
2/
for
-7
+
lin
next
drop
;
+del
del
@
nop
petal
and
col
@
+
f8f8f8
and
color
100
hex
;
-del
del
@
f8f8f8
or
80808
+
;
rose
0
+del
-176
-200
+at
f80000
-del
petal
352
-200
+at
f80000
+del
-264
-349
+at
f800
-del
petal
176
-200
+at
f8
+del
-176
98
+at
f8
-del
petal
176
-200
+at
f800
+del
;
ok
show
black
screen
512
282
at
rose
text
col
@
h.
space
del
@
ff
and
.
keyboard
;
58
load
ok
h
draws
7
hexagons.
colors
differ
along
red,
green
and
blue
axes.
col
color
of
center
hexagon
del
color
difference
lin
n
draws
1
horizontal
line
of
a
hexagon
hex
n
draws
top,
center
and
bottom.
slope
7
x
to
4
y
is
1.750
compared
to
1.732
+del
n
increment
color
-del
n
petal
n
draw
colored
hexagon
rose
draw
7
hexagons
ok
describe
screen.
center
color
at
top
pan
in
del
@
2*
404040
min
del
!
;
out
del
@
2/
80808
max
del
!
;
r
f80000
+del
del
@
+col
and
col
@
+
f8f8f8
and
col
!
;
g
f800
+del
;
b
f8
+del
;
-r
f80000
-del
+col
;
-g
f800
-del
+col
;
-b
f8
-del
+col
;
nul
;
h
pad
nul
nul
accept
nul
-r
-g
-b
nul
r
g
b
nul
out
nul
nul
in
nul
nul
nul
nul
nul
nul
nul
nul
nul
nul
nul
nul
250000
,
130d01
dup
,
,
2b000023
,
0
,
0
,
0
,
in
increment
color
difference
out
decrement
it
r
g
b
increment
center
color
-r
-g
-b
decrement
it
+del
redefine
with
;
+col
change
center
color
nul
ignore
h
describe
keypad
-7326896
colorforth
jul31
chuck
moore
public
domain
24
load
26
load
28
load
30
load
dump
32
load
;
icons
34
load
;
print
38
load
;
file
44
load
;
north
46
load
;
colors
56
load
;
mtcf
l
170
load
;
mark
empty
timing
empty
macro
out
e1e6
2,
;
forth
tare
time
-
1000
for
next
time
+
;
tare+
time
-
push
1000
for
dup
next
c
pop
time
+
;
test
tare
time
+
-
1000
for
out
next
time
+
;
next
3
loop
5.7
/next
2
/swap
25
swap
7.2
macro
c!
c88b
2,
drop
here
;
loop
49
1,
75
1,
e2
here
-
+
1,
;
forth
try
time
-
1000
c!
loop
time
+
;
audio
ess
tech
maestro2e
ac-97
empty
macro
2@
dup
a!
ed66
2,
;
2!
a!
ef66
2,
drop
;
4@
dup
ed
1,
;
4!
ef
1,
drop
;
forth
us
100
*
for
next
;
nb
cf8
a!
4!
cfc
a!
;
ess!
80006800
+
nb
4!
;
on
5
4
ess!
0
c4
ess!
;
wind
1240
40
ess!
9a840058
50
ess!
100
58
ess!
3810
60
ess!
;
r@
1400
+
2@
;
r!
1400
+
2!
;
rdy
1430
2@
1
and
drop
if
2
us
rdy
;
then
;
ac@
rdy
80
+
1430
2!
21
us
rdy
1432
2@
;
ac!
rdy
swap
1432
2!
1430
2!
;
rb@
1434
a!
4@
;
rb!
1434
a!
4!
;
ac0
8000000
rb!
2
us
30000000
rb!
21
us
;
ac1
ff6
64
ess!
9
68
ess!
0
60
ess!
2
us
1
60
ess!
1
us
9
60
ess!
500000
us
9
68
ess!
84
us
10000000
rb!
;
try
80
1430
2!
61
us
1430
2@
;
version
7c
ac@
;
on
66
load
audio
test
x
0
wpa
1402
2!
1400
;
wp@
wpa
2@
;
wp!
over
over
wpa
2!
over
1400
2@
or
drop
if
wp!
;
then
drop
drop
;
aa
1
wp!
0
;
apu@
aa
wp@
;
apu!
aa
wp!
;
wca
1410
2!
1412
;
wc@
wca
2@
;
wc!
wca
2!
;
h.s
h.4
space
;
ac?
dup
ac@
h.s
dup
h.s
dup
2/
dup
wp@
h.s
dup
apu@
h.s
dup
wc@
h.s
h.s
;
regs
x
@
20
+
11
for
dup
r@
h.s
ac?
cr
-2
+
next
drop
;
ok
show
black
screen
text
regs
keyboard
;
u
20
x
+!
;
d
-32
x
+!
;
agg0
9240
40
ess!
1000c0
50
ess!
4000
18
r!
10000
us
0
18
r!
500
7
wp!
140
14
r!
1fc
4
for
200000
1000
/
over
wp!
1
+
next
drop
ac0
;
editor
empty
macro
forth
blk
0
cur
0
prev
0
nul
;
70
load
edit
blk
!
e
;
ok
show
black
screen
keyboard
;
h
pad
nul
nul
accept
nul
nul
nul
nul
nul
-w
-l
+l
+w
-b
nul
nul
+b
nul
nul
nul
nul
nul
nul
nul
nul
nul
nul
nul
nul
2500
,
0
,
0
,
2b000023
,
0
,
0
,
0
,
keys
+w
1
cur
+!
;
-w
prev
@
cur
!
;
+l
8
cur
+!
;
-l
-8
cur
+!
;
+b
1
+
*b
dup
blk
!
;
-b
-1
+
24
max
*b
;
editor
display
macro
@b
8a
2,
;
forth
bksp
xy
@
12
10000
*
negate
+
xy
!
;
emitw
unpack
if
emit
emitw
;
then
space
drop
drop
;
ecap
unpack
if
48
+
emit
ecap
;
then
space
drop
drop
;
nul
drop
;
dig
pop
+
@b
ff
and
emit
;
edig
dig
1b1a1918
,
1f1e1d1c
,
13052120
,
e04100a
,
odig
dup
f
and
swap
2/
2/
2/
2/
fffffff
and
;
hex
odig
if
hex
edig
;
then
drop
edig
;
num
if
c0c000
and
color
hex
space
;
then
color
.
;
ex
bksp
emitw
;
gw
ff00
color
emitw
;
cw
ffff
color
emitw
;
yw
ffff00
color
emitw
;
ww
ffffff
color
emitw
;
ys
ffff00
short
push
dup
2/
2/
2/
2/
2/
swap
10
and
drop
pop
num
;
74
load
long
push
1
u+
10
and
drop
dup
@
pop
num
;
yn
ffff00
long
;
gs
ff00
short
;
gn
ff00
long
;
x
xy
@
10000
/
;
rcr
x
3
or
drop
if
cr
then
;
rw
rcr
ff0000
color
emitw
;
var
ff00ff
color
emitw
0
gn
;
cap
ffffff
color
unpack
48
+
emit
emitw
;
acap
ffffff
color
ecap
;
blknr
174
word
dup
-16
and
swap
f
and
jump
ex
yw
yn
rw
gw
gn
gs
cw
ys
ww
cap
acap
var
nul
nul
nul
?ring
dup
1
u+
t
blknr
@
block
text
n
dup
@
-1
?
if
word
1
+
n
;
then
drop
drop
;
ok
show
black
screen
t
keyboard
;
ok
mandelbrot
set
dep
24
o
0
0
dep
@
1
max
for
vndup
itr
vdup
vlen
f0000000
+
drop
-if
*next
drop
drop
0
;
then
drop
drop
pop
hue
;
mh
x
@
swap
1024
for
o
wf+
inc
@
u+
next
nip
;
mv
y
@
768
for
mh
inc
@
negate
+
next
drop
;
+d
2
dep
+!
-d
-1
dep
+!
dep
@
1
max
dep
!
draw
drop
1e80000
frame
!
mv
dep
@
;
ok
show
keyboard
;
l
inc
@
1023
8
*/
negate
x
+!
draw
;
u
inc
@
767
8
*/
y
+!
draw
;
d
inc
@
767
8
*/
negate
y
+!
draw
;
r
inc
@
1023
8
*/
x
test
test
test
spy
empty
3f8
54
load
init
ry
5
r
p@
;
82
load
init
buffer
2000
block
;
2000
1
erase
buf
73
0
buf
!
b!
swap
ff
and
+
buf
@
buffer
+
!
1
buf
+!
;
dev
r2
if
dup
xmit
100
b!
dev
;
then
;
pc
?rcv
if
dup
x2
0
b!
pc
;
then
;
relay
s2
st
s2!
st!
dev
pc
;
.1
f
and
digit
;
.byte
dup
10
/
.1
.1
;
traffic
text
buffer
buf
@
1
max
400
min
for
dup
@
green
100
?
if
red
then
.byte
1
+
next
drop
;
ok
show
black
screen
relay
traffic
keyboard
;
k
show
black
screen
relay
keyboard
;
q
6000
for
relay
next
;
test
st!
st
;
84
load
serial
2
r
2f8
+
;
b/s
83
3
r
p!
9600
0
r
p!
0
1
r
p!
3
3
r
p!
;
init
b/s
16550
1
2
r
p!
0
4
r
p!
;
x2
5
r
p@
20
and
drop
if
0
r
p!
;
then
x2
;
c2
6
r
p@
30
and
30
or
drop
if
c2
;
then
x2
;
s2
6
r
p@
xbits
;
s2!
4
r
p!
;
r2
5
r
p@
1
and
drop
if
0
r
p@
;
then
;
dynapulse
200m
send
pop
swap
for
dup
1@
x2
1
+
next
drop
;
reset
2
send
2323
,
1st
12
send
37269a12
,
39027afd
,
23c75680
,
dnum
drop
evpac
;
b10
10
base
!
evnm1
;
b16
16
base
!
evphx
;
pnum
pad
nul
dnum
evpac
nul
digit
digit
digit
nul
digit
digit
digit
digit
digit
digit
digit
nul
nul
nul
nul
nul
nul
nul
nul
nul
nul
nul
nul
nul
2515
,
1b1a19
,
181e1d1c
,
21201f
,
0
,
0
,
0
,
phex
pad
nul
dnum
evpac
nul
digit
digit
digit
nul
digit
digit
digit
digit
digit
digit
digit
nul
nul
digit
digit
digit
nul
digit
digit
digit
nul
nul
nul
nul
2515
,
1b1a19
,
181e1d1c
,
21201f
,
a130500
,
e041000
,
0
,
148
load
format
floppy
empty
macro
p@
0
ec
1,
;
p!
ee
1,
drop
;
forth
hd
1
array
pop
2/
2/
;
com
align
array
1202004d
,
6c
2,
done
3f4
a!
p@
d0
or
drop
if
done
;
then
;
byte
n
ready
p!
;
sectors
nn-n
18
for
over
byte
hd
@
byte
dup
18
mod
1
+
byte
2
byte
1
+
next
drop
;
head
nn-n
dup
hd
!
400
*
1202004d
+
com
!
seek
com
6
command
dup
2*
-
1801
+
sectors
done
;
cylinders
n
0
swap
for
0
head
1
head
1
+
next
stop
drop
;
format
12
cylinders
;
increase
speed
from
2
cylinders/s
to
3
p@
read
byte
from
port
in
a
p!
write
byte
to
port
in
a
array
-a
return
next
word
address
com
-a
address
of
command
string
done
wait
till
last
sector
formatted.
till
ready
to
read
byte
n
send
byte
to
fdc
when
ready
sectors
nn-n
send
4
format
bytes
to
each
of
18
sectors.
sector
number
from
1
to
18
head
nn-n
set
head
number.
issue
seek
and
format
commands.
starting
sector
number
depends
on
cylinder,
allowing
2
sector
times
to
step
heads.
cylinder
1:
17
18
1
2
...
16.
1801
+
adjusts
for
1s
complement
and
for
unsigned
mod
cylinders
n
format
both
heads
of
each
cylinder,
starting
at
0
format
standard
number
of
cylinders.
smaller
is
faster
hard
disk
empty
macro
2/s
?lit
f8c1
2,
1,
;
p@
dup
a!
ec
1,
;
p!+
42ee
2,
;
1!
91
1,
drop
;
insw
1!
97
1,
6df266
3,
97
1,
;
outsw
1!
96
1,
6ff266
3,
96
1,
;
forth
2dup
over
over
;
bsy
1f7
p@
80
and
drop
if
bsy
;
then
;
rdy
-n
1f7
p@
8
and
drop
if
1f0
a!
256
;
then
rdy
;
sector
1f3
a!
swap
p!+
8
2/s
p!+
8
2/s
p!+
8
2/s
e0
or
p!+
drop
p!+
drop
2*
2*
;
read
an
20
sector
256
for
rdy
insw
next
drop
;
write
an
bsy
30
sector
256
for
rdy
outsw
next
drop
;
92
load
boot:
3f
fat0:
5f
fat1:
25a5
dir:
2
cl
forth:
8e6d
cl
reg
dup
p@
ff
and
2
h.n
space
3
h.n
cr
;
regs
7
for
i
1f0
+
reg
-next
;
ok
show
blue
screen
text
regs
keyboard
;
cl
20
*
4aab
+
;
buffer
2000
block
;
?fort
dup
@
54524f46
or
drop
;
cl0
dup
5
+
@
10000
*
swap
6
+
@
16
2/s
ffff
and
or
;
find
-n
buffer
dup
2
cl
read
256
for
?fort
if
8
+
*next
drop
;
then
cl0
pop
drop
;
fort
8e6d
cl
;
+2
8000
u+
100
+
;
reads
for
2dup
read
+2
next
drop
drop
;
writes
for
2dup
write
+2
next
drop
drop
;
get
buffer
fort
9
reads
;
cf!
0
fort
2
writes
;
deskjet
empty
40
load
nb
768
3
*
;
42
load
pixels
for
pix
next
drop
drop
;
drow
string
33622a1b
,
622a1b4d
,
5730
2,
rpt
drow
10
type
drop
;
columns
for
264
2
erase
dup
buffer
8
*
768
pixels
line
rpt
rpt
2
+
next
drop
;
res
300
2,
300
2,
2
2,
;
esci
string
306c261b
,
6f2a1b4c
,
1b4d312e
,
3033742a
,
2a1b5230
,
55342d72
,
32672a1b
4025736
res
res
res
res
32722a1b
,
53343033
,
30722a1b
,
722a1b41
,
c4362
3,
print
esci
37
type
f0000000
767
1024
*
2
*
+
1024
columns
6
type
drop
;
tx
string
3f
and
if
3f
or
if
;
then
c0
or
;
then
;
text
tx
map
!
print
;
it
table
map
!
print
;
printer
macro
p@
ec
1,
;
p!
ee
1,
;
@w
8b66
3,
;
@b
8a
2,
;
+a
c2ff
2,
;
bts
10ab0f
3,
drop
;
2/s
?lit
f8c1
2,
1,
;
forth
ready
p@
80
and
if
;
then
ready
;
delay
for
next
;
emit
378
a!
p!
+a
ready
+a
8d
or
p!
30
delay
1
or
p!
drop
;
type
for
dup
@b
emit
1
+
next
;
buffer
264
block
4
*
;
string
pop
;
!b
dup
-
7
and
a!
dup
3
2/s
bts
1
+
;
three
!b
two
!b
one
!b
nul
drop
;
white
ffff
and
dup
ffff
or
drop
if
-
then
;
deskjet
-nb
nb
negate
u+
;
bcmy
string
10243800
,
3033
,
200022
,
10000011
,
c00f
,
4003
,
0
,
0
,
8000a
,
0
,
800002
,
0
,
4000005
,
0
,
0
,
c0000001
,
ye
nb
3
*
u+
all
over
over
3
and
jump
nul
one
two
three
ma
-nb
2
2/s
all
;
cy
-nb
2
2/s
all
;
bl
-nb
2
2/s
all
;
map
1050918
6b
c618
and
3
2/s
dup
3
2/s
or
3c3
and
dup
4
2/s
or
3f
and
;
table
string
bcmy
+
@b
;
ex
map
@
push
;
pix
over
@w
6b
ex
ff
and
if
ye
ma
cy
bl
then
drop
3
+
1024
-2
*
u+
;
arow
string
30622a1b
,
4d
1,
trbp
string
32622a1b
,
563838
3,
trbr
string
32622a1b
,
573838
3,
color
7
type
drop
nb
8
/
type
;
line
arow
5
type
drop
buffer
3
for
trbp
color
next
trbr
color
drop
;
x18
simulator
empty
macro
2/s
?lit
f8c1
2,
1,
;
forth
state
1fff
block
;
102
load
reset
r
26
for
100000
over
!
1
+
next
drop
180
mem
@
ir
!
181
pc
!
0
slot
!
;
un.
5
for
37
emit
next
;
undef
100000
?
if
drop
un.
;
then
5
h.n
;
r.
a-a
dup
@
undef
cr
1
+
;
stack
sp
@
8
for
dup
ss
r.
drop
-1
+
next
drop
;
return
rp
@
8
for
1
+
dup
rs
r.
drop
next
drop
;
ok
show
black
screen
text
green
return
r
r.
blue
r.
r.
white
r.
r.
green
r.
r.
drop
stack
keyboard
;
reset
ok
2/s
n
shift
right
n
bits
state
-a
address
of
state
vector
for
current
computer
reset
set
registers
undefined,
execute
from
rom
un.
display
undefined
register
h.n
nn
display
n
hex
digits
of
number
undef
n
bit
20
set
means
undefined
r.
display
register
stack
display
stack,
top
at
top
return
display
return
stack,
top
at
bottom
ok
display
registers,
b
a
blue,
pc
ir
white
registers
r
state
;
b
state
1
+
;
ar
state
2
+
;
pc
state
3
+
;
ir
state
4
+
;
t
state
5
+
;
s
state
6
+
;
slot
state
7
+
;
ss
7
and
8
+
state
+
;
rs
7
and
16
+
state
+
;
rp
state
24
+
;
sp
state
25
+
;
mem
2000
block
+
;
106
load
104
load
s1
ir
@
8
2/s
inst
;
s2
ir
@
3
2/s
inst
;
s3
0
slot
!
ir
@
4
and
drop
if
ret
then
pc
@
mem
@
ir
!
1
pc
+!
s0
ir
@
13
2/s
inst
;
step
slot
@
jump
s0
s1
s2
s3
steps
for
step
next
;
name
26
registers
in
state
vector
ar
-a
a
register.
cannot
be
named
a
because
pentium
macro
takes
precedence
s0-s3
execute
instruction
from
slot
0-3
step
execute
next
instruction
steps
n
execute
n
instructions
instructions
nul
;
call
pc
@
+r
jmp
ir
@
1ff
and
pc
!
;
jz
t
@
dup
or
jc
drop
if
3
slot
!
;
then
jmp
;
jns
t
@
20000
and
jc
;
ret
-r
pc
!
;
@b
b
@
@x
mem
@
+t
;
@+
ar
@
1
ar
+!
@x
;
n
pc
@
1
pc
+!
@x
;
@a
ar
@
@x
;
!b
b
@
1
b
+!
!x
-t
swap
mem
!
;
!+
ar
@
1
ar
+!
!x
;
!a
ar
@
!x
;
inst
n
1
slot
+!
1f
and
jump
jmp
jmp
call
call
jz
jz
jns
jns
@b
@+
n
@a
!b
!+
nul
!a
-x
2*x
2/x
+*
orx
andx
nul
+x
r@
a@
t@
s@
r!
a!x
nul
t!
define
action
of
each
instruction
inst
n
jump
vector
for
32
instruction
codes
instructions
+r
n
r
@
rp
@
1
+
dup
rp
!
rs
!
r
!
;
-r
-n
r
@
rp
@
dup
rs
@
r
!
-1
+
rp
!
;
+t
n
t
@
s
@
sp
@
1
+
dup
sp
!
ss
!
s
!
t
!
;
-t
-n
t
@
s
@
t
!
sp
@
dup
ss
@
s
!
-1
+
sp
!
;
-x
t
@
3ffff
or
t
!
;
2*x
t
@
2*
3ffff
and
t
!
;
2/x
t
@
dup
20000
and
2*
or
2/
t
!
;
+*
t
@
1
?
if
s
@
+
then
2/
t
!
;
orx
-t
t
@
or
t
!
;
andx
-t
t
@
and
t
!
;
+x
-t
t
@
+
3ffff
and
t
!
;
r@
-r
+t
;
a@
ar
@
+t
;
t@
t
@
+t
;
s@
s
@
+t
;
r!
-t
+r
;
a!x
-t
ar
!
;
t!
-t
drop
;
+r
n
push
onto
return
stack
-r
-n
pop
from
return
stack
+t
n
push
onto
data
stack
-t
-n
pop
from
data
stack
-x
some
instructions
named
with
terminal
x
to
avoid
pentium
conflict
x18
target
compiler
empty
h
2097547
ip
2097546
slot
3
macro
2*s
?lit
e0c1
2,
1,
;
forth
memory
2000
block
;
org
n
memory
+
dup
h
!
ip
!
0
slot
!
;
,
n
h
@
!
1
h
+!
;
s3
s0
h
@
ip
!
13
2*s
,
1
slot
!
;
s1
8
2*s
sn
ip
@
+!
1
slot
+!
;
s2
3
2*s
sn
;
i,
slot
@
jump
s0
s1
s2
s3
25x
114
load
;
116
load
110
load
112
load
n
x18
call
class
25x
prototype
for
target
compilers
h
address
of
next
available
word
in
target
memory
ip
address
of
current
instruction
word
slot
next
available
instruction
slot
2*s
n
shift
left
n
bits
memory
-a
host
address
for
target
memory
org
n
set
current
target
memory
location
,
n
compile
word
into
target
memory
s0-s3
assemble
instruction
into
slot
0-3
i,
assemble
instruction
into
next
slot
25x
compile
code
for
multicomputer
instructions
nop
1e
i,
;
adr
n-a
slot
@
2
or
drop
if
nop
then
i,
ip
@
;
call
defer
a
2
adr
+!
;
if
-a
4
adr
;
-if
-a
6
adr
;
then
a
h
@
1ff
and
swap
+!
;
@+
8
i,
;
@b
9
i,
;
n
defer
8
f@
execute
a
i,
,
;
@
b
i,
;
!+
c
i,
;
!b
d
i,
;
!
f
i,
;
-
10
i,
;
2*
11
i,
;
2/
12
i,
;
+*
13
i,
;
or
14
i,
;
and
15
i,
;
+
17
i,
;
words
being
redefined
for
the
target
computer.
these
pentium
words
can
no
longer
be
executed.
although
pentium
macros
still
take
precedence
during
compilation,
they
will
no
longer
be
used.
adr
n-a
assembles
instruction,
but
not
in
slot
2,
where
address
goes.
instruction
address
left
on
stack
call
deferred
to
class.
executed
for
target
defined
words
then
a
puts
address
in
low
9
bits
of
previous
instruction
word
n
executed
for
green
short-numbers.
all
18-bit
target
numbers
are
short.
executes
white
short-number
to
put
interpreted
number
on
stack.
then
assembles
literal
instruction
with
number
in
next
location
instructions
pop
18
i,
;
a
19
i,
;
dup
1a
i,
;
over
1b
i,
;
push
1c
i,
;
a!
1d
i,
;
drop
1f
i,
;
;
4
ip
+!
;
more
target
instructions
;
since
it
will
be
executed,
it
does
not
conflict
with
the
pentium
macro
25x
rom
180
org
0
dup
-
dup
-
dup
-
dup
-
dup
-
dup
-
dup
-
dup
-
dup
push
push
push
push
push
push
push
push
push
a!
a
nop
target
defer
-a
pop
;
execute
a
push
;
class
a
last
1
+
!
;
f!
an
sp
+
!
;
f@
n-a
sp
+
@
;
?com
1384
csho
1331
empty
empt
0
class
csho
@
?com
@
functions
aa
4
f!
6
f!
;
x18
a
4
f@
?com
!
6
f@
csho
!
1
f@
functions
;
defer
-a
byte
address
of
the
compiled
code
that
follows
execute
a
code
at
this
address
class
a
store
address
of
code
to
be
executed
for
each
word
subsequently
defined
f!
an
store
address
of
code
executed
when
a
word
with
this
function
is
interpreted
f@
n-a
fetch
address
of
function
code
empty
redefine
empty
to
restore
altered
functions
functions
aa
store
functions
x18
save
compile
and
number
functions.
set
green
short-number
to
n,
compile
to
execute.
target
words
are
executed
to
assemble
instructions
lite-on
c169b
macro
align
here
7
and
3
or
drop
if
nop
align
;
then
;
forth
array
pop
2/
2/
;
us
n
550
3
/
*
for
next
;
r
n-a
ffaffe00
+
2/
2/
;
rom
a-n
600
+
98
r
!
100
us
48
r
@
;
3rom
2
rom
1
rom
0
rom
;
reset
1
0
r
!
1
us
4000000
0
r
!
1000
us
;
frag
80000000
,
1000000
,
0
,
here
40000004
+
,
;
tx
align
array
frag
frag
frag
80000000
,
c2000000
,
0
,
tx
4
*
40000000
+
,
f
16
n
tx
1
+
;
a
tx
2
+
;
fr!
f
@
+
!
;
first
an
0
f
!
20000000
or
send
an
1000000
or
n
fr!
40000000
or
a
fr!
4
f
+!
;
last
an
c3000000
or
send
-1
8
r
!
;
move
sdn
move
n
bytes
from
source
to
destination.
register
1
is
used,
6
and
7
are
saved
array
-a
returns
word-aligned
address
in
dictionary
us
n
delay
n
microseconds.
edit
cpu
clock
rate
r
n-a
word
address
of
register.
edit
base
address
from
north
pci
device
configuration
rom
a-n
fetch
2
1rces
of
ethernet
id
3rom
nnn
3
byte-pairs
of
id.
54,
32
and
10
reset
controller
tx
-a
transmit
buffer.
1536
bytes.
fragments
must
be
assembled
for
transmission
rx
-b
receive
buffer.
8k+16
bytes
n
-a
tx
status/length.
writing
starts
transmission
send
an
fragment
into
transmit
buffer
first
an
fragment.
wait
till
buffer
empty
last
an
fragment.
start
transmission
init
ialize
controller.
set
tx/rx
address/on
and
perfect
match
receive
rx
align
array
80000000
,
1000600
,
2000
block
4
*
40000000
+
dup
,
here
40000004
+
,
80000000
,
1000600
,
600
+
,
rx
4
*
40000000
+
,
wait
-a
rx
@
0
or
drop
-if
wait
;
then
rx
2
+
@
40000000
or
2/
2/
;
init
reset
rx
10000000
+
2
*
2*
18
r
!
1
us
tx
10000000
+
2
*
2*
20
r
!
1
us
2000
30
r
!
1
us
-1
28
r
!
;
reg
dup
r
@
h.
space
2
h.n
cr
;
regs
b8
reg
a0
reg
98
reg
90
reg
78
reg
60
reg
48
10
for
dup
reg
-8
+
next
drop
;
ok
show
red
screen
text
regs
keyboard
;
ok
wait
-b
till
packet
received
reg
a
display
register
and
address
regs
display
interesting
registers
ok
diagnostic
display
serial
macro
p@
a!
?dup
ec
1,
;
p!
a!
ee
1,
drop
;
1@
8a
2,
;
forth
r
3f8
+
;
115200
1
;
b/s
83
3
r
p!
115200
0
r
p!
0
1
r
p!
3
3
r
p!
;
init
b/s
16550
0
2
r
p!
b
4
r
p!
1
1
r
p!
;
xmit
n
5
r
p@
20
and
drop
if
0
r
p!
;
then
xmit
;
macro
5@
?dup
c58b
2,
;
5!
c589
2,
drop
;
5!+
ec
1,
45004588
,
;
forth
c
interrupt
rcv
2push
0
r
a!
5!+
clear
2pop
i;
receive
a
2*
2*
5!
init
ef
21
p!
sti
;
bytes
an-a
over
+
negate
wait
pause
dup
5@
+
drop
-if
wait
;
then
drop
;
send
an
for
dup
1@
xmit
1
+
next
drop
;
p@
p-n
fetch
byte
from
port
p!
np
store
byte
to
port
1@
a-n
fetch
byte
from
byte
address
r
n-p
convert
relative
to
absolute
port
115200
-n
baud-rate
divisor.
name,
not
number
b/s
set
baud
rate.
edit
to
change
init
initialize
uart.
fifo
off,
receive
interrupt
on,
dtr
rqs
on
xmit
n
wait
for
ready
and
transmit
byte
5!
a
load
register
5.
reserved
as
byte
input
pointer
5@
-a
fetch
it
5!+
n
fetch
port,
store
byte,
increment
pointer
rcv
receive
interrupt.
buffers
byte
in
memory.
must
not
use
data
stack
receive
start
input
enabling
only
serial
interrupt.
keyboard
off
requires
screen,
suspend
and
standby
off
also
count
-n
bytes
received
send
an
message
interrupts
a,
a,
;
idt
324
block
;
macro
1ld
n
?lit
b9
1,
,
;
p!
na
a!
ee
1,
drop
;
lidt
b
18010f
3,
drop
;
sti
fb
1,
;
enable
interrupts
somewhere
cli
fa
1,
;
add
to
empty!
2push
5250
2,
;
2pop
585a
2,
;
forth
2push
be5651
3,
idt
100
+
a,
;
/forth
595e
2,
2pop
;
clear
20e620b0
,
;
8clear
a0e620b0
,
20e6
2,
;
i;
cf
1,
;
forth
!idt
a
lidt
;
here
3b7
2,
idt
a,
!idt
interrupt
n
2*
idt
+
here
ffff
and
80000
+
over
!
here
ffff0000
and
8e00
+
swap
1
+
!
;
fill
an
for
dup
interrupt
1
+
next
drop
;
0
70
fill
ignore
i;
8
8
fill
ignore
2push
clear
2pop
i;
70
8
fill
ignore
2push
8clear
2pop
i;
0
interrupt
0div
7fffffff
1ld
i;
idt
-a
table
of
2-word
interrupts.
edit
convenient
block
number
1ld
n
load
register
1
with
literal
lidt
load
interrupt
table
register
from
byte
address
on
stack
sti
enable
device
interrupts
cli
disable
them
2push
save
registers
0
and
2
2pop
restore
2
and
0
forth
save
1
and
6,
load
6
as
stack.
interrupt
may
occur
while
its
a
source
address
/forth
restore
6
and
1
clear
store
20
to
port
20
to
clear
irq
0-7
8clear
also
20
to
port
a0
to
clear
irq
8-f
i;
return
from
interrupt
-
restore
flags
!idt
b
execute
lidt
interrupt
n
construct
interrupt
to
here.
avoid
yellow-green
literal
with
red
comment
fill
an
n
entries
in
default
interrupt
table
ignore
clear
the
interrupt.
doesnt
clear
the
device
0div
make
divisor
+infinity,
quotient
0
realtek
rtl8139b
macro
move
sdn
c189
2,
drop
c78957
3,
drop
c68956
3,
a4f3
2,
5f5e
2,
drop
;
forth
1us
1
us
n
2144
3
/
*
for
next
;
r
n-a
5800
14
+
pci
+
2/
2/
;
rom
a-n
r
@
;
3rom
nnn
4
rom
0
rom
dup
16
for
2/
next
swap
;
tx
-b
2000
block
4
*
;
rx
-b
tx
1536
+
;
ds
3
fr
42
n
-a
ds
@
10
r
+
;
send
an
fr
@
tx
+
swap
dup
fr
+!
move
;
first
an
n
@
2000
and
drop
if
ds
dup
@
1
+
3
and
swap
!
0
fr
!
send
;
then
first
;
last
an
send
tx
ds
@
20
r
+
!
fr
@
60
max
n
!
;
reset
10000000
34
r
!
100
us
;
init
rx
30
r
!
1us
reset
c000000
34
r
!
1us
8a
44
r
!
3
ds
!
fb
dup
21
p!
a1
p!
sti
/int
ffff0001
3c
r
!
;
rcvd
-b
38
r
@
dup
10000
/
1fff
and
fffffff0
+
38
r
!
10
+
1fff
and
rx
4
+
+
;
move
sdn
move
n
bytes
from
source
to
destination.
register
1
is
used,
6
and
7
are
saved
us
n
delay
n
microseconds.
edit
cpu
clock
rate
r
n-a
word
address
of
register
rom
a-n
fetch
2
bytes
of
mac
3rom
nnn
3
byte-pairs
of
mac
tx
-a
transmit
buffer.
1536
bytes.
fragments
must
be
assembled
for
transmission
rx
-b
receive
buffer.
8k
+
1532
byte
overrun
ds
-a
must
cycle
thru
4
tx
descriptors
fr
-a
must
accumulate
fragments
in
tx
buffer
n
-a
tx
status/length.
writing
starts
transmission
send
an
fragment
into
transmit
buffer
first
an
fragment.
wait
till
buffer
empty
last
an
fragment.
start
transmission
reset
controller
init
ialize
controller.
set
tx/rx
address/on
and
mac/broadcast.
enable
irq10
rcvd
-b
received
packet.
register
38
is
10
bytes
before
start
of
next
packet.
register
3a
is
end
of
current
packet
display
registers
reg
a
dup
r
@
h.
space
2
h.n
cr
;
regs
48
19
for
dup
reg
-4
+
next
drop
;
ok
show
red
screen
text
regs
picst
keyboard
;
reg
a
display
register
and
address
regs
display
interesting
registers
ok
diagnostic
display
48
counter.
neat!
44
rx
configuration
40
tx
configuration
3c
interrupt
38
rx
count/address
34
command
30
rx
8k
ring
buffer
2c-20
tx
address
1c-10
tx
status
c-8
multicast
id,
unused
4
mac
54
0
mac
3210
ethernet
188
load
46
load
t1
57723
empty
cli
empt
logo
;
macro
w
66
1,
;
w@
8b
2,
;
w!
w
289
2,
drop
;
*byte
c486
2,
;
142
load
forth
126
load
n@
w
w@
ffff
and
*byte
;
2!
a!
w!
;
n!
a!
*byte
w!
;
n,
*byte
2,
;
string
pop
;
packet
string
-1
dup
dup
2,
2,
2,
3rom
2,
2,
2,
0
n,
length
n
packet
12
+
n!
;
3!
swap
over
2!
2
+
swap
over
2!
2
+
2!
;
ethernet
n
length
packet
14
first
;
+ethernet
-a
rcvd
14
+
;
132
load
140
load
136
load
138
load
2a
interrupt
serve
forth
1
t1
+!
receive
/int
8clear
/forth
i;
init
1000
us
184
load
128
load
ok
empty
redefined
to
disable
interrupts
w
16-bit
prefix
w@
b-n
fetch
16-bits
from
byte
address
w!
nb
store
16-bits
*byte
n-n
swap
bytes
0
and
1
n@
b-n
fetch
16-bit
network-ordered
number
2!
nb
store
16-bit
number
n!
nb
store
16-bit
number
in
network
order
n,
n
compile
16-bit
number
in
network
order
string
-b
returns
byte
address
packet
-b
ethernet
packet
header
dest
-b
destination
field
in
packet
src
-b
source
field
length
n
store
length
into
packet
3!
nnnb
store
3-word
mac
ethernet
n
send
header
with
type/length
@ethernet
-b
return
payload
address
of
received
packet
arp
for
a
single
correspondent
c.
n.
.
;
.
n
1,
;
message
string
1
n,
800
n,
6
.
4
.
1
n,
me
3rom
2,
2,
2,
ip
192
.
168
.
3
.
2
.
to
0
0
0
2,
2,
2,
ip
192
.
168
.
3
.
1
.
sender
8
+
;
target
18
+
;
dir
6
+
;
ip
6
+
w@
;
ar
n
message
dir
n!
806
ethernet
message
28
last
;
arp
cli
-1
dup
dup
packet
3!
1
ar
sti
;
-arp
b-b
dup
-2
+
n@
806
or
drop
if
;
then
pop
drop
me?
dup
target
ip
message
sender
ip
or
drop
if
;
then
dup
sender
packet
6
move
query?
dup
dir
n@
1
or
drop
if
;
then
sender
message
target
10
move
2
ar
;
set
ip
addresses
with
edit.
normal
order,
net
bytes
first
.
n
compile
byte.
resembles
url
punctuation
message
-b
28-byte
string
me
comment
marking
my
mac/ip
address
to
comment
marking
correspondent
sender
target
dir
-b
fields
in
either
message
or
received
message
ip
b-n
fetch
ip
address
ar
n
send
query
1,
or
reply
4
arp
broadcast
query
-arp
b-b
return
if
not
arp.
otherwise
process
and
skip
out.
me?
b
return
if
broadcast
not
for
me.
save
sender
only
in
packet
query?
b
if
a
request,
reply
ipv6
header
string
1000060
,
0
n,
11
.
64
.
to
0
,
0
,
0
,
ip
192
.
168
.
3
.
1
.
me
0
,
0
,
0
,
ip
192
.
168
.
3
.
2
.
length
n
header
4
+
n!
;
dest
header
20
+
;
src
header
36
+
;
ip
n
86dd
ethernet
length
header
40
send
;
+ip
b-b
dup
-2
+
n@
86dd
or
drop
if
pop
;
then
40
+
;
set
ip
addresses
with
edit.
normal
order,
net
bytes
first
header
-a
40-byte
ipv6
header
length
n
store
2-byte
length
in
header
dest
-a
4-byte
destination
ip
address
src
-a
source
ip
ip
n
send
ip
header
embedded
in
ethernet
packet
+ip
b-b
skip
out
if
not
ip.
otherwise
return
payload
address
udp
macro
b!
a!
288
2,
drop
;
forth
b@
b-n
w@
ff
and
;
header
align
string
4444
n,
4444
n,
8
n,
0
n,
0
n,
length
n
8
+
header
4
+
n!
;
udp
n
dup
8
+
ip
length
;
proto
17
setdp
dup
n@
header
2
+
n!
;
set
udpdestport
udport
n
header
n!
;
set
udpsourceport
+udp
b-b
dup
-11
+
b@
dup
proto
!
11
or
drop
if
pop
;
then
setdp
8
+
;
b@
b-n
fetch
byte
header
-a
8-byte
udp
header
length
n
store
length
in
header
udp
n
send
ip
header
for
n-byte
packet
+udp
b-b
skip
out
if
not
udp.
otherwise
return
payload
address
blocks
to/from
server
payload
n-bn
header
8
+
n!
header
10
;
udppay
payload
-2
+
;
standard
minimal
udp
header
length
+put
nn
4444
udport
1026
udp
over
payload
send
+
block
2*
2*
1024
last
;
it
b
dup
2
+
swap
n@
32768
+
block
2*
2*
1024
move
;
-got
b-b
dup
-4
+
n@
2
8
+
or
drop
if
it
pop
;
then
;
ep
8390162
el
208
snif
dup
dup
ep
!
2
+
n@
el
!
;
160
load
receive
+ethernet
snif
-arp
+ip
+udp
-tftp
-got
+get
b
n@
32768
+put
;
...
interrupt-protect
words
that
transmit
get
n
65535
min
cli
4444
udport
2
udp
payload
last
sti
;
put
n
cli
0
+put
sti
;
archive
161
for
i
put
1000
us
-next
;
@el
el
@
518
min
;
cnt
@el
h.
cr
cr
;
dmp
cnt
white
@el
2
/
for
dup
@el
2
/
i
negate
+
2
*
+
n@
.hw
space
next
drop
;
okd
show
blue
screen
text
ep
@
dup
red
h.
space
dmp
keyboard
;
client
can
get
or
put
blocks
to
server
payload
n-bn
2
bytes
were
appended
to
udp
header
for
block
number
+put
nn
send
block
number.
append
block
as
last
fragment.
packet
length
distinguishes
two
messages
it
b
move
1024
bytes
from
packet
to
offset
block
-got
b-b
if
a
2-byte
message,
return.
otherwise
move
block
to
archive
-
300+
-
and
skip
out
receive
check
and
decode
received
packet.
+test
returns
if
true,
-test
returns
if
false.
otherwise
they
pop
-
skip-out
-
return
from
receive.
resulting
stack
need
not
be
empty,
since
/forth
will
restore
pre-interrupt
stack.
pop
must
be
in
a
word
called
by
receive,
it
cant
be
nested
+get
b
send
requested
block
from
archive
get
n
send
block
number
to
request.
interrupt
disabled
lest
reply
interfer
put
n
send
block
archive
send
blocks
0-161
-
9
cylinders
ipv4
header
align
string
4500
n,
0
n,
1
n,
0
n,
ff11
n,
0
n,
me
192
.
168
.
3
.
2
.
to
217
.
149
.
199
.
177
.
length
n
header
2
+
n!
;
+id
header
4
+
dup
n@
1
+
swap
n!
;
0csum
0
header
10
+
n!
;
msum
dup
ffff
and
swap
10000
/
+
ffff
swap
negate
+
;
checksum
0csum
0
9
for
i
2
*
header
+
n@
+
-next
msum
header
10
+
n!
;
source
header
12
+
;
destination
header
16
+
;
setd
dup
-8
+
dup
n@
destination
n!
2
+
n@
destination
2
+
n!
;
ip
n
20
+
800
ethernet
length
+id
checksum
header
20
send
;
+ip
b-b
dup
-2
+
n@
800
or
drop
if
pop
;
then
20
+
setd
;
oks
show
blue
screen
text
destination
dup
n@
h.
2
+
n@
h.
keyboard
;
network
hex
print
code
macro
1@
8a
2,
;
1!
a!
288
2,
drop
;
forth
addr
pop
;
jht
addr
1b1a1918
,
1f1e1d1c
,
43352120
,
3e34403a
,
hb
jht
+
1@
ff
and
;
.hw
n
dup
dup
dup
1000
/
hb
emit
fff
and
100
/
hb
emit
ff
and
10
/
hb
emit
f
and
hb
emit
;
htp
show
red
screen
text
f
for
i
hb
emit
space
-next
cr
1234
.hw
keyboard
;
fb
1
+
block
4
*
1024
for
dup
i
negate
+
i
swap
1!
next
drop
;
ekbd
byte
15
1,
1
1,
13
1,
45
1,
12
1,
22
1,
16
1,
1
1,
35
1,
9
1,
10
1,
43
1,
0
1,
56
1,
58
1,
2
1,
0
,
0
,
ekb0
byte
21
1,
37
1,
7
1,
0
1,
pad
in
cf
source
vector
1470336
ev
0
macro
1@
8a
2,
;
cedx
ff
1,
d2
1,
;
wedx
c201
2,
582548d
,
fc5203
3,
ad
1,
cedx
;
forth
g4byt
n-
0
ev
!
3
for
dup
i
+
1@
ff
and
ev
@
256
*
+
ev
!
-next
drop
;
pad
pop
dup
vector
!
28
5
*
+
dup
board
!
4
4
*
negate
+
board
1
+
!
pa1
cmkey
vector
@
a!
wedx
pa1
;
tcmk
6
for
cmkey
next
;
tftpd
dblk
4
cblks
0
anfc
4
bnfc
5
offset
0
lbs
32771
inb
4
nul
;
tmp
4
sd
n
32768
+
block
dump
;
ed
n
32768
+
edit
;
et
160
edit
;
esb
32768
65535
erase
;
fb
nb
512
for
over
over
512
i
negate
+
2*
+
n!
next
drop
drop
;
fsb
esb
65535
for
65535
i
negate
+
dup
32768
+
block
2*
2*
fb
next
;
optack
align
string
6
n,
626c
n,
6b73
n,
697a
n,
6500
n,
3130
n,
3234
n,
0
.
tack
align
string
4
n,
0
n,
dpak
align
string
3
n,
0
n,
1+ack
tack
2
+
dup
n@
1
+
swap
n!
;
ascdec
0
tmp
!
1
4
for
over
i
+
b@
-48
+
over
*
tmp
+!
10
*
-next
drop
;
destb
dup
2
+
ascdec
tmp
@
dup
dblk
!
offset
!
;
bcount
dup
6
+
ascdec
tmp
@
dup
cblks
!
inb
!
;
162
load
tftpd
uous
udp
over
udppay
send
;
sopta
cli
69
udport
15
uous
optack
15
last
sti
;
rdrq
destb
bcount
sopta
;
mvit
bnfc
@
offset
@
+
32767
+
block
2*
2*
1024
move
1
dblk
+!
;
?mvit
cblks
@
bnfc
@
negate
+
drop
-if
;
then
mvit
;
sack
cli
dup
2
+
n@
bnfc
!
dup
4
+
?mvit
69
udport
tack
4
uous
tack
4
last
1+ack
sti
;
wrrq
destb
bcount
1
tack
2
+
n!
sopta
sack
;
sbk
n
cli
dup
lbs
!
offset
@
+
69
udport
1028
uous
dpak
4
send
block
2*
2*
1024
last
sti
;
scblk
inb
@
anfc
@
negate
+
cblks
!
;
sclose
cli
4
uous
dpak
4
send
0
0
last
sti
;
ndblk
dup
2
+
n@
anfc
!
scblk
cblks
@
0
or
drop
if
anfc
@
1
+
dup
dpak
2
+
n!
dup
dblk
!
32767
+
sbk
;
then
dblk
@
dpak
2
+
n!
sclose
;
jack
n
6
min
jump
nul
rdrq
wrrq
sack
ndblk
nul
nul
tftp
dup
n@
jack
;
-tftp
dup
-6
+
n@
69
or
drop
if
;
then
pop
drop
tftp
;
.
n.
;
redefine
.
to
print
tos
cell
pop
4
/
;
here
data
align
cell
100
,
200
,
300
,
400
,
500
,
get
n-
data
+
@
;
put
nn-
4
min
data
+
!
;
display
4
for
i
get
.
cr
-next
;
sum
0
4
for
i
get
+
-next
cr
.
;
line
10
for
35
emit
next
;
wipe
4
for
0
i
put
-next
;
ok
show
black
screen
text
display
line
sum
keyboard
;
macro
1@
8a
2,
;
forth
byte
pop
;
data
byte
68
1,
4
1,
12
1,
12
1,
3
1,
0
1,
15
1,
3
1,
1
1,
12
1,
16
1,
42
1,
get
n-
data
+
1@
ff
and
;
display
12
dup
for
dup
i
negate
+
get
emit
-next
drop
;
ok
show
black
screen
text
display
keyboard
;
tv
5
t!
n-
tv
!
;
.tv
50
emit
65
emit
space
tv
@
.
;
d
tv
@
72
+
emit
;
la
53
emit
;
lb
67
emit
;
lc
58
emit
;
ld
64
emit
;
le
52
emit
;
lf
62
emit
;
oor
0
emit
;
decide
tv
@
10
min
jump
d
d
d
d
d
d
d
d
d
d
la
lb
lc
ld
le
lf
oor
ok
show
red
screen
text
.tv
decide
keyboard
;
main
load
screen
tnr
0
0
tnr
!
vc
0
0
vc
!
maxvc
5
5
maxvc
!
vckey
1202489
logov
1201941
vector
1159434
ev
0
lkey
2
172
load
rekey
vkey
4
*
11
hcka
+
vkey
!
;
130
load
178
load
174
load
kbdget
n-k
kbd
+
1@
ff
and
;
kst
0
64
kbp@
;
gkey
vc
@
tnr
@
or
drop
if
drop
0
;
then
drop
0
60
kbp@
;
key
0
0
or
k1
?ref
kst
1
and
1
or
drop
if
k1
;
then
gkey
;
?chvc
dup
7f
and
negate
dup
64
+
drop
-if
drop
;
then
58
+
-if
abs
-1
+
vc
!
;
then
drop
;
mkey
key
?chvc
15
max
58
min
dup
-58
+
drop
if
-15
+
kbdget
dup
lkey
!
;
then
drop
mkey
;
here
vckey
!
mtkey
mkey
;
g4byt
n-
0
ev
!
3
for
dup
i
+
1@
ff
and
ev
@
256
*
+
ev
!
-next
drop
;
pad
pop
dup
vector
!
28
5
*
+
dup
board
!
4
4
*
negate
+
board
1
+
!
pa1
mkey
vector
@
a!
wedx
pa1
;
tm
6
for
mkey
next
;
tc
6
for
cmkey
next
;
vckey
@
vkey
!
sti
keyboard
driver
data
macro
1@
8a
2,
;
cedx
ff
1,
d2
1,
;
wedx
c201
2,
582548d
,
fc5203
3,
ad
1,
cedx
;
kbp@
?lit
e4
1,
1,
;
@esi
56
1,
pop
;
forth
byte
pop
;
kbd
byte
0
1,
16
1,
17
1,
18
1,
19
1,
0
1,
0
1,
4
1,
5
1,
6
1,
7
1,
0
1,
0
1,
0
1,
0
1,
20
1,
21
1,
22
1,
23
1,
0
1,
0
1,
8
1,
9
1,
10
1,
11
1,
0
1,
0
1,
0
1,
0
1,
24
1,
25
1,
26
1,
27
1,
0
1,
1
1,
12
1,
13
1,
14
1,
15
1,
0
1,
0
1,
3
1,
2
1,
video
frame
buffer
refresh
gfb
-n
fr
@
2/
2/
;
gvid
-n
fr
1
+
@
2/
2/
;
refresh
gvid
gfb
1024
768
*
2
/
1
+
for
over
over
i
+
@
swap
i
+
!
-next
drop
drop
;
sw
56
1,
358b
2,
330c
,
57
1,
3d8b
2,
3310
,
b9
1,
60000
,
a5f3
2,
5f
1,
5e
1,
c3
1,
?ref
vc
@
tnr
@
or
drop
if
yield
;
then
keyb
keyb
sw
;
screen
bscr
0
0
at
1024
600
box
white
;
show
pop
dtv
vc
@
+
!
;
here
logov
!
idtv
mlogo
show
black
bscr
800
600
blue
box
600
50
at
1024
600
red
box
200
100
at
700
500
green
box
text
cf
keyboard
;
sht
show
red
bscr
text
1
emit
keyboard
;
sht2
show
blue
bscr
text
0
a!
10
for
a
1
+
a!
a
h.
cr
next
keyboard
;
keyboard
display
data
macro
1@
8a
2,
;
forth
byte
pop
;
alpha
byte
c010a0d
,
8060214
,
110f0913
,
70e0b12
,
16040305
,
10152417
,
graph
byte
1b1a19
,
181e1d1c
,
2f21201f
,
2c2a2829
,
2e252226
,
232b272d
,
numbrs
byte
1b1a19
,
181e1d1c
,
21201f
,
0
,
0
,
0
,
octals
byte
1b1a19
,
181e1d1c
,
21201f
,
a130500
,
e041000
,
0
,
grap0
byte
50000
,
grap1
byte
52515
,
alph0
byte
2d21
,
alph1
byte
2d2515
,
numb0
byte
e0523
,
numb1
byte
2515
,
keyboard
screen
display
176
load
156
load
getc
n-c
1@
ff
and
;
four
n-n+4
4
for
dup
getc
emit
1
+
next
;
eight
n-n+8
12
+
four
space
-16
+
four
;
3rows
n-
3
for
eight
cr
next
drop
;
.brd
board
9
for
dup
@
h.
space
1
+
next
drop
;
.hist
353e
hcka
11
for
dup
getc
emit
1
+
next
drop
;
vstkn
vc
@
dstn
;
vstk0
9f44c
hcka
;
jstck
vc
@
1
min
jump
vstk0
vstkn
.stck
0
740
at
@esi
negate
jstck
+
4
/
-1
+
if
for
@esi
4
/
-1
+
i
+
@
n.
next
;
then
drop
;
kpd
vector
@
28
5
*
+
4
+
;
kpdt
vector
@
28
5
*
+
;
jbrd
board
@
-14139
hcka
+
24
/
0
max
4
min
jump
alpha
graph
numbrs
octals
kpd
jtk
board
1
+
@
-14344
hcka
+
20
/
0
max
6
min
jump
grap0
grap1
alph0
alph1
numb0
numb1
kpdt
tkeys
jtk
four
drop
;
keyc
board
4
+
@
color
;
keyboard
;
keyb
0
600
at
1024
768
blue
box
0
603
at
keyc
.brd
cr
jbrd
3rows
50
700
at
tkeys
125
625
at
magenta
65
emit
58
emit
space
vc
@
n.
space
.hist
.stck
;
wami
1200190
t0
460972296
nrtsks
6
6
nrtsks
!
nyip
1
1
nyip
!
cell
pop
2/
2/
;
allot
n-
for
0
,
next
;
dtv
align
cell
maxvc
@
1
+
allot
tski
align
cell
11
allot
orsts
align
cell
nrtsks
@
allot
ovects
align
cell
nrtsks
@
allot
ofbs
align
cell
maxvc
@
1
+
allot
ofos
align
cell
maxvc
@
1
+
allot
obrds
align
cell
maxvc
@
1
+
9
*
allot
kf@
-n
fr
@
;
kf!
n
fr
!
;
kfn
n-n
1
+
1024
768
*
2
*
*
negate
2000000
+
;
skfn
n
kfn
kf!
;
svfb
kf@
ofbs
vc
@
+
!
;
refb
ofbs
vc
@
+
@
kf!
;
kfo@
-n
fo
@
;
kfo!
n
fo
!
;
svfo
kfo@
ofos
tnr
@
+
!
;
refo
ofos
tnr
@
+
@
kfo!
;
svvec
vector
@
ovects
tnr
@
+
!
;
revec
ovects
tnr
@
+
@
vector
!
;
svbrd
n-
9
*
obrds
+
9
for
dup
board
9
i
negate
+
+
@
swap
!
1
+
next
drop
;
ibrd
maxvc
@
for
i
svbrd
-next
;
ibrd
rebrd
n-
9
*
obrds
+
9
for
dup
@
board
9
i
negate
+
+
!
1
+
next
drop
;
idtv
maxvc
@
for
logov
@
dtv
i
+
!
-next
;
inctnr
1
tnr
+!
;
ztnr
0
tnr
!
;
nxttnr
nrtsks
@
tnr
@
negate
+
1
min
jump
ztnr
inctnr
rstn
n-n
2
*
301
+
block
2*
2*
;
dstn
n-n
2
*
1
+
301
+
block
2*
2*
;
macro
puall
60
1,
;
poall
61
1,
;
svrst
-n
?dup
c48b
2,
;
cs@
-n
e
1,
pop
;
ef@
-n
9c
1,
pop
;
srstn
n
e08b
2,
drop
;
sdstn
n
f08b
2,
drop
;
int20
cd
1,
20
1,
;
forth
yield
0
nyip
!
int20
;
neg+
negate
+
;
mtski
n
dup
rstn
4
/
11
for
11
i
neg+
tski
+
@
over
11
i
neg+
neg+
!
next
drop
;
sef
ef@
37002
and
tski
!
;
scs
cs@
tski
1
+
!
;
sip
wami
@
tski
2
+
!
;
srt
n
dup
rstn
12
+
tski
7
+
!
;
sdt
n
dup
dstn
tski
9
+
!
;
sorst
n
dup
rstn
-40
+
over
orsts
+
!
;
itsk
n
sef
scs
sip
srt
sdt
mtski
sorst
drop
;
timer
interrupt
mt
empty
only
works
from
vc0
cli
rekey
empt
logo
;
cli
cli
;
sti
sti
;
macro
picp@
0
ec
1,
;
tp!
picp!
ee
1,
drop
;
forth
!pit
nn
43
a!
34
tp!
40
a!
tp!
tp!
;
0
0
!pit
0pic1!
20
a!
tp!
;
0pic2!
a0
a!
tp!
;
pic1!
21
a!
tp!
;
pic2!
a1
a!
tp!
;
!pic
cli
init
11
dup
20
a!
tp!
a0
a!
tp!
irq
20
pic1!
28
pic2!
master
4
pic1!
slave
2
pic2!
8086
mode
1
dup
pic1!
pic2!
mask
irqs
fb
pic2!
ed
fb
pic1!
;
!pic
picst
white
700
575
at
21
a!
picp@
h.
space
a1
a!
picp@
h.
700
600
at
a
0pic1!
20
a!
picp@
h.
space
a
0pic2!
a0
a!
picp@
h.
700
625
at
b
0pic1!
20
a!
picp@
h.
space
b
0pic2!
a0
a!
picp@
h.
;
20
interrupt
timer0
forth
svrst
orsts
tnr
@
+
!
svfb
svfo
tnr
@
svbrd
svvec
nyip
@
t0
+!
1
nyip
!
nxttnr
revec
tnr
@
rebrd
refo
refb
orsts
tnr
@
+
@
srstn
clear
/forth
i;
uma
0
dup
pic1!
pic2!
;
ma
ff
dup
pic1!
pic2!
;
186
load
vcs
uma
vcs
init
screen
forth
196
load
198
load
vc@
-n
vc
@
;
vc!
n
vc
!
;
at?
xy
@
10000
/mod
swap
;
vcs
show
vc@
skfn
at?
0
660
at
1024
768
blue
box
keyboard
at
;
n
vc
@
1
+
maxvc
@
min
vc
!
;
p
vc
@
-1
+
0
max
vc
!
;
exec
a-
push
;
here
wami
!
1
itsk
vc1
sti
1
skfn
accept
vc1
;
here
wami
!
2
itsk
vc2
sti
2
skfn
accept
vc2
;
here
wami
!
3
itsk
vc3
sti
3
skfn
accept
vc3
;
here
wami
!
4
itsk
vc4
sti
4
skfn
accept
vc4
;
here
wami
!
5
itsk
vc5
sti
5
skfn
accept
vc5
;
here
wami
!
6
itsk
dt
sti
vc
@
skfn
at?
dtv
vc
@
+
@
exec
at
yield
dt
;
dd
n
2
*
1
+
301
+
block
dump
;
dr
n
2
*
301
+
block
dump
;
interrupts
a,
a,
;
idt
324
block
;
180
load
182
load
macro
1ld
n
?lit
b9
1,
,
;
p!
na
a!
ee
1,
drop
;
lidt
b
18010f
3,
drop
;
sti
fb
1,
;
enable
interrupts
somewhere
cli
fa
1,
;
add
to
empty!
2push
5250
2,
;
2pop
585a
2,
;
forth
puall
be
1,
idt
100
+
a,
;
/forth
poall
;
clear
20e620b0
,
;
8clear
a0e620b0
,
20e6
2,
;
i;
cf
1,
;
forth
!idt
a
lidt
;
here
3b7
2,
idt
a,
!idt
interrupt
n
2*
idt
+
here
ffff
and
80000
+
over
!
here
ffff0000
and
8e00
+
swap
1
+
!
;
fill
an
for
dup
interrupt
1
+
next
drop
;
0
70
fill
ignore
i;
20
8
fill
ignore
2push
clear
2pop
i;
28
8
fill
ignore
2push
8clear
2pop
i;
0
interrupt
0div
7fffffff
1ld
i;
serial
3f8
2e8
altered
for
interrupt
useage
macro
serp@
a!
dup
ec
1,
;
serp!
a!
ee
1,
drop
;
1@
8a
2,
;
1!
a!
288
2,
drop
;
forth
r
0
+
+
;
110
1047
;
300
384
;
2400
48
;
9600
12
;
115200
1
;
b/s
83
3
r
serp!
115200
0
r
serp!
3
3
r
serp!
;
init
1
1
r
serp!
8
4
r
serp!
b/s
16550
1
2
r
serp!
2
2
r
serp!
c1
2
r
serp!
;
xmit
n
5
r
serp@
20
and
drop
if
0
r
serp!
;
then
pause
xmit
;
cts
6
r
serp@
30
and
30
or
drop
if
cts
;
then
xmit
;
st
6
r
serp@
xbits
30
and
10
/
dup
1
and
2*
2*
+
2/
;
st!
4
r
serp!
;
?rcv
5
r
serp@
1
and
drop
if
0
r
serp@
then
;
rcv
?rcv
if
;
then
rcv
;
keyboard
scan
codes
data
addr
pop
;
sc-ii
addr
32311b00
,
36353433
,
30393837
,
9083d2d
,
72657771
,
69757974
,
5d5b706f
,
7361000d
,
68676664
,
3b6c6b6a
,
5c006027
,
7663787a
,
2c6d6e62
,
2a2f2e
,
20202020
,
ssc-ii
addr
40211b00
,
5e252423
,
29282a26
,
82b5f
,
52455751
,
49555954
,
7d7b504f
,
5341000d
,
48474644
,
3a4c4b4a
,
7c007e22
,
5643585a
,
3c4d4e42
,
3f3e
,
csi-ii
addr
1b00
,
1e000000
,
0
,
7f001f
,
12051711
,
9151914
,
1d1b100f
,
1301000a
,
8070604
,
c0b0a
,
1c000000
,
1603181a
,
d0e02
,
si
sc-ii
+
1@
ff
and
;
ssi
ssc-ii
+
1@
ff
and
;
csi
csi-ii
+
1@
ff
and
;
keyboard
driver
shft
0
eflag
1
192
load
3f8
190
load
init
macro
ior
60b
binary
;
kbp@
?lit
e4
1,
1,
;
forth
nul
;
kst
0
64
kbp@
;
!shft
shft
!
;
@shft
shft
@
;
sshft
@shft
1
ior
!shft
;
rshft
@shft
fffffffe
and
!shft
;
sctrl
@shft
2
ior
!shft
;
rctrl
@shft
fffffffd
and
!shft
;
?shft
dup
dup
7f
and
ffffffd6
+
drop
if
drop
;
then
80
and
drop
if
rshft
;
then
sshft
80
or
;
?ctrl
dup
dup
7f
and
ffffffe3
+
drop
if
drop
;
then
80
and
drop
if
rctrl
;
then
sctrl
80
or
;
?chvc
dup
7f
and
negate
dup
64
+
drop
-if
drop
;
then
58
+
-if
abs
-1
+
vc!
;
then
drop
;
key
kst
1
and
1
or
drop
if
key
;
then
0
60
kbp@
;
seflag
1
eflag
!
;
?seflag
@shft
3
or
drop
if
;
then
seflag
;
sendk
@shft
jump
si
ssi
csi
nul
;
mkey
key
?seflag
?shft
?ctrl
?chvc
dup
80
and
drop
if
drop
;
then
sendk
0
r
serp!
;
21
interrupt
ikey
forth
vc
@
ffffffff
and
drop
if
mkey
then
clear
/forth
i;
added
macros
macro
0if
75
2,
here
;
forth ywts
rtc
macro
p@
ec
1,
;
p!
ee
1,
drop
;
forth
rtca
70
a!
p!
71
a!
;
rtc@
rtca
0
p@
;
rtc!
rtca
p!
;
hi
10
rtc@
80
and
drop
0if
hi
;
then
;
lo
10
rtc@
80
and
drop
if
lo
;
then
;
bcd
rtc@
16
/mod
10
*
+
;
hms
lo
4
bcd
100
*
2
bcd
+
100
*
0
bcd
+
;
ymd
lo
9
bcd
100
*
8
bcd
+
100
*
7
bcd
+
;
day
lo
6
rtc@
-1
+
;
cal
hi
lo
time
-
hi
lo
time
+
;
accept
vpacc
1159429
vphx
1159044
vnm1
1158871
base
10
10
base
!
sign
1
nul
;
pack
0
0
at
28
28
black
box
text
lkey
@
.
;
evpac
vpacc
@
exec
;
evphx
vphx
@
exec
;
evnm1
vnm1
@
exec
;
racc
ffff00
board
4
+
!
accept
;
ok
show
nul
keyboard
;
246
load
pgraf
pad
nul
nul
nul
evpac
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
500
,
1b1a19
,
181e1d1c
,
2f21201f
,
2c2a2829
,
2e252226
,
232b272d
,
here
vpacc
!
pacc
pad
nul
racc
basep
pgraf
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
pack
2d2115
,
c010a0d
,
8060214
,
110f0913
,
70e0b12
,
16040305
,
10152417
,
macc
ff00ff
board
4
+
!
ok
pacc
;
anum
byte
0
,
30201
,
60504
,
90807
,
c0b0a00
,
f0e0d00
,
gnum
lkey
@
anum
+
1@
ff
and
;
?neg
sign
@
0
+
drop
if
negate
;
then
;
digit
base
@
*
gnum
?neg
+
;
dnum
drop
evpac
;
b10
10
base
!
evnm1
;
b16
16
base
!
evphx
;
pnum
pad
nul
dnum
evpac
nul
digit
digit
digit
nul
digit
digit
digit
digit
digit
digit
digit
nul
nul
nul
nul
nul
nul
nul
nul
nul
nul
nul
nul
nul
2515
,
1b1a19
,
181e1d1c
,
21201f
,
0
,
0
,
0
,
phex
pad
nul
dnum
evpac
nul
digit
digit
digit
nul
digit
digit
digit
digit
digit
digit
digit
nul
nul
digit
digit
digit
nul
digit
digit
digit
nul
nul
nul
nul
2515
,
1b1a19
,
181e1d1c
,
21201f
,
a130500
,
e041000
,
0
,
248
load
dig1
gnum
?neg
pnum
;
hex1
gnum
?neg
phex
;
sneg
1
sign
!
0
base
@
-10
+
drop
if
phex
;
then
pnum
;
here
vnm1
!
pnm1
pad
nul
sneg
evpac
b16
dig1
dig1
dig1
nul
dig1
dig1
dig1
dig1
dig1
dig1
dig1
nul
nul
nul
nul
nul
nul
nul
nul
nul
nul
nul
nul
nul
e0523
,
1b1a19
,
181e1d1c
,
21201f
,
0
,
0
,
0
,
here
vphx
!
phx1
pad
nul
sneg
evpac
b10
hex1
hex1
hex1
nul
hex1
hex1
hex1
hex1
hex1
hex1
hex1
nul
nul
hex1
hex1
hex1
nul
hex1
hex1
hex1
nul
nul
nul
nul
210523
,
1b1a19
,
181e1d1c
,
21201f
,
a130500
,
e041000
,
0
,
basep
0
sign
!
base
@
-10
+
drop
if
phx1
;
then
pnm1
;
accept
version
2
empty
254
load
nul
;
pack
black
screen
text
lkey
@
.
;
exit
logo
accept
;
gnum
lkey
@
anum
+
1@
ff
and
;
?neg
sign
@
0
+
drop
if
negate
;
then
;
dig
base
@
*
gnum
?neg
+
base
@
-10
+
drop
if
hex1
;
then
num1
;
jtopk
shift
@
0
max
5
min
jump
pack
pack
pack
pack
dig
dig
cbase
0
sign
!
base
@
-10
+
drop
0
if
hex0
;
then
num0
;
sneg
1
sign
!
base
@
-10
+
drop
if
hex1
;
then
num1
;
baset
base
@
-10
+
drop
if
10
base
!
num0
;
then
16
base
!
hex0
;
dnum
drop
alp0
;
jth0
shift
@
0
max
5
min
jump
nul
alp0
exit
nul
sneg
dnum
jth1
shift
@
0
max
5
min
jump
nul
alp0
cbase
alp0
dnum
alp0
jth2
shift
@
0
max
5
min
jump
alp0
nul
grf0
nul
baset
nul
jk
n-
0
max
4
min
jump
nul
jth0
jth1
jth2
jtopk
acc
cmkey
dup
lkey
!
jk
acc
;
ok
show
keyb
keyboard
;
ok
acc
keyboard
display
data
macro
1@
8a
2,
;
forth
lkey
1
brd
0
0
brd
!
shift
2
2
shift
!
base
10
10
base
!
kcolr
16711935
ff00ff
kcolr
!
sign
0
byte
pop
;
alpha
byte
c010a0d
,
8060214
,
110f0913
,
70e0b12
,
16040305
,
10152417
,
graph
byte
1b1a19
,
181e1d1c
,
2f21201f
,
2c2a2829
,
2e252226
,
232b272d
,
numbrs
byte
1b1a19
,
181e1d1c
,
21201f
,
0
,
0
,
0
,
octals
byte
1b1a19
,
181e1d1c
,
21201f
,
a130500
,
e041000
,
0
,
grap0
byte
50000
,
grap1
byte
52515
,
alph0
byte
2d2115
,
alph1
byte
2d2515
,
numb0
byte
e0523
,
numb1
byte
2515
,
anum
byte
0
,
30201
,
60504
,
90807
,
c0b0a00
,
f0e0d00
,
sb!
shift
!
brd
!
;
grf0
1
0
sb!
;
grf1
1
1
sb!
;
alp0
0
2
sb!
;
alp1
0
3
sb!
;
num0
0
sign
!
2
4
sb!
;
num1
2
5
sb!
;
hex0
0
sign
!
3
4
sb!
;
hex1
3
5
sb!
;
keyboard
screen
display
252
load
getc
n-c
1@
ff
and
;
four
n-n+4
4
for
dup
getc
emit
1
+
next
;
eight
n-n+8
12
+
four
space
-16
+
four
;
3rows
n-
3
for
eight
cr
next
drop
;
jbrd
brd
@
0
max
3
min
jump
alpha
graph
numbrs
octals
jtk
shift
@
0
max
5
min
jump
grap0
grap1
alph0
alph1
numb0
numb1
tkeys
jtk
four
drop
;
keyc
kcolr
@
color
;
keyb
0
600
at
1024
768
blue
box
3
603
at
keyc
jbrd
3rows
50
700
at
tkeys
;
accept
version
3
empty
adnul
1191342
here
adnul
!
nul
;
4nuls
4
for
adnul
@
,
next
;
cell
pop
2/
2/
;
brda
cell
0
,
0
,
0
,
0
,
0
,
0
,
0
,
0
,
0
,
brd@
brda
@
;
brd!
brda
!
;
shft@
brda
1
+
@
;
shft!
brda
1
+
!
;
kcl@
brda
4
+
@
;
kcl!
brda
4
+
!
;
ff00ff
kcl!
base@
brda
2
+
@
;
base!
brda
2
+
!
;
10
base!
setv
nn-
4
*
+
4
/
here
swap
!
;
264
load
exec
push
;
alph0
1
setv
exit
logo
accept
;
alph0
4
setv
grap0
4
setv
pack
black
screen
text
lkey
@
.
;
266
load
keyboard
display
data
macro
1@
8a
2,
;
forth
lkey
1
sign
0
byte
pop
;
alpha
byte
c010a0d
,
8060214
,
110f0913
,
70e0b12
,
16040305
,
10152417
,
graph
byte
1b1a19
,
181e1d1c
,
2f21201f
,
2c2a2829
,
2e252226
,
232b272d
,
numbrs
byte
1b1a19
,
181e1d1c
,
21201f
,
0
,
0
,
0
,
octals
byte
1b1a19
,
181e1d1c
,
21201f
,
a130500
,
e041000
,
0
,
grap0
align
byte
50000
,
4nuls
grap1
align
byte
52515
,
4nuls
alph0
align
byte
2d2115
,
4nuls
alph1
align
byte
2d2515
,
4nuls
numb0
align
byte
e0523
,
4nuls
numb1
align
byte
2515
,
4nuls
anum
byte
0
,
30201
,
60504
,
90807
,
c0b0a00
,
f0e0d00
,
alph0
3
setv
grf0
graph
brd!
grap0
shft!
;
grf1
graph
brd!
grap1
shft!
;
numb1
2
setv
grap0
3
setv
alp0
alpha
brd!
alph0
shft!
;
alp1
alpha
brd!
alph1
shft!
;
num0
0
sign
!
numbrs
brd!
numb0
shft!
;
num1
numbrs
brd!
numb1
shft!
;
hex0
0
sign
!
octals
brd!
numb0
shft!
;
hex1
octals
brd!
numb1
shft!
;
keyboard
screen
display
262
load
getc
n-c
1@
ff
and
;
four
n-n+4
4
for
dup
getc
emit
1
+
next
;
eight
n-n+8
12
+
four
space
-16
+
four
;
3rows
n-
3
for
eight
cr
next
drop
;
tkeys
shft@
four
drop
;
keyc
kcl@
color
;
keyb
0
600
at
1024
768
blue
box
3
603
at
keyc
brd@
3rows
50
700
at
tkeys
;
numbers
gnum
lkey
@
anum
+
1@
ff
and
;
?neg
sign
@
0
+
drop
if
negate
;
then
;
numb0
4
setv
numb1
4
setv
dig
base@
*
gnum
?neg
+
base@
-10
+
drop
if
hex1
;
then
num1
;
alph0
2
setv
cbase
0
sign
!
base@
-10
+
drop
0
if
hex0
;
then
num0
;
numb0
1
setv
sneg
1
sign
!
base@
-10
+
drop
if
hex1
;
then
num1
;
numb0
3
setv
baset
base@
-10
+
drop
if
10
base!
num0
;
then
16
base!
hex0
;
numb0
2
setv
numb1
1
setv
dnum
drop
alp0
;
thumk
n-
lkey
@
4
min
4
*
shft@
+
4
/
@
exec
;
jk
n-
0
max
1
min
jump
nul
thumk
iacc
alp0
acc
cmkey
dup
lkey
!
jk
acc
;
ok
show
keyb
keyboard
;
ok
iacc
test
aro;
14139
rtotf
14139
ew?
0
ewid
rtoen
0
1202322
rtamd
14306
rte,s
rtotf
14139
eb@
0
ev;
rtoen
0
1202322
rtamd
14306
rte?
rtotf
14139
eq@
0
ex;
rtoen
0
16
1258ec
14530
0
aro;
14139
rtotf
14139
e3@
0
e1;
rtoen
0
1202322
rtamd
14306
rta r
aro;
14139
rtotf
14139
e7@
0
e5;
rtoen
0
16
1258ec
14530
rta o
aro;
332796
aro;
32037314
rryse
rrlo
aro;
332796 rzn?e rrgse
36236
rtotf
33005968 ek
e9@
20
rtoen
0
16
rta i
o
20
t8
n
0