| \ 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 |
| ; |
