SOURCE
h

/*
;**************************************************************
;
;      SD MEMORY CARD SOFTWARE SPI DRIVER 
;
;**************************************************************
*/


: SDCARD.IVOS
	." SD CARD DRIVERS USING LPC2138 SSP - (C) 2005 P.JAKACKI"
	;


4000.4000h VP !


512d CONSTANT BLKSIZ

BLKSIZ bytes XBUF			\ main SD sector buffer


variable sdsize

variable ocr

64d bytes cid
64d bytes csd

16d bytes extbuf



/* ***************** SD FLASH CARD *****************

LPC2138 @ 22.1184MHz x3 -> >600KB/sec read rate
Uses SSP hardware

Commands are sent as 6 bytes
01CMD ARGX4 CRC1
*/



: SdBusyLed ( on/off -- )	30d MASK SWAP 0= IF IOSET ELSE IOCLR THEN ! ;

: SDCS	DUP SDCS SdBusyLed ;

: SDPWR	( on/off -- )
	IF
	  FCh PINSEL1 CLR A8h PINSEL1 SET
	  ON SDON
	  1 MS
	  !SSP 
	  ON SDCS
	  10d SDCLK
	  OFF SDCS
	  FF SD! FF SD!
	  ON SDCS
	  2 SDCLK
	  0107h SSPCR0 !
	  OFF SDCS
	  ELSE
	  OFF SDON
	  ON SDCS	( kill power )
	  FCh PINSEL1 CLR
	  E0000h IOCLR !
	  THEN
	;


: RES@
	2000h 0
	  DO SD@ DUP FFh <>
	    IF LEAVE THEN
	  DROP
	  LOOP
	FFh
	;


: SCMD	( data cmd -- res )
	ON SDCS
	SD@ DROP
	3Fh AND 40h OR SD!
	DUP 18h SHR SD! DUP 10h SHR SD! DUP 8 SHR SD! SD! 95h SD!
	RES@
	;
: ACMD ( data acmd -- res ) 0 55d SCMD DROP SCMD ;


: STAT@ ( -- stat )	0 13d SCMD RES@ 8 SHL OR ;

: SD2@	( -- 16b )	SD@ 8 SHL SD@ OR ;
: SD4@	( -- 32b )	SD2@ 16d SHL SD2@ OR ;




] $" ( adr -- ) Wait for read token and read SD data into buffer" [

: SDDAT ( adr -- )	BEGIN SD@ FEh = UNTIL 10h BOUNDS DO SD@ I C! LOOP 3 SDCLK ;

: GETCSD		0 9 SCMD 0= IF csd SDDAT THEN ;
: GETCID		0 10d SCMD 0= IF cid SDDAT THEN ;

: XSHR1
	0 extbuf 10h BOUNDS
	  DO I C@ DUP 2/ ROT OR I C!
	    1 AND IF 80h ELSE 0 THEN
	  LOOP
	 DROP
	;
	
: XSHR		?DUP IF 0 DO XSHR1 LOOP THEN ;

: BEXT	( bith bitl adr -- )
	extbuf 10 CMOVE DUP XSHR - 1+ MASK
	1-
	0 extbuf 0C + 4 BOUNDS DO 8 SHL I C@ OR LOOP
	AND
	;
	
: CSD@	( bith bitl -- n ) csd BEXT ;
: CID@	( bith bitl -- n ) cid BEXT ;




: ?TIMEOUT	0 TIMER @ 0= IF R> DROP 0 EXIT THEN ;

] $" ( -- ocr ) Initialise the SD card in SPI mode and return with the OCR" [

: InitSdCard	( -- ocr | false )
	30d IODIR @IO1 XCLR
	OFF SDPWR 5 MS ON SDPWR 5 MS 200d 0 TIMER !
	  BEGIN ?TIMEOUT 0 0 SCMD 1 = UNTIL
	  BEGIN ?TIMEOUT 0 41d ACMD 0= UNTIL
	  BEGIN 0 58d SCMD 0= UNTIL SD4@ DUP ocr !
	GETCID GETCSD
	OFF SDCS
	;

: !SD	InitSdCard ;

] $" ( -- flg ) Is SD card present?" [

: CardInserted?	( -- flg )
	30d MASK IODIR @IO1 CLR		\ Card Detect input
	IOPIN @IO1 @ 30d MASK AND 0=
	;


: SDRDBLK ( -- crc )
	BLKSIZ (SDRD)
	SD2@				\ read crc
	8000000h OR			\ force crc as TRUE flag
	;

0FEh CONSTANT DATATKN			\ data token for single block read/write
0FCh CONSTANT DATATKN1			\ data token for 1st block read/write
0FDh CONSTANT DATATKNE			\ data token for last block read/write

// data error token is 0000,b3=out of range,b2=card ecc failed,b1=CC error,b0=error



: READ_TOKEN	( xadr token -- flg )
	DATATKN CASE SDRDBLK ENDCASE
	2DROP				\ drop token and xadr
	2 SDCLK STAT@ DROP
	OFF SDCS
	FALSE
	;


// SD CARD READ BLOCK
// 20ms read time

] $" ( xadr dst -- crc | false ) Read xadr from SD into dst" [

: SDRD	( xadr dst -- crc | false )
	SWAP
	17d SCMD		\ read block command
	0= IF
	  RES@ READ_TOKEN	\ process read token
	  ELSE DROP FALSE
	  THEN
	 OFF SDCS
	  ;
	

: SIZE?	( -- bytes )			\ Brute force memory capacity check (works!)
	InitSdCard DROP
	4000.0000h 0	( high low ) \  allow up to 1G
	  BEGIN
	  2DUP - 2/ OVER +
	  DUP XBUF SDRD
	    IF \ mid is ok - set low to mid
	    NIP
	    ELSE \ mid is too high - set high to mid
	    STAT@ DROP
	    ROT DROP SWAP
	    THEN
	  2DUP - BLKSIZ 1+ <
	  UNTIL
	DROP DUP sdsize !
	;



] $" ( src xdst -- flg ) Write from src to xdst in the SD" [

: SDWR	( src xdst - flg )
	OFF SDCS FF SD! ON SDCS 3 SDCLK
	24d SCMD
	0=
	  IF 3 SDCLK DATATKN SD!
	    BLKSIZ (SDWR) 	\ BOUNDS DO I C@ SD! LOOP
	  BEGIN SD@ 0= UNTIL
	  BEGIN SD@ FFh = UNTIL
	  TRUE
	  ELSE FALSE
	  THEN
	 OFF SDCS
	;



CREATE tval	d DB	00,10,12,13,15,20,25,30,35,40,45,50,55,60,70,80
	
: .CARD
	InitSdCard
	  IF
	  CR ." BYTES:  " SIZE? .DEC
	  HEX
	  \     0123456789ABCDEF012345
	  CR ." MFG:    " cid C@ .BYTE
	  CR ." OEM:    " cid 1+ 2 TYPE
	  CR ." PROD:   " cid 3 + 5 TYPE
	  CR ." REV:    " cid 8 + C@ .BYTE
	  CR ." S/N:    " cid 9 + NA@ 8 U.N
	  CR ." DATE:   " cid 0D + C@ 8 SHL cid 0E + C@ OR
	  DUP 4 SHR 2000h + .WORD
	  ." /" 0F AND 1 U.N
	  CR ." CRC:    " cid 0F + C@ 2/ .BYTE
	  CR
	  CR ." TACC    " 119d 112d CSD@
	  DUP 3 SHR tval + C@ 10d /MOD DECIMAL 0 U.R ." ." 0 U.R
	  ." x10E" 3 AND 0 U.R ." ns"
	  CR ." NSAC    " 111d 104d CSD@ .

	  \ still more to do
	  THEN
	;







] $" ( src xdst cnt -- ) Save cnt bytes from src to xdst in the SD" [

: XSAVE	( src xdst cnt -- )
	0 DO
	  SWAP	( xdst src )
	  XBUF BLKSIZ BOUNDS DO DUP C@ I C! 1+ LOOP
	  SWAP ( src+ xdst )
	  XBUF OVER SDWR					\ write a block
	  DROP
	  BLKSIZ +
	  BLKSIZ 
	  +LOOP
	 2DROP
	;

] $" ( xsrc dst cnt -- ) Load cnt bytes from xsrc in SD to dst" [

: XLOAD	( xsrc dst cnt -- )
	0 DO 2DUP SDRD DROP SWAP BLKSIZ + SWAP BLKSIZ + BLKSIZ +LOOP
	2DROP
	;



\ *******************************************************************




: FAT16.IVOS
	." FAT16 + VIRTUAL MEMORY FOR SD CARD - (C) 2005 AR1784"
	;

\ 

\ sector 0 - partition info
00 bytes part1

01 bytes @state
01 bytes @head
02 bytes @cylsec
01 bytes @partype
01 bytes @ehead
02 bytes @ecylsec
04 bytes @offset	\ offset to first sector from mbr
04 bytes @size		\ number of sectors in partition


variable pstart
variable fatsz
variable sectorsz
variable clustersz


08 bytes filename
04 bytes fext

variable handle		\ files starting cluster (also used as a handle)
variable dirptr
variable fileptr	\ point to virtual memory address of file
variable fend		\ end of file
variable fsize		\ file size


: sector	1F4h @USER ;
: sectorflg	1F8h @USER ;

: @PART		pstart @ ;
: FATSZ		fatsz @ 9 SHL ;
: @FAT		@PART BLKSIZ + ;
: @FAT2		FATSZ @FAT + ;
: @DIR		FATSZ 2* @FAT + ;
: @DATA		@DIR $4000 + ;


: FAT@		2* @FAT + @ ;

: .CLUSTERS	BEGIN DUP 4 U.N ." ," FAT@ DUP h FFF0 SWAP U< UNTIL DROP ;


: READ?		1 sectorflg TEST ;

: FlushSector?	2 sectorflg TEST ;

: WriteSector	( addr -- )	XBUF SWAP SDWR DROP ;

: FlushSector	sector @ WriteSector 2 sectorflg CLR ;

: UpdateSector	2 sectorflg SET ;

: ?FlushSector	FlushSector? IF FlushSector THEN ;


] $" ( xadr -- ) Read a sector from the SD to the block buffer" [

: BufferSector		( xadr -- )
	DUP sector @ DUP 1FFh + WITHIN 0=	\ check if current block is valid
	READ? 0= OR				\ or if there is no current block
	  IF
	  ?FlushSector				\ Flush buffer if necessary
	  1FFh NOT AND DUP sector !		\ mask and remember block address
	  0 sectorflg !
	  XBUF SDRD				\ read sector into XBUF
	    IF 1 sectorflg SET THEN		\ mark as valid read
	  ELSE DROP
	  THEN
	;


// *************** VIRTUAL MEMORY INTERFACE *************

: @BLK	( xadr -- badr )	1FFh AND XBUF + ;

: XADR  ( xadr -- adr )		DUP BufferSector @BLK ;

: XC@	( addr -- byte )	XADR C@ ;

: XC!	( byte addr -- )	XADR C! UpdateSector ;

: XH@	( addr -- 16bit )	XADR H@ ;

: XH!	( 16bit addr -- )	XADR H! UpdateSector ;

: X@	( addr -- byte )	XADR NA@ ;

: X!	( byte addr -- )	XADR NA! UpdateSector ;




] $" ( xadr -- len ) Return with length of string in SD" [

: XLEN	( xadr -- len )
	0
	  BEGIN
	  ( adr cnt )
	  OVER XADR LEN DUP ( adr cnt len len )
	  ROT + ( adr len cnt+len ) SWAP
	  BLKSIZ =
	  WHILE
	  SWAP BLKSIZ + SWAP
	  REPEAT
	NIP
	;


] $" ( xsrc xdst cnt -- ) Move from SD memory to SD memory" [

: XMOVE	( xsrc xdst cnt -- )
	SWAP >R				\ save dst
	0
	  DO ( src ) DUP BufferSector	\ read source sector
	  R@ I + sector ! FlushSector	\ and write as is to destination
	  BLKSIZ + 			\ point to next src sector
	  BLKSIZ			\ adjust count also
	  +LOOP
	R> DROP
	DROP
	;



: XDUMP
	HEX 0F + 4 SHR 0
	  DO
	  CR 10h 2DUP
	  OVER 10h SHR 4 U.N
	  '.' EMIT OVER FFFFh AND 4 U.N ." : " 0
	    DO DUP XC@ SPACE 2 U.N 1+ LOOP
	  ROT ROT 2 SPACES OVER + SWAP
	    DO I XC@ 7Fh AND DUP BL <
	      IF DROP '.' THEN
	    EMIT
	    LOOP
	  ESC? IF LEAVE THEN
	  LOOP
	DROP
	; 



\ ********************* FAT16 ********************

: .SDFAIL	."  Failed to mount SD Card" ;

] $" Mount the SD card as FAT16" [

: MOUNT
	h -200 sector !
	0 sectorflg !
	CardInserted?
	  IF
	  InitSdCard
	    IF
	    SIZE? DROP
	    01BEh XADR part1 10h CMOVE
	    @offset @ 9 SHL pstart !
	    @PART 0B + XH@ sectorsz !
	    @PART 0D + XC@ clustersz C!
	    @PART 16h + XH@	\ sectors per FAT
	    fatsz !		\ size of FAT
	    ELSE
	    .SDFAIL ."  - Card does not respond"
	    THEN
	  ELSE .SDFAIL ."  - No card inserted!!!"
	  THEN
	;



: .VOL		CR ." VOL: " @PART 2Bh + XADR 0B TYPE ;

] $" ( <name> -- ) Enter a new volume name" [

: VOL:
	0 PARSE 0Bh MIN @PART 2Bh + XADR DUP 0Bh 20h FILL SWAP CMOVE
	FlushSector
	;


] $" Print out the fragmentation map" [

: .FRAG
	@FAT fatsz @ 9 SHL BOUNDS
	  DO I 7F AND 0= IF CR THEN I XH@
	    IF B2 EMIT ELSE B0 EMIT THEN
	  2 +LOOP
	;

: .FAT
\	MOUNT
	CR ." OEM: " @PART 3 + XADR 8 TYPE
	.VOL
	@PART 0B + XH@ DECIMAL CR . ."  Bytes/Sector"
	@PART 0D + XC@ CR . ."  Sectors/Cluster"
	@PART 0E + XH@ CR . ."  Reserved Sectors"
	;



/* **************** DIRECTORY ****************
DIR STRUCTURE
NAME:	8
EXT:	3
ATR:	1	= X X ARCH DIR , VOLUME SYSTEM HIDDEN READONLY
	10
TIME:	2	= HOUR(5),MIN(6),SEC2(5)
DATE:	2	= YEAR(7),MONTH(4),DAY(5)
CLUS:	2	1A
FSIZ:	4

*/

: @ATR		11d + ;
: @FSIZE	28d + ;
: @FDATE	24d + ;
: @FTIME	22d + ;
: @FCLST	26d + ;


: NAME:
	BL PARSE ?DUP
	  IF
	  @PART 2Bh + XADR 11d 20h FILL
	  @PART 2Bh + XADR SWAP CMOVE UpdateSector
	  THEN
	 ;

: IndexClusterEntry	( clust# -- fataddr )	2* @FAT + ;

: AddressOfCluster	( clust# -- addr )	1- 14d SHL @DIR + ;

: NextFreeCluster	( -- cluster# )
	@FAT
	  BEGIN DUP XH@ WHILE 2 + REPEAT
	@FAT - 2/
	;

: AddCluster	( -- cluster# )	\ find next free cluster and assign
	NextFreeCluster FFFFh OVER IndexClusterEntry XH!
	;
	
: NextFreeDirEntry	( -- addr )
	@DIR clustersz @ sectorsz @ * BOUNDS
	  DO I XC@ 0= I XC@ 80h AND 0<> OR
	    IF L> L> DROP EXIT THEN
	  20h
	  +LOOP
	@DIR
	;


] $" ( <name> -- ) Create a new file - allocate 1 cluster" [

: CreateFile	( "name" -- )
	AddCluster DUP handle !
	DUP AddressOfCluster fileptr !	\ point to start of file
	0 fsize !			\ initial size of 0
	NextFreeDirEntry DUP dirptr !	\ find a free dir entry
	XADR				\ translate to real memory
	( name clust xadr )
	SWAP OVER @FCLST H!		\ starting cluster
	SWAP OVER 0B CMOVE		\ write name to directory
	20h OVER @ATR C!		\ ATR
	0 OVER @FSIZE !			\ init file size
	FDATE@ OVER @FDATE H!
	FTIME@ OVER @FTIME H!
	DROP
	FlushSector			\ force update
	;


: FILENAME!	( str -- )
	filename 0B CMOVE
	0 filename 0B + C!
	;
	
: FILENAME:
	filename 0Bh 20h FILL
	'.' PARSE
	filename SWAP 8 MIN CMOVE
	BL PARSE fext SWAP 3 MIN CMOVE
	;

] $" ( str1 str2 len -- flg ) Compare strings" [

: COMPARE$
	-1 SWAP 0 DO 2 PICK I + C@ 2 PICK I + C@ = AND LOOP NIP NIP
	;


// find the file which matches the file name

: FindFile	( -- dir.addr )
	@DIR
	  BEGIN
	  DUP XC@
	  WHILE
	  DUP XADR filename 11d COMPARE$ ?EXIT
	  20h +
	  REPEAT
	DROP 0
	;

: DEL	( -- ) 				// delete the file indicated in filename
	FindFile ?DUP
	  IF E5h OVER XC! @FCLST XH@
	    BEGIN
	    IndexClusterEntry DUP XH@	// read cluster word
	    SWAP 0 SWAP XH!		// delete this cluster
	    DUP FFEFh >			// last cluster?
	    UNTIL
	  DROP
	  FlushSector
	  THEN
	;

: DEL:		FILENAME: DEL ;


] $" Create a file by the name supplied in the input stream" [

: FILE:		FILENAME: filename CreateFile ;


: CLUSTERS? ( startcluster -- clusters )
	0 SWAP BEGIN SWAP 1+ SWAP IndexClusterEntry XH@ DUP FFEFh > UNTIL DROP
	;

: EndCluster	( startcluster -- lastcluster )
	BEGIN DUP IndexClusterEntry XH@ DUP FFF0h < WHILE NIP REPEAT DROP
	;

: AddClusters	( startcluster cnt -- )
	0
	  DO DUP EndCluster AddCluster
	  0 DROP				 \ bug here somewhere???
	  SWAP IndexClusterEntry XH!
	  LOOP
	DROP
	;

: CLOSE		?FlushSector handle 20d ERASE ;


\
\ open the file pointed to by "dirptr"
\
: OPENd		
	dirptr @ DUP @FCLST XH@ DUP handle !	\ find the starting cluster and set as a handle
	AddressOfCluster DUP fileptr !			\ file pointer
	SWAP @FSIZE X@ DUP fsize !		\ file size
	+ fend !				\ and file end
	;

\
\ Open the file whose starting cluster matches the handle
\
: OPENh	( handle -- )
	>L @DIR
	  BEGIN
	  DUP XC@ 0= IF CLOSE EXIT THEN		\ couldn't find it so give up (!!!limit?)
	  DUP @FCLST XH@ I <>			\ compare handle
	  WHILE
	  20h +					\ no match, continue to next entry (!!!valid?)
	  REPEAT
	dirptr !				\ save directory pointer
	L> DROP					\ drop handle
	OPENd					\ open file
	;



: OPEN	( -- )
	FindFile ?DUP
	  IF
	  dirptr !
	  ELSE
	  filename CreateFile
	  THEN
	OPENd
	;

: ?OPEN	( -- )
	FindFile ?DUP
	  IF
	  dirptr ! OPENd
	  ELSE
	  0 dirptr ! 0 fileptr !
	  THEN
	;

: OPEN:		FILENAME: ?OPEN ;


: REN:
		OPEN:
		dirptr @ ?DUP
		IF	XADR 11d 20h FILL
			'.' PARSE 8 MIN dirptr @ XADR SWAP CMOVE
			BL PARSE 3 MIN dirptr @ 8 + XADR SWAP CMOVE
			FlushSector
		THEN
		;


: .FATR
	$" rhsvda67" SWAP 8 0 DO DUP 7 I - MASK AND
	  IF OVER 7 I - + C@ EMIT ELSE ." ." THEN LOOP 2DROP
	;

: .FDATE	DECIMAL DUP 1Fh AND 2 U.N ." /" 5 SHR DUP 0Fh AND 2 U.N ." /" 4 SHR 1980d + 4 U.N ;
: .FTIME	DECIMAL DUP 11d SHR 2 U.N ." :" DUP 5 SHR 3Fh AND 2 U.N ." :" 1Fh AND 2* 2 U.N ;



: .INFO	( diraddr -- )
	SPACE
	DUP @ATR XC@ .FATR SPACE
	DUP @FSIZE X@ .DEC
	SPACE DUP @FDATE XH@ .FDATE SPACE DUP @FTIME XH@ .FTIME
	SPACE
	DROP
	;

: .FNAME
	DUP XADR 8 TYPE ." ."			// type 8.3 name
	8 + XADR 3 TYPE
	;

variable diropt

: .DIR	( diraddr -- )
	DUP 0B + XC@ 10h =				// read atr - dir ?
	IF '<' EMIT DUP XADR 8 TYPE '>' EMIT	// indicate directory
	ELSE
	.FNAME
	THEN
	;

: .DIRS
	  @DIR					// start from root directory
	    BEGIN
	    DUP XC@ 0<>				// check if active entry
	    ESC? NOT AND			// while not escape
	    WHILE
	    DUP 0B + XC@ h 0F <>		// read atr - valid entry?
	    OVER XC@ 80h AND 0= AND		// active?
	    IF					// ( diradr )
	    	diropt 1+ C@ 'W =		// wide list?
	    	IF
		  diropt 2 + C@ 4 MOD 0= IF CR THEN
		  DUP .DIR TAB 1 diropt 2 + C+!
	      	ELSE				// normal list
	      	  DUP CR .DIR
	     	  DUP 0B + XC@ 10h <>
	          IF DUP .INFO THEN
	      	THEN
	    THEN
	    20h +
	    REPEAT
	   DROP
	;
		
: DIR
	0 PARSE DROP NA@ diropt !
	.VOL .DIRS
	;


F800h CONSTANT FORMAT16.HEX
FORMAT16.HEX 200h + CONSTANT FAT16

C200h CONSTANT @BOOT
0 CONSTANT @MBR



: FORMAT_BOOT ( -- flg )
	FORMAT16.HEX @MBR SDWR
	FAT16 @BOOT SDWR					\ boot sector here???
	AND
	;
	
: FORMAT_FAT
	    @FAT fatsz @ 9 SHL 2* BOUNDS DO 0 I X! 4 +LOOP
	    FFFFFFF8h @FAT X!
 	    FFFFFFF8h @FAT2 X!
	;
	
: FORMAT_DIRS
	@DIR 4000h BOUNDS DO 0 I X! 4 +LOOP
	;


] $" ( -- ) Format the SD card as FAT16" [

: FORMAT
	InitSdCard
	  IF
	  FORMAT_BOOT
	    IF
	    MOUNT
	    FORMAT_FAT
 	    FORMAT_DIRS
 	    TRUE
 	    ELSE FALSE
	    THEN
	  ELSE FALSE
	  THEN
	  CR IF ." Format complete" ELSE ." Format Failed" THEN
	;



: TYPE:
	OPEN: fsize @ ?DUP fileptr @ X@ 0<> AND
 	  IF CR fileptr @ 1+ SWAP BOUNDS
 	    DO I XC@ ?DUP IF EMIT ELSE LEAVE THEN LOOP
 	  THEN
 	;





FINIS