\ ********************************************************************* 
\ SD CARD management for ARDUINO MEGA NANO UNO 
\    Filename:      sdcard.txt 
\    Date:          31/10/2020 
\    Updated:       31/10/2020 15:30 
\    File Version:  1.0 
\    MCU:           ARDUINO all models 
\    Copyright:     collective work 
\    Author:        collective work 
\    GNU General Public License 
\ ********************************************************************* 
 
-condComp \ the word ?\ is a conditionnal comment. 
marker -condComp 
 
: ?\  ( fl --- ) 
  0= 
  if 
    postpone \ 
  then 
; immediate 
 
\ set the card you are using to true 
false constant MEGAcard 
 true constant NANOcard 
false constant UNOcard 
 
 
 
-spi-base \ ***** SPI for ARDUINO / FlashForth ******* 
marker -spi-base 
 
\ Registers of interest 
$24 constant DDRB       \ Port B Data Direction Register 
$25 constant PORTB      \ Port B Data Register 
 
$4c constant SPCR       \ SPI Control Register 
$4d constant SPSR       \ SPI Status Register 
$4e constant SPDR       \ SPI Data Register 
 
\ bit masks for ARDUINO MEGA 
MEGAcard ?\ %00000001 constant mSS1   ( PB0 )   \ -> CS 
MEGAcard ?\ %00000010 constant mSCK   ( PB1 )   \ -> CLK 
MEGAcard ?\ %00000100 constant mMOSI  ( PB2 ) 
MEGAcard ?\ %00001000 constant mMISO  ( PB3 ) 
\ MEGAcard ?\ %00010000 constant mRST   ( PB4 ) 
 
\ bit masks for ARDUINO NANO --- à vérifier et tester 
NANOcard ?\ %00000100 constant mSS1   ( PB2 )   \ -> CS 
NANOcard ?\ %00010000 constant mSCK   ( PB5 )   \ -> CLK 
NANOcard ?\ %00000100 constant mMOSI  ( PB2 ) 
NANOcard ?\ %00001000 constant mMISO  ( PB4 ) 
\ NANOcard ?\ %00010000 constant mRST   ( PB4 ) 
 
\ bit masks for ARDUINO UNO  --- à vérifier et tester 
UNOcard  ?\ %00000100 constant mSS1   ( PB2 )   \ -> CS 
UNOcard  ?\ %00100000 constant mSCK   ( PB5 )   \ -> CLK 
UNOcard  ?\ %00001000 constant mMOSI  ( PB3 ) 
UNOcard  ?\ %00010000 constant mMISO  ( PB4 ) 
\ UNOcard  ?\ %00010000 constant mRST   ( PB4 ) 
 
 
 
 
$80 constant mSPIF      \ SPI Interrupt Flag 
$40 constant mWCOL      \ Write Collision Flag 
 
: slave.select ( mSSx -- )     \ select slave x in mSSx constant 
    dup DDRB  mset      \ SS as output 
        PORTB mclr      \ deselect 
  ; 
: slave.deselect ( mSSx -- )   \ unselect slave 
    dup DDRB  mset      \ SS as output 
        PORTB mset      \ deselect 
  ; 
 
%01000000 constant SPCR_SPE     \ SPI Enable 
: spi.enable ( ---) 
    SPCR_SPE SPCR mset ; 
: spi.disable ( ---) 
    SPCR_SPE SPCR mclr ; 
 
%00100000 constant SPCR_DORD \ Data Order 
: LSB.first ( --- )     \ select LOW Signifiant Bit first 
    SPCR_DORD SPCR mset ; 
: MSB.first ( --- )     \ select MOST Signifiant Bit first 
    SPCR_DORD SPCR mclr ; 
 
%00010000 constant SPCR_MSTR    \ Master/Slave Select 
: Master.mode 
    SPCR_MSTR SPCR mset ; 
: Slave.mode 
    SPCR_MSTR SPCR mclr ; 
 
\ SPI mode 
%00000100 constant SPCR_CPHA    \ Clock Phase 
%00001000 constant SPCR_CPOL    \ Clock Polarity 
: Mode0 
    SPCR_CPHA SPCR mclr   \ Idle CLK = 0 
    SPCR_CPOL SPCR mclr  \ Sample on leading edge 
  ; 
: Mode1 
    SPCR_CPHA SPCR mclr   \ Idle CLK = 0 
    SPCR_CPOL SPCR mset    \ Sample on trailing edge 
  ; 
: Mode2 
    SPCR_CPHA SPCR mset     \ Idle CLK = 1 
    SPCR_CPOL SPCR mclr    \ Sample on trailing edge 
  ; 
: Mode3 
    SPCR_CPHA SPCR mset     \ Idle CLK = 1 
    SPCR_CPOL SPCR mset    \ Sample on leading edge 
  ; 
 
\ SPI clock speed 
%00000010 constant SPCR_SPR1    \ SPI Clock Rate Selects 
%00000001 constant SPCR_SPR0    \ SPI Clock Rate Selects 
%00000001 constant SPSR_SPI2x   \ Double SPI Speed 
: spi2X.off ( --- ) 
    SPSR_SPI2x SPSR mclr 
  ; 
: spi2X.on  ( --- ) 
    SPSR_SPI2x SPSR mset 
  ; 
: fosc/4 
    SPCR_SPR1  SPCR mclr 
    SPCR_SPR0  SPCR mclr 
    spi2X.off 
  ; 
: fosc/16      
    SPCR_SPR1  SPCR mclr 
    SPCR_SPR0  SPCR mset 
    spi2X.off 
  ; 
: fosc/64      
    SPCR_SPR1  SPCR mset 
    SPCR_SPR0  SPCR mclr 
    spi2X.off 
  ; 
: fosc/128     
    SPCR_SPR1  SPCR mset 
    SPCR_SPR0  SPCR mset 
    spi2X.off 
  ; 
 
: spi.init ( -- )  
    mSCK  DDRB  mset            \ SCK as output 
    mSCK  PORTB mclr            \ clock idles low 
    mMOSI DDRB  mset            \ MOSI as output 
    mMISO DDRB  mclr            \ MISO as input 
    mMISO PORTB mset            \ activate pull-up on MISO 
    mSS1  DDRB  mset            \ SS as output 
    mSS1  PORTB mset            \ deselect 
        spi.enable 
        Master.mode 
        Mode0 
        fosc/64 
    SPSR c@ drop SPDR c@ drop   \ will clear SPIF 
; 
 
: spi.close ( -- ) 
    $00 SPCR c! 
  ; 
: spi.wait ( -- ) 
    begin  
        mSPIF SPSR mtst  
    until 
  ; 
: spi.cexch ( c1 -- c2 ) 
    SPDR c!  
    spi.wait  
    SPDR c@ 
  ; 
: spi.csend ( c1 -- ) 
    spi.cexch drop 
  ; 
 
 
\ : spi.test ( -- )  
\     mSS1 slave.select 
\     spi.init 
\     $1c spi.csend   \ an arbitrary byte 
\     mSS1 slave.deselect 
\     spi.close 
\   ; 
 
 
 
 
 
\ SPI MECRISPn **** Do not compile, here only for information **** 
\ @TODO: must adapted to flashForth 
$40013000 constant SPI1 
    SPI1 $0 + constant SPI1-CR1 
    SPI1 $4 + constant SPI1-CR2 
    SPI1 $8 + constant SPI1-SR 
    SPI1 $C + constant SPI1-DR 
 
 
: >spi> ( c -- c )  \ hardware SPI, 8 bits 
    SPI1-DR !   
    begin  
        SPI1-SR @ 1 and  
    until   
    SPI1-DR @ 
  ; 
 
: spi> ( -- c )  
    0 >spi> ;  \ read byte from SPI 
: >spi ( c -- )  
    >spi> drop ;  \ write byte to SPI 
 
\ SD Card interface using SPI w/ FAT access 
 
\ *** CODE FOR MECRIS¨P - MUST ADAPTED FOR ARDUINO *** 
 
 
: sd-slow ( -- ) \ clk/256 
    SPI1-CR1  SPI1-CR1 @  %111000 or  SPI1-CR1 !  
  ;   
 
: sd-wait ( -- )   
    begin  
        $FF >spi> $FF =  
    until  
  ; 
 
: sd-cmd ( cmd arg -- u ) 
    swap 
    -spi 2 us +spi 
              $FF >spi 
           $40 or >spi 
    dup 24 rshift >spi 
    dup 16 rshift >spi 
     dup 8 rshift >spi 
                  >spi 
              $95 >spi 
    begin  
        $FF >spi> dup $80 and  
    while  
        drop  
    repeat  
  ; 
 
: sd-init ( -- ) 
    spi-init  sd-slow  10 0 do $FF >spi loop 
    0 ticks ! 
    begin 
        0 0 sd-cmd  \ CMD0 go idle 
    $01 = until 
 
    begin 
        10 ms 
        55 0 sd-cmd drop sd-wait 
        41 0 sd-cmd 
    0= until 
 
    spi-init  \ revert to normal speed 
 
    \ 59 0 sd-cmd . sd-wait 
    \ 8 $1AA sd-cmd . sd-wait 
    \ 16 $200 sd-cmd . sd-wait 
  ; 
 
512 buffer: sd.buf 
\ ( sd.buf: ) sd.buf hex. 
 
: sd-copy ( f n -- ) 
  swap begin ( dup . ) $FE <> while $FF >spi> repeat 
  0 do  $FF >spi> sd.buf i + c!  loop 
  $FF dup >spi >spi ; 
 
\ 0 1 2 3 4 5 6 7 8 9 A B C D E F CRC 
\ 002E00325B5A83A9FFFFFF80168000916616  Kingston 2GB 
\ 007F00325B5A83D3F6DBFF81968000E7772B  SanDisk 2GB 
 
: sd-size ( -- n )  \ return card size in 512-byte blocks 
  9 0 sd-cmd  16 sd-copy 
\ http://www.avrfreaks.net/forum/how-determine-mmc-card-size 
\ https://members.sdcard.org/downloads/pls/simplified_specs/archive/part1_301.pdf 
\ TODO bytes 6 and 8 may be reversed... 
  sd.buf 6 + c@ $03 and 10 lshift 
  sd.buf 7 + c@ 2 lshift or 
  sd.buf 8 + c@ 6 rshift or ; 
 
: sd-read ( page -- )  \ read one 512-byte page from sdcard 
    9 lshift  17 swap sd-cmd  512 sd-copy 
  ; 
 
: sd-write ( page -- )  \ write one 512-byte page to sdcard 
    9 lshift  24 swap sd-cmd drop 
    $FF >spi $FE >spi 
    512 0 do  sd.buf i + c@ >spi  loop 
    $FF dup >spi >spi  sd-wait 
  ; 
 
\ FAT access 
 
0 variable sd.fat   \ block # of first FAT copy 
0 variable sd.spc   \ sectors per cluster (64) 
0 variable sd.root  \ block # of first root sector 
0 variable sd.#ent  \ number of root entries 
0 variable sd.data  \ block offset of cluster #2 
 
: sd-mount ( -- )  \ mount a FAT16 volume, extract the key disk info 
                sd-init    \ initialise interface and card 
              0 sd-read    \ read block #0 
  sd.buf $1C6 + @          \ get location of boot sector 
         dup 1+ sd.fat !   \ start sector of FAT area 
            dup sd-read    \ read boot record 
   sd.buf $0D + c@         \ sectors per cluster 
                sd.spc !   \ depends on formatted disk size 
   sd.buf $0E + h@         \ reserved sectors 
   sd.buf $10 + c@         \ number of FAT copies 
   sd.buf $16 + h@         \ sectors per fat 
      * + + dup sd.root !  \ start sector of root directory 
   sd.buf $11 + h@         \ max root entries 
            dup sd.#ent !  \ save for later 
     4 rshift + sd.data !  \ start sector of data area 
; 
 
: sd-mount. ( -- )  \ mount and show some basic card info 
  sd-mount 
  cr ." label: " sd.buf $2B + 11 type space 
     ." format: " sd.buf $36 + 8 type space 
     ." capacity: " sd.buf $20 + @ . 
; 
 
: dirent ( a -- a )  \ display one directory entry 
  dup c@ $80 and 0= over 2+ c@ and if 
    cr dup 11 type space 
    dup 11 + c@ h.2 space 
    dup 26 + h@ . 
    dup 28 + @ . 
  then ; 
 
: ls  ( -- ) \ display files in root dir (skipping all LFNs and deleted files) 
  sd.buf 512 + 
  sd.#ent @ 0 do 
    i $F and 0= if 
      sd.root @ i 4 rshift + sd-read 
      512 - 
    then 
    dirent 
    32 + 
  loop drop ; 
 
: fat-find ( addr -- u )  \ find entry by name, return data cluster, else $FFFF 
  sd.buf 512 + 
  sd.#ent @ 0 do 
    i $F and 0= if 
      sd.root @ i 4 rshift + sd-read 
      512 - 
    then 
    2dup 11 tuck compare 
    if nip 26 + h@ unloop exit then 
    32 + 
  loop 2drop $FFFF ; 
 
: fat-next ( u -- u )  \ return next FAT cluster, or $FFFx at end 
  \ TODO hard-coded for 64 sec / 32 KB per cluster 
  dup 8 rshift sd.fat @ + sd-read 
  $FF and 2* sd.buf + h@ ; 
 
: chain. ( u -- )  \ display the chain of clusters 
  begin 
    dup . 
  dup $F or $FFFF <> while 
    fat-next 
  repeat drop ; 
 
\ 128 clusters is 8 MB when the cluster size is 64 
4 constant NFILES 
129 2* NFILES * buffer: fat.maps  \ room for file maps of max 128 clusters 
 
: file ( n -- a )  \ convert file 0..3 to a map address inside fat.maps 
  129 2* * fat.maps + ; 
 
: fat-chain ( u n -- )  \ store clusters for use as file map n 
  file 
  begin 
    2dup ! 2+ 
  over $F or $FFFF <> while 
    swap fat-next swap 
  repeat 2drop ; 
 
: fat-map ( n1 n2 -- n )  \ map block n1 to raw block number, using file n2 map 
  file over sd.spc @ / 2* + h@ 
  2- sd.spc @ * swap sd.spc @ 1- and + 
  sd.data @ + ;