x86 colorforth and arrayforth tm
ns
number of sectors compressed if neg, cr
last compressed if pos.
nblk
number of uncompressed blocks.
nc
no. of compressed cylinders, deprecated cr
these vars must be first things in block! br

abuf starting block of 3 mb audit buffer
cbuf
starting block of 3 mb compression buffer
floppy
utilities for floppy format and ops.
dump
compile memory display background task
flush
eases concurrent use of pf/ef.
icons
compile icon editor
audit
utility for reconciliation and merging
index
file listing first lines of blocks
html
colorforth source to 2-up html file,
,
saying qwerty enables the qwerty keyboard mode
till next boot.
cr
seeb toggles blue word display on.            

   18 list
ns 625 nblk 1440 nc 18 144a12 02b 42c/22a,
copyright 2009 greenarrays,inc,
20 load 22 load 24 load colors 28 load
abuf
10000 ;*cbuf 29000 ;,
decompress mark 30 load restore empt
env
34 winver 2* + ; env ironment load,
44 46 thru 62 70 thru 88 load 84 load,
,
floppy 52 ;*.dump 48 load ;*flush save ;
icons
.54 ;*audit 90 ;*index 76 ;*html 176 ;,
,
mark empty arrayforth 144 load qwerty seeb,
application tools 202 2 loads mark empty,
,
exit or compile any following...
q
706 660 load ; mark empty                   


pentium macros' 1, 2, 3, , compile 1-4 bytes
drop
lodsd, flags unchanged, why sp is in esi
- in kernel

then
fix address - in kernel
swap
sp xchg
0
0 0 xor, macro 0 identical to number 0
if
jz, flags set, max 127 bytes, leave address
-if
jns, same
a
2 0 mov, never used?
a!
0 2 mov, unoptimized
2*
shift left
4@
fetch word on byte boundary.
a,
compile word address
@/!
fetch/store from/to word address, or eax
nip
swap drop
+/or/and
number or sp with eax
u+
add to 2nd number, number or sp
?
test bits, set flags, literal only!
over
sp 4 + @                                 

   20 list
macros macro
swap
168B 2, C28B0689 , ;
0
?dup C031 2, ; -cr  if 74 2, here ;
-if
79 2, here ; -cr  while n-nn if swap ;
-while
n-nn -if swap ; -cr  a ?dup C28B 2, ;
a!
?lit if BA 1, , ; then D08B 2, drop ;
2*
E0D1 2, ;*4@ b-n 8B 2, ; forth
a,
2* 2* , ; macro
@
?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 ; -cr  +or 60B binary ;
u+
?lit if 681 2, , ; then 44601 3, drop ;
?
?lit A9 1, , ; -cr  over ?dup 4468B 3, ;    


push lit to sp; eax to sp
pop
sp to eax
-
ones-complement
begin
-a current code address - byte
while
a-aa if-escape from any structure usage
example begin xxx while xxx next xxx then

for
n push count onto return stack, begin
*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
aa-aa swap end and if addresses
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                            

   22 list
- macros
push
?lit if 68 1, , ; then 50 1, drop ;
pop
?dup 58 1, ;
-
D0F7 2, ;
*end
swap
end
EB
loop
1, here - + 1, ;
until
74 loop ;
-until
79 loop ;
for
push begin ;
*next
swap
next
75240CFF
0next
, here - + 1, 4C483 3, ;
-next
79240CFF 0next ;
i
?dup 24048B 3, ;
+!
?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 ;                               


2/ arithmetic right shift
time
pentium cycle counter, calibrate to actua
l clock rate

7push/7pop
save/restore save register 7, edi
@-drop
these macros redefined in forth so they
may be executed

+or
and negate when you just can't use -
min
and max minimum and maximum
abs
absolute value
v+
add 2-vectors
exit
terminates interpretation of a block.
loads
load successive blocks
thru
loads first thru last block inclusive
nc
number of cylinders booted and saved
writes
address, cylinder, cylinder count
reads
address, cylinder, count. floppy access
note do not hit any keys while floppy is being
written - wait for light to go out

then
aborts on jump out of range.             

   24 list
- compiled macros
2/
n-n F8D1 2, ;*time -n ?dup 310F 2, ;
7push
57 1, ;*7pop 5F 1, ; forth
@
@ ;*! ! ;*+ + ;*- - ;**/ */ ;** * ;*/ / ;
/mod
/mod ;*2/ 2/ ;
dup
dup ;*drop drop ;*nip ab-b nip ;
over
over ;*swap swap ;*and and ;
or
or ;*+or +or ;*+! +! ;
exit
7pop 7pop ;*negate n-n - 1 + ;
min
nn-n less if drop ; then swap drop ;
abs
n-u dup negate
max
nn-n less if swap then drop ;
v+
vv-v push u+ pop + ;
loads
bn for dup push load pop 2 + next drop ;
writes
acn for write next drop drop ;
thru
fl over negate + 2/ 1 + loads ;
reads
acn for read next drop drop ; macro
dann
then ;
then
a-a here over negate + 128 +,
..
-256 and drop if abort dann dann ; forth    


                                              

   26 list
                                              


block n-a block number to word address
wrtboot
write boot and kernel
colors
specified as rgb' 888 bits
at
xy set current screen position - in kernel
box
xy lower-right of colored rectangle - in k
ernel

5*
emit five characters in reverse order
cf
display double-size colorforth
fill
n an writes n into a cell string
move
sdn copies a cell string from s to d
erase
bn zeroes a string of blocks
copy
n copies current editor block and its sha
dow to the given block                        

   28 list
colors etc
-offset
n-n offset @ negate + ;
block
offset @ +
blks
100 * ;
wrtboot
0 block 0 1 writes stop ;
white
FFFFFF color ;
red
FF0000 color ;
green
FF00 color ;
blue
FF color ;
silver
BFBFBF color ;
black
0 color ;
5*
5 for 2emit next ;
cf
25 dup at red B 5 1 1 5 5* green 14 2 1 3 E
5*
chip 25 550 at red 1C 1C 19 5 D 5* ;
fill
nan for over over ! 1 + next drop drop ;
move
sdn for over @ over ! 1 + 1 u+ next drop
drop ;

erase
bn push 0 swap block pop blks fill ;
copy
n blk @ block over block 512 move blk ! ;


char examine high bits; shift 4, 5 or 7 bits
eob
end of block
chars
shift characters until 0
word
shift characters, then tag
short
28-bit value+tag
number
1-bit base+tag, value in next word
32bits
for values
variable
word, value
tag
vector
words
examine tags
range
process each block
move
blocks 72 thru 1419 to 3000
res
restore compressed blocks                 

   30 list
decompress empt 32 load
char
-n 0 b! ?new 4 bits b 8 and drop if b 4 a
nd drop if
3 bits 7 ; then 1 bits 5 ; then 4 b
F
and drop if ; then
eob
n drop pop drop ;
chars
n-n char ?full c! 2*c b or chars ;
word
n 28 nb ! dup chars tbits ;
short
n 28 bits
t,
-4 nb ! b tbits ;
number
n 0 b! 1 bits t,
32bits
16 bits 16 bits b , ;
variable
n word 32bits ;
tag
-n b F and dup jump eob word number word w
ord number short word short word word word var
iable short word short

words
?new 4 bits tag words ;
range
ann over block h ! dup push erase aa ! 0
na
! begin words h @ 256 + -256 and h ! next ;
restore
ns @ dup and -if abs ns ! 36 block cbu
f
block 18 blks nc @ -2 + * move cbuf block 36
nblk @
-36 + range ; then drop ;              


b pop ebx, register 3, into eax
c!
push eax into register 1, ecx
2*d
shift ebx left by ecx. bits from eax
2*c
shift eax left by ecx
na
bits remaining in source word
nb
bits remaining in ebx
h
destination address
,
store at destination
?new
fetch new word if necessary
new
32-bits in current word
shift
eax into ebx, decrement nb
tbits
fill ebx with tag
?full
is there room in ebx?
bits
shift bits into ebx. overflow into next w
ord                                           

   32 list
- more macro uses ebx
b
?dup C38B 2, ;
b!
D88B 2, drop ;
c!
C88B 2, drop ;
2*d
C3A50F 3, ;
2*c
E0D3 2, ; forth na 22 nb 9 h 70070272 an 0
aa
74636354 nz 4
?new
na @ dup and drop if ; then
new
aa @ @ an ! 1 aa +! 32 na ! ;
shift
n-n dup negate dup nb +! na +! c! an @ 2
*d 2*c
an ! ;
bits
n ?new dup negate na @ + -if dup push + s
hift new pop negate shift ; then drop shift ;

tbits
nn nb @ 8 + c! 2*c or
,
h @ ! 1 h +! ;
tz
nn-n over nz ! dup negate push + b begin du
p
1 and drop if drop drop pop drop nz @ ; then
2/ next b! dup
nz @ - + - nb +! pop drop ;
?full
n-n nb @ dup and -if tz dup push -4 + nb
+! tbits 0 dup pop dup -
29 + nb ! ; then drop
;                                             


key? exits calling defn if key struck
clock
loads time of day suppt
altfrm
byte addr of alternate frame buffer
topram
end ram avail for applications.
@back
and !back read/wrt full disk to/from adr
@back reads only active part of compressed

@cyls
equiv to reads
screen
fills screen with current color
utime
null definition for now for compatabilit
y                                             

   34 list
native system dependencies macro
p@
a! ?dup EC 1, ; forth
key?
64 p@ 1 and drop if 60 p@ 80 and drop if
; then pop drop then ;

clock
40 ;
altfrm
-b aper @ 1024 768 * -4 * + ;
topram
-b 30000000 ;
!work
n block 0 over 1 + @ 35 + 36 / writes st
op ;

@rest
nn push 36 + block 2 pop reads stop ;
@back
n dup block 0 2 reads dup 18 + block dup
@
18 block @ or drop if drop 78 @rest ; then d
up
1 + @ dup and -if nip abs 35 + 36 / -2 + @r
est ; then drop drop
78 @rest ;
!back
n block 0 nblk @ 18 / writes stop ;
@cyls
acn reads stop ;
screen
0 dup at 1024 768 box ;
utime
-n 0 ; br

serial -n 108 ;                               


key? exits calling defn if key struck
save
writes full disk image
beep
alert in hardsim
clock
loads time of day suppt
altfrm
byte adr of alt frame buffer
topram
end ram avail for applications.
@back
and !back read/wrt full disk to/from adr
@back reads only active part of compressed, an
d only active part of straight disks with vars

@cyls
equiv to reads
screen
fills screen with current color br

fopen opens an existing win32 file given word
adr of name and access code of
r/o w/o or r/w.
returns handle, indicators nz if it's good. th
e alternate value
3 enables sharing for read a
nd write; necessary to open a file sf has open
with clib.

frd
and fwr read and write on things with win3
2 handles.                                    

   36 list
windows system dependencies
key?
keych @ 0 or drop if pop drop ; then ;
beep
;*clock 38 ;
topram
*altfrm -b endram -4096 768 * + ;
!work
n dup block 1 + @ 1 + 2/ wwork ;
@back
n dup 19 rback dup 18 + block dup @,
18 block @ or drop if drop 1440 rback ; then,
dup 1 + @ dup and -if nip abs 1 + 2/ rback ;,
then drop 3 + @ rback ;
!back
n nblk @ wback ;
@cyls
acn abuf @back push 18 * abuf + block,
swap pop 18 256 * * move ;
screen
0 dup at 868 for 0 1024 line next,
0 dup at ;*serial -n 112 ;
fopen
af-h push push 0 32 exist 3 0 0 3,
pop pop swap 4 * fcreate ;,
flng 17442 flng 4 * dup
frd
anh-n push push push 0 + pop pop swap,
pop fread*frw? ok-n if drop flng @ then ;
fwr
anh-n push push push 0 + pop pop swap,
pop fwrite frw? ;*r/o 80000000 ;
w/o
40000000 ;*...r/w r/o w/o + ;             


utime returns unix time in sec since epoch 000
0z fri 1/01/1970

sec
seconds since midnight needs unsigned mod
by time we are all dead

min
minutes past midnight                     

   38 list
- clock
sec
-n utime 60 60 * 24 * mod ;
minute
-n sec 60 / ;                          


                                              

   40 list
native clock macro pentium timer
p@
a! ?dup EC 1, ;
p!
a! EE 1, drop ; forth
ms
100000 * for next ;
ca
70 p! 71 ;
c@
ca p@ ;
c!
ca p! ;
!bcd
push 10 /mod 16 * + pop c! ;
!hm
100 /mod 4 !bcd 2 !bcd 0 dup c! ;
bcd
c@ 16 /mod 10 * + ;
sec0
4 bcd 60 * 2 bcd + 60 * 0 bcd + ;
sec
sec0 2 ms dup sec0 or drop if drop sec ; t
hen ;

minute
sec 60 / ;
hms
sec 60 /mod 60 /mod 100 * + 100 * + ;
ymd
9 bcd 100 * 8 bcd + 100 * 7 bcd + ;
day
6 c@ -1 + ;
hi
10 c@ 80 and drop if ; then hi ;
lo
10 c@ 80 and drop if lo ; then ;
cal
hi lo time - hi lo time + 748 ;
beep
B6 43 p! EE 42 p! 0 42 p! on 61 p@ 3 or 6
1
p! 50000000 for next off 61 p@ 3 or 61 p! ; 


                                              

   42 list
                                              


logo and editor display extensions.,
empty smart for less display wanking,
,
logo displays colorforth logo
-safe
returns true flag if addr is past here.
?logo
displays logo screen if current display,
generator has been forgotten.
empty
switches to logo display only if current
display has been forgotten.
,
,
editor display is extended to show block no.,
being edited above the keyboard hints, colored
red if the editor is 'hot'.

+buf
preserves blk if new block is different
list
displays the given block without entering
the editor.

l
lists the current editor block.             

   44 list
logo and watermark
logo
show black screen 800 710 blue box 600 50
at
1024 620 red box 200 100 at 700 500 green b
ox
18 list text cf keyboard ; logo,
,
-safe a-f negate here + 80000000 and drop ;
?logo
sp 17 + @ -safe if logo ; then ;
empty
empt ?logo ;,
,
2u.r nw -1 + dup push for 10 /mod next F and,
begin 0 + if pop 1 +*.lo for 24 + 2emit next ;
then drop space space next
1 .lo ;
?ec
blk 2 + @ 0 + drop if red ; then silver ;
watermark
show black screen 765 603 at,
blk @ ?ec 6 2u.r +list keyboard ;,
,
+buf n-n blk @ over or if,
...
over or blk 1 + ! ; then drop ;,
,
edit n +buf blk !*e watermark +e ;
list
n +buf blk ! lis ;*l blk @ list ;        


!dict resets dictionary to a saved state
interp
is a temp patch for missing interpreter
entry point.

finish
executes at same stack level as load bu
t starts interpreting at editor's current curs
or position.
,
,
-kbd returns true/nonzero flag if a word that
calls it is being interpreted from a block as
opposed to from the keyboard. use with caution
from deep within an app that might have monkey
ed with register
7
fh
from here, block number relative to editor
or interpreter block as appropriate.

pause
is redefined to push an extra item onto
stack while displaying for symmetry with kbd. 

   46 list
miscellaneous
!dict
fmh h ! macros ! forths ! ;
interp
b align load ; temp 9 here 4 / -1 + +!
finish
cad @ interp ;,
,
-kbd -t 7push pop dup and drop ;
fh
n-b -kbd if 7push pop 0 block,
negate + 256 / + ; then blk @ + ;
paws
pause ;*pause dup paws drop ;            


does not say empty, compiles on top of applica
tion

x
-a current address
one
a-a line of display
lines
an
dump
a background task continually displays me
mory --- takes address -- displays three cols
with address on right contents in middle and-
the left col is f18 instruction view

u
increment address
d
decrement
ati
address of agp graphic registers
byte
a byte address dump
fix
an-a test word                            

   48 list
dump empty x 75751424 y -79635296
5-8
8 /mod 32 /mod 32 /mod 100 * + 100 * + 100
* swap
4 * + ;
one
dup @ dup 5-8 h. space h. space dup h. cr
;

lines
for one -1 + next drop ;
dump
x !
r
show black screen x @ 15 + 16 text lines key
board ;

it
@ + @ dup h. space ;
lines
for white i x it i y it or drop if red t
hen i . 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 agp graphics reg
byte
4 / dump ;
fix
for 0 over ! 1 + next ; dump              


                                              

   50 list
timing tmt 286630312 tmn -162350156 tmp 642452
70
secs 0
tmclr
0 tmt ! 0 tmn ! 0 tmp ! 0 secs ! ;
tms
a time - 1 + swap +! ;
tme
a time swap +! ;
tare
tmt tms pause tmt tme ;
0tare
tmn tms switch tmn tme ;
counter
utime negate secs +! ;
timer
utime secs +! ;                         


format issue format command 30 cyl - in kernel
hd
disk head
ad
current address in buffer
buffer
usual floppy cylinder buffer
array
return word address
com
format command
word
store word into command string
sectors
build sector table
head
build sectors for selected head
cylinders
sectors advance 1 for each cylinder
- to allow time for head step

format
only desired cylinders to save time
bytes
arguments for crc
archive
verify save' compute crc, save, read-b
ack, recompute crc - first 64 bytes used by fl
oppy read/write -- the two crc numbers should
be the same !                                 

   52 list
floppy utility empty hd 1 ad 152338
array
pop 2/ 2/ ;
com
align array 1202004D , 6C 2,
word
n ad @ ! 1 ad +! ;
sectors
cs-c buffer ad ! 18 for over hd @ 100
* + over
18 mod 1 + 10000 * + 2000000 + word 1
+ next drop ;

head
ch-c dup hd ! 400 * 1202004D + com ! dup
2* -
1801 + sectors format ;
cylinders
n push com 0 pop for 0 head 1 head 1
+ next
stop drop drop ;
format
nc @ 80 cylinders stop ;
archive
0 block 0 nc @ writes stop ;
check
abuf block 0 nc @ reads stop ;
ati
10CD4123 vesa ! ; setup for ati video card
nvidia
10CD4118 vesa ! ; for nvidia card then
save                                          


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
ikon
draw big-bits icon
adj
nn-nn magnify cursor position
cursor
draw red box for cursor
ok
background task to continually draw icon, i
con number at top                             

   54 list
icons empty macro
@w
8B66 3, ;
!w
a! 28966 3, drop ;
*byte
C486 2, ; forth ic 11 cu 167
sq
xy @ 10000 /mod 16 + swap 16 + box cr
17 0 +at ;
loc
ic @ 16 24 8 */ * 12 block 4 * + ;
0/1
8000 ? if green sq ; then blue sq ;
row
dup @w *byte 16 for 0/1 2* next drop cr
-17 16 * 17 +at ;
ikon
loc 24 for row 2 + next drop ;
adj
17 * swap ;
cursor
cu @ 16 /mod adj adj over over at cr
red 52 u+ 52 + box ;
line
i-in for dup emit 1 + next ;
set
xy over lm at 0 10 for 12 line cr next cr
8 line drop ;
ok
show black screen cursor 18 dup at ikon cr
text ic @ dup . h. 400 60 set keyboard ; 56 lo
ad ok h                                       


edit icon                                     

   56 list
- control panel
+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 ;
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 dup , , 2B00002
3
, 0 , 0 , 0 ,                               


                                              

   58 list
                                              


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 addres
s. base port on stack at compile time. compile
d as literal at yellow-green transition

9600
115200
baud-rate divisors. these are names, no
t 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 teste
d by
if
rcv
-n wait for ready and fetch byte          

   60 list
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! 115200 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 pau
se
xmit ;
cts
6 r p@ 30 and 30 or drop if cts ; then xmi
t ;

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 ;                


word search tcurs
bt
returns nz and less if bit n of m is set. p
ops t to 2, bit test index t mask 2, 2-2-sbb t
o set nz if carry.

tag?
nz and less if bit in m indexed by tag of
token n is 1.

t2
nn-nn 2 cell - big nums, var
t1
nn-nn 1 cell
t0
nn-nn extensions, undefined
map
end n wrd-end n inc n and maybe curs
tcurs
blk offset-blk convert offset to tokens
in curs

-curs
- decrement curs to zero
tpoint
- fix abort to point cursor correctly,
except if last word in block                  

   62 list
word search macro
bt
nm-n 68BD08B , F04768D , D21BC2A3 , ; forth
tag?
nm-n over F and swap bt drop ;
red?
n-nm 1008 tag? if 4092 ; then 1008 ;
t2
nn-nn 1 +
t1
nn-nn 1 curs +!
t0
nn-nn 1 + ;
map
nnn-nn F and jump indent
  
t0 t1 t2 t1 t1 t2 t1 t1 indent
  
t1 t1 t1 t1 t2 t1 t1 t1
tcurs
nn-n over block push -1 curs ! 0
tcu1
nnn-n dup i + @ map over over negate + dr
op -if t1 drop drop pop drop ; then tcu1 ;

-curs
- curs @ -1 + 0 max curs ! ; here
tpoint
blk @ curs @ tcurs drop -curs ; cpoint
!                                             


word search
+shad
skips shadows if in one and skipping.
1word
-n return 1st cell of word from kbd.
find
finds following short word, starting in b
lock 18, regardless of color.

def
finds only definitions.
f
find next occurrence of word last found
fk
'f' key in edit keyboard. drops key and blo
ck number and behaves like f except continues
search from current editor position in current
kind of block src/shad.

fkc
if word left of cursor is a number, list t
hat block. if red or magenta definition, searc
hes for references. otherwise searches for def
initions.

from
n- like find but start from block number
literal
n- finds any equivalent literal       

   64 list
- more fmask -16 fnn -1794220780 cr
fna 67146240 fbits 4104 18 block fna !
+shad
a-a dup fna @ or 256 and + ;
1word
-n word words @
1wz
2 less drop if drop ; then nip -1 + 1wz ;
want?
nm-n tag? if or ; then drop drop -1 ;
-found
na @ fbits @ want? fmask @ and drop ;
reedit
fna nip dup 1 + fna ! indent
  
100 /mod -offset swap tcurs swap indent
  
dup and drop if dup blk ! then edit ;
find
1word 5E9A -cr  fnd+ 18 block -16
fnd
nbam fmask ! fna ! fbits ! 16 or fnn ! 0
f
f fnn @ 16 or fna @ begin indent
  
+shad nblk @ block less drop while indent
  
over over -found while 1 + end indent
  
then reedit ; then drop drop drop ;
def
1word 1008 fnd+ ; here ekt 21 + !
fkc
drop pcad @ @ 140 tag? if 32 / edit ; cr
then red? fnd+ blk @ dup ; here ekt 22 + !
fk
drop drop cad @ fna ! 1 f blk @ dup ;
from
n 1word swap 5E9A swap block -16 fnd ;
literal
n 20 * 140 18 block -32 fnd ;         


tags cr
extend execute 32-bit define cr
compile 32-bit 27-bit immediate cr
27-bit comment cap caps cr
variable address blue 27-bit br

array fetch new tag
reclr
table of color cycles
wadr
-a address of word to left of cursor
change
color of word to left of cursor
220e100a
0a-c 10-d 0e-f 22-j                  

   66 list
editor recolor 8 display + @ 13 display + !
array
pop 2/ 2/ + @ ; 1-4-9 2-5 8-6-15
reclr
align array cr
0 , 4 , 5 , 3 , 9 , 2 , 15 , 7 , cr
6 , 1 , 10 , 11 , 12 , 13 , 14 , 8 ,
wadr
-a pcad @ blk @ max ; here ekt 20 + !
change
wadr @ F and reclr wadr @ FFFFFFF0 and
or wadr ! ;
220E100A ekt 33 + ! br

obsolete comment cases F000000 ekt 32 + ! cr
ekt 16 + @ dup ekt 17 + ! ekt 18 + !          


blue and grey words*must fit into one cell!,
,
-w@ returns word being interpreted by display
.blu
display blue word
type1
displays word with color already set,
,
exr one-shot red display suppressing cr
-cr
arms exr for next red word encountered.
s/2
halfspace for reports.,
,
bs backspace protecting left margin
wd
is a factor of simple to test shannon codes
simple
returns regular blue word for execution
but handles special words internally.
,
,
exb display and execute blue word iff found in
dictionary.                                   

   68 list
blue words ?blu 255 0 ?blu !
-w@
-n 7push pop -1 + @ ;*.blu ?blu @ color
type1
9 display + @ 5 + push ;,
,
here*blu ;*-blue b-t dup 1 + 4@ + -5 + or,
...
drop ;,
,
d03 -a 3 display + ; ...here
exr
d03 @ nop d03 ! red type1 ;
-cr
blu 0 + nop d03 ! ;*sp/2 B0000 xy +! ;,
,
bs xy 1 + @ 21 + 10000 * xy @ less,
...
drop drop if FFEA0000 xy +! then ;
wd
nn-/n over or if 0 and drop ;,
...
then nip pop pop drop push 1 or drop ;
simple
-w -w@ -16 and,
* FA000000 wd if bs .blu -cr bs ; then,
, FC000000 wd if bs .blu cr ; then,
. EA000000 wd if .blu bs ; then,
.. EBD40000 wd if .blu bs ; then,
... EBD7A800 wd if .blu bs ; then ;           


seeb toggle display of blue words
?seeb
set flag non-zero if blue words visible,
,
@lit fetch 27-bit literal from current word
tadr
display target address,
,
br blank line
tab
advance n spaces
indent
5 spaces                               

   70 list
- blue and grey,
,
here 14 display + !
exb
simple .blu itick if drop ; then,
dup -blue if drop ; then push drop ;,
,
seeb ?blu @ FF or ?blu ! ;
?seeb
-t ?blu @ 0 + drop ;,
,
@lit -w@ 32 / ; grey here display 13 + !
tadr
C0C0C0 color @lit 1024 /mod swap,
2 over -256 and drop if 1 + then h.n,
0 + if 39 emit dup 1 h.n then drop space ;,
,
old blue words
br
blu cr cr ;*tab n for space next ;
indent
blu cr 3 tab ;*kr cr ;*cr blu kr ;     


colorforth to ascii and ascii to colorforth
cf-ii
otr inae ycms wfgl bpvd quxh indent
  
3210 7654 -j98 /z.k +!'; ?,*@
ii-cf
! +* /.-, 3zjk 7654 ;'98 ? indent
  
cba@ gfed 02ih onml srqp wvut 1yx indent
  
cba@ gfed 02ih onml srqp wvut 1yx br

to facilitate pathnames and html strings...
set1
modifies cf-ii table. cr
; to colon, ' to doublequote, + to equal, cr
@ to lessthan, * to blank, ? to greaterthan
set0
restores original cf-ii table.           

   72 list
convert cf character to/from ascii cr
macro
1@
8A 2, ; -cr  1! a! 288 2, drop ; forth
string
pop ;
cf-ii
align string cr
6F747200 , 696E6165 , 79636D73 , 7766676C , cr
62707664 , 71757868 , 33323130 , 37363534 , cr
2D6A3938 , 2F7A2E6B , 2B21273B , 3F2C2A40 ,
ch
FFFFFFF0 and unpack cf-ii + 1@ FF and ; br

ii-cf string cr
2A00 , 2B , 2B2D0000 , 2725232E , cr
1B1A1918 , 1F1E1D1C , 28292120 , 2F000000 , cr
3A43355C , 3D3E3440 , 54523744 , 3336393C , cr
38314742 , 3F414632 , 563B45 , 23000000 , cr
A13052C , D0E0410 , 24220714 , 306090C , cr
8011712 , F111602 , 260B15 ,
chc
FFFFFFE0 + ii-cf + 1@ FF and ; br

set1 3D21223A 3E2C203C
!8
nn- cf-ii 2C + 2/ 2/ ! cf-ii 28 + 2/ 2/ ! ;
set0
2B21273B 3F2C2A40 !8 ;                   


filename input
strng
defines an array of bytes.
fnam
is a zero terminated ascii string consist
ing of
hld chars including the null. emt appen
ds a character to this string.

+shan
appends a shannon word to fnam. br

named returns the byte address of a null termi
nated ascii string representing the following
colorforth string, which may follow in either
source code or in keyboard input.
cr
example named //./a; br

onamed and bnamed override the default .cf cr
filenames used by save and audit              

   74 list
pathname input -nat 72 load set1
strng
n-a pop + ;
fnam
n-a align strng here 80 + h ! hld 8
emt
n- hld @ fnam 1! 1 hld +! ;
+shan
ch emt dup and if +shan ; then drop ; br

,src 7@+ @
xx
dup and if +shan 7@+ @ dup 15 and drop cr
while then 0 and emt 7dec ; then xx ;
named
string 0 hld ! -kbd if ,src ; cr
then keyboard 0 word 0 cr
begin push dup and while end then drop cr
begin pop dup and while +shan end then emt ; c
r
onam n-a align strng here 80 + h !
bnam
n-a align strng here 80 + h !
!str
b push named 0 fnam 4 / pop 4 / 20 move ;
onamed
0 onam !str ; onamed okadwork.cf
bnamed
0 bnam !str ; bnamed okadback.cf cr
0 onam 'ofn ! 0 bnam 'bfn !                   


index
hld
place in file
spot
in line
nxt
fetch next word
emit
ascii character, won't go past column 72
space
written to file
crlf
to file
digit
hex digit to file
.h
print hex number
.d
decimal number br

usage example in bottom line.                 

   76 list
index empty -nat cr
pad 278806528 abuf block 4 * pad ! cr
hld 278823970 pad @ hld ! pos 2 0 pos !
nxt
a-an dup 1 + swap @ ;
-eol?
pos @ 47 or drop ;
.sp
32
.ch
c -eol? if hld @ 1! 1 hld +! 1 pos +! ; in
dent
  
then drop ;
crlf
0 pos ! 13 .ch 10 .ch ; br

.hd n -10 + -if 3A + .ch ; then 41 + .ch ;
.dec
n 0 + -if 2D .ch negate then -1 swap cr
begin 10 /mod dup and while end then drop
spit
-1 ... begin .hd 0 + -until drop ; br

hd n-nn dup F and swap 2/ 2/ 2/ 2/ ;
.hex
n -1 swap begin hd FFFFFFF and while end
then drop spit ;
cr
78 load br

named index.txt exit 18 1440 run              


index.1
short
number
literal
long number
word
text, not number
cont
inuation word
variable
name and value
eol
red word means end of line
tag
vector table
words
print maximum n words or to eol
run
first-block last+1 cr
prints first line of each block in range cr
to a log file in windows                      

   78 list
- more
word
n .sp FFFFFFF0 and
cont
n dup and if ch .ch cont ; then drop ;
short
n .sp 2/ 2/ 2/ 2/ dup 1 and drop indent
  
if 2/ .hex ; then 2/ .dec ;
variable
an-a word 0
long
an-a .sp push nxt pop 10 and drop indent
  
if .hex ; then .dec ;
eol
n begin drop 47 pos ! ;
tag
a-a dup and until dup F and jump cr
cont word long eol word long short word cr
short word word word variable short eol short
?sp
nl-n + -if .sp then ;
line
n -100 ?sp -900 ?sp 1000 + indent
  
dup .dec space block 0 pos ! indent
  
begin -eol? while nxt tag end indent
  
then drop crlf ;
run
1st lst+1 pad @ hld ! over negate + 2/ ind
ent
  
for dup line 2 + next drop
sav
0 32 2 0 0 w/o 0 fnam fcreate dup push cr
pad @ hld @ over negate + pop fwr drop fclose
;                                             


index page overview display br

qx shows the heading comments of the index pag
e in which block
n lies, source or shadow. br

nx shows the next page and bx the preceding.
sx
toggles between source and shadows for the
current page.
br

ax shows the page in which the current editor
block lies.
this block is displayed in green  

   80 list
qx ?qxc 271547945 qb 120 82 load
?c
n-n green dup blk @ or drop if white then ;
!qx
?qxc assign ?c ; !qx,
,
nx qb @ 120 +*qx n !qx 0 max abuf /mod,
...
push 2 /mod 60 / 120 * + pop abuf * + qb !,
show black screen white 0 60 for dup 30 /mod,
...
42 * swap tab/2 qb @ over 2* + ?qxc xqt,
...
dup .r .cmt 1 + next drop keyboard ;
bx
qb @ -120 + qx ; -cr  ax blk @ qx ;
sx
qb @ 1 or qx ;
ox
qb @ abuf /mod 1 or abuf * + qx ;          


index page overview display br

these definitions are necessary due to the way
in which colorforth kernel is factored.       

   82 list
- formatting ws 271547561
tab/2
xy push 11 * 3 + pop 15 * 3 + cr
over lm at ; -cr  emit/2 c 48 + emit
-sp/2
-11 10000 * nop xy +! ; br

/bl ws assign nop ; -cr  /sp ws assign sp/2 ;
.r
n 4 for 10 /mod next F and 4 for 0 + if cr
pop 1 + -cr  .lo for 24 + emit/2 next ; cr
then drop ws xqt next 1 .lo ; /sp
.n
n 32 / /bl .r /sp ;
.s/2
n 0 + if unpack emit/2 .s/2 ; then drop ;
.wd
n 8200 tag? if sp/2 then 8000 tag? if .n ;
then
-16 and .s/2 ;
.cmt
n 18 less drop if drop ; then block 7 for
dup @
0 + while 8201 tag? while .wd cr
1 + next drop ; then then pop drop drop drop ;


short tag, then 28bit value+base
lit
tag, then base
32bits
from next word. 2 chunks
variable
single word, then 32-bits
/whit
replaces a word's tag with 9, making it
a lowercase comment.

tag
identify kind of word note /whit used for
tags
A and B to convert these deprecated capit
alized comments to lower case. when all source
of interest has been compressed at least once
this may be removed.

atoms
scan thru block. 8 0s eob
range
process blocks, number and count. 31 0s
eof

sve
compress blocks 72 thru 1419
flop
write floppy; save number of cylinders   

   84 list
resident compress 86 load
short
4 rbits 28 bits ;
lit
4 rbits 2/ 2/ 2/ 2/ 1 rbits
32bits
drop 1 + dup @ 16 bits 16 bits ;
variable
1word 32bits ;
/whit
n-n -16 and 9 or atom ;
tag
an-an dup F and jump cont atom lit atom at
om lit short atom short atom /whit /whit varia
ble short atom short

atoms
a dup @ dup and if tag drop 1 + atoms ;
then
4 bits drop drop ;
range
nn-an here/4 here4 push new for dup bloc
k atoms
1 + next drop 0 31 bits drop pop here4
over negate + ;

!lng
nw 127 + 128 / 72 + dup nsec 0 block 1 +
! dup negate
ns ! 35 + 36 / nc ! ;
save
7push h @ push cbuf 36 + block 4 * h ! 36
nblk @
-36 + range an !lng drop 0 block cbuf b
lock
36 blks move cbuf !work ns @ abs ns ! pop
h
! 7pop ;                                    


r3@ fetches register 3 onto stack.
r1!
stores top of stack to register 1.
2*d
shift ebx left by ecx. bits from eax
2*c
shift eax left by ecx
2/r
rotate eax right by ecx
nb
number of bits remaining in word
here/4
align to word boundary
here4
word address in dictionary
new
32-bits in current word
shift
eax into ebx, decrement nb
rbits
rotate bits to high-order position
bits
shift bits into ebx; cross word boundary
char
examine high bits. shift 4, 5 or 7 bits
chars
shift all non-zero characters
1word
short word without continuation for vari
able

atom
shift tag, then characters
cont
continue without tag                     

   86 list
- more macro uses ebx
r3@
?dup C38B 2, ;
r1!
C88B 2, drop ;
2*d
C3A50F 3, ;
2*c
E0D3 2, ;
2/r
C8D3 2, ; forth nb 9
here/4
here 3 and if 1, here/4 ; then drop ;
here4
here 2/ 2/ ;
new
32 nb ! ;
shift
nn-n dup negate nb +! r1! 2*d 2*c ;
rbits
dup r1! swap 2/r swap
bits
nn-n dup negate nb @ + -if dup push + shi
ft r3@ , new pop negate shift ; then drop shif
t ;

char
-if 2* -if 2/ 7 bits ; then 2/ 80000000 o
r
5 bits ; then 4 bits ;
chars
dup and if char chars ; then ;
1word
4 rbits chars 4 bits ;
atom
an-an 4 rbits
cont
chars over 1 + @ dup and if F and drop if
4
bits ; then ; then drop 4 bits ;            


various useful extensions. br

7@+ interpret only, returns adr of next word i
n block and skips over it ... 7-0-mov 7-inc

7dec
used to correct address after 7@+
@ret
fetch return address, skip bytes of code.
4@
cell fetch on byte boundary
tick
given adr of call instr, return tgt adr
call
and jmp generate xfers to next word br

.shan displays a shannon coded string
,lit
compiles a literal.
.'
displays the following comment or comments.
remember
used in a containing word to make tha
t word restore dictionary to what immedately f
ollows it.
br

strings starts an array of words in source.
'
interp only, returns next word's code addr.
execute
is a call to the given routine adr.
eval
interprets the source word whose address
is given.                                     

   88 list
display text macro
7@+
-a ?dup C78B 2, 47 1, ;*7dec 4F 1, ;
@ret
-b ?dup 24048B 3, 5240483 , ;
4@
b-n 8B 2, ; forth
tick
b-b dup 1 + 4@ + 5 + ;
call
E8*dst 1, @ret tick here 3 + - + , ;
jmp
E9 dst ;*execute b push ;,
,
.shan n- dup and if unpack emit .shan ; then d
rop ;

.shans
a begin dup @ 8201 tag? while -16 and,
...
.shan 1 + dup @ 8200 tag? drop if space,
then end then drop drop ;*+str a-a + ; macro
,lit
n ?dup B8 1, , ;
strings
i-a 7push pop ,lit jmp +str nop ;
.'
comments 7@+ ,lit call .shans nop ;
remember
forths @ ,lit macros @ ,lit h @ 15 +
,lit
call jmp !dict nop ; forth,
,
' -b -kbd if 7@+ @ itick if abort then ;,
then tic ;
eval
a 7push 1 + push 7pop,
...
sp 1 + @ execute 7pop ;                    


disk mgmt and reconciliation utility.
bloks
copies n blocks from s to d, front to ba
ck so only moves overlap downward safely.

+blocks
copies n blocks and their shadows.
obliterate
wipes from block l to block h.
matching
sets up to match s to d.
to
sets block no. past end of source area.
other
given a block number in one of the areas
returns the corresponding block no. in the oth
er area.

lesser
given a block number returns the lesser
of the pair it is a member of

?blks
scans a range of blks leaving nos of any
differing blks on the stack.

?bin
scans the binary parts of okad disk.
check
reads backup to 3000 and decompresses if
appropriate                                   

   90 list
disk audit utility empty 30 load bias 0,
sep 10000 abuf sep ! head 1439 1439 head !
+blocks
sdn 2* bloks ;
bloks
sdn push swap block swap block pop 256 *
move ;
*n18 i-a abuf 18 + block + ;
wipe
blk @ 1 erase e lis ;*to n head ! ;
obliterate
lh over negate + erase ;
matching
sd less if swap then,
dup bias ! negate + sep ! ;
cast
nn-n dup push /mod 1 or pop * + ;
other
n-n' bias @ negate + sep @ cast bias @ +
;
*lesser n-n dup other min ; 92 load
?blk
n-n?n+ lesser dup block over other block
256
for over @ over @ or drop if drop drop dup
1
+ pop drop ; then 1 + 1 u+ next drop drop 1
+ ;
*?blks sn-? for ?blk next drop ;
?bin
kernel 0 12 ?blks icons 12 6 ?blks ;
unpk
abs 1 n18 !,
abuf 36 + block cbuf block 1404 blks move,
cbuf block abuf 36 + 3 n18 @ -36 + range ;
check
abuf @back 0 n18 @ 18 block @ or,
drop if ; then 1 n18 @,
dup and -if unpk ; then drop ;                


blink displays the given block with its other
set as the editor's 'other' block

var
compares a variable name, advancing pointe
rs to skip its value.

*1
compares garden variety words.
*2
compares large literals.
tag
compares source cells given, true if diff,
advancing ptrs and ignoring variable vals.

?nul
ends loop in co if nuls hit in both blks.
co
does work of com given adrs of both blks.
com
invokes editor to blink the given block if
it differs from the other, otherwise returns.

g
scans for diffs after current editor block.
v
shows the other block
give
writes current editor block over its twin
take
writes twin over current editor block.
check
reads backup to 3000 for matching.
all
scans the whole usable area of the disk.
cvec
is behavior on com finding difference;
diff
makes it just set color for qx.
!cx
makes qx aware of us,
empty
redefined to kill that awareness.       

   92 list
- compare cvec 271556556
blink
cvec assign n dup other blk ! edit ;
var
nnxx-nnd push push 1 + 1 u+ pop pop
*1
nnxx-nnd or ;
*2
nnxx-nnd var push over @ over @ or pop + ;
tag
nn-n dup F and jump *1 *1 *2 *1,
...
*1 *2 *1 *1 ..*1 *1 *1 *1 ..var *1 *1 *1
?nul
nnxx-nnxx over over +or drop if ; then dr
op drop pop drop drop drop ;

co
naa-n over @ over @ ?nul tag drop if,
...
drop drop cvec xqt ; then 1 + 1 u+ co ;
com
n-n dup block over other block co ;
g
blk @ lesser
gg
n blink head @ over - + drop -if drop ;,
then 1 + com gg ;
v
blk @ other edit ;
give
blk @ dup other 1 bloks ;
take
blk @ dup other swap 1 bloks ;
all
0 abuf matching nblk @ -1 + to 17 gg ;
diff
cvec assign red ;
!cx
?qxc assign n-n ?c diff com ;,
!cx*emp empty !qx ;*empty emp ;               


-msg deactivates any current message and sets
nr
to default life span of 2 refreshes, which
typically means
two keystrokes.
msg
is std word to assign rest of defn to msg.
rep
is used inside a msg to count down life.
?msg
deactivates if its code's been forgotten.
empty
changes display/message only if needed.
messages display till forgotten, or aged using
rep, or are replaced by another, or someone sa
ys -msg, or the message otherwise monitors the
situation and uses -msg itself.
,
,
ks0 and ksp return empty and current stack,
pointers in word units.
.s
displays stack, top on right, yellow number
is max number of entries to display. indicates
stack below empty and ... when excess items.
,
factored separately so new versions may be,
tested as messages with nos                   

   94 list
improved stack display nr 6,
,
-msg ' nul 'msg ! 2 6 nr ! ;
msg
-msg pop 'msg ! ;
rep
-1 nr +! nr @ 0 + drop if ; then -msg ;
?msg
'msg @ -safe if -msg ; then ;
emp
empty ?msg ;*empty emp ;,
,
ks0 -a 'stk 1 + @ 4 / -1 + ;
ksp
-a 'stk 2 + @ 4@ 4@ 4 / ;
.s
ks0 ksp negate + dup . 0 less drop if,
..
abs . .' below empty ; then 0 + if,
....
5 over less drop if .' ... swap then drop,
....
dup push ksp + begin,
dup @ ?. -1 + next drop then drop ;,
install ' .s 'stk ! exit,
,
-range msg rep red .' out of range ; macro
then
a-a here over negate + 128 + -256 and,
drop if -range abort dann dann ; forth exit,
dstk*z 'msg assign white,
'stk 2 + @ 9 + 4@ 4@ 4 / ?. ;                 


                                              

   96 list
                                              


                                              

   98 list
                                              


                                              

   100 list
show bin occupancy empty compile
?any
nn-nn dup nn-n 2* 8000 + block 0 64 for,
...
over @ 61FC or +or 1 u+ next nip 0 +,
drop if dup 100 mod swap then ;
row
nn 18 for ?any 1 + next drop ;
chk
0 18 for dup 1 + next drop ;              


                                              

   102 list
                                              


                                              

   104 list
                                              


                                              

   106 list
                                              


talk to chip via native rs232. br

1@ and 1! byte fetch and store, byte address.
2@
and 2! halfcell fetch/store, byte adr.
swab
and swa4 2-way and 4-way byte swaps.
a-b
and b-a convert cells to+from bytes. br

bofs and ofs make byte and cell offset adrs in
a structure given byte posn and byte width.

create
used after align to exit with word adr
of cell following in dictionary.
note that wri
ting into such allocations invalidates nearby
instruction cache!

rez
allots n bytes in the dictionary.
?zero
classical zero-equal returning 0 or -1 w
ith indicators.
br

ntgt indices for active paths, 1 for adjacent.
act
number of selected path, to which vport le
ads.

cold
sets no active paths.
user
test code before canonicals.             

   108 list
ide native async 0 fh orgn ! macro
1@
b-c 8A 2, ;
1!
cb a! 288 2, drop ;
2@
b-h 8B66 3, ;
2!
hb a! 28966 3, drop ;
4@
b-n 8B 2, ;
4!
nb a! 289 2, drop ;
swab
h-h C486 2, ;
swa4
n-n C80F 2, ; forth
a-b
a-b 2* 2* ;
b-a
b-a 3 + 2/ 2/ ;
create
-a pop b-a ;
rez
n h +! ;
?zero
n-n 0 or if dup or ; then - -1 or ; br

act 0 vport 373 0tg 1 1tg 1 2tg 1
cold
1 0tg ! 1 1tg ! 1 2tg ! 0 act ! ; br

ser 110 load 118 load routes 120 load cr
generic 122 132 thru panel 134 load cr
user 136 load 142 load creeper 140 load cr
canon load                                    


async data are 18 bits per 3 bytes. to chip wo
rd inverted, shifted up 6, '12' inserted, then
sent low order byte first. from chip are tbd.

br

!nam sport and bps dummies for compatibility
4@
and 4! full cell on byte address.
+ser
opens serial; true if good, handle in dh.
-ser
closes the handle.
reset
resets the chip.
toser
transmits n bytes to chip.
inser
receives w f18 words from the chip. br

-stream clears byte index bi in sdat buffer.
stream
byte adr of buffer.
/str
byte adr of next 18-bit slot in buff. br

@18 returns the next 18 bits from the stream.
!18
appends 18 bits to the stream. no higher o
rder bits may be present!                     

   110 list
- umbilical 3F8 serial 60 load
!nam
; sport 0 bps 0
rsh
ni-n 0 + if for 2/ next ; then drop ;
sdat
align create 24576 rez bi 30
-stream
0 bi ! ;
stream
-b sdat a-b ;
/str
-b bi @ stream + ; br

@18 -n /str 4@ 3FFFF and
+wd
3 bi +! ;
!18
n 3FFFF or 40 * 12 + /str 4! +wd ; br

+ser -ok init 1 0 + ;
-ser
;
reset
1 st! 100000 for next 3 st! ;
toser
bn for dup 1@ xmit 1 + next drop ;
inser
w stream swap 3 * for indent
  
rcv over 1! 1 + next drop ;                


talk to chip via onspec usb. br

1@ and 1! byte fetch and store, byte address.
2@
and 2! halfcell fetch/store, byte adr.
swab
and swa4 2-way and 4-way byte swaps.
a-b
and b-a convert cells to+from bytes. br

bofs and ofs make byte and cell offset adrs in
a structure given byte posn and byte width.

create
used after align to exit with word adr
of cell following in dictionary.
note that wri
ting into such allocations invalidates nearby
instruction cache!

rez
allots n bytes in the dictionary.
+or
inclusive or.
?zero
classical zero-equal returning 0 or -1 w
ith indicators.
br

ntgt indices for active paths, 1 for adjacent.
act
number of selected path, to which vport le
ads.

cold
sets no active paths.
user
test code before canonicals.             

   112 list
ide windows async 0 fh orgn ! macro
1@
b-c 8A 2, ; -cr  1! cb a! 288 2, drop ;
2@
b-h 8B66 3, ; -cr  2! hb a! 28966 3, drop ;
4@
b-n 8B 2, ; -cr  4! nb a! 289 2, drop ;
swab
h-h C486 2, ;
swa4
n-n C80F 2, ; forth br

a-b a-b 2* 2* ; -cr  b-a b-a 3 + 2/ 2/ ;
create
-a pop b-a ; -cr  rez n h +! ;
?zero
n-n 0 or if dup or ; then - -1 or ; br

act 2 vport 469 0tg 1 1tg 1 2tg 1
cold
1 0tg ! 1 1tg ! 1 2tg ! 0 act ! ; br

ser 114 118 thru routes 120 load cr
generic 122 132 thru panel 134 load cr
user 136 load 142 load creeper 140 load cr
canon load                                    


async data are 18 bits per 3 bytes. to chip wo
rd inverted, shifted up 6, '12' inserted, then
sent low order byte first. from chip are tbd.

br

sport comp com port number
snam
null terminated string //./comx
!nam
sets port number in snam.
+ser
opens serial; true if good, handle in dh.
-ser
closes the handle.
reset
resets chip. no inversion in rx line.
toser
transmits n bytes from byteadr b
inser
receives w f18 words from the sync boot
node.
br

-stream clears byte index bi in sdat buffer.
stream
byte adr of buffer.
/str
byte adr of next 18-bit slot in buff. br

@18 returns the next 18 bits from the stream.
!18
appends 18 bits to the stream. no higher o
rder bits may be present!                     

   114 list
- umbilical sport 3 1 sport !
rsh
ni-n 0 + if for 2/ next ; then drop ;
sdat
align create 24576 rez bi 1629
-stream
0 bi ! ;
stream
-b sdat a-b ;
/str
-b bi @ stream + ; br

@18 -n /str 4@ 3FFFF and
+wd
3 bi +! ;
!18
n 3FFFF or 40 * 12 + /str 4! +wd ; br

snam -a align create //./ 2F2E2F2F , com 6D6F6
3
, 0 ,
!nam
sport @ 10 over - + drop -if 256 * 2560 /
mod +
3000 + then 30 + snam a-b 7 + 4! ; !nam
toser
bn dh @ fwr drop ;
inser
w stream swap 3 * dh @ frd drop ;       


dcb structure controls mode of a com port.
dflg
flags sent every time we control com port
1
binary always, 10 dtr on, 100 rts on.
@dcb
and !dcb read and write com port control.
dflg
is always included in the setting.
/dcb
sets dflg without changing anything else
baud
sets baud rate and character framing.,
,
+ser opens serial; true if good, handle in dh.
-ser
closes the handle.
reset
resets chip. no inversion in rx line.,
set ?reset zero to prevent resetting in talk  

   116 list
- com port management,
dflg 4113 1011 dflg !,
bps 921600 115200 bps !
dcb
n-a align strng here 32 + h !
@dcb
0 dcb dh @ rdcb drop ; 0 0 dcb b-a 8 fill
!dcb
dflg @ 8 dcb 4! 0 dcb dh @ wdcb drop ;
/dcb
@dcb !dcb ;
baud
n @dcb 4 dcb 4! bits 8 18 dcb 1!,
np/1sb 0 19 dcb 2! !dcb ;,
,
+ser -ok snam r/w fopen dh ! if,
bps @ baud 1 ; then 0 ;
-ser
dh @ 0 + if fclose 0 then dh ! ;
ctl!
n dh @ fesc drop ; ?reset 0 1 ?reset !
reset
?reset @ 0 + if lo 4 ctl!,
..
500000 for next hi 3 ctl! then drop ;       


boot frames begin with a 3 word header;,
..
100xx jump to xx when done,
..
ddd mem/port adr to store payload,
..
n transfer length,
..
n words of payload, none if n is 0.
/frame
heads a new given even words of payload
, destination addr, final jump addr.

+frame
appends words to payload.
+ram
appends a string of code from binary prod
uced by
compile for the given node.
!frame
transmits frame given wos or wos!,
,
talk prepares chip for control thru node 19.
send
sends a boot stream after talk.
exch
performs a transaction with target given
addr and length of port stream, stream end act
ion in boot node, and number of words reply.
,
,
ok stream end to simply ack completion; fet pu
mps one word from target;
bstk shepherds stack
dump;
stat pumps ten. exec is next boot frame.

   118 list
- node 708 boot frames
wos
-n 0 ;
/frame
nw xfr jmp -stream 10000 + !18 !18 1 +
2/
words 2* actual -1 + !18 ;
+frame
wn for dup @ !18 1 + next drop ;
+ram
w n node nn-n 2* 8000 + block u+ for dup
@
15555 or !18 1 + next drop ;
!frame
f drop stream bi @ toser ;,
,
exec AE ;
talk
cold -ser +ser if drop reset 40 0 exec /f
rame
0 40 1600 +ram wos !frame good ; then bad
-ser drop
BAD dup abort ;
send
ac for dup @ 15555 or -stream !18,
..
stream 3 toser 1 + next drop ;
exch
w n f n push push dup 2 + -2 and vport @
pop /frame
vport @ 12000 + !18 dup - 1 and dro
p if
vport @ 10000 + !18 then +frame wos !fram
e pop inser -stream ;
,
,
ok 12 ;
fet
15 ;
stat
1B ;
bstk
1D ;                                     


0pth 1pth 2pth are manually set route lists fo
r using the north, south, and west ports of no
de 19. end list is marked by -1
br

customize these paths by replacing entries in
paths
table after loading ide.                

   120 list
- node 708 paths
line
ncd swap push swap indent
  
begin dup , over + -next drop drop ;
count
nc-ncd dup 100 mod 0 + if cr
horz swap drop 1 ; vert then drop 100 / 100 ;
to
nn over negate + -if cr
back negate count negate line ; cr
forw then count line ; br

0pa align create 708 700 to 600 0 to cr
1 17 to 117 717 to 716 708 to -1 ,
1pa
align create 708 , 608 , -1 ,
2pa
align create 708 717 to 617 17 to cr
16 0 to 100 , 101 116 to 216 200 to cr
300 316 to 416 400 to 500 516 to cr
616 600 to 700 708 to -1 ,                    


this code supports boot node controlling one o
f its immediate neighbors directly.
these all
begin with focusing call and each must return!

,
port returns port for 0-3 rdlu ndx, then edges
wall
is index for port between two nodes
'wall
vectors the active wall definition
swall
is standard wall definition,
,
doxxx port execution templates for target.
aa@
fetches from memory or port in target onto
our stack here.

aa!
stores a value from our stack here to port
or memory in target.

ains
executes an arbitrary instruction word wh
ich must end by returning.

acall
executes a target word which must return
or jump to ports.

apsh
pushes a number onto target stack.
astk
queries target stack nondestructively.   

   122 list
- boot target adjacent 'wall 271582744
swall
nn-i over over or 1 and drop if or 2 and
; then
10 100 / swap 10 100 / or 2 and 1 + ;
wall
nn-i 'wall xqt ; ' swall 'wall !
mwall
nn-i 1000 mod swap 1000 mod,
over over or drop if swall ;,
then drop drop up 3 ;
2chip
' mwall nop 'wall ! ;,
,
do! align create @p+a!.@p+ 4AB7 ,,
..
0 , 0 , !;;; B555 ,
do@
align create ...@p+ 2C9B7 ,,
..
0 , a!@!p+; 2BE35 ,
doi
align create 10000 ,
dopu
align create @p+; 5555 , 0 ,
dostk
align create !p+dup-push!p+ CDBE ,,
,
aa@ a-n do@ 1 + ! do@ 3 fet 1 exch @18 ;
aa!
na do! 1 + ! do! 2 + ! do! 4 ok 1 exch ;
acall
a 10000 +
ains
w doi ! doi 1 ok 1 exch ;
apsh
n dopu 1 + ! dopu 2 ok 1 exch ;
astk
dostk 1 bstk 10 exch ;                   


templates and load streams
'pth
current posn in path list of nodes.
nstream
given addr of path tbl, nodes away, gi
ves no of wire nodes and total stream length

?path
returns node number relative to current
posn in selected path.

side
gives adr of 0 near, 1 far side next node
/hdr
starts a stream of given length; if odd,
we leave out jump after waking 1st node.
br

+pump makes port pump thru next node; its ram
load and init postamble must be out of w.

+load
builds a program load from binary given
node ram addr, word count, words to take from
binary, and node number. caller must append an
y words not taken from binary.

+post
follows a node's ram load to set b to ou
t, a to in, and jump to
p.                    

   124 list
- stream components 'pth 67896348
nstream
an-n'w swap 'pth ! -2 + -if 0 pop drop
; then
pre 2 ;
?path
i-n 'pth @ + @ ;
side
n-a 'pth @ + dup @ swap 1 + @ wall port ;
/hdr
w-w dup -2 and 0 side exec /frame pre 0 s
ide
12000 + !18 -1 + dup 1 and drop if 0 side
10000
+ !18 then -1 + ; br

+pump nw-nw -8 + @p+b!@p+@p+ 4B17 !18 cr
1 side dup !18 dup 10000 + !18 12000 + !18 cr
!b!b.@p+ 9BB7 !18 w dup -1 + !18 cr
dup-push-if 24861 !18 @p+!b.unext 5BB4 !18 ;
+load
w n nb nd push push @p+a!.@p+ 4AB7 !18 a
over !18
n -1 + !18 dup-push-if 24861 !18 cr
@p+!+.unxt 58B4 !18 pop pop +ram ;
+post
p @p+b!.@p+ 4BB7 !18 1 side !18 0 side !
18
a!@p+push; 2BDBD !18 p !18 ;               


this block creates and destroys umbilical wiri
ng within the chip.
br

using sets vport between given pair of nodes.
avail
is idle pc val for given node. the initi
al mod is to support multichip ide.
br

+path steps pos to, neg away from target. br

wires builds wire for path table a. entry zero
is boot node.
n is number of nodes away from b
oot in path;
0 no uut, 1 no wire, uut is meigh
bor,
2 neighbor is last guy, 3 n-2 wire nodes
then last guy. generates call at end of last g
uy pgm that last guy sends target for focus.

rips
rips out a wire built by wire
foc
sets 'foc to leave ripped wires focused on
ide boot node;
unfoc restores 'foc to default.

   126 list
- umbilical plumbing 'foc 271580178
using
nn wall port vport ! ;
avail
n-p 1000 mod nn-n idle ; br

+path n'wn-n'w dup 'pth +! negate u+ ; br

unfoc -a 'foc assign 1 ?path avail ; unfoc
foc
-a 'foc assign 0 side ; br

rip nw-nw 0 u+ if post -5 + +pump 1 +path rip
-1
+path then 'foc xqt +post ;
rips
an-n'w nstream over 13 * + 5 + /hdr rip
hose
nw drop drop 0 ?path 1 ?path using wos !f
rame ;
br

wire nw-nw 0 u+ if wire 16 10 + negate + +pump
1
+path wire -1 +path wire 0 16 dup 1602 +load
0
side +post ; then last 0 20 dup -1 +,
1603 +load 1 side 12000 + !18 0 side +post ;
wires
an-n'w nstream over 18 lwire 16 + * + 10
llast
20 + + nop /hdr wire hose ;             


these functions support route setup and select
ion for internal wiring.
br

targets table of target index variables.
paths
table of route lists. br

path selects active path i 0,1,2
node
selects path whose target is node n br

-hook rips out any wiring on path i
hook
hooks up path i to node n ripping out any
old wiring on that path.
br

?adj executes following word and exits defn if
selected path is to adjacent node, otherwise s
kips following word.                          

   128 list
- routing control
targets
-a act @ align tbl 0tg , 1tg , 2tg ,
paths
-a act @ align tbl here 0pa , 1pa , 2pa
,
-cr  'pths 0 + b-a ; br

path i act ! paths dup @ swap 1 + @ wall port
vport
! ;
node
n 3 for i -1 + path paths targets @ + @ o
ver or drop while next drop ; then pop drop dr
op ;
br

-hook i path targets @ 1 or drop if paths targ
ets @ rips
1 targets ! then ;
hook
i n swap -hook 2 begin over over paths +
@ or drop while dup paths + @
0 + drop -if dro
p drop ; then
1 + end then dup targets ! paths
swap wires drop ;
br

?adj pop 1 + dup 4@ swap 4 + targets @ 1 or dr
op if push drop ; then + push ;               


these operations work on any target node. br

dorx port templates for remote target. br

r@ r! rins lit call are the specific names for
the primitives using appropriate sequences for
adjacent or remote target nodes.
br

boot loads code into current remote node from
binary image for node
nd from addr a in both i
mage and ram for
n words.                     

   130 list
- target anywhere
dor!
align create 12005 , 0 , 0 ,
dor@
align create 12000 , 0 ,
dori
align create 1200A , 0 ,
dorp
align create 1200D , 0 ,
dorst
align create 12010 ,
stak
align create 40 rez br

r@ a-n ?adj aa@ dor@ 1 + ! dor@ 2 fet 1 exch @
18 ;

r!
na ?adj aa! dor! 1 + ! dor! 2 + ! dor! 3 ok
1
exch ;
call
a 10000 +
rins
w ?adj ains dori 1 + ! dori 2 ok 1 exch ;
lit'
n ?adj apsh dorp 1 + ! dorp 2 ok 1 exch ;
aupd
astk
@stk
@18 s stak 1 + ! @18 t stak ! stak 2 + 8
for @18 over !
1 + next drop ;
upd
?adj aupd dorst 1 stat 10 exch @stk ;
lit
lit' upd ;
boot
a n nd nn-n swap push 2* 32768 + block ov
er + swap begin over @
15555 or over r! 1 + 1
u+ next drop drop ;                           


single instruction words that may be executed
by the target. these must end with return for
s40 restriction compliance.
br

the following won't work on s40 due to bug 1.
r@p+
C rop ;
psh
n r@p+ value rins ;                       

   132 list
- remote instructions
compile
recompile ; -cr  canon 138 ;
focus
paths targets @ + dup @ swap -1 + @ wall
port call ;

virgin
paths targets @ + @ avail call ; br

rop n A or 13 for 2* next ;s 1555 + rins upd ;
@b
A rop ; -cr  @a B rop ; -cr  @+ 9 rop ;
!b
E rop ; -cr  !a F rop ; -cr  !+ D rop ;
r+*
10 rop ;
r2*
11 rop ; -cr  r2/ 12 rop ;
r-
13 rop ; -cr  r+ 14 rop ;
rand
15 rop ; -cr  ror 16 rop ;
rdrop
17 rop ; -cr  rdup 18 rop ;
rover
1A rop ;
ra!
1F rop ; -cr  ra@ 1B rop ;
rb!
1E rop ; br

up 145 ; -cr  data 141 ; -cr  down 115 ;
left
175 ; -cr  ldata 171 ; -cr  right 1D5 ;
io
15D ;                                      


code for panel
panel
134 list ;
.s
blu silver cr cr stak 6 + 4 for dup @ 5 h.n
space
1 + next -5 + cr 6 for dup @ 5 h.n space
-1
+ next drop ;
?color
nn-nn over over or drop if silver ; the
n green ;

.pth
blu act @ cr 3 for cr i -1 + path act @ ?
color . paths dup
1 + @ . targets @ dup . + @
. next path ;
br

/ram align create 64 a-b rez
rsp
n dup 1 and drop if sp/2 then ;
.ram
blu silver cr /ram 64 for i 7 and ?zero d
rop if cr space then i rsp dup @
5 h.n i 1 and
drop if space then
1 + next drop ;            

   134 list
indicator panel 135 load node stack / upd .s b
r

path, via, hops, tgt - green selected .pth br

mem dump / ?ram or ?rom .ram                  


this test routine tester loads and runs the co
de compiled for node 6 on all other nodes exce
pt the root, stopping if a node crashes or, po
ssibly, other failure criteria are met
br

one runs the test routine from node 6 compilat
ion, entry point
ent , on node n . aborts if w
e cannot write and read back memory.
select de
sired path at start.

all
tries the test starting with node n and go
ing down to node zero, skipping node 19.
br

watch displays live stack from current node. t
his and other interactive functions can be ena
bled in a running program by placing a definit
ion like this in outer loop...

poll
@b 200 and if up b! @b push ;' 15D b! the
n drop ;
br

!dac sets given output value in node i
!dacs
sets given value in all dacs.           

   136 list
- tester
ent
0 ;
n6tst
0 64 6 boot ent call 0 r@ dup 123 + dup
0
r! 0 r@ or if abort then drop 0 r! upd ;
rot
n-n 3FFFF and 2* 40000 /mod + ;
sto
n dup 63 for rot dup i r! -next drop cr
63 for rot i r@ over over or indent
  
drop if i abort then drop -next drop ;
pat
n 18 for dup sto rot next drop ;
ramtst
0 sto 3FFFF sto 1 pat 3FFFE pat ;
one
n 2 swap hook pause n6tst ramtst ;
?ok
n-t 2pa @ nn-n or ;
all
n nn-n 1 + for i -1 + ?ok drop if i -1 + n
-nn one then next ;

!dac
n i 2 swap hook 155 or io r! ;
!dacs
n dup 709 !dac dup 713 !dac dup 717 !dac
dup
617 !dac 117 !dac ;
nn
n-n -1 + dup !dacs ;
ms
100000 * for next ;
watch
begin upd pause 1000 ms key? end ;
?ram
0 -cr  suck a ra@ /ram 64 for over r@ ove
r !
1 + 1 u+ next drop drop ra! ;
?rom
80 suck ;                                


the final step in loading the ide is to redefi
ne the canonical forth words to operate on the
target node. this is done as a separate step s
o that you may define any sort of exerciser be
fore losing access to host colorforth words.  

   138 list
- canonical words
-canon
remember
@
a-n r@ ;
!
na r! ; call lit upd rins boot !b already ok
+*
r+* ;
2*
r2* ;
2/
r2/ ;
-
r- ;
+
r+ ;
and
rand ;
or
ror ;
drop
rdrop ;
dup
rdup ;
over
rover ;
a!
ra! ;
a
ra@ ;
b!
rb! ;                                      


this block interchanges ats commands with any
node adjacent to the ide boot node.
br

pfocus must be used after booting package into
an adjacent node and before using the followin
g words. focuses that node properly on the boo
t node with both
p and b - note! after pfocus
regular ide functions may not be done against
nodes in this path until
rip has restored them
to
warm state. br

tfocus performs ats focus function to select p
ort thru which test and creep operate. use ide
port names.

test
executes test w/ arg giving positive ans.
creep
creeps into focused node, making it acti
ve and changing current active to wire.

rip
tears out ats connection to active node re
turning it and all wire nodes to warm states.

cr
zfocus used by hand in ide to effectively tfoc
us the ide node under test on a given tgt node

works whether or not r! preserves a           

   140 list
- ide ats support
zxch
w n f n push push dup 2 + -2 and vport @
pop /frame
vport @ 12000 + !18 dup - 1 and dro
p if vport @
10000 + !18 then +frame wos !fram
e pop inser -stream ;
br

dox align create @p call 56A9 , arg 0 ,
xchg
cmd arg - result dox 1 + ! dox ! dox 2 fe
t
1 exch zxch @18 ; br

pfocus paths targets @ + dup @ swap -1 + @ wal
l port dup call lit rb! ;

vtest
arg.ent-ans 5600 or swap xchg ;
test
arg-ans 4 vtest ;
tfocus
port 5636 swap 10000 + xchg drop ;
creep
563A 67 xchg drop ;
rip
5602 20000 xchg drop ; br

zfocus node paths targets @ + @ wall port cr
10000 or dup dup r! 5636 over r! dup dup r! cr
lit' ra! ;                                    


manage running a test in all nodes
fwall
returns rdlu for feeding node
fport
returns port from feeding node.
fbit
returns io mask bit for feed node write.
nodes
returns number of nodes in current path.
!one
programs and starts the node whose index
is given in 1..nodes

!all
programs all nodes in the current path.  

   142 list
- all-nodes tester
fwall
-n paths targets @ + dup @ swap -1 + @ w
all ;

fport
-a fwall port ;
fbit
-n fwall align tbl cr
r 8000 , d 2000 , l 800 , u 200 ,
nodes
-n 0 begin 1 + cr
dup paths + 1 + @ 0 + drop -until paths @ cr
over paths + @ or drop if ; then -1 + ;
!one
i 2 path 2 swap paths + @ hook cr
0 64 1604 boot fbit 2 r! 6 14 call ;
!all
2 path nodes 40 for pause i !one next ;
?one
i-f 2 path 2 swap paths + @ hook pause cr
3E r@ 1E100 8D00 or 3F r@ 17D 430E or +or drop
if upd ?ram
0 dup or drop ; then 1 dup and dro
p ;

?all
2 path 0 nodes 40 for 1 + pause dup ?one
while next drop ; then pop drop ;

zz
for i next ;
z
1 ?one upd ;                                


main load block for okad2 applications
testb
nonzero to enable testbeds.
dh
holds drive handle we are responsible for.
first
execution of hardsim or softsim. initial
izes variables in either.

recompile
compiles f18 code then reloads tool
that depends on it like ide from load block in

orgn.

compile
compiles relevant f18 code. br

-nat exits a block if running on native system
tbl
self fetching cell array. usage...
squared
i-n align tbl 0 , 1 , 4 , 9 , 16 ,
xqt
calls the code whose adr is in the var giv
en.

assign
places addr of following code in the lo
cation given and exits current definition.
br

ray defines i-a array usage align ray
aray
use after red to make ray of n cells     

   144 list
arrayforth tm and okad tools and designs,
copyright 2009-2012 greenarrays, inc.,
cuco 5 testb 0 dh 0 0 dh !,
first -1 -1 first ! orgn 0 0 orgn !
compile
146 load ;
recompile
compile orgn @ load lis ;
softsim
*so 148 load ;,
,
-nat winver drop if ; then exit ;
tbl
i-n pop 2/ 2/ + @ ;
xqt
a @ push ;*assign a pop swap ! ;
ray
i-a pop 2/ 2/ + ;
aray
n align call ray 4 * h +! ;,
,
ascii file names 74 load,
png screen capture 168 load,
qx 80 load stack 94 load
-tape
1 1 and ; for redacted systems,
,
chip design 190 194 thru mark empty,
okad resident 660 load mark empty             


compiles all relevant f18 code. br

laid is cleared for setting as nodes laid out
resets
is set to default multiport executes fo
r all nodes and may be overridden in source co
de using
reset
kinds
is set to default testbed none and may b
e overridden with
kind to 0-none 1-async 2-syn
c 3-1wire 4-spi 5-strap 6-serdes 7-servers

node
starts random compilation for node nn by
compiling node
nn's rom
bin
saves the binary just generated in the bin
for node
nn, which must be outside chip 0 0 .
program
compile code for multicomputers. alway
s compiles standard rom; if not tapeout, the l
oad block at
1300 defines test environment whi
ch may be in rom, ram, or both.

reclaim
remembers and restores dictionary     

   146 list
f18 compiler empty c cr
0 0 laid nns fill 0 0 kinds nns fill br

1400 load br

reset a ?rst com @ resets ! ;
kind
n com @ kinds ! ;
node
nn nn-n nns mod dup com ! 0 -org cr
node's 64 eras n-nn @rom load ;
bin
nn 0 memory swap nn-n com ! 0 memory 64 mo
ve ;
br

program nns -1 + for i com ! cr
i idle reset i n-nn @rom load -next cr
special rom's 1304 load cr
-tape drop if 150 load then ; br

1402 1412 thru target 1380 load host
h'
' ; -cr  ' h' 6 + 4@ ;
reclaim
remember target program empty         


comment demo bootstream if you are going to be
generating your own for simulation.           

   148 list
f18 software simulator empty compile,
demo bootstream 1242 load empty,
prelude 1250 load boot descriptors 1236 load,
engine 1252 1266 thru opcodes 1268 1274 thru,
boot loader 1238 load,
view 1276 1286 thru 1248 load 1288 1290 thru,
preserve variables nmem 0 n2mem 0
nm2m
nod2 @ !node n2mem @ mem !,
...
nod @ !node nmem @ mem ! ; big 2
puka
nn-a nn-n 2* 8000 + block ;
code
nn nn puka push puka pop 64 move ;,
kbd 1292 1294 thru,
ports/pins 1296 1298 thru,
interactive 1240 load,
,
/softsim 0 time ! power,
first @ 1 + if drop nm2m ; then 0 first !,
100 big ! 1 gap ! -1 wind? !,
100 !node 0 mem ! 100 other,
0 !node 0 mem ! 0 node 0 xo ! 0 yo ! !vis ;,
,
init and testbeds 216 load,
start /softsim ok h                           


this block defines what compile does. cr
the system code loaded at the start is used by
common development tools and should generally
be left alone. it goes into bins 1600..2317 as
follow
br

1600 ide code code; spi r/w/boot,
1700 polyforth,
1800 ---; temp sram for eforth.,
1900 ats/ide; ---,
2000 creeper modules 1 full,
2100 creeper modules 2 full,
2200 creeper modules 3 half,
2300 creeper modules 4 reserved,
,
note that special rom leaves residue in 008 an
d 106.                                        

   150 list
test code for chip reclaim br

ide parts 1372 1380 thru reclaim cr
all nodes 1350 load reclaim br

ats tests 480 load reclaim br

polyforth 360 load reclaim cr
eforth 1080 load reclaim br

bridge 644 load reclaim br

applic code 200 load br

                                              


load this block to redact an okad disk for pub
lic release or extensive programming.
br

additional housekeeping... cr
144 comment loading of okad application. cr
18 uncomment loading of application tools. cr
196ff merge in released pd software.          

   152 list
redact okad disk audit load br

to arm this block, make cr
this word white... exit br

okad 196 1300 obliterate br

type save to commit changes                   


colorforth to/from ascii w/gds specifics br

cf-ii otr inae ycms wfgl bpvd quxh indent
  
3210 7654 -j98 /z.k +!'; ?,*@
ii-cf
! +* /.-, 3zjk 7654 ;'98 ? indent
  
cba@ gfed 02ih onml srqp wvut indent
  
1yx cba@ gfed 02ih onml srqp wvut 1yx
notice
j and z transposed in cf-ii; - converts
to underscore, + to dollar.                   

   154 list
c-a-c - ascii for gds only! macro
1@
8A 2, ; forth
string
pop ;
cf-ii
string 6F747200 , 696E6165 , 79636D73 ,
7766676C
, 62707664 , 71757868 , 336a7a6b 3332
3130
, 37363534 , 2d313938 - 2d7a3938 5F7A3938
,
2f322e30 2F6A2E6B , 2b213a3b 24213A3B , 3F2C
2A40
,
ch
FFFFFFF0 and unpack cf-ii + 1@ FF and ;
ii-cf
string 2A00 , 0 + 2B , 2B2D0000 , 272523
2E
, zjk 1b262224 1B1A1918 , 1F1E1D1C , 282921
20
, 2F000000 , 3A43355C , 3D3E3440 , 02 484a3
744 kj
54523744 , 3336393C , 38314742 , 3F4146
32
, 1 493b45 z 563B45 , - 23000000 , A13052C
,
D0E0410 , 02 181a0714 kj 24220714 , 306090C
,
8011712 , F111602 , 1 190b15 z 260B15 ,
chc
FFFFFFE0 + ii-cf + 1@ FF and ;            


                                              

   156 list
big letters macro
*byte
C80F 2, ; forth
clr
aper 2 + ; sz 14 cur 6217744 14 sz !
ptab
xy 1024 * + aper @ 4 / + cur ! ;
center
n sz @ -24 * 768 + 2/ ptab ;
table
12 * 12 block + ;
1line
a sz @ for clr @ over ! 1 + next drop ;
pix
a sz @ for dup 1line 1024 + next drop ;
row
an-an 16 for dup and -if over pix then sz
@ u+ 2* next
1024 sz @ * sz @ -16 * + u+ ;
!emit
table cur @ 12 for over @ *byte row row
drop
1 u+ next drop drop sz @ 18 * cur +! ;
!digit
24 + !emit ;
2.
nn /mod !digit !digit ;
4.
n 100 /mod 10 2. 10 2. ;                   


                                              

   158 list
big clock empty 40 load 156 load
hm
sec 60 /
sex
n 60 /mod 100 mod 10 2. 10 2. ; t0 32458
?beep
if ; then beep ;
till
t0 @ sec negate + green -if negate red th
en ?beep sex ;

set
n 60 * sec + t0 !
ok
show black screen blue 0 center hm till ;
run
dup pause drop key? run ; ok run          


check reads backup to 3000 and decompresses if
appropriate

blink
displays the given block with its other
set as the editor's 'other' block

var
compares a variable name, advancing pointe
rs to skip its value.

*1
compares garden variety words.
*2
compares large literals.
tag
compare compares the two source cells give
n, returning true if they differ. ignores vari
able differences.

?nul
ends the loop in co when nuls are found i
n both blocks.

co
given the addresses of the two blocks does
the work of com.

com
invokes editor to blink the given block if
it differs from the other, leaving stack set t
o continue the scan by typing q. otherwise ret
urns.

all
scans the whole usable area of the disk.
q
scans for differences given starting block a
nd number of source blocks skipping shadows.

note!
return stk probably grows!              

   160 list
compare empty 30 load
n18
i-a abuf 18 + block + ;
unpk
abs 1 n18 ! abuf 36 + block cbuf block 14
04
blks move cbuf block abuf 36 + 3 n18 @ -36
+ range ;

check
abuf @back 0 n18 @ 18 block @ or drop if
; then
1 n18 @ dup and -if unpk ; then drop ;
blink
dup abuf + blk ! edit ;
var
push push 1 + 1 u+ pop pop
*1
or ;
*2
var push over @ over @ or pop + ;
tag
nn-n dup F and jump *1 *1 *2 *1 *1 *2 *1 *
1 *1 *1 *1 *1 var *1 *1 *1

co
naa-n 256 for over @ over @ tag drop if dro
p drop pop drop pop drop dup
2 u+ i pop swap b
link ; then
1 + 1 u+ next drop drop ;
com
n dup block over abuf + block co ;
q
nn for com 2 + next drop ;
all
18 1439 -18 + 2/ q ;
old
blk @ abuf mod dup abuf + blk ! copy ;    


                                              

   162 list
                                              


                                              

   164 list
                                              


                                              

   166 list
                                              


d is reduction factor                         

   168 list
png empty -nat w 1024 hh 768 d 1
frame
1D0000 aper @ 4 / ; 172 load 174 load
-crc
a here over negate + crc .. ;
here/4
-a here 3 and drop if 0 1, here/4 ; the
n here
2 2/s ;
bys
nn-b .. here swap , ; cr
pallettes 170 load br

!png awh-an d @ / hh ! d @ / w ! here/4 swap 4
74E5089
, A1A0A0D , ihdr 52444849 13 bys w @ .
.
hh @ .. 304 , 0 1, -crc plte pallette idat 5
4414449
0 bys swap deflate -crc iend 444E4549
0
bys -crc here/4 over negate + ; br

'at xy-a 1024 * + frame + ;
full
1 d ! 0 dup 'at 1024 768 !png ;
png
full wgds ;                               


                                              

   170 list
- pallettes
paper
45544C50 48 bys cr
FFFFFF 3, C00000 3, C000 3, C0C000 3, cr
C0 3, C000C0 3, C0C0 3, 404040 3, cr
C0C0C0 3, FF0000 3, FF00 3, FFFF00 3, cr
FF 3, FF00FF 3, FFFF 3, 0 3, -crc ; br

crt 45544C50 48 bys cr
0 3, C00000 3, C000 3, C0C000 3, cr
C0 3, C000C0 3, C0C0 3, 404040 3, cr
C0C0C0 3, FF0000 3, FF00 3, FFFF00 3, cr
FF 3, FF00FF 3, FFFF 3, FFFFFF 3, -crc ; br

pallette paper crt ;                          


2/s shift right by literal
1@
fetch byte, address in eax
array
return word address in dictionary
bit
process 1 bit with standard 32-bit crc
fill
construct crc table for bytes
table
said table
crc
compute crc for a byte string
ad1/ad2
adler checksums
+adl
add a byte to both checksums
adl!
store checksums
+mod
truncate checksums                       

   172 list
- crc ad1 14840 ad2 50699 macro br

2/s ?lit E8C1 2, 1, ; -cr  1@ 8A 2, ; forth
bit
n-n 1 ? if 1 2/s EDB88320 or ; indent
  
then 1 2/s ;
,crc
nn for dup 8 for bit next , indent
  
1 + next drop ;
table
-a align array 0 256 ,crc
crc
bn-n -1 swap for over 1@ over or FF and ta
ble swap
8 2/s or 1 u+ next - nip ; br

+adl n FF and ad1 @ + dup ad2 @ +
adl!
ad2 ! ad1 ! ;
+mod
ad1 @ 65521 mod ad2 @ 65521 mod adl! ;   


0/1 0, f or 7 for dark, bright or dim         

   174 list
- lz77 macro -cr  *byte C486 2, ;
!bx
a! 289 2, drop ; forth br

*bys dup 16 2/s *byte swap FFFF and *byte 1000
0
* + ; -cr  .. *bys , ;
0/1
80 ? if 7E and 7E or drop if 7 ; then F ;
then
0 and ;
4b
dup 0/1 9 and over 8 2/s 0/1 A and +or swap
16
2/s 0/1 C and +or ;
pix
dup @ d @ 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 * + ; br

deflate 178 2, 1 0 adl! hh @ -1 + for 0 row ne
xt
1 row drop ad2 @ *byte 2, ad1 @ *byte 2, he
re over
4 + negate + *bys over -4 + !bx ;     


colorforth to html utility br

the html is created between pad and hld cr
by .html and its factors .hdr .blks and .tlr ,
then written to the file last
named . br

uncomment estyle in .hdr to use an external cr
stylesheet, maybe for printing. br

pairs of blocks are formatted 2-up using html
tables, with the odd/even blocks used to invok
e
.html or .blks displayed on the right. 'n li
st' is shown above the even block.
br

176 188 .html puts shadows on left, while cr
177 189 .html puts them on the right. br

seeb toggles blue-word visibility. br

the last line of each block is filled cr
with nbsp for column alignment. the class @ cr
line closes the code tag of an empty block.   

   176 list
cf-html empty -nat cr
pad 278806528 abuf block 4 * pad ! cr
hld 279086155 pad @ hld ! 178 188 thru
estyle
,link ,t1cr cfhtml.css '? ;
.hdr
pad @ hld ! ,t1cr @html? @head? istyle cr
estyle ,t1cr @/head? @body? @table? ;
.blk
n 0 pos ! crlf ,t1 @td*class+cf? cr
dup even? if dup .dec ,t1cr *list then cr
.cr block ,t1 @code 0 class ! 0 --cr ! cr
begin @+ dup and while .token end then cr
class @ eq? if ,t1 ? then drop drop cr
begin -eol? while .nb end then .cr cr
,t1 @/code? .cr ,t1cr @/td? ;
.sep
,t1 @td? .nb .nb ,t1 @/td? ;
.blks
first last+2 over negate + 2/ for cr
,t1 @tr? dup 1 or .blk .sep dup .blk cr
,t1cr @/tr? 2 + next drop ;
.tlr
,t1cr @/table? @/body? @/html? sav ;
run
first last+2 .hdr .blks .tlr ; br

named cf.html exit 18 1440 run                


eq? -cr  nz? -cr  diff? -cr  even? leave only
flags
cr
@+ -cr  @tag are common factors br

the following words generate ascii text only f
or html tags and source formatting; it will no
t be visible in the html display.
br

sc -cr  ch, -cr  lb -cr  rb -cr  crlf punctuat
ion output
br

the macros enable in-line output from the cr
standard cf-ascii table using set0 default or
the extended table using
set1 br

,token output ascii characters for one token
,word
output a token and any extension tokens
,comments
output contiguous comment words br

,t output from current set, don't change set.
,trb
,t output followed by rb
,t1
output from set1 , return to set0 at end
,t1cr
,t1 output followed by crlf             

   178 list
- generate html details cr
eq? nn-n over or if drop -1 then - nz? ;
nz?
n dup and drop ;
even?
n 1 or 1 and drop ; br

@+ a-an dup 1 + swap @ ;
@tag
a-at dup @ F and ; br

sc 3B semicolon
ch,
c hld @ 1! 1 hld +! ;
lb
7B left-brace ch, ;
rb
sc 7D right-brace ch,
crlf
13 ch, 10 ch, ; br

,token n ch if ch, ,token ; then drop drop ;
,word
a-a begin @+ ,token @tag drop until ; cr
loop begin ,word
,comments
a @tag 9 or drop until drop ; macro
cr
,t words 7push pop ,lit call ,comments nop ;
,trb
words ,t call rb nop ;
,t1
words call set1 ,t call set0 nop ;
,t1cr
words ,t1 call crlf nop forth           


pos 0 character display pos ition in line
-bol?
-cr  -eol? test position
.cr
visible crlf
emit
visible character
.ch
-cr  .sp -cr  .2sp -cr  .nb quirky charact
eristics
cr
note .sp does nothing at left margin cr
note .ch does .cr after 46th character cr
note .2sp takes only one space at left margin
cr
note .nb takes only one character position. br

.tn -cr  .sp.tn display a token. br

.hd -cr  hd -cr  spit are number-output factor
s

.dec
-cr  .hex -cr  .ad/s display numbers     

   180 list
- translate text and numbers pos 32 --bs 1
-bol?
pos @ nz? ;*-eol? pos @ 46 or drop ;
.cr
,t1 @br? 0 pos ! ;,
loop begin .cr*emit c ch, 1 pos +! ;
.ch
c -eol? until emit ;
.sp
-eol? if -bol? if 20 emit ; then then ;
.2sp
.sp*.nb 26 ampersand .ch ,t nbsp sc ;
?sp
--bs @ nz? if .sp then 1 --bs ! ;
-sp
0 --bs ! ;
.sp.tn
n ?sp .tn ;
.tn
n ch if .ch .tn ; then drop drop ;
?ch
n ?seeb if .ch ; then drop .nb ;
?sp.tn
n ?sp ?tn ;
?tn
n ch if ?ch ?tn ; then drop drop ;
.hd
n -10 + -if 3A + .ch ; then 41 + .ch ;
.dec
n .sp ?sp 0 + -if 2D .ch negate then -1 s
wap begin
10 /mod dup and while end then drop
spit
-1 ... begin .hd 0 + -until drop ;
hd
n-nn dup F and swap 2/ 2/ 2/ 2/ ;
.hex
n .sp ?sp -1 swap begin hd FFFFFFF and,
while end then drop spit ;
.ad/s
n 1024 /mod swap hd hd hd drop ?sp,
dup and if dup .hd then drop .hd .hd,
0 + if 47 .ch dup .hd then drop ;             


class 0 current class cr
--cr 0 true suppresses cr before next red word
cr
,class -cr  ,c class defining words, cf style
br

.quirks handle the spacing before red words br

.space blue spaces are ignored at eol!
.indent
4 + html leading space br

.blue generate most of the blue-word effects  

   182 list
- translate cf token details cr
class -1054867447 --cr 0
,class
a @ class @ over or drop diff? if cr
class @ nz? if ,t1 @/code? @code then cr
,t1 *class+ dup class ! ,token ,t1 ? ; cr
then drop ; macro
,c
7push pop ,lit call ,class nop ; forth
.quirks
n --bs @ -1 + nz? if 1 --bs ! drop ;,
...
then --cr @ nz? if .2sp drop 0 --cr ! ;,
...
then class nz? if -bol? if .cr then then ;
.space
-eol? if .nb then ;
.indent
.cr 4 2 for .nb next ;
.blue
n ?seeb if dup .sp.tn then,
9080000E cr eq? if .cr drop ;,
then E721000E -cr eq? if 1 --cr ! drop ;,
then 8625920E space eq? if .space drop ;,
then 76C08C4E indent eq? if .indent drop ;,
then C620000E br eq? if .cr .cr then drop ;
?simple
n-n,
...
FC00000E eq? if ?tn .cr pop drop ; then,
...
FA00000E eq? if ?tn -sp pop drop ; then,
...
EA00000E eq? if ?sp.tn -sp pop drop ; then
...
EBD4000E eq? if ?sp.tn -sp pop drop ; then
...
EBD7A80E eq? if ?sp.tn -sp pop drop ; then
;                                             


sh? extract short number, true flag if hex
lh?
extract long number, true flag if hex br

tag ------- cf class ------- html class cr
.t0 extension token ........ same as last
.t1
execute word ........... t1
.t2
execute long number .... h2, d2
.t3
define word ........... -cr  t3
.t4
compile word ........... t4
.t5
compile long number .... h5, d5
.t6
compile short number ... h6, d6
.t7
compile macro .......... t7
.t8
execute short number ... h8, d8
.t9
lowercase text comment . t9
.ta
capitalized text comment ta deprecated
.tb
uppercase text comment . tb deprecated
.tc
variable ............... tc 0 dc
.td
target address ......... hd
.te
editor command ......... te
.tf
short number comment ... hf, df br

.token translate tag-by-tag indent
  
note address may be incremented            

   184 list
- translate cf tokens
sh?
n-n 2/ 2/ 2/ 2/ dup 2/ swap 1 and drop ;
lh?
an-an push @+ pop 10 and drop ; br

.t1 n ,c t1 .sp.tn ;
.t2
an-a lh? if ,c h2 .hex ; then ,c d2 .dec ;
.t3
n class @ ,c t3 .quirks .sp.tn .tn ;
.t4
n ,c t4 .sp.tn ;
.t5
an-a lh? if ,c h5 .hex ; then ,c d5 .dec ;
.t6
n sh? if ,c h6 .hex ; then ,c d6 .dec ;
.t7
n ,c t7 .sp.tn ;
.t8
n sh? if ,c h8 .hex ; then ,c d8 .dec ;
.t9
n ,c t9 .sp.tn ;
.ta
n ,c ta .sp.tn ;
.tb
n ,c tb .sp.tn ;
.tc
an-a ,c tc .sp.tn ,c dc @+ .dec ;
.td
n sh? ,c hd .ad/s ;
.te
n ,c te ?simple .blue ;
.tf
n sh? if ,c hf .hex ; then ,c df .dec ; br

.token an-a dup F and jump cr
.tn .t1 .t2 .t3 .t4 .t5 .t6 .t7 cr
.t8 .t9 .ta .tb .tc .td .te .tf               


vat -cr  bcw -cr  wsn -cr  fo -cr  ffm -cr  fw
b
-cr  fz -cr  fc -cr  fsi -cr  tt cr
space-saving factors of internal stylesheet br

,link most of the external stylesheet link br

fopen -cr  sav open, write, close html file cr
note byte addresses throughout                

   186 list
- stylesheet details and file output
vat
,t *vertical-align; top sc ;
bcw
crlf ,t *background-color; white sc ;
wsn
crlf ,t *white-space; nowrap sc ;
fo
,t *font- ;
ffm
crlf fo indent
  
,t family; lucida*console,monospace sc ;
fwb
crlf fo ,t weight; bold sc ;
fz
fo ,t size; ;
fc
lb ,t *color; 23 sharp ch, ;
fsi
sc fo ,t style; italic rb ;
tt
sc ,t *text-transform; ; br

,link ,t1 @link *rel+stylesheet indent
  
,t1 *type+'text/css' *href+' ; br

fopen af-h push push 0 32 exist 2 0 0 indent
  
pop pop swap fcreate ;
sav
0 fnam w/o fopen dup push indent
  
pad @ dup negate hld @ + pop indent
  
fwr drop fclose ;                          


istyle internal styles are aimed toward cr
providing code examples for stand-alone use in
other documents. although it's black-on-white,
it faithfully displays the colorforth screen.

br

some cf-html rendering tests br

load 2147483647 80000000
t1
; 2147483646 80000001 87 57 ?lit 87 57 rtoe
ani rtos ascii
var 123 cr
-cr
 quirky 05 indent
  
87 57 -87 end 0 0 0                        

   188 list
- internal stylesheet
istyle
,t1cr @style*type+'text/css'? set1 cr
,t td lb vat bcw wsn ffm fwb fz ,trb x-large ,
t
code lb fz ,t large tt ,trb lowercase cr
,t .t1 fc ,trb ddaa00 cr
,t .h2 fc ,t aa7700 fsi cr
,t .d2 fc ,trb ddaa00 cr
,t .t3 fc ,trb ff0000 cr
,t .t4 fc ,trb 00cc00 cr
,t .h5 fc ,t 009900 fsi cr
,t .d5 fc ,trb 00cc00 cr
,t .h6 fc ,t 009900 fsi cr
,t .d6 fc ,trb 00cc00 cr
,t .t7 fc ,trb 00cccc cr
,t .h8 fc ,t aa7700 fsi cr
,t .d8 fc ,trb ddaa00 cr
,t .t9 fc ,trb 444444 cr
,t .ta fc ,t 000000 tt ,trb capitalize cr
,t .tb fc ,t 000000 tt ,trb uppercase cr
,t .tc fc ,trb ff00ff cr
,t .dc fc ,trb 00ff00 cr
,t .hd fc ,t bbbbbb fsi cr
,t .te fc ,trb 0000ff cr
,t .hf fc ,t 777777 fsi cr
,t .df fc ,trb 444444 ,t1cr @/style? ;        


gdsnos block for gds layer numbers
nnx
and nny number of nodes/row and /column
nnc
number of nodes compiled
nn-n
and n-nn convert yx notation to and from
linear node nos. 1xxxx denotes second chip.

gapl,
r, b, t distance in tiles between inner
edge of padring bus and outer edge of core pwr

ray0
and rayn are gxy relative phys origin and
upper right corner of node array. source of co
nstants is
xtab and ytab.
gx
and gy bounds of pad ring. always remember
to check
global reset wiring when size or plac
ement of node array or pad ring are changed!

cx
and cy bounds of seal ring.
-cx
negative tiles/row
origin
origin of 'die' i.e. pad ring within se
al ring. c coords rel to seal; g rel to 'die'

gfx
and gfy fill cell grid                    

   190 list
chip configuration g144a12
gdsnos
440 ;
nnx
8 18 ;*nny 4 8 ;*nns nnx nny * ;
nnc
nns nns 2 * 144 + ;
nn-n
cyyxx-n 10000 /mod nns *,
....
swap 100 /mod nnx * + + ;
n-nn
n-yyxx nnx /mod 100 * + ;,
,
gapl 2 strap 5 + pwr 0 + chans 20 2 * + ;
gapr
2 strap 5 + pwr 0 + chans 24 2 * + ;
gapb
2 strap 5 + pwr 0 + chans 28 2 * + ;
gapt
2 strap 5 + pwr 0 + chans 18 2 * + ;
ray0
-xy gapl 199 + gapb 199 + ;
rayn
-xy nnx 350 * nny 759 * -1 + ray0 v+ ;,
gx rayn drop gapr + 199 + ;
gy
rayn nip gapt + 199 + ;,
,
,
origin 164 89 26 26 ;
cx
origin drop 2 * gx + 2 + ;
cy
origin nip 2 * gy + 2 + ;
-cx
cx negate ;*cx*y cx cy * ;,
,
gfx 8 ;*gfy 16 ;                              


port returns port for 0-3 rdlu then edges
idle
is idle p value for given node.
rstadr
and rstdef number values and white name
s of p straps rom, corn, side, top/bot, mid.

?rst
returns index of valid reset or aborts.  

   192 list
- pads, ports and resets,
,
port i-pa align tbl 1D5 , 115 , 175 , 145 , 19
5
, 185 , 1B5 , 1A5 ,
idle
n-p nnx /mod nny -1 + mod 1 min 4 + swap
nnx
-1 + mod 1 min 2* + port ;
rstadr
align tbl AA , 195 , 185 , 1B5 , 1A5 ,
rstdef
strings p0aa p13f p12f p11f p10f
?rst
pa-i 4 for dup i rstadr or while drop -ne
xt abort then drop drop pop ;                 


laid nz if node laid out
resets
index of reset address
kinds
kind for testbeds
+roms
and @rom are here only as temporary klud
ges. we will eventually load a table from the
node defns for default kind and prom source.

+roms
array indexed by linear node number cont
aining code number for rom load block.

iz
sets node nn to use rom load block n codes-
0-arith 2-serdes 4-syncboot 6-async 10-spi 14-
analog 18-1wire

@rom
returns block number for production rom c
ode applicable to the given node.

?serbed
0-none 1-async 2-sync 3-1wire 4-spi 5-
strap 6-serdes 7-servers for
cuco if testb nz.

   194 list
- node types,
,
laid nns aray*resets nnc aray
kinds
nnc aray,
,
0's n for 0 , next ;
+roms
i-a align ray nns 0's
iz
nn i swap nn-n +roms ! ;,
701 2 iz 705 10 iz 708 6 iz,
...
709 14 iz 713 14 iz 717 14 iz,
117 14 iz 617 14 iz,
1 2 iz 200 18 iz 300 4 iz,
eforth 105 20 iz 106 20 iz sdram...,
7 20 iz 8 20 iz 9 20 iz 107 20 iz 108 20 iz
@rom
nn-n nn-n nns mod +roms @ 22 less if drop
1418
+ ; then drop 100 mod 1301 + ;,
,
bedtab -serbed cuco @ nn-n kinds @ ;
?serbed
testb @ 0 or drop if bedtab ; then 0 ;


                                              

   196 list
                                              


                                              

   198 list
                                              


use this load block to compile your code cr
for the f18 computers. br

as delivered, sample code loaded here is pro-
vided to facilitate working with examples
cr
presented in the user's guide. it may be cr
deleted if you no longer have use for it.     

   200 list
user f18 code reclaim br

softsim example reclaim 0 node 1342 load cr
practical example pwm code reclaim 842 load br

sha256 reclaim 900 5 loads,
greg n1 object 950 load                       


these definitions are used in released code or
documented procedures and shouldn't be changed
or overloaded casually.
br

a-com and c-com are com port numbers for eval
board usb ports a and c.

a-bps
and c-bps are baud rates to which ide cr
sets these usb ports.
host
and target load block numbers for serial
ide configured to work with eval board host or
target chips using default usb ports.

bridge
loaded to extend ide for 2 chips. br

definitions for getting started app note
selftest
runs ats selftest on either chip via
the ide com port number given.

autotest
given host ide com port number, runs
ate tests of target chip using sync boot. then
tests
serdes between the chips.               

   202 list
ga application tools
a-com
3 6 ;*a-bps 921600 480000 ;
c-com
5 8 ;*c-bps 921600 ;
host
206 ;*target 208 ;*bridge 218 ;,
modules*sram 264 ;*pf 360 ;*ether 720 ;,
utils*streamer 282 ;*loader 210 ;,
,
selftest port 708 load ; stp 3
autotest
port 712 load ;                      


this is the place to compile definitions that
you wish to be available after
empty. be sure
to test compile separately before placing them
here or you may cause
18 load to abort.       

   204 list
- user application tools                      


this load block compiles and configures the cr
ide for the host chip on the eval board. it's
also an example of configuring and customizing
the ide without hacking it and breaking other
uses of the ide.
br

this block starts by loading the serial ide in
its standard form.
-canon forgets the mapping
of canonical words like
@ and dup onto the f18
so that we may interact with x86 code and ram.

cr
we then set orgn so that the ide compile will
reload this block, and we set
sport to the usb
port a for normal ide operations on host chip.

!nam
updates pathname for that com port. br

dac is defined to illustrate extending the ide
cr
canon load restores mapping of canonical words
onto the f18. comment this if you wish to use
the 'r-words' for all f18 operations.         

   206 list
evb001 host chip ide empty compile br

serial load cr
customize -canon 0 fh orgn ! cr
a-com sport ! a-bps bps ! !nam br

dac n 155 and io r! ; br

canon load                                    


this load block compiles and configures the cr
ide for the eval board's target chip. it's cr
also an example of configuring and customizing
the ide without hacking it and breaking other
uses of the ide.
br

this block starts by loading the serial ide in
its standard form.
-canon forgets the mapping
of canonical words like
@ and dup onto the f18
so that we may interact with x86 code and ram.

cr
we then set orgn so that the ide compile will
reload this block, and we set
sport to the usb
port c for normal ide ops on target chip.
cr
!nam updates pathname for that com port. br

dac is defined to illustrate extending the ide
cr
canon load restores mapping of canonical words
onto the f18. comment this if you wish to use
the 'r-words' for all f18 operations.         

   208 list
evb001 target chip ide empty compile br

serial load cr
customize -canon 0 fh orgn ! cr
c-com sport ! c-bps bps ! !nam br

dac n 155 and io r! ; br

canon load                                    


ide scripting,
,
body recursively visit and initialize,
each node in the path,
,
ship use given path and set foc mode,
visit each node in the path then cleanup,
by convention path 2 in the ide reaches all,
nodes and is suitable for use by most apps.,
,
usage is simple.,
1. host or target load loader load,
2. describe the application using +node et al.
3.
ship                                       

   210 list
ide based loader pth 2 root 708 talk,
tables and routing 2 fh 2 loads,
,
body follower 0 + drop -if,
...
root @ active or drop if deliver ; then ;,
...
then 1 +route body -1 +route deliver ;,
,
ship n dup pth ! route active root !,
...
1 +route foc body unfoc pth @ -hook ;      


- configuration tables
tabl
,
,
jsr call from block 88 has been clobbered,
so replace it with jsr instead
table
build and initialize a table,
tables hold configuration information
/a
a specifies a value for current node;
/b
a specifies b value
/io
n specifies initial io value
/p
a specifies entry point
+node
n makes n the current node
/part
acb specifies address count and bin,
for code to be loaded into current node later
/ram
b specifies just the bin, load all 64
rammer
-acb returns address count and bin,
from table
/stack
stuff count specifies count items to be
placed on the stack at load time              

   212 list
- configuration tables com 116
tabl
pop 2/ 2/ com @ + ;
jsr
E8 dst ; call has been clobbered already
table
nn align jsr tabl for dup , next drop ;
a-boot
-1 288 table*c-boot -1 288 table
b-boot
-1 288 table*p-reg A9 288 table
a-reg
-1 288 table*b-reg io 288 table
io-reg
-1 288 table,
,
/a a a-reg ! ;*/b a b-reg ! ;*/p a p-reg ! ;
/io
n io-reg ! ;*+node n nn-n com ! ;
/part
acb b-boot ! c-boot ! a-boot ! ;
/ram
b b-boot ! 64 c-boot ! 0 a-boot ! ;
rammer
-acb a-boot @ c-boot @ b-boot @ ;,
,
aaray pop 2/ 2/ com @ 11 * + ;
array
n align jsr aaray 11 * for 0 , next ;
'stack
288 array sp 10
@s+
'stack sp @ + @ 1 sp +! ;
!s-
n 'stack sp @ + ! -1 sp +! ;
/stack
stuff count,
10 sp ! dup !s- for !s- next ;                


- routing
route
i start on a path
active
-n node being configured
follower
-n next node in path
+route
n change active node,
,
?load load code into node now if table says to
,
,
deliver init ram, a, b, stack, and p if,
tables say to do so                           

   214 list
- routing 'rte 67896840
route
i 'pths + @ 'rte ! ;
active
-n 'rte @ @ ;
follower
-n 'rte @ 1 + @ ;
+route
n 'rte +! active nn-n com ! ;,
,
?load c-boot @ 0 + drop -if ; then,
...
rammer boot ;,
,
deliver pth @ active hook pause ?load,
io-reg @ - 0 + drop -if,
...
io-reg @ io r! then,
a-reg @ - 0 + drop -if,
...
a-reg @ lit' ra! then,
b-reg @ - 0 + drop -if,
...
b-reg @ lit' rb! then,
'stack 10 + @ dup and if dup,
...
dup negate 10 + sp ! for @s+ lit' next,
...
then drop,
p-reg @ call ;                                


this block is loaded by softsim to set the,
configuration for a given simulation. edit it
as needed to set up testbeds, load application
code and initialize it for running, and set
,
breakpoints.,
,
see arrayforth user's manual for information,
about these options.                          

   216 list
softsim configuration,
,
spi boot testbed 1244 2 loads,
sync boot testbed 'addr,len' 1230 load,
,
smtm 0 +node 0 /ram 0 /p,
/command test 400 +node 0 /ram 25 /a 12 /b,
9 8 7 6 5 4 3 2 1 12345 10 /stack A9 /p,
,
rom write test 200 +node 13 /p,
,
0 32 103 break,
0 BE 300 break                                


this load block compiles and configures the,
ide for a 2-chip environment on the eval board
,
this block starts by loading the serial ide in
its standard form.
-canon forgets the mapping
of canonical words like
@ and dup onto the f18
so that we may interact with x86 code and ram.

,
we then set orgn so that the ide compile will
reload this block, and we set
sport to the usb
port a for normal ide operations on host chip.

!nam
updates pathname for that com port.,
,
talk resets host chip as in regular ide.
span
resets target and builds port bridge,
between nodes 300 on both chips. paths are set
for bridged operation.
,
,
canon load restores mapping of canonical words
onto the f18. comment this if you wish to use
the 'r-words' for all f18 operations.         

   218 list
evb001 bridge 2-chip ide empty compile,
,
serial load,
customize -canon 0 fh orgn !,
a-com sport ! a-bps bps ! !nam,
path 2 fh load setup 4 fh load,
,
dac n 155 and io r! ;,
,
mwall nn-i 1000 mod swap 1000 mod,
over over or drop if swall ;,
then drop drop up 3 ; ' mwall 'wall !,
,
span !b0a setup !b0 !b2,
..
0 10000 hook 0 -hook ;,
,
canon load                                    


in the bridged environment, paths are...,
..
bri0 used to reach and boot entire target,
....
chip as well as 400/500/600/700-707.,
..
bri2 reaches rest of host chip not covered .
...
by path 0.,
..
path 1 available for general debug use.,
,
..
bri0a only used to set bridge up.,
,
                                              

   220 list
- paths
bri0a
align create,
708 608 to 607 600 to 500 300 to -1 ,,
bri0 align create,
708 608 to 607 600 to 500 400 to,
10400 10700 to 10701 10717 to 10617 10601 to,
10501 10517 to 10417 10401 to 10301 10317 to,
10217 10200 to 10100 10117 to 10017 10000 to,
-1 ,
bri2
align create,
708 717 to 617 601 to 501 517 to 417 401 to,
301 317 to 217 200 to 100 117 to 17 0 to -1 ,,
,
!b0a bri0a 'pths ! ;
!b0
bri0 'pths ! ;,
!b2 bri2 'pths 2 + ! ;                        


setup resets target chip and sets up the port
bridge for ide and creeper use.
br

first we load sync boot master in our 300 done
by
!sync
second
!his loads bridge in uut node 300 using
frame
which sends a boot frame starting at loc
ation
a compiled for bin nd's ram
third
!ours loads bridge into our node 300 br

setup does all this and leaves ide set to node
400
which may talk to 1400 through its up port
for testing of the bridged 2-chip system.     

   222 list
- build port bridge
set
n nn 0 swap hook 2 + 10000 * io r! ;
rst
n 500 set ;,
,
!sync 0 300 hook 0 64 1901 boot 19 call ;,
,
pt@ a-n @ 15555 or ;
frame
a nd nn-n 2* 32768 + block + dup 2 + pt@
3
+ for dup pt@ lit' 6 call 1 + next drop ;
!his
5 1904 1905 frame ;,
,
!ours off 19 call 0 64 1904 boot ent 30 call ;
,
setup 0 rst !sync 1 rst,
0 300 hook !his !ours 0 -hook,
2 -hook 1 -hook 0 -hook ;                     


                                              

   224 list
                                              


                                              

   226 list
                                              


                                              

   228 list
                                              


                                              

   230 list
                                              


                                              

   232 list
                                              


                                              

   234 list
                                              


                                              

   236 list
                                              


                                              

   238 list
                                              


framer load gets the stream vocabulary,
,
body recursively make the body of a boot frame
length
add up number of words in boot frame
head
make boot frame header
frame
make the whole boot frame,
...
-1 for focus , +3 for header
fram
a make a bootframe using a different,
continuation address                          

   240 list
framer overlay
exec
B6 ;*warm A9 ;*io 15D ;,
right 1D5 ;*down 115 ;
left
175 ;*up 145 ;,
streams 2 fh 4 loads,
,
body w-w follower 0 + drop -if,
?load post ; then -load -post pump,
1 +route body -1 +route ?load post ;,
length -n 1 'pth @ 1 + begin dup @ - 0 +,
-while - nn-n com ! c-boot @ 0 + -if -4 +,
then load 5 + pump 5 + post @post + u+,
1 + end then drop drop -1pump -5 + ;,
,
head a-w active nn-n com ! 10000 + !18,
0 side dup !18 length dup !18,
swap 12000 + !18 1 +route ;
frame
exec
fram
a head -1 + body drop -1 +route,
...
c-boot @ 0 + drop -if 0 0 0 /part then,
...
p-reg @ booter /root ;,
,
default path 22 fh load                       


stream components com identfies current node
table
creates an array initialized to -1
x-boot
x-reg
arrays have booter and starter details
/p
specifies entry point
/a
initial value of a
/b
initial value of b
/io
initial value of io register
+node
connect to a node in a path cr
/part from ide, specifies ram address, cr
length and source,
note scrub must be maintained to match the,
defaults stored here!
booter
find a, c, and b for +load br

aaray
array
'stack
an array of 144 10 item stacks
@s+
get next item to be initialized
!s-
store next item into stacks array
/stack
specify stack initialization
/rstack
specify return stack initialization   

   242 list
- framer com 131
tabl
pop 2/ 2/ com @ + ;
table
nn align call tabl for dup , next drop ;
a-boot
-1 288 table*c-boot -1 288 table
b-boot
-1 288 table*p-reg A9 288 table
a-reg
-1 288 table*b-reg io 288 table
io-reg
-1 288 table
/a
a a-reg ! ;*/b a b-reg ! ;*/p a p-reg ! ;
/io
n io-reg ! ;*+node n nn-n com ! ;
/part
acb b-boot ! c-boot ! a-boot ! ;
/ram
b b-boot ! 64 c-boot ! 0 a-boot ! ;
booter
-acb a-boot @ c-boot @ b-boot @ ;,
,
aaray pop 2/ 2/ com @ 11 * + ;
array
n align call aaray 11 * for 0 , next ;
'rstack
288 array*'stack 288 array sp 10
@s+
'stack sp @ + @ 1 sp +! ;
!s-
n 'stack sp @ + ! -1 sp +! ;
/stack
stuff count,
..
10 sp ! dup 'stack !s- for 'stack !s- next ;
/rstack
stuff count,
..
10 sp ! dup 'rstack !s- for,
....
'rstack !s- next ;                        


stream components cr
'pth points to current place in path
b-a
byte to word address
route
stores address of new path in 'pth
course
is user vocab for setting a path.
active
return current node in path
follower
return next node in path
+route
move to next node in path indent
  
pos moves forward neg moves back br

wd point to next word in stream buffer
!18
stores word into stream buffer br

wall given numbers of two adjacent nodes cr
return index for shared port
side
given numbers of two adjacent nodes cr
return address of shared port br

0/2 false is 0 and true is 2
@post
add up the size of active node's cr
postamble
to-do
... clean up 'stream as +2,,
define -1+ as length and -2+ as,
concat.                                       

   244 list
- framer 'pth 67898173 'wall 271590019
b-a
b-a 3 + 2/ 2/ ;*a-b a-b 2* 2* ;
create
-a pop b-a ;
route
pop b-a*course a 'pth ! ;
active
-n 'pth @ @ ;
follower
-n 'pth @ 1 + @ ;
+route
n 'pth +! active nn-n com ! ;,
wd 75760552
'stream
-a nnc 2 * 8000 + block 1 + ;,
clear 'stream 1 + wd !
stream
-ac 'stream 1 + dup wd @ - + -,
dup 'stream -1 + ! ;
strlen
-n stream nip ;
!18
n 15555 or wd @ ! 1 wd +! ;,
swall nn-i over over or 1 and drop if or 2 and
; then
10 100 / swap 10 100 / or 2 and 1 + ;
wall
nn-i 'wall xqt ; ' swall 'wall !
side
n-a 'pth @ + dup @ swap 1 + @ wall port ;
0/2
n-0/2 0 + drop -if 0 ; then 2 ;
@post
-n a-reg @ 0/2 b-reg @ 0/2 + io-reg @,
..
0/2 2* + 'stack 10 + @ 2 * +,
..
'rstack 10 + @ 2 * + 1 + ;                  


stream components br

pump store 5 word port pump to stream buffer
post
variable length word postamble, cr
entry point, a, b, stack
+ram
write ram contents to stream buffer
+load
5 word load pump to stream buffer       

   246 list
- framer
pump
w-w -5 + @pdupa!@p 4DAF !18,
0 side 12000 + !18 dup -1 + !18,
push!.. 2FAB2 !18 @p!unext. 5A72 !18 ;
post
/io ..io-reg @ - 0 + drop -if,
@pb!.. 4BB2 !18 io !18,
@p!b.. 5BB2 !18 io-reg @ !18 then,
/a ..a-reg @ - 0 + drop -if,
@pa!.. 4AB2 !18 a-reg @ !18 then,
/b ..b-reg @ - 0 + drop -if,
@pb!.. 4BB2 !18 b-reg @ !18 then,
/rstack ..'rstack 10 + @ dup and if dup,
..
dup negate 10 + sp ! for @ppush.. 48B2 !18,
..
'rstack @s+ !18 next then drop,
/stack ..'stack 10 + @ dup and if dup,
..
dup negate 10 + sp ! for @p.. 49B2 !18,
..
'stack @s+ !18 next then drop,
/p always p-reg @ 10000 + !18 ;,
+ram acb nn-n 2* 8000 + block u+,
for dup @ 15555 or !18 1 + next drop ;
+load
acb push @pa!@p. 4A12 !18,
..
over !18 dup -1 + !18 push... 2E9B2 !18,
@p!+unext. 5872 !18 pop +ram ;                


stream components br

?load maybe add load pump and ram contents
-load
subtract ram words from payload count cr
if ram is to be loaded in active node
-post
subtract length of postamble from cr
payload count br

adjust align stream to 8 18 bit word boundary
scrub
remove previous initialization clues cr
for node n in the current path must be main-,
tained whenever defaults for tables change.
fresh
scrub the entire current path to prepare
for another boot frame                        

   248 list
- framer
?load
w-w c-boot @ 0 + drop -if ; then,
booter +load ;
-load
w-w c-boot @ 0 + -if drop ; then,
5 + negate + ;
-post
w-w @post negate + ;,
,
adjust begin strlen 7 and drop while,
0 !18 end then strlen 'stream ! ;
scrub
n +node -1 dup dup /part,
-1 /a io /b warm /p ;
fresh
begin active scrub 1 +route,
active dup and drop -until 708 +node AA /p ;,
,
/root a' a c b push push push,
10000 +or !18 pop dup !18 pop dup !18,
0 + if pop +ram ; then drop drop pop drop ;,
,
mwall nn-i 1000 mod swap 1000 mod,
over over or drop if swall ;,
then drop drop up 3 ;
2chip
' mwall nop 'wall ! ;                   


erasing flash br

ers an cr
a byte address in flash on 4k boundary cr
n number of 16 bit words to erase             

   250 list
ers flash erase function overlay cr
len ! dest ! cr
serial load -canon cr
a-com sport ! a-bps bps ! !nam panel
esc
key? esc ;
wait
esc 0 keych ! ;
expand
n-lh dup FFFF and 4 * swap cr
F0000 and 64 / ;
ersall
21 call ;
ers32
18 call ;
ers
dest @ 2* 2* 1E r! ers32 ;
read
a-a' dup expand lit' lit' C call -2 + ;
r
d-dw 2 + rdrop 25 call upd ;
check
dest @ read len @ for cr
r FFFF or drop if pop 0 ; then -next -1 ; cr
nores 285 list cr
.noboot pause wait ** install noboot jumper cr
talk check a-com 0 705 hook 0 64 1613 boot cr
.boot pause wait *** remove noboot jumper cr
ers .erasing pause ersall ers chill,
check overlay                                 


writing a boot stream into flash br

force length to 0 mod 8 so operation ends cr
at a 16 bit boundary br

18burn sdn cr
s source address of buffer in host memory cr
d destination 8 bit address in flash cr
n length of stream in 18 bit words            

   252 list
flash writer 18 bit overlay cr
7 + -8 and len ! dest ! source ! cr
serial load -canon cr
a-com sport ! a-bps bps ! !nam talk br

esc key? esc ;*wait esc 0 keych ! ; cr
nores 285 list cr
.noboot pause wait ** install noboot jumper cr
talk check a-com 0 705 hook 0 64 1613 boot,
.boot pause wait *** remove noboot jumper,
.erasing pause erase 1st 32k,
...
0 1E r! 18 call chill,
,
0 705 hook 0 64 1609 boot focus cr
0 706 hook 0 64 1610 boot br

flash commands 1214 2 fh load,
285 list nosay cr
.burning pause burn chill cr
.checking pause check cr
overlay                                       


                                              

   254 list
- code for flash writer
read
a left lit' ra! dup F0000 and 64 / cr
swap FFFF and 4 * lit' lit' 23 call ;
r
left lit' ra! 29 call upd ;
commence
left lit' ra! len @ 8 / -1 + cr
dest @ dup F0000 and 64 / lit' cr
FFFF and 4 * lit' lit' 2D call ;
git
a-an dup 1 + swap @ 15555 or ;
get
a-a git lit' ;
burning
source @ len @ for get !+ next drop ;
fetch
-n 37 call 3F 3A r@ ;
check
-t dest @ read source @ len @ cr
for git fetch over pause over or cr
drop if pop fail ; cr
then drop drop next drop good ;
burn
commence burning ; br

f 0 706 hook fetch 0 705 hook upd ;
b
0 706 hook burn ;                           


                                              

   256 list
exercising flash 20 org
focus
20 @p dup a! .. / --l- / ! ;
reading
23 l h focus @p ! .. / @p @p .. / cr
! ! .. @p ! ; / 1200E , /
@word
29 -n @p ! .. / 120D9 , / cr
@p ! @ ; / !p .. /
writing
2D h l n focus cr
left @p ! .. / @p a! .. / cr
! @p ! .. / @p @p @p .. / push push ! cr
pop ! pop ! @p ! ; / 1201D , /
stash
37 focus @word !p ; 3A 0 , br

exit
stash
37 focus a push @word 3F a! ! pop a! ;  


programming 8 bit flash br

burn sdn cr
s source address of buffer in host memory cr
d destination 8 bit address in flash cr
n length of stream in 16 bit words            

   258 list
writing flash 8 bits overlay cr
len ! dest ! source ! cr
serial load -canon cr
a-com sport ! a-bps bps ! !nam talk,
nores 285 list 0 705 hook 0 64 1613 boot,
.erasing pause erase 2nd 32k,
...
20000 1E r! 18 call chill,
,
flash commands 1220 2 fh load br

0 705 hook 0 64 1611 boot cr
285 list nosay nores cr
.burning pause burn chill cr
.checking pause check cr
overlay                                       


reading and writing flash br

read begin at 20 bit flash byte address
r
read the next 16 bit word from flash
r18
read the next 18 bit word from flash
rr
begin and read first word at 8000
ers
erase whole flash
pr
program assuming already erased
back
back out to node 706 for streaming
send
one word into node 705 , pause to display
2@+
fetch 16 bit word + byte swap
burn
n start programming flash in 705 , cr
then back out to 706 and stream words from cr
the stream buffer into 705 .                  

   260 list
code for reading and writing flash 8 bits cr
out 0 706 hook ; -cr  in 0 705 hook ;
read
a-a' in dup dup F0000 and 64 / lit' cr
FFFF and 4 * lit' E call rdup upd -2 + ;
r
d-dw 2 + rdrop 14 call upd ;
r18
d-dw 2 + rdrop D9 call upd ;
rr
8000 read r ;
ers
24 call ; -cr  pr 28 call ;
send
n left pause r! ;
2@+
b-b'h dup 2 + swap 2@ FFFF and swab ;
burn
in dest @ dup F0000 and 64 / lit' cr
FFFF and 4 * lit' len @ lit' cr
left lit' ra! pr out source @ len @ cr
for 2@+ 4 * send -next drop ;
check
-t dest @ read drop cr
source @ len @ for 2@+ 39 3B call 3F r@ or cr
drop if pop drop fail ; then -next drop good ;


line ncd comma nodes into a table starting at
node
n for c nodes incrementing by d cr
/left extend line toward the left
/right
extend line toward the right
/up
extend line upward
/down
extend line downward
entire
default path table that cr
covers the whole virginal chip                

   262 list
default flash path for whole chip
line
ncd swap push swap,
...
begin dup , over + -next drop drop ;
count
nc-ncd dup 100 mod 0 + if,
horz swap drop 1 ;,
vert then drop 100 / 100 ;
to
nn over negate + -if,
back negate count negate line ;,
forw then count line ;,
,
entire align create 705 701 to 700 0 to,
1 17 to 117 101 to 201 217 to 317 301 to,
401 417 to 517 501 to 601 617 to 717 706 to,
-1 ,,
,
retain asynch boot 708 +node AA /p            


load block for sram cluster mk1,
as documented in an003.,
,
packaged as per preliminary module standards,
,
sram load block for f18 code,
sram 2 + boot descriptors for cluster,
sram 4 + optional residual path definition,
f18 source code follows.                      

   264 list
sram cluster mk1 br

load sram 6 fh 3 loads indent
  
norm 12 fh degen 12 16 fh load             


load descriptor for sram cluster,
,
this descriptor is suitable for use with,
ide loader, streamer, and softsim.            

   266 list
- load descriptor,
,
interface 107 +node 1614 /ram down /b,
...
mask 8A00 1 /stack re 17 /p,
,
data 7 +node 1615 /ram 20 /p,
cntl 8 +node 1616 /ram 20 /p,
addr 9 +node 1617 /ram 20 /p                  


memory clusters are often loaded before the,
rest of the application so that external ram,
may be initialized without burdening appli-,
cation f18 code. these residual paths provide
access from boot nodes to the rest of the chip
in such cases.
,
,
s705 residual path for spi flash boot streams.
s708
residual path for async boot or ide.     

   268 list
- residual paths,
,
s705 align create 705 701 to 700 0 to,
1 6 to 106 101 to 201 208 to 108 109 to,
209 210 to 110 10 to 11 17 to 117 111 to,
211 217 to 317 301 to 401 417 to 517 501 to,
601 617 to 717 706 to -1 ,,
,
s708 align create 708 701 to 700 0 to,
1 6 to 106 101 to 201 208 to 108 109 to,
209 210 to 110 10 to 11 17 to 117 111 to,
211 217 to 317 301 to 401 417 to 517 501 to,
601 617 to 717 709 to -1 ,                    


node 9 suspends while waiting for a16. it uses
the two lower page bits to output an
cr
18-bit address. cr
indent
  
a16 xx.aaaa.aaaa.aaaa.aaaa indent
  
p04 00.0000.0000.0000.pppp indent
  
a18 aa.aaaa.aaaa.aaaa.aapp br

the code is written to minimize/equalize the t
ime to output the address, which must be stabl
e when node8 stores the 'start' command.      

   270 list
sram.16 address-bus 9 node cr
AA 20 org br

start 20 right b! .. data a! .. 3 mask
cmd
m 26 @b a16 2* 2* over @b -if indent
  
28 - p04 and or a18 ! cmd ; indent
  
2A then p04 and or .. a18 ! cmd ;,
2C 1617 bin                                   


node8 is fed a stop command during start-up, t
hen suspends while waiting for a16. after star
ting the read or write, it again suspends whil
e waiting for the stop command.
br

bits 4..2 of the /possibly inverted/ page valu
e are used 'as-is' to index into the start tab
le, setting two address bits, write enable, an
d chip enable.
** note that reads and writes a
re swapped if the page 'overflows' into bit4,
with disastrous results **
cr
cr
cmd index .lit. pin17 pin05 pin03 pin01 cr
w00 .0111 2556A a19-0 a18-0 /we-0 /ce-0 cr
r00 .0000 2556E a19-0 a18-0 /we-1 /ce-0 cr
w01 .0110 2557A a19-0 a18-1 /we-0 /ce-0 cr
r01 .0001 2557E a19-0 a18-1 /we-1 /ce-0 cr
w10 .0101 3556A a19-1 a18-0 /we-0 /ce-0 cr
r10 .0010 3556E a19-1 a18-0 /we-1 /ce-0 cr
w11 .0100 3557A a19-1 a18-1 /we-0 /ce-0 cr
r11 .0011 3557E a19-1 a18-1 /we-1 /ce-0       

   272 list
- control-pins 8 node host
'r-l-
1F5 lit ; target 0 org br

'start' pin control table 0-7 cr
00 2556E r00 , 2557E r01 , cr
02 3556E r10 , 3557E r11 , cr
04 3557A w11 , 3556A w10 , cr
06 2557A w01 , 2556A w00 , cr
08 20 org br

start 20 'r-l- b! io a!
cmd
24 @b stop ! a push 7 mask .. indent
  
@b a16 !b @b +p/-p dup !b indent
  
2/ 2/ and i3 a! .. @ ctrl pop a! indent
  
start ! cmd ;,
2C 1616 bin                                   


node7 suspends waiting for a16, passes it and
page/r/w to nodes
8 and 9, finally controlling
the data transfer and timing until sending the
stop command.
br

the literals needed for writing are loaded cr
onto the stack and used circularly to save cr
time. /read's drops are free./ br

---- .lit. pin17 pin05 pin03 pin01 cr
stop 3557F a19-1 a18-1 /we-1 /ce-1            

   274 list
- data-bus 7 node host
in
14555 lit ; -cr  out 15555 lit ;
stop
3557F lit ; target cr
cr
AA 20 org
start
20 left b! out io data stop indent
  
out io data stop in io a! in ! indent
  
down a! stop !b
cmd
/soid/ 31 @ a16 !b @ +p/-p -if br

w16 /soid/p- 33 +p/-p !b cr
/- setup + 45ns @ w a push push data a! cr
pop ! io a! out ! 40 13 for unext stop !b cr
-/ in ! pop a! cmd ; br

r16 /soid/p- 3C then +p/-p !b cr
/- setup + 55ns a push data a! cr
io drop out drop 50 40 for unext stop !b -/ cr
@ w pop a! ! cmd ;,
43 1615 bin                                   


node 107 full capability version.,
polls for master requests and delivers stimuli
priority
is ether/108, vm/106, snorkel/207,
all requests are atomic. passes ex@ and ex!,
requests on to node 007, performs cx? locally
using those primitives. the command and stimul
us mask
m is maintained on the stack.,
,
requests are variable length messages decoded
as shown below where - means 18-bit inverse of

16
bit argument.,
,
ex@ +p +a fetch
cx?
-w1 +p a w2 comp-and-exch
ex!
-p -a w store
mk!
+0 -f m f-1 enables each master whose port
write bit is set in
m. kills pending stimulus
for any disabled master. abandons old mask.
,
f-0 adds a stimulus for each master whose port
write bit is set in
m. caller should not post
a stimulus for any disabled master.           

   276 list
- interface 107 node 0 org
cx
wp- 00 over push @ dup,
...
a !b over p !b @b w pop - w1 or if,
ne @ w2 dup or ff ! ;,
eq then drop a !b - -p !b @ w2 !b FFFF ! ;,
,
cmd 0A @ -if @ ' cx -until .e! - !b !b @ !b ;
then
0E @ -if mixpa,
.mk! 0F - push drop drop pop if mia,
..stim 11 drop and @ over over 2* ahead swap,
..mask 14 then drop drop @ 2* over -,
...both 16/3 then and or
re
17 m 15555 dup ahead swap,
...
then .e@ 19 a !b p !b @b w ! ;
cmds
mixa 1B a! cmd*poll mix then io a!,
1E/2 begin drop over over @ or and until,
21 over over and if mixt 23 and and mt,
..
dup 1000 and if left ahead swap then,
..
28 drop 10000 over and if right ahead swap,
..
2D then drop 400 dup up then then,
...
2F mtba a! and or dup ! m ' re end,
31 then drop 2* 2* -if right cmds ;,
35 then 2* 2* 2* 2* -if left cmds ;,
39 then up cmds ; 3B 1614 bin                 


example code for memory master nodes. cr
memory-access words assume that addresses and
data are 16-bit parameters with the upper two
bits zero and pages are 4-bits with the upper

14
bits zero. p.a is thus a 20-bit address. br

ex@ a p - w fetch w from p.a
ex!
w a p store w at p.a
mk!
w f -0 set masks from w per f.
cx?
w a p n - f comp-and-exch br

cx? compares value at p.a to n. if same, write
s
w to p.a and returns true. otherwise, only r
eturns false.
x@ and x! are 16-bit versions to
access the lowest 64k of available memory.
br

mk! sets mask from w when f is 0; cr
posts stimuli when f is 1.                    

   278 list
- user node 106, 108, or 207.
x!
wa 39 dup dup or
ex!
wap -cr  mk! mfp' 3A - !b - !b !b ;
x@
a-w 3C dup dup or
ex@
ap-w 3D !b !b @b ;
cx?
wapn-f 3E - !b !b !b !b @b ; 40           


node 107 minimal capability version. cr
single master, no polling, no stimuli. cr
maximum speed, minimum power. br

all requests are atomic. passes ex@ and ex! cr
requests on to node 007, performs cx? locally
using those primitives.
br

requests are variable length messages decoded
as shown below where - means 18-bit inverse of

16
bit argument. br

ex@ +p +a fetch
cx?
-w1 +p a w2 comp-and-exch
ex!
-p -a w store                             

   280 list
- degenerate sram 107 node 0 org br

cx wp- 00 over push @ dup indent
  
a !b over p !b @b w pop - w1 or if cr
ne @ w2 dup or ff ! ; cr
eq then drop a !b - -p !b @ w2 !b FFFF ! ; br

cmd 0A @ -if @ ' cx -until .e! - !b !b @ !b ;
then
0E @ .e@ 0F a !b p !b @b w ! ; br

11 17 org
start
17 down b! right a!
run
1B cmd run ; 1D                           


stream building utilities cr
persistant streamer variables cr
source word address in host memory buffer cr
dest byte address in flash cr
len length of stream in words
stream
-an returns source an len
18burn
sdn burn flash in 18 bit words
burn
sdn burn flash in 16 bit words
ers
an erase 4k blocks containing range an
framer
location of boot frame vocabulary
chill
delay a long enough time to be sure cr
that the previous operation is complete
overlay
remember point for streamer utility cr
saying overlay restores the dictionary to cr
its state when overlay was defined            

   282 list
streamer cr
source 303005696 dest 32768 len 4607
stream
-an source @ len @ ;
18burn
sdn -30 fh load ;
burn
sdn -24 fh load ;
ers
an -32 fh load ;
framer
-42 fh ;
chill
500 for 1000000 for nop next next ;
file
12 fh ; cr
feedback 284 load
overlay
remember                              


flash utilities,
,
.str,
,
.now,
.at.,
,
.res,
.ask                                          

   284 list
flash utilties feedback,
result 0 'say 271552498,
'ask 271552293 'at 271553181
nosay
'say assign nop ; nosay
noask
'ask assign nop ; noask
noat
'ask assign nop ; noat
.now
blu 'say xqt ;
.ask
blu 'ask xqt ;
.at.
blu 'at xqt ;
chs
...n for emit next ; 2 fh load
.res
blu result @,
0 -1 + -if drop .good ; then,
1 -1 + -if drop .fail ; then ;
good
0 result ! ;*fail 1 result ! ;
nores
2 result ! ; leng 4096 36 leng !
.str
blu silver .' stream space .' length,
space leng @ . .' words space,
leng @ 18 8 */ . .' bytes space ;
.nucleus
'at assign blu silver,
.' nucleus space ;
.stream
'at assign blu silver,
.' boot space .' stream space ;               


                                              

   286 list
- flash utilities feedback
.erasing
noask 'say assign silver,
.' erasing space ;
.burning
noask 'say assign silver,
.' burning space ;
.checking
noask 'say assign silver,
.' checking space ;
.good
green .' success space ;
.fail
red fail 0 C 7 5 E 5 chs ;
.boot
nosay 'ask assign green .' remove space
.j26
.' j26 space .' then space,
.' press space .' key space ;
.noboot
nosay 'ask assign green,
.' install space .j26 ;
.cont
nosay 'ask assign green,
.' press space .' space space .' to space,
.' burn space .' new space .' nucleus space ; 


                                              

   288 list
pf to flash br

read/write 18 bit flash indent
  
705 node 1364 load 1609 bin indent
  
706 node 256 load 1610 bin cr
read/write 8 bit flash indent
  
705 node 1370 load 1611 bin cr
erase flash indent
  
705 node 1352 load 1613 bin                


                                              

   290 list
speedup spi boot 705 node 0 org
start
5 dup spi-exec ; cr
03 1608 bin                                   


                                              

   292 list
                                              


stream to file
open
bf-h b is byte address of filename
change
ac stream is made as pattern not number
keep
convert stream to number and write it to
a file, then change it back to pattern        

   294 list
stream to file named stream.bin
open
bf-h push push 0 32 exist 2 0 0 cr
pop pop swap fcreate ;
change
ac for dup @ 15555 or over ! 1 + cr
next drop ;
keep
0 fnam w/o open dup push stream change cr
stream push 4 * pop 4 * pop fwr drop fclose cr
stream change ; keep                          


                                              

   296 list
                                              


                                              

   298 list
                                              


                                              

   300 list
dc characterization code added march 2011. br

block 602 is code run in a node to measure pow
er.
br

blocks 604 thru 636 are ide load blocks to set
up various measurement conditions.            


this load block, and the following 25 source/s
hadow pairs, are yours to do with as you pleas
e!                                            

   302 list
custom test code 609 node 0 org
t1
00 begin begin begin begin cr
unext unext unext unext t1 ;
t2
02 begin begin begin cr
. unext unext unext t2 ;
t3
04 begin begin . . unext unext t3 ;
t4
06 begin . . . unext t4 ;
t5
08 begin begin begin begin cr
next next next next t5 ;
t6
0D begin begin begin begin cr
. . . . next next next next t6 ;
s++
13 15555 dup -cr  s.. dup dup dup dup dup
dup dup dup ;
-cr  s+- 15555 2AAAA s.. ;
t7
1C s++ -cr  t78e begin begin begin drop une
xt unext unext t78e ;
-cr  t8 1F s+- t78e ;
t9
21 io b! -1 !b begin . drop @b -until ;
txx
28 s++ s+-
txxx
begin . . . - unext txxx ; 2A
temp
2 3FFFE 3 3FFFF 999 io b! push !b begin u
next !b ;
31
temps
temp temps ; 33                         


                                              

   304 list
set all high z for leakage test talk br

0 200 hook 0 io ! cr
0 300 hook 0 io ! cr
0 9 hook 0 io ! cr
0 7 hook 0 io ! cr
serdes already in input just focus it cr
0 701 hook focus cr
2 709 hook 155 io !                           


                                              

   306 list
set all weak pd for wpd test talk br

0 200 hook 15555 io ! cr
0 300 hook 15555 io ! cr
0 9 hook 0 io ! cr
0 7 hook 0 io ! cr
serdes already in input just focus it cr
0 701 hook focus cr
2 709 hook 155 io !                           


                                              

   308 list
set all high for several tests talk br

0 200 hook 30003 io ! cr
0 300 hook 30003 io ! cr
0 9 hook 3FFFF data ! cr
0 7 hook 3FFFF data ! cr
serdes already in input just focus it cr
0 701 hook focus cr
2 709 hook AA io !                            


                                              

   310 list
set all low for several tests talk br

0 200 hook 20002 io ! cr
0 300 hook 20002 io ! cr
0 9 hook 0 data ! cr
0 7 hook 0 data ! cr
serdes already in input just focus it cr
0 701 hook focus cr
2 709 hook 155 io !                           


                                              

   312 list
t04 all node access talk br

?rom pause upd pause cr
2 708 hook pause 2 707 hook pause cr
?ram pause upd pause cr
1 lit pause 2 lit pause 3 lit pause cr
+ pause +                                     


                                              

   314 list
vt+- node 217 compile talk 2 217 hook upd cr
dak n a 5BB2 over r! swap 155 or swap r! ;
try
n up dak ;
h
20000 io r! 0 try 100 ms 0 io r! cr
0 begin dup 200 or 200 and drop while cr
dup try 1 + io r@ 20000 and drop until then ;
l
30000 io r! 511 try 100 ms 0 io r! cr
255 begin dup 100 or 100 and drop while cr
dup try -1 + io r@ - 20000 and drop until then
;                                             


                                              

   316 list
vt+- node 517 compile talk 0 517 hook upd cr
dak n a 5BB2 over r! swap 155 or swap r! ;
try
n up dak ;
h
20000 io r! 0 try 100 ms 0 io r! cr
0 begin dup 200 or 200 and drop while cr
dup try 1 + io r@ 20000 and drop until then ;
l
30000 io r! 511 try 100 ms 0 io r! cr
255 begin dup 100 or 100 and drop while cr
dup try -1 + io r@ - 20000 and drop until then
;                                             


                                              

   318 list
vt n7/8 compile talk cr
2 7 hook 0 io ! data lit ra! focus cr
2 8 hook 20000 io ! focus upd cr
rd a-n @!p 39B2 over r! r@ ;
git
-n left rd ;
go
key? git 1 and drop if 30000 io r! go ; cr
then 20000 io r! go ; go                      


                                              

   320 list
vt n9/8 compile talk cr
0 9 hook 0 io ! data lit ra! focus cr
0 8 hook 20000 io ! focus upd cr
rd a-n @!p 39B2 over r! r@ ;
git
-n right rd ;
go
key? git 20000 and drop if 30000 io r! go ;
cr
then 20000 io r! go ; go                      


                                              

   322 list
t10 schmitt power talk br

no boot 0 709 hook upd 0 -hook cr
0 200 hook 15555 io ! upd cr
0 300 hook 15555 io ! upd cr
0 9 hook input 0 io ! upd cr
0 7 hook output 15555 io ! upd cr
serdes to output cr
0 701 hook focus 3FFFE lit 3FFFE data ! indent
  
20000 io ! upd cr
0 1 hook focus 3FFFE lit 3FFFE data ! indent
  
20000 io ! upd cr
                                              


                                              

   324 list
t11 suspended power talk br

no boot 0 709 hook upd 0 -hook cr
0 200 hook 15555 io ! pause cr
0 300 hook 15555 io ! pause cr
0 9 hook input 15555 io ! 0 data ! pause cr
0 7 hook output 15555 io ! 0 data ! pause cr
serdes to output cr
0 701 hook focus 3FFFE lit 3FFFE data ! indent
  
20000 io ! pause cr
0 1 hook focus 3FFFE lit 3FFFE data ! indent
  
20000 io ! upd pause cr
susp boot- 0 0 warm A9 /frame wos !frame      


                                              

   326 list
study single node + boot power talk br

no boot 0 709 hook upd 0 -hook cr
0 200 hook 15555 io ! pause cr
0 300 hook 15555 io ! pause cr
0 9 hook input 15555 io ! 0 data ! pause cr
0 7 hook output 15555 io ! 0 data ! pause cr
serdes to output cr
0 701 hook focus 3FFFE lit 3FFFE data ! indent
  
20000 io ! pause cr
0 1 hook focus 3FFFE lit 3FFFE data ! indent
  
20000 io ! upd pause cr
1 608 hook upd 0 64 609 boot ?ram             


                                              

   328 list
t12a boot power talk br

no boot 0 709 hook upd 0 -hook cr
0 200 hook 15555 io ! pause cr
0 300 hook 15555 io ! pause cr
0 9 hook input 15555 io ! 0 data ! pause cr
0 7 hook output 15555 io ! 0 data ! pause cr
serdes to output cr
0 701 hook focus 3FFFE lit 3FFFE data ! indent
  
20000 io ! pause cr
0 1 hook focus 3FFFE lit 3FFFE data ! indent
  
20000 io ! upd pause cr
1 608 hook upd 0 64 609 boot ?ram cr
                                              


                                              

   330 list
t12b boot pwr + drop same talk br

no boot 0 709 hook upd 0 -hook cr
0 200 hook 15555 io ! pause cr
0 300 hook 15555 io ! pause cr
0 9 hook input 15555 io ! 0 data ! pause cr
0 7 hook output 15555 io ! 0 data ! pause cr
serdes to output cr
0 701 hook focus 3FFFE lit 3FFFE data ! indent
  
20000 io ! pause cr
0 1 hook focus 3FFFE lit 3FFFE data ! indent
  
20000 io ! upd pause cr
1 608 hook upd 0 64 609 boot ?ram cr
19 1C call                                    


                                              

   332 list
t12c boot pwr + drop alternating talk br

no boot 0 709 hook upd 0 -hook cr
0 200 hook 15555 io ! pause cr
0 300 hook 15555 io ! pause cr
0 9 hook input 15555 io ! 0 data ! pause cr
0 7 hook output 15555 io ! 0 data ! pause cr
serdes to output cr
0 701 hook focus 3FFFE lit 3FFFE data ! indent
  
20000 io ! pause cr
0 1 hook focus 3FFFE lit 3FFFE data ! indent
  
20000 io ! upd pause cr
1 608 hook upd 0 64 609 boot ?ram cr
28 1F call                                    


                                              

   334 list
t12d boot pwr + greg test talk br

no boot 0 709 hook upd 0 -hook cr
0 200 hook 15555 io ! pause cr
0 300 hook 15555 io ! pause cr
0 9 hook input 15555 io ! 0 data ! pause cr
0 7 hook output 15555 io ! 0 data ! pause cr
serdes to output cr
0 701 hook focus 3FFFE lit 3FFFE data ! indent
  
20000 io ! pause cr
0 1 hook focus 3FFFE lit 3FFFE data ! indent
  
20000 io ! upd pause cr
1 608 hook upd 0 64 15 boot ?ram cr
14 call                                       


                                              

   336 list
t12e boot pwr + unext talk br

no boot 0 709 hook upd 0 -hook cr
0 200 hook 15555 io ! pause cr
0 300 hook 15555 io ! pause cr
0 9 hook input 15555 io ! 0 data ! pause cr
0 7 hook output 15555 io ! 0 data ! pause cr
serdes to output cr
0 701 hook focus 3FFFE lit 3FFFE data ! indent
  
20000 io ! pause cr
0 1 hook focus 3FFFE lit 3FFFE data ! indent
  
20000 io ! upd pause cr
1 608 hook upd 0 64 609 boot ?ram cr
0 call                                        


                                              

   338 list
sram test bd quiet i/o talk br

no boot 0 709 hook upd 0 -hook cr
0 200 hook 15555 io ! pause cr
0 300 hook 15555 io ! pause cr
0 8 hook all hi 3557F io ! cr
0 9 hook input 15555 io ! 0 data ! pause cr
0 7 hook output 15555 io ! 0 data ! pause cr
0 705 hook 3FFFF io ! cr
0 -hook                                       


                                              

   340 list
study single node w/boot suspended talk br

no boot 0 709 hook upd 0 -hook cr
0 200 hook 15555 io ! pause cr
0 300 hook 15555 io ! pause cr
0 9 hook input 15555 io ! 0 data ! pause cr
0 7 hook output 15555 io ! 0 data ! pause cr
serdes to output cr
0 701 hook focus 3FFFE lit 3FFFE data ! indent
  
20000 io ! pause cr
0 1 hook focus 3FFFE lit 3FFFE data ! indent
  
20000 io ! upd pause cr
1 608 hook upd 0 64 609 boot ?ram cr
run 0 15555 3FFFF lit dup dup dup 21 call cr
susp boot- 0 0 warm A9 /frame wos !frame      


                                              

   342 list
705 unext w/boot suspended talk br

no boot 0 709 hook upd 0 -hook cr
0 200 hook 15555 io ! pause cr
0 300 hook 15555 io ! pause cr
0 9 hook input 15555 io ! 0 data ! pause cr
0 7 hook output 15555 io ! 0 data ! pause cr
serdes to output cr
0 701 hook focus 3FFFE lit 3FFFE data ! indent
  
20000 io ! pause cr
0 1 hook focus 3FFFE lit 3FFFE data ! indent
  
20000 io ! upd pause cr
0 705 hook upd 0 64 609 boot ?ram cr
run 0 call cr
susp boot- 0 0 warm A9 /frame wos !frame      


                                              

   344 list
instr timing code 610 node 0 org
set
3FFFE 3FFFF 999 io b! 1 a! ;
t1
07 set push !b begin unext !b ;
t2
0A set push !b begin next !b ;
t3
0E set push !b begin . unext !b ;
t4
11 set push !b begin . . . unext !b ;
t5
15 set push !b begin . . @ unext !b ;
t6
19 set push io a! !b begin . . @ unext !b ;
t7
1F set push !b begin . .. next !b ;
t8
24 set push !b begin . .. . .. next !b ;
t9
2A set push !b begin begin dup or push unex
t . . . . next
2 !b ; 31                      


                                              

   346 list
study instr timing talk br

no boot 0 709 hook upd 0 -hook cr
0 200 hook 15555 io ! pause cr
0 300 hook 15555 io ! pause cr
0 9 hook input 15555 io ! 0 data ! pause cr
0 7 hook output 15555 io ! 0 data ! pause cr
serdes to output cr
0 701 hook focus 3FFFE lit 3FFFE data ! indent
  
20000 io ! pause cr
0 1 hook focus 3FFFE lit 3FFFE data ! indent
  
20000 io ! upd pause cr
0 705 hook upd 0 64 610 boot ?ram cr
cr
t1 7 call ; -cr  t2 A call ;
t3
E call ; -cr  t4 11 call ;
t5
15 call ; -cr  t6 19 call ;
t7
1F call ; -cr  t8 24 call ;
t9
2A call ;                                  


                                              

   348 list
                                              


                                              

   350 list
                                              


                                              

   352 list
                                              


                                              

   354 list
                                              


old code, not checked recently.
go
entered with path hooked to initial adjacen
t node. boots it with package and makes it act
ive.

//go
entered with path tbl adr for the active
node on stack.                                

   356 list
mark mem test all nodes cr
empty compile serial load panel talk 2 0 path
cr
tgt 417 tport 277 times 0 cr
runs 3 greg 98862 /max 98862 /tot 0 br

init 0 greg ! 0 times ! 0 runs ! 0 /max ! 0 /t
ot
! 0 tgt ! 0 tport ! ; init br

xx 0 test 0 or if -1 + dup /max @ max /max ! g
reg
! drop rip 9876 54321 abort then drop ; br

-us a-a dup @ paths @ or drop ;
-end
a-a dup @ -1 or drop ;
pt@
paths targets @ + ;
/go
pause 0 64 907 boot pfocus paths targets @
+
;
//go
key? 1 + -us if -end if dup @ dup tgt ! o
ver
-1 + @ wall port dup tport ! pause tfocus
pause xx
pause creep //go ; then then drop 1 r
uns
+! rip /go ;
real
-cr  jj /go drop rip ; 776 list /go      


old code, not checked recently.
go
entered with path hooked to initial adjacen
t node. boots it with package and makes it act
ive.

//go
entered with path tbl adr for the active
node on stack.                                

   358 list
mark burn on one weak node cr
empty compile serial load panel talk 2 0 path
cr
tgt 710 tport 373 times 0 cr
runs 3 greg 0 /max 0 /tot 0 cr
init 0 greg ! 0 times ! 0 runs ! 0 /max ! 0 /t
ot
! ; init
kk
0 64 907 boot pfocus left tfocus creep righ
t tfocus

//run
init pause
/con
key? 0 test 0 or if dup 1 times +! -1 + d
up
/max @ max /max ! dup greg ! /tot +! then g
reg
! 1 runs +! runs @ 1000 10 2 mod dup and d
rop if /con ; then pause /con ;

/real
kk 12345 ; 778 list /go                 


this load block compiles the f18 code for all
nodes in the polyforth vm.                    

   360 list
polyforth virtual machine reclaim,
,
sram cluster mk1 sram load,
serial 38 fh 3 loads reclaim,
,
stack 106 node 39 org 278 load 14 fh 2 loads,
coprocs 22 fh 4 loads,
bitsy 105 node 18 fh 2 loads,
coprocs 30 fh 4 loads,
,
flash to sram 86 fh 2 loads reclaim,
erase and burn flash 288 load,
spi speedup 290 load,
,
serial wires 102 node 20 org,
start @ !b start ; 21 1709 bin,
ganglia 44 fh load snorkel 48 fh load,
spi 50 fh load,
ethernet cluster mk1 ether load               


this block describes entire chip's loading for
polyforth boot environment.
,
,
suitable for use with ide loader, streamer,,
and softsim.,
,
all nodes not otherwise programmed are loaded
with ganglia for ad hoc routing.
,
,
the sram cluster is invoked here for complete
documentation although it has been loaded
,
earlier and is excluded from the path used by
the main stream.
,
,
enable loading of clock nodes if you have ftdi
or ether clock connected to 517.
,
,
enable loading of ether cluster if you have,
nic hardware attached to right side of chip.  

   362 list
- load descriptors,
l, nn dup +node 100 /mod 1 and 2* swap 1 and +
1714
+ push 32 32 pop /part warm A9 /p ;
ganglia
nns for i -1 + n-nn l, next ;,
,
sea of mk1 ganglia,
snorkel mk1 207 +node 1605 /ram up /b 37 /p,
,
sram cluster mk1 sram 2 + load,
virtual machine 2 fh load,
serial terminal 4 fh load,
additional i/o 6 fh load,
clock nodes exit,
..
517 +node 517 /ram io /b 200 /p,
..
516 +node 516 /ram left dup /a /p right /b,
ethernet cluster mk1 exit,
..
ether 2 + load                              


                                              

   364 list
-- virtual machine br

buds 205 +node 1705 /ram up /b 1 /p indent
  
5 +node 1704 /ram down /b 1 /p indent
  
206 +node 1702 /ram up /b right 1 /p indent
  
6 +node 1701 /ram down /b 1 /p br

bitsy 105 +node 1703 /ram indent
  
FFE0 15555 'cold 1 3 /stack indent
  
left /b right /a 31 /p br

stack 106 +node 1700 /ram indent
  
FFFF 0 0 3 /stack indent
  
right /b left /p                           


                                              

   366 list
-- serial terminal br

/wire io 20 1 1709 /part /b /a 20 /p ; br

104 +node 1708 /ram 20 /p cr
103 +node left right /wire cr
102 +node right left /wire cr
101 +node left right /wire cr
100 +node 1706 /ram 20 /p br

204 +node left up /wire cr
203 +node right left /wire cr
202 +node left right /wire cr
201 +node right left /wire cr
200 +node 1707 /ram 20 /p                     


loads the spi node with flash support in both
..
ide and spi boot procedures.,
when loading from spi, the async boot node is
..
loaded with ganglion but the line here runs
..
it at cold, thus allowing ide ops. for just
..
ganglion, comment this line; to program it,
..
otherwise, override later with your own boot
..
descriptors.,
,
spi boot may load every node in the chip.,
ide boot may load every node in the chip with,
..
the sole exception of node 708.             

   368 list
-- additional i/o,
spi 705 +node 1606 /ram io /b A9 /p,
async bootable 708 +node AA /p                


this load block compiles and configures the,
ide for the host chip on the eval board, for,
debugging f18 code in the rest of the chip aft
er polyforth has been loaded.
,
,
regardless of how pf was booted ... ide or spi
flash ... you will load this code and say talk
to get started. the reset line is disabled for
talk in this mode so that we don't kill pf.
,
,
canon load restores mapping of canonical words
onto the f18. comment this if you wish to use
the 'r-words' for all f18 operations.         

   370 list
- host ide with pf running empty compile,
,
serial load,
customize -canon 0 fh orgn ! 0 ?reset !,
a-com sport ! a-bps bps ! !nam,
,
paths 2 fh load,
select one... pfonly pfeth 'pths 2 + !,
,
dac n 155 and io r! ;,
,
canon load                                    


maximum coverage paths usable after pf loaded,
with or without ether+clock.
,
,
pfonly covers all nodes not loaded by the base
..
poly boot. it does not cover 205, 206 which
..
must have discrete paths.,
,
pfeth covers all nodes but 416 after pf, ether
..
and clock are all loaded. 205, 206 and 416,
..
must have discrete paths.                   

   372 list
-- residual paths,
pfonly align create 708 716 to 717 17 to,
16 616 to 615 15 to 14 614 to 613 13 to,
12 612 to 611 11 to 10 610 to 609 109 to,
108 608 to 607 707 to 706 606 to 605 604 to,
704 701 to 700 300 to 301 601 to 602 603 to,
503 506 to 507 307 to 306 406 to 405 305 to,
304 404 to 403 303 to 302 502 to -1 ,,
,
pfeth align create 708 717 to 617 609 to,
509 515 to 415 409 to 309 313 to 213 208 to,
308 608 to 607 707 to 706 606 to 605 604 to,
704 700 to 600 300 to 301 307 to 507 506 to,
406 405 to 505 504 to 404 403 to 603 601 to,
501 401 to 402 502 to -1 ,                    


the stack node abuts the memory driver. note t
hat it includes x@ and friends.
br

psht is placed so it falls into x! br

'name denotes vm instructions cr
others are internal words br

the external data stack grows downward, using
pre-dec writes post-inc reads.
cr
the internal stack holds the vm stack pointer
and cached
s and t br

16-bit words are 00.nnnn.nnnn.nnnn.nnnn       

   374 list
pf.16 stack 0 org
'1+
w-w 00 1 . + -cr  mask w-w 02 FFFF and ;
'2/
w-w 04 2* 2* 2/ 2/ 2/ mask ;
popt
p-pt 06 dup '1+ over x@ ;
'au!
pst-p43 08 x!
popst
p-pst 09 popt
pops
pt-pst 0A push popt pop ;
pop43
pst-p43st 0C push push popst pop pop ;
'1-
w-w 0E -1 . + mask ; 11 here 37 org
psht
pt-p 37 push '1- pop over x! ; 39/2 * org
pshs
pst-pt 11 push psht pop ;
pshw
pstw-ptw 13 push pshs pop ;
'sp!
ptp-pst 15 pshs popst ;
'drop
pst-p3s 17 drop pops ;
'over
pst-pts 18 over pshw ; br

sco x3 19 2* -if cr
code.sx x4 1A 2* up 145 -until -d-- ; cr
code.sm x4 1D then drop push ; 1E br

3 words to recover! 21 org                    


notes- indent
  
the initial sp is reset by cold indent
  
code must fit before block 740's psht inden
t
  
some optimizations are commented out cr
so as not to lose the code for use later when/
if some code is put in rom.                   

   376 list
- stack cont'd
'dup
pst-ptt 21 dup pshw ;
'swap
st-ts 22 over push push drop pop pop ;
'2*
w-w 24 2* mask ;
'or
pst-p3w 25 over - and
'xor
pst-p3w 26 or pops ;
'and
pst-p3w 27 and pops ;
'neg
n-n 28 '1-
'inv
w-w 29 begin - mask ;
'zeq
w-f 2A until begin dup or ;
'zlt
n-f 2C 2* 2* -until dup or 'inv ;
'um+
uu-uc 2E + 10000 over and if or 1 ;
'nop
33 then begin ;
'qdup
pst-pst/ptt 34 until
'-
pst-p3n 34 'neg
'+
pst-p3n 35 + mask pops ; cr
37 1700 bin                                   


the return stack pointer 'r', top of return st
ack 'i', and vm instruction pointer 'p' live o
n the stack of the bitsy node. in stack pictur
es . shows return stack on right.
br

                                              

   378 list
pf.16 bitsy 0 org
'else
-cr  bx@ a-w 00 @p !b !b . / @p x@ / cr
@p !b @b ; / !p . . . /
bx!-
aw-a' 04 @p !b !b dup / @p . . . / cr
@p !b !b . / @p x! /
dec
a-a' 08 -1 . + ;
@2tos
a- 0A bx@
bpshw
w- 0B @p !b !b ; / @p pshw /
'rp@
rip-rip 0D push over bpshw pop ;
'lit
rip-rip' 0F dup @2tos
inc
a-a' 10 1 . + ;
'con
rip-rip 12 bx@
'var
rip-rip 13 dup bpshw
'exit
rip-r'i'p' 14 drop push
popi
r.p-r'ip 15 inc
geti
r.p-rip 16 dup bx@ pop ; br

bpopw -w 18 @p !b @b ; / !p pops /
'tor
rip-rip 1A push bx!- bpopw pop ;
'r@
rip-rip 1D over bpshw ;
'rfrom
rip-rip 1E push bpshw popi ;           


the bit-threaded code technique confines execu
tion to the
bitsy loop and a small number of c
ode words. pseudo-instruction format is
br

xx.0aaa.aaaa.aaaa.aaaa high level call cr
xx.100x.xxaa.aaaa.aaaa xt in stack node cr
xx.1010.xxaa.aaaa.aaaa xt in stack up cr
xx.1011.xxaa.aaaa.aaaa xt in stack down cr
xx.110x.xxaa.aaaa.aaaa xt in bitsy cr
xx.1110.xxaa.aaaa.aaaa xt in bitsy up cr
xx.1111.xxaa.aaaa.aaaa xt in bitsy down br

this version uses sco in stack node to decode
all its instructions.
br

7 word decode for stack node cr
code.s rix3 28 then 2* -if cr
code.sx rix4 29 @p !b !b . / @b sco / drop ; c
ode.sm
2C then drop 1A000 or !b ;             

   380 list
- bitsy cont'd
'exe
rip-rip 20 bpopw
xxt
ripx-rip 21 dup 2* 2* -if cr
code ripx2 23 2* -if cr
code.b ripx3 24 2* -if cr
code.bx ripx4 25 2* up 145 -until -d-- ; cr
code.bm ripx4 28 then drop push ; cr
code.s ripx3 29 then @p !b push . / @p @p . .
!b pop !b .. @p !b ; ..
/ sco .. cr
hi rix2 2E then drop push push bx!- pop pop ;
run
rip-rip 31 dup bx@ push inc pop xxt run ;
cr
'if rip-rip' 35 bpopw if drop inc ; cr
then drop bx@ ;
'rx?
39 @ bpshw ;
'tx?
3A @p !b @b . / !p . . @p / ! @ !b ;
'rp!
rip-rip 3D push bx!- bpopw geti ; cr
40 1703 bin                                   


idle main program of coprocessor nodes. feeds
owner instruction to give us the vm opcode and
executes it.
cr
opcodes must return to idle when done. cr
port code for owner must end with return. br

ex@ and friends cost 10 words, two more than t
he
8 which they took in the stack node.
'mk!
msk f 0 inverts 0 so ex! can do the work.
'sus
suspends vm waiting for stimulus.        

   382 list
stack down bxxx 6 node 0 org
xqt
00 @b push ex
idle
01 @p !b xqt ; / drop !p . . / 03 br

''s 03 @p !b @p . / pshs / psht / cr
!b @p !b ; / dup pops ; 08 br

43xp op 08 @p !b !b . / pop43
pops;
0A @p !b ; / pops ;
'ex@
pst-p3w 0C @p !b pops; ; / ex@
'ex!
pst-p54 0E @p 43xp ; / ex!
'cx?
pst-p5f 10 @p 43xp ; / cx?
'mk!
pst-p54 12 @p 43xp ; / - ex!
'sus
14 @p !b ; / @b drop ;,
16 1701 bin                                   


                                              

   384 list
                                              


idle main program of coprocessor nodes. feeds
owner instruction to give us the vm opcode and
executes it.
cr
opcodes must return to idle when done. cr
port code for owner must end with return. br

                                              

   386 list
stack up axxx 206 node 0 org
xqt
00 @b push ex
idle
01 @p !b xqt ; / drop !p . . / 03 cr
br

start 03 up b! idle ;
free
05 @p !b pop ; / . ; .. br

07 1702 bin exit
who
07 @p !b @b @p / !p @p ; / 206 , + !b ;   


                                              

   388 list
                                              


idle main program of coprocessor nodes. feeds
owner instruction to give us the vm opcode and
executes it.
cr
opcodes must return to idle when done. cr
port code for owner must end with return. br

'next length is 12 vs 4 or 5 in bitsy, argh.  

   390 list
bitsy down fxxx 5 node 0 org
xqt
00 @b push ex
idle
01 @p !b xqt ; / drop !p . . / 03 br

'next 03 @p !b @b . / push dup !p . / cr
push zif @p !b @p . / drop inc / dup bx@ cr
!b @p !b ; / pop inc ; / then cr
pop @p !b @p / dec / pop bx@ ; / !b drop ;,
0F 1704 bin                                   


                                              

   392 list
                                              


idle main program of coprocessor nodes. feeds
owner instruction to give us the vm opcode and
executes it.
cr
opcodes must return to idle when done. cr
port code for owner must end with return. br

                                              

   394 list
bitsy up exxx 205 node 0 org
xqt
00 @b push ex
idle
01 @p !b xqt ; / drop !p . . / 03 br

start 03 up b! idle ;
free
05 @p !b pop ; / . ; .. br

07 exit
no-op
03 @p !b ; .. / ; .. 05
upop
05 @p !b ; .. / bpopw 07
upsh
07 @p !b ; .. / bpshw 09
uin
09 -n @p !b @b ; / !p .. 0B
uout
0B n @p !b !b ; / @p .. 0D
uid
0D upop uin 205 . + uout upsh no-op ;,
14 1705 bin                                   


                                              

   396 list
                                              


notes- indent
  
tx is inverted for compatibility with the b
oot node conventions, i.e. mark hi, space lo,
data1 lo, data0 hi, start hi, stop lo.
br

putchar takes a clean inverted octet and trans
mits it low bit first via p17.
br

wait suspends while waiting for inverted chara
cter or a new delay value.
cr
indent
  
the first terminal operation must set cr
the delay! indent
  
send and send/ test the bit timing using ex
ternal loop-back.                             

   398 list
serial transmit 100 node 0 org
!bit
im-i 00 over and cr
if 0 dumb 25555 maxim 35555 !b drop ; cr
then 1 dumb 35555 maxim 25555 !b drop ;
putc
dc-d 05 -
putchar
di-d 06 FF or 2* cr
9 for 0A 1-start, 8-data, 1-stop bit indent
  
1 !bit 2/ over for . unext cr
next 0E drop weak-pulldown 15555 !b ; br

0F 20 org programmed with abandon
start
io b! right a! 2400 est. 115200 baud cr
stopbit state dumb 25555 maxim 35555 !b
wait
d-.d 27 @ -if tx! putchar wait ; indent
  
then !io up a! ! .. @ right a! wait ; br

send cd 2F over putc send ;
send/
d 31 40 begin dup push putc indent
  
pop 1 . + 5F and end,
3A 1706 bin                                   


notes- indent
  
rx is inverted for compatibility with the b
oot node conventions, i.e. mark hi, space lo,
data1 lo, data0 hi, start hi, stop lo. receive
d characters may have one stop bit.
br

getchar called after seeing leading edge of st
art bit. returns clean inverted character. mus
t be called before start bit begins!
br

baud space is 1...1'0010.0000'0 indent
  
stop bits ---' .hex..20. '--- start br

idle                                          

   400 list
- receive 200 node 28 org
@bit
cm-c @b - over - and push and pop or ;
getc
d-dc 2B dup begin drop @b -until
getchar
dx-dc 2D over 2/ for . unext 1/2 bit 8
for
1-start, 8-data, 1-stop bits indent
  
1FFFF @bit 2/ over for . unext cr
next 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ FF and ; br

baud n-dd 3A if dup ; then - push cr
3D/2 begin @b . -until at start-bit of space,
3E begin @b - -until at 1-bit cr
3F begin @b . zif then . -until at 0-bits cr
41 begin @b - zif then . -until stop-bit cr
pop - n dup 2/ . + 1.5n dup ; br

auto 46 a push up a! @ baud ! pop a! dup !
idle
d 4C @b -if getchar - indent
  
@b 2* - -if over ! then drop drop idle ; th
en
200 and .. if auto ; then drop idle ; br

58 20 org programmed with some abandon
start
io b! 5555 !b right a! 2400 idle ;,
27 1707 bin                                   


notes- indent
  
idle is a polling loop waiting for cr
right reading - rx? returns 16-bit inv indent
  
character from recv queue or 0 if indent
  
queue is empty. cr
right writing - do tx! for 16-bit inv indent
  
character or iox for 16-bit pos indent
  
bit delay input. cr
indent
  
tx! returns the 16-bit inv character when t
he xmit queue is full and
0 otherwise. cr
indent
  
iox suspends until it puts the 16-bit pos b
it delay
in the xmit queue and again while it
discards any
inv characters in the recv queue
before the new
pos bit delay arrives.         

   402 list
- interface 104 node 20 org,
programmed with abandon
start
io b! right a! ahead
rx?
24 400 and .. if avail up a! @ then
rtn
w- 29 FFFF and right a! !,
idle 2D then @b 2* .. ' rx? -until,
...
not read 2* ' idle -until,
...
write @ 2* 2* 2/ 2/ .. -if
tx!
c- 33 @b 1000 and if full drop rtn ;,
...
room then left a! over ! rtn ;
iox
c- 3A then left a! !,
...
up a! begin @ - -until - rtn ;,
40 1708 bin                                   


background nodes are filled by default with,
ganglia, routing code in 20 to 3F thus they,
may support either ide or neural messaging,
until node is programmed some other way.,
,
routing directions are geographic.,
...
coded direction rlud 0123,
,
four bins hold node orientations...,
...
1716 100 ..1717 101,
...
1714 000 ..1715 001,
,
routing note- step count is relative to the no
de first receiving one of these messages. if
,
all counts zero will deliver to its neighbor,
in direction indicated by two lsb of path. a,
turn to deliver to right neighbor of turner is
not expressible
because whole field zero.,
third run must never have count 8 or more!    

   404 list
generate ganglia,
,
700 node 20 org reclaim,
rlud r--- --l- ---u -d-- 2 fh load,
1716 bin 40,
,
701 node 20 org reclaim,
rlud --l- r--- ---u -d-- 2 fh load,
1717 bin 40,
,
600 node 20 org reclaim,
rlud r--- --l- -d-- ---u 2 fh load,
1714 bin 40,
,
601 node 20 org reclaim,
rlud --l- r--- -d-- ---u 2 fh load,
1715 bin 40                                   


ganglia route messages much like chuck's 'sea'
delivers exchanges of
1 or more word out and,
1 or more word reply to arbitrary nodes with,
source routing. message structure is...,
,
..
focus call to port always there,
....
pump call interganglion only,
....
path see below inter only,
....
reply count words-1 inter only,
....
payload count words-1 inter only,
..
payload always there,
..
reply always there,
,
path has 3 6-bit runs low order taken first,
run encoded nnnndd path has 3 runs,,
...
2-bit direction rlud 0123,
...
4-bit count 1-relative zero deliver immed,
......
3rd run must be lt 8,
example from 708 to 617 go down 1 and right 8,
...
8 0 1 3 packed as 807 in octal.,
,
when an exchange is finished all,
ganglia are back where they were,
on receipt of focusing call.                  

   406 list
- ganglion template,
,
a whence b whither,
msg is focus call path cin-1 cout-1 code,
,
20 org rlud r--- --l- ---u -d--
aim
24 p-pa dup 3 and 20 or b! @b dup b! !b,
@p ; / pump leap
whither
2A p -4 . + aim !b path !b,
cnts @ dup push !b @ dup push !b
payload
30 begin @ !b unext,
...
begin @b ! unext ;
/8
32 n-n 2/ 2/ 2/ ;
pump
33 then pop a! @ dup
turn
pp 3C and if drop whither ; then,
...
drop dup FC0 and if drop /8 /8 dup turn ;,
then drop aim cnts @ push @ push payload ;,
40                                            


to activate snorkel wait till mmptr zero then
write addr of a
sequence/x to it and stim.,
mmptr zeroed after stim and you may queue 2nd
x
by writing and posting another stim. mmptr,
defined in idle, 2 for node 108, 4 for 207.,
,
x has 2 wd port address followed by one or mor
e
function/arg groups. all x*must*be in bottom
64k of memory!
,
,
function/arg group is 1 word jump adr in snork
followed by
args if any. funcs are...,
x/r 16/18 count18, adr20,
fin done-flg awaken?,
,
if focusing call desired it must be first word
in first transmit.
nothing about this code,
depends on using ganglia ... can source ide or
any other reasonable protocol including direct
stream or ad hoc node to node transfer.       

   408 list
- snorkel reclaim 207 node 0 org
mk!
fp'm
/!
an-a 00 push dup - !b over - !b pop !b ;
a+
03 ap-ap+ push 1 . + 10000 over and if,
...
or 1 then pop . + ;
+@
0B a-an a+*/@ 0C a-an dup !b over !b @b ;
@w
0E a-a'u /@ 7 for 2* 2* unext,
...
push +@ pop or ;
dma
14 x/r a+ @w push +@ push +@ pop begin,
...
pop pop dup push over push push drop ex,
next pop drop drop drop func +@ push ;
x16
20 x dma /@ ! a+ ;
r16
23 x dma @ /! a+ ;
x18
26 x dma @w ! a+ ;
r18
29 x dma @ dup push 7 push,
...
begin 2/ 2/ unext 3 and /! a+ pop /! a+ ;
fin
33 x dup /! +three dup - 8000 mk!
idle
37 begin @b 2 4 dup dup or /@ until,
...
push dup /! pop over @w a! func +@ push ;,
40 1605 bin reclaim exit                      


timing roughly 53 ns 19.2 mhz read clock,
clk low 16.5 ns 30. mhz so this is good for,
all sst25wfxxx parts as well. with mk1 sram,
we get 555 us block read time.,
,
registers b-io a-boss t-delay r-cmd. command,
stream starts with dly and then funcs...,
,
done deselect and end operation.
null
does so after sending a dummy byte in.
cmd
selects and pumps a command
out
given nbyt-1 sends nbyt bytes to device.
bytin
given nbyt-1 receives nbyt bytes from,
...
the device and ends operation.
wout
given nwds writes nwds 16-bit words to,
...
the device in aai mode. used immed after,
...
address, should be followed by wrdi rdsr.,
,
slowin given nbyt-1 receives nbyt bytes from,
...
the device. used for slow mmc.             

   410 list
spi flash sst25wf080 reclaim 705 node 0 org
entry
00 pop a! delay @
nxt
01 d-d @ push ex . nxt ;,
,
null 03 d dup !
done
04 d -++ !b await ;
cmd
07 d dup select
out
08 d @ for @ 2* 2* 8obits zif,
...
drop pop drop ; then 8obits drop next ;
byte
10 d-dw dup dup or
+byte
11 dw-dw 7 push begin begin,
...
--- !b --+ !b . @b -while,
......
drop - 2* - next ; then drop 2* next ;
bytin
1E d @ for byte zif ! done ;,
...
then +byte ! next done ;
wout
25 d @ push .. zif begin,
..
select 2B400 8obits drop swap then,
....
@ 2* 2* 8obits 8obits drop select dup,
......
begin drop @b -until drop next null ;
slob
33 d-dw dup dup or
+slob
34 dw-dw 7 push ibits ;
slowin
37 d @ for slob zif ! done ;,
...
then +slob ! next done ;,
3E 1606 bin reclaim                           


minimal code but slow; timing roughly 64 ns or
15.4 mhz read clock, low
31 ns; write 76 ns or
13.2 mhz. when delay is zero. addl delay about

4
ns per count.,
command stream starts with dly and then funcs,
,
done deselect and end operation.
null
does so after sending a dummy byte in.
cmd
selects and pumps a command
out
given nbyt-1 sends nbyt bytes to device.
bytin
given nbyt-1 receives nbyt bytes from,
...
the device and ends operation.             

   412 list
minimal spi reclaim 705 node 0 org,
working before speed up
entry
00 pop a! delay @
nxt
01 d-d @ push ex . nxt ;,
,
null 03 d dup !
done
04 d -++ !b await ;
cmd
07 d dup select
out
08 d @ for @ 2* 2* 8obits zif,
...
drop ; then 8obits drop next ;
byte
10 d-dw dup dup or
+byte
11 dw-dw 7 push ibits ;
bytin
14 d @ for byte zif ! done ;,
...
then +byte ! next done ;,
1B 1606 bin reclaim                           


                                              

   414 list
                                              


                                              

   416 list
                                              


                                              

   418 list
                                              


- load screen for pf boot stream via async,
,
panel is just to set us know it's finished,
,
the ide is left working so make a new 2 chip,
ide path and hook to node 10600 to prove,
it works                                      

   420 list
2 chip async bootstream demo,
empty compile streamer load framer load,
async*frame AE fram ; 2chip,
the stream 2 fh load stream -an,
,
serial load -canon 0 fh orgn !,
a-com sport ! a-bps bps ! !nam,
2chip talk send,
,
new ide path 220 load !b0,
0 10600 hook panel                            


-
sram1
path just to load sram driver and data,
,
read nucleus to get word count from address 0,
,
construct a boot header by hand to send the,
nucleus down to loader in node 108 ,,
commented exit would allow reading and writing
sram via the ide for testing
,
,
rest of nodes are loaded,
,
note if you want to use the ide after sending
you need to load bin
1600 into node 708       

   422 list
- generate stream
brdg
align create 708 700 to 600 300 to -1 ,,
brdg course,
708 +node 1600 /ram AE /p,
500 +node 1904 /ram 5 /a io /b down /p,
400 +node 1907 /ram down /b up /a 0 /p,
300 +node 1901 /ram 19 /p,
frame,
,
app align create 708 700 to 600 400 to,
..
10400 10600 to 10601 10616 to,
..
10617 10717 to -1 ,,
fresh app course,
708 +node 1600 /ram AE /p,
frame,
                                              


- load screen for pf boot stream via async,
,
build a 2 chip bootstream rooted at node 708,
leaving address and count on stack,
,
load serial ide and modify it to send a stream
straight to the serial node
,
,
reset host via talk and send the stream,
,
the ide is left working so make a new 2 chip,
ide path and hook to node 10600 to prove,
it works                                      

   424 list
async pf bootstream with bridge,
empty compile streamer load framer load,
async*frame AE fram ; 2chip,
the stream 2 fh load stream -an,
,
serial load -canon 0 fh orgn !,
a-com sport ! a-bps bps ! !nam,
2chip talk send,
,
new ide path 220 load !b0,
0 10600 hook panel                            


-
sram1
path just to load sram driver and data,
node 0 must be carefully loaded along with,
sram or not reachable,
,
read nucleus to get word count from address 0,
,
construct a boot header by hand to send the,
nucleus down to loader in node 108 ,,
commented exit would allow reading and writing
sram via the ide for testing
,
,
rest of nodes are loaded,
,
note if you want to use the ide after sending
you need to load bin
1600 into node 708       

   426 list
- generate pf stream,
,
sram1 align create,
..
708 108 to 107 100 to 0 9 to -1 ,,
sram1 course sram driver sram 2 + load,
odd one 0 +node,
ide 708 +node 1600 /ram AE /p,
sram loader 436 load frame,
read nucleus 434 load @nuc,
header 100AE !18 down !18 fbuf t@ 2 + !18,
..
drop !nuc exit to test sram working,
,
bridge to target
brdg
align create 708 701 to 700 300 to -1 ,,
fresh brdg course,
708 +node 1600 /ram AE /p,
400 +node 1907 /ram down /b up /a 0 /p,
500 +node 1904 /ram 5 /a io /b down /p,
300 +node 1901 /ram 19 /p frame,
,
path covering both chips 2 fh load,
fresh entire course,
rest of chip pf 2 + load,
ide 708 +node 1600 /ram AE /p frame,
                                              


                                              

   428 list
-- path both chips
entire
align create 708 716 to 717 17 to,
..
16 10 to 110 116 to 216 209 to 109 108 to,
..
208 207 to 307 316 to 416 407 to,
..
507 516 to 616 607 to 707 706 to,
..
606 6 to 5 705 to 704 4 to 3 103 to,
..
102 2 to 1 101 to 100 200 to 201 203 to,
..
303 703 to 702 302 to 301 701 to 700 400 to,
..
10400 10700 to 10701 10717 to 10617 10601 to
..
10501 10517 to 10417 10401 to 10301 10317 to
..
10217 10200 to 10100 10117 to 10017 10000 to
..
-1 ,                                        


- load screen for pf boot stream via async,
,
panel is just to set us know it's finished    

   430 list
install pf via async bootstream,
empty compile streamer load framer load,
async*frame AE fram ;,
the stream 2 fh load stream -an,
,
serial load -canon 0 fh orgn !,
a-com sport ! a-bps bps ! !nam,
talk send panel,
,
test exit
s1+
nm-mn' swap 1 + ; sm 454 load
spa
align create 708 108 to -1 ,,
spa 'pths 1 + ! 1 108 hook panel              


-
sram1
path just to load sram driver and data,
,
read nucleus to get word count from address 0,
,
construct a boot header by hand to send the,
nucleus down to loader in node 108 ,,
commented exit would allow reading and writing
sram via the ide for testing
,
,
rest of nodes are loaded including 600 which,
toggles its pin for the scope , just a demo,
,
note if you want to use the ide after sending
you need to load bin
1600 into node 708       

   432 list
- generate pf stream,
,
sram1 align create,
..
708 108 to 107 7 to 8 9 to -1 , sram1 course
sram driver
sram 2 + load,
ide 708 +node 1600 /ram AE /p,
sram loader 4 fh load frame,
read nucleus 2 fh load @nuc,
header 100AE !18 down !18 fbuf t@ 2 + !18,
..
drop !nuc exit to test sram working,
,
fresh sram 4 + load s708 course,
rest of chip pf 2 + load,
ide 708 +node 1600 /ram AE /p frame,
                                              


- nucleus in file pf/pfdisk.blk is read into a
buffer on the host ,
,
,
!img uses t@ to transform nucleus into correct
byte order and bits per word while sending it
through the serial interface via the ide's !18

   434 list
-- read pf nucleus ft 0 chr 9216 0 chr !
a-b
a-b 2* 2* ;*b-a b-a 3 + 2/ 2/ ;
allot
h +! ;*buffer pop ;
fbuf
align buffer 9216 allot
+pf
0 fnam b-a r/o fopen if ft ! ;,
..
then drop abort ;
-pf
ft @ 0 + if fclose 0 then ft ! ;,
,
macro,
2@ b-h 8B66 3, ;*swab h-h C486 2, ; forth
t@
a-an dup 2@ swab FFFF and ;
@nuc
+pf fbuf 9216 ft @ frd chr ! -pf ;
!img
nc push fbuf begin t@ !18 2 +,
..
next drop ;
!nuc
fbuf t@ 2 + !img drop ;,
,
named pf/pfdisk.blk                           


- wire passes word count and data down,
to loader in node 108                         

   436 list
-- load polyforth nucleus,
/nwire in out /b /a 0 4 1711 /part 0 /p ;,
608 +node down up /nwire,
508 +node up down /nwire,
408 +node down up /nwire,
308 +node up down /nwire,
208 +node down up /nwire,
108 +node 1713 /ram left /b 0 /p              


                                              

   438 list
                                              


                                              

   440 list
                                              


                                              

   442 list
                                              


                                              

   444 list
                                              


minimal version of plumbing for sram boot from
flash. wires are compiled only once and are
,
initialized with source port in a and dest,
port in b.,
,
message consists of word count n-1 followed by
n words to be passed along.
,
,
node 108 now loads the image received from,
flash into sram. 208 is just another wire,
,
however, the generic sram interface code is,
compiled at the usual place anyway, so this,
bin can be used by both the streamer and the,
ide                                           

   446 list
- sram loader nodes,
,
wires 605 node 0 org
wire
b! a! @ dup !b for @ !b unext warm ;,
04 1711 bin,
,
sram loader node 108,
108 node 39 org 278 load,
0 org*start 00 up a! left b!,
0 @ dup push over x!,
begin 1 . + @ over x! next warm ;,
0D 1713 bin                                   


start 1st word read is count in words         

   448 list
- spi flash 8 bits 705 node 0 org host
resume
nnc 2 * 8000 + block @ FFFFF and indent
  
18 8 */ 4 * lit ; target
wait
dw-dw 00 select dup begin drop @b -until
drop select ;

2cmd
dw-d 04 select 8obits
cmd
dw-d select
!8
dw-d 8obits drop ;
set
-d 09 io b! fast 5 ;
fet
ah al-d 0C push push set read C00 cmd pop
!8 pop 8obits !8 ;

16ibits
d-db 12 dup 15 for cr
rbit ibit - next FFFF and ;
start
19 down a! 0 20000 fet cr
16ibits dup ! for 16ibits ! next indent
  
resume fet 18ibits 1E000 . + - -if
done
io b! 20 20 -++ half warm ; then cr
5 resume push spicmd spi-boot ; cr
34 1710 bin                                   


customize ide for polyforth development. br

pf loads polyforth f18 code, nucleus in sram,
and starts it up.
br

***no canonical opcodes*** cr
use the 'remote' ones                         

   450 list
polyforth ide boot host bridge load,
...
loader load,
kill boots 0 708 hook 0 -hook
s1+
nm-mn' swap 1 + ;,
,
custom routes 2 fh load sram 4 + load,
select pfp0 'pths ! pfp1 'pths 1 + !,
...
s708 'pths 2 + !,
vm build tools 4 fh load 14 fh load,
,
sram 6 fh load 1 ship,
!img n push fbuf 0 begin over 2@ swab,
over sm swap 2 + s1+ next drop drop ;
!nuc
chr @ 2/ 1 + !img ;,
...
1 108 hook !nuc .unfoc 1 -hook,
,
rest pf 2 + load .2 ship .panel upd ?ram,
                                              


paths 0 and 1 are customized for interactive d
evel and testing of polyforth.
,
,
pfp0 is not used by the loading procedures and
is available for detailed application testing.
if more paths are needed in testing, stuff new
path vectors after
pf is loaded.,
,
pfp1 is used after reset to load and start the
sram cluster, then boot sram as needed.       

   452 list
- custom ide paths,
,
pfp0 align create 708 707 to 607 207 to,
206 205 to -1 ,,
,
pfp0 align create 708 308 to 309 315 to -1 ,,
,
pfp1 align create sram 708 108 to 107 7 to,
8 9 to -1 ,                                   


this tester code assumes the ide is hooked to
one of the sram user nodes.                   

   454 list
- sram user code from nodes 106, 108, 207
2lit'
nn- swap lit' lit' ;
sm
wa- 2lit' 39 x! call ;
sem
wap- push 2lit' pop lit' 3A ex! call ;
fm
a-w lit' 3C x@ call
get
-w upd stak @ rdrop ;
fem
ap-w 2lit' 3D ex@ call get ;
4lit'
nnnn- push push 2lit' pop pop 2lit' ;
cxm
wapw-f 4lit' 3E cx? call get ; cr
cr
sram test code
fmem
ap-... 8 for push dup i fem indent
  
s1+ pop next drop drop ;
smem
wapn- for push over over i sem indent
  
s1+ s1+ pop next drop drop drop ;
n2x
wapn- 4lit' 42 n2x call ;
nqx
wapn- 4lit' 4A nqx call ; br

                                              


load sram cluster for booting pf nucleus br

this is done with ide path 1 from 708 down to
108
before any of the rest of the chip is set
up.
br

after it's completed, the whole rest of the ch
ip can be booted using the serpentine path 2.
this relatively byzantine method is used inste
ad of simply reloading the sram with a more re
gular path so that the methods will still work
with external dram.
br

this block leaves path 1 connected to sram for
use by !pf                                    

   456 list
- ph0 sram setup br

kill boot nodes 2 2 hook 2 -hook 1 path br

sram setup sram 2 + load br

temporary 108 +node 1713 /ram left /b         


                                              

   458 list
                                              


pf stream br

two passes required to calculate address cr
to resume booting from after loading sram cr
and compile it into node 705                  

   460 list
install pf in flash,
,
empty 1st pass compile streamer load cr
framer load the stream 466 load br

empty 2nd pass compile streamer load cr
framer load the stream 466 load br

.stream cr
write stream into flash cr
display stream length strlen leng !,
stream 0 swap 18burn,
ask permission to burn nucleus as well
esc
key? esc ;
?cont
esc keych @ 0 keych !,
...
7F and 20 or drop if noask exit ; then ;,
.cont pause ?cont,
...
erase and burn nucleus 462 load            


load this block to install polyforth for flash
booting. just follow instructions.
,
,
burns nucleus to flash starting at 32k then,
generates and burns full chip boot stream.    

   462 list
- burn pf nucleus,
empty compile streamer load,
.nucleus nores,
,
read pfdisk.blk 464 load,
...
fbuf source ! 4607 len !,
display nuc length,
...
len @ 1 + 2 * 8 18 */ leng !,
,
...
burn nucleus stream 8000 swap burn         


                                              

   464 list
-- read pf nucleus ft 0 chr 9216
a-b
a-b 2* 2* ;*b-a b-a 3 + 2/ 2/ ;,
fbuf -a nnc 2 * 8000 + block a-b ;,
,
+pf 0 fnam b-a r/o fopen if ft ! ;,
then drop abort ;
-pf
ft @ 0 + if fclose 0 then ft ! ;,
,
@nuc +pf fbuf 9216 ft @ frd chr ! -pf ;,
,
named pf/pfdisk.blk,
,
@nuc                                          


                                              

   466 list
- generate pf stream br

speedup indent
  
0 0 3 1608 /root br

default entire course cr
sram driver sram 2 + load,
flash to sram 2 fh load,
frame adjust resume point,
,
fresh residual sram 4 + load s705 course,
...
rest of chip pf 2 + load,
,
frame                                         


                                              

   468 list
-- load polyforth nucleus,
/nwire in out /b /a 0 4 1711 /part 0 /p ;,
,
705 +node 1710 /ram 19 /p,
605 +node down left /nwire,
606 +node left right /nwire,
607 +node right left /nwire,
608 +node left up /nwire,
508 +node up down /nwire,
408 +node down up /nwire,
308 +node up down /nwire,
208 +node down up /nwire,
108 +node 1713 /ram left /b 0 /p              


                                              

   470 list
                                              


                                              

   472 list
                                              


                                              

   474 list
                                              


                                              

   476 list
                                              


                                              

   478 list
                                              


                                              

   480 list
g144a12 ats test components br

pkg 2000 to 2017 482 18 loads cr
pkg 2100 to 2117 518 18 loads cr
pkg 2200 to 2208 554 9 loads br

ats/ide parts 1200 to 1206 630 7 loads br

steven mem-random xxxx 576 1 loads cr
1400 to 1400 648 1 loads                      


port tests
bit
send and receive 1 bit pattern via port
walk
test with pattern shifted left 18 times
tst
focus neighbor with a call then cr
walk with 1 bit set and 1 bit clear cr
shifting left on the test node
release
causes node under test to return . cr
error code 0 for success , cr
loop index for failure cr
parameter is ignored br

tests on single neighbor and on pairs cr
address 4 tests the tfocused neighbor cr
13 tests the right neighbor cr
10 tests the down neighbor cr
16 tests the left neighbor cr
19 tests the up neighbor cr
15 tests the down and left neighbors cr
12 tests the down and right neighbors cr
18 tests the right and up neighbors cr
F tests the right and down neighbors          

   482 list
2000 port tests cr
creeper reclaim 0 node 1344 load 1B org
release
1B @p ! ; / ; /
bit
1D n-nn @p ! dup dup / @p !p .. / cr
! @ or ;
walk
20 n 17 for bit if pop !b pop cr
release ; then drop 2* next drop ; cr
28 4 org -cr  ftst a 1FF and 13400 or
tst
08 cport dup a! ! cr
15554 dup walk dup - walk release dup or !b ;
trd
0F leap tr -cr  td 10 @p tst ; -d--
tdr
12 td -cr  tr 13 then @p tst ; r---
tdl
15 td -cr  tl 16 @p tst ; --l-
tru
18 tr -cr  tu 19 @p tst ; ---u cr
1B 2000 bin                                   


port tests
bit
send and receive 1 bit pattern via port
walk
test with pattern shifted left 18 times
tst
focus neighbor with a call then cr
walk with 1 bit set and 1 bit clear
release
causes node under test to return . cr
error code 0 for success , cr
loop index for failure cr
parameter is ignored br

tests on single neighbor and on pairs cr
address 4 tests the tfocused neighbor cr
13 tests the right neighbor cr
10 tests the down neighbor cr
16 tests the left neighbor cr
19 tests the up neighbor cr
15 tests the down and left neighbors cr
12 tests the down and right neighbors cr
18 tests the right and up neighbors cr
F tests the right and down neighbors          

   484 list
2001 port tests with 2* cr
creeper reclaim 0 node 1344 load 1B org
release
1B @p ! ; / ; /
bit
1D n-nn @p ! dup dup / @p 2* !p .. / cr
! 2* @ or ;
walk
21 n 17 for bit if pop !b pop cr
release ; then drop 2* next drop ; cr
2A 4 org -cr  ftst a 1FF and 13400 or
tst
08 cport dup a! ! cr
15554 dup walk dup - walk release dup or !b ;
trd
0F -cr leap tr  td 10 @p tst ; -d--
tdr
12 td -cr  tr 13 then @p tst ; r---
tdl
15 td -cr  tl 16 @p tst ; --l-
tru
18 tr -cr  tu 19 @p tst ; ---u cr
1B 2001 bin                                   


test tests neighbor's memory br

tests the tfocused node node's ram. cr
apocryphal documentation follows br

19999 cccc test shorts to bits two bits away c
r
3ffff 0 test shorts to bits one bit away cr
tests for shorts between two addresses cr
by reading 64 words after each 3FFFF ! cr
                                              

   486 list
2002 extensive ram test jeff cr
creeper reclaim 0 node 1344 load 28 org
err
4 org
test
n1 @p ! @p dup ' 3F push dup dup cr
! @p ! ' or dup a! . cr
@p ! ' begin dup !+ unext .. 0B erased cr
for br

19999 @p ! dup ' @p ! @ . cr
! @p ! . ' !b @p ! cr
@ or if 12 pop err ; then 13 test1 cr
CCCC dup ! @p ' @ !b dup dup cr
! @ or if 18 pop err ; then 19 0 test2 cr
@p ! . ' or ! . erased br

drop @p ! @p ' dup 0 0 - 3FFFF ! 3E cr
! @p ! ' @+ !b push 0 cr
@ - if 21 pop err ; then 22 test3 cr
drop @p ! ' begin @+ !b unext . 0 cr
3E for @ if pop pop
err
28 1 + !b ; then 2A test4 cr
drop next cr
@p ! . . ' dup !+ . next erased cr
dup dup or !b ; 30 2002 bin                   


testing t and s br

intended to isolate testing to t and s cr
non-zero return value identifies bad bit br

address 4 tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success , cr
loop index for failure                        

   488 list
2003 testing t and s cr
creeper reclaim 0 node 1344 load 20 org
echo
20 n-n @p ! dup .. / @p - dup .. / cr
! @p ! .. / drop !p .. / - @ or ; 4 org
test
04 n 17 for dup echo cr
if pop 1 . + !b ; then drop 2* next cr
dup or !b ; 0E 2003 bin                       


testing t and s br

intended to isolate testing to t and r cr
non-zero return value identifies bad bit br

address 4 tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success , cr
loop index for failure                        

   490 list
2004 testing t and r cr
creeper reclaim 0 node 1344 load 20 org
echo
20 n-n @p ! dup .. / @p - push .. / cr
! @p ! .. / pop !p .. / - @ or ; 4 org
test
04 n 17 for dup echo cr
if pop 1 . + !b ; then drop 2* next cr
dup or !b ; 0E 2004 bin                       


testing stack registers br

fill the stack registers with unique cr
numbers and read them back. error code cr
identifies the register that failed the test.
br

address 4 tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success , cr
loop index for failure                        

   492 list
2005 testing stack registers cr
creeper reclaim 0 node 1344 load 6 org
put
n @p ! ! ; / @p .. /
get
-n @p ! @ ; / !p .. /
stack
0A 1 9 for dup put 2* next cr
9 for 2/ get over or if pop 1 . + !b cr
pop ; then drop next ; 18 4 org
start
n stack dup or !b ; 06 2005 bin         


testing return stack registers br

fill neighbor return stack with alternating cr
inverted patterns , then read back and verify
each pattern ; relies on
s and t of uut cr
and instructions @p !p push pop in the port br

address 4 tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success , 1 for failure br

comment - after fill to force failure         

   494 list
2006 testing return stack registers cr
creeper reclaim 0 node 1344 load 04 ahead
!error
n 1 !b ;
put
07 n @p ! ! ; / @p push .. /
get
09 -n @p ! @ ; / pop !p .. /
fill
0B n-n 8 for - dup put next ;
check
11 n-f leap - then fill - cr
9 for - get over or .. if !error pop ; cr
then drop next ;
test
n then 0 check 15555 check cr
.. 19999 check 33333 check cr
.. dup or !b ; cr
26 2006 bin                                   


worst case ram test looking for store failures
when driving weak inverter high.
this test pre
serves b, a, and p.
br

store makes target store next value in next wd
fetch
makes target return next word in ram
/stack
executed in either node sets stack to a
lternating
15555 and 2AAAA with 15555 on top.
/neighbor
feeds /stack to target node. doesn't
pass the last word - return.
br

go sets both nodes' stacks that way then begin
s the
testmem
testmem
runs test cycles, must do at least 2.
each cycle switches polarity
15555 or 2AAAA fo
r first word stored, then stores alternating v
alues into all ram in target. reads back and c
ompares. if all cycles run ok, returns zero st
atus. otherwise returns the
1 relative cycle n
umber in which the failure occurred.          

   496 list
2007 mark ram test 200 node cr
creeper reclaim 0 node 1344 load ahead
store
@p ! ; .. / !+ .. /
fetch
-n @p ! @ ; / @+ !b drop .. /
/neighbor
4 for @p ! unext ;
/stack
0C 15555 2AAAA dup - over over over cr
over over over over over over .. 11 ; br

go entry 12 then /neighbor /stack
testmem
14 3 65535 for cr
@p ! drop .. / dup or a! .. / cr
3F for store next 3F for fetch or if indent
  
pop pop 3 65535 or 1 . + !b ; cr
then drop next next cr
good 0 12345 !b ; 29 2007 bin                 


testing return and data stacks registers cr
also mulitple overs pops and pushes in the por
t
br

fill neighbor return stack with alternating cr
inverted patterns , then push to return stack
then pop to data stack then read back and veri
fy each pattern ; relies on
b s t r r-stack an
d
d-stack of uut cr
and instructions @p !b over push pop in the po
rt
br

address 2B
full
tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success , next count for fail
ure
br

comment - in /stack after over to force failur
e                                             

   498 list
2008 mark r d stack test cr
creeper reclaim 0 node 1344 load ahead
store
dup ! dup ! dup ! ! ;
fetch
-n @p ! @ ; / !b .. /
/neighbor
@p ! ! .. @p .. cr
3 for @p ! unext ; ..
/stack
dup - over .. / over over - cr
over .. / over over over .. / over .. / ;
t-stk
14 cr
dup /neighbor /stack 16 cr
FFFE 8 for cr
@p .. push push push .. store cr
fetch drop @p .. pop pop pop .. store cr
cr
9 for fetch or .. if pop pop FFFF and pop drop
!b ; then drop
cr
next next ; cr
then 2B 2B org
full
2B 2AAAA t-stk dup or t-stk 33333 t-stk 1
9999
t-stk dup or t-stk 0 dup or !b ; cr
36 2008 bin                                   


testing a shifts by +* br

tests the 4 combinations of shifting 1/0 cr
from t for add/notadd behavior of +* . the cr
19999 group checks the double shift error seen
previously ; relies on
s and t of uut cr
and instructions @p !p +* a a! in the port br

address 4 tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success , 1 for failure br

replace pattern before step with 0 cr
to force failure                              

   500 list
2009 +* a shift test cr
creeper reclaim 0 node 1344 load ahead
!error
n 1 !b ;
init
s @p ! ! ; / @p .. /
check
an-a over or if !error pop pop ; cr
then drop ;
step
tan-t'a' push .. cr
@p ! ! .. / @p a! @p .. / cr
! @p ! . / +* !p a !p / @ @ pop check ;
start
then cr
1 init 0 15555 2AAAA step 15555 step cr
...... 0 19999 2CCCC step 16666 step cr
2 init 0 15555 AAAA step 25555 step cr
...... 0 19999 CCCC step 26666 step cr
dup or !b ; cr
35 2009 bin                                   


testing t s a and r data paths br

does 32 reps of 8 patterns between t and cr
the other registers; relies on instructions cr
@p !p a! a push pop in the port br

address 4 tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success, address after cr
test for failure br

uncomment 2* in each test to force failure    

   502 list
2010 t s a and r data path tests cr
creeper reclaim 0 node 1344 load ahead
check
or if pop !b pop ; then drop ;
-t-
n dup @p ! .. / @p !p .. / ! @ 2* check ;
-s-
n dup @p ! dup / @p @p !p !p / cr
! ! @ drop @ 2* check ;
t-a
n dup @p ! .. / @p a! a !p / cr
! @ 2* check ;
t-r
n dup @p ! .. / @p push pop !p / cr
! @ 2* check ;
start
then 19 3FFFF dup - 2AAAA cr
dup - 33333 dup - 6666 dup - dup dup drop cr
256 for drop -t- 24 -s- 25 cr
............ t-a 26 t-r 27 next dup or !b ; 29
2010
bin                                      


drive test of a single gpio pin whose control
bits are nonzero in the argument.
br

while testing a pin any other pins are set at
high impedance so we can prove all three drive
transistors work for this pin and detect any o
pens. other tests look for shorts between pins

   504 list
2011 gpio pin test cr
creeper reclaim 0 node 1344 load ahead
!it
n 05 @p drop !p ;
its
n-n 06 0 and ;
++
08 -1 -cr  !io its ! ; -cr  -- 2AAAA !io ;
500ns
n 0E 199 for unext ;
.hi
-n 11 15 for @ its if cr
drop pop ; then drop next dup dup or ;
.lo
18 for @ 2AAAA and its while drop next cr
dup dup or ; then drop pop ;
start
n 20 then !it io a! cr
++ 500ns wpd 15555 !io 8191 .lo cr
-16 -- and 500ns ++ .hi or 500ns cr
2* -- 2* 2* 2* 15 .lo or !b ; cr
34 2011 bin                                   


testing data stack registers cr
also overs in the port br

fill neighbor return stack with alternating cr
inverted patterns , then read back and verify
each pattern ; relies on
b s t and d-stack of
uut
cr
and instructions @p !b over in the port br

address 2A
full
tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success , next count for fail
ure
br

comment - in /stack after over to force failur
e                                             

   506 list
2012 mark d stack test cr
creeper reclaim 0 node 1344 load ahead
fetch
-n @p ! @ ; // !b .. /
/neighbor
@p ! ! .. @p .. cr
3 for @p ! unext ; ..
/stack
0C dup - over .. / over over cr
over .. / over over over .. / over - . .. / ;
d-stack
11 8 for dup - /neighbor /stack 16 nex
t
cr
12 0 for drop fetch or if pop pop FFFF and !b
pop
and drop !b ; then cr
next ; cr
21 2A org then
full
2A 2AAAA d-stack dup or d-stack 33333 d-s
tack
19999 d-stack dup or d-stack cr
!b ; 35 2012 bin                              


testing io data path br

checks that the masked bits return their cr
inverse ; relies on a of uut cr
and instructions @p !p ! @ in the port br

address 4 tests the tfocused neighbor cr
parameter is a mask for the io bits cr
to be tested . error code 0 for success, cr
test's return address for failure br

include unwritable bits in the mask cr
to force failure                              

   508 list
2013 io data path tests cr
creeper reclaim 0 node 1344 load ahead
check
nn or if pop !b pop ; then drop ;
t-io
mn-m 15555 or dup @p / @p ! @ !p / cr
! ! @ or over and over check ;
start
m then 0E if 0 for cr
io @p ! .. / @p a! .. / ! cr
dup t-io 16 0 t-io 18 next then dup or !b ; 1A
2013
bin                                      


test p9 control of carry br

verify that neighbor carry can be set or cr
cleared under control of p9 and that carry is
preserved when p9 is zero.
br

depends upon uut p9 cry s and t as well as cr
uut jump @p !p . + in port. cr
test starts at 04 with loop count input. cr
12 words of ram are unused. cr
error code is ?t return address. cr
verify by defeating any ?t parameter. br

+@ calculate n+n in test node, returning c cr
then clear tested's p9.
+c
set p9 in test node prior to add.
?t
match result to expected and abort with cr
call address as return code in case of error.
note
that loop count will clear high r bits.  

   510 list
2014 set/clear carry test cr
creeper reclaim 0 node 1344 load br

2A org test tools
+c
2A n-c a 200 or !
+@
2D n-c @p ! dup . / . . . @p / cr
.. 2F ! @p ! . / @p . + !p / ! @ a ! ;
?t
33 c or if pop !b pop then drop ; 36 br

4 org test start cr
04 post args push 20000 0 begin cr
07 clr nxt dup +c ign was drop .. cr
09 set nxt over +c tst clr over ?t cr
0B set nxt over +c tst set 1 ?t cr
0E clr nxt dup +c tst set 1 ?t cr
11 clr nxt dup +c tst clr over ?t cr
13 nop nxt over +@ see nop over ?t cr
15 set nxt over +c tst clr over ?t cr
17 nop nxt dup +@ see nop over ?t cr
19 clr nxt dup +c tst set 1 ?t cr
1C next pass !b drop ; cr
1E 2014 bin                                   


testing @p br

does 64 reps of @p on target covering all ram
addresses; relies on target port instructions;

@p a! !+ dup or push ;
cr
relies on target ram instructions; cr
@p !b unext ; br

address 4 tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success, target address cr
for failure br

uncomment - to force failure                  

   512 list
2015 mark @p test cr
creeper reclaim 0 node 1344 load 04 ahead cr
seq -n 05 63 .. a push 6 a! cr
if dup -1 . + ! pop a! ; cr
then drop 63 ! pop a! @p!bunext; 5B75 ;
init
11 @p ! @p .. / @p a! .. / 1 , ! cr
63 for seq @p ! ! .. / @p !+ .. / next cr
@p ! a .. / @p push .. / cr
! @p ! @p / @p push .. / 63 , cr
! @p ! ; / dup or push ; /
/@p
n 21 then init cr
63 for @ seq - or .. if pop !b ; cr
then drop next dup or !b ; cr
2A 2015 bin                                   


test 8,5-0 of i and r to adrs bus br

verify adrs drivers for above bits in uut. cr
1. using a set @p ; n in ram, where n is cr
-- loc of same word. chk ram via b and cr
-- return error code 40+n if fail. cr
2. for n of 0-3f store call-n / !p .. into cr
-- port and read back and confirm that data cr
-- have the same low order 6 bits as the next
-- call we are to send. return error code
cr
-- 80+n if fail. cr
3. same as test 2 using ex instead of call cr
-- return error code c0+n if fail. br

test starts at 04 with ignored input. cr
depends upon uut a b r s t and ram as well as
uut
call ex ; @p !p . push dup a! b! ! @b in r
am or port.
br

failure is forced by uncommenting - in cr
each test                                     

   514 list
2016 test i-ad and r-ad data paths cr
creeper reclaim 2 node 1344 load br

test start cr
04 @p; 5500 63 for .. cr
07 pop dup push dup @p ! ! .. / @p dup a! @p 0
A
over or @p .. / ! b! @b !p / cr
0C over ! ! @ - or .. if pop 40 or !b ; cr
12 then drop next cr
13 a @p ! .. / @p b! .. / ! .. dup or !b ; cr
16 call 12000 63 for .. cr
19 dup ! 1 @p / !p .. / ! . + dup cr
1D @ - or 3F and if pop 80 or !b ; cr
23 then drop next dup or !b ; cr
24 ex 12040 dup 63 for .. cr
26 @p ! ! @p / @p push ex / 1 , cr
29 @p ! . + / !p .. / @ over - or 3F cr
2D and if pop drop C0 or !b ; cr
31 then drop dup .. next dup or !b ; br

34 2016 bin                                   


rom check sums br

does an xor checksum of the 64 target node rom
locations ; relies on instructions
cr
@p !p a! a in the port br

address 4 tests the tfocused neighbor cr
parameter is expected checksum cr
error code 0 for success, 1 for failure br

0 test to force failure                       

   516 list
2017 rom checksum cr
creeper reclaim 0 node 1344 load
start
n 04 0 63 for pop dup push 80 . + cr
@p .. / @p a! @ !p / ! ! @ or next cr
or if 1 then !b ; cr
11 2017 bin                                   


parallel port pin test br

walking ones test of parallel port pins in cr
nodes 7 and 9 , detects opens shorts and weak
drive transistors .
br

address 4 tests active node given arg which is
ending io value.
note purpose is to control wr
bit setting and if the bit does not work in ei
ther node the test will fail in one of em.
cr
error code 0 for success, cr
test's return address for failure br

force an 'open pad' failure by running cr
the test on node 9 of a chip with sram cr
connected br

force a 'short' failure by temporarily cr
connecting a pin to power ground or a cr
neighbor pin                                  

   518 list
2100 parallel port pin test cr
creeper reclaim 0 node 1344 load ahead
return
n pop dup b! push !b ;
chk
nn 07 or cr
if pop pop drop pop drop return ; cr
then drop ;
write
n 0C out 15555 !b ! ;
50ns
-n 0E 18 for unext ;
sample
-n 11 in 14555 !b .. @ out 15555 !b ;
300ns
-n 15 124 87 for unext sample ;
once
n-n' 18 cr
dup write 50ns 0 chk 1C 300ns over chk 1E cr
0 write 50ns over chk 22 300ns 0 chk 25 2* ;
start
n 26 then cr
0 data a! io b! write 300ns 0 chk 2E cr
1 17 for once next drop !b dup or return ; cr
35 2100 bin                                   


b-adr-data test; b-reg adr paths to ram and da
ta path from t to ram and ram to t using b-reg

br

uses !+ to fill ram with -1 to -40 cr
next uses b to change ram to 0 to 3f cr
next checks to see if ram successfully changed
; relies on instructions
cr
@p / @p b! / @b !p / @p push / dup or a! / cr
a - !+ unext / in the port br

address 4 tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success, cr
address + 1000 of failure for failure br

uncomment 3E and comment 3F in
init
to force failure                         

   520 list
2101 mark @b !b test cr
creeper reclaim 0 node 1344 load ahead
/t
05 n dup - .. / @p ! ! ; / @p .. /
/b!
08 n @p ! ! ; / @p b! .. /
/!b
0A n @p ! ! ; / @p !b .. /
/@b
0C -n @p ! @ ; / @b !p .. /
end
@p ! a . / @p b! .. / ! !b ;
init
11 then @p ! @p .. / dup or a! . 63 , cr
14 @p ! ! .. / 15 @p push .. 16 / cr
@p ! .. / 17 begin a - !+ unext .. 18 / ; cr
1 dup 3E 3F for over . + /t dup /b! dup /!b ne
xt
;
chk-a
21 1 dup 3F for over . + /t dup /b! dup
/@b or .. if pop
-1064 . + - !b pop drop ; the
n drop next

b-adr
0 end ; cr
32 2101 bin                                   


b-reg testing t to b-reg br

uses !+ to fill ram with 0 to 3F cr
next puts 0 on t and -1 on s cr
next puts the 0 into b and does a @b with -1 o
n t
cr
next checks if t contains 0 cr
then does this for 3F , 0 and other numbers ;
relies on instructions
cr
@p / @p b! / @b !p / @p push / dup or a! / cr
/ a !+ unext / in the port br

address 4 tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success, cr
address + 1000 of failure for failure br

uncomment - in
chk-a
to force failure                        

   522 list
2102 mark t to b reg test cr
creeper reclaim 0 node 1344 load ahead 12 14 o
rg

end
14 @p ! a . / @p b! .. / ! !b ;
/t
17 n dup - .. / @p ! ! .. / @p .. / ;
/b!
1B n @p ! ! .. / @p b! .. / ;
/!b
1E n @p ! ! .. / @p !b .. / ;
/@b
21 -n @p ! @ .. / @b !p .. / ;
chk-a
24 3F and dup dup /t /b! /@b or - .. if
drop
1000 . + end pop pop pop ; then ;
2chk
dup dup chk-a drop drop - chk-a drop drop
chk-a ;
36 4 org
init
then @p ! .. / dup or a! .. / cr
3F .. / 08 @p ! ! .. / 09 @p push .. 0A /,
@p ! .. / 0B begin a !+ unext .. 0C /
b-reg
0C dup or 2chk AA 2chk 33 2chk 19 2chk c
r
14 end ; cr
2102 bin                                      


port testing port to i-reg br

uses the instruction / a! !p drop unext / cr
first the inverse instruction is sent then the
instruction then the inverse instruction again

note
the inverse of a! is ; cr
next the inverse of instruction / a! - @p dup
is used, except for the
a! / cr
note the pre and post instructions begin with
;
and don,t effect the stack cr
after each triplet the stack is checked; cr
relies on instructions cr
@p dup push . / dup dup or . / push push .. /
@p a! @p @p
/ @p @p . . / a !p !p . / cr
pop pop drop . / push .. / cr
in the port br

address 4 tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success, cr
1000 for failure br

uncomment 2/ in
init
to force failure                         

   524 list
2103 mark port to i-reg test cr
creeper reclaim 0 node 1344 load 1A org
chk
1A or if pop 1000 !b ; then ;
rets
@p ! a . / @p dup push . / cr
/ ! @p ! @p / dup dup or . / push push . . / !
init
24 15555 dup - over over - over over cr
. 2/ . over .. @p ! ! . / @p a! @p @p / cr
.. ! ! @p . / @p @p . . / ! . ! ! ;
code
2D @p - dup . / begin a! !p drop unext /
- over ! ! @ push
/ ! pop ; ; - @p dup cr
-code 32 @p dup - dup / a! - @p dup / push ! !
! pop ! ;
/ ; !p drop unext br

36 4 org
i-reg
04 rets ; code over chk drop cr
08/1 .. / @p ! @ . / a !p !p .. / cr
0A - chk drop @ - chk / end first check cr
0D rets .. / @p ! @p . / pop pop drop . / push
..
/ ! dup dup -code cr
13 / @p ! @ . .. / !p !p !p .. / cr
chk drop @ chk drop @ chk end second check cr
!b ; 1A 2103 bin                              


i-reg-bits testing port to i-reg for cr
shorted adjacent bits br

uses the instructions / and @b and + / cr
and @b and @b + checked; cr
relies on instructions cr
@p dup push . / dup dup or . / push push .. /
@p a! @p @p
/ @p @p . . / a !p !p . / cr
pop pop drop . / push .. / cr
in the port br

address 4 tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success, cr
1000 for failure br

uncomment 2/ in
init
to force failure                         

   526 list
2104 mark port to i-reg-bit-short test cr
creeper reclaim 0 node 1344 load 13 17 org
chk
17 or if pop pop 1000 1000 !b ; then drop
;

init
1C 3807 dup 2* dup 2* dup dup cr
2* dup dup 2* dup dup cr
.. @p ! @p . / @p @p @p . / 12345 , . 2/ . ! !
! ;

read
25 / @p ! @ . / !p !p !p . / @ @ ; br

code 28 / @p ; / and @b and @p /
-code
2A / @p ; / @b and @b + / br

run 2C -code ! . ! ! . code ! . ! ! . cr
-code ! . ! ! . ; cr
br

32 4 org
i-reg
04 init run read 12345 chk 10020 chk 150
2A
chk cr
dup or !b ; 0E 2104 bin 9813                  


i-reg-bits testing port to i-reg for cr
shorted adjacent bits br

uses the instructions / - - - . / !p !p !p ; /
relies on instructions
cr
/ !p !p !p . / @p @p @p @p / @p push @p @p / .
in the port
br

address 4 tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success, cr
1000 for failure br

uncomment 2/ in
init
to force failure                         

   528 list
2105 mark port to i-reg-bit-short test cr
creeper reclaim 0 node 1344 load 1A org
chk
1A or if pop pop 1000 1000 !b ; then drop
;

init
1F cr
dup or - dup 2* dup 2* dup 2* dup 2* dup 2* du
p 2*
/ cr
.. / @p ! a . / @p push @p @p / cr
/ ! ! ! @p / @p @p @p @p / ! . 2/ . ! ! ! ! ;
cr
3code 29 / @p dup dup . / - - - . / !p !p !p ;
run
2B push ! - ! @ @ @ pop ! cr
.. / @p ! @ . / !p !p !p . / @ @ ; br

31 4 org
i-reg
04 init 3code 3FFC0 chk 3FFE0 chk F chk
3FFF8
chk 3FFFC chk 1 - chk cr
cr
dup or !b ; 13 2105 bin                       


i-reg-bits testing port to i-reg for cr
shorted adjacent bits br

uses the instructions cr
/ !p - a! . / - !p ; ; / cr
relies on instructions cr
/ / @p dup push . / push @p a! @p / cr
/ @p @p @p @p / a !p !p . / cr
in the port br

address 4 tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success, cr
1000 for failure br

uncomment 2/ in
init
to force failure                         

   530 list
2106 mark port to i-reg-bit-short test cr
creeper reclaim 0 node 1344 load 18 org
chk
18 or if pop pop 1000 !b ; then drop ;
init
1D dup or - dup 2* dup 2* dup 2* cr
dup 2* dup 2* dup 2* dup 2* dup 2* dup 2* cr
.. / @p ! a . / @p dup push . / cr
.. / ! @p ! . / push @p a! @p / cr
27 ! ! @p . / @p @p @p @p / ! . 2/ . ! ! ! ! ;
cr
2code 2B / @p - dup . / !p - a! . / - !p ; ;
run
2D - over push push ! @ pop ! @ pop ! @ cr
.. / @p ! @ . .. / a !p !p . / @ .. ; br

35 4 org
i-reg
04 init 2code 3FF00 chk 3F chk 7F chk 3F
FE0
chk F chk cr
dup or !b ; 11 2106 bin                       


i-reg-bits testing port to i-reg for cr
shorted adjacent bits br

uses the instructions cr
/ a! - . . / ; !p c c / cr
/ - a! - . / !p ; !p ; / cr
@p dup push . / dup dup or . cr
relies on instructions cr
/ a !p !p !p / !p a !p . / @p @p @p @p cr
/ push @p a! . / @p dup push . / cr
in the port br

address 4 tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success, cr
1000 for failure br

uncomment 2/ in
init
to force failure                         

   532 list
2107 mark port to i-reg-bit-short test cr
creeper reclaim 0 node 1344 load 18 17 org
chk
17 or if pop pop 1000 1000 !b ; then drop
;

init
1C cr
dup or - dup 2* dup 2* dup 2* dup 2* / cr
.. / @p ! a . / @p dup push . / cr
/ ! @p ! . / push @p a! . / cr
23 ! @p ! . / @p @p @p @p / . 2/ . ! ! ! ! ; c
r
1code 27 / @p - dup . / - a! - . / !p ; !p ;
run
29 ! @ ; push dup - ! ! pop @ cr
.. / @p ! @ . / !p a !p . / @ ;
0code
2F / @p - dup . / a! - . . / ; !p c c
0run
31 - over ! ! ! cr
.. / @p ! @ . / a !p !p !p / @ @ ; br

36 4 org
i-reg
04 init 1code 1 chk 3FFF8 chk 3 chk 3FFF
F
chk cr
0E init 0code 3FFFC chk 1 chk 3FFFF chk cr
dup or !b ; 17 2107 bin                       


i-reg-bits testing port to i-reg for cr
shorted adjacent bits br

uses the instructions cr
/ a! a! a! . / ; ; ; ; / cr
relies on instructions cr
/ @p dup push . / push @p a! . / cr
/ @p @p @p @p / a !p !p . / cr
in the port br

address 4 tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success, cr
1000 for failure br

uncomment 2/ in
init
to force failure                         

   534 list
2108 mark port to i-reg-bit-short test cr
creeper reclaim 0 node 1344 load 15 org
chk
15 or if pop pop 1000 1000 !b ; then drop
;

init
1A cr
dup or - dup 2* dup 2* dup 2* dup 2* / cr
.. / @p ! a . / @p dup push . / cr
/ ! @p ! . / push @p a! . / cr
21 ! @p ! . / @p @p @p @p / ! . 2/ . ! ! ! ; c
r
+code 25 / @p - dup . / a! a! a! . / ; ; ; ;
+run
27 - over ! ! ! cr
.. / @p ! @ . / a !p !p . / @ ; br

2C 4 org
i-reg
04 init +code 3FFF8 chk 3FFFC chk cr
0A dup or !b ; 0B 2108 bin                    


i-reg-bits testing port to i-reg for cr
shorted adjacent bits br

uses the instructions cr
/ @p @p @p ; / a! a! a! . / ; ; ; ; / cr
relies on instructions cr
/ @p dup push . / push @p a! @p / cr
/ @p @p @p @p / a !p !p !p . / cr
/ cr
in the port br

address 4 tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success, cr
1000 for failure br

uncomment 2/ in
init
to force failure                         

   536 list
2109 mark port to i-reg-bit-short test cr
creeper reclaim 0 node 1344 load 15 org
chk
15 or if pop pop 1000 !b ; then drop ;
init
1A dup or - dup 2* dup 2* dup 2* cr
dup 2* dup 2* dup 2* dup 2* dup 2* / cr
.. / @p ! a . / @p dup push . / cr
/ ! @p ! . / push @p a! @p / cr
23 ! ! @p . / @p @p @p @p / ! . 2/ . ! ! ! ! ;
cr
-code 27 / @p ; / @p @p @p ; /
+code
29 / @p ; / a! a! a! . / ; ; ; ;
-run
2B +code ! -code ! . ! ! ! . +code ! cr
.. / @p ! @ . / a !p !p !p . / @ @ ; br

33 4 org
i-reg
04 init -run 3FF80 chk 3FFC0 chk 3FFFC c
hk
cr
dup or !b ; 0D 2109 bin                       


prp-call testing p to r to p using call and ;
also test
jump from port to ram. ; returns to
port and to ram
br

uses the instructions in ram cr
/ pop dup push ; / call / ; / br

to insure failure on fail, fills ram with cr
/ !b pop !b . / br

relies on instructions in the port cr
/ a! @p !+ . / push !+ @p .. / cr
/ !+ dup .. / a! @p @p .. / cr
/ !+ !+ push .. / cr
br

address 4 tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success, cr
1000 for failure br

uncomment 2/ in
forcefail
to force failure cr
uncomment @ ; in
calls
and removing for next structure cr
might help debuging chip.                     

   538 list
2110 mark prp-call test cr
creeper reclaim 0 node 1344 load D C 9 org
p-r-p
dup 1 . + 7E for
init
2 3 dup 3 push over a cr
3 . 2 a pop 3 a push dup push 1 . + cr
3 . 2 a 4 dup a! - 3F 7F and cr
3 . 2 a 3B dup push 13000 or pop cr
3 . 2 a 1303B 3B pop 3 . 2 a 3B 3 cr
a 4 pop a! 4 push cr
/ .. @p ! ! . // @p @p @p @p / cr
/ ! ! ! @p // @p .. / ! ! cr
8 for @p ! unext cr
/ 2 a! @p !+ . / !b pop !b . / cr
a push !+ @p .. / ; / cr
forcefail !+ dup .. / 3B a! 3B . 2/ . @p @p ..
!b pop !b .
/ pop dup push ; cr
!+ !+ push .. / cr
cr
calls 2A 3 pop 4 over 3 11000 or ! ? @ ; ? cr
/ .. @p ! @ .. // !p .. a cr
chk or if pop pop 1000 !b ; then drop cr
cr
next ; 35 4 org
p-r
0 p-r-p 200 p-r-p dup or !b ; cr
09 2110 bin                                   


prp-ex testing p to r to p using ex and ; cr
also test jump from port to ram. ; returns to
port and to ram
br

uses the instructions in ram cr
/ pop dup push ; / ex .. / ; / cr
to insure failure on fail, fills ram with cr
/ !b pop !b . / cr
relies on instructions in the port cr
/ a! @p !+ . / push @p @p .. / cr
/ !+ !+ dup dup .. / a! push @p @p / cr
/ !+ !+ .. / push drop .. / br

address 4 tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success, cr
1000 for failure br

uncomment 2/ in
forcefail
to force failure cr
uncomment @ ; in
calls
and removing for next structure cr
might help debuging chip.                     

   540 list
2111 mark prp-ex test cr
creeper reclaim 0 node 1344 load D org
p-r-p
dup 1 . + 7E for
init
2 3 dup 3 push over a cr
3 . 2 a pop 3 a push dup push 1 . + cr
3 . 2 a 4 dup a! - 7F and cr
3 . 2 a 3B pop 3 . 2 a 3B 3 cr
a 4 pop a! 4 push cr
/ .. @p ! ! . // @p @p @p @p / ! ! ! cr
cr
10 for @p ! unext cr
/ 2 a! @p !+ . / !b pop !b . / cr
a push @p @p .. / ; / ex .. / cr
!+ !+ dup dup .. / 3B a! 3B push @p @p / cr
/ !b pop !b . / pop dup . . push . ; / cr
forcefail !+ !+ .. / . 2/ . push drop .. / cr
cr
calls 2B 3 pop 4 over 3 11000 or ! ? ; ? cr
/ a .. @p ! @ .. // !p .. cr
chk or if pop pop 1000 !b ; then drop cr
next ; 36 4 org
p-r
0 p-r-p 200 p-r-p dup or !b ; cr
09 2111 bin                                   


basic serdes test. this package is loaded into
node 001 and location
5 executed, returning ne
gative status to rip the creeper out and placi
ng the node in its cold configuration to execu
te anything node
701 sends it. the location 4
entry point is used in node
701 on the way to
001 to place
701 in listen mode first. br

s-lis is used from node 101 to start 001 liste
ning for instructions from node 701.

one
is called by master thru serdes to run the
test. receives count, nominally 250,000, and t
hen receives one more than that words of data.
compares each word with prn sequence generated
off the initial count. ors all error bits toge
ther, then xors that result with
31416 and ret
urns two copies after turning line around. fin
ally goes back to receive and warm so it's rdy
for the next test.                            

   542 list
2112 serdes 001 slave test cr
creeper reclaim 1 node 1344 load ahead
s-lis
05 rip -1 !b .. cold ;
lis
08 io a! 15555 ! data a! 3FFFE dup ! ;
m-lis
arg 0F then a push lis pop a! .. 0 !b ;
14
br

ran n-n 14 -if 2* 2CD81 or ; then 2* ;
rcv
-n 18 3FFFE @ nip over or or ;
dly
1B 50 for unext ;
one
1E up a! 0 rcv dup for cr
ran dup push rcv or over - and or pop next cr
drop dly cr
data a! 31416 or dup ! io a! 20000 ! cr
up a! ! dly lis warm ; br

36 2112 bin                                   


basic serdes test. single package used in two
modes on path
1 for the two nodes. br

s-lis is used from node 101 to start 001 liste
ning for instructions from node 701.          

   544 list
2113 serdes 701 master test cr
creeper reclaim 1 node 1344 load ahead br

ran n-n 05 -if 2* 2CD81 or ; then 2* ;
dly
09 10 12 for unext ;
lis
0C io a! 15555 ! data a! 3FFFE dup ! ;
go
arg 13 then data a! io 1201E cr
! a! up 20000 . ! a! dup ! dup for indent
  
dly ran dup ! next drop cr
result . .. . .. lis dly dly lis up a! @ @ cr
31416 or over 31416 or over - and or cr
dup 2/ over - and or 1FFFF and .. !b ; br

31 2113 bin exit                              


basic analog control br

this code is intended to run in the active cr
node, not the target node. br

!dac sets dac value into io and returns zero.
ladc
sets up dac and io then reads back raw cr
adc value when used in a left analog node.
uadc
does the same for an up analog node.     

   546 list
2114 basic analog checks cr
creeper reclaim 0 node 1344 load br

!dac 04 n io a! ! dup dup or !b ;
ladc
07 n io a! ! ldata
.adc
0A a! ! @ dup 1000 for unext .. cr
---- 0E ! @ - 1 . + . + 1FFFF and !b ;
uadc
13 n io a! ! data .adc ; br

17 2114 bin exit br

!dac 19 n dup @p ! dup / @p a! @p . / cr
---- 1B io ! ! @p / ! . . . / ! or !b ;       


tst-2* testing 2* cr
br

relies on instructions in the port cr
@p . . . / 2* . . . / !p . . . / 2* 2* 2* . /
br

address 4 tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success, cr
1000 for failure br

first comment dup in
h2*3
to force failure cr
then comment dup in
h2*
to force failure                          

   548 list
2115 mark 2* test cr
creeper reclaim 0 node 1344 load 13 org
t!
n @p ! ! ; // @p .. /
t2*
@p ! ; // 2* .. /
t@
-n @p ! @ ; // !p .. /
t2*3
@p ! .. // 2* 2* 2* .. / cr
@p ! @ ; // dup !p .. /
chk
over or .. if pop pop pop 1000 !b ; then d
rop ;

h2*
dup t! 18 for cr
dup . + t2* t@ dup t! chk cr
next ;
h2*3
dup t! 6 for cr
dup . + dup . + dup . + t2*3 chk next ;
forcefail
36 4 org
tst-2*
04 15555 h2* 1 h2* - 3FFFF h2*3 0 h2*3
15555
h2*3 33333 h2*3 71C7 h2*3 1 h2*3 !b ; cr
13 2115 bin                                   


tst-2/ testing 2/ cr
br

relies on instructions in the port cr
@p 2/ !p . / @p . . . / 2/ 2/ 2/ !p / cr
br

address 4 tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success, cr
1000 for failure br

first comment dup in
h2/
to force failure cr
then comment dup in
h2/3
to force failure                         

   550 list
2116 mark 2/ test cr
creeper reclaim 0 node 1344 load 13 19 org
t2/
n-n dup . + @p // @p 2/ !p .. / ! dup ! ov
er @ ;

t2/3
n-n dup . + dup . + cr
.. / dup . + @p // @p .. / cr
/ ! dup ! @p // 2/ 2/ 2/ !p / cr
/ ! over @ ;
chk
or .. if pop pop pop 1000 !b ; then drop ;
h2/
12 for dup t2/ chk next ;
h2/3
3 for dup t2/3 chk next ; 36 4 org
tst-2/
04 F h2/ 5 h2/ 3 h2/ C h2/ F h2/3 5 h2/
3
3 h2/3 C h2/3 7 h2/3 9 h2/3 dup or !b ; cr
19 2116 bin                                   


tst-2/b testing 2/ cr
br

relies on instructions in the port cr
@p 2/ !p . / @p . . . / 2/ 2/ 2/ !p / cr
br

address 4 tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success, cr
1000 for failure br

first comment dup in
h2/
to force failure cr
then comment dup in
h2/3
to force failure                         

   552 list
2117 mark 2/ test cr
creeper reclaim 0 node 1344 load 22 org
t2/
n-n dup . + @p // @p 2/ !p .. / ! ! @ ;
t2/3
n-n dup . + dup . + cr
.. / dup . + @p // @p .. / cr
/ ! ! @p .. // 2/ 2/ 2/ !p / cr
/ ! @ ;
chk
or .. if pop pop pop 1000 !b ; then drop ;
h2/
dup t2/ chk ;
h2/3
dup t2/3 chk ; 36 4 org
tst-2/b
04 30000 h2/ 3AAAA h2/ 35555 h2/ 3FFFE
h2/
33333 h2/ 3CCCC h2/ cr
3C000 h2/3 3EAAA h2/3 3D555 h2/3 3FFF8 h2/3 3F
333
h2/3 3CCCC h2/3 3C0F0 h2/3 3C1C3 h2/3 dup
or !b ;
cr
21 2117 bin                                   


tst+ mark testing + cr
br

relies on s and t of uut cr
relies on instructions in the port cr
/ @p .. / @p . + !p / br

address 4 tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success, cr
1000 for failure br

fail mode; cr
uncomment - in
t+
to force failure cr
cr
                                              

   554 list
2200 tst+ mark testing + cr
creeper reclaim 0 node 1344 load 2A org cr
chk or if pop pop 1000 !b ; then drop ;
t+
nnn-n push .. cr
/ @p ! ! @p // @p . - . .. // @p . + !p / cr
/ ! ! @ pop chk ; cr
35 4 org cr
tst+ 15555 dup dup 2AAAA t+ cr
dup dup - 3FFFF t+ - dup - dup 2AAAA 3FFFF t+
dup -
3FFFF t+ cr
dup or - dup dup 3FFFE t+ 2AAAA CCCC 37776 t+
19999 15555 2EEEE
t+ 33333 8888 3BBBB t+ cr
dup or !b ; cr
27 2200 bin                                   


rdstk mark testing return and data stacks regi
sters
cr
also mulitple overs pops and pushes in the por
t
br

fill neighbor return stack with alternating cr
inverted patterns , then push to return stack
then pop to data stack then read back and veri
fy each pattern ; relies on
b s t r r-stack an
d
d-stack of uut cr
and instructions cr
/ !b .. / @p .. dup - over .. / cr
/ over over over .. / over .. / cr
/ push push push .. / pop pop pop .. / cr
/ @p .. / !b .. / over push pop .. / cr
in the port br

full tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success , next count for fail
ure
br

uncomment - in
/stack
after over to force failure            

   556 list
2201 mark r d stack test v2 cr
creeper reclaim 0 node 1344 load E org
store
dup ! dup ! dup ! ! ;
fetch
-n @p ! @ ; / !b .. /
/neighbor
@p ! ! .. @p .. cr
3 for @p ! unext ; ..
/stack
dup - over .. / over over . - . cr
over .. / over over over .. / over .. / ;
t-stk
1D cr
dup /neighbor /stack 1F cr
FFFE 8 for cr
@p .. push push push .. store cr
fetch drop @p .. pop pop pop .. store cr
cr
11 for fetch or .. if pop pop - 10 . + !b pop
; then drop
cr
next drop fetch drop next ; cr
35 4 org
full
04 2AAAA t-stk dup or 0 t-stk 33333 t-stk
19999
t-stk dup or !b ; cr
0D 2201 bin                                   


stk mark testing data stack registers cr
also overs in the port br

fill neighbor return stack with alternating cr
inverted patterns , then read back and verify
each pattern ; relies on
b s t and d-stack of
uut
cr
and instructions cr
/ dup - over .. / over over over .. / cr
/ over .. / @p .. / !b .. / cr
in the port br

full tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success , next count for fail
ure
br

uncomment - in
d-stack
after dup to force failure            

   558 list
2202 mark d stack test v2 cr
creeper reclaim 0 node 1344 load 18 org
fetch
-n @p ! @ ; // !b .. /
/neighbor
@p ! ! .. @p .. cr
3 for @p ! unext ; ..
/stack
1F dup - over .. / over over cr
over .. / over over over .. / over .. / ;
d-stack
24 8 for dup . - . /neighbor /stack .
11
for fetch or if pop pop - 10 . + !b pop ; t
hen drop
cr
next next ; cr
33 4 org
full
04 2AAAA d-stack dup or 0 d-stack 15555 d
-stack dup or -
3FFFF d-stack 33333 d-stack 19
999
d-stack CCCC d-stack 26666 d-stack dup dup
or
cr
!b ; 16 2202 bin cr
                                              


tst+b mark testing + cr
br

relies on s t and d-stack of uut cr
relies on instructions in the port / cr
@p .. / @p . + !p / br

address 4 tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success, cr
1000 for failure br

uncomment - in
h+
to force failure cr
                                              

   560 list
2203 mark test + v2 cr
creeper reclaim 0 node 1344 load 18 org cr
h+ over over . - . . + push
t+
nn-n @p ! ! @p // @p .. // @p . + !p / ! !
@
cr
pop over chk or if pop pop 1000 !b ; then drop
;
cr
first x leap 23225 . + dup
xstr
@p drop !p ; -cr  x then 0 ; 2A
sec
y leap 1F9A9 . + dup
ystr
@p drop !p ; -cr  y then 0 ;
thr
z leap 1BE29 . + dup
zstr
@p drop !p ; -cr  z then 0 ; cr
cr
36 4 org cr
tst+ dup or 3FFFF 3FF for first h+ sec over h+
thr h+ x - h+ over h+ z - h+ - y h+ dup h+ h+
next dup or !b ;
cr
18 2203 bin                                   


tst-and mark testing and br

relies on s t and d-stack of uut cr
relies on instructions cr
/ @p @p and !p / cr
in the port br

full tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success , 1000 for failure br

uncomment - in
ttand
after over to force failure             

   562 list
2204 mark testing and cr
creeper reclaim 0 node 1344 load 1E org
chk
nn or if pop pop pop 1000 !b ; then drop ;
tand
nn-n @p ! ! .. // @p @p and !p / ! @ ;
ttand
over over . - . and push tand pop chk ;
first
x leap 23225 . + dup
xstr
@p drop !p ; -cr  x then 0 ;
sec
y leap 1F9A9 . + dup
ystr
@p drop !p ; -cr  y then 0 ; cr
35 4 org
tstand
3FFFF 100 for first sec ttand x - y tta
nd x y - ttand x - y - ttand y - x ttand y x -
ttand y - x - ttand next dup or !b ;
cr
1D 2204 bin cr
cr
                                              


tst-andb mark testing and cr
br

relies on s t and d-stack of uut cr
relies on instructions cr
/ @p @p and !p .. / @p @p @p @p / cr
/ and and and !p / cr
/ cr
in the port br

full tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success , 1000 for failure br

first fail mode; cr
uncomment and in
tand
to force failure cr
cr
second fail mode; cr
uncomment and in
tand3
to force failure cr
                                              

   564 list
2205 mark test and cr
creeper reclaim 0 node 1344 load 25 org
chk
nn or if pop pop 1000 !b ; then ;
tand
nn-n @p ! ! .. // @p @p and !p .. / ! @ ;
cr
tand3 nnnn-n @p ! ! .. // @p @p @p @p / cr
/ ! ! ! @p // and and and !p .. / ! @ ;
tsa
tand chk ;
tsa3
tand3 chk ; cr
36 4 org
tstand
0 2222 17777 2AAAA 3FAFF 33333 tsa3 30A
5C 3FFFF
over tsa 30A5C - 3FFFF over tsa A00 3
FF00 FFF 3FFFF 3FA55
tsa3 - tsa 15555 tsa dup
2AAAA
tsa 15555 2AAAA tsa !b ; cr
25 2205 bin cr
cr
                                              


tst-or mark testing and br

relies on s t and d-stack of uut cr
relies on instructions cr
/ @p @p and !p / cr
in the port br

full tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success , 1000 for failure br

uncomment - in
ttand
after over to force failure             

   566 list
2206 mark testing or cr
creeper reclaim 0 node 1344 load 1E org
chk
nn or if pop pop pop 1000 !b ; then ;
tor
nn-n @p ! ! .. // @p @p or !p / ! @ ;
ttor
over over . - . or push tor pop chk ;
first
x leap 23225 . + dup
xstr
@p drop !p ; -cr  x then 0 ;
sec
y leap 1F9A9 . + dup
ystr
@p drop !p ; -cr  y then 0 ; cr
35 4 org
tst-or
3FFFF 100 for first sec ttor x - y ttor
x y - ttor x - y - ttor y - x ttor y x - ttor
y - x - ttor next dup or !b ;
cr
1D 2206 bin cr
cr
                                              


tst-orb mark testing and cr
br

relies on s t and d-stack of uut cr
relies on instructions cr
/ @p @p and !p .. / @p @p @p @p / cr
/ and and and !p / cr
/ cr
in the port br

full tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success , 1000 for failure br

first fail mode; cr
uncomment and in
tand
to force failure cr
cr
second fail mode; cr
uncomment and in
tand3
to force failure cr
                                              

   568 list
2207 mark test or v2 cr
creeper reclaim 0 node 1344 load 25 org
chk
nn or if pop pop pop 1000 !b ; then ;
tor
nn-n @p ! ! .. // @p @p or . - . !p .. / !
@ ;
cr
tor3 nnnn-n @p ! ! .. // @p @p @p @p / cr
/ ! ! ! @p // or or or . - . !p .. / ! @ ;
tso
tor chk ;
tso3
tor3 chk ; cr
36 4 org
tstor
3E372 35FA9 3F57F 25733 11E97 tso3 3F555
3FF00 FFF 3FFFF 3FA55
tso3 15555 3FFFF over -
tso
2AAAA 3FFFF over - tso dup or dup - dup ts
o dup or - dup dup - tso
15555 over - over - t
so !b ;
cr
25 2207 bin cr
cr
                                              


tst- mark testing - cr
br

relies on s t and d-stack of uut cr
relies on instructions cr
/ @p - !p .. / @p - - !p .. / cr
/ @p .. / - - - !p .. / br

in the port br

tests the tfocused neighbor cr
parameter is ignored cr
error code 0 for success , 1000 for failure br

first fail mode; cr
uncomment - in
t-
to force failure br

second fail mode; cr
uncomment - in
t-2
to force failure br

second fail mode; cr
uncomment - in
t-3
to force failure                          

   570 list
2208 mark test - cr
creeper reclaim 0 node 1344 load 26 org
chk
nn ! @ or if pop pop 1000 !b ; then ;
t-
n-n @p ! .. // @p - !p .. / chk ;
t-2
n-n dup @p ! .. // @p - - !p .. / chk ; cr
t-3 n-n @p ! ! @p // @p .. / cr
// - - - !p .. / chk ; cr
36 4 org
tstor
1C8D 3E372 t- 2AAAA 15555 t- 15555 2AAAA
t-
3FFFF dup dup or t- dup dup or 3FFFF t- cr
dup dup or t-2 3FFFF t-2 2AAAA t-2 15555 t-2 3
FFFF
dup dup or t-3 2AAAA 15555 t-3 !b ; cr
26 2208 bin cr
cr
                                              


                                              

   572 list
                                              


                                              

   574 list
                                              


                                              

   576 list
                                              


                                              

   578 list
                                              


                                              

   580 list
                                              


                                              

   582 list
                                              


                                              

   584 list
                                              


                                              

   586 list
                                              


                                              

   588 list
                                              


                                              

   590 list
                                              


                                              

   592 list
                                              


                                              

   594 list
                                              


                                              

   596 list
                                              


                                              

   598 list
                                              


                                              

   600 list
res for more ats test pkgs ---                


                                              

   602 list
                                              


                                              

   604 list
                                              


                                              

   606 list
                                              


                                              

   608 list
                                              


                                              

   610 list
                                              


                                              

   612 list
                                              


                                              

   614 list
                                              


                                              

   616 list
                                              


                                              

   618 list
                                              


                                              

   620 list
                                              


                                              

   622 list
                                              


                                              

   624 list
                                              


                                              

   626 list
                                              


                                              

   628 list
                                              


ide mode code.
mv
returns approx pad voltage in mv using cont
emporaneous cal values from our own rails assu
ming said rails at
0 and 1800. no linearizatio
n. dac output remains unchanged.

!mv
sets dac output to a voltage in mv. this i
s most bogus since no linearization is done; t
he actual voltage will be much higher than wha
t we are setting.                             

   630 list
1900 ats analog cr
reclaim 717 node 0 org
sam
n-k 00 io b! data a! @b - 1FF and or cr
!b dup ! @ 1000 for unext dup ! @ - . + ;
vdd
0C 2000 sam ; -cr  vss 0E 6000 sam ;
vpin
10 0 sam ;
u*
nn-hl 12 dup a! dup or 17 for +* unext cr
push drop pop a ;
m/
dn-q --u/mod push drop pop ;
mv
-n 19 vss vdd over - . + push cr
vpin - . + -if dup or then 1800 u* pop m/ ;
!mv
n 23 io b! 511 u* -1800 m/ 155 or !b ; cr
2B 1900 bin                                   


this code is loaded into tb001 test chip node
300
to boot node 300 of the uut. the ide uses
18o
to form a boot stream to load the link cr
routine into the remote node. once remote cr
is started ide sets the local pins to low cr
tri-state and weak-low before loading the cr
link code into the local node and starting it.
at this time both of these nodes remain off of
the grid until both the test and uut chip have
been reset.                                   

   632 list
1901 ats sync boot master cr
reclaim 300 node 0 org
dly
00 b !b 40 31 for unext ;
1bt
03 wb-w' dup dly 10000 or dly ;
18o
06 w 30000 dly 8 for begin cr
0A -if 1- 30003 1bt swap -cr  rise cr
0D 2* -if 1+ 20003 1bt 2* *next drop ; cr
12 . then 0+ 20002 1bt 2* *next drop ; cr
16 . then 0- 30002 1bt rise ; cr
off 19 io b! 20002 dly 10001 !b ; cr
1F 1901 bin                                   


boot frame which commands uut node 200 to set
its pin 200.17 high.                          

   634 list
1902 boot frame for master testing cr
reclaim 300 node 0 org cr
host -cr  3- FFFFFFFD + ; target br

frame ser-exec -d-- 0 ,
portex
@p !b . . / 30000 , / cr
05 here here 3- 2 org , cr
org 05 1902 bin                               


boot frame which commands uut node 200 to set
its pin 200.17 low.                           

   636 list
1903 boot frame for master testing cr
reclaim 300 node 0 org cr
host -cr  3- FFFFFFFD + ; target br

frame ser-exec -d-- 0 ,
portex
@p !b . . / 20000 , / cr
05 here here 3- 2 org , cr
org 05 cr
20 org
misc
---u @p - !p ; 1903 bin                  


this code is loaded into nodes 300 of two,
chips to make their up ports into a slow but,
transparent bridge between the chips.,
,
each node waits for port data or rising clock
edge and based on clock state after wakeup
,
moves a word between sync serial and port.,
,
on the line, xmtr controls clock and data are
sampled on falling edge. clock and data set to
weak-low one half bit time from end of word.
,
,
there is no flow control and read handshake,
line of the up port is not meaningful.,
,
origin moved to 5 so boot frame header can be
laid down without affecting slot
2 jumps.     

   638 list
1904 ats sync bridge cr
reclaim 300 node 3 8 org cr
host -cr  hd- -3 -8 + ; target br

dly 08 b !b 40 for unext ; 88ns
1bt
0B wb-w' dup dly 10000 or dly ;
zro
0E 10001 dly ; -cr  wpd 10 10001 !b ;
18o
12 w zro 17 for begin cr
15 -if 30003 1bt 2* *next drop wpd ; cr
1A then 30002 1bt 2* next drop wpd ; br

18i 1E x drop dup or !b 17 for cr
21 .. begin @b -until cr
22 .. begin @b - -until cr
23 .. - 2 and 2/ a 2* or a! next cr
27 a up a! ! br

idl 2A 165 --lu a! . @ @b -if drop 18i ; cr
2E then zro drop 18o idl ; cr
ent 31 io b! wpd begin @b - -until idl ; cr
36 here here hd- 0 5 org
frame
ent dly , cr
org 36 1904 bin                               


shadow out of date. cr
this code is loaded into nodes 300 of both cr
the test and uut chips of the tb001 board. cr
the transmitter controls the clock and data is
sampled on the falling edge. the clock is set
to low tri-state and data to weak-low one half
bit time from the end of word. the code idles
reading from a neighbor and the clock pin.
cr
data from the neighbor are transmitted and cr
receive data are writen to the neighbor. no cr
attempt is made to be able to terminate either
of these serial linked nodes except reset.
cr
terminating the remote node would require cr
an enhanced protocol. also we see no need cr
to impliment flow control at this time. on cr
entry the code waits for the clock to drop cr
to facilitate transition from the old boot cr
protocol. cr
origin moved to 5 so boot frame header can be
laid down without affecting slot
2 jumps.     

   640 list
1905 uut bridge debug cr
reclaim 300 node 3 8 org cr
host -cr  hd- -3 -8 + ; target br

dly 08 b !b 40 400 for unext ; 88ns
1bt
0B wb-w' dup dly 10000 or dly ;
zro
0E 10001 dly ;
wpd
10 10001 !b ;
18o
12 w zro 17 for begin cr
15 -if 30003 1bt 2* *next drop wpd ; cr
1A then 30002 1bt 2* next drop wpd ;
18i
1E x drop dup or !b 17 for cr
21 .. begin @b -until cr
22 .. begin @b - -until cr
23 .. - 2 and 2/ a 2* or a! next cr
27 a up a! ! 1 and 2 or !b zro 12345 . + 18o b
r

idl 2B 165 --lu a! .. cr
2D @ @b -if drop 18i ; then cr
2F zro drop 18o idl ; cr
ent 31 io b! wpd cr
begin @b - -until idl ; cr
36 here here hd- 0 5 org
frame
ent dly , cr
org 36 1905 bin                               


shadow out of date. cr
this code is loaded into nodes 300 of both cr
the test and uut chips of the tb001 board. cr
the transmitter controls the clock and data is
sampled on the falling edge. the clock is set
to low tri-state and data to weak-low one half
bit time from the end of word. the code idles
reading from a neighbor and the clock pin.
cr
data from the neighbor are transmitted and cr
receive data are writen to the neighbor. no cr
attempt is made to be able to terminate either
of these serial linked nodes except reset.
cr
terminating the remote node would require cr
an enhanced protocol. also we see no need cr
to impliment flow control at this time. on cr
entry the code waits for the clock to drop cr
to facilitate transition from the old boot cr
protocol. cr
origin moved to 5 so boot frame header can be
laid down without affecting slot
2 jumps.     

   642 list
1906 tester bridge debug cr
reclaim 300 node 3 8 org cr
host -cr  hd- -3 -8 + ; target
dly
08 b !b 40 400 for unext ; 88ns
1bt
0B wb-w' dup dly 10000 or dly ;
zro
0E 10001 dly ;
wpd
10 10001 !b ;
18o
12 w io b! zro 17 for begin cr
17 -if 30003 1bt 2* *next drop wpd ; cr
1C then 30002 1bt 2* next drop wpd ;
18i
20 x drop dup or !b 17 for cr
23 .. begin @b -until cr
24 .. begin @b - -until cr
25 .. - 2 and 2/ a 2* or a! next cr
2A a up a! ! ;
joe
2B w 18o 18i ;
idl
2D 165 --lu a! .. cr
2F @ @b -if drop 18i ; then cr
31 zro drop 18o idl ; cr
ent 33 io b! 10001 !b cr
begin @b - -until idl ; cr
3A here here hd- 0 5 org
frame
ent dly , cr
org 3A 1906 bin                               


bridge loader,
node 300 contains code used by 400 to boot,
node 300 of the target chip .,
,
node 500 contains code to be loaded into both
nodes
300 .,
,
node 400 contains code that moves code,
from 500 into both nodes 300 .,
,
node 401 has test code that toggles an io pin 

   644 list
bridge loader,
400 node 6 org*18o 30 org*go 19 org*off,
0 org
start
00 ahead
@s
-n @p !b @b ; .. @+ !p ..
!his
n @p ! ! ; .. @p 18o ..
!ours
n @p ! ! ; .. @p !+ ..
set
n @p !b !b ; .. @p !b ..
-rst
20000 set ;*+rst 30000 set ;
frame
then -rst 1000 for next +rst,
@s @s @s dup -1 . + push push push,
!his pop !his pop !his begin @s !his next
local
@p !b .. dup or a! .. @p ! .. off ..,
@p ! .. dup or a! .. 3F for @s !ours next,
@p ! .. go ; .. @p !b .. warm ; .. warm ;,
2E 1907 bin                                   


                                              

   646 list
                                              


code for node 108 in ats. cr
                                              

   648 list
1400 ats cs master0 n108 cr
reclaim 108 node 742 load AA 0 org
sam
n-k 00 cr
01 1400 bin                                   


                                              

   650 list
1401 ats cs wire cr
reclaim 109 node 0 org
sam
n-k 00 cr
2B 1401 bin                                   


pf mode code for digital nodes.               

   652 list
1402 ats cs digital cr
reclaim 717 node 0 org
sam
n-k 00 cr
2B 1402 bin                                   


pf mode code.
mv
returns approx pad voltage in mv using cont
emporaneous cal values from our own rails assu
ming said rails at
0 and 1800. no linearizatio
n. dac output remains unchanged.

!mv
sets dac output to a voltage in mv. this i
s most bogus since no linearization is done; t
he actual voltage will be much higher than wha
t we are setting.                             

   654 list
1403 ats cs analog cr
reclaim 717 node 0 org
sam
n-k 00 io b! data a! @b - 1FF and or cr
!b dup ! @ 1000 for unext dup ! @ - . + ;
vdd
0C 2000 sam ; -cr  vss 0E 6000 sam ;
vpin
10 0 sam ;
u*
nn-hl 12 dup a! dup or 17 for +* unext cr
push drop pop a ;
m/
dn-q --u/mod push drop pop ;
mv
-n 19 vss vdd over - . + push cr
vpin - . + -if dup or then 1800 u* pop m/ ;
!mv
n 23 io b! 511 u* -1800 m/ 155 or !b ; cr
2B 1403 bin                                   


                                              

   656 list
                                              


this is steven's cr
g144-smtm-self-tet-mem-random                 

   658 list
xxxx smtm mem-random converted cr
reclaim 0 node 0 3 org
rnd
n-n' 00 -if 2* 2CD81 or ; then 2* ;
run
04 @p @p a! dup / 12155 , A9 , / cr
@ B a! .. or 3 3FFF8 .. rnd dup ! and .. cr
push 8 begin 2* . . unext and if or ahead cr
swap then run ; 14 . .. . ..
go
16 then @ over a! @p / @p dup push dup cr
a ! ! E push dup ! begin @p ! . unext /- cr
1C push dup push dup push dup push dup cr
1E push dup push dup push push pop dup cr
20 pop pop pop pop pop pop pop pop 3F dup cr
24 push push or dup a! or or or or or or or .
28
begin dup !+ . unext begin @+ or . unext cr
2A @p a! ! . -/ a ! @ or if warm ; then
migrate
1557F !b 1556A . 1F for . . . unext cr
34 !b 4 @p . / @p dup 2/ . / cr
37 a ! ! 43 push begin @p !+ . unext /- cr
3B 3F , 2* a! push begin @p !+ . unext cr
3E @p push ; -/ ! warm ; cr
40 xxxx bin                                   


these defns are used in ide on ats master to s
imulate actions later run by polyforth.
br

!vdx and vdx drive and read uut power bus x in
nonlinear millivolts.

!bus
and bus do the same with analog bus.
rst
sets uut reset line low if n 0 or high 1
drain
used only when no power enabled to short
out the supply rails briefly.

rst
controls uut reset line 0 is low.
1.8
and 1.475 control power supplies 1 enables
0
disables.
hivd
lovd and novd select high, low, and zero
voltage power supply to uut.                  

   660 list
tb001 ide pretest empty compile serial load br

customize -canon 660 orgn ! cr
a-com sport ! a-bps bps ! !nam br

mv -n 19 call 3F lit' ra! !a 3F r@ ;
!mv
n lit' 23 call ;
+a
nn 2 swap hook 0 64 1900 boot ; br

!vdc mv 709 +a !mv ; -cr  vdc -mv 709 +a mv ;
!vdi
mv 713 +a !mv ; -cr  vdi -mv 713 +a mv ;
!vda
mv 717 +a !mv ; -cr  vda -mv 717 +a mv ;
!bus
mv 117 +a !mv ; -cr  bus -mv 117 +a mv ;
drain
2 617 hook AA io r! 155 io r! ;
set
n nn 2 swap hook 2 + 10000 * io r! ;
rst
n 417 set ;
1.8
n 715 set ; -cr  1.475 n 517 set ;
hivd
1 1.8 0 1.475 ; -cr  lovd 1 1.475 0 1.8 ;
novd
0 1.8 0 1.475 drain ; br

functions 662 4 loads cr
automate talk pre                             


-pwr removes all power from uut socket and lea
ves it
safe for inserting or removing chip. pu
ts chip in reset, disables both power supplies
, removes drive from power rail test dacs, and
drains the rails.

?open
checks each supply rail for enough loadi
ng to believe there's a chip in the socket.   

   662 list
- pre powerup tests 662 list br

preliminary tests .pok vval 1 cr
vcop 1 vcsh 1 viop 1 vish 1 vaop 1 vash 1 br

init 0 vcop ! 0 vcsh ! 0 viop ! 0 vish ! cr
0 vaop ! 0 vash ! 0 vval ! pause
-pwr
0 rst 0 !vdc 0 !vdi 0 !vda novd ; br

exit test procedure...
-
no chip in socket
-
'compile'
-
'280 load talk'
-
insert chip
-
'pre'
-
will stop here if pretests fail
-
else runs creeper tests in 250
-
always say -pwr before removing chip!!!     


                                              

   664 list
- power opens and shorts
sam
-n mv mv + mv + mv + 2/ 2/ ;
-sam
x-mv drop sam ;
lt
nn-t less if drop drop 1 ; cr
then drop drop 0 ;
-sht
n.mv.mv-t max 2* swap lt ; br

?cop 75 !vdc sam dup 500 lt vcop ! 0 !mv ;
?iop
75 !vdi sam dup 500 lt viop ! 0 !mv ;
?aop
75 !vda sam dup 850 lt vaop ! 0 !mv ;
?open
?cop pause ?iop pause ?aop pause ; br

?csht 75 !vdc sam vdi -sam vda -sam cr
-sht vcsh ! 0 !vdc ;
?isht
75 !vdi sam vdc -sam vda -sam cr
-sht vish ! 0 !vdi ;
?asht
75 !vda sam vdi -sam vdc -sam cr
-sht vash ! 0 !vda ;
?short
?csht pause ?isht pause ?asht pause ;  


.pok shows how to make a blue word display var
iable text strings.                           

   666 list
- results
chs
...n for emit next ;
?good
-t vcop @ vcsh @ and viop @ and vish @ a
nd
vaop @ and vash @ and ;
.pf
?good drop if cr
green 42 36 3 3 chs space ; cr
then red 42 12 7 5 14 5 chs space ;
.pok
blu vval @ 0 + drop if .pf ; cr
then silver 11 8 22 19 4 chs space ;          


set up port bridge. br

first we load sync boot master in our 300 done
by
!sync
second
we load bridge in uut node 300 using fr
ame
which sends a boot frame starting at locat
ion
a compiled for bin nd's ram
third
we load bridge into our node 300 br

setup does all this and loads new ide for the
bridged 2-chip system.

pre
runs full set of pre-tests                

   668 list
- port bridge br

!sync 0 300 hook 0 64 1901 boot 19 call ; br

pt@ a-n @ 15555 or ;
frame
a nd nn-n 2* 32768 + block + dup 2 + pt@
3
+ for dup pt@ lit' 6 call 1 + next drop ;
!hitst
0 1902 frame ;
!lotst
0 1903 frame ;
!his
5 1904 1905 frame ; br

!ours off 19 call 0 64 1904 boot cr
ent 30 call testing 0 400 hook focus ; br

setup ?good drop if -pwr !sync hivd 1 rst cr
300 node !hitst !his !ours then ; br

pre 662 list pause init cr
?open ?short 1 vval ! 123 pause cr
?good drop if setup cr
2 -hook 1 -hook 0 -hook drop pause cr
670 load ; then ;                             


ide environment to run ide and creepers in the
uut. path
2 reaches right side controls. paths
0
and 1 are mutually exclusive reaching into t
he uut.
br

!vdx and vdx drive and read uut power bus x in
nonlinear millivolts.

!bus
and bus do the same with analog bus.
rst
sets uut reset line low if n 0 or high 1
drain
used only when no power enabled to short
out the supply rails briefly.

rst
controls uut reset line 0 is low.
1.8
and 1.475 control power supplies 1 enables
0
disables.
hivd
lovd and novd select high, low, and zero
voltage power supply to uut.
br

needing special runners - 913 911             

   670 list
tb001 ide creepers empty serial load,
customize -canon 670 orgn !,
a-com sport ! a-bps bps ! !nam,
functions 674 5 loads,
,
test status is .pok,
,
details ph 3 id 2002 tgt 1000 pos 154,
------- ans 0 rval 35978,
------- nrun 13125 vval 1,
,
init 0 tgt ! 0 pos ! 0 nrun ! 0 id ! 0 rval !,
..
0 ans ! 0 vval ! -1 ph ! ;,
runner 684 9 loads 672 load,
run 670 list !p0 !p1 init pause,
..
-buses 0 1000 hook 0 -hook ana0 ;,
0 ph ! 0 path z t911 t917 ta00 t913,
1 ph ! 1 path z !p1a,
2 ph ! 1 path z !p1 ser70 !p1b ser07 !p1,
3 ph ! lovd 500 ms actually 50 on moo,
..
0 path 2007 runall 2002 runall,
1 vval ! -pwr ; run                           


                                              

   672 list
- all tests br

z lov-ram 2007 runall cr
port 2000 runall port2* 2001 runall cr
ram 2002 runall t,s 2003 runall cr
t,r 2004 runall stack 2005 runall cr
return 2006 runall ms-rdst 2008 runall cr
shifta 2009 runall tsar-data 2010 runall cr
ms-stk 2012 runall carry 2014 runall cr
ms-@p 2015 runall i,r-ad 2016 runall cr
@b!b 2101 runall b-reg 2102 runall cr
i-reg 2103 runall i-reg 2104 runall cr
i-reg 2105 runall i-reg 2106 runall cr
i-reg 2107 runall i-reg 2108 runall cr
i-reg 2109 runall prp-call 2110 runall cr
prp-ex 2111 runall tst-2* 2115 runall cr
tst-2/ 2116 runall tst-2/b 2117 runall cr
tst+ 2200 runall rdstkv2 2201 runall cr
dstkv2 2202 runall +v2 2203 runall cr
and 2204 runall andv2 2205 runall cr
or 2206 runall orv2 2207 runall cr
- 2208 runall cr
;                                             


mwall discards chip id portion of node number
and in the special case of two consecutive nod
es of same number forces up port to be the wal
l between them. thus a path going from
400 to
1400
uses up to make the connection via the 30
0
to 300 sync bridge. br

uup0 is the primary path for pass/fail testing
in the uut. it reaches all nodes but the bridg
e in
300
uup1
is secondary path which passes thru most
of the ports skipped by uup1. it does not incl
ude nodes 000
100 200 and leaves 4 ports that
have not been exercised.

up1a
is a quick path that is substituted for p
ath
1 to catch the four remaining ports. br

when all three have been done, only node 300 a
nd its right and down ports have not been exer
cised.                                        

   674 list
- multichip ide
mwall
nn-i 1000 mod swap 1000 mod cr
over over or drop if swall ; cr
then drop drop up 3 ; ' mwall 'wall ! br

uup0 align create 708 , 707 , 706 , 705 , 704
,
703 , 702 , 701 , 700 , 600 , 500 , 400 , cr
1400 , 1500 , 1600 , cr
1700 , 1701 , 1702 , 1703 , 1704 , 1705 , cr
1706 , 1707 , 1708 , 1709 , 1710 , 1711 , cr
1712 , 1713 , 1714 , 1715 , 1716 , 1717 , cr
1617 , 1616 , 1615 , 1614 , 1613 , 1612 , cr
1611 , 1610 , 1609 , 1608 , 1607 , 1606 , cr
1605 , 1604 , 1603 , 1602 , 1601 , cr
1501 , 1502 , 1503 , 1504 , 1505 , 1506 , cr
1507 , 1508 , 1509 , 1510 , 1511 , 1512 , cr
1513 , 1514 , 1515 , 1516 , 1517 , cr
1417 , 1416 , 1415 , 1414 , 1413 , 1412 , cr
1411 , 1410 , 1409 , 1408 , 1407 , 1406 , cr
1405 , 1404 , 1403 , 1402 , 1401 , cr
1301 , 1302 , 1303 , 1304 , 1305 , 1306 , cr
1307 , 1308 , 1309 , 1310 , 1311 , 1312 , cr
1313 , 1314 , 1315 , 1316 , 1317 , cr
                                              


                                              

   676 list
-- paths 0,1 cr
1217 , 1216 , 1215 , 1214 , 1213 , 1212 , cr
1211 , 1210 , 1209 , 1208 , 1207 , 1206 , cr
1205 , 1204 , 1203 , 1202 , 1201 , 1200 , cr
1100 , 1101 , 1102 , 1103 , 1104 , 1105 , cr
1106 , 1107 , 1108 , 1109 , 1110 , 1111 , cr
1112 , 1113 , 1114 , 1115 , 1116 , 1117 , cr
1017 , 1016 , 1015 , 1014 , 1013 , 1012 , cr
1011 , 1010 , 1009 , 1008 , 1007 , 1006 , cr
1005 , 1004 , 1003 , 1002 , 1001 , 1000 , -1 ,
br

uup1 align create 708 , 707 , 706 , 705 , 704
,
703 , 702 , 701 , 700 , 600 , 500 , 400 , cr
1400 , 1500 , 1600 , 1700 , cr
1701 , 1601 , 1501 , 1401 , 1301 , 1201 , cr
1101 , 1001 , 1002 , 1102 , 1202 , 1302 , cr
1402 , 1502 , 1602 , 1702 , cr
1703 , 1603 , 1503 , 1403 , 1303 , 1203 , cr
1103 , 1003 , 1004 , 1104 , 1204 , 1304 , cr
1404 , 1504 , 1604 , 1704 , cr
                                              


                                              

   678 list
-- paths 1 cr
1705 , 1605 , 1505 , 1405 , 1305 , 1205 , cr
1105 , 1005 , 1006 , 1106 , 1206 , 1306 , cr
1406 , 1506 , 1606 , 1706 , cr
1707 , 1607 , 1507 , 1407 , 1307 , 1207 , cr
1107 , 1007 , 1008 , 1108 , 1208 , 1308 , cr
1408 , 1508 , 1608 , 1708 , cr
1709 , 1609 , 1509 , 1409 , 1309 , 1209 , cr
1109 , 1009 , 1010 , 1110 , 1210 , 1310 , cr
1410 , 1510 , 1610 , 1710 , cr
1711 , 1611 , 1511 , 1411 , 1311 , 1211 , cr
1111 , 1011 , 1012 , 1112 , 1212 , 1312 , cr
1412 , 1512 , 1612 , 1712 , cr
1713 , 1613 , 1513 , 1413 , 1313 , 1213 , cr
1113 , 1013 , 1014 , 1114 , 1214 , 1314 , cr
1414 , 1514 , 1614 , 1714 , cr
1715 , 1615 , 1515 , 1415 , 1315 , 1215 , cr
1115 , 1015 , 1016 , 1116 , 1216 , 1316 , cr
1416 , 1516 , 1616 , 1716 , cr
1717 , 1617 , 1517 , 1417 , 1317 , 1217 , cr
1117 , 1017 , -1 ,                            


path1a catches the port walls that are left cr
after using paths 0 and 1.
path1b
reverses path 1 swapping serdes roles. 

   680 list
-- paths 1a cr
up1a align create 708 , 707 , 706 , 705 , 704
,
703 , 702 , 701 , 700 , 600 , 500 , 400 , cr
1400 , 1401 , 1501 , 1500 , 1600 , 1601 , cr
1602 , 1502 , 1402 , 1302 , 1202 , cr
1201 , 1200 , 1100 , 1000 , -1 , br

up1b align create 708 , 707 , 706 , 705 , 704
,
703 , 702 , 701 , 700 , 600 , 500 , 400 , cr
1400 , 1401 , 1301 , 1201 , 1101 , 1001 , cr
1002 , 1102 , 1202 , 1302 , 1402 , 1502 , cr
1602 , 1702 , 1701 , 1700 , -1 , br

!p0 uup0 'pths ! ;
!p1
uup1 'pths 1 + ! ;
!p1a
up1a 'pths 1 + ! ;
!p1b
up1b 'pths 1 + ! ;                       


these defns control and interrogate the uut.
!vdx
and vdx drive and read uut power bus x in
nonlinear millivolts.

!bus
and bus do the same with analog bus.
rst
sets uut reset line low if n 0 or high 1
drain
used only when no power enabled to short
out the supply rails briefly.

rst
controls uut reset line 0 is low.
1.8
and 1.475 control power supplies 1 enables
0
disables.
hivd
lovd and novd select high, low, and zero
voltage power supply to uut.                  

   682 list
- control lines br

mv -n 19 call 3F lit' ra! !a 3F r@ ;
!mv
n lit' 23 call ;
+a
nn 2 swap hook 0 64 1900 boot ; br

!vdc mv 709 +a !mv ; -cr  vdc -mv 709 +a mv ;
!vdi
mv 713 +a !mv ; -cr  vdi -mv 713 +a mv ;
!vda
mv 717 +a !mv ; -cr  vda -mv 717 +a mv ;
!bus
mv 117 +a !mv ; -cr  bus -mv 117 +a mv ;
drain
2 617 hook AA io r! 155 io r! ;
set
n nn 2 swap hook 2 + 10000 * io r! ;
rst
n 417 set ;
1.8
n 715 set ; -cr  1.475 n 517 set ;
hivd
1 1.8 0 1.475 ; -cr  lovd 1 1.475 0 1.8 ;
novd
0 1.8 0 1.475 drain ; br

-pwr 0 rst 0 !vdc 0 !vdi 0 !vda novd drain ;  


tgt current target node
pos
posn of current active node in path
nrun
number of tests run on current chip
id
puka number for test being run
ans
most recent answer from a test br

pt@ addresses path table for active node.
active
returns active node no. yxx format
nxt
returns next target node in path.
-us
true if node given is not current boot
-end
true if node given is not end path marker
-pass
runs current test, true if failed br

runall runs the test whose puka number is give
n on all nodes using the selected path. this p
ath must be empty, selecting a node adjacent t
o the boot in use.

hike
starts with active node selected. runs te
st against next node then creeps into it and r
epeats. aborts on test fail. returns with path
ripped and ready to load new test after all re
maining nodes in path have been tested ok.    

   684 list
- all-nodes runner br

pt@ -a paths pos @ + ;
active
-nn pt@ @ ;
nxt
-nn pt@ 1 + @ ;
-us
nn-nn dup paths @ or drop ;
-end
nn-nn dup -1 or drop ; br

'arg 271594264
-try
n-t 1 nrun +! test dup ans ! 0 or drop ;
ecch
fail BAD BAD rip 1 vval ! abort ;
pass
'arg xqt -try if ecch then ; br

/all n id ! targets @ pos ! pause cr
0 64 id @ boot ?ram pfocus punchout ;
hike
key? active nxt -us if -end if cr
dup tgt ! pause wall port tfocus pass cr
creep 1 pos +! hike ; cr
then then drop drop rip ;
/zero
'arg assign 0 ;
runall
n /zero /all rip ;                     


runner components for tests that do not apply
to all nodes and for tests that work on the ac
tive rather than the target node.
br

some starts work on current path given test in
given bin.

adv
steps to the next node in path.
kreep
advances to make the given node active.
uno
kreeps if necessary to the given node and
runs the test there.
br

usage... 906 some cr
1500 kreep 1 pass 1600 uno rip                

   686 list
- incremental runner br

some n id ! targets @ pos ! pause cr
0 64 id @ boot ?ram pfocus ;
adv
active nxt -us if -end if dup tgt ! cr
pause wall port tfocus creep 1 pos +! ; cr
then then ecch ;
kreep
nn begin key? active dup tgt ! cr
over or drop while adv end then drop ;
uno
nn kreep 0 pass ;                         


notes- br

this took the bulk of the code from softsim   

   688 list
- build table of valid io w/r bits
iom
nns aray 201FF 0 iom nns fill
iom!
nm push nn-n iom dup @ pop or swap ! ;
c0,
n 1E00 iom! ; -cr  l0, n 1800 iom! ;
u0,
n 600 iom! ; -cr  !l nn over l0, iom! ;
!u
nn over u0, iom! ; -cr  l1, n 20000 !l ;
u1,
-cr  us, -cr  u18, n 20000 !u ;
l2,
n 20003 !l ; -cr  u2, n 20003 !u ;
u4,
n 2003F !u ; -cr  la, nn l1, l1, ;
ua,
nn u1, u1, ; br

single 100 l1, 317 l1, 417 l1, 500 l1, 600 l1,
serdes
1 us, 701 us, spi 705 u4, cr
async 708 u2, 1wire 200 l1, sync 300 l2, cr
parallel 7 u18, 8 u4, 9 u18, cr
analog 709 715 ua, 713 715 ua, 717 715 ua, cr
117 217 la, 617 517 la, cr
no pins 0 c0, 2 u0, 3 u0, 4 u0, 5 u0, 6 u0, cr
10 u0, 11 u0, 12 u0, 13 u0, 14 u0, 15 u0, cr
16 u0, 17 c0, 400 l0, 700 c0, 702 u0, 703 u0,
704
u0, 706 u0, 707 u0, 710 u0, cr
711 u0, 712 u0, 714 u0, 716 u0,               


                                              

   690 list
- build table of rom checksums
sums
nns aray 0 0 sums nns fill
!sum
n dup push 2* 8000 + block 80 + 0 indent
  
63 for over i + @ or -next indent
  
pop sums ! drop ;
!sums
nns -1 + for i !sum -next ; !sums cr
                                              


.pok shows how to make a blue word display var
iable text strings.
br

-buses quiets test chip parallel buses by sett
ing
7 to read and 9 to write. this facilitates
later creeper test using path 0. easily burns
hundreds of ma if not done due to cross coupli
ng of output mode buses on powerup.           

   692 list
- results
chs
...n for emit next ;
.pf
ans @ 0 + drop if cr
red 42 12 7 5 14 5 chs space ; cr
then green 42 36 3 3 chs space ;
.pok
blu vval @ 0 + drop if .pf ; cr
then silver 11 8 22 19 4 chs space ; br

-buses 0 1009 hook ou 15555 io r! 0 data r! cr
0 1007 hook in 14555 io r! 0 data r! ;        


                                              

   694 list
- runner for 911 pin test br

atest arg-ans 1 nrun +! test dup rval ! ;
within
nlh-t push less drop pop if drop 0 and
; then less if drop
-1 +or ; then drop 0 and ;
pinok
ans 16 /mod 16 /mod 16 200 within cr
push 4 13 within push 4 13 within pop and cr
pop and ; drop if ; then 2011 ans ! ecch ; br

p17 30000 ;
p5
30 ; -cr  p3 C ; -cr  p1 3 ;
a911
p atest pinok ;
n911
np swap kreep a911 ;
t911
0 path 2011 some cr
1500 p17 n911 1600 p17 n911 cr
1705 p1 n911 p3 a911 p5 a911 cr
1k pullup p17 atest 7000 +or pinok cr
no-caps 1708 p17 n911 p1 a911 cr
1715 p17 n911 1517 p17 n911 1417 p17 n911 cr
1317 p17 n911 1217 p17 n911 rip ;             


t917 needs arg of expected xor checksum value.
t913
needs arg of io latch bit mask.
ta00
needs arg of state to leave in io at end.

   696 list
- runner for 917 rom checksum br

/917 'arg assign tgt @ 1000 mod nn-n sums @ ;
t917
/917 2017 /all rip ;
/913
'arg assign tgt @ 1000 mod nn-n iom @ ;
t913
/913 2013 /all rip ; br

na00 np swap kreep -try if ecch then ;
ta00
0 path 2100 some cr
1009 14555 na00 1007 14555 na00 rip cr
1 path 2100 some cr
1007 14555 na00 1009 15555 na00 rip 0 path ;  


                                              

   698 list
- runner for 2113 serdes test br

/many 'arg assign 250000 ;
stest
arg-ans /many pass ; br

ser70 1 path 2112 some /zero cr
1701 kreep pass cr
1001 kreep 0 5 vtest drop cr
1 path 2113 some 1701 kreep stest rip ; br

ser07 1 path 2112 some /zero cr
1001 kreep pass cr
1701 kreep 0 5 vtest drop cr
1 path 2113 some 1001 kreep stest rip ;       


                                              

   700 list
- runner for 2114 analog test br

'side 271591078
tops
'side assign 13 ;
rights
'side assign 7 ;
stest
arg-ans /many pass ;
atest
arg.ent-ans 1 nrun +! vtest dup rval ! ;
!da
n 4 atest drop ;
@ad
n-n 155 or 'side xqt atest ;
@vdd
-n 2000 @ad ; -cr  @vss -n 6000 @ad ;
@off
-n 4000 @ad ; -cr  @pad -n 0 @ad ; br

a? nlhk push within if drop pop drop ; then cr
pop ans ! ecch ;
/vlo
12450 14700 ; -cr  /vhi 7800 9350 ;
aok
nn kreep pause @off 0 1 1 a? cr
@vdd /vhi 2 a? cr
@vss /vlo 3 a? AA @ad /vhi 4 a? cr
@pad /vlo 5 a? 1800 !bus 0 path cr
@pad /vhi 6 a? 0 !bus 0 path ;
ana0
0 path 2114 some cr
tops 1709 aok 1713 aok 1717 aok cr
rights 1617 aok 1117 aok rip ;                


                                              

   702 list
                                              


                                              

   704 list
                                              


                                              

   706 list
                                              


this code runs selected creeper tests directly
on a chip using the ide. use with a-com/c-com
or a literal port number.
br

tgt current target node
pos
posn of current active node in path
nrun
number of tests run on current chip
id
puka number for test being run
ans
most recent answer from a test            

   708 list
selftest a chip, port on stack empty stp ! br

compile serial load -canon usb 3 cr
stp @ dup sport ! usb ! a-bps bps ! !nam cr
functions 674 4 loads exit br

test status is .pok br

details ph 3 id 2013 tgt 701 pos 7 cr
------- ans 0 rval 0 cr
------- nrun 11520 vval 1 br

init 0 tgt ! 0 pos ! 0 nrun ! 0 id ! 0 rval !
0
ans ! 0 vval ! -1 ph ! ; init cr
runner 684 7 loads 672 load 710 load br

run 708 list init pause talk indent
  
2pa 'pths 2 + ! indent
  
2 708 hook 2 -hook !p0 !p1 !p2 ; cr
0 ph ! 0 path z t917 t913 cr
1 ph ! 1 path z t917 t913 cr
2 ph ! 2 path z t917 t913 !p1a cr
3 ph ! 1 path z t917 t913 cr
1 vval ! ; run                                


line ncd comma nodes into a table starting at
node
n for c nodes incrementing by d cr
/left extend line toward the left
/right
extend line toward the right
/up
extend line upward
/down
extend line downward
path
make a default path table that cr
covers the whole chip                         

   710 list
- paths
line
ncd swap push swap indent
  
begin dup , over + -next drop drop ;
count
nc-ncd dup 100 mod 0 + if cr
horz swap drop 1 ; vert then drop 100 / 100 ;
to
nn over negate + -if cr
back negate count negate line ; cr
forw then count line ; br

stp2 align create 708 717 to 617 600 to cr
500 517 to 417 400 to 300 317 to 217 200 to cr
100 117 to 17 0 to -1 ,
stp1
align create 708 8 to 7 707 to cr
706 6 to 5 705 to 704 4 to 3 703 to cr
702 2 to 1 701 to 700 0 to -1 ,
stp1a
align create 708 701 to -1 ,
stp0
align create 708 8 to 9 709 to 710 10 to
11 711
to 712 12 to 13 713 to 714 14 to cr
15 715 to 716 16 to 17 717 to -1 , br

!p0 stp0 'pths ! ; -cr  !p1 stp1 'pths 1 + ! ;
!p1a
stp1a 'pths 1 + ! ;
!p2
stp2 'pths 2 + ! ;                        


this code runs selected creeper tests directly
on a chip using the ide. use with a-com/c-com
or a literal port number.
br

tgt current target node
pos
posn of current active node in path
nrun
number of tests run on current chip
id
puka number for test being run
ans
most recent answer from a test            

   712 list
ats target test given host port empty stp ! br

compile serial load -canon usb 3 cr
stp @ dup sport ! usb ! a-bps bps ! !nam cr
functions 674 4 loads exit br

test status is .pok br

details ph 3 id 2113 tgt 1001 pos 23 cr
------- ans 0 rval 0 cr
------- nrun 13124 vval 1 br

init 0 tgt ! 0 pos ! 0 nrun ! 0 id ! 0 rval !
0
ans ! 0 vval ! -1 ph ! ; init cr
runner 684 7 loads 672 load 710 load cr
714 3 loads br

run 712 list init pause talk cr
.. 2pa 'pths 2 + ! 2 708 hook 2 -hook cr
.. !p0 !p1 !p2 setup ; cr
0 ph ! 0 path z t917 t913 cr
1 ph ! 1 path z t917 t913 !p1a cr
2 ph ! 1 path z t917 t913 !p1 cr
3 ph ! serht serth talk 1 vval ! ; run        


these paths are used by host chip to test the
target chip via sync node 300.
br

atp2 runs from 708 to the 700 corner and down
to
500 which controls target reset, accessing
701
for serdes testing along the way. includes
300
so it may be used to boot both chips' 300.
atp0
atp1 and atp1a steer clear of path two on
their way to node 300's up port where they dup
licate the paths used on tb001 for ats testing

   714 list
- paths
atp2
align create cr
708 700 to 600 300 to -1 , cr
atp0 align create 708 408 to 407 400 to cr
1400 1700 to 1701 1717 to 1617 1601 to cr
1501 1517 to 1417 1401 to 1301 1317 to cr
1217 1200 to 1100 1117 to 1017 1000 to -1 ,
atp1
align create 708 408 to 407 400 to cr
1400 1700 to 1701 1001 to 1002 1702 to cr
1703 1003 to 1004 1704 to 1705 1005 to cr
1006 1706 to 1707 1007 to 1008 1708 to cr
1709 1009 to 1010 1710 to 1711 1011 to cr
1012 1712 to 1713 1013 to 1014 1714 to cr
1715 1015 to 1016 1716 to 1717 1017 to -1 ,
atp1a
align create 708 408 to 407 400 to cr
1400 1401 to 1501 1500 to 1600 1602 to cr
1502 1202 to 1201 1200 to 1100 1000 to -1 , br

!p0 atp0 'pths ! ; -cr  !p1 atp1 'pths 1 + ! ;
!p1a
atp1a 'pths 1 + ! ;
!p2
atp2 'pths 2 + ! ;                        


setup resets target chip and sets up the port
bridge for ide and creeper use.
br

first we load sync boot master in our 300 done
by
!sync
second
!his loads bridge in uut node 300 using
frame
which sends a boot frame starting at loc
ation
a compiled for bin nd's ram
third
!ours loads bridge into our node 300 br

setup does all this and leaves ide set to node
400
which may talk to 1400 through its up port
for testing of the bridged 2-chip system.     

   716 list
- build port bridge
set
n nn 2 swap hook 2 + 10000 * io r! ;
rst
n 500 set ; br

!sync 2 300 hook 0 64 1901 boot 19 call ; br

pt@ a-n @ 15555 or ;
frame
a nd nn-n 2* 32768 + block + dup 2 + pt@
3
+ for dup pt@ lit' 6 call 1 + next drop ;
!hitst
0 1902 frame ;
!lotst
0 1903 frame ;
!his
5 1904 1905 frame ; br

!ours off 19 call 0 64 1904 boot ent 30 call ;
cr
setup 0 rst !sync 1 rst cr
2 300 hook !hitst !his !ours 2 -hook cr
testing 0 400 hook focus ; cr
2 -hook 1 -hook 0 -hook ;                     


serht transmits 250k words from host 701 into
tgt 001 with success feedback.                

   718 list
- runner for 2113 serdes test br

/many 'arg assign 250000 ;
stest
arg-ans /many pass ; br

serht 2 path 2112 some /zero cr
.. 701 kreep pass rip cr
1 path 2112 some /zero cr
.. 1001 kreep 0 5 vtest drop cr
2 path 2113 some 701 kreep stest rip ; br

serth 1 path 2112 some /zero cr
.. 1001 kreep pass rip cr
2 path 2112 some /zero cr
.. 701 kreep 0 5 vtest drop cr
1 path 2113 some 1001 kreep stest rip ;       


software-defined / bitbanged dma controller,
for full duplex 10 megabit ethernet.,
,
mark 1 - does autonomous link state management
so it's usable by low level applications. for
exclusive use by high level such as polyforth
this could be simplified and it would save one
spinning node.                                

   720 list
10baset ethernet cluster mk1,
,
tx 8 fh 24 fh thru,
dma 28 26 fh 32 fh thru,
..
tx ctl 34 fh load,
rx 36 fh 52 fh thru,
,
clock monitor 54 fh 56 fh thru                


                                              

   722 list
- load descriptor,
,
rx 117 +node 117 /ram io /b left /a,
....
5555 5D55 left down 5555 5D55 left down,
....
5555 5D55 10 /stack 5 /p,
..
17 +node 17 /ram 200 /p,
..
116 +node 116 /ram down /a up /b 0 /p,
..
216 +node 116 /ram up /a right /b 0 /p,
..
217 +node 217 /ram right /a io /b 0 /p,
tim 16 +node 16 /ram right /a io /b 3C /p,
prs 15 +node 15 /ram left /b right /a left /p,
frm 14 +node 14 /ram right /a left /b 4 /p,
crc 13 +node 13 /ram left /a right /b 212 /p,
pak 12 +node 12 /ram right /a left /b 0 /p,
swp 11 +node 11 /ram left /a right /b 0 /p,
ctl 10 +node 10 /ram right /a down /b 23 /p,
..
110 +node 110 /ram down /a left /b 15 /p,
..
109 +node 109 /ram left dup /p /a right /b,
..
108 +node 1801 /ram right dup /p /a left /b,
,
tx 4 fh load                                  


it is not clear that there actually exists a,
single path based on 708 that can reach the,
rest of the chip after pf and ether have been
loaded.                                       

   724 list
- residual paths exit,
,
afeth align create 708 701 to 700 0 to,
1 6 to 106 101 to 201 208 to 108 109 to,
209 210 to 110 10 to 11 17 to 117 111 to,
211 217 to 317 301 to 401 417 to 517 501 to,
601 617 to 717 709 to -1 ,                    


the clock/monitor code is loaded as part of pf
hence it is under an exit here.               

   726 list
- tx load descriptor,
,
tx 417 +node 417 /ram 2 /p,
..
317 +node 317 /ram 20000 30000 over over,
....
over over over over over over 10 /stack,
....
io /b up /a 4 /p,
..
316 +node 316 /ram left /a right /b 0 /p,
..
315 +node 315 /ram left /b C 10 /p,
..
215 +node 215 /ram up /a down /b 9 /p,
..
115 +node 115 /ram down /a io /b 7 /p,
..
314 +node 314 /ram down /a right /b A /p,
..
214 +node 214 /ram up /a down /b 27 /p,
..
114 +node 114 /ram left /a up /b 20A /p,
..
113 +node 113 /ram right /a left /b A /p,
..
112 +node 112 /ram left /a right /b 0 /p,
..
111 +node 111 /ram right /b left /a 16 /p,
exit,
mon 517 +node 517 /ram io /b 200 /p,
..
516 +node 516 /ram left dup /a /p right /b  


10 mhz ceramic resonator drive.,
each 50 ns edge sends a return instruction,
thru up port to tx pin node 317 which waits,
for the edge by simply calling the port.,
io power seems to be 70 to 90 uamps.,
,
node 317 must wait faithfully for every edge,
to keep this oscillator running reliably.,
,
note that after starting, the resonator decays
in about
10 us; so node 317 starts us when it
is ready to go by writing to the port.
,
,
timing is actually quite tight in here; had to
fight to keep duty cycle lt
100 to prevent,
creep. also the resonator enthusiastically,
responds to pumping; rings have phase jitter,
so for this app with 20 mhz stimuli we must,
pump on every edge. ring code would be...,
ring 22 @ drop drop !b a push a! ! pop a! ..  

   728 list
417 tx osc 788 load exit 417 node 0 org,
,
drive 00 4n !b !b for unext drop ;
init
02 up a! @ drop .io b! left a!,
8 dup 0 20000 9 dup 800 30000,
...
dup dup drop drop 9 for drive drive next,
15555 up 0 20000 .15555 up 800 30000,
...
dup dup drop drop 22/1
go
22 . @ drop . !b !b a push a! ! pop a! go ;
26
reclaim exit                               


manchester encoding transmitter. instructions
executed in right port.
,
,
bit sends a zero hi-lo.,
over bit sends one lo-hi. once transmission is
started bits must be ready before needed.
,
idle ends transmit with tp-idl waveform, high
for
3 bit times then sil-ent.,
sil -ent sets hi-z, forces silence for 1/2 the
number of bit times given, then polls for work
to do while keeping the oscillator happy.
,
counts cycles, generating a slow link pulse if
there have been
16ms / 320,000 stimuli since,
last transmit or link pulse.,
slp sends the link pulse and resumes timing.,
called thru the right port for flp sequences,
during auto-negotiation.,
flp delays 62.5us to time interbit interval.  

   730 list
317/316 tx pin 317 node 0 org,
,
0bit 00 @ drop !b @ drop !b ;
1bit
02 drop 0bit drop ;
init
04 0 dup ! ...
sil
1/2bt 06 push 0 .. @ drop !b ..,
....
09 begin @ drop unext ..,
..
0A dup 15 for 0C 19999 for,
....
0E @ drop drop .,
....
0F @b 2* 2* . -if drop r---,
..
13 then next next drop ... slp,
slp 16 @ drop dup !b @ drop 81 sil ;
goose
1A begin drop @ drop dup !b
idle
1C @b -until,
...
drop 4 for @ drop unext 83 sil ;
flp
22 1249 sil ; 24,
,
316 wires instructions from 315 to 317,
316 node 0 org
wir
00 begin begin @ !b unext unext wir ; 02  


multiplexor for command of node node 315,
by 314 or 215.,
spins, will use smart io read when available.
this loop is costing 3.4-3.5 ma.
,
,
to claim the node start writing code to its,
port; no focusing call needed, and a will be,
pointed at the port in node 315. you then own
it until you send it a return instruction or
,
equivalent. code may call these routines...,
,
/slp generates a slow link pulse
/flp
delays 62.5us
/-lnk
delays 1.25 sec with no link pulses,,
..
thus forcing renegotiation
/one
sends a manchester '1'
/zer
sends a manchester '0'
/idle
sends end of frame                      

   732 list
315 tx mux 315 node,
host*'rd-- 12195 lit ;*'-d-- 12115 lit ;,
*....
'r--- 121D5 lit ; target 0 org,
,
!who n 00 @p drop !p ;*who -n 01 -1 ;
/slp
03 @p !b ; .. slp ;
/flp
05 @p !b ; .. flp ;
/-lnk
07 1.25 sec 20000 for /flp next ;,
,
kall 0C a dup a! !who push ex pop dup push !wh
o ;

run
10 'rd-- a! @ drop io a! @ dup push 13/1,
..
2000 and if '-d-- kall then 17,
..
pop 2* 2* -if 'r--- kall then run ; 1C
/wd
n 15 for /slp /flp,
...
dup 1 and if /slp then drop,
/flp 2/ next /slp 223 for /flp next ;,
,
/idle 2C @p !b ; .. idle ;
/one
2E @p !b ; .. 1bit
/zer
30 @p !b ; .. 0bit,
32                                            


node 115 passes new link states from 015 to,
215 without blocking 015 ever. suspends till,
new state is available then spins on io to,
deliver it to 215. new state may be received,
while spinning and this simply replaces the,
state we are trying to deliver, so that when,
215 gets around to reading it will see the,
most recent link state received.,
,
node 215 takes latest state from 115 and check
s it for ack of 802.3 10fd mode. if so, we are
happy and do nothing. otherwise we perform one
negotiation cycle, open loop, by sending
5,
code words of 10fd, 8 of ack 10fd, and then,
ignoring new link states for six seconds to,
let the other end make up its mind. at the end
of that time we expect to receive a good ack
,
from node 115. 215 is not required to be timel
y in reading from 115.                        

   734 list
115/215 autonegot 215 node 0 org,
,
!link n 00 @p drop !p ;*link -n 01 -1 ;
-attn
03 @p !b ; .. ;,
-lnk 05 @p !b ; .. /-lnk
wd
n 07 @p !b !b ; .. @p /wd
auto
09 begin @ dup !link,
....
dup 41 4041 and 41 4041 or until,
neg 0F -lnk 4 for 41 wd next,
....
7 for 4041 wd next -attn,
..
60000 20000 n.n ms for,
....
41664 for unext next auto ; 21,
,
115 node 0 org
!link
n 00 @p drop !p ;*link -n 01 -1 ;
pass
a up a! link ! a! ;
done
07 @ !link begin,
..
@b 400 or dup 400 and if pass done ;,
..
then drop 2000 and until done ;,
12                                            


315 passes commands and packets, converting to
bit commands, adding preamble and idle pulse
,
to frame packets. incoming stimuli begin with
the t.xn field value as follows...
,
,
..
-1 force renegotiation of link.,
,
..
n packet of n bytes, in n*8 words.,
....
0/1 data bits, multiple of 8, 1 per word,
....
1x xxxx xxxx xxxx xxxx end marker,
,
pre generates ethernet preamble of 61 bits,
alternating 1/0, start frame delimiter of two
consecutive 1's, all bits of packet including
crc, and the end of frame signal.             

   736 list
314 tx framing 314 node 0 org,
,
-attn 00 @p !b ; .. ;,
-lnk 02 @p !b ; .. /-lnk ;,
,
+one 04 @p !b ; .. /one
+zer
06 @p !b ; .. /zer
+idle
08 @p !b .. /idle ; ...
run
0A @ -if attn -lnk run ; then attn
pre
0D 30 for +one +zer next +one +one
pkt
14 @ -if +idle then,
..
16 if +one pkt then,
..
19 +zer pkt,
1B reclaim                                    


214 buffers bits out from crc node, holding 32
bit times of data to keep the packet flowing
,
while calculating final crc. see crc node for
incoming stimuli.
,
,
outgoing data...,
..
-1 force renegotiation of link.,
,
..
n packet of n bytes follows in n*8 words,
....
0/1 data bits, multiple of 8, 1 per word,
....
0/1 crc bits, 32 words,
....
1x xxxx xxxx xxxx xxxx,
,
we start a packet by notifying framer to send
preamble. this gives us
64 bit times during,
which we prime our 32 bit fifo. thereafter we
send one bit for each new bit received. upon
,
receiving end packet indicator we empty the,
fifo while crc node generates the final 32,
bits that we pass through.                    

   738 list
214 tx delay 214 node 0 org reclaim,
,
00 buffer 32 words 20 org,
,
@!+ an-a'n' 20 a push push dup a!,
..
1 . + 31 and @ pop ! pop a! ;,
,
run 27 begin @ dup !b - -until dup or
fill
a-a 2A 31 for @ @!+ drop next,
pass a-a 2E @ -if*,
..
purge a-a 2F push 31 for dup @!+ !b next*,
..
crc a-a 33 31 for @ !b unext pop !b run ;
body
a-a 38 then @!+ !b pass ;,
3A reclaim                                    


114 calculates and attaches crc.,
,
+crc inserts one bit. hl is 32-bit crc packed
..
into a 36 bit number, 14/18. m tests the bit
..
shifted out of high order.
run
passes link-down msg and starts crc when,
..
packet arrives. the packet must be longer,
..
than 32 bits due to loop structure.
trail
ends pkt by running 32 zeroes into the,
..
crc and then clocking it out, whole word,
..
msb first.,
..
trail takes on the order of 2.5us or 25 bit,
..
times before it sends the first crc bit down
..
the pipeline. hence the special delay node.,
,
outgoing data...,
..
-1 force renegotiation of link.,
..
n packet of n bytes follows,
....
0/1 data bits, n*8 words,
....
20000 end data marker,
....
0/1 crc bits, 32 words                    

   740 list
114 tx crc reclaim 114 node 0 org +cy,
+crc mhlb-mhl 200 push dup . + pop or push,
..
dup . + over over and .. 204 if ** then,
....
205 or 130 or pop 11DB7 or ;,
..
209 ** then drop pop ;
run
20A begin @ dup !b - -until,
..
20C 4000 clc dup dup or dup 31 for,
....
211 @ dup !b 1 or +crc next,
..
ahead begin dup !b +crc swap then @ -until
trail
219 !b 31 for 0 +crc next