mirror of https://github.com/mgcaret/of816.git
111 lines
2.0 KiB
Forth
111 lines
2.0 KiB
Forth
|
\ CompactFlash test code
|
||
|
vocabulary cflash
|
||
|
also cflash definitions
|
||
|
|
||
|
7F60 value card-base
|
||
|
E0000000 value lba-select \ drive 0, LBA mode
|
||
|
200 value block-size
|
||
|
|
||
|
struct
|
||
|
1 field card>data
|
||
|
0 field card>features
|
||
|
1 field card>error
|
||
|
1 field card>s-count
|
||
|
4 field card>lba
|
||
|
0 field card>command
|
||
|
1 field card>status
|
||
|
drop
|
||
|
|
||
|
: ?."
|
||
|
ascii " parse
|
||
|
[: rot if type cr else 2drop then ;]
|
||
|
state @ if
|
||
|
-rot postpone sliteral compile,
|
||
|
else
|
||
|
execute
|
||
|
then
|
||
|
; immediate
|
||
|
|
||
|
: send-cmd
|
||
|
card-base card>command c!
|
||
|
;
|
||
|
|
||
|
defer init-card
|
||
|
|
||
|
: cferror ( fatal? -- f | <abort> )
|
||
|
card-base card>status c@ 1 and 0= if drop false exit then
|
||
|
card-base card>error c@ ?dup 0= if drop false exit then
|
||
|
." CF error: " .
|
||
|
03 send-cmd card-base card>error c@
|
||
|
." ; sense code: " . cr
|
||
|
if abort else true then
|
||
|
;
|
||
|
|
||
|
|
||
|
\ wait for busy (b7) to become unset
|
||
|
: busy-wait
|
||
|
card-base card>status
|
||
|
begin
|
||
|
dup c@
|
||
|
dup 80 and 0= if 2drop exit then
|
||
|
1 and if ." (!BUSY) " true cferror drop then
|
||
|
again
|
||
|
;
|
||
|
|
||
|
\ wait for drq (b3) to be asserted
|
||
|
: drq-wait
|
||
|
card-base card>status
|
||
|
begin
|
||
|
dup c@
|
||
|
dup 08 and if 2drop exit then
|
||
|
1 and if ." (DRQ) " true cferror drop then
|
||
|
again
|
||
|
;
|
||
|
|
||
|
: init-card
|
||
|
\ set up 8-bit mode
|
||
|
busy-wait 1 card-base card>features c!
|
||
|
busy-wait ef send-cmd
|
||
|
0 set-lba
|
||
|
;
|
||
|
|
||
|
|
||
|
: set-lba ( lba -- )
|
||
|
busy-wait
|
||
|
0FFFFFFF and lba-select or card-base card>lba !
|
||
|
;
|
||
|
|
||
|
: (read-blk-data) ( addr -- )
|
||
|
busy-wait drq-wait
|
||
|
block-size 0 do
|
||
|
card-base card>data c@
|
||
|
over i + c!
|
||
|
loop
|
||
|
drop
|
||
|
;
|
||
|
|
||
|
: read-block ( lba addr -- )
|
||
|
busy-wait
|
||
|
1 card-base card>s-count c!
|
||
|
swap set-lba
|
||
|
20 send-cmd (read-blk-data)
|
||
|
true cferror drop
|
||
|
;
|
||
|
|
||
|
: (identify-drive) ( addr - )
|
||
|
busy-wait
|
||
|
EC send-cmd (read-blk-data)
|
||
|
;
|
||
|
|
||
|
: identify-drive
|
||
|
init-card 200 alloc-mem >r r@ (identify-drive)
|
||
|
false cferror if r> free-mem ." Error identifying" cr then
|
||
|
r@ a + w@ 0240 <> if r> free-mem ." Unable to identify" cr exit then
|
||
|
r@ 36 + 28 -trailing type ." rev. " r@
|
||
|
r@ 2e + 8 -trailing type cr
|
||
|
r@ 78 + @ . ." LBAs"
|
||
|
r> free-mem
|
||
|
;
|
||
|
|
||
|
previous definitions
|