blob: fc5f9bdc8c4b7c38868fc0eb09cc2ae7ed8f68bf [file] [log] [blame]
\ Driver for SD card connected via SPI
defer spi-bits-in ( #bits -- n )
defer spi-out-in ( outbuf inbuf #bytes -- )
0 value high-capacity?
\ XXX needs a timeout
\ We must poll the first bit a bit at a time because
\ some microSD cards - notable SanDisk 4G - do not
\ align the R1 start bit to a byte boundary.
: r1 ( -- b )
#32 0 do \ Typically takes no more than 11 tries
1 spi-bits-in 0= if
7 spi-bits-in
unloop exit
then
loop
;
\ Used after cmd has already read the R1 byte
variable rbuf
: read1 ( -- b ) 0 rbuf 1 spi-out-in rbuf c@ ;
: read2 ( -- w ) 0 rbuf 2 spi-out-in rbuf be-w@ ;
: read4 ( -- l ) 0 rbuf 4 spi-out-in rbuf be-l@ ;
: send1 ( b -- ) rbuf c! rbuf 0 1 spi-out-in ;
: poly7-xor ( b -- b' ) dup $80 and if $89 xor then ;
: init-crc7 ( -- )
#256 0 do
i poly7-xor ( value )
8 1 do 2* poly7-xor loop ( value )
c,
loop
;
create crc7table init-crc7
: crc7 ( adr len -- crc7 )
0 -rot bounds ?do ( crc7 )
2* i c@ xor $ff and crc7table + c@ ( crc7' )
loop ( crc7 )
;
: +crc1021 ( crc b -- crc' )
swap wbsplit ( b crcl crch )
rot xor $ff and ( crcl x )
dup 4 rshift xor >r ( crcl r: x )
8 lshift r@ xor r@ 5 lshift xor r> #12 lshift xor
$ffff and ( crc' )
;
: crc1021 ( adr len -- crc )
0 -rot bounds ?do i c@ +crc1021 loop
;
: .sd-error ( r1 -- )
dup $40 and if ." ParameterError " then
dup $20 and if ." AddressError " then
dup $10 and if ." EraseSequenceError " then
dup $08 and if ." CommandCRCError " then
dup $04 and if ." IllegalCommand " then
$02 and if ." EraseReset" then
;
: ?sd-error ( r1 -- )
$7e and ?dup if .sd-error then
;
\ XXX needs a timeout
: wait-not-busy ( -- ) begin read1 0<> until ;
8 buffer: cmdbuf
4 value #flush
: sd-flush ( -- )
cmdbuf 8 $ff fill
cmdbuf 0 #flush spi-out-in
;
\ The command is 6 bytes but we use an 8-byte buffer
\ All commands have a 0 in the high bit as a "start bit"
\ for the transfer. We send an initial ff byte, containing
\ no start bit, to ensure that the card sees the start bit
\ in the right place - some cards otherwise get out of sync
\ with the bit stream.
: cmd ( arg cmd# -- r1 )
$ff cmdbuf c!
$40 or cmdbuf 1+ c! ( arg )
cmdbuf 2+ be-l! ( )
cmdbuf 1+ 5 crc7 2* 1 or cmdbuf 6 + c!
cmdbuf 0 7 spi-out-in r1
;
: cmde ( arg cmd# -- ) cmd ?sd-error ;
: .data-error ( n -- )
dup 8 and if ." Out of Range " then
dup 4 and if ." ECC Failed " then
dup 2 and if ." CC Error " then
1 and if ." Unknown Data Error" then
cr
;
: wait-data ( -- error-code )
begin read1 dup $ff = while drop repeat ( token )
case
$fe of 0 exit endof ( -- 0 )
1 of 1 exit endof ( -- 1 )
( default ) dup .data-error dup
endcase ( error-code )
;
false value check-crc?
: get-block ( adr len -- )
wait-data ?dup if ( adr len error )
1 = if ( adr len )
\ For Unknown Data Error, we fill the buffer with ff's
\ Some cards seem to return that value for unwritten blocks
$ff fill
else ( adr len )
2drop ( )
then ( )
exit ( -- )
then ( adr len )
2dup 0 -rot spi-out-in ( adr len )
read2 -rot ( crc adr len )
check-crc? if ( crc adr len )
crc1021 <> if ( )
." CRC error in get-block" cr
then
else ( crc adr len )
3drop ( )
then ( )
;
: ?put-data ( -- )
read1 dup 5 = if drop exit then ( token )
dup $11 and 1 <> if ." Bad data response token " .x cr exit then ( token )
case
$0b of ." CRC Error" cr endof
$0d of ." Write Error" cr endof
dup ." Funny error " .x cr
endcase
;
: put-block ( adr len token -- )
send1 ( adr len )
0 swap spi-out-in ( adr len )
?put-data ( )
wait-not-busy ( )
;
4 buffer: '#wr
#16 buffer: 'cid
#16 buffer: 'csd
#512 value /sd-block
: (sd-reset) ( -- r1 ) 0 0 cmd ;
: sd-reset ( -- )
5 0 do
(sd-reset) 1 = if unloop exit then
loop
true abort" SD Reset failed"
;
: send-op-cond ( hcs? -- ) 0<> $40000000 and 1 cmde ; \ CMD1
: send-if-cond ( arg -- response ) 8 cmde read4 ; \ CMD8
: send-csd ( -- ) 0 9 cmde 'csd #16 get-block ; \ CMD9
: send-cid ( -- ) 0 #10 cmde 'cid #16 get-block ; \ CMD10
: stop-transmission ( -- ) 0 #12 cmde wait-not-busy ; \ CMD12
: set-blocklen ( length -- ) #16 cmde ; \ CMD16
: fix-block# ( block# -- block#|byte# ) high-capacity? 0= if /sd-block * then ;
: read-single ( adr len block# -- )
fix-block# #17 cmde get-block relax
;
: read-multiple ( adr len block# -- )
fix-block# #18 cmde ( adr len )
begin dup 0> while ( adr len )
over /sd-block get-block ( adr len )
relax ( adr len )
/sd-block /string ( adr len )
repeat ( adr len )
2drop stop-transmission ( )
;
: write-single ( adr len block# -- ) fix-block# #24 cmde $fe put-block relax ;
: write-multiple ( adr len block# -- )
fix-block# #25 cmde ( adr len )
begin dup 0> while ( adr len )
over /sd-block $fc put-block ( adr len )
relax ( adr len )
/sd-block /string ( adr len )
repeat ( adr len )
2drop $fd send1 ( )
wait-not-busy
;
: program-csd ( -- ) 0 #27 cmde ;
: set-write-prot ( addr -- ) #28 cmde wait-not-busy ;
: clr-write-prot ( addr -- ) #29 cmde wait-not-busy ;
: send-write-prot ( addr -- ) #30 cmde ;
: erase-wr-blk-start-addr ( addr ) #32 cmde ;
: erase-wr-blk-end-addr ( addr ) ;
: sd-erase ( block# #blocks -- )
dup 0= if 2drop exit then ( block# #blocks )
bounds 1- #33 cmde #32 cmde ( )
0 #38 cmde wait-not-busy
;
: lock-unlock ( adr len -- ) 0 #42 cmde put-block ;
: app-cmd ( -- ) 0 #55 cmde ;
: gen-cmd ( adr len r/w_ -- )
dup #56 cmde if get-block else put-block then
;
: read-ocr ( -- ocr ) 0 #58 cmde read4 ; \ CMD58
: crc-on-off ( 0/1 -- ) #59 cmde ;
: app-send-status ( -- ) app-cmd 0 6 cmde read1 ;
: send-status ( -- extra-status ) app-cmd 0 #13 cmde read4 ; \ ACMD13
: send-num-wr-blocks ( -- #blocks ) app-cmd 0 #22 cmde '#wr 4 get-block '#wr be-l@ ;
: set-wr-blk-erase-count ( #blocks -- ) app-cmd #23 cmde ;
: sd-send-op-cond ( hcs? -- r1 ) app-cmd 0<> $40000000 and #41 cmd ;
: set-clr-card-detect ( set? -- ) app-cmd 0<> 1 and #42 cmde ;
: send-scr ( -- ) app-cmd 0 #51 cmde ;
: sd-consume ( -- )
#16 0 do
read1 $ff = if unloop exit then
loop
;
: sd-card-init ( -- )
sd-consume
sd-reset
$1aa send-if-cond $1aa <> abort" send-if-cond failed"
begin true sd-send-op-cond 1 and 0= until
\ Wait for power-up to complete then check the high-capacity bit
begin read-ocr dup $80000000 and 0= while drop repeat ( ocr )
$40000000 and 0<> to high-capacity?
high-capacity? if
#512
else
send-csd
1 'csd 5 + c@ $f and lshift
then
to /sd-block
;