476 lines
9.4 KiB
Forth
476 lines
9.4 KiB
Forth
\ SD-SPI Variables initialize by the boot code
|
|
: spi_var create , does> @ spi_vars + ;
|
|
\ 0 spi_var spi_engine_cog
|
|
\ 4 spi_var spi_command
|
|
\ 8 spi_var spi_block_index
|
|
\ 12 spi_var spi_buffer_address
|
|
16 spi_var spi_rootdir
|
|
20 spi_var spi_filesystem
|
|
24 spi_var spi_clustershift
|
|
28 spi_var spi_dataregion
|
|
32 spi_var spi_fat1
|
|
36 spi_var spi_sectorsperfat
|
|
40 spi_var spi_currdir
|
|
|
|
hex
|
|
7fd0 constant spi_engine_cog
|
|
7fd4 constant spi_command
|
|
7fd8 constant spi_block_index
|
|
7fdc constant spi_buffer_address
|
|
decimal
|
|
|
|
\ Read a single 512-byte sector
|
|
: spi_readblock ( block_index buffer_address -- retval )
|
|
spi_engine_cog @ 0= if 2drop -999 exit then \ ERR_SPI_ENGINE_NOT_RUNNING
|
|
dup 3 and if 2drop -4 exit then \ ERR_BLOCK_NOT_LONG_ALIGNED
|
|
spi_buffer_address !
|
|
spi_block_index !
|
|
[char] r spi_command !
|
|
begin spi_command @ [char] r <> until \ Wait for command to complete
|
|
spi_command @
|
|
;
|
|
|
|
\ Write a single 512-byte sector
|
|
: spi_writeblock ( block_index buffer_address -- retval )
|
|
spi_engine_cog @ 0= if 2drop -999 exit then \ ERR_SPI_ENGINE_NOT_RUNNING
|
|
dup 3 and if 2drop -4 exit then \ ERR_BLOCK_NOT_LONG_ALIGNED
|
|
spi_buffer_address !
|
|
spi_block_index !
|
|
[char] w spi_command !
|
|
begin spi_command @ [char] w <> until \ Wait for command to complete
|
|
spi_command @
|
|
;
|
|
|
|
\ Allocate space for file structures
|
|
create file_info_1 9 cells allot 512 allot
|
|
create file_info_2 9 cells allot 512 allot
|
|
|
|
\ Define file structure
|
|
0 value file_info
|
|
: file_var create , does> @ file_info + ;
|
|
0 file_var file_sector0
|
|
4 file_var file_length
|
|
8 file_var file_position
|
|
12 file_var file_sector
|
|
16 file_var file_remaining
|
|
20 file_var file_dsector
|
|
24 file_var file_doffset
|
|
28 file_var file_dirty
|
|
32 file_var file_opened
|
|
36 file_var spi_buf
|
|
|
|
\ Clear the file_opened flags
|
|
file_info_1 to file_info 0 file_opened !
|
|
file_info_2 to file_info 0 file_opened !
|
|
|
|
\ Convert a character to upper case
|
|
: toupper dup [char] a >=
|
|
if
|
|
dup [char] z <=
|
|
if
|
|
32 -
|
|
then
|
|
then
|
|
;
|
|
|
|
create fatname 12 allot
|
|
|
|
\ Convert an 8.3 file name to FAT format
|
|
: convertfname ( addr num -- )
|
|
fatname 11 bl fill
|
|
8 0 do
|
|
dup 1 <
|
|
if 2drop r> r> 2drop exit then
|
|
over 1+ rot c@ dup [char] . =
|
|
if drop swap 1- leave
|
|
else
|
|
toupper i fatname + c!
|
|
swap 1-
|
|
then
|
|
loop
|
|
over c@ [char] . =
|
|
if 1- swap 1+ swap then
|
|
11 8 do
|
|
dup 1 <
|
|
if 2drop r> r> 2drop exit then
|
|
over 1+ rot c@
|
|
toupper i fatname + c!
|
|
swap 1-
|
|
loop
|
|
2drop
|
|
;
|
|
|
|
\ Compare two strings and return 0 if they match
|
|
: compare ( str1 len1 str2 len2 ... n )
|
|
rot over <> if 2drop drop 1 exit then
|
|
0 ?do
|
|
2dup c@ swap c@ <>
|
|
if 2drop r> r> 2drop 1 exit then
|
|
1+ swap 1+
|
|
loop
|
|
2drop 0
|
|
;
|
|
|
|
: initialize_file ( length sector0 dsector doffset -- fileid ior )
|
|
file_doffset !
|
|
file_dsector !
|
|
dup file_sector0 !
|
|
file_sector !
|
|
dup file_length !
|
|
dup 512 min file_remaining !
|
|
if
|
|
file_sector0 @ spi_buf spi_readblock drop
|
|
then
|
|
0 file_position !
|
|
0 file_dirty !
|
|
1 file_opened !
|
|
1 0
|
|
;
|
|
|
|
\ Get an available file structure
|
|
: get-file-struct
|
|
file_info_1 to file_info file_opened @
|
|
0= if 123 exit then
|
|
file_info_2 to file_info file_opened @
|
|
0= if 124 exit then
|
|
0
|
|
." No file structs available" cr
|
|
;
|
|
|
|
\ Attempt to open a file and return 0 on success
|
|
: open-file ( addr len fam -- fileid ior )
|
|
drop
|
|
get-file-struct
|
|
dup
|
|
0= if
|
|
drop 2drop
|
|
1 1 exit
|
|
then
|
|
-rot
|
|
convertfname
|
|
spi_currdir @
|
|
begin
|
|
dup spi_buf spi_readblock drop
|
|
512 0 do
|
|
i spi_buf + dup c@
|
|
if
|
|
dup 11 fatname 11 compare 0=
|
|
if
|
|
spi_filesystem @ 2 =
|
|
if dup 20 + w@ 16 lshift else 0 then
|
|
over 26 + w@ + spi_clustershift @ lshift spi_dataregion @ +
|
|
swap 28 + @ swap
|
|
rot r> r> drop
|
|
initialize_file
|
|
swap drop
|
|
exit
|
|
then
|
|
drop
|
|
else
|
|
r> r> 2drop 2drop 1 exit
|
|
then
|
|
32 +loop
|
|
1+
|
|
again
|
|
;
|
|
|
|
\ Set the file structure pointer
|
|
: set-file-struct ( fileid )
|
|
dup 123 = if drop file_info_1 to file_info exit then
|
|
dup 124 = if drop file_info_2 to file_info exit then
|
|
." Bad fileid " . cr
|
|
;
|
|
|
|
\ Read one byte from the file. Return -1 on EOF
|
|
: file-getc
|
|
file_position @ file_length @ >= if -1 exit then
|
|
file_remaining @ 1 <
|
|
if
|
|
file_sector @ 1+ file_sector !
|
|
file_sector @ spi_buf spi_readblock drop
|
|
file_length @ file_position @ - 512 min file_remaining !
|
|
then
|
|
file_position @ 511 and spi_buf + c@
|
|
file_position @ 1+ file_position !
|
|
file_remaining @ 1- file_remaining !
|
|
;
|
|
|
|
: read-file ( addr size fileid -- len flag ior )
|
|
set-file-struct
|
|
over swap 0 ?do
|
|
file-getc dup -1 =
|
|
if
|
|
drop swap - dup
|
|
if -1 else 0 then
|
|
unloop exit
|
|
else
|
|
over c! 1+
|
|
then
|
|
loop
|
|
swap - 0
|
|
;
|
|
|
|
\ Read one line from the file. Return number of bytes read or -1 on EOF
|
|
: read-line ( addr size fileid -- len flag ior )
|
|
set-file-struct
|
|
>r dup
|
|
begin
|
|
r@ 1 < if r> drop swap - -1 0 exit then
|
|
file-getc dup -1 =
|
|
if
|
|
r> 2drop swap - dup
|
|
if -1 0 exit then
|
|
0 0 exit
|
|
else
|
|
dup 10 = if
|
|
r> 2drop
|
|
2dup - if
|
|
dup 1- c@ 13 = if 1- then
|
|
then
|
|
swap - -1 0 exit
|
|
then
|
|
|
|
over c! 1+
|
|
r> 1- >r
|
|
then
|
|
again
|
|
;
|
|
|
|
\ Include file
|
|
: included 0 open-file
|
|
if
|
|
drop ." Could not open file" cr
|
|
else
|
|
#tib @ >in !
|
|
_savesrc
|
|
to source-id
|
|
refill
|
|
\ 0 #tib ! 0 >in !
|
|
then
|
|
;
|
|
|
|
\ Include file from intepreter
|
|
: include bl word count included ;
|
|
|
|
\ Get the file size
|
|
: file-size ( fileid -- size ior ) drop file_length @ 0 ;
|
|
|
|
\ Get the file postion
|
|
: file-position ( fileid -- position ior ) drop file_position @ 0 ;
|
|
|
|
\ Repostion the file
|
|
: reposition-file ( position fileid -- ior ) drop
|
|
dup 0 < if drop 1 exit then
|
|
dup file_length @ >= if drop 1 exit then
|
|
dup -512 and file_position @ -512 and <>
|
|
if
|
|
dup 9 rshift file_sector0 @ +
|
|
dup file_sector !
|
|
spi_buf spi_readblock drop
|
|
then
|
|
dup file_position !
|
|
file_length @ swap - 512 min file_remaining !
|
|
0
|
|
;
|
|
|
|
: file_rewind
|
|
0 0 reposition-file drop
|
|
;
|
|
|
|
: file_update_length
|
|
file_dsector @ spi_buf spi_readblock drop
|
|
file_length @
|
|
file_doffset @ 28 + spi_buf + !
|
|
file_dsector @ spi_buf spi_writeblock drop
|
|
;
|
|
|
|
: file_putc
|
|
file_position @ 511 and spi_buf + c!
|
|
file_position @ 1+ dup file_position ! file_length !
|
|
file_position @ 511 and 0=
|
|
if
|
|
file_sector @ spi_buf spi_writeblock drop
|
|
file_sector @ 1+ file_sector !
|
|
file_update_length
|
|
0
|
|
else
|
|
1
|
|
then
|
|
file_dirty !
|
|
;
|
|
|
|
: write-file ( addr len fileid -- ior )
|
|
set-file-struct
|
|
0 ?do
|
|
dup c@ file_putc
|
|
1+
|
|
loop
|
|
drop 0
|
|
;
|
|
|
|
: write-line ( addr len fileid -- ior )
|
|
write-file
|
|
10 file_putc
|
|
;
|
|
|
|
: flush-file ( fileid -- ior )
|
|
set-file-struct
|
|
file_dirty @
|
|
if
|
|
file_sector @ spi_buf spi_writeblock drop
|
|
file_update_length
|
|
file_sector @ spi_buf spi_readblock drop
|
|
0 file_dirty !
|
|
then
|
|
0
|
|
;
|
|
|
|
: find_free_cluster
|
|
spi_fat1 @ spi_sectorsperfat @ 0
|
|
?do
|
|
dup spi_buf spi_readblock drop
|
|
1+
|
|
512 0
|
|
do
|
|
spi_filesystem @ 2 =
|
|
if
|
|
spi_buf i + @ 0=
|
|
if
|
|
drop
|
|
j 128 * i 4 / +
|
|
unloop unloop exit
|
|
then
|
|
4
|
|
else
|
|
spi_buf i + w@ 0=
|
|
if
|
|
drop
|
|
j 256 * i 2 / +
|
|
unloop unloop exit
|
|
then
|
|
2
|
|
then
|
|
+loop
|
|
loop
|
|
drop 0
|
|
;
|
|
|
|
: open_directory
|
|
32768 file_length !
|
|
0 file_position !
|
|
0 file_remaining !
|
|
0 file_dsector !
|
|
0 file_doffset !
|
|
spi_currdir @
|
|
dup file_sector0 !
|
|
dup file_sector !
|
|
spi_buf spi_readblock drop
|
|
;
|
|
|
|
: directory_next
|
|
file_position @ 32 + dup file_position !
|
|
511 and 0=
|
|
if
|
|
file_sector @ 1+ dup file_sector !
|
|
spi_buf spi_readblock drop
|
|
then
|
|
;
|
|
|
|
: find_directory_end
|
|
open_directory
|
|
begin
|
|
file_position @ 511 and spi_buf + c@
|
|
while
|
|
directory_next
|
|
repeat
|
|
;
|
|
|
|
: allocate_cluster ( cluster )
|
|
spi_filesystem @ 2 =
|
|
if
|
|
4 * dup 512 / spi_fat1 @ +
|
|
dup spi_buf spi_readblock drop
|
|
swap 511 and spi_buf + 268435455 swap !
|
|
else
|
|
2* dup 512 / spi_fat1 @ +
|
|
dup spi_buf spi_readblock drop
|
|
swap 511 and spi_buf + 65535 swap w!
|
|
then
|
|
spi_buf spi_writeblock drop
|
|
;
|
|
|
|
: create-file ( addr len fam -- fileid ior )
|
|
>r 2dup r> open-file 0=
|
|
if swap drop swap drop 0
|
|
0 file_length !
|
|
file_update_length
|
|
exit then
|
|
drop
|
|
get-file-struct
|
|
dup 0= if drop 2drop 1 1 exit then -rot
|
|
convertfname
|
|
find_free_cluster dup
|
|
find_directory_end
|
|
file_position @ 511 and spi_buf +
|
|
fatname over 11
|
|
cmove
|
|
dup 11 + 21 0 fill
|
|
spi_filesystem @ 2 =
|
|
if
|
|
over 16 rshift over 20 + w!
|
|
then
|
|
26 + w!
|
|
file_position @ 511 and >r
|
|
file_sector @ >r
|
|
file_position @ 32 + dup file_position !
|
|
511 and dup 0=
|
|
if
|
|
file_sector @ spi_buf spi_writeblock drop
|
|
file_sector @ 1+ file_sector !
|
|
then
|
|
spi_buf + 0 swap c!
|
|
file_sector @ spi_buf spi_writeblock drop
|
|
dup
|
|
allocate_cluster
|
|
spi_clustershift @ lshift spi_dataregion @ +
|
|
0 swap r> r>
|
|
initialize_file
|
|
swap drop
|
|
;
|
|
|
|
: close-file ( fileid -- ior )
|
|
flush-file
|
|
0 file_opened !
|
|
;
|
|
|
|
: delete-file ( addr len -- ior )
|
|
0 open-file swap drop
|
|
if
|
|
1
|
|
else
|
|
file_dsector @ spi_buf spi_readblock drop
|
|
229 file_doffset @ spi_buf + c!
|
|
file_dsector @ spi_buf spi_writeblock drop
|
|
0 file_opened !
|
|
0
|
|
then
|
|
;
|
|
|
|
\ Create an new definition for refill
|
|
: _refill1 tib 200 source-id
|
|
if
|
|
source-id read-line drop
|
|
0 = if
|
|
source-id close-file drop
|
|
drop \ 0 to source-id 0
|
|
_loadsrc exit
|
|
then
|
|
else
|
|
accept
|
|
then
|
|
#tib ! 0 >in !
|
|
;
|
|
|
|
' _refill1 is refill
|
|
|