Re: CF05, Block 20 (USB), =?windows-1255?b?k2ZyZWWU?=

Quoting Jason Kemp <[email protected]>:

>... " Hi,
>... " 
>... " There is a variable, free, whose comment says
>... " ג€current address in work 
>... " spaceג€ in this block.  The initial value is
>... " 3fff800 
>... " <http://slug/colorforth/index.php?page=3fff800>
>... " 
>... " Where does this address come from?
>... " 
>... " Sorry, I can't point to an html listing of the
>... " code on the Web
>... " 
>... " Thanks,
>... " Jason
>... " 

Nick here:  I can't help re USB, but here is an html
listing of CF05 in text form (original URL owner please
claim)

{block 18} 
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 --- 

--------------------------------------------------------------------------------
{block 19} 
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 

--------------------------------------------------------------------------------
{block 20} 
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 ; 

--------------------------------------------------------------------------------
{block 21} 
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 

--------------------------------------------------------------------------------
{block 22} 
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 ; 

--------------------------------------------------------------------------------
{block 23} 
/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 

--------------------------------------------------------------------------------
{block 24} 
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, ; 

--------------------------------------------------------------------------------
{block 25} 
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 + @ 

--------------------------------------------------------------------------------
{block 26} 
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 ; 

--------------------------------------------------------------------------------
{block 27} 
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 

--------------------------------------------------------------------------------
{block 28} 
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 ; 

--------------------------------------------------------------------------------
{block 29} 
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 

--------------------------------------------------------------------------------
{block 30} 
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 31} 
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 

--------------------------------------------------------------------------------
{block 32} 
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 

--------------------------------------------------------------------------------
{block 33} 
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 

--------------------------------------------------------------------------------
{block 34} 
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 

--------------------------------------------------------------------------------
{block 35} 
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 

--------------------------------------------------------------------------------
{block 36} 
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 , 

--------------------------------------------------------------------------------
{block 37} 
edit icon 

--------------------------------------------------------------------------------
{block 38} 
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 

--------------------------------------------------------------------------------
{block 39} 
frame 1024*768*4 below 32m 

--------------------------------------------------------------------------------
{block 40} 
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 ; 

--------------------------------------------------------------------------------
{block 41} 
0/1 0, f or 7 for dark, bright or dim 

--------------------------------------------------------------------------------
{block 42} 
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! ; 

--------------------------------------------------------------------------------
{block 43} 
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 

--------------------------------------------------------------------------------
{block 44} 
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 

--------------------------------------------------------------------------------
{block 45} 
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 

--------------------------------------------------------------------------------
{block 46} 
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 

--------------------------------------------------------------------------------
{block 47} 
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 

--------------------------------------------------------------------------------
{block 48} 
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 ; 

--------------------------------------------------------------------------------
{block 49} 
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 

--------------------------------------------------------------------------------
{block 50} 
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 ; 

--------------------------------------------------------------------------------
{block 51} 

--------------------------------------------------------------------------------
{block 52} 
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 ; 

--------------------------------------------------------------------------------
{block 53} 
sr 4210752 4210752 4210752 

--------------------------------------------------------------------------------
{block 54} 
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 ; 

--------------------------------------------------------------------------------
{block 55} 
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 

--------------------------------------------------------------------------------
{block 56} 
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 

--------------------------------------------------------------------------------
{block 57} 
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 

--------------------------------------------------------------------------------
{block 58} 
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 , 

--------------------------------------------------------------------------------
{block 59} 
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 

--------------------------------------------------------------------------------
{block 60} 
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 

--------------------------------------------------------------------------------
{block 61} 
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 !


--------------------------------------------------------------------------------
{block 62} 
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 + ; 

--------------------------------------------------------------------------------
{block 63} 

--------------------------------------------------------------------------------
{block 64} 
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 

--------------------------------------------------------------------------------
{block 65} 
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 

--------------------------------------------------------------------------------
{block 66} 

--------------------------------------------------------------------------------
{block 67} 

--------------------------------------------------------------------------------
{block 68} 

--------------------------------------------------------------------------------
{block 69} 

--------------------------------------------------------------------------------
{block 70} 

--------------------------------------------------------------------------------
{block 71}