'' +---------------------------------------------------------------------------+ '' | Cluso's P2 SD Driver: SD_DRIV V2.71 | '' +---------------------------------------------------------------------------+ '' | Authors: (c)2012-2020 "Cluso99" (Ray Rodrick) | '' | Modifications: | '' | License: MIT License | '' +---------------------------------------------------------------------------+ '' | Special thanks to the following authors for their ideas and MIT code: | '' | Michael Park, Dave Hein, Kye, James Moxham, Mike Green, Tomas Rokicki, | '' | lonesock, hippy, Jeff Ledger, Roger Williams, Michelli Scales, | '' | Andy Schenk. My apologies to any others I may have missed. | '' +---------------------------------------------------------------------------+ '' + SD_DEMO Demonstration user code for using the SD Driver objects + '' + SD_DRIV SD Driver - COG PASM resident driver + '' +---------------------------------------------------------------------------+ '' RR20200604 v250 first release '' RR20200812 v251 tweek docs '' RR20201201 prep for v260 release '' v252 get SD_MBOX update '' RR20201205 v253 mailbox posn: cmd/status/spare, bufad, sector, aux '' RR20201205 v260 second release (spin2 demo version) '' RR20210130 v262 tweek documentation '' RR20201205 v260 second release (spin2 demo version) '' RR20210130 v270 third release (spin2 demo version) '' RR20210228 v271 try FLTH #DO {I} and Init twice ' WARNING: _CLOCKFREQ is set to 200MHz for delay calcs! CON ''+============================================================================+ ''+ SD Driver: Constants and Equates + ''+============================================================================+ ' the following is required to approximate the delays _CLOCKFREQ = 200_000_000 ' set clock frequency '+-----------------------------------------------------------------------------+ sdx_ck = 61 ' pin SD Card clock sdx_cs = 60 ' pin SD Card select sdx_di = 59 ' pin SD Card MOSI sdx_do = 58 ' pin SD Card MISO '+-----------------------------------------------------------------------------+ delay1s = _CLOCKFREQ ' 1s (xtal * pll) delay10ms = _CLOCKFREQ / 100 ' 10ms delay5us = (_CLOCKFREQ / 100_000 / 2) - 2 ' 5us @???MHz 100KHz (20MHz/100KHz/2-2=98) '+-----------------------------------------------------------------------------+ '+-------[ SD Commands & Responses ]-------------------------------------------+ ' Command Argument Response/Data Description CMD0 = 0 +$40 ' 0 R1 - GO_IDLE_STATE *Reqs valid CRC ' CMD1 = 1 +$40 ' 0 R1 - SEND_OP_COND ACMD41 = 41 +$40 ' $4000_0000 R1 - APP_SEND_OP_COND *Reqs CMD55 first CMD8 = 8 +$40 ' 0 R1+R7 - SEND_IF_COND *Reqs valid CRC CMD9 = 9 +$40 ' 0 R1 Y SEND_CSD CMD10 = 10 +$40 ' 0 R1 Y SEND_CID ' CMD12 = 12 +$40 ' 0 R2 - STOP_TRANSMISSION CMD16 = 16 +$40 ' BlkLen[31:0] R1 - SET_BLOCKLEN CMD17 = 17 +$40 ' Addr[31:0] R1 Y READ_SINGLE_BLOCK ' CMD18 = 18 +$40 ' Addr[31:0] R1 Y READ_MULTIPLE_BLOCK ' CMD23 = 23 +$40 ' NoBlks[15:0] R1 - SET_BLOCK_COUNT ' ACMD23 = 23 +$40 ' NoBlks[22:0] R1 - SET_WR_BLOCK_ERASE_COUNT *Reqs CMD55 first CMD24 = 24 +$40 ' Addr[31:0] R1 Y* WRITE_SINGLE_BLOCK ' CMD25 = 25 +$40 ' Addr[31:0] R1 Y* WRITE_MULTIPLE_BLOCK CMD55 = 55 +$40 ' 0 R1 - APP_CMD *Prefix for ACMD41/ACMD23 CMD58 = 58 +$40 ' 0 R1+R3 - READ_OCR '+-------[ SD Responses ]------------------------------------------------------+ ' R1 response: $FF = busy/wait (0-8 bytes?) ' b7: 0 (msb first) ' b6: Parameter Error ' b5: Address Error ' b4: Erase Sequence Error ' b3: Command CRC Error ' b2: Illegal Command ' b1: Erase Reset ' b0: In Idle State ' R1b response: ??? ' R3 response: R1 + OCR(32b) ' R7 response: R1($01) + 32b(b11..b0 = $1AA = SDC V2 2V7-3V6, else reject) ' ' DataPacket: DataToken(1byte) + DataBlock(1-2048bytes) + CRC(2bytes) ' DataToken: $FE = CMD17/18/24 (read'1'block/read'n'blocks/write'1'block) ' $FC = CMD25 (write'n'blocks) ' $FD = CMD25 StopToken (Single byte packet without data or CRC) ' ErrorToken: Single Byte sdx_reply ' b7-b5: 000 ' b4: Card Locked ' b3: Out of Range ' b2: Card ECC failed ' b1: CC Error ' b0: Error ' DataResponse: ' b7-b4: xxx0 ' $x5: Data Accepted ' $xB: Data Rejected - CRC Error ' $xD: Data Rejected - Write Error '------------------------------------------------------------------------------+ '' +---------------------------------------------------------------------------+ '' + SD Driver: Mailbox Interface (COG resident PASM) + '' +---------------------------------------------------------------------------+ '' + sd_mailbox '\ [16] mailbox for SD Driver + '' + mbox_command byte 0 '| [1] command + '' + mbox_status byte 0 '| [1] status + '' + mbox_spare word 0 '| [2] -spare- + '' + mbox_bufad long 0 '| [4] address of disk buffer in hub + '' + mbox_sector long 0 '| [4] sector + '' + mbox_aux long 0 '/ [4] aux eg filesize + '' +---------------------------------------------------------------------------+ '' + The hub address of the 4 long mailbox is passed in PTRA and accessed by.. + m_cmd = 0 ' PTRA[m_cmd] (byte) m_stat = 1 ' PTRA[m_stat] (byte) m_bufad = 1 ' PTRA[m_bufad] (long) m_sector = 2 ' PTRA[m_sector] (long) m_aux = 3 ' PTRA[m_aux] (long) '' +---------------------------------------------------------------------------+ '' + SD_DRIV commands (via sd_mailbox)... + '' +---------------------------------------------------------------------------+ '' + "I" = Initialise SD Driver and SD Card + '' + "R" = readFastSector + '' + "W" = writeFastSector + '' + "D" = find Directory + '' + "F" = find File ("D" must have been done previously) + '' + "X" = Load/Execute (usually after "F") + '' +---------------------------------------------------------------------------+ ''+============================================================================+ ''+ SD Driver: Start using pasm... + ''+============================================================================+ ' mov sdcog, #16 ' start next cog avail and return cogid ' setq ##sd_mailbox ' put in PTRA of started cog ' coginit sdcog, ##@sddriver wc ' starts a free cog, returns cogid (id=16 initially) ''+============================================================================+ ''+============================================================================+ ''+ SD Driver: Start using spin... + ''+============================================================================+ VAR long sdcog ' cog+1 of sd driver long ptr_mailbox ' ptr to hub address of sd_mailbox PUB startSD(sd_mailbox) : result ' start SD Driver - uses a cog stopSD() ' stop cog if running ptr_mailbox := sd_mailbox sdcog := coginit(COGEXEC_NEW, @sddriver, ptr_mailbox) + 1 ' start sd driver cog return sdcog PUB stopSD() ' Stop SD Driver - frees a cog if driver was running if (sdcog) ' cog active? cogstop(sdcog-1) ' yes, shut it down sdcog := 0 ' and mark stopped bytefill(ptr_mailbox, -1, 2) ' reset object globals cmd=status=$FF ''+============================================================================+ DAT ''+============================================================================+ ''+ SD Driver: Mailbox Routines + ''+============================================================================+ orgh org 0 '+-----------------------------------------------------------------------------+ sddriver jmp #mainloop '+-----------------------------------------------------------------------------+ '+-----------------------------------------------------------------------------+ '+ Wait for something to do (via mailbox) + '+-----------------------------------------------------------------------------+ mainloop wrbyte #0, PTRA[m_cmd] ' clear ##mbox_command (after status updated) wait rdbyte sdx_status, PTRA[m_cmd] wz ' get ##mbox_command I/R/W/F/X if_z jmp #wait '+------------------------------------------------------------------+ rdlong sdx_bufad, PTRA[m_bufad] ' collect buffer address from ##mbox_bufad rdlong sdx_sector, PTRA[m_sector] ' collect sector address from ##mbox_sector '+------------------------------------------------------------------+ cmp sdx_status, #"I" wz ' I = initialise? if_e jmp #cmd_I cmp sdx_status, #"R" wz ' R = readFastSector if_e jmp #cmd_R cmp sdx_status, #"W" wz ' W = writeFastSector if_e jmp #cmd_W cmp sdx_status, #"D" wz ' D = find Directory if_e jmp #cmd_D cmp sdx_status, #"F" wz ' F = findFile if_e jmp #cmd_F cmp sdx_status, #"X" wz ' X = Load/Execute (usually after "F") if_e jmp #cmd_X done if_e wrbyte #0, PTRA[m_stat] ' set ##mbox_status (success) if_e jmp #mainloop wrbyte #$FF, PTRA[m_stat] ' set ##mbox_status (failed) ' setq #32-1 ' wrlong sdx_status, ##$FC400 ' dump regs for debugging jmp #mainloop '+-----------------------------------------------------------------------------+ cmd_I call #_SDInit ' initialise sd card call #_SDInit ' initialise sd card (twice) jmp #done '+-----------------------------------------------------------------------------+ cmd_R call #_readFastSector ' readFastSector jmp #done '+-----------------------------------------------------------------------------+ cmd_W call #_writeFastSector ' writeFastSector jmp #done '+-----------------------------------------------------------------------------+ cmd_D call #_SDWalk ' find Directory wrlong sdx_sector, PTRA[m_sector] ' set ##mbox_sector (first sector) jmp #done '+-----------------------------------------------------------------------------+ cmd_F ' rdlong sdx_bufad, ##mbox_bufad ' findFile mov PTRB, sdx_bufad ' copy bufad (stores filename) setq #3-1 rdlong sdx_fname, PTRB ' copy filename 8+3+$0 (ie w/o ".") call #_searchDIR wrlong sdx_sector, PTRA[m_sector] ' set ##mbox_sector (first sector) wrlong sdx_bytecnt,PTRA[m_aux] ' set ##mbox_aux (file size) jmp #done '+-----------------------------------------------------------------------------+ cmd_X rdlong sdx_sectorcnt,PTRA[m_aux] ' get ##mbox_aux (file size) add sdx_sectorcnt,#511 ' convert to ... shr sdx_sectorcnt,#9 ' ... sector count .next call #_readFastSector ' readFastSector if_ne jmp #done ' error? add sdx_sector, #1 ' sector++ add sdx_bufad, ##512 ' bufad++ djnz sdx_sectorcnt,#.next ' sectorcnt-- jmp #done '+-----------------------------------------------------------------------------+ ''+============================================================================+ ''+ SD Driver: Base Routines + ''+============================================================================+ '' +-----------------------------------------------------------------------------------------------+ '' + _SDInit ' initialises the SD Card + '' + _readFastSector ' read a sector into the buffer + '' + _writeFastSector ' write a sector from the buffer + ' '+ _readFastCSD ' read the CSD (16 bytes) into the buffer + ' '+ _readFastCID ' read the CID (16 bytes) into the buffer + '' +-----------------------------------------------------------------------------------------------+ '' +-------[ SDInit () : status ]---------------- SD Card Initialisation --------------------------+ '' + Call Format: + '' + CALL #_SDInit ' initialise the SD Driver and Card + '' + On Entry: + '' + -nil- + '' + On Return: + '' + sdx_status = ' returns status success=0, failure=-1=$FFFFFFFF + '' + sdx_cmdout = ' last cmd sent to card & $40 + '' + Returns "Z" if ok, "NZ" if error + '' +-----------------------------------------------------------------------------------------------+ '+-----------------------------------------------------------------------------+ '+ Send >74 clocks with /CS=1 & DI=1 starting & ending with CLK=0 + '+-----------------------------------------------------------------------------+ _SDInit call #_enable_pins ' outputs:/CS=1 CLK=0 DI=1 rep @.rep,#(96*2) ' outnot #sdx_ck '\ CLK=0-->1-->0 waitx ##delay5us '/ 5us @20MHz 100KHz (20MHz/100KHz/2-2=98) .rep ' /CS=1 & CLK=0 (idle) '+-----------------------------------------------------------------------------+ '+ Software Reset: + '+ CMD0, PAR=$0, CRC=$95, reply=R1($01) + '+-----------------------------------------------------------------------------+ .command0 getct sdx_timeout '\ set sdx_timeout up to CMD9 addct1 sdx_timeout, ##delay10ms '/ mov sdx_ctr1, #10 ' try a few times .again0 mov sdx_cmdout, #CMD0 mov sdx_cmdpar, #0 mov sdx_cmdcrc, #$95 '+-----------------------------------------------------------------------------+ call #_cmdR1 ' /CS=0, send cmd, recv R1, /CS=1 '+-----------------------------------------------------------------------------+ if_nc addct1 sdx_timeout, ##delay1s ' increase sdx_timeout to 1s '\ $01(idle): SD/MMC, not fully validated if_nc jmp #command8 '/ $00(good): (dane card response) '+-----------------------------------------------------------------------------+ waitx ##delay5us ' delay 5us @20MHz djnz sdx_ctr1, #.again0 ' n: try again? '+-----------------------------------------------------------------------------+ _fail MODCZ _set,_clr wcz ' "C" & "NZ" = fail jmp #_releaseDO '+-----------------------------------------------------------------------------+ ' we know we now have an SD/MMC card but its not fully validated yet... '+-----------------------------------------------------------------------------+ '+ Check Voltage: + '+ CMD8, PAR=$1AA, CRC=$87, reply=R1($01)+R7($xx1AA) ($05=try SDV1) + '+-----------------------------------------------------------------------------+ command8 mov sdx_cmdout, #CMD8 mov sdx_cmdpar, #$1AA mov sdx_cmdcrc, #$87 '+-----------------------------------------------------------------------------+ call #_cmdR1R7 ' /CS=0, send cmd, recv R1+R7, /CS=1 '+-----------------------------------------------------------------------------+ '\ $05(illegal cmd)=SDV1 not supported if_c_or_z jmp #_fail '/ j if <> $01 (not idle) .idle and sdx_reply, ##$FFF '\ cmp sdx_reply, #$1AA wz '/ R7[11:0]=$1AA ? if_ne jmp #_fail ' n: unknown R7 ' CMD55+ACMD41($0) fall thru '+-----------------------------------------------------------------------------+ '+ Prefix to ACMD41 & ACMD23: + '+ CMD55, PAR=$0, CRC=$xx, reply=R1($01) + '+-----------------------------------------------------------------------------+ .command55 mov sdx_cmdout, #CMD55 ' mov sdx_cmdpar, #0 ' '+-----------------------------------------------------------------------------+ call #_cmdRZA41 ' /CS=0, send cmd, recv R1, /CS=0(ena) '+-----------------------------------------------------------------------------+ if_c_or_z jmp #_fail ' <>$01 (not idle) ' fall thru '+-----------------------------------------------------------------------------+ '+ Check SDV1/SDV2: (follows CMD55) + '+ ACMD41, PAR=$40000000, CRC=$xx, reply=R1($00) SD-V2 + '+-----------------------------------------------------------------------------+ .commandA41 mov sdx_cmdout, #ACMD41 ' decod sdx_cmdpar, #30 ' SDV2=$40000000 (1<<30) '+-----------------------------------------------------------------------------+ call #_cmdR1 ' /CS=0, send cmd, recv R1, /CS=1 '+-----------------------------------------------------------------------------+ if_nc_and_nz jmp #.command55 ' =$01(busy): CMD55+CMD41 again if_c jmp #_fail ' <>$00/$01: error ' SDV2 fall thru '+-----------------------------------------------------------------------------+ '+ Check OCR CCS bit: + '+ CMD58, PAR=$0, CRC=$xx, reply=R1($00)+R3(b30=1) + '+-----------------------------------------------------------------------------+ .command58 mov sdx_cmdout, #CMD58 ' SDHC ? mov sdx_cmdpar, #0 ' '+-----------------------------------------------------------------------------+ call #_cmdR1R3 ' /CS=0, send cmd, recv R1+R3, /CS=1 '+-----------------------------------------------------------------------------+ if_c_or_nz jmp #_fail ' <>$00(good): error testbn sdx_reply, #30 wz ' bit30=CCS=1? $40000000? if_z jmp #_fail ' n: #2 SDV2(byte address) not supported ' y: #3 SDHC/SDV2(block address) fall thru '+-----------------------------------------------------------------------------+ '+ Force block size to 512 bytes: + '+ CMD16, PAR=$200, CRC=$xx, reply=R1($00) + '+-----------------------------------------------------------------------------+ .command16 mov sdx_cmdout, #CMD16 ' force blocksize=512bytes decod sdx_cmdpar, #9 ' $200 = 512 bytes '+-----------------------------------------------------------------------------+ call #_cmdR1 ' /CS=0, send cmd, recv R1, /CS=1 '+-----------------------------------------------------------------------------+ if_nc_and_nz jmp #.command16 ' =$01(idle): again ''if_nc_and_z ' =$00(good): done '+-----------------------------------------------------------------------------+ jmp #_releaseDO ' releaseDO & /CS=1 '+-----------------------------------------------------------------------------+ '' +-------[ readCSD/CID (address) : status ]---- SD Card read CSD & CID --------------------------+ '' + Call Format: + '' + CALL #_readFastSCD ' reads the card's CSD into the hub (16 bytes) + '' + CALL #_readFastCID ' reads the card's CID into the hub (16 bytes) + '' + + '' + On Entry: + '' + sdx_bufad = ' hub address of where to store results + '' + On Return: + '' + [sdx_bufad]= ' CSD(16 bytes) followed by CID(16 bytes) + '' + sdx_status = ' returns status success=0, failure=-1=$FFFFFFFF + '' + sdx_cmdout = ' last cmd sent to card & $40 + '' + Uses (in addition to named registers): + '' + PTRB = internal: pointer to Hub Buffer + '' + Returns "Z" if ok, "NZ" if error + '' +-----------------------------------------------------------------------------------------------+ '+-----------------------------------------------------------------------------+ '+ Read CSD register (16 bytes): + '+ CMD9, PAR=$0, CRC=$xx, reply=R1($00) + '+-----------------------------------------------------------------------------+ _readFastCSD .command9 mov sdx_cmdout, #CMD9 ' CMD9: read CSD register jmp #_readFastReg '+-----------------------------------------------------------------------------+ '+ Read CID register (16 bytes): + '+ CMD10, PAR=$0, CRC=$xx, reply=R1($00) + '+-----------------------------------------------------------------------------+ _readFastCID .command10 mov sdx_cmdout, #CMD10 ' CMD10: read CID register _readFastReg mov sdx_cmdpar, #0 ' PAR=$0 mov sdx_bytecnt, #16 ' CMD9,10: CSD,CID (16 bytes) jmp #_readFastCxD ' read & releaseDO & /CS=1 '+-----------------------------------------------------------------------------+ '' +-------[ readFastSector (sector, address) : status ]--------- read SECTOR from SD Card --------+ '' + Call Format: + '' + CALL #_readFastSector ' reads the sector into the hub address + '' + ' (512 bytes) + '' + On Entry: + '' + sdx_sector = ' sector number to read + '' + sdx_bufad = ' hub address of where to read into + '' + On Return: + '' + [sdx_bufad]= ' data(512 bytes) read from sector + '' + sdx_status = ' returns status success=0, failure=-1=$FFFFFFFF + '' + sdx_cmdout = ' last cmd sent to card & $40 + '' + Uses (in addition to named registers): + '' + PTRB = internal: pointer to Hub Buffer + '' + Returns "Z" if ok, "NZ" if error + '' +-----------------------------------------------------------------------------------------------+ '+-----------------------------------------------------------------------------+ '+ Read Block/Sector: (512 bytes) + '+ CMD17, PAR=blocknr, CRC=$xx, reply=R1($??) +n*$FF +($FE+block+CRC16) + '+-----------------------------------------------------------------------------+ _readFastSECTOR .command17 mov sdx_cmdout, #CMD17 ' CMD17: mov sdx_cmdpar, sdx_sector ' PAR=sector# decod sdx_bytecnt, #9 ' $200 = 512 bytes _readFastCxD call #_enable_pins ' outputs:/CS=1 CLK=0 DI=1 mov PTRB, sdx_bufad ' set hub buffer addr getct sdx_timeout '\ set sdx_timeout for cmd17 addct1 sdx_timeout, ##delay1s '/ '+-----------------------------------------------------------------------------+ ' getct sdx_dbg 'debug-time ' wrlong sdx_dbg, ##sdx_dbg_1 'debug-time call #_cmdRZtoken ' /CS=0, send cmd, recv R1, /CS=0(ena) if_nz jmp #_fail ' <>$00=error="NZ"=failed '+-----------------------------------------------------------------------------+ call #_getreply ' n*$FF+$FE cmp sdx_reply, #$FE wz ' $FE=valid Data Token if_nz jmp #_fail ' <>$FE=error="NZ"=failed '+-----------------------------------------------------------------------------+ ' getct sdx_dbg 'debug-time ' wrlong sdx_dbg, ##sdx_dbg_2 'debug-time '+-----------------------------------------------------------------------------+ 'read 512 bytes: wkg but we are sampling 3 clocks after CLK=H and 2 clocks before CLK=L 48714 clocks (was 194742) ' Note: From testing at 200MHz there are 7 clocks between OUTx and TESTP and 8 clocks between OUTx and TESTB ' Note: Both TESTP or TESTB alternatives shown :) WRFAST #0, PTRB ' use streamer /fifo rep @.reprd, sdx_bytecnt ' read 512 bytes (or 16 bytes if CSD/CID) ' outl #sdx_ck ' CLK=0 (already 0 first time) .s7 outh #sdx_ck ' CLK=1 mov sdx_reply, #0 ' clear reply outl #sdx_ck ' CLK=0 nop .s6 outh #sdx_ck ' CLK=1 testp #sdx_do wc '\ read input bit7: sample on/after prior CLK rising edge ' testb inb, #sdx_do-32 wc '/ read input bit7: sample on/after prior CLK rising edge outl #sdx_ck ' CLK=0 rcl sdx_reply, #1 ' accum DO input bit 7 .s5 outh #sdx_ck ' CLK=1 testp #sdx_do wc '\ read input bit6: sample on/after prior CLK rising edge ' testb inb, #sdx_do-32 wc '/ read input bit6: sample on/after prior CLK rising edge outl #sdx_ck ' CLK=0 rcl sdx_reply, #1 ' accum DO input bit 6 .s4 outh #sdx_ck ' CLK=1 testp #sdx_do wc '\ read input bit5: sample on/after prior CLK rising edge ' testb inb, #sdx_do-32 wc '/ read input bit5: sample on/after prior CLK rising edge outl #sdx_ck ' CLK=0 rcl sdx_reply, #1 ' accum DO input bit 5 .s3 outh #sdx_ck ' CLK=1 testp #sdx_do wc '\ read input bit4: sample on/after prior CLK rising edge ' testb inb, #sdx_do-32 wc '/ read input bit4: sample on/after prior CLK rising edge outl #sdx_ck ' CLK=0 rcl sdx_reply, #1 ' accum DO input bit 4 .s2 outh #sdx_ck ' CLK=1 testp #sdx_do wc '\ read input bit3: sample on/after prior CLK rising edge ' testb inb, #sdx_do-32 wc '/ read input bit3: sample on/after prior CLK rising edge outl #sdx_ck ' CLK=0 rcl sdx_reply, #1 ' accum DO input bit 3 .s1 outh #sdx_ck ' CLK=1 testp #sdx_do wc '\ read input bit2: sample on/after prior CLK rising edge ' testb inb, #sdx_do-32 wc '/ read input bit2: sample on/after prior CLK rising edge outl #sdx_ck ' CLK=0 rcl sdx_reply, #1 ' accum DO input bit 2 .s0 outh #sdx_ck ' CLK=1 testp #sdx_do wc '\ read input bit1: sample on/after prior CLK rising edge ' testb inb, #sdx_do-32 wc '/ read input bit1: sample on/after prior CLK rising edge outl #sdx_ck ' CLK=0 rcl sdx_reply, #1 ' accum DO input bit 1 nop ' do not do CLK=1 (NOP for timing) testp #sdx_do wc '\ read input bit0: sample on/after prior CLK rising edge ' testb inb, #sdx_do-32 wc '/ read input bit0: sample on/after prior CLK rising edge rcl sdx_reply, #1 ' accum DO input bit 0 wfbyte sdx_reply ' save byte to streamer/fifo .reprd '+-----------------------------------------------------------------------------+ ' since we are not checking crc(2 bytes), no need to sample, so can go 2x speed (50MHz @ 200MHz clock) ' in cog we can do rep just as fast as inline hubexec rep @.repcrc, #2*8 outh #sdx_ck ' CLK=1 outl #sdx_ck ' CLK=0 .repcrc '+-----------------------------------------------------------------------------+ ' getct sdx_dbg 'debug-time ' wrlong sdx_dbg, ##sdx_dbg_3 'debug-time '+-----------------------------------------------------------------------------+ .pass MODCZ _clr,_set wcz ' "NC" & "Z" = success '+-----------------------------------------------------------------------------+ '+ /CS=1, Release SD Card DO pin, tristate SD CS/CK/DI/DO + '+-----------------------------------------------------------------------------+ _releaseDO ' if "NC" & "Z" = success call #_sendFastFF ' releaseDO bith sdx_bitout, #sdx_cs ' prepare /CS=1(disable) call #_sendFastFF ' releaseDO again to be sure! flth #sdx_cs ' tristate /CS fltl #sdx_ck ' tristate CLK flth #sdx_di ' tristate DI if_nc_and_z mov sdx_status, #0 ' $0 = "NC" & "Z" = success if_c_or_nz neg sdx_status, #1 ' $ffff_ffff = "C" | "NZ" = fail RET ' '+-----------------------------------------------------------------------------+ '' +-------[ writeFastSector (sector, address) : status ]-------- write SECTOR to SD Card ---------+ '' + Call Format: + '' + CALL #_writeFastSector ' writes the sector from the hub address + '' + ' (512 bytes) + '' + On Entry: + '' + sdx_sector = ' sector number to write + '' + sdx_bufad = ' hub address of where to write from + '' + [sdx_bufad]= ' data(512 bytes) for write to sector + '' + On Return: + '' + sdx_status = ' returns status success=0, failure=-1=$FFFFFFFF + '' + sdx_cmdout = ' last cmd sent to card & $40 + '' + Uses (in addition to named registers): + '' + PTRB = internal: pointer to Hub Buffer + '' + Returns "Z" if ok, "NZ" if error + '' +-----------------------------------------------------------------------------------------------+ '+-----------------------------------------------------------------------------+ '+ WriteBlock/Sector: (512 bytes) + '+ CMD24, PAR=blocknr, CRC=$xx, reply=R1($??) +n*$FF +($FE+block+CRC16) + '+-----------------------------------------------------------------------------+ _writeFastSECTOR .command24 mov sdx_cmdout, #CMD24 ' mov sdx_cmdpar, sdx_sector ' sector# call #_enable_pins ' outputs:/CS=1 CLK=0 DI=1 mov PTRB, sdx_bufad ' set hub buffer addr getct sdx_timeout '\ set sdx_timeout for cmd24 addct1 sdx_timeout, ##delay1s '/ '+-----------------------------------------------------------------------------+ ' getct sdx_dbg 'debug-time ' wrlong sdx_dbg, ##sdx_dbg_1 'debug-time call #_cmdRZ24 ' /CS=0, send cmd, recv R1, /CS=0(ena) '+-----------------------------------------------------------------------------+ if_c_or_nz jmp #.time ' sdx_timeout or <>$00 call #_sendFastFF ' write dummy byte $FF mov sdx_dataout, #$FE ' $FE call #_sendFastByte ' send block prefix '+-----------------------------------------------------------------------------+ ' getct sdx_dbg 'debug-time ' wrlong sdx_dbg, ##sdx_dbg_2 'debug-time '+-----------------------------------------------------------------------------+ RDFAST #0, PTRB ' use streamer /fifo rep @.repwr, ##512 ' write 512 bytes rfbyte sdx_dataout ' get byte from streamer/fifo rol sdx_dataout, #25 wc ' test output bit 7 (DI=0/1) (msbit first) bitc sdx_bitout, #sdx_di-32 ' prepare output bit 7 ready for output with clk=0 .o7 mov outb, sdx_bitout ' OUT: /CS=0 + CLK=0 + DI=0/1 (output data with CLK falling edge) rol sdx_dataout, #1 wc ' test output bit 6 (DI=0/1) outh #sdx_ck ' CLK=1 bitc sdx_bitout, #sdx_di-32 ' prepare output bit 6 ready for output with clk=0 .o6 mov outb, sdx_bitout ' OUT: /CS=0 + CLK=0 + DI=0/1 (output data with CLK falling edge) rol sdx_dataout, #1 wc ' test output bit 5 (DI=0/1) outh #sdx_ck ' CLK=1 bitc sdx_bitout, #sdx_di-32 ' prepare output bit 5 ready for output with clk=0 .o5 mov outb, sdx_bitout ' OUT: /CS=0 + CLK=0 + DI=0/1 (output data with CLK falling edge) rol sdx_dataout, #1 wc ' test output bit 4 (DI=0/1) outh #sdx_ck ' CLK=1 bitc sdx_bitout, #sdx_di-32 ' prepare output bit 4 ready for output with clk=0 .o4 mov outb, sdx_bitout ' OUT: /CS=0 + CLK=0 + DI=0/1 (output data with CLK falling edge) rol sdx_dataout, #1 wc ' test output bit 3 (DI=0/1) outh #sdx_ck ' CLK=1 bitc sdx_bitout, #sdx_di-32 ' prepare output bit 3 ready for output with clk=0 .o3 mov outb, sdx_bitout ' OUT: /CS=0 + CLK=0 + DI=0/1 (output data with CLK falling edge) rol sdx_dataout, #1 wc ' test output bit 2 (DI=0/1) outh #sdx_ck ' CLK=1 bitc sdx_bitout, #sdx_di-32 ' prepare output bit 2 ready for output with clk=0 .o2 mov outb, sdx_bitout ' OUT: /CS=0 + CLK=0 + DI=0/1 (output data with CLK falling edge) rol sdx_dataout, #1 wc ' test output bit 1 (DI=0/1) outh #sdx_ck ' CLK=1 bitc sdx_bitout, #sdx_di-32 ' prepare output bit 1 ready for output with clk=0 .o1 mov outb, sdx_bitout ' OUT: /CS=0 + CLK=0 + DI=0/1 (output data with CLK falling edge) rol sdx_dataout, #1 wc ' test output bit 0 (DI=0/1) outh #sdx_ck ' CLK=1 bitc sdx_bitout, #sdx_di-32 ' prepare output bit 0 ready for output with clk=0 .o0 mov outb, sdx_bitout ' OUT: /CS=0 + CLK=0 + DI=0/1 (output data with CLK falling edge) ' nop ' filler (can remove) outh #sdx_ck ' CLK=1 (next CLK=0 is in repeat loop except for last time) .repwr bith sdx_bitout, #sdx_di-32 ' prepare crc16 (send $FF $FF) ie DI=1 always outl #sdx_ck ' CLK=0 on exit '+-----------------------------------------------------------------------------+ ' NOTE: CRC16 is not calculated - so we are going to send $FF $FF really fast!! rep @.repcrc, #16 ' write CRC16 2*8 bits outh #sdx_ck ' CLK=1 mov outb, sdx_bitout ' OUT: /CS=0 + CLK=0 + DI=1 (output data with CLK falling edge) .repcrc '+-----------------------------------------------------------------------------+ ' getct sdx_dbg 'debug-time ' wrlong sdx_dbg, ##sdx_dbg_3 'debug-time '+-----------------------------------------------------------------------------+ .wait call #_recvFastByte ' reply? pollct1 wc ' c if sdx_timeout if_c jmp #.time ' j if sdx_timeout and sdx_reply, #$1F ' cmp sdx_reply, #$05 wz ' xxx00101=accept if_nz jmp #.time ' j if <>$05 (failure) '+-----------------------------------------------------------------------------+ .waitff call #_recvFastByte ' busy? pollct1 wc ' c if sdx_timeout if_c jmp #.time ' j if sdx_timeout cmp sdx_reply, #$00 wz ' $00=busy? if_z jmp #.waitff ' y: wait cmp sdx_reply, #$FF wz ' completed? if_z jmp #.time ' y: return ok jmp #.waitff ' wait while busy '+-----------------------------------------------------------------------------+ .time ' c=sdx_timeout; nz=failure ' if "NC" & "Z" = success jmp #_releaseDO ' releaseDO & /CS=1 '+-----------------------------------------------------------------------------+ '+-----------------------------------------------------------------------------+ '+ SEND: CMDx, PARx, CRCx, GET reply + '+-----------------------------------------------------------------------------+ _cmdRZA41 ' CMD55: R1 response _cmdRZtoken ' CMD9,10,17: R1+$FE response _cmdRZ24 ' CMD24: R1 response mov sdx_cmdtype, #1 ' returns w /CS=0(ena) jmp #_cmdxx ' _cmdR1R3 ' CMD58: R1+R3 response _cmdR1R7 ' CMD8: R1+R7 response _cmdR1 ' CMD0,A41,16: R1 response mov sdx_cmdtype, #0 ' returns w /CS=1(disabled) _cmdxx ' '+-----------------------------------------------------------------------------+ outl #sdx_cs ' /CS=0 (enable) '+-----------------------------------------------------------------------------+ call #_sendFastFF ' send $FF byte first mov sdx_dataout, sdx_cmdout ' CMD call #_sendFastByte ' send cmd byte mov sdx_dataout, sdx_cmdpar ' Parameter mov sdx_bitcnt, #4 ' prepare to Send a Long (long=32bits) =4bytes call #_sendFastLong ' send 4 bytes (MSB first) mov sdx_dataout, sdx_cmdcrc ' CRC call #_sendFastByte ' send crc byte '+-----------------------------------------------------------------------------+ call #_getreply ' recv R1/R1+R3/R1+R7/RZ..+Token '+-----------------------------------------------------------------------------+ skip sdx_cmdtype '\ skips next instr if #1 outh #sdx_cs '| /CS=1(disable) if reqd RET '/ else /CS=0 cmdRZA41/cmdRZtoken '+=============================================================================+ '+-----------------------------------------------------------------------------+ '+ READ reply: R1/R1+R3/R1+R7/R1+token + '+-----------------------------------------------------------------------------+ _getreply call #_recvFastByte ' recv R1 byte cmp sdx_reply, #$FF wz ' reply=$FF=busy ? if_nz jmp #.doneR1 ' n: pollct1 wc ' c if sdx_timeout if_nc jmp #_getreply ' n: try again _RET_ MODCZ _set,_clr wcz ' sdx_timeout: C & NZ = fail '+=============================================================================+ .doneR1 mov sdx_replyR1, sdx_reply ' save R1/Token reply '+-----------------------------------------------------------------------------+ cmp sdx_cmdout, #CMD8 wz if_nz cmp sdx_cmdout, #CMD58 wz if_nz jmp #.end ' ret if not CMD8/CMD58 '+-----------------------------------------------------------------------------+ ' receive long reply... R7=CMD8=volts/R3=CMD58=OCR call #_recvFastByte ' R7=CMD8=volts/R3=CMD58=OCR setbyte sdx_rcvlong, sdx_reply, #3 ' MSB byte call #_recvFastByte ' setbyte sdx_rcvlong, sdx_reply, #2 ' next byte call #_recvFastByte ' setbyte sdx_rcvlong, sdx_reply, #1 ' next byte call #_recvFastByte ' setbyte sdx_rcvlong, sdx_reply, #0 ' LSB byte mov sdx_reply, sdx_rcvlong ' recover long '+-----------------------------------------------------------------------------+ .end '\ returns with... '| nc+z replyR1=$00(success) test sdx_replyR1, #1 wz '| nc+nz replyR1=$01(idle) _RET_ cmpr sdx_replyR1, #$01 wc '/ c replyR1>$01(error) '+-----------------------------------------------------------------------------+ '+-----------------------------------------------------------------------------+ '+ SD SPI Send Routines... (write byte/long) + '+ /CS=0 & CLK=0 on both entry and exit + '+-----------------------------------------------------------------------------+ ' send byte/word/long in dataout (already in position ie <<24/16/0); bitcnt set to 1/2/4 ' note: we use bitcnt as a byte counter in sendFast _sendFastByte rol sdx_dataout, #24 ' call here to Send a Byte (msbit first) mov sdx_bitcnt, #1 ' bitcnt=1 (counts bytes) _sendFastLong ' call here to send a long with bitcnt=4 (counts bytes) rol sdx_dataout, #1 wc ' test output bit 7/15/31 (DI=0/1) (msbit first) .sendFaster rep @.repbits, #8 ' repeat for 8 bits bitc sdx_bitout, #sdx_di-32 ' prepare output bit 7 ready for output with clk=0 .o7 mov outb, sdx_bitout ' OUT: /CS=0 + CLK=0 + DI=0/1 (output data with CLK falling edge) rol sdx_dataout, #1 wc ' test output bit 6 (DI=0/1) outh #sdx_ck ' CLK=1 .repbits djnz sdx_bitcnt, #.sendFaster ' any more bytes to send? outl #sdx_ck ' CLK=0 on exit RET wcz ' & restore flags '+-----------------------------------------------------------------------------+ '+-----------------------------------------------------------------------------+ ' Special send routine for sending $FF really fast _sendFastFF bith sdx_bitout, #sdx_di-32 ' prepare output bit=1 ready for output with clk=0 rep @.rep, #8 ' repeat 8x mov outb, sdx_bitout ' OUT: /CS=0 + CLK=0 + DI=0/1 (output data with CLK falling edge) outh #sdx_ck ' CLK=1 .rep _RET_ outl #sdx_ck ' CLK=0 on exit (DI remains 0/1) (cz same) '+-----------------------------------------------------------------------------+ '+-----------------------------------------------------------------------------+ '+ SD SPI Recv Routines... (read byte) + '+ /CS=0 & CLK=0 on both entry and exit + '+-----------------------------------------------------------------------------+ ' outl #sdx_ck ' CLK=0 (already 0 first time) _recvFastByte rep @.repbits, #8 outh #sdx_ck ' CLK=1 testp #sdx_do wc '\ read input bit: sample on/after prior CLK rising edge ' testb inb, #sdx_do-32 wc '/ read input bit: sample on/after prior CLK rising edge outl #sdx_ck ' CLK=0 rcl sdx_reply, #1 ' accum DO input bit (first time is dummy) .repbits nop ' do not do CLK=1 (NOP for timing) testp #sdx_do wc '\ read input bit0: sample on/after prior CLK rising edge ' testb inb, #sdx_do-32 wc '/ read input bit0: sample on/after prior CLK rising edge rcl sdx_reply, #1 ' accum DO input bit 0 and sdx_reply, #$FF ' strip the 9th dummy bit RET wcz ' & restore flags '+-----------------------------------------------------------------------------+ '+-----------------------------------------------------------------------------+ '+ Enable SD I/O Pins + '+-----------------------------------------------------------------------------+ _enable_pins drvh #sdx_cs ' /CS=1 & output drvl #sdx_ck ' CLK=0 & output drvh #sdx_di ' DI =1 & output flth #sdx_do ' DO =1 & input mov SDX_bitout, #0 ' OUTB: /CS=0 CLK=0 DI=0 waitx #20 ' delay 20 clocks (was 5us) RET '+-----------------------------------------------------------------------------+ ''+============================================================================+ ''+ SD Driver: Walks the SD Card FAT32 Directory tree... + ''+============================================================================+ ''+ _SDWalk: Walks the MBR/VOL/DIR tree, returns DIR_BEGIN + ''+ _searchDIR: Searches the Directory for a filename, + ''+ returns the file start sector and file size (bytes) + ''+============================================================================+ '' +-------[ _SDWalk (address) : status ]-------- Walk the tree to the DIRectory ------------------+ '' + Call Format: + '' + CALL #_SDWalk ' walks the FAT32 tree to the Directory entries + '' + On Entry: + '' + sdx_sector = -anything- ' sector number to read + '' + sdx_bufad = ' hub address of where to read into (512 bytes) + '' + On Return: + '' + [sdx_bufad]= ' last sector read (no particular use) + '' + sdx_status = ' returns status success=0, failure=-1=$FFFFFFFF + '' + sdx_cmdout = ' last cmd sent to card & $40 + '' + sdx_sector = ' first sector of FAT directory + '' + Uses (in addition to named registers): + '' + PTRB = internal: pointer to Hub Buffer + '' +-----------------------------------------------------------------------------------------------+ _SDWalk '+-----------------------------------------------------------------------------+ '+ Read MBR/VBR (Sector 0): + '+-----------------------------------------------------------------------------+ ._readMBR mov sdx_sector, #0 ' VBR/MBR = SECTOR 0 call #_readFastSector ' read sector '+-----------------------------------------------------------------------------+ '+ Validate MBR (PTN0 table & signature) + '+ +$1BE[16] = = Ptn0 Table... + '+ verify +$1BE+$0[1] = $00/$80 = Ptn0 State + '+ verify +$1BE+$4[1] = $0B/$0C = Ptn0 Type + '+ calc +$1BE+$8[4] = = Ptn0 StartSector# --> vol_begin + '+ calc +$1BE+$C[4] = = Ptn0 SectorSize --> ptn_size + '+ verify +$1FE[2] = $55AA = signature + '+-----------------------------------------------------------------------------+ ._validateMBR mov PTRB, sdx_bufad ' MBR hub addr add PTRB, #$1BE ' offset to PTN0 table rdbyte sdx_reply, PTRB ' ptn_state and sdx_reply, #$7F wz ' $00/80? inactive/active if_ne jmp #_fail_walk ' add PTRB, #$4 ' offset to ptn_type rdbyte sdx_reply, PTRB ' ptn_type cmp sdx_reply, #$0C wz ' $0C=FAT32(LBA) if_ne cmp sdx_reply, #$0B wz ' $0B=FAT32(CHS) '''' if_ne cmp sdx_reply, #$07 wz ' $07=exFAT/NTFS Do not allow!!! if_ne jmp #_fail_walk ' add PTRB, #($1FE-$1BE-$4) ' offset to $55AA signature rdword sdx_reply, PTRB ' read cmp sdx_reply, ##$AA_55 wz ' we read it reversed! if_ne jmp #_fail_walk ' mov PTRB, sdx_bufad ' MBR hub addr add PTRB, #$1BE ' offset to PTN0 table '+-----------------------------------------------------------------------------+ '+ Calculate the raw sector address (LBA) for the VOL sector (vol_begin)... + '+ vol_begin = LBA begin ptn0 $1BE+$08[4] (reversed & not long aligned!!!)+ '+-----------------------------------------------------------------------------+ add PTRB, #$08 ' offset to start sector LBA rdlong vol_begin, PTRB ' read '+-----------------------------------------------------------------------------+ '+ Calculate the partition size in sectors + '+ ptn_size = #sectors in ptn0 $1BE+$0C[4] (reversed & not long aligned!!!)+ '+-----------------------------------------------------------------------------+ add PTRB, #($0C-$08) ' offset to PTN0 size rdlong ptn_size, PTRB ' read '+-----------------------------------------------------------------------------+ '+-----------------------------------------------------------------------------+ '+ Read VOL (Sector x): + '+-----------------------------------------------------------------------------+ ._readVOL mov sdx_sector, vol_begin ' VOL SECTOR# call #_readFastSector ' read sector '+-----------------------------------------------------------------------------+ ' Validate VOL... + ' verify +$00B[2] = 512 = #Bytes/Sector + ' calc +$00D[1] = = #Sectors/Cluster 64? --> clustersh + ' calc +$00E[2] = #ResvSectors --> PTN0RESV + ' verify +$010[1] = 2 = #NoOfFATs PTN0NFATS + ' ??? +$020[4] = #Sectors/PTN --> =ptn_size? + ' calc +$024[4] = #Sectors/FAT --> PTN0SECFAT + ' calc +$030[2] = #FileSystemInfo --> fsi_begin + ' verify +$1FE[2] = $55AA = signature + ' + ' calc fat_begin = vol_begin + PTN0RESV + ' calc dir_begin = fat_begin + (PTN0SECFAT * 2) + '+-----------------------------------------------------------------------------+ ._validateVOL mov PTRB, sdx_bufad ' VOL hub locn add PTRB, #$0B '\ offset to bytes/sector rdword sdx_reply, PTRB '| read cmp sdx_reply, ##512 wz '| if_ne jmp #_fail_walk '/ add PTRB, #($0D-$0B) ' offset to #Sectors/Cluster rdbyte clustersh, PTRB '\ calc as shift left 'n' encod clustersh '/ add PTRB, #($0E-$0D) ' offset to #ResvSectors rdword fat_begin, PTRB '\ start of FAT table add fat_begin, vol_begin '/ add PTRB, #($10-$0E) '\ offset to #nooffats rdbyte sdx_reply, PTRB '| read cmp sdx_reply, #2 wz '| $02 PTN0NFATS if_ne jmp #_fail_walk '/ add PTRB, #($24-$10) ' offset to #Sectors/FAT rdlong dir_begin, PTRB '\ start of DATA (DIR table) shl dir_begin, #1 '| *2 add dir_begin, fat_begin '/ +base add PTRB, #($30-$24) ' offset to #FileSystemSector rdword fsi_begin, PTRB ' read add fsi_begin, vol_begin ' add vol_begin add PTRB, #($1FE-$30) ' offset to $55AA signature rdword sdx_reply, PTRB ' read cmp sdx_reply, ##$AA_55 wz ' we read it reversed! if_ne jmp #_fail_walk ' mov sdx_sector, dir_begin '+-----------------------------------------------------------------------------+ _RET_ MODCZ _clr,_set wcz ' NC & Z = success '+=============================================================================+ _fail_walk _RET_ MODCZ _set,_clr wcz ' C & NZ = failed '+=============================================================================+ '+-------[ SD: Search Root Directory for <_fname> entry ]----------------------+ <--- SD: search root directory ---> '+ On Entry: + '+ sdx_fname[3]: filename[11] 8+3 without "." + '+ Call Format: + '+ CALL #@_searchDIR ' + < call: search root directory > '+ On Return: + '+ "Z" if found, and sets + '+ sdx_sector = first native sector of file's data + '+ sdx_bytecnt = file size in bytes + '+ "NZ" if not found / error + '+-----------------------------------------------------------------------------+ _searchDIR and sdx_fname+2, ##$00FFFFFF ' 12th char must be $00 mov sdx_sector, dir_begin ' DIR SECTOR# decod sdx_ctr1, clustersh ' max sectors to scan (1 cluster) .search_next call #_readFastSector ' read sector '+-----------------------------------------------------------------------------+ '+ Walk Directory: (read DIR sectors) + '+ 16 x 32byte DIR(fname) entries per DIR sector + '+ +$00[1] = $00 = empty + '+ => $80 = deleted file + '+ search +$00[11] = 8.3 filename + '+ verify +$0B[1] = FileAttrib AND $D8,check $00 + '+ $01=read,02=hidden,04=system,08=volume,0F=longfile,10=dir,20=archive+ '+ calc +$14[2] = FAT32: 1st cluster# HI -\-> cluster + '+ calc +$1A[2] = FAT32: 1st cluster# LO -/ + '+ calc +$1C[4] = FAT32: FileSize in bytes --> file_size + '+ calc dat_begin = dir_begin + ((cluster-2)<<6) + '+-----------------------------------------------------------------------------+ ' scan dir sector for files... .walk_dir mov sdx_entries, #16 ' 16*32byte file entries mov PTRB, sdx_bufad ' dir hub locn ' scan this sector for filename entry... .scan rdlong sdx_reply, PTRB wz '\ check this entry, $0=empty if_ne jmp #.check '| n: _RET_ MODZ _clr wz '/ return "NZ" = not found .check cmp sdx_reply, sdx_fname wz '| check fname... add PTRB, #4 '| rdlong sdx_reply, PTRB '| if_e cmp sdx_reply, sdx_fname+1 wz '| add PTRB, #4 '| rdlong sdx_reply, PTRB '| and sdx_reply, ##$D8FFFFFF '| check atts b7+6+4+3 if_e cmp sdx_reply, sdx_fname+2 wz '| if_e jmp #.found '/ found! add PTRB, #(32-8) ' next entry djnz sdx_entries, #.scan ' "NZ" not found this sector '+-----------------------------------------------------------------------------+ add sdx_sector, #1 ' next sector# _RET_ djnz sdx_ctr1, #.search_next ' return "NZ" = not found '+-----------------------------------------------------------------------------+ '+ set: cluster = +$14[2] +$1A[2] + '+ filesize = +$1C[4] + '+ sector = ((cluster-2)<