colorforth 11/05 chuck moore blocks 0-65 public domain macros 24 load 26 load 28 load colors 30 load
rest 36 block 2 24 reads ; the rest utilities
usb 20 load ; usb flash
dump 32 load ; background dump
icons 34 load ; edit chars
png 38 load ; png file format
file 44 load ; file io util
north 46 load ; view northbridge registers
floppy 60 load ; format, set video mark empty 11/05 release note --- floppy nvidia save -or- floppy ati save --- to change video driver vector ---

compile pentium colorforth
memory map: block is 1 kbyte
0 kernal 12k fonts 6k bytes
500 c18 compiled object code
595 deleted words - reinsert with i
640 top of stacks
1024 dictionary
7424 video frame buffer
32768 okad tables
524288 512 megabytes
dump compile memory display background task
icons compile icon editor
png screen image to usb flash drive
file compile dos file utility
north compile north-bridge pci bus display
---
editor
sct yrg* all-caps cap lower-case yellow red green * 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

usb macro macro searched first
p@ a! dup ed 1, ; cyan macro compilation
bswap c80f 2, ;
b! ?lit 589 2, , drop ; forth
ad n-n 2* ff80 e800 8000e820 pci -1 + or ;
u@ n-n ad p@ ;
regs 12 for i u@ 4 h.n space i ad 4 h.n cr -next ;
ok show black screen white regs keyboard ; free 67106904 3fff800 free !
toggle 7 ;
array pop + ; magenta variables
string align array 42535500 , 143 , 20000 , a008000 , 28 , 0 , 1 , 0 ,
+fr a-a 1 +
fr n-a dup 3ff and drop if ; then fffffc00 + ;
frame 4 u@ 2/ 2/ 1 + fr ;
td, free @ ffffff7f and free ! 22 load
move sd 128 for over @ over ! 1 dup v+ next drop drop ; yellow variable in green is literal
rest 31 block 1055 486 -31 + read ;
cf 0 1024 nc @ 18 * write ;
gds 4096 swap 255 + 256 / write ;
bot 3000 block dup 0 16 read 2000 block over move 2000 block over 128 6 * + move 0 16 write ;

p@ read register
p! write register
bswap byte-swap eax
b! store eax into literal byte address
ad byte-address of usb 16-bit register
u@ read usb register
regs display usb registers
ok start register display
free current address in work space
frames initialize 1024 frame pointers to off
+fr increment frame address - wrap
frame address of first accessible frame
td, wrap free 1st word of transfer
t, compile word into work space
b read 1024-byte blocks offset by 2000

usb flash stores gds image
t, free @ ! 1 free +! ;
/f n-b free @ + ffffff7f and 2* 2* ;
qh f-f +fr 0 /f 2 + over ! 1 td, 3 /f t, 0 t, 0 t, ;
wait free @ -3 + begin dup @ 3f and drop if drop 1 over ! ; then end
cbw qh 1 string 3c101e1 toggle @ or 1 td,
td an 800000 t, t, t, ;
tog toggle @ 80000 or toggle ! ;
csw anf qh 32 string here 1808169 toggle @ or 1 td, td tog 100 4 string 4 / +! wait drop drop drop ;
tran ann-an td, over over td 64 u+ 80000 or ;
command abncc-anf 16 string 4 / ! push bswap 21 string b! 2* bswap 18 string b! 2* 2* pop toggle @ or frame cbw wait ;
sector qh push 7 for 4 /f 4 + tran next 1 tran pop wait ;
read abn 2* dup push 7e08169 28 command begin sector next csw ;
write dup push 2* 7e901e1 2a command begin sector sector +fr next csw ;

/f wrap free
qh queue head. required for bulk transfers
wait till last transfer done
cbw command-block wrapper
td transfer descriptor
csw command-status wrapper. increment cbw tag
tran 64-byte transfer
bigend convert block number - 65535 max
active mark td
command multiple transfers
sector one frame of transfers
read multiple blocks from sector
write block at a time

macro
swap 168b 2, c28b0689 , ;
0 ?dup c031 2, ;
if 74 2, here ;
-if 79 2, here ;
a ?dup c28b 2, ;
a! ?lit if ba 1, , ; then d08b 2, drop ;
2* e0d1 2, ; 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, ;

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 + @

macros
push ?lit if 68 1, , ; then 50 1, drop ;
pop ?dup 58 1, ;
- d0f7 2, ;
*end swap
end eb
loop 1, here - + 1, ;
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 ;

push lit to sp; eax to sp
pop sp to eax
- ones-complement
begin -a current code address - byte
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

compiled macros
2/ f8d1 2, ;
time ?dup 310f 2, ;
7push 57 1, ;
7pop 5f 1, ; forth
@ @ ;
! ! ;
+ + ;
*/ */ ;
* * ;
/ / ;
2/ 2/ ;
dup dup ;
drop drop ; 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 ;
wrtboot 0 0 1 writes stop ;

2/ arithmetic right shift
time -n pentium cycle counter, calibrate to actual 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 type stop after the arguements on the stack go away to stop the floppy motor
save write colorforth to bootable floppy note do not hit any keys while floppy is being written - wait for light to go out sl r r r r r r s s s s s s 4 4 138 m s s

colors etc
block 100 * ;
save 18 block 1 nc @ -1 + writes stop ;
white ffffff color ;
red ff0000 color ;
green ff00 color ;
blue ff color ;
silver bfbfbf color ;
black 0 color ;
screen 0 dup at 1024 768 box ;
5* 5 for 2emit next ;
cf 25 dup at red 1 3 c 3 a 5* green 14 2 1 3 3e 5* ;
logo show black screen 800 710 blue box 600 50 at 1024 620 red box 200 100 at 700 500 green box text cf keyboard ; 64 load
empty empt logo ;
wait 10 30 * for 7push pause 7pop next ;
ruu boot ; off on qwerty keys

block n-a block number to word address
colors specified as rgb: 888 bits
screen fills screen with current color
at xy set current screen position - in kernel
box xy lower-right of colored rectangle - in kernel
5* emit letters
cf display double-size colorforth
logo displays colorforth logo
show background task executes following code repeatedly
keyboard displays keypad and stack
empty empty dictionary w/ empt display logo
wait while saving edi, in interrupt dead code artifact

dump x 511689 y -79640960
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 keyboard ;
it @ + @ dup h. space ;
lines for white i x it i y it or drop if red then 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

does not say empty, compiles on top of application
x -a current address
one a-a line of display
lines an
dump a background task continually displays memory --- takes address -- displays three cols with address on right contents in middle and- the left col is c18 instruction view
u increment address
d decrement
ati address of agp graphic registers
byte a byte address dump
fix an-a test word

icons empty macro
@w 8b66 3, ;
!w a! 28966 3, drop ;
*byte c486 2, ; forth ic 5 cu 89
sq xy @ 10000 /mod 16 + swap 12058640 + box t 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 -17 16 * 17 +at ;
ikon loc 24 for row 2 + next drop ;
adj 17 * swap ;
cursor cu @ 16 /mod adj adj over over at red 52 u+ 52 + box ;
ok show black screen cursor 18 dup at ikon text ic @ . keyboard ; 36 load ok h

draw big-bits icon
@w a-n fetch 16-bit word from byte address
!w na store same
*byte n-n swap bytes
ic -a current icon
cu -a cursor
sq draw small square
xy -a current screen position, set by at
loc -a location of current icons bit-map
0/1 n-n color square depending on bit 15
row a-a draw row of icon
+at nn relative change to screen position
ikon draw big-bits icon
adj nn-nn magnify cursor position
cursor draw red box for cursor
ok background task to continually draw icon, icon number at top sr 4210752 4210752 4210752

edit 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 ;
nul ;
h pad nul nul accept nul tl tu td tr l u d r -ic nul nul +ic nul nul nul nul nul nul nul nul nul nul nul nul 2500 , 110160c dup , , 2b000023 , 0 , 0 , 0 ,

png empty usb w 1024 h 768 d 1
frame 1d0000 ; 42 load 40 load
-crc a here over negate + crc . ;
crc -crc ;
here/4 -a here 3 and drop if 0 1, here/4 ; then here 2 2/s ;
bys nn-b . here swap , ;
plte 45544c50 48 bys ffffff 3, c00000 3, c000 3, c0c000 3, c0 3, c000c0 3, c0c0 3, 404040 3, c0c0c0 3, ff0000 3, ff00 3, ffff00 3, ff 3, ff00ff 3, ffff 3, 0 3, crc ;
png awh-an d @ / h ! d @ / w ! here/4 swap 474e5089 , a1a0a0d , ihdr 52444849 13 bys w @ . h @ . 304 , 0 1, crc plte idat 54414449 0 bys swap deflate crc iend 444e4549 0 bys crc here/4 over negate + ;
at 1024 * + frame + ;
full 1 d ! 0 dup at 1024 768 png ;
pad 1 d ! 46 -9 + 22 * nop 25 -4 + 30 * at 9 22 * nop 4 30 * png ;
put 7168 swap 255 + 256 / write ; full put

frame 1024*768*4 below 32m

lz77 macro
*byte c486 2, ;
!b a! 289 2, drop ; forth
*bys dup 16 2/s *byte swap ffff and *byte 10000 * + ;
. *bys , ;
+or over - and or ;
0/1 80 ? if 7e and 7e or drop if 7 ; then f ; then 0 and ;
4b dup 0/1 9 and over 8 2/s 0/1 a and +or swap 16 2/s 0/1 c and +or ;
pix dup @ d @ u+ 4b ;
row 1, dup w @ 2/ dup 1 + dup 2, - 2, 0 dup 1, +adl for pix 16 * push pix pop or dup 1, +adl next drop +mod d @ 1024 * + ;
deflate 178 2, 1 0 adl! h @ -1 + for 0 row next 1 row drop ad2 @ *byte 2, ad1 @ *byte 2, here over 4 + negate + *bys over -4 + !b ;

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

crc macro
2/s ?lit e8c1 2, 1, ;
1@ 8a 2, ; forth
array -a pop 2 2/s ;
bit n-n 1 ? if 1 2/s edb88320 or ; then 1 2/s ;
fill nn for dup 8 for bit next , 1 + next drop ;
table -a align array 0 256 fill
crc bn-n -1 swap for over 1@ over or ff and table + @ swap 8 2/s or 1 u+ next - nip ; ad1 45874 ad2 26480
+adl n ff and ad1 @ + dup ad2 @ +
adl! ad2 ! ad1 ! ;
+mod ad1 @ 65521 mod ad2 @ 65521 mod adl! ;

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

dos file
w/c 18 blocks ;
buffer 595 block ;
size -a buffer 0 1 reads buffer 98f + ;
set n ! buffer 0 1 writes ;
cyls n-nn 1 swap w/c -1 + + w/c / ;
put an dup 2* 2* size set cyls writes stop ;
puts an-an over 262144 put 262144 u+ -262144 + ;
get a size @ 3 + 2/ 2/ cyls reads stop ;
.com 0 63 blocks put ;
okad 0 nc @ 18 * blocks put ; okad blocks
-okad 18 block nc @ -1 + 18 * blocks put ;
recover 2000 block get ;
cf 2000 block 0 nc @ writes stop ; 42 load
mosis an 2* 2* swap 2* 2* over crc ;
upload 18 block 1 nc @ -1 + writes stop ;
download 18 block 1 nc @ -1 + reads stop ; --- upload download source blocks only

north bridge empty macro
4! ef 1, drop ; forth dev -2147424256
nb 80000000 dev ! ;
agp 80000800 dev ! ;
sb 80003800 dev ! ;
usb 8000e800 dev ! ;
graphic 3000000 device dev ! ;
ether 2000000 device dev ! ;
devs 80020000 65 for dup pci dup 1 + drop if dup h. space drop dup 8 + pci dup h. space over h. cr then drop fffff800 + next drop ;
k show black screen text devs keyboard ;
regs dev @ 19 4 * + 20 for dup pci h. space dup h. cr -4 + next drop ;
ok show black screen text regs keyboard ;
u 40 dev +! ;
d -64 dev +! ;
pci! na pci drop 4! ; ok k shows all pci devices while ok shows pci registers

4! nb store 4-byte word in byte address
dev -a current device configuration address
nb select north bridge as device
agp select agp bus
sb select south bridge
graphic locate graphic accelerator. starts with agp - bus 1, dev 0, - searches down. defaults to dev 2
ether locate ethernet controller
devs display device/vendor and class for each installed device
k start devices display
regs display configuration registers of current device
ok start register display
u move up in register space
d move down
pci! na store into configuration register. be carefull

convert colorforth character to/from ascii macro
1@ 8a 2, ; forth
string pop ;
cf-ii string 6f747200 , 696e6165 , 79636d73 , 7766676c , 62707664 , 71757868 , 336a7a6b 33323130 , 37363534 , 2d313938 - 2d7a3938 5f7a3938 , 2f322e30 2f6a2e6b , 2b213a3b 24213a3b , 3f2c2a40 ,
ch fffffff0 and unpack cf-ii + 1@ ff and ;
ii-cf string 2a00 , 0 + 2b , 2b2d0000 , 2725232e , zjk 1b262224 1b1a1918 , 1f1e1d1c , 28292120 , 2f000000 , 3a43355c , 3d3e3440 , 02 484a3744 kj 54523744 , 3336393c , 38314742 , 3f414632 , 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 02ih onml srqp wvut 1yx cba@ gfed 02ih onml srqp wvut 1yx

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 c@ 16 /mod 10 * + ;
sec0 4 bcd 60 * 2 bcd + 60 * 0 bcd + ;
sec sec0 2 ms dup sec0 or drop if drop sec ; then ;
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 ;

lan empty 3f8 54 load init
no block 4 * 1024 ;
send no for dup 1@ xmit 1 + next drop ;
receive no for rcv over 1! 1 + next drop ;
no 18 7 18 * ;
backup no for dup send 1 + next drop ;
accept no for dup receive 1 + next drop ;

sr 4210752 4210752 4210752

serial 3f8 2e8 1050 macro
p@ a! dup ec 1, ;
p! a! ee 1, drop ;
1@ 8a 2, ;
1! a! 288 2, drop ; forth
r 0 + + ;
9600 12 ;
115200 1 ;
b/s 83 3 r p! 9600 0 r p! 0 1 r p! 3 3 r p! ;
init b/s 16550 1 2 r p! 0 4 r p! ;
xmit n 5 r p@ 20 and drop if 0 r p! ; then pause xmit ;
cts 6 r p@ 30 and 30 ?i+@ drop if cts ; then xmit ;
st 6 r p@
xbits 30 and 10 / dup 1 and 2* 2* + 2/ ;
st! 4 r p! ;
?rcv 5 r p@ 1 and drop if 0 r p@ then ;
rcv ?rcv if ; then pause rcv ;

p@ p-n fetch byte from port
p! np store byte to port
1@ a-n fetch byte from byte address
1! na store byte to byte address
r n-p convert relative to absolute port address. base port on stack at compile time. compiled as literal at yellow-green transition
9600
115200 baud-rate divisors. these are names, not numbers
b/s set baud rate. edit to change
init initialize uart
xmit n wait for ready and transmit byte
cts n wait for clear-to-send then xmit
st -n fetch status byte
xbits n-n exchange status bits
st! n store control byte
?rcv fetch byte if ready. set flag to be tested by if
rcv -n wait for ready and fetch byte

boot assembler empty
org- over negate + ; macro
2ld nn ?lit ?lit swap b8 or 1, 2, ;
int n ?lit cd 1, 1, ;
cli fa 1, ;
xor n ?lit 3366 2, dup 8 * or c0 or 1, ;
call0 -n e8 3, here org- ;
rpop n ?lit 58 or 1, ;
sub nn ?lit 81 1, e8 or 1, 2, ;
movsd a566f3 3, ;
jmp aan ?lit ea 1, push org- 2, pop 2, ;
jis an-a ?lit here + ea 1, org- 2, ;
seg n ?lit 8e 1, 8 * c0 or 1, ;
0ld n ?lit b0 1, 1, ;
out n ?lit e6 1, 1, ;
in n ?lit e4 1, 1, ;
0and n ?lit 24 1, 1, ;
jnz a 75 1, here - + 1, ;
ld nr ?lit ?lit swap b8 or 1, , ; forth
/200 here 1ff and drop if 0 1, /200 ; then ;
fix b 4 / 2000 block 147 for over @ over ! 1 dup v+ next drop drop ; 200 load /200 here 58 load fix

p@ 2-byte port fetch
p! 4-byte port store
sector advance to 512-byte sector boundary
org- address relative to start-of-sector
2ld 16-bit register load
int fixed interrupt
cli clear interrupts, henceforth disabled
xor clear 32-bit register
pop pop stack into register
sub subtract number from register
movsd move string of 32-bit words
jmp to address with segment
seg load segment register from eax
0ld load al with number
out/in write/read fixed port from/to al
0and and al with number
jnz jump back if non-zero
ad compute port address
toggle address of data-toggle state. unused word in bcb. zero after boot

boot sector
org 7c00 e9 1, 17a 2, cf 20206663 , 312e3420 , bcb 512 2, 1 1, 38 2, 2 1, 0 , f8 1, 0 2, 3f 2, ff 2, toggle 0 , 129024 , 993 , 0 , 2 , 1 2, 6 2, gdt 17 2, 38 , 0 2, 0 , ffff , cf9a00 , ffff , cf9200 , cbw 42535500 , 143 , 74e007f , a008000 , 28 , 2026 300ea07 2049 108 , 468 a7 3d 2, ? 0 2, 0 , 190 load
video 4f02 0 2ld ati 4123 nvidia 4118 3 2ld 10 int cli 0 xor
segment cb8c 2, db8e 2, c08e 2,
relocate 6 xor 7 xor call0 6 rpop 6 sub 512 4 / 1 2ld movsd 5 jis 0 2,
protect lgdt 16010f 3, 34 2, cr0 1 0ld c0220f 3, 5 jis 8 2, 10 0ld 3 seg 0 seg stacks 2 seg a0000 4 ld 9f400 6 ld
boot 7 6 st 512 0 ld 7e88169 cbw wait sector eb 1, 21 44 + 1, 0 , 0 , 0 , 0 , 0 3, aa55 2,
csw qh 1 td, 0 1888169 td wait ; 31 2 * -2 + for sector next drop csw e9 1, 6f ,

sectors
0 boot
1,2 each end with aa55
3-5 zero
6-11 copy of 0-5
12 code - ends with aa55
13-37 zero
38-1030 fat: 0ffffff8 ffffffff 0fffffff 4
1031-2023 copy of fat
2022 cluster 0
2024 root directory: +8 name +f start +f size
2025 colorforth
org jmp, bios control block, global descriptor table, command-block wrapper
video select mode 1024*768 565, clear interrupts
segment clear segment registers
move this code from 7c00 to 0
relocate jump into it
protect establish protected mode, set segment registers and return stack pointer
a20 enable address bit 20
boot from usb file
boot+ continues in sector 1

format floppy empty 42 load hd 1 ad 152338
buffer 595 block ;
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 ;
bytes 4 * 64 + nc @ 18 * blocks 4 * -64 + crc ;
format 30 cylinders
archive 0 dup nc @ writes
check 0 bytes 2000 block dup 0 nc @ reads bytes stop ;
ati 10cd4123 17 ! ; setup for ati video card
nvidia 10cd4118 17 ! ; for nvidia card then save

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-back, recompute crc - first 64 bytes used by floppy read/write -- the two crc numbers should be the same !

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

word search
find 4
-find word + 18 block
f nc @ 18 * block over negate + for over over @ or drop if 1 + *next drop drop ; then dup 1 u+ 100 /mod swap curs ! edit ; here ekt 22 + !
fk drop drop f blk @ dup ;
def 3 -find ;
yel 1 -find ;
from n 4 word + swap block f ;
lit 20 * 6 + 18 block f ; finds literal

find following short compiled word. blocks 18 thru number of cylinders searched for 32-bit match that means first 8-bytes of name
f find next occurrance
fk key in edit keyboard. drops key and block number
def find definition
lit finds compiled literal
from n like find but start from block number