0 list
                                              

21005595nngl
tnnv3e tstnngl tstev3e 3B4 138688anmn iyllts m
ofww 9A022 rmsdsd rd4nss 8F0 mlost 344FE3 o@
k -602 dn ,ofml 8ersns -24879592 -1059869440
?zol FE2F47FF 24FFFFF 7B9?9ol CBAFFF A4D ?6olt
FD2F47FF 24FFFFF ADFFFFFD
/ialrd
tinvzia -64060322 FC768DDA towk ???ls ooveas 2
02700 -336692919
ooveam 202700 -1449 FF6BCA4F e FF47FFFF ???ls
E1D 417857536 FFF 2476167ar 3B4 -61472360 kto
see ???y .waecl
'?t?s ramn rriooln 3B4 -65520552 49233959 FF5
FFFFF -1946157059 B21,ofml ielt k ???n8 t
tsolttd 404064512 -33029887
t?fqe 33F47FF FF47FFFF -323352 802C0F 257mn B4
1 ?gak 2E3FFF
9449019 1573121?gok FE3B37FF -1929229568 B19te
ks 6FFFFF re 303107849
rirn rct rd 0F0tcajrt 20013393 421735207 rd 0F
0                                             

    2 list
E1D -1979943283 20776200misd FB528D00 tigsaed
ooiaiaw ,ofmls fret ln -2130623861 inmwz8 66
4802697rnks FFF 868480512 C9330278
wlro7s ???? -16 D0035AC3 2A4
gw;ls 281F17 ai miaw9 snmd 539475093 tstson88
e tst 227239619 180D3B66 62914817 re -3302988
7 mnur 080rz tstmw 344FE3 FFFFFFFDtsnrenv3e at
mwws mw 344FE3 400045inml k -36 71709695 3A5 m
wmwae 2046823 5C61Fk
???@ 204 -1854360 go0 127FFFF ie 2046D68 kwaec
204 344FE3 -897 FD1F8127 -1012022355 141AC5A
45613313 tsas+'s -7192 FFD4574F 1EC5FFF sgynid
oo ?;n FC480007 1C0ds 13C887
o4e?u 9E4 121ggynrs 8769060nn bdp; 'waec
s23on 8nm
rimttt8 mt sn iaecrrs 1459617790 doagtak FFFFF
FFB tsnrmitar -785 FE063C0F 46661632 ag8iae FC
0D6AF2 369098752aianvs 3000B08Dow0 FC5FFFFF 18
B900ktm ???/ r@ecfe 1005815E 257gl
?t/ln 2E3FFF
tso ki??8 ???6 8keol @cwv0 o -6815487 r -43515
647 61D o7??8 5C02B
mn 29387102 66060545 is 13880 lt rl, dmntf 1
358962728 gi-
ecfik FC768DC3 ?6 FF480007 ???we 3B4 523712 FE
174807 FFF 344FE3 FE060605,4*t 3B46FFF w 42109
43 ??nci FFE3B46F ks 89FC768D -522816s6y FFF  

5F47FF FC5FFFFF mgrd 344FE3 7C005teo4 ps
ie -1073694666t?as ,akat FE0FFFFF ei 3B4 -522
816 1EC0807 12060020k ??,c 3B4 -125864 -11227
27168 ???? -1928987967 344FE3 FFFFFFFDteo4 ps
ie -1061111803b!drs 2102117 2102075 100
9B 1009C -21209 FFE3B46F ox ln
o4a8 65849
tieeo0-8e 29486152 +s -5009 FDE8A45F         

    4 list
0801sedd -8436199 FD6FFFFF
?!oln 2FFFFF 8415278tsos 069mw 344FE3
a !wor 145228977 oeer FC568458 io 60245632 .j
i*n 824628208 6842688vs -10089 13C250Foeml 199
22284 -327960 FC202E3F bs 256,ofml           

* -29884160 5373035522 ge -37748480 1 -34193 F
FAD474F FDE2CFFF 3B46F0F w 655360 knmpr frs*rl
.fe-is djtt, aigltos -8i9 '8 v3aik
-125085697 an titsnf-n lwu tmenw2 gl
r -39321343 109706358 tkrs?s ??*? 3B4 -1158278
4 -59768833 344FE3 t/zwe 3B46FFF mn -271652410
6FFFFF .3e E8FFFFF9 ???, -48297 3C4287F -6081
7409 g 12E1801???? -48489 FC68245F
,ofmw 3F4BA66 0i 1123644384 mw 56028800 8!ox
3CFFFFF -1263733525 8'wi *oguis 28379312 -361
FFFDF747 FF3767FF vd -13680545 3AFFFFF ftr+
?5il FEAF47FF 3A7FFFF weu FEE1E6EE v,ygd -3371
09840 FDCFFFFF -974454095 -31174609 376879 - -
423327228 r 6128655 -29675393 -1342004992
k
???. 9973307 100r 100
k ???- r0ltrk 3CFFFFF rnfrs, -1281 FF473587 FF
E 26005F2 BFC35EA5 frewu ?ynk FE2D87FF relan,
100 344FE3 2069971 grv-i -385518320 ???k -1545
86173 276102912 3B4 37748160eak FD6FFFFF
?/*rs FDFF47FF 2BFFFFF dseik i?e 2FFFFFF A05
?7*rs FCFF47FF 2B7FFFF dseins 65486871 2F7FFFF
inmwiw k -302 61D -2689 FD8EB45F -807104 2CF47
FF iy??@ w
4!oted am??@ -1329 3B45AB7 -433 FFFDC2F7 k ??
?3 1989002157 k -5578 -53937 FF2EAF47 FCBF47FF
FE37FFFF 96928000 tiw 361AC6A w8 3571712 tif
sonlwu 1AC -61341259 DA0a.t@d til0 2E3801 1013
A tia 95kilk 21F4FFF 0                      

    6 list
7F807 tiidt8ri.xias 2E3D6A 2098881 tis 07Ed
sabs -25689856 bs -65536@pols AC5FFF ed
mt C20,ofml
ec 40158904 ks FFFFFFEB 65725 65709 21
02689 2103292 65726 100BD 20048A 0AE 20
98314 468245 t0nsr 722077987tt 2104362 75D 9
40tdnpe ln 65849 745 AFFFFF 662701511rn3 07E
268443663 bs 538501120ne ; FE380100 -65536!yrk
A7FFFF -236212992 csantae 8CC2neramt sn ramttr
d 65851 -22473 FCA0AC5F 82548DD0 -338493523   

                                              

    8 list
w 526796
,ofmw t -31981504 3B4 5158336 -59893760 344FE3
404F0Dinmw w 526819
,ofmw anw -1979943283 5195200 -59893760 344FE3
404E8Dinmw w 526858
,ofmw nowvs 3B4 5146048 -59893760 344FE3 12980
5inmw w 526797
,ofmw qadrl vs 3B4 4138432 -59893760 344FE3 40
2935                                          

                                              

    10 list
65611 65612
                                              

iv;@8 -267388897 8 -4128896 o-9;n 7F80FF      

    12 list
                                              

31803
                                              

    14 list
d
d                                             

                                              

    16 list
24                                            

compile x86 colorforth
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

dump compile memory display background task
icons compile icon editor
png screen image to file
---
editor
sct yrg* all-caps cap lower-case yellow red gr
een * toggles shadow comment block
fj ludr find jump left up down right
.. -mc+ dec-block magenta cyan inc-block
x.i delete exit insert
. jump jumps between -edited- blocks
f finds next word from find word              

    18 list
ns 240 nblk 1440 nc 7 cr
colorforth v4.2e2+ g4/1.2 chuck moore cr
20 load 22 load 24 load colors 28 load cr
decompress mark 30 load restore empt
env 34 winver 2* + ; env ironmental load 46 lo
ad 62 4 loads 88 load br

dump 48 load ; background dump
floppy 52 load ; format, archive, set video
icons 54 load ; edit chars
c-a-c 70 ; ascii
audit 90 load ; disk audit utility
png 168 load ; png file format
html 176 load ; html file write br

blocks 0-143 are public domain software cr
mark empty arrayforth 144 load                

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
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
macro
swap 168B 2, C28B0689 , ;
0 ?dup C031 2, ;
if 74 2, here ;
-if 79 2, here ;
while n-nn if swap ;
-while n-nn -if swap ;
a ?dup C28B 2, ;
a! ?lit if BA 1, , ; then D08B 2, drop ;
2* E0D1 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 ;
u+ ?lit if 681 2, , ; then 44601 3, drop ;
? ?lit A9 1, , ;
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 -n pentium cycle counter, calibrate to ac
tual clock rate
7push/7pop save/restore save register 7, edi
@-drop these macros redefined in forth so they
may be executed
negate n-n when you just cant use -
min nn-n minimum
abs n-u absolute value
max nn-n maximum
v+ vv-v add 2-vectors
loads load successive blocks
nc -a 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            

    24 list
compiled macros
2/ F8D1 2, ;
time ?dup 310F 2, ;
7push 57 1, ;
7pop 5F 1, ; forth
@ @ ; -cr  ! ! ; -cr  + + ; -cr  - - ;
*/ */ ; -cr  * * ; -cr  / / ; -cr  2/ 2/ ;
dup dup ; -cr  drop drop ; -cr  nip nip ;
or or ; arithmetic
negate - 1 + ;
min less if drop ; then swap drop ;
abs dup negate
max less if swap then drop ;
v+ vv-v push u+ pop + ; vector
loads bn for dup push load pop 2 + next drop ;
writes acn for write next drop drop ;
reads acn for read next drop drop ;           

                                              

    26 list
                                              

block n-a block number to word address
wrtboot write boot and kernel
save write entire image to floppy
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 letters
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 ;
save 84 load ;
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 1 3 C 3 A 5* green 14 2 1 3 E
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
literal 1-bit base base, tag. value in next wo
rd
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 ;
literal 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 literal word
word literal short word short word word word v
ariable 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 300
0 block 18 blks nc @ -2 + * move 3000 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
decompress 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 1 nb -6 h 67510272 an 0
aa 67931074 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 load ;
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 96 ;                                

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.
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 ; -cr  clock 38 load ;
topram -cr  altfrm -b endram -4096 768 * + ;
!work n dup block 1 + @ 1 + 2/ wwork ;
@back n dup 19 rback dup 18 + block dup @ 18 b
lock @ or drop if drop 1440 rback ; then dup 1
+ @ dup and -if nip abs 1 + 2/ rback ; then dr
op 3 + @ rback ;
!back n nblk @ wback ;
@cyls acn 3000 @back push 18 * 3000 + block sw
ap pop 18 256 * * move ;
screen 0 dup at 868 for 0 1024 line next 0 dup
at ;
serial -n 114 ;
fopen af-h push push 0 32 exist 3 0 0 pop pop
swap 4 * fcreate ; flng 33793 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? ; -cr  r/o 80000000 ;
w/o 40000000 ; -cr  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
windows 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
                                              

                                              

    44 list
                                              

logo, etc
logo displays colorforth logo
show background task executes following code r
epeatedly
keyboard displays keypad and stack
empty empty dictionary w/ empt display logo
wait while saving edi, in interrupt dead code
artifact
list displays the given block without entering
the editor. br

-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                            

    46 list
logo, etc
list n blk @ blk 1 + ! blk ! lis ;
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 ;
empty empt logo ;
wait 10 30 * for 7push pause 7pop next ;
l blk @ load ; br

156 load
watermark show black screen 16 center 404060 c
olor blk @ 4. +list keyboard ;
edit n blk @ blk 1 + ! blk !
e watermark +e ; br

-kbd -t 7push pop dup and 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 g18 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 75530240 y -79636112
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 greg tmt 515626134 tmn 1780009900 tmp -
360017368 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
format floppy 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 3000 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 53 cu 169
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 @ . 400 60 set keyboard ; 56 load ok h

edit icon                                     

    56 list
edit character set application
+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
lan empty 3F8 60 load init
no block 4 * 1024 ;
send no for dup 1@ xmit 1 + next drop ;
receive no for rcv over 1! 1 + next drop ;
no 18 7 18 * ;
backup no for dup send 1 + next drop ;
accept no for dup receive 1 + next drop ;     

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.
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 tcurs macro
bt nm-n 68BD08B , F04768D , D21BC2A3 , ; forth
t2 nn-nn 1 +
t1 nn-nn 1 curs +!
t0 nn-nn 1 + ;
map nnn-nn F and jump t0 t1 t2 t1 t1 t2 t1 t1
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
tag? nz and less if bit in m indexed by tag of
token n is 1.
+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
word search fmask -16 fnn -403177456 fna 67146
240 fbits 24218 18 block fna !
tag? nm-n over F and swap bt drop ;
+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 ;
find 1word 5E9A
fnd+ 18 block -16
fnd nbam fmask ! fna ! fbits ! 16 or fnn !
f fnn @ 16 or fna @ begin +shad nblk @ block l
ess drop while over over @ fbits @ want? fmask
@ and drop while 1 + end then dup 1 + fna ! ni
p 100 /mod -offset swap tcurs edit ; then drop
drop ;
red? n-nm 1008 tag? if 4092 ; then 1008 ;
def 1word 1008 fnd+ ; here ekt 21 + !
fkc drop drop pcad @ @ 140 tag? if 32 / edit ;
then red? fnd+ blk @ dup ; here ekt 22 + !
fk drop drop cad @ fna ! 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 + !               

?xqt executes the word just passed over if it
exists in the dictionary.
@lit fetch 27-bit literal
tadr display target address
blu display blue word
d14 tag 14 display entry
exb display and execute blue word if found.
tab advance n spaces
indent 5 spaces
br blank line
s/2 halfspace for reports.
-cr suppress cr on next red word.
seeb toggle display of blue words
?seeb set flag non-zero if blue words visible;
indent
     only useable in a definition             

    68 list
blue words
-w@ -n 7push pop -1 + @ ;
?xqt -w@ -16 and itick if drop ; then push ;
@lit -w@ 32 / ; here display 13 + !
tadr C0C0C0 color @lit 3 h.n space ;
blu FF color
type1 9 display + @ 5 + push ;
d14 14 display + ; here d14 !
exb blu 1 sp + @ push ?xqt ;
tab n for space next ;
indent cr 5 tab ;
br cr cr ;
sp/2 B0000 xy +! ;
d03 -a 3 display + ; here
exr d03 @ nop d03 ! space red type1 ;
-cr 0 + nop d03 ! ;
seeb d14 @ d14 @ dup 5 + or or d14 ! ;
?seeb -t d14 @ d14 @ 5 + or drop ; seeb       

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

    70 list
convert colorforth character to/from ascii mac
ro
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 ;            

colorforth to ascii and ascii to colorforth
cf-ii otr inae ycms wfgl bpvd quxh 3210 7654 -
j98 /z.k +!'; ?,*@
ii-cf ! +* /.-, 3zjk 7654 ;'98 ? cba@ gfed 02i
h onml srqp wvut 1yx cba@ gfed 02ih onml srqp
wvut 1yx
set1 modifies cf-ii table. cr
; to colon, ' to doublequote, + to equal, cr
@ to lessthan, * to blank, ? to greaterthan
set0 converts back to ascii.                  

    72 list
convert cf character to/from ascii macro
1@ 8A 2, ;
1! a! 288 2, drop ; forth
string pop ;
cf-ii align string 6F747200 , 696E6165 , 79636
D73 , 7766676C , 62707664 , 71757868 , 3332313
0 , 37363534 , 2D6A3938 , 2F7A2E6B , 2B21273B
, 3F2C2A40 ,
ch FFFFFFF0 and unpack cf-ii + 1@ FF and ;
ii-cf string 2A00 , 2B , 2B2D0000 , 2725232E ,
1B1A1918 , 1F1E1D1C , 28292120 , 2F000000 , 3A
43355C , 3D3E3440 , 54523744 , 3336393C , 3831
4742 , 3F414632 , 563B45 , 23000000 , A13052C
, D0E0410 , 24220714 , 306090C , 8011712 , F11
1602 , 260B15 ,
chc FFFFFFE0 + ii-cf + 1@ FF and ;
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. br

inam accept filename input from keyboard, stor
e zero terminated ascii string to fnam, and re
turn byte address of fnam.                    

    74 list
pathname input 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
exit testing
ccc dup 1@ 255 and swap 1 + ; cr
named //./a;                                  

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                             

    76 list
index empty cr
72 load cr
hld 0 0 hld ! spot 0 0 spot !
nxt a-an dup 1 + swap @ ;
emit c spot @ -72 + drop -if hld @ 3000 block
4 * + 1! 1 hld +! 1 spot +! ; then drop ;
space 32 emit ;
crlf 0 spot ! 13 emit 10 emit ;
digit n -10 + -if 3A + emit ; then 41 + emit ;
.h n space -1 swap cr
begin dup F and swap 2/ 2/ 2/ 2/ cr
FFFFFFF and while end then drop cr
0 + -if drop 0 digit ; then
spit 0 + -if drop ; then digit spit ;
.d n space 0 + -if 2D emit negate then -1 swap
begin 10 /mod dup and while end then cr
drop spit ; cr
78 load                                       

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
index first-block last+1 cr
prints first line of each block in range cr
to a log file in windows                      

    78 list
index.1
short n 2/ 2/ 2/ 2/ dup 1 and drop cr
if 2/ .h ; then 2/ .d ;
literal an-a push nxt pop 10 and drop cr
if .h ; then .d ;
word n space FFFFFFF0 and
cont n dup and if ch emit cont ; then drop ;
variable an-a word nxt .d ;
eol n drop pop drop pop drop drop ;
tag a-a dup F and jump cont word literal cr
eol word literal short word short word cr
word word variable short word short
words n for nxt tag next drop ;
index 1st lst+1 0 hld ! over negate + 2/ cr
for dup .d dup space block 10 words crlf cr
2 + next drop
sav 3000 block 4 * olog hld @ wlog clog ;     

                                              

    80 list
                                              

                                              

    82 list
                                              

short tag, then 28bit value+base
literal 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.
words 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
compress empty 86 load
short 4 rbits 28 bits ;
literal 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 word ;
tag an-an dup F and jump cont word literal wor
d word literal short word short word /whit /wh
it variable short word short
words a dup @ dup and if tag drop 1 + words ;
then 4 bits drop drop ;
range nn-an here/4 here4 push new for dup bloc
k words 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 ! ;
sve 7push 36 nblk @ -36 + range an !lng drop 0
block 3000 block 36 blks move 3000 !work ns @
abs ns ! 7pop ; 3036 block 4 * h ! sve        

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
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
word shift tag, then characters
cont continue without tag                     

    86 list
compress macro uses ebx
b ?dup C38B 2, ;
c! C88B 2, drop ;
2*d C3A50F 3, ;
2*c E0D3 2, ;
2/r C8D3 2, ; forth nb 4
here/4 here 3 and if 1, here/4 ; then drop ;
here4 here 2/ 2/ ;
new 32 nb ! ;
shift nn-n dup negate nb +! c! 2*d 2*c ;
rbits dup c! swap 2/r swap
bits nn-n dup negate nb @ + -if dup push + shi
ft b , new pop negate shift ; then drop shift
;
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 ;
word an-an 4 rbits
cont chars over 1 + @ dup and if F and drop if
4 bits ; then ; then drop 4 bits ;            

these definitions support text display and are
used in other parts of okad as well. 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 one-word comment. 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 -cr  dst 1, @ret tick here 3 + - + , ;
jmp E9 dst ; br

.shan n- dup and if unpack emit .shan ; then d
rop ; -cr  +str a-a + ; macro
,lit n ?dup B8 1, , ;
strings i-a 7push pop ,lit jmp +str nop ;
.' comment 7@+ @ -16 and ,lit call .shan nop ;
forth br

' -b -kbd if 7@+ @ itick if abort then ; cr
then tic ;
execute b push ;
eval a 7push 1 + push 7pop sp 1 + @ execute 7p
op ;                                          

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 cr
sep 3000 3000 sep ! head 1439 1439 head !
+blocks sdn 2* bloks ;
bloks sdn push swap block swap block pop 256 *
move ; -cr  n18 i-a 3018 block + ;
wipe blk @ 1 erase e lis ; -cr  to n head ! ;
obliterate lh over negate + erase ;
matching sd less if swap then dup bias ! negat
e + sep ! ;
cast nm-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
+ ; -cr  ?blks sn-? for ?blk next drop ;
?bin kernel 0 12 ?blks icons 12 6 ?blks ;
unpk abs 1 n18 ! 3036 block 5000 block 1404 bl
ks move 5000 block 3036 3 n18 @ -36 + range ;
check 3000 @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.  

    92 list
compare
blink 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
+or nn-n over - and or ;
?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 d
rop blink ; then 1 + 1 u+ co ;
com n-n dup block over other block co ;
g blk @ lesser
gg n 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 ;
check 3000 @back ;
all 0 3000 matching nblk @ -1 + to 17 gg ;    

                                              

    94 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.
+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.             

    96 list
native async 96 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 +! ;
+or nn-n over - and or ;
?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 98 load 118 load routes 120 load cr
generic 122 6 loads panel 134 load cr
user 136 load canon 138 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 com port address
4@ and 4! full cell on byte address.
+sea opens serial; true if good, handle in dh.
-sea closes the handle.
/sea resets the chip.
tosea transmits n bytes to chip.
insea receives w g18 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!                     

    98 list
async umbilical 3F8 serial 60 load
rsh ni-n 0 + if for 2/ next ; then drop ;
sdat align create 16384 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

+sea -ok init 1 0 + ;
-sea ;
reset 2 st! 100000 for next 0 st! ;
tosea bn for dup 1@ xmit 1 + next drop ;
insea w stream swap 3 * for indent
     rcv over 1! 1 + next drop ;              

talk to seaforth 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.             

    100 list
onspec usb interface 100 orgn ! macro
1@ b-c 8A 2, ;
1! cb a! 288 2, drop ;
2@ b-h 8B66 3, ;
2! hb a! 28966 3, 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/ ;
bofs bw-b'b over + swap ;
ofs bw-b'a bofs b-a ;
create -a pop b-a ;
rez n h +! ;
+or nn-n over - and or ;
?zero n-n 0 or if dup or ; then - -1 or ; br

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

usb 102 5 loads routes 112 load cr
generic 122 6 loads panel 134 load cr
user 136 load canon 138 load                  

nam pathname buffer
spq argument for inquiry
obuf buffer for inquiry return
len bytes returned from fioctl calls br

inq makes device inquiry, returns true if ok
?sea true with indic if reply vendor seaforth
cr
+sea finds a forthdrive. true if found, handle
in dh.
-sea closes the handle.                       

    102 list
find/open/close onspec
nam -a align create //./ 2F2E2F2F , d' 3A47 ,
obuf -a align create 512 rez len 80
spq -a align create 0 , 0 , 0 ,
inq -ok len 512 obuf 12 spq 2D1400 dh @ fioctl
; br

-sea dh @ 0 + if fclose 0 then dh ! ;
?sea -t obuf dup 3 + @ b-a + dup @ 66414553 or
swap 1 + @ 6874726F or +or ?zero ;
+sea -ok 3A44 nam 1 + ! 20 for nam r/w fopen d
h ! if inq drop if ?sea if pop drop ; then dro
p then then -sea 1 nam 1 + +! next 0 ;        

/sdb total length of scsi structure, bytes br

sdb scsi structure word adr unless -b
nsdb -b length in bytes thru cdb
ncdb -b length of cdb in bytes
i/o -b 0 out 1 in 2 no data
ndata -a length in bytes of data transfer
nto -a timeout in seconds
'data -a offset in bytes to sdat
'sns -a offset in bytes to sns
cdb -b scsi command
sdat -b scsi data br

!cdb initializes sdb for cmd whose word adr an
d byte lng are given. data xfer params must be
set before /scsi.
!xfer sets length in bytes and direction of da
ta transfer.
/scsi executes scsi command returning api stat
us not necessarily scsi status.               

    104 list
scsi operations
/sdb -n 28 16 + 32 + 16 1024 * + ; br

sdb align create /sdb rez struc sdb a-b
nsdb -b 2 bofs ; sstat 1 + 3 +
ncdb -b 1 bofs ; nsns 1 +
i/o -b 1 bofs ; 3 +
ndata -a 4 ofs ;
nto -a 4 ofs ;
'data -a 4 ofs ;
'sns -a 4 ofs ;
cdb -b 16 bofs ; sns 32 +
sdat -b 16 1024 * bofs ; drop br

!cdb an 0 sdb 28 16 + 32 + b-a fill 28 16 + du
p nsdb 2! dup 'sns ! 32 + 'data ! 20 nto ! dup
ncdb 1! cdb b-a swap b-a move ;
!xfer ni i/o 1! ndata ! ;
/scsi -ok len /sdb sdb over over 4D004 dh @ fi
octl ;                                        

lok and -lok perform the lock and unlock volum
e functions that are apparently required aroun
d a scsi command.
scsi executes a scsi passthrough command with
proper lock protection. br

onspec custom scsi command blocks-
/os cycles chip power and resets it.
wos writes synch to chip
wos! writes and leaves lines tristate.
ros reads synch from chip.
!nbits sets bit count field in command, limit
32 or 64k br

/sea resets the chip.
tosea transmits w halfwords, b bits with op wo
s or wos! as you wish.
insea receives w g18 words from the sync boot
node. the data in our memory are in onspec for
mat both directions.
mute properly closes the handle.              

    106 list
onspec vendor unique ops
/lok f-ok push len 0 0 0 0 pop dh @ fioctl ;
lok 90018 /lok drop ;
-lok 9001C /lok drop ;
scsi -ok lok /scsi -lok 0 + ; br

/os align create FA20 , 0 , 0 2,
wos align create FB20 , 0 , 0 2,
wos! align create 2FB20 , 0 , 0 2,
ros align create 1FB20 , 0 , 0 2,
!nbits h swab cdb 7 + 2! ; br

/sea -ok /os 10 !cdb 0 2 !xfer scsi drop ;
tosea wbo 10 !cdb !nbits 2* 0 !xfer scsi drop
;
insea w ros 10 !cdb 18 * dup !nbits 14 + 16 /
2* 1 !xfer scsi drop ;
mute -lok -sea ;                              

onspec data are a continuous stream of bits in
consecutive bytes, left to right, except that
bytes are swapped in halfcell units. cell fetc
hed on any halfcell boundary and half-swapped
has continuous bits running from hi to lo. br

4@ and 4! full cell on byte address.
lsh and rsh left and right arith shifts.
swah swaps hi and lo halfcells of a number. br

-stream clears bit index bi in sdat buffer.
stream halfcells and bits within index.
/str cell addr, shift count for next 18. 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!                     

    108 list
onspec bitstream bi 0 macro
4@ b-n 8B 2, ;
4! nb a! 289 2, drop ;
swah n-n C1 1, 10C8 2, ; forth
lsh ni-n 0 + if for 2* next ; then drop ;
rsh ni-n 0 + if for 2/ next ; then drop ; br

-stream 0 bi ! ;
stream -wb bi @ dup 15 + 16 / swap ;
/str -bi bi @ 16 /mod 2* sdat + swap - 15 + ;
cr
@18 -n /str push 4@ swah pop rsh 3FFFF and
+wd 18 bi +! ;
!18 n 3FFFF and /str swap push i 4@ swah push
push i lsh FFFC0000 pop lsh pop and or swah po
p 4! +wd ;                                    

boot frames begin with a 3 word header; indent
     100xx jump to xx when done indent
     ddd mem/port adr to store payload indent
     nnn transfer length indent
     nnn+1 * 2 words of payload
/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! br

talk prepares chip for control thru node 19.
exch performs a transaction with target given
addr and length of port stream, stream end act
ion in node 19, and number of words reply. br

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.

    110 list
node 19 boot frames inop for ga4
/frame nw xfr jmp -stream 10000 + !18 !18 1 +
2/ -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 op push stream pop tosea ; br

exec B6 ;
talk cold mute +sea if lok drop /sea 40 0 exec
/frame 0 40 19 +ram wos !frame good ; then bad
-sea ; br

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! !fra
me pop insea -stream ; br

ok 18 ;
fet 1C ;
stat 23 ;
bstk 25 ;                                     

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

this block has plenty of extra room so that yo
u may customize the available lists without ch
anging the reference versions.                

    112 list
route lists inop for ga4
0pa align create 19 , 29 , 39 , 38 , 37 , 36 ,
35 , 34 , 33 , 32 , 31 , 30 , 20 , 10 , 0 , 1
, 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 19 , -1 ,
1pa align create 19 , 18 , 17 , 16 , 15 , 14 ,
13 , 12 , 11 , 21 , 22 , 23 , 24 , 25 , 26 , 2
7 , 28 , -1 ,
2pa align create 19 , 9 , 8 , 7 , 6 , 5 , 4 ,
3 , 2 , 1 , 0 , 10 , 20 , 30 , 31 , 32 , 33 ,
34 , 35 , 36 , 37 , 38 , 39 , 29 , 28 , 27 , 2
6 , 25 , 24 , 23 , 22 , 21 , 11 , 12 , 13 , 14
, 15 , 16 , 17 , 18 , 19 , -1 , br

                                              

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.             

    114 list
windows async 114 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
a-b a-b 2* 2* ; -cr  b-a b-a 3 + 2/ 2/ ;
create -a pop b-a ; -cr  rez n h +! ;
+or nn-n over - and or ;
?zero n-n 0 or if dup or ; then - -1 or ; br

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

ser 116 2 loads routes 120 load cr
test boot frames 1304 load cr
once orgn @ dup and drop if ; then -pwr ; cr
once 114 orgn ! cr
generic 122 6 loads panel 134 load cr
user 136 load canon 138 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
4@ and 4! full cell on byte address.
snam null terminated string //./comx
!nam sets port number in snam.
+sea opens serial; true if good, handle in dh.
-sea closes the handle.
-pwr refreshes handle + sets reset low
reset releases reset line high
tosea transmits w halfwords, b bits with op wo
s or wos! as you wish.
insea receives w g18 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!                     

    116 list
async umbilical sport 18 18 sport !
rsh ni-n 0 + if for 2/ next ; then drop ;
sdat align create 16384 rez bi 3
-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
+sea -ok snam r/w fopen dh ! if 1 ; then 0 ;
-sea dh @ 0 + if fclose 0 then dh ! ;
ctl! n dh @ fesc drop ;
-pwr cold -sea +sea if drop 3 ctl! ; then -sea
;
reset 4 ctl! 500000 for next 4 ctl! ;
tosea bn dh @ fwr drop ;
insea w stream swap 3 * dh @ frd drop ;       

boot frames begin with a 3 word header; indent
     100xx jump to xx when done indent
     ddd mem/port adr to store payload indent
     nnn transfer length indent
     nnn+1 * 2 words of payload
/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! br

talk prepares chip for control thru node 19.
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. c
r
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 0 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 @ tosea ; br

exec 6E 6D ;
talk cold -sea +sea if drop reset 40 0 exec /f
rame 0 40 33 22 +ram wos !frame good ; then ba
d -sea ; cr
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 insea -stream ; br

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

this block has plenty of extra room so that yo
u may customize the available lists without ch
anging the reference versions.                

    120 list
route lists
0pa align create 0 , 10 , 11 , 1 , 0 , -1 ,
1pa align create 0 , 10 , 11 , 1 , 0 , -1 ,
2pa align create 0 , 1 , 11 , 10 , 0 , -1 , br

                                              

this code supports boot node controlling one o
f its immediate neighbors directly. these all
begin with focusing call and each must return!
cr
port returns port for 0-3 rdlu ndx, then edges
wall is index for port between two nodes br

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 nn-i over over or 1 and drop if or 2 and
; then 10 / swap 10 / or 2 and 1 + ; br

do! align create @p+a!.@p+ 4AB7 , indent
     0 , 0 , !;;; B555 ,
do@ align create ...@p+ 2C9B7 , indent
     0 , a!@!p+; 2BE35 ,
doi align create 10000 ,
dopu align create @p+; 5555 , 0 ,
dostk align create !p+dup-push!p+ CDBE , br

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 67523448
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. 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            

    126 list
umbilical plumbing
using nn wall port vport ! ;
avail n-p nn-n idle ; br

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

rip nw-nw 0 u+ if post -5 + +pump 1 +path rip
-1 +path then 1 ?path avail +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 21 +load 0
side +post ; then last 0 20 dup -1 + 20 +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 0pa , 1pa , 2pa , 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 ;
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 ;
@+ 9 rop ; -cr  !+ D rop ; -cr  !b E 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

io D1 ; -cr  data DF ; -cr  up DD ;
down F5 ; -cr  left C5 ; -cr  right 95 ;      

code for panel
panel 134 list ;
.s silver cr cr stak 6 + 4 for dup @ 5 h.n spa
ce 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 act @ cr 3 for cr i -1 + path act @ ?colo
r . paths dup 1 + @ . targets @ dup . + @ . ne
xt path ; br

/ram align create 64 a-b rez
rsp n dup 1 and drop if sp/2 then ;
.ram silver cr /ram 64 for i 7 and ?zero drop
if cr space then i rsp dup @ 5 h.n i 1 and dro
p 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.
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 ;
all n nn-n for i me 0pa @ or drop if i n-nn on
e then -next ; br

!dac n i 2 swap hook 155 or 15D io r! ;
!dacs n dup 36 !dac dup 37 !dac 11 !dac ;
nn n-n -1 + dup !dacs ; br

ms 100000 * for next ;
watch begin upd rdrop pause 1000 ms key? end ;
?ram 0
suck a /ram 64 for over r@ over ! 1 + 1 u+ nex
t drop drop ;
?rom 40 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
@ 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! ;                                      

                                              

    140 list
                                              

                                              

    142 list
                                              

main load block for okad2 applications
cur cursor position
first execution of hardsim. initializes least-
squares variables br

ray defines i-a array usage align ray
aray use after red to make ray of n cells
uatbl lists transistor table addresses of the
devices so far found to be conducting current.
ntbl is number of active uatbl entries.
nil clears the table.                         

    144 list
arrayforth tm and okad tools and designs cr
copyright 2009-2010 greenarrays, inc. cr
first -1 -1 first ! cr
cur 1202462 config 148 load br

.s ; defaults for blue words
.pth ;
.ram ; br

ray i-a pop 2/ 2/ + ; ntbl 0 0 ntbl !
aray n align call ray 4 * h +! ;
uatbl i-a 1000 aray
nil 0 ntbl ! ; br

png screen capture png cr
chip design 900 load                          

                                              

    146 list
                                              

names for blocks that are customized to config
ure tools while designing and testing.
cfuse two cylinders on cylinder boundary - 18
blocks plus shadows - actively loaded and used
cftape default image of config area under chan
ge control in base br

exit terminates interpretation of a block.
tbl self fetching cell array. usage'
squared i-n align tbl 0 , 1 , 4 , 9 , 16 ,
assign places addr of following code in the lo
cation given and exits current definition.
xqt calls the code whose adr is in the var giv
en.                                           

    148 list
configuration blocks orgn 0 0 orgn !
exit 7pop 7pop ;
tbl i-n pop 2/ 2/ + @ ;
assign a pop swap ! ;
xqt a @ push ;
cfuse 648 ; active cfuse load
cfchip 650 ;
cfpins 652 ;
cfstart 654 ;
cfpads 656 ;
cfprobe 658 ;
cfsim 660 ;
cfstep 662 ;
cfscale 664 ;
cftape 756 ; tapeout default
readme cfuse block nop cfuse 18 / 2 @cyls ;
tapeout cftape block nop cfuse block nop 36 25
6 * move ;
recompile 940 load orgn @ load lis ;          

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

    150 list
redact okad disk audit br

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

okad 146 148 obliterate 190 cfuse obliterate c
fpins 890 obliterate cr
chip 902 940 obliterate 944 1248 obliterate br

type save to commit changes                   

                                              

    152 list
                                              

                                              

    154 list
                                              

                                              

    156 list
big letters macro
*byte C80F 2, ; forth
clr aper 2 + ; sz 14 cur 8889344 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 3018 block + ;
unpk abs 1 n18 ! 3036 block 5000 block 1404 bl
ks move 5000 block 3036 3 n18 @ -36 + range ;
check 3000 @back 0 n18 @ 18 block @ or drop if
; then 1 n18 @ dup and -if unpk ; then drop ;
blink dup 3000 + 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 3000 + block co ;
q nn for com 2 + next drop ;
all 18 1439 -18 + 2/ q ;
old blk @ 3000 mod dup 3000 + blk ! copy ;    

compare roms
. put t18 rom into blocks 1420ff
see n-n compare roms for node n
u up 16 words
d down 16 words
n next node
b back one node
diff compare up to 64 words, t18 binary vs g18
compile. total match gets green screen. first
non-matching word causes a dump of that node.
note the double pop drop in diff. don't run it
as a command.
check run diff on all 40 nodes                

    162 list
compare roms compile empty x 887904 y 8913568
old n-a 64 * 1420 block + ;
new n-a 2* 8000 + block 80 + ;
spaces for space next ;
5-8 8 /mod 32 /mod 32 /mod 100 * + 100 * + 100
* swap 4 * + ;
it @ + @ dup 5-8 white h. space dup 15555 or 5
silver h.n space ;
lines for i x it i y it white or if red dup 5
h.n then drop space i 1 h.n cr -next ;
u 16
+xy dup x +! y +! ;
d -16 +xy ;
n 1 +
see n-n dup old x ! dup new y ! show black scr
een text 15 lines green x @ h. 7 spaces y @ h.
keyboard ;
b -1 + see ;
diff n-n dup old over new 64 for over @ over @
or drop if drop drop pop drop pop drop see ; t
hen 1 + 1 u+ next drop drop ;
check 40
more -1 + diff 0 or if more ; then drop show g
reen screen keyboard ;                        

                                              

    164 list
timing empty macro
out E1E6 2, ; forth
tare time - 1000 for next time + ;
tare+ time - push 1000 for dup next c pop time
+ ;
test tare time + - 1000 for out next time + ;
next 3 loop 5.7 /next 2 /swap 25 swap 7.2 macr
o
c! C88B 2, drop here ;
loop 49 1, 75 1, e2 here - + 1, ; forth
try time - 1000 c! loop time + ;              

                                              

    166 list
                                              

d is reduction factor                         

    168 list
png empty 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 23534 ad2 64494 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 ; -cr  +or over - and or ;
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 74 load cr
pad 271638528 3000 block 4 * pad ! cr
hld 271924577 pad @ hld ! 178 6 loads
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? 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 ;
.html first last+2 .hdr .blks .tlr ; cr
named cf.html                                 

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  .3hex display numbers     

    180 list
translate text and numbers pos 30
-bol? pos @ nz? ;
-eol? pos @ 46 or drop ;
.cr ,t1 @br? 0 pos ! ; cr
loop begin .cr -cr  emit c ch, 1 pos +! ;
.ch c -eol? until emit ;
.sp -eol? if -bol? if 20 emit ; then then ;
.2sp .sp .nb ;
.nb 26 ampersand .ch ,t nbsp sc ; br

.sp.tn n .sp .tn ;
.tn n ch if .ch .tn ; then drop drop ; br

.hd n -10 + -if 3A + .ch ; then 41 + .ch ;
.dec n .sp 0 + -if 2D .ch negate then -1 swap
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 .sp -1 swap begin hd FFFFFFF and while
end then drop spit ;
.3hex n hd hd hd drop .sp .hd .hd .hd ;       

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 br

.quirks n --cr @ nz? if .2sp drop 0 --cr ! ; c
r
then class nz? if -bol? if .cr then then ;
.space -eol? if .nb then ;
.indent .cr 4 for .nb next ; br

.blue n 9080000E cr eq? if .cr drop ; cr
then E721000E -cr eq? if 1 --cr ! drop ; cr
then 8625920E space eq? if .space drop ; cr
then 76C08C4E indent eq? if .indent drop ; cr
then C620000E br eq? if .cr .cr then drop ;   

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 .3hex ;
.te n ,c te ?seeb if dup .sp.tn then .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 005 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? ;        

                                              

    190 list
                                              

                                              

    192 list
                                              

                                              

    194 list
                                              

                                              

    196 list
                                              

                                              

    198 list
                                              

                                              

    200 list
                                              

                                              

    202 list
                                              

                                              

    204 list
                                              

                                              

    206 list
                                              

                                              

    208 list
                                              

                                              

    210 list
                                              

                                              

    212 list
                                              

                                              

    214 list
                                              

                                              

    216 list
                                              

                                              

    218 list
                                              

                                              

    220 list
                                              

                                              

    222 list
                                              

                                              

    224 list
                                              

                                              

    226 list
                                              

                                              

    228 list
                                              

                                              

    230 list
                                              

                                              

    232 list
                                              

                                              

    234 list
                                              

                                              

    236 list
                                              

                                              

    238 list
                                              

                                              

    240 list
                                              

                                              

    242 list
                                              

                                              

    244 list
                                              

                                              

    246 list
                                              

                                              

    248 list
                                              

                                              

    250 list
                                              

                                              

    252 list
                                              

                                              

    254 list
                                              

                                              

    256 list
                                              

                                              

    258 list
                                              

                                              

    260 list
                                              

                                              

    262 list
                                              

                                              

    264 list
                                              

                                              

    266 list
                                              

                                              

    268 list
                                              

                                              

    270 list
                                              

                                              

    272 list
                                              

                                              

    274 list
                                              

                                              

    276 list
                                              

                                              

    278 list
                                              

                                              

    280 list
                                              

                                              

    282 list
                                              

                                              

    284 list
                                              

                                              

    286 list
                                              

                                              

    288 list
                                              

                                              

    290 list
                                              

                                              

    292 list
                                              

                                              

    294 list
                                              

                                              

    296 list
                                              

                                              

    298 list
                                              

                                              

    300 list
                                              

                                              

    302 list
                                              

                                              

    304 list
                                              

                                              

    306 list
                                              

                                              

    308 list
                                              

                                              

    310 list
                                              

                                              

    312 list
                                              

                                              

    314 list
                                              

                                              

    316 list
                                              

                                              

    318 list
                                              

                                              

    320 list
                                              

                                              

    322 list
                                              

                                              

    324 list
                                              

                                              

    326 list
                                              

                                              

    328 list
                                              

                                              

    330 list
                                              

                                              

    332 list
                                              

                                              

    334 list
                                              

                                              

    336 list
                                              

                                              

    338 list
                                              

                                              

    340 list
                                              

                                              

    342 list
                                              

                                              

    344 list
                                              

                                              

    346 list
                                              

                                              

    348 list
                                              

                                              

    350 list
                                              

                                              

    352 list
                                              

                                              

    354 list
                                              

                                              

    356 list
                                              

                                              

    358 list
                                              

                                              

    360 list
                                              

                                              

    362 list
                                              

                                              

    364 list
                                              

                                              

    366 list
                                              

                                              

    368 list
                                              

                                              

    370 list
                                              

                                              

    372 list
                                              

                                              

    374 list
                                              

                                              

    376 list
                                              

                                              

    378 list
                                              

                                              

    380 list
                                              

                                              

    382 list
                                              

                                              

    384 list
                                              

                                              

    386 list
                                              

                                              

    388 list
                                              

                                              

    390 list
                                              

                                              

    392 list
                                              

                                              

    394 list
                                              

                                              

    396 list
                                              

                                              

    398 list
                                              

                                              

    400 list
                                              

                                              

    402 list
                                              

                                              

    404 list
                                              

                                              

    406 list
                                              

                                              

    408 list
                                              

                                              

    410 list
                                              

                                              

    412 list
                                              

                                              

    414 list
                                              

                                              

    416 list
                                              

                                              

    418 list
                                              

                                              

    420 list
                                              

                                              

    422 list
                                              

                                              

    424 list
                                              

                                              

    426 list
                                              

                                              

    428 list
                                              

                                              

    430 list
                                              

                                              

    432 list
                                              

                                              

    434 list
                                              

                                              

    436 list
                                              

                                              

    438 list
                                              

                                              

    440 list
                                              

                                              

    442 list
                                              

                                              

    444 list
                                              

                                              

    446 list
                                              

                                              

    448 list
                                              

                                              

    450 list
                                              

                                              

    452 list
                                              

                                              

    454 list
                                              

                                              

    456 list
                                              

                                              

    458 list
                                              

                                              

    460 list
                                              

                                              

    462 list
                                              

                                              

    464 list
                                              

                                              

    466 list
                                              

                                              

    468 list
                                              

                                              

    470 list
                                              

                                              

    472 list
                                              

                                              

    474 list
                                              

                                              

    476 list
                                              

                                              

    478 list
                                              

                                              

    480 list
                                              

                                              

    482 list
                                              

                                              

    484 list
                                              

                                              

    486 list
                                              

                                              

    488 list
                                              

                                              

    490 list
                                              

                                              

    492 list
                                              

                                              

    494 list
                                              

                                              

    496 list
                                              

                                              

    498 list
                                              

                                              

    500 list
                                              

                                              

    502 list
                                              

                                              

    504 list
                                              

                                              

    506 list
                                              

                                              

    508 list
                                              

                                              

    510 list
                                              

                                              

    512 list
                                              

                                              

    514 list
                                              

                                              

    516 list
                                              

                                              

    518 list
                                              

                                              

    520 list
                                              

                                              

    522 list
                                              

                                              

    524 list
                                              

                                              

    526 list
                                              

                                              

    528 list
                                              

                                              

    530 list
                                              

                                              

    532 list
                                              

                                              

    534 list
                                              

                                              

    536 list
                                              

                                              

    538 list
                                              

                                              

    540 list
                                              

                                              

    542 list
                                              

                                              

    544 list
                                              

                                              

    546 list
                                              

                                              

    548 list
                                              

                                              

    550 list
                                              

                                              

    552 list
                                              

                                              

    554 list
                                              

                                              

    556 list
                                              

                                              

    558 list
                                              

                                              

    560 list
                                              

                                              

    562 list
                                              

                                              

    564 list
                                              

                                              

    566 list
                                              

                                              

    568 list
                                              

                                              

    570 list
                                              

                                              

    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
                                              

                                              

    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
                                              

                                              

    630 list
                                              

                                              

    632 list
                                              

                                              

    634 list
                                              

                                              

    636 list
                                              

                                              

    638 list
                                              

                                              

    640 list
                                              

                                              

    642 list
                                              

                                              

    644 list
                                              

                                              

    646 list
                                              

these parameters are globally resident and sho
uld not be overloaded. use warm after changing
any but variables marked hot.
sim is 0 for full hi lvl integrator, 1 for fas
ter hand coded, 2 for fastest partial sim, 3 n
o sim for tare.
fov abstract display scale
ps/ picosec per display step in hardsim
dh holds drive handle we are responsible for.
testb nonzero to enable testbeds.
compile compiles rom for layout and ram for op
tional initialization via pram in hardsim.
simrec defined here as nop in case not loaded
logger compiles log file generator in windows
systems
-tape the yellow literal must be 0 for tapeout
, 1 for testing.
saying qwerty at the end of the block enables
the qwerty keyboard mode till next boot. enabl
e seeb to see blue words by default.          

    648 list
active config global fov 1024 cuco 10 testb 0
dh 0 0 dh ! br

sim 1 ;
ps/ 4 ;
compile 940 load ;
tether -cr  te 944 load ;
simrec ; default nop
logger winver drop if 554 3 loads then ;
-tape 1 1 and ; qwerty seeb                   

define chip to lay out, loaded from 998
3..0row lay out all the nodes. comment those y
ou do not wish to work with; make active nodes
green. make sure cuco numbers a valid node tha
t you are laying out before doing extract
chip top-level gds cell
chip0 octagon before global - well before wc
warnings nodes 3 or 5 require 4.              

    650 list
cfchip - chip definition
1row 10nd 11nd ;
0row 00nd 01nd ; cuco node must be green!
chip0 power octagon global 0row 1row ;
logo poly cpr m1 cpr m2 cpr m3 cpr m4 cpr ;
chip seal origin v chip0 70 gy -70 + v logo ; 

                                              

    652 list
                                              

                                              

    654 list
                                              

                                              

    656 list
                                              

                                              

    658 list
                                              

                                              

    660 list
                                              

                                              

    662 list
                                              

                                              

    664 list
                                              

                                              

    666 list
                                              

                                              

    668 list
                                              

                                              

    670 list
                                              

                                              

    672 list
                                              

                                              

    674 list
                                              

                                              

    676 list
                                              

                                              

    678 list
                                              

                                              

    680 list
                                              

                                              

    682 list
                                              

                                              

    684 list
                                              

                                              

    686 list
                                              

                                              

    688 list
                                              

                                              

    690 list
                                              

                                              

    692 list
                                              

                                              

    694 list
                                              

                                              

    696 list
                                              

                                              

    698 list
                                              

                                              

    700 list
                                              

                                              

    702 list
                                              

                                              

    704 list
                                              

                                              

    706 list
                                              

                                              

    708 list
                                              

                                              

    710 list
                                              

                                              

    712 list
                                              

                                              

    714 list
                                              

                                              

    716 list
                                              

                                              

    718 list
                                              

                                              

    720 list
                                              

                                              

    722 list
                                              

                                              

    724 list
                                              

                                              

    726 list
                                              

                                              

    728 list
                                              

                                              

    730 list
                                              

                                              

    732 list
                                              

                                              

    734 list
                                              

                                              

    736 list
                                              

                                              

    738 list
                                              

                                              

    740 list
                                              

                                              

    742 list
                                              

                                              

    744 list
                                              

                                              

    746 list
                                              

                                              

    748 list
                                              

                                              

    750 list
                                              

                                              

    752 list
                                              

                                              

    754 list
                                              

                                              

    756 list
                                              

                                              

    758 list
                                              

                                              

    760 list
                                              

                                              

    762 list
                                              

                                              

    764 list
                                              

                                              

    766 list
                                              

                                              

    768 list
                                              

                                              

    770 list
                                              

                                              

    772 list
                                              

                                              

    774 list
                                              

                                              

    776 list
                                              

                                              

    778 list
                                              

                                              

    780 list
                                              

                                              

    782 list
                                              

                                              

    784 list
                                              

                                              

    786 list
                                              

                                              

    788 list
                                              

                                              

    790 list
                                              

                                              

    792 list
                                              

                                              

    794 list
                                              

                                              

    796 list
                                              

                                              

    798 list
                                              

                                              

    800 list
                                              

                                              

    802 list
                                              

                                              

    804 list
                                              

                                              

    806 list
                                              

                                              

    808 list
                                              

                                              

    810 list
                                              

                                              

    812 list
                                              

                                              

    814 list
                                              

                                              

    816 list
                                              

                                              

    818 list
                                              

                                              

    820 list
                                              

                                              

    822 list
                                              

                                              

    824 list
                                              

                                              

    826 list
                                              

                                              

    828 list
                                              

                                              

    830 list
                                              

                                              

    832 list
                                              

                                              

    834 list
                                              

                                              

    836 list
                                              

                                              

    838 list
                                              

                                              

    840 list
                                              

                                              

    842 list
                                              

                                              

    844 list
                                              

                                              

    846 list
                                              

                                              

    848 list
                                              

                                              

    850 list
                                              

                                              

    852 list
                                              

                                              

    854 list
                                              

                                              

    856 list
                                              

                                              

    858 list
                                              

                                              

    860 list
                                              

                                              

    862 list
                                              

                                              

    864 list
                                              

                                              

    866 list
                                              

                                              

    868 list
                                              

                                              

    870 list
                                              

                                              

    872 list
                                              

                                              

    874 list
                                              

                                              

    876 list
                                              

                                              

    878 list
                                              

                                              

    880 list
                                              

                                              

    882 list
                                              

                                              

    884 list
                                              

                                              

    886 list
                                              

                                              

    888 list
                                              

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 numbers br

dieorg origin of 'die' i.e. pad ring within se
al ring. c coords rel to seal; g rel to 'die'
br

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                        

    890 list
ga4 chrt .18 design specific
gdsnos 440 ; -cr  origin 23 26 ;
nnx 2 ; -cr  nny 2 ; -cr  nns nnx nny * ;
nnc nns nns 36 + ;
nn-n n-n 10 /mod nnx * + ;
n-nn n-n nnx /mod 10 * + ; br

cr
cr
cr
cr
cr
cr
cr
gx 1074 1034 39 + ;
gy 1820 1646 ; br

cr
cx gx 9 + ;
cy gy 55 + ;
-cx cx negate ; -cr  cx*y cx cy * ; br

                                              

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.  

    892 list
ga4 pads, ports and resets br

port i-pa align tbl 95 , F5 , C5 , DD , B5 , B
D , A5 , AD ,
idle n-p nnx /mod nny -1 + mod 1 min 4 + swap
nnx -1 + mod 1 min 2* + port ;
rstadr align tbl 6A , B5 , BD , A5 , AD ,
rstdef strings p06a p09f xxx xxx xxx
?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 retu
rning 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.

    894 list
ga4 node types br

laid nns aray -cr  resets nns aray
kinds nns aray br

0's n for 0 , next ;
+roms -ia align ray nns 0's
iz nn i swap nn-n +roms ! ; indent
     async 0 6 iz spi 1 10 iz indent
     1wire 10 18 iz analog 11 14 iz
@rom nn-n nn-n +roms @ 1418 + ; br

bedtab -serbed cuco @ nn-n kinds @ ;
?serbed testb @ 0 or drop if bedtab ; then 0 ;
to test 1wire on 00nd use 0 18 iz not 0 6 iz  

                                              

    896 list
                                              

                                              

    898 list
                                              

design load block for okad2 applications
ex
extract netlist for simulation and go into
flat view of layout - keys
.
.... ludr big left up down right
.432 ludr toggle metal 2-4 , move ludr
.... +g1- zoom in, toggle gates, toggle metal1
, zoom out
. exit flat view or simulator with space e spa
ce to enter block editor and get new key menu
on bottum right
ha
hardsim virtual scope g n go till number h go
till key b go 1000 counts , exit with e
gds consruct gds file image and display
@gds view file records
?gds
lite brighten the net pointed to - metal-1
lit brighten an additional net                

    900 list
okad tools compile is in cfuse
softsim -cr  so 942 load ;
tile 910 load ; layout tiles 146 load
place -cr  pl tile layout and display
flat -cr  fl 912 load ; 2d display
cover 914 load ;
gds 916 load ; construct gds file
@gds 918 load ; display gds
?gds 920 load ; examine gds
extract -cr  ex 922 load ; build tables
hardsim -cr  ha 924 load ; integrate i and v
hilo 926 load ; mark nets above vdd/2
lite 928 load ;
lit 908 load ;
pram 934 load ;
calc 930 load ; tsmc calculation app
prism 932 load ; tsmc spectrum 890 3 loads des
ign specific mark empty                       

                                              

    902 list
                                              

                                              

    904 list
                                              

                                              

    906 list
                                              

                                              

    908 list
                                              

                                              

    910 list
                                              

                                              

    912 list
                                              

                                              

    914 list
                                              

                                              

    916 list
                                              

                                              

    918 list
                                              

                                              

    920 list
                                              

                                              

    922 list
                                              

                                              

    924 list
                                              

                                              

    926 list
                                              

                                              

    928 list
                                              

                                              

    930 list
                                              

                                              

    932 list
                                              

                                              

    934 list
                                              

                                              

    936 list
                                              

                                              

    938 list
                                              

compiles all relevant g18 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
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. br

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 . 

    940 list
g18 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 ! cr
n-nn @rom load ;
bin nn 0 memory swap nn-n com ! 0 memory 512 m
ove ; br

program 1380 load nns -1 + for i com ! cr
i idle reset i n-nn @rom load -next cr
-tape drop if 1300 load then ; br

1402 6 loads target program empty             

                                              

    942 list
g18 simulator compile empty cr
1272 11 loads cr
1256 2 loads testbed
testbed spi asynch ; cr
1260 2 loads port handshake cr
1266 2 loads memory instructions cr
1270 load show pins cr
1294 3 loads display keyboard init cr
cr
reset cr
0 1 right link 10 11 right link cr
0 10 down link 1 11 down link cr
/asynch cr
0 0 boots smtm cr
6A 0 boots asynch cr
6A 1 boots spi cr
ok h                                          

                                              

    944 list
                                              

                                              

    946 list
                                              

                                              

    948 list
                                              

                                              

    950 list
                                              

                                              

    952 list
                                              

                                              

    954 list
                                              

                                              

    956 list
                                              

                                              

    958 list
                                              

                                              

    960 list
                                              

                                              

    962 list
                                              

                                              

    964 list
                                              

                                              

    966 list
                                              

                                              

    968 list
                                              

                                              

    970 list
                                              

                                              

    972 list
                                              

                                              

    974 list
                                              

                                              

    976 list
                                              

                                              

    978 list
                                              

                                              

    980 list
                                              

                                              

    982 list
                                              

                                              

    984 list
                                              

                                              

    986 list
                                              

                                              

    988 list
                                              

                                              

    990 list
                                              

                                              

    992 list
                                              

                                              

    994 list
                                              

                                              

    996 list
                                              

                                              

    998 list
                                              

                                              

    1000 list
                                              

                                              

    1002 list
                                              

                                              

    1004 list
                                              

                                              

    1006 list
                                              

                                              

    1008 list
                                              

                                              

    1010 list
                                              

                                              

    1012 list
                                              

                                              

    1014 list
                                              

                                              

    1016 list
                                              

                                              

    1018 list
                                              

                                              

    1020 list
                                              

                                              

    1022 list
                                              

                                              

    1024 list
                                              

                                              

    1026 list
                                              

                                              

    1028 list
                                              

                                              

    1030 list
                                              

                                              

    1032 list
                                              

                                              

    1034 list
                                              

                                              

    1036 list
                                              

                                              

    1038 list
                                              

                                              

    1040 list
                                              

                                              

    1042 list
                                              

                                              

    1044 list
                                              

                                              

    1046 list
                                              

                                              

    1048 list
                                              

                                              

    1050 list
                                              

                                              

    1052 list
                                              

                                              

    1054 list
                                              

                                              

    1056 list
                                              

                                              

    1058 list
                                              

                                              

    1060 list
                                              

                                              

    1062 list
                                              

                                              

    1064 list
                                              

                                              

    1066 list
                                              

                                              

    1068 list
                                              

                                              

    1070 list
                                              

                                              

    1072 list
                                              

                                              

    1074 list
                                              

                                              

    1076 list
                                              

                                              

    1078 list
                                              

                                              

    1080 list
                                              

                                              

    1082 list
                                              

                                              

    1084 list
                                              

                                              

    1086 list
                                              

                                              

    1088 list
                                              

                                              

    1090 list
                                              

                                              

    1092 list
                                              

                                              

    1094 list
                                              

                                              

    1096 list
                                              

                                              

    1098 list
                                              

                                              

    1100 list
                                              

                                              

    1102 list
                                              

                                              

    1104 list
                                              

                                              

    1106 list
                                              

                                              

    1108 list
                                              

                                              

    1110 list
                                              

                                              

    1112 list
                                              

                                              

    1114 list
                                              

                                              

    1116 list
                                              

                                              

    1118 list
                                              

                                              

    1120 list
                                              

                                              

    1122 list
                                              

                                              

    1124 list
                                              

                                              

    1126 list
                                              

                                              

    1128 list
                                              

                                              

    1130 list
                                              

                                              

    1132 list
                                              

                                              

    1134 list
                                              

                                              

    1136 list
                                              

                                              

    1138 list
                                              

                                              

    1140 list
                                              

                                              

    1142 list
                                              

                                              

    1144 list
                                              

                                              

    1146 list
                                              

                                              

    1148 list
                                              

                                              

    1150 list
                                              

                                              

    1152 list
                                              

                                              

    1154 list
                                              

                                              

    1156 list
                                              

                                              

    1158 list
                                              

                                              

    1160 list
                                              

                                              

    1162 list
                                              

                                              

    1164 list
                                              

                                              

    1166 list
                                              

                                              

    1168 list
                                              

                                              

    1170 list
                                              

                                              

    1172 list
                                              

                                              

    1174 list
                                              

                                              

    1176 list
                                              

                                              

    1178 list
                                              

                                              

    1180 list
                                              

                                              

    1182 list
                                              

                                              

    1184 list
                                              

                                              

    1186 list
                                              

                                              

    1188 list
                                              

                                              

    1190 list
                                              

                                              

    1192 list
                                              

                                              

    1194 list
                                              

                                              

    1196 list
                                              

                                              

    1198 list
                                              

                                              

    1200 list
                                              

                                              

    1202 list
                                              

                                              

    1204 list
                                              

                                              

    1206 list
                                              

                                              

    1208 list
                                              

                                              

    1210 list
                                              

                                              

    1212 list
                                              

                                              

    1214 list
                                              

                                              

    1216 list
                                              

                                              

    1218 list
                                              

                                              

    1220 list
                                              

                                              

    1222 list
                                              

                                              

    1224 list
                                              

                                              

    1226 list
                                              

                                              

    1228 list
                                              

                                              

    1230 list
                                              

                                              

    1232 list
                                              

                                              

    1234 list
                                              

                                              

    1236 list
                                              

                                              

    1238 list
                                              

                                              

    1240 list
                                              

                                              

    1242 list
                                              

                                              

    1244 list
                                              

                                              

    1246 list
                                              

                                              

    1248 list
smtm test 32 org
go a! 1557F !b 1556A !b . pop @p+ indent
     ' @p+ dup 2/ . ' a ! ! 43 for indent
     3F !+ . unext indent
     ' 2* a! push . ' ' begin @p+ !+ . unext '
indent
     ' @p+ push ; ' ! warm ; cr
12 org
r @p+ go ; r---
d @p+ go ; -d--
l @p+ go ; --l-
u @p+ go ; ---u cr
0 org
path r d path ;                               

                                              

    1250 list
                                              

1252 load makes an html listing of cr
the softsim application                       

    1252 list
html named ga4softsim.html .hdr cr
1252 1254 .blks this print screen cr
942 944 .blks load block cr
1272 1294 .blks cr
1256 1260 .blks testbed cr
1260 1268 .blks memory instructions cr
1270 1272 .blks show pins cr
1250 1252 .blks debug window cr
1294 1300 .blks screen/kbd initialization cr
.tlr                                          

                                              

    1254 list
                                              

spi testbed
clk state of clock pin last time
spbit 'bit' address of incoming data cr
note stream code is at node nns
btcnt count output bits at beginning
?bit count down to zero but no further cr
and pop out of calling word until zero reached
bitn change 'bit' address to word address and
bit count ... increment bit address ... cr
@ from word address leaving bit count on top
bit17 shift current bit into almost bit 17 and
io! insert bit into ios
spi execute during each step for spi testbed  

    1256 list
spi serial testbed cr
clk 0 spbit 1359581274 btcnt 0 33 btcnt ! cr
nns com ! 0 me 18 * spbit ! 0 clk ! cr
?bit btcnt @ -1 + 0 max dup btcnt ! indent
     dup and drop if pop drop ; then ;
bitn n-nn dup @ swap over 1 + swap ! indent
     18 /mod @n swap ;
bit17 spbit bitn for 2* -next
io! n 2/ 20000 and ios @n indent
     1FFFF and or ios !n ;
spi 1 nn-n nop com ! clk @ ioc @ indent
     1 and dup clk ! or drop indent
     if clk @ dup and drop if ; then indent
     ?bit bit17 then ;                        

async serial testbed
table help to
lt00 create a left port for node 0
/asynch init left dest register for 0
?wake wake on pin and execute @b ;
sta rt bit
sto p bit cr
sbit stream pointer node 0 cr
ss stream counter cr
baud bit timer
timing six bit preamble
data lsb first
dat time for data, not start or stop
bit17 insert next bit into io register
asynch execute during each step for testbed   

    1258 list
async serial testbed lst17 131072 0 lst17 !
asport 0 nn-n nop com ! left pt ! ;
table pop 2/ 2/ ;
lt00 align table 0 , cr
0 nn-n com ! left pt ! pend ,
/asynch asport lt00 dest ! ;
?wake ios @ 20000 and lst17 @ over or drop if
indent
     14000 @b ; wrq or asport dest @ ! then in
dent
     lst17 ! ;
sta 40000 io! ; -cr  sto 0 io! ; cr
sbit 1359581309 ss 207 baud 832200 cr
200 baud ! -1 ss ! nns com ! 0 me 18 * sbit !
timing 2D000 ss @ 30 mod for 2* next io! ; cr
data sbit bitn -18 + - for 2* -next io! ;
dat ss @ 30 mod -7 + drop indent
     -if timing ; then data ;
bit17 1 ss +! ss @ 10 mod jump indent
     sta dat dat dat dat dat dat dat dat sto
asynch time @ baud @ or drop if clear wrq inde
nt
     asport 0 dest @ ! ; then indent
     4000 baud +! 0 nn-n nop com ! indent
     bit17 ?wake ;                            

softsim memory access
rwb read write bits shifted from port to ios
mkios make ios using rwb
/ios set pins in ios to low unless ioc says cr
output high. testbed can override this. cr
?ios reads ios register as a special case, cr
testbed should put appropriate pin data cr
into ios.
?ioc reads ioc then initializes ios with cr
reasonable default values. testbed can plug cr
in more appropriate values.                   

    1260 list
softsim memory access
rwb nai-n mem @ rrq wrq or and swap / or ;
mkios ios @ 201FF and 8 right rwb indent
     20 down rwb 80 left rwb 200 up rwb indent
     ios ! ;
/ios ios @ 1FE00 and ioc @ indent
     dup 2* and 2002A and or ios ! ;
?ios dup D1 or drop if ; then indent
     drop ios @ +t set pop drop ;
?ioc dup D1 or drop if ; then indent
     drop -t ioc ! set /ios pop drop ;        

softsim ports
rpt -cr  dpt -cr  lpt -cr  upt cr
set pt and leave mask
active mask off ad to see if port is active
@part
get accumulate values of active ports
!part
put store accumulated value into pend cr
for each active port
-both save pt and ad for later display and cr
set flag if not both read and write requested
-slot node is sleeping so arrange for cr
instruction to be executed again next time br

@comm multiport fetch
!comm multiport store
@inst multiport instruction fetch cr
                                              

    1262 list
softsim ports
rpt -m right pt ! 40 ;
dpt -m down pt ! 20 ;
lpt -m left pt ! 10 ;
upt -m up pt ! 8 ;
active m ad @ 50 or and drop ;
@part pm-p active if port @ +or then ;
get -p 0 rpt @part dpt @part lpt @part indent
     upt @part 3 slp ! ;
!part pm-p active if dup pend ! then ;
put p rpt !part dpt !part lpt !part upt !part
indent
     drop ;
-both p-p dup es ! ad @ clu ! indent
     rrq wrq or over over and or drop ;
-slot -1 slot +! 0 slp ! ; br

@comm get -both if drop -slot rrq put ; then i
ndent
     3FFFF and +t 0 put ;
!comm get -both if drop -slot t @ wrq or put i
ndent
     ; then drop -t drop 0 put ;
@inst get -both if drop 0 slp ! rrq put ; inde
nt
     then 3FFFF and ir ! 0 slot ! 0 put ;     

                                              

    1264 list
                                              

softsim memory
bus? is address a bus register ?
@x/!x a common to fetch/store br

@p fetching or storing memory or ports
@a
@+
!a
!b
!+
@p br

+pc fetch the next instruction word from cr
memory or a port                              

    1266 list
softsim memory
bus? a dup ad ! 80 and drop indent
     if ad @ 78 and 50 or drop then ;
!p pc @3 bus? if 1 cnt !comm ; then indent
     2 cnt ad @ p+
!x a -t swap mem ! set ;
@a ar @n ?ios
@ab bus? if 1 cnt @comm ; then 2 cnt ad @
@x a mem @ +t set ;
@b b @3 ?ios @ab ;
@+ ar @n ?ios bus? if 1 cnt @comm ; indent
     then 2 cnt ad @ a+ @x ;
!a ar @n ?ioc
!ab bus? if 1 cnt !comm ; then 2 cnt ad @ !x ;
!b b @3 ?ioc !ab ;
!+ ar @n ?ioc bus? if 1 cnt !comm ; indent
     then 2 cnt ad @ a+ !x ;
@p pc @3 bus? if 1 cnt @comm ; then indent
     2 cnt ad @ p+ @x ; br

+pc pc @3 bus? if @inst ; then indent
     ad @ p+ mem @ ir ! 0 slot ! set ; cr
                                              

fast number of quick steps in fast mode
gap number of steps in current mode
inst increment slot jump to 1 of cr
32 instructions
s0-s3 execute instruction from slot 0-3
s4 fetch next instruction word
tick execute 1 clock cycle
bus merge pend and dest into port
buses bus on each of four ports
step tick for each computer
quick gap steps before stopping to display
go quick display until keypress
faster toggle fast and slow modes for go      

    1268 list
softsim execute fast 4000 gap 4000 1 gap ! cr
instruction jump table
inst n 1 slot +! 1F and jump ret ex jmp call u
r+ jr+ jz jns @p @+ @b @a !p !+ !b !a +* 2*x 2
/x -x +x andx orx t! t@ r@ s@ a@ nul r! b! a!x
s0 ir @ 13 2/s inst ;
s1 ir @ 8 2/s inst ;
s2 ir @ 3 2/s inst ;
s3 ir @ 2* 2* inst ;
s4 cl @ dup and drop -if +pc ; then ;
tick com ! -1 cl +! slot @ jump s0 s1 s2 s3 s4
bus mem dup 1 or @ over F or @ @ +or swap ! ;
buses right bus down bus left bus up bus ; br

step 1 time +! nns -1 + for i tick -next inden
t
     nns -1 + for i com ! buses mkios -next in
dent
     testbed ;
quick gap @ for step next ;
go quick pause key? go ;
faster fast @ gap @ 1 or drop if indent
     drop 1 then gap ! ;                      

softsim pins
out outputs are silver
pn. factored behavior
in inputs are blue
p17. sets com, moves cursor, always first
pin. factored behavior of each pin
p5. p17. has already set com
p3.
p1. br

1pin some nodes have one pin
2pins some have two
4pins spi at least has four
pins. display io pins on all nodes cr
used in ok br

testbed must set ios                          

    1270 list
softsim pins
out silver ioc
pn. @n swap / 1 and digit ;
in blue ios pn. ;
p17. n com ! -14 xy +! 20000
pin. ioc @ over and drop if 2/ out ; then in ;
p5. 20 pin. ;
p3. 8 pin. ;
p1. 2 pin. ; br

1pin n nn-n loc p17. ;
2pins n nn-n loc p17. p1. ;
4pins n nn-n loc p17. p5. p3. p1. ;
pins. 0 2pins 1 4pins 10 2pins ;              

ad dress com puter pt port time
2/s n shift right n bits
2*s n shift left n bits
+or inclusive or
me convert memory offset to pentium address
mem convert register address br

pend convert port to 'pending' address
dest convert port to 'destination' which cr
points to neighbor with shared port
bus! when neighbors sync, write data to cr
both my pend and his pend while clearing cr
read/write requests br

right unconverted port addresses
down
left
up br

rrq read request bit
wrq write request bit                         

    1272 list
softsim registers and memory cr
ad 62 com 2 pt 197 time 832000 0 time ! macro
2/s ?lit F8C1 2, 1, ;
2*s ?lit E0C1 2, 1, ; forth
+or nn over - and or ;
me com @ 2* 8000 + block + ;
mem FF and 80 ? if dup D1 or drop indent
     if D5 or 8 / 8,4,2,1 120 or indent
     then then 17F and me ; 120-12e used
port pt @ mem ;
pend port 1 or ;
dest port F or ;
bus! n dup dest @ ! pend ! ; br

right 95 ;
down F5 ;
left C5 ;
up DD ;
rrq 80000 ;
wrq 40000 ;                                   

registers and 'node variables'
ar a register. cannot be named a because cr
pentium macro takes precedence
slot current instruction slot 0-4
rp,sp stack pointers
ss 8 stack registers
rs 8 stack registers
cl clock counted down to time memory access
ph clock counted up to time instruction
es used in debugging
clu used in debugging
slp mark a node as asleep
ioc write only, use with testbed
ios read only, also used with testbed         

    1274 list
softsim registers and memory
r 100 me ;
ar 101 me ; a register
b 102 me ;
pc 103 me ;
ir 104 me ;
t 105 me ;
s 106 me ;
ss 7 and 107 me + ;
rs 7 and 10F me + ;
slot 117 me ;
rp 118 me ;
sp 119 me ;
cl 11A me ;
ph 11B me ;
es 11C me ;
clu 11D me ;
slp 11E me ;
ioc 130 me ; write only
ios 131 me ; read only                        

softsim display
cr/2 half carriage return
emit/2 half space emit
+e/2 set emit/2 to perform half emit
-e/2 set emit/2 to drop the character
?adr used to avoid displaying an address cr
field as random opcodes
'ops a string of opcode names for decompiler
op@ lookup and type an opcode string
opc. when slot is 4 display 'fet'
ops. given an instruction word, display the cr
opcodes                                       

    1276 list
softsim display 'e/2 270073890
cr/2 cr -14 xy +! ;
emit/2 c 'e/2 xqt ;
+e/2 'e/2 assign 48 + xy @ swap emit indent
     B0000 + xy ! ; +e/2
-e/2 'e/2 assign drop ;
?adr a -8 + -if -e/2 then indent
     4 + drop if ; then +e/2 ;
'ops align strings ; ex jmp cal unx nxt if -if
@p @+ @b @ !p !+ !b ! +* 2* 2/ - + and or drp
dup pop ovr a . psh b! a! fet
op@ i 'ops @ -16 and indent
     begin dup and while unpack emit/2 indent
     end then drop sp/2 ;
opc. i slot @ 4 and drop if drop 32 then op@ ;
ops. n 4 * 3 for 32 /mod next indent
     4 for dup op@ ?adr next +e/2 ;           

softsim display
base radix for small character number display
digits table of character values
digit display digit as small character
.n display c digits of n in the current base
hex change base to hex
dec change base to decimal
nod nod2 focus on two nodes
switch swap focus nodes
wake? a node is awake if slp is 3
?white
?green
?blue
?red change to named color if awake
me? color for node number                     

    1278 list
softsim display base 16
digits i-n align tbl 24 , 25 , 26 , 27 , 28 ,
29 , 30 , 31 , 32 , 33 , cr
5 , 19 , 10 , 16 , 4 , 14 ,
digit i digits emit/2 ;
.n nc dup push -1 + indent
     for base @ /mod next pop for digit next ;
hex 16 base ! ;
dec 10 base ! ; br

nod 1 nod2 1
switch nod @ nod2 @ nod ! nod2 ! ;
wake? silver slp @ 3 and drop ;
blue 4040FF color ;
?white wake? if white then ;
?green wake? if green then ;
?blue wake? if blue then ;
?cyan wake? if cyan BBBB color then ;
?red wake? if red then ;
me? 808080 color ;                            

softsim display
xorg -cr  yorg upper left corner of display br

out? decide whether node is off screen
loc n calculate screen position of node
tab xy move cursor and set left margin br

@n -cr  !n -cr  @3 -cr  !3 cr
fetch and store from memory, changing cr
from pattern to number br

10bit -cr  8bit -cr  3bit
adr isolate the address field in an inst      

    1280 list
softsim display xorg 0 yorg 0 cr
out? xy over over +or push over -8 + indent
     over -4 + and - pop +or drop ;
loc n-n dup nnx /mod xorg @ negate indent
     yorg @ negate v+ out? indent
     -if drop drop drop pop drop ; then indent
     - 4 + 176 * swap 72 * swap indent
     22 dup v+ over lm at ;
tab xy over lm at ; br

@n @ 15555 or ;
!n swap 15555 or swap ! ;
@3 @ 3FF and 155 or ;
!3 swap 155 or swap ! ;
10bit 3FF and ;
8bit FF and ;
3bit 7 and pc @ @3 7 - and or ;
adr slot @ jump 10bit 10bit 8bit 3bit nul     

softsim display
u
ud
d manipulate the memory dump offset
the make focus node the current node br

array -cr  div -cr  cin cr
isolate current opcode from inst word br

ar. -cr  br. -cr  ioc. -cr  ios.
ir. -cr  tr. -cr  sr. -cr  rr.
pc. -cr  sl. -cr  op. -cr  cl. cr
building blocks for the 2d display, com.      

    1282 list
softsim display off 48
u 16
ud off @ + FF and off ! ;
d -16 ud ;
the nod @ com ! ; br

array pop 2/ 2/ + @ ;
div align array 100000 , 8000 , 400 , 20 , 1 ,
cin ir @ 80 * 1 + slot @ div / 1F and ; br

ar. ar @n 5 .n cr/2 ;
br. b @3 3 .n ;
rqs. ios @ 9 2/s FF and 2 .n ;
ioc. ioc @n 5 .n cr/2 ;
ios. ios @n 5 .n cr/2 ;
ir. ir @n 5 .n cr/2 ;
tr. t @n 5 .n cr/2 ;
sr. s @n 5 .n cr/2 ;
rr. r @n 5 .n cr/2 ;
pc. pc @3 hex 3 .n cr/2 ;
sl. slot @ digit ;
op. cin opc. cr/2 ;
cl. cl @ 0 max 3 min digit ;                  

softsim display
-sp/2 half backspace
place identify current computer on 2d display
com. n display computer n
mem. xy memory dump of focus nod at xy
stack
return
stacks full stack dump of focus nod at xy     

    1284 list
softsim display
-sp/2 B0000 negate nop xy +! ;
place dup com ! n-nn me? dec -sp/2 3 .n ; br

com. n loc place ?white pc. ?blue cl. indent
     ?white sl. ?green op. ?white ir. indent
     ?blue ioc. ios. ?red rr. ?green indent
     tr. sr. ?white ar. blue rqs. ?white br. ;
br

mem. xy tab hex 15 for i off @ 7F and + indent
     dup white 2 .n sp/2 mem @ dup indent
     15555 or green 5 .n sp/2 indent
     white ops. cr/2 -next ; br

stack sp @ 8 for dup ss @n 5 .n cr/2 indent
     -1 + next drop ;
return rp @ 8 for 1 + dup rs @n 5 .n indent
     cr/2 next drop ;
stacks xy tab hex white return indent
     red rr. green tr. sr. white stack ;      

softsim execute
cnt count down for memory access
set4 go to slot 4 and
set set cl to time memory prefetch br

/+/ nim-n add i to n affecting only bits cr
within m
inc increment current address if not cr
a port address
a+ increment the a register
p+ increment the p register                   

    1286 list
softsim execute cr
cnt n ph @ or drop if 1 ph +! indent
     -1 slot +! pop drop ; then 0 ph ! ;
set4 4 slot !
set 2 cl ! ; br

/+/ nim-n push over + over or pop and or ;
inc n-n ad @ 100 and drop if ; then 1 3F /+/ ;
a+ ar @n inc ar !n ;
p+ pc @3 inc pc !3 ;                          

softsim execute
+t n push onto data stack
-t -n pop from data stack
+r n push onto return stack
-r -n pop from return stack
t! write t as number
t@ read t as number
bin prepare for a binary operation br

some instructions named with terminal cr
x to avoid pentium conflict br

-x -
2*x 2*
sx sign extend
+* multiply step                              

    1288 list
softsim execute
+t n t @ s @ sp @ 1 + dup sp ! ss ! s ! t ! ;
-t -n t @ s @ t ! sp @ dup ss @ s ! indent
     -1 + sp ! ;
+r n r @ rp @ 1 + dup rp ! rs ! r ! ;
-r -n r @ rp @ dup rs @ r ! -1 + rp ! ;
t@ t @n ;
t! t !n ;
bin -t 15555 or t@ ; br

-x t @ 3FFFF or t ! ;
2*x t@ 2* 3FFFF and t! ;
sx dup 20000 and 2* or ;
+* t@ sx ar @n indent
     1 ? if push s @n + pop indent
     then 2/ over 1 and drop indent
     if 20000 or then ar !n 2/ t! ;           

softsim execute
2/x 2/
orx or
andx and
+x +
t! drop
r@ pop
a@ a
t@ dup
s@ over
b!
r! push
a!x a!                                        

    1290 list
softsim execute cy 0
2/x t@ sx 2/ t! ;
orx bin or t! ;
andx bin and t! ;
+x bin + pc @ 200 and drop indent
     if 0 cy @ 40000 and drop indent
     if 1 or then + dup cy ! then indent
     3FFFF and t! ;
t! -t drop ;
r@ -r +t ;
a@ ar @ +t ;
t@ t @ +t ;
s@ s @ +t ;
b! -t 3FF and b ! ;
r! -t +r ;
a!x 0 cnt -t ar ! ;                           

softsim execute
call call through i
jmp jump through i
jz if
jc
jns -if
ret ; jump through r
jr+ next
ur+ unext
ex call through r                             

    1292 list
softsim execute
call pc @ +r
jmp ir @n adr dup pc !3 set4 80 and indent
     drop if 0 cl ! then ;
jz 3FFFF
jc t @n and drop if set4 ; then jmp ;
jns 20000 jc ;
ret -r 3FF and pc ! set4 ;
jr+ r @n -1 + dup r !n dup and drop indent
     -if -r drop set4 ; then jmp ;
ur+ r @n -1 + dup r !n dup and drop indent
     -if -r drop ; then 0 slot ! ;
ex pc @ -r pc ! +r set4 ;                     

softsim display
nod. show current node in red at xy
ofst offset to second focus node br

ok the default 2d display br

lw move display window left
+xorg factored move in x axis
rw move display window right
uw move display window up
+yorg factored move in y axis
dw move display window down                   

    1294 list
softsim display
nod. xy tab dec nod com @ n-nn red 3 .n ;
yofst -320 ; -cr  xofst 400 ;
x0 210 ; -cr  y0 342 ;
x1 x0 xofst + ; -cr  y1 y0 ;
x2 x0 ; -cr  y2 y0 yofst + ;
x3 x0 xofst + ; -cr  y3 y0 yofst + ;
focus xyc com ! over over stacks indent
     over 80 + over nod. indent
     80 u+ 30 + mem. ; br

ok show black screen text indent
     nns -1 + for i com. -next indent
     x0 y0 0 focus x1 y1 1 focus indent
     x2 y2 2 focus x3 y3 3 focus indent
     610 680 tab time @ . cr gap @ . indent
     pins. debug keyboard ;                   

softsim display
n! change focus node nod
fr focus right
+nod factored horizontal move
fl focus left
fu focus up
++nod factored vertical move
fd focus down
+gap add 1 to gap and fast
+g factored add to gap and fast
++gap add 100 to gap and fast
-gap add -1 to gap and fast
--gap add -100 to gap and fast
h keyboard handler indent
     ++ fastest faster indent
     fgs fast go step indent
     -- slowest slower cr
indent
     ludr left up down right window indent
     ludr left up down right focus indent
     oud other up down memory dump cr
indent
     . quit                                   

    1296 list
softsim keyboard handler
+gap 1
+g n fast @ + 0 max dup fast ! gap ! ;
++gap 100 +g ;
-gap -1 +g ;
--gap -100 +g ; br

h pad nul nul accept nul cr
nul nul nul nul nul nul nul nul nul u d nul cr
++gap +gap nul nul nul faster go quick cr
--gap -gap nul nul indent
     2500 , 0 , 0 , indent
     101600 , 2B2B , 80D0E00 , 2323 ,         

co-ordinate shared register ports
link s ource node d est node a addr of port cr
links two nodes via their shared port
127 f or' destination
12b
12d
12e
129 1 or' pending
125
123
120
128 bus 8 right
124 bus 4 down
122 bus 2 left
121 bus 1 up
boots set execution address to AA
reset initialize some registers , cr
execute from idle                             

    1298 list
softsim reset limbo 0 0 limbo !
ln sd nn-n com ! pend swap nn-n com ! dest ! ;
link sda pt ! over over ln swap ln ;
boots an nn-n com ! 155 or pc ! ;
un! for 0 over ! 1 + next drop ;
/dest a -1 limbo swap pt ! dest ! indent
     0 dup port ! pend ! ;
rese r 31 un! 69 155 or pc ! 4 slot ! indent
     0 dup cl ! ph ! -1 es ! indent
     0 dup ioc ! ios ! 3 slp ! indent
     left /dest up /dest right /dest indent
     down /dest D1 155 or b ! ;
reset drop 0 nns -1 + for i com ! rese -next ;

this block is loaded to compile test code for
any desired nodes. write *nnn node* either her
e before loading a node's source, or in the so
urce itself. the *node* phrase compiles the ap
propriate rom for the given node so that test
code may reference the rom. br

things like ide and common tests are loaded he
re, and this base code is presently assigned u
p at the top of this area just below 1380. to
simplify base maintenance, please use 1302 for
your own testing and load it from here. when w
e begin using personal space above 1440 your o
wn tests can go there.                        

    1300 list
test code for chip br

custom code 1302 load exit br

ide serial 0 node 1372 load 22 bin indent
     wire 0 node 1376 load 21 bin indent
     end 0 node 1378 load 20 bin cr
smtm test 0 node 1248 load exit br

*/ exerciser 11 node 1354 1356 load indent
     10 node 1358 load cr
serdes xx node 1360 load xx node 1362 load cr
spi flash write 1 node 1364 load cr
ana 11 node 1366 1368 load cr
                                              

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

    1302 list
custom test code br

async life test 0 node 1306 load br

exit boot packet 0 node cr
0 org exe 1E000 p, load 0 p, cnt 1 p, cr
code call0 12000 p, 12000 p, cr
1 node 0 org
go io b! 0 !b
skop @b -if 3 !b skop ; then 2 !b skop ;      

boot frames begin with a 3 word header; indent
     100xx jump to xx when done indent
     ddd mem/port adr to store payload indent
     nnn transfer length indent
     nnn+1 * 2 words of payload
/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! br

talk prepares chip for control thru node 19.
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. c
r
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.

    1304 list
node 0 boot frames
?18 -n /str 4@ FFFFFF and 40 / 3FFFF or +wd ;
!ram reset 40 0 0 exec /frame 0 40 0 +ram wos
!frame ;
xram reset 64 0 0 exec /frame 0 64 0 +ram wos
!frame ;
!io reset 2 D1 warm 69 /frame 0 2 0 +ram wos !
frame ;
!right reset 4 95 exec /frame 0 4 0 +ram wos !
frame ;                                       

                                              

    1306 list
node 0 life test 0 org
go! 1001 0
wig over for . .. . next - dup !b cr
over for . .. . next - dup !b wig ; 00C
hang - dup !b hang ;
many 00E begin @p+ !b unext . 00F 3FFFF , 2AAA
A , 2AAAA , 3FFFF , 3FFFF , 2AAAA , 2AAAA , 3F
FFF , 3FFFF ,
n01 018 . .. . .. -1 !b . .
simp 01C dup dup or - !b simp ;
try 01E 3 -1 !b try ; 021
joe 021 0 3FFFF , 3FFFF ,                     

                                              

    1308 list
                                              

                                              

    1310 list
                                              

                                              

    1312 list
                                              

                                              

    1314 list
                                              

                                              

    1316 list
                                              

                                              

    1318 list
                                              

                                              

    1320 list
10 left 6A reset 40 org
xmit nn-n 17 for begin . . . . -if over dup 2/
!b !b 2* *next drop ; then over 2/ !b 2* over
!b next drop ;
rcv -n left a! dup 17 for begin @ drop @b -if
drop 2* *next ; then drop - 2* - next ; cr
6A org @b . -if then @ or dup a! dup ! - ! 200
00 dup xmit exit br

0 org
one 9999 for . next ;
time hi 15D b! 3 !b down 115 b! right 1D5 a! c
ount 9999 for 00D . unext next 00F low 15D b!
2 !b ;
set 013 ---u ; 014 br

240 org
clc 0 dup . + drop ;
u/mod clc - 1 . +
-u/mod a! 17 push dup . begin begin cr
+ push dup . / + dup a . / + -if / drop pop du
p . / swap next / + ; / then over or or . / po
p dup . . / next / + ; 6A org
test 0 125 50 u/mod rd-u                      

                                              

    1322 list
                                              

                                              

    1324 list
                                              

                                              

    1326 list
                                              

                                              

    1328 list
                                              

                                              

    1330 list
                                              

                                              

    1332 list
                                              

                                              

    1334 list
                                              

                                              

    1336 list
                                              

                                              

    1338 list
                                              

                                              

    1340 list
20 left 1-bit serial 0 org
fifo n-n 000 up right a! .. . @p+ ! .. @ @p+ !
+ !p+ .. ! @ .. ; 'clicks'
ran 006 1 . + ;
ran n-n 008 -if 2* 2CD81 or ; then 2* ;
set n-nn 00C dup 63 for ran dup fifo drop next
over ;
chk nn-nnxd 012 over ran over ran over fifo ov
er over or ;
test xn 016 push set begin chk if pop BAD ; th
en drop drop next 600D ; 01F
period n 01F dup -1 for ran over over or if dr
op *next EEEE ; then pop ;
some xn 028 for ran dup fifo drop next drop ;
exit
fifo n-n 000 up a! .. . @p+ ! .. @ @p+ !+ !p+
.. ! .. @ ; 'nothing' stops after 20
fifo n-n 000 up a! .. . @p+ .. @ @p+ !+ !p+ ..
! ! @ .. ; 'works'                            

                                              

    1342 list
                                              

                                              

    1344 list
                                              

                                              

    1346 list
                                              

                                              

    1348 list
                                              

                                              

    1350 list
                                              

                                              

    1352 list
                                              

h* is simplest multiply; first arg is a signed
number and second, the multiplier, is a full 1
8 bit unsigned number.
try slaves this node to another by the port gi
ven. it expects to receive numbers b a r and c
alculates b*a+r then receives a and returns b
and r. the multiply is done using the h* here
which is why b is signed and a is unsigned.   

    1354 list
hardware multiply test 0 org +cy
clc 200 dup dup or dup . + drop ;
d2* hl-hl 202 dup . + push dup . + pop ;
um+ hln-hl 205 . + push dup dup or . + pop ; 2
08 -cy
h* nu-hl 008 dup a! dup or 17 for +* unext a ;
abs n-n 00C -if
neg n-n 00D - 1 . + then ; 010 +cy
u/mod hld-rq 210 clc neg
-u/mod 212 a! 17 push begin begin dup . + push
dup . + dup a . + -if drop pop *next dup . + ;
then over or or pop next dup . + ; 21E -cy
try 01E right b! ba @b @b h* r @b um+ a @b u/m
od b !b r !b try ; 027                        

                                              

    1356 list
soft multiply test 0 org +cy
clc 200 dup dup or dup . + drop ;
d2* hl-hl 202 dup . + push dup . + pop ;
um+ hln-hl 205 . + push dup dup or . + pop ;
u* nn-hl 208 a! clc dup push dup or dup pop 17
for begin push d2* a -if 2* a! pop dup push .
+ push 0 . + pop pop *next drop ; then 2* a! p
op next drop ; 219 -cy
abs n-n 019 -if
neg n-n 01A - 1 . + then ;
*. ff-f 01D over over or push abs swap abs u*
d2* d2* drop pop -if drop neg ; then drop ; 02
6 +cy
u/mod hld-rq 226 clc neg
-u/mod 228 a! 17 push begin begin dup . + push
dup . + dup a . + -if drop pop *next dup . + ;
then over or or pop next dup . + ; 233 -cy
try 033 right b! @b @b u* @b um+ @b u/mod !b !
b try ; 03D                                   

try exercises slave node given a test vector.
for the hardware version a is unsigned and b i
s signed. but the divide is unsigned so b is l
imited to the largest positive number.        

    1358 list
multiply exerciser 0 org
dec n-n -1 . + ;
+or nn-n over - and or ;
try abr-ab bad 004 right a! 12033 ! push dup !
over ! pop dup ! push over ! dup @ or @ pop or
+or ;
test abr-abr dup push try if pop ; then drop p
op
poll @b 200 2000 and if up down b! @b push ;'
io b! then drop
run abr-abr 01A if dec test ; then drop if dec
over dec test ; then drop dec if -1 1FFFF over
dec test ; then drop 600D ; 029
go 029 io b! 20000 1FFFF -1 1FFFF over dec run
; br

-u/mod old 02F a! 17 push dup . begin begin cr
+ push dup . + dup a . + -if drop pop dup *nex
t + ; then over or or pop dup next + ; 03C    

                                              

    1360 list
                                              

                                              

    1362 list
                                              

                                              

    1364 list
spi flash writer michael + greg 2.1 0 org
2o dw-dw' 000 obit 2* obit ;
wait dw-dw 002 select dup begin drop @b -until
drop select ;
2cmd dw-d 006 select 8obits
cmd dw-d select
!8 dw-d 8obits drop ;
set -d 00B io b! fast 5 ;
fet ah al-d 00E push push set read C00 cmd pop
!8 pop 8obits !8 ;
+wr -d 014 set wren+wrsr 1804 2cmd indent
     hi8 zero dup !8 ebsy 1C000 cmd ;
aaip d-d 01A 2B400 wait !8 ;
x8p hln-d asrc 01D +wr wren+aaip 1AB4 2cmd cr
drop push push push set pop !8 pop 8obits cr
!8 ahead begin aaip swap then 7 for indent
     pop dup push push @+ indent
     begin 2o 2* next push aaip pop indent
     7 pop dup push or push indent
     begin 2o 2* next drop next next cr
wrdi+dbsy 1200 wait 2cmd rdl- ; 039
ers 039 +wr wren+eras 1980 2cmd dup select ; 0
3D                                            

this block supports taking of data manually fo
r a/d transfer function. to use it, put a/d in
the desired mode by editing the constants in s
am+ and - then set desired voltage and execute
sam. you will find a sequence of samples store
d in ram at 32 br

original version sampled each half cycle of th
e incoming clock.                             

    1366 list
take adc data 0 org
sam+ -n 000 155 2155 6155
s+- k-n io b! !b up b! !b @b ;
sam- -n 006 955 2955 6955 s+- ; br

sam 008 20 a! sam+ sam- 11 2* for cr
push sam+ dup - pop . + !+ push cr
push sam- dup - pop . + pop + !+ next ; 016 br

exit sam+ drop                                

                                              

    1368 list
generate dac waves 0 org
dly 000 100 for unext ;
sano n-n 3FFDF and ; 10 or ;
tri n 007 push 155 0 begin cr
510 for over or dup sano !b indent
     dly over or 1 . + next cr
510 for over or dup sano !b indent
     dly over or -1 . + next next drop drop ;
try 01C io b!
sing 01E 1000 tri
poll 020 @b 2000 and if down b! @b push ;' io
b! then drop sing ;
haul 029 io b! -1 dup push dup push dup push d
up push dup push dup push dup push dup push pu
sh 155 AA over over over over over over / dup
dup
spin 036 begin !b . . unext !b !b !b !b !b !b
!b !b spin ; 037 exit cr
155 1D5 55 D5 AA D5 55 1D5 /                  

                                              

    1370 list
                                              

                                              

    1372 list
ide via async boot 0 org
obit dwn-dw 000 !b over push delay ;
word dw-d 002 leap drop leap drop leap drop dr
op ;
obyt dw-dwx 006 then then then 3 obit drop 7 f
or dup 1 and 3 or obit drop 2/ next 2 obit ;
-out 011 ser-exec rdl- ; 012 br

ok 012 31416 word -out ;
fet 015 0
pump n for @+ word . next -out ;
stat 01B 9 pump ;
bstk 01D @ push .. @ word pop dup push word ..
@p+.push 49BA ! 7 .. dup push ! .. @p+ ! .. /+
begin !p+ . . unext .. begin @ word .. . next
.. @p+ ! pop .. /+ pop @p+ ; .. ! -out ; 02C  

                                              

    1374 list
ide via sync boot 0 org
1bit wx-w'x drop -if 3 ahead swap then 2 cr
then !b 2* dup ;
word w 006 8 dup for begin drop @b -until 1bit
begin drop @b - -until 1bit next drop drop ;
+out x 00F begin drop @b - -until drop 3 !b ;
-out x 013 begin drop @b -until cr
drop 2 !b 1 !b ser-exec ; br

ok 018 dup +out 31416 word dup -out ;
fet 01C 0
pump n dup +out for @+ word next dup -out ;
stat 023 9 pump ;
bstk 025 +out @ dup push . @ word word / @p+.p
ush 49BA ! 7 . / dup push ! . / @p+ ! . . /+ b
egin !p+ . . unext / begin @ word / next / @p+
! pop . /+ pop @p+ ; / ! -out ; 034           

                                              

    1376 list
ide wire node code 0 org
fet 000 @p+ !b @ . fet !b @b ! ; 003 5 org
sto 005 @p+ !b @ . sto !b @ !b ; 008 A org
ins 00A @p+ !b @ . ins !b ; 00D D org
psh 00D @p+ !b @ . psh !b ; 010 10 org
stk 010 @p+ !b . . stk 9 for @b ! unext ; cr
015                                           

                                              

    1378 list
ide last guy size-2 1E org
focus i0 01E @p+ !b !b ; / focus ; 0 org
fet 000 @p+ focus /+ @p+ a! @ !p+ / @ !b @b @p
+ /+ ; / !b ! ;
sto 005 @p+ focus /+ @p+ a! . @p+ / @ !b @ . /
!b @p+ !b ; /+ ! ;
ins 00A @ focus ; / ins ins
psh 00D @p+ focus /+ @p+ ; / @ !b ;
stk 010 @p+ focus /+ !p+ dup push !p+ / @b @b
! dup / ! @p+.push 49BA !b 7 / dup push !b . /
@p+ !b /+ begin !p+ . . unext / begin @b ! une
xt . / @p+ !b !b ; /+ pop @p+ ; cr
if past size-2 not ok- 01C                    

                                              

    1380 list
common cr
1D5 95 org -cr  r--- cr
115 F5 org -cr  -d-- cr
175 C5 org -cr  --l- cr
145 DD org -cr  ---u cr
1A5 AD org -cr  rdlu right down left up cr
1B5 A5 org -cr  rdl- right down left cr
185 BD org -cr  rd-u right down up cr
195 B5 org -cr  rd-- right down               

poly xn-xy cr
evaluation of chebyshev polynomials using cr
the horner scheme. br

x is the input value. n is the length of cr
the coefficient table minus 2. coefficient cr
table follows inline, and execution cr
continues after the final table entry. x is cr
left on the stack under the result, y. br

for example...
cos f-f' cr
hart 3300 cr
-0.0043 0.0794 -0.6459 0.5708 indent
     2* 2* . triangle dup *. 2 poly indent
     -281 , 5203 , -42329 , 37407 , indent
     push drop pop *. + ;                     

    1382 list
polynomial approximation
poly xn-xy pop a! push @+ a begin indent
     push *. pop a! @+ + a next push ;        

interp ims-v cr
to determine values for m and s ... cr
let l be number of meaningful input bits. cr
let n be power of 2 where 2**n + 1 is the cr
number of table entries. br

s equals l-n-1 cr
m equals 2** l-n - 1 br

so for example if you have an 8 bit adc, cr
l equals 8. let n equal 2 for a 5 entry table.
the table is expected to be at address 0, cr
so to represent 0 to 1800 millivolts... br

0 org 0 , 450 , 900 , 1350 , 1800 , cr
mv i-n 3f 5 interp ; br

0 mv gives 0 cr
255 mv gives 900 cr
255 mv gives 1800 cr
and intermediate values are interpolated.     

    1384 list
interpolate
interp ims-v dup push push over indent
     begin 2/ unext a! indent
     and push @+ dup @+ - . + - indent
     pop a! dup dup or indent
     begin +* unext push drop pop . + ;       

taps yxc-y'x' cr
for example... br

fir yx-y'x' 15 taps -53 , 0 , 2276 , 0 , 382 ,
0 , -1706 , 0 , -1158 , 0 , 2014 , 0 , 2406 ,
0 , -1977 , 0 , -4206 , 0 , 1289 , 0 , 6801 ,
0 , 678 , 0 , -11109 , 0 , -6250 , 0 , 23531 ,
0 , 54145 , 0 , br

16 taps, 16 coefficients with intermediate cr
storage interleaved.                          

    1386 list
fir or iir filter
taps yxc-y'x' pop a! push begin indent
     @+ @ push a push *.17 pop a! indent
     push !+ pop . + pop next @ a! ;          

relay moves a port executable packet down cr
a sequence of nodes linked by their b cr
registers. the packet consists of a 1-cell cr
index, a 1-cell count less one of body cr
size, and the body cells. br

a packet may be started from memory within cr
a node, or it may simply be fed to a port. br

relay assumes that b points to the next cr
node in the chain. uses one return stack cr
location and four data stack locations. cr
it must be at the same location in every cr
node.                                         

    1388 list
routing; called with 'a relay'
relay a pop a! @+ push @+ zif indent
     drop ahead done swap then indent
     pop over push @p+ ' a relay ' indent
     !b !b !b begin @+ !b unext
done then a push a! ;                         

*.17 multiplies a fraction by a fraction, cr
giving a fraction, or an integer by a cr
fraction, giving an integer. note that f1 cr
is left in s to be ignored, dropped, or cr
reused. note that the definition of *. cr
contains a call to this word. br

17 bit fractions --- s.i ffff ffff ffff ffff  

    1390 list
multiply
*.17 a b - a a*b a! 16 push dup dup or indent
     begin +* unext - +* a -if indent
     drop - 2* ; then drop 2* - ;             

                                              

    1392 list
lshift rshift
lsh push begin 2* unext ;
rsh push begin 2/ unext ;                     

triangle assuming an angle expressed as a cr
16 bit fraction of a revolution, cr
2* 2* triangle produces a triangle wave cr
approximation to the cosine of that angle.    

    1394 list
triangle
triangle x-y call with; 2* 2* triangle indent
     10000 over -if drop . + ; then indent
     drop - . + - ;                           

*. multiplies a fraction by a fraction, cr
giving a fraction, or an integer by a cr
fraction, giving an integer. note that f1 cr
is left in s to be ignored, dropped, or cr
reused. br

16 bit fractions --- si. ffff ffff ffff ffff  

    1396 list
fractional multiply
*. 07B f1 f2 - f1 f1*f2 *.17 indent
     a 2* -if drop - 2* - ; then indent
     drop 2* ;                                

clc clears the carry bit for addition in cr
ea mode. br

the following defines u/mod in ram ... cr
u/mod hld-rq - 1 . + --u/mod ; br

if the divisor is a constant, just negate cr
it at edit or compile time.                   

    1398 list
divide cr
+cy 24F enter ea mode
clc dup dup or dup . + drop ;
--u/mod clc
-u/mod hld-rq a! 17 push begin begin indent
     dup . + . push dup . + indent
     dup a . + -if indent
     drop pop *next dup . + ; then indent
     over or or . pop next dup . + ; cr
-cy 05E exit ea mode                          

g18 target compiler includes support for g18 a
ddressing see 1404
h address of next available word in target mem
ory here
ip address of current instruction word
slot next available instruction slot
call? was last instruction a call ?
call a compile a call
eras fills g18 memory with call 155 number
2*s n shift left n bits
memory n-a host address for target memory
org n set current target memory location
break break in emulator only
/+/ adds unsigned value i aligned with mask m
to the field under that mask in number n
p, n compile pattern into target memory
s0-s4 assemble opcode into slot 0-3
i, assemble opcode into next slot *note** simp
le code jump table using jump                 

    1400 list
g18 compiler h 3 ip 2 slot 4 call? 24576 cal 2
70077670 com 0 macro
!7 BD0489 3, FFFFFFFC , drop ;
2*s ?lit E0C1 2, 1, ;
call nn ?dup B8 1, , E9 1, cal @ here 3 + - +
, ; forth
swap swap ;
eras an push 613C call 69 swap block pop blks
fill ;
memory n-a 380 - and com @ 2* 8000 + block + ;
8000 nnc 2 * eras
org n dup h ! ip !
break 4 slot ! ;
/+/ nim-n push over + over or pop and or ;
o n 6 for 10 /mod next 6 for 8 * + next
p, n h @ memory ! h @ 1 3F /+/ h ! ;
s4 h @ ip ! 13 2*s dup call? ! p, 1 slot ! ;
s0 13 2*s
sn dup call? ! ip @ memory +! 1 slot +! ;
s1 8 2*s sn ;
s2 3 2*s sn ;
s3 dup 3 and drop if 7 sn s4 ; then 4 / sn ;
i, slot @ jump s0 s1 s2 s3 s4                 

defer -a byte address of the compiled code tha
t follows -- used for forward referencing
execute a code at this address
f! an store address of code executed when a wo
rd with this function is interpreted
f@ n-a fetch address of function code
class a store address of code to be executed f
or each word subsequently defined
empty redefine empty to restore altered functi
ons
host change context back to colorforth
functions aa store functions in kernel specifi
c way
c18 save green word and number functions. set
green short-number to n, compile to call. targ
et words are executed to assemble instructions
. nop used to fill instruction words
nops fills rest of word with nops
here -a starts new instruction word. leaves ta
rget address as number
await generates call to node's idle ports.    

    1402 list
target
cnt 2/ -1 + ;
defer -b pop ;
execute b push ;
f! bn sp + ! ;
f@ n-b sp + @ ;
class b last 1 + ! ;
empty empt
host 0 class 6 f@ nop 4 f@ nop 13 f@ nop
functions bbb 13 f! 4 f! 6 f! ;
. 1C i, ; nop
hhere here ;
.. slot @ 4 or drop if . .. ; then 0 call? ! ;
here .. h @ 3FF and ; hhere
report here 32 * 13 16 + + !7 ;
c18 b 1 f@ 0 + functions ;
+cy here 200 over - and or org ;
-cy here 200 - and org ;
await com @ idle cal @ execute ;              

the g18 uses adr bits 8 and 9 for modes; 7 for
i/o; 6 for rom. incrementer maintains bits 0-5
, rest are left alone except for return and sl
ot 0 jumps. br

hisame is true if the two addresses match in b
its 9 and 8 - the extended arithmetic and unde
fined mode bits. the first address is jump des
t and the last is p at time of the jump. both
are pattern as used.
-adr an assembles jump to known address
adr n-a assembles forward jump in slot 0,1,2.
value left on stack is instr addr * 64 + here-
ip + slot.
@h given that value / 8 returns p at time the
jump executes, as number.
then a insert address for forward jump        

    1404 list
g18 jump instructions
hisame axa-ax push over pop or - dup 2* and 20
0 and drop ;
j3 .
j0 i, ip @ memory +! break ;
j1 h @ 155 or hisame if swap FF and swap j0 ;
then . . j3 ;
j2 over 155 or h @ or 3F8 and drop if . j3 ; t
hen swap 7 and swap j0 ;
-adr an swap 155 or swap slot @ jump j0 j1 j2
j3 j0
adr n-n slot @ 3 or drop if i, ip @ 8 * h @ ip
@ negate + 7 and + 8 * slot @ + break ; then .
adr ;
@h n-a 8 /mod swap 3F /+/ ;
f3 an over 155 or over @h or 3F8 and drop if a
bort ; then swap 7 and swap 8 / memory +! ;
f2 dup @h 155 or hisame if swap FF and swap
f1 8 / memory +! ; then abort ;
then n here 155 or swap 8 /mod swap jump f1 f1
f2 f3                                         

def -a deferred to class. executed for every t
arget definition to compile host code that com
piles target call
call a compile target call
; will be executed as a target word. the penti
um macro has precedence while compiling
if/-if leaves address of jump on stack
-until a jump if positive to begin
zif forward next decrements r and jumps if r!
else pops and falls thru
next/for
n executed for green short-numbers. all 18-bit
target numbers are short. executes white short
-number to put interpreted number on stack. th
en assembles literal instruction with number i
n next location. inverted for rom
, n compile number into target memory
?lit -n retrieve previously compiled number
begin -a starts new instruction word. leaves p
roperly formatted target address
ahead compiles fwd ref jump resolve w/then
leap like ahead but compiles a call           

    1406 list
complex instructions
def defer here call ;
call defer a 3 -adr ; call cal !
; call? @ dup 6000 or drop if dup 300 or drop
if dup 18 or drop if 0 and i, break ; then the
n then dup 2/ and negate ip @ memory +! ;
-if -a 7 adr ;
if -a 6 adr ;
-until a 7 -adr ;
until a 6 -adr ;
-while a-aa 7 adr swap ;
while a-aa 6 adr swap ;
zif -a 5 adr ;
*next aa-a swap
next a 5 -adr ;
unext a 4 i, drop ;
n defer 8 f@ execute
lit 8 i, 3FFFF and ok in slot 3
, n 15555 or p, ;
for 1D i,
begin here ;
ahead -a 2 adr ;
end a 2 -adr ;
leap -a 3 adr ;                               

words being redefined for the target computer.
these host words can no longer be executed. al
though pentium macros take precedence during c
ompilation, they will no longer be used.
g18 instructions
0 ; ....8 n ..10 +* ..18 dup
1 ;' ...9 @+ .11 2* ..19 pop
2 j ....a @b .12 2/ ..1a over
3 call .b @ ..13 - ...1b a
4 unext c !p+ 14 + ...1c .
5 next .d !+ .15 and .1d push
6 if ...e !b .16 or ..1e b!
7 -if ..f ! ..17 drop 1f a!                   

    1408 list
instructions
target n c18 def class ;
ex -cr  ;' 1 i, break ;
rx
@p -cr  @p+ 8 i, ;
@+ 9 i, ;
@b A i, ;
@ B i, ;
!p -cr  !p+ C i, ;
!+ D i, ;
!b E i, ;
! F i, ;                                      

                                              

    1410 list
port literals - 2a or
right 95 lit ; 0010111111
down F5 lit ; 0011011111
left C5 lit ; 0011101111
up DD lit ; 0011110111
warp D4 lit ; 0011111110 ???
io D1 lit ; 0011111011
data DF lit ; 0011110101
center AD lit ; port calls
top A5 lit ;
side BD lit ;
corner B5 lit ;
/mod /mod ;
spispeed 497 0 lit ; 0 24-bit adrs 4 * 262144
/mod al ah 3 read cmd 256 * + 4 *
spicmd c.ah 0 + lit ;
spiadr al 0 + lit ;                           

o replaces top-of-stack with 0. g18 instructio
ns can't be used in macros - forth macros take
precedence                                    

    1412 list
more instructions
+* 10 i, ; slot 3 ok
2* 11 i, ;
2/ 12 i, ;
- 13 i, ;
+ 14 i, ; slot 3 ok
and 15 i, ;
or 16 i, ; exclusive-or
drop 17 i, ;
dup 18 i, ; slot 3 ok
pop 19 i, ;
over 1A i, ;
a 1B i, ;
push 1D i, ;
b! 1E i, ;
a! 1F i, ;                                    

                                              

    1414 list
                                              

                                              

    1416 list
                                              

                                              

    1418 list
math rom anywhere 0 kind br

A1 61 org cr
061 1388 load relay cr
069 -cr  warm await ; br

B0 70 org cr
070 1390 load multiply cr
077 1396 load fractional multiply cr
07C 1386 load taps cr
044 1384 load interpolate cr
04E 1394 load triangle cr
053 1398 load -u/mod br

AA 6A org cr
06A 1382 load polynomial approximation cr
070                                           

                                              

    1420 list
serdes boot top/bot 6 kind AA 6A reset br

A1 61 org cr
0A1 1388 load relay cr
0A9 -cr  warm await ; cr
cold 0AA 3141 a! 3FFFE dup ! rdlu cold ; br

0B0 1390 load multiply cr
0B7 1396 load fractional multiply cr
0BC 1386 load taps cr
0C4 1384 load interpolate cr
0CE 1394 load triangle cr
0D3 1398 load -u/mod cr
0E1                                           

                                              

    1422 list
sync serial boot side 2 kind AA 6A reset cr
needs rewrite for g4 wakeup!!! cr
BF 7F org -cr  sget cr
A1 61 org cr
061 1388 load relay cr
069 -cr  warm await ; cr
cold 06A A5 'rdl- a! @ @b . . -if 0pin cr
3FCB5 'rd-- 3fc00 + dup push dup begin cr
drop @b . -if /pin *next swap then cr
B5 'rd-- push drop push ; then
ser-exec 076 x-x sget push sget a! sget
ser-copy 079 push zif ; then cr
begin sget push sget pop !+ !+ next ; cr
7F org -cr  sget 07F -w dup leap leap
6in 041 then then leap leap
2in 043 then then 2* 2* dup begin cr
. drop @b . - -until - 2 and dup begin cr
. drop @b . . -until 2 and 2/ or or ; br

04D 1390 load multiply cr
054 1386 load taps cr
05C 1394 load triangle cr
061                                           

cold now insists on seeing the pin low after b
oot and thus will only start booting on a trul
y rising edge. no longer necessary to fake a c
all to the port since we are really doing one.
could use a call on the leading edge of a star
t bit too, eventually.                        

    1424 list
async serial boot top/bot 1 kind 6A reset cr
4F org -cr  18ibits cr
61 org cr
04F 1388 load relay cr
69 org 069 -cr  warm await ;
cold 06A @b -if rdl- then rdl-
ser-exec 06D x-d 18ibits drop push . cr
18ibits drop a! . 18ibits
ser-copy 072 xnx-d drop push zif ; then begin
18ibits drop !+ next ; 077 7B org
wait 07B x begin . drop @b -until . drop ;
sync 07E x-delay dup dup wait or - push begin
@b . -if . drop *next rd-- ; then . drop pop -
2/ ;
start 045 delay word - delay word b cr
dup wait over dup 2/ . + push
delay 048 nw-nwb cr
begin @b . -if then . drop next @b ; br

04B 4F org 1426 load 18ibits 1-wire xmit cr
6A org or - . setup dup xmit dup xmit cr
069 1392 load lsh rsh cr
069                                           

                                              

    1426 list
more async serial
18ibits 04F x - delay word x indent
     sync sync dup start leap 2bits leap
byte 054 then drop start leap
4bits 056 then leap
2bits 057 then then leap
1bit 058 nwb-nwb then indent
     push 2/ pop over or indent
     20000 and or over push delay ; cr
1-wire xmit and setup
xbit 05D n-n . -if over 2/ !b over !b . ; 11.5
ns then over dup 2/ !b !b . ; 3.7ns pulse
setup n-m push 20000 pop
xmit mn-m . 17 for . xbit 2* next @b drop drop
; cr
069 cr
0 to 0 cr
0 to 1 mbps max rate cr
1 to 0 cr
1 to 1                                        

                                              

    1428 list
spi boot top/bot 4 kind AA 6A reset host
--- 2A lit ;
--+ 2B lit ;
+-- 3A lit ;
+-+ 3B lit ;
-++ 2F lit ; target cr
61 org 1388 load relay br

42 org
8obits dw-dw' 7 for leap obit 2* *next ;
ibit 047 dw-dw' indent
     @b . -if drop - 2* ; then drop 2* - ;
half 04A dwc-dw !b over for . . unext ;
select 04C dw-dw -++ half --+ half ;
obit 050 dw-dw then indent
     -if +-- half +-+ half ; then
rbit 055 dw-dw --- half --+ half ;
18ibits 059 d-dw dup 17 for rbit ibit - next ;
cr
u2/ 2/ 1FFFF and ; 061 cr
69 org cr
069 -cr  warm await ; cr
06A 1430 load the rest cr
041                                           

                                              

    1430 list
more spi
cold 06A @b - .. B5 'rd-- -until indent
     spispeed spiadr push spicmd
spi-boot 070 dly adrh . adrl - dly x indent
     select 8obits 8obits indent
     drop pop . 8obits 8obits
spi-exec 076 dx-dx drop 18ibits indent
     1E000 . + B5 'rd-- -until indent
     push 18ibits a! 18ibits
spi-copy 07C dn-dx push zif ; then begin inden
t
     18ibits push 18ibits pop !+ !+ next dup ;
041                                           

                                              

    1432 list
analog 8 kind br

61 org cr
061 1388 load relay cr
069 -cr  warm await ; br

70 org cr
070 1390 load multiply cr
077 1396 load fractional multiply cr
07C 1434 load -dac cr
044 1384 load interpolate cr
04E 1394 load triangle cr
053 1398 load -u/mod 061 br

6A org cr
06A 1382 load polynomial approximation cr
070                                           

                                              

    1434 list
dac
-dac legacy entry name below
dac27 07C mcpaw-mcp dup push push indent
     over pop - . + push push 155 indent
     pop over or a indent
     begin unext !b . indent
     begin unext !b !b ;                      

cold now waits for pin to go low i.e. end of r
eset before looking for a rising edge. br

rdl- @b ; -if 21.5ns cr
0bit 39.5ns 1bit 42.5ns 23.5mbps              

    1436 list
1-wire 3 kind 6A reset br

5E org
rcv -n 17 dup for begin rdl- -if cr
drop - 2* @b drop - *next ; cr
then drop 2* @b drop next ; cr
068 free br

69 org 069 -cr  warm await ;
cold 06A @b -if rdl- cr
then rcv push rcv a! rcv indent
     for push zif ; then begin rcv !+ next ; b
r

074 1390 load multiply *.17 7 cr
07B 1396 load fractional multiply *. 5 cr
040 1384 load interpolate interp 10 cr
04A 1394 load triangle 5 cr
04F 1398 load -u/mod 14 cr
05E free                                      

                                              

    1438 list
null rom anywhere 0 kind