implement some of the file I/O words
This commit is contained in:
parent
38da1322c1
commit
9361c6fef0
163
startup.4th
163
startup.4th
|
|
@ -106,6 +106,7 @@ UTILITY SET-CURRENT
|
|||
-13 CONSTANT EXCP-UNDEFINED-WORD
|
||||
-17 CONSTANT EXCP-PNO-OVERFLOW
|
||||
-24 CONSTANT EXCP-BAD-NUMERIC-ARGUMENT
|
||||
-36 CONSTANT EXCP-NON-EXISTENT-FILE
|
||||
-37 CONSTANT EXCP-FILE-IO
|
||||
-39 CONSTANT EXCP-UNEXPECTED-EOF
|
||||
-56 CONSTANT EXCP-QUIT
|
||||
|
|
@ -165,6 +166,8 @@ DEFER QUIT
|
|||
: ?FAIL ( flag c-addr u -- <none> | <noreturn> )
|
||||
ROT IF FAIL ELSE 2DROP THEN ;
|
||||
|
||||
: …TODO… "not implemented" FAIL ;
|
||||
|
||||
\ Get the execution token of the most recent word in the compilation word list
|
||||
\ If the word list is empty the result will be zero
|
||||
: LATEST ( -- xt | NULL ) GET-CURRENT @ ;
|
||||
|
|
@ -220,7 +223,6 @@ DEFER QUIT
|
|||
12 ⇒ SYS_CHDIR
|
||||
13 ⇒ SYS_TIME
|
||||
15 ⇒ SYS_CHMOD
|
||||
19 ⇒ SYS_LSEEK
|
||||
20 ⇒ SYS_GETPID
|
||||
21 ⇒ SYS_MOUNT
|
||||
25 ⇒ SYS_STIME
|
||||
|
|
@ -531,6 +533,21 @@ DEFER QUIT
|
|||
\ Special dirfd for *at syscalls to resolve path relative to current directory
|
||||
-100 ⇒ AT_FDCWD
|
||||
|
||||
\ Common flags for *at syscalls
|
||||
1 8 LSHIFT ⇒ AT_SYMLINK_NOFOLLOW
|
||||
1 9 LSHIFT ⇒ AT_REMOVEDIR ( only for unlinkat )
|
||||
1 9 LSHIFT ⇒ AT_EACCESS ( only for faccessat )
|
||||
1 10 LSHIFT ⇒ AT_SYMLINK_FOLLOW
|
||||
1 11 LSHIFT ⇒ AT_NO_AUTOMOUNT
|
||||
1 12 LSHIFT ⇒ AT_EMPTY_PATH
|
||||
3 13 LSHIFT ⇒ AT_STATX_SYNC_TYPE ( mask )
|
||||
1 15 LSHIFT ⇒ AT_RECURSIVE
|
||||
|
||||
\ Sync types for statx
|
||||
0 13 LSHIFT ⇒ AT_STATX_SYNC_AS_STAT
|
||||
1 13 LSHIFT ⇒ AT_STATX_FORCE_SYNC
|
||||
2 13 LSHIFT ⇒ AT_STATX_DONT_SYNC
|
||||
|
||||
\ errno values
|
||||
\ System calls return -errno in the range [-4095, -1]
|
||||
1 ⇒ ERRNO_EPERM
|
||||
|
|
@ -611,9 +628,29 @@ DEFER QUIT
|
|||
\ openat2() flags
|
||||
1 6 LSHIFT ⇒ O_CREAT
|
||||
1 7 LSHIFT ⇒ O_EXCL
|
||||
1 8 LSHIFT ⇒ O_NOCTTY
|
||||
1 9 LSHIFT ⇒ O_TRUNC
|
||||
1 10 LSHIFT ⇒ O_APPEND
|
||||
1 11 LSHIFT ⇒ O_NONBLOCK
|
||||
1 12 LSHIFT ⇒ O_DSYNC
|
||||
1 13 LSHIFT ⇒ FASYNC
|
||||
1 14 LSHIFT ⇒ O_DIRECT
|
||||
1 15 LSHIFT ⇒ O_LARGEFILE
|
||||
1 16 LSHIFT ⇒ O_DIRECTORY
|
||||
1 17 LSHIFT ⇒ O_NOFOLLOW
|
||||
1 18 LSHIFT ⇒ O_NOATIME
|
||||
1 19 LSHIFT ⇒ O_CLOEXEC
|
||||
1 20 LSHIFT ⇒ __O_SYNC
|
||||
1 21 LSHIFT ⇒ O_PATH
|
||||
1 22 LSHIFT ⇒ __O_TMPFILE
|
||||
|
||||
__O_SYNC O_DSYNC OR ⇒ O_SYNC
|
||||
__O_TMPFILE O_DIRECTORY OR ⇒ O_TMPFILE
|
||||
|
||||
\ Achor location for whence argument to _llseek
|
||||
0 ⇒ SEEK_SET
|
||||
1 ⇒ SEEK_CUR
|
||||
2 ⇒ SEEK_END
|
||||
|
||||
\ Names for the standard file descriptor numbers
|
||||
0 ⇒ STDIN
|
||||
|
|
@ -2232,6 +2269,7 @@ SYSTEM DEFINITIONS
|
|||
{ "Pictured numeric output string overflow\n" TYPE-ERR }
|
||||
EXCP-PNO-OVERFLOW REPORTER!
|
||||
{ "Invalid numeric argument\n" TYPE-ERR } EXCP-BAD-NUMERIC-ARGUMENT REPORTER!
|
||||
{ "Non-existent file\n" TYPE-ERR } EXCP-NON-EXISTENT-FILE REPORTER!
|
||||
{ "File I/O exception\n" TYPE-ERR } EXCP-FILE-IO REPORTER!
|
||||
{ "Unexpected end of file\n" TYPE-ERR } EXCP-UNEXPECTED-EOF REPORTER!
|
||||
{ "Quit\n" TYPE-ERR } EXCP-QUIT REPORTER!
|
||||
|
|
@ -2730,6 +2768,12 @@ UTILITY DEFINITIONS
|
|||
|
||||
LINUX DEFINITIONS
|
||||
|
||||
STRUCT
|
||||
uint64% FIELD open_how>flags
|
||||
uint64% FIELD open_how>mode
|
||||
uint64% FIELD open_how>resolve
|
||||
ENDSTRUCT open_how%
|
||||
|
||||
STRUCT
|
||||
unsigned-long-long% FIELD stat64>dev
|
||||
unsigned-char% 4 * FIELD stat64>__pad0
|
||||
|
|
@ -2752,35 +2796,120 @@ STRUCT
|
|||
unsigned-long-long% FIELD stat64>ino
|
||||
ENDSTRUCT stat64%
|
||||
|
||||
SYSTEM DEFINITIONS
|
||||
|
||||
STRUCT
|
||||
AA-NODE% FIELD FILE>NODE
|
||||
CELL% FIELD FILE>FD
|
||||
CELL% FIELD FILE>BUFFER
|
||||
2CELL% FIELD FILE>LEFTOVER
|
||||
2CELL% FIELD FILE>POSITION
|
||||
ENDSTRUCT FILE%
|
||||
|
||||
{ CONTAINEROF FILE>NODE ▪ FILE>FD @ } ' <=> NEW-AA-TREE CONSTANT FILES
|
||||
|
||||
ALSO LINUX
|
||||
open_how% %VARIABLE OPEN-HOW
|
||||
stat64% %VARIABLE STAT64-RESULT
|
||||
signed-long-long% %VARIABLE LLSEEK-RESULT
|
||||
PREVIOUS
|
||||
|
||||
: FD>FILE ( fileid -- file-addr )
|
||||
FILES AA-LOOKUP ?DUP 0= "unknown file ID" ?FAIL ;
|
||||
|
||||
UTILITY DEFINITIONS
|
||||
|
||||
4096 CONSTANT FILE-BUFFER-BYTES
|
||||
|
||||
: MAKE-CSTRING ( c-addr1 u -- c-addr2 )
|
||||
TUCK ▪ DUP 1+ ALLOCATE ▪ DUP >R ▪ SWAP CMOVE ▪ 0 ▪ SWAP R@ + C! ▪ R> ;
|
||||
|
||||
: EMPTY-CSTRING "\0" DROP ;
|
||||
|
||||
FORTH DEFINITIONS
|
||||
|
||||
ALSO LINUX
|
||||
|
||||
O_RDONLY CONSTANT R/O ( -- fam )
|
||||
O_WRONLY CONSTANT W/O ( -- fam )
|
||||
O_RDWR CONSTANT R/W ( -- fam )
|
||||
PREVIOUS
|
||||
|
||||
\ All files are treated as binary files
|
||||
: BIN ( fam1 -- fam2 ) IMMEDIATE ;
|
||||
|
||||
: CREATE-FILE ( c-addr u fam -- fileid ) ;
|
||||
: OPEN-FILE ( c-addr u fam -- fileid ) ;
|
||||
: REPOSITION-FILE ( ud fileid -- ) ;
|
||||
: FILE-POSITION ( fileid -- ud ) ;
|
||||
: RESIZE-FILE ( ud fileid -- ) ;
|
||||
: FILE-SIZE ( fileid -- ud ) ;
|
||||
: OPEN-FILE ( c-addr u fam -- fileid )
|
||||
FILE% %ALLOCATE >R
|
||||
FILE-BUFFER-BYTES ALLOCATE R@ FILE>BUFFER !
|
||||
[ NULL 0 ] 2LITERAL R@ FILE>LEFTOVER 2!
|
||||
0# R@ FILE>POSITION 2!
|
||||
OPEN-HOW SIZEOF open_how% 0 FILL
|
||||
DUP 0 SWAP OPEN-HOW open_how>flags 2!
|
||||
[[ O_CREAT __O_TMPFILE OR ]] AND IF
|
||||
0 0666 OPEN-HOW open_how>mode 2!
|
||||
THEN
|
||||
AT_FDCWD ▪ -ROT MAKE-CSTRING DUP >R ▪ OPEN-HOW ▪ SIZEOF open_how%
|
||||
SYS_OPENAT2 SYSCALL4-RETRY
|
||||
R> FREE
|
||||
DUP ERRNO_ENOENT = OR-ELSE DUP ERRNO_ENOTDIR = THEN IF
|
||||
DROP EXCP-NON-EXISTENT-FILE THROW THEN
|
||||
DUP 0< IF DROP EXCP-FILE-IO THROW THEN
|
||||
DUP R@ FILE>FD !
|
||||
R@ FILES AA-LOOKUP 0<> "internal error - duplicate key in FILES" ?FAIL
|
||||
R> FILES AA-INSERT ;
|
||||
|
||||
: CREATE-FILE ( c-addr u fam -- fileid )
|
||||
[[ O_CREAT O_TRUNC OR ]] OR OPEN-FILE ;
|
||||
|
||||
: REPOSITION-FILE ( ud fileid -- )
|
||||
DUP ▪ FD>FILE >R ▪ -ROT SWAP ▪ LLSEEK-RESULT ▪ SEEK_SET
|
||||
SYS__LLSEEK SYSCALL5-RETRY
|
||||
[ NULL 0 ] 2LITERAL R@ FILE>LEFTOVER 2!
|
||||
0<> IF RDROP EXCP-FILE-IO THROW THEN
|
||||
LLSEEK-RESULT 2@ SWAP R@ FILE>POSITION 2!
|
||||
RDROP ;
|
||||
|
||||
: FILE-POSITION ( fileid -- ud ) FD>FILE FILE>POSITION 2@ ;
|
||||
|
||||
: FLUSH-FILE ( fileid -- ) DUP FILE-POSITION ROT REPOSITION-FILE ;
|
||||
|
||||
: RESIZE-FILE ( ud fileid -- ) …TODO… ;
|
||||
|
||||
: FILE-SIZE ( fileid -- ud )
|
||||
STAT64-RESULT SIZEOF stat64% 0 FILL
|
||||
FD>FILE FILE>FD @ EMPTY-CSTRING STAT64-RESULT AT_EMPTY_PATH
|
||||
SYS_FSTATAT64 SYSCALL4-RETRY
|
||||
0<> IF EXCP-FILE-IO THROW THEN
|
||||
STAT64-RESULT stat64>size 2@ SWAP ;
|
||||
|
||||
: READ-FILE ( c-addr u1 fileid -- u2 ) ;
|
||||
: READ-LINE ( c-addr u1 fileid -- u2 t=eof ) ;
|
||||
: WRITE-FILE ( c-addr u fileid -- ) ;
|
||||
: WRITE-LINE ( c-addr u fileid -- ) ;
|
||||
: FLUSH-FILE ( fileid -- ) ;
|
||||
: CLOSE-FILE ( fileid -- ) ;
|
||||
: RENAME-FILE ( c-addr1 u1 c-addr2 u2 -- ) ;
|
||||
: DELETE-FILE ( c-addr u -- ) ;
|
||||
|
||||
: INCLUDE-FILE ( i*x fileid -- j*x ) ;
|
||||
: INCLUDED ( i*x c-addr u -- j*x ) ;
|
||||
: WRITE-FILE ( c-addr u fileid -- )
|
||||
FD>FILE >R
|
||||
R@ FILE>LEFTOVER 2@ NIP IF R@ FILE>FD @ FLUSH-FILE THEN
|
||||
BEGIN DUP WHILE
|
||||
2DUP R@ FILE>FD @ -ROT SYS_WRITE SYSCALL3-RETRY
|
||||
DUP -4095 1 WITHIN IF DROP EXCP-FILE-IO THROW THEN
|
||||
DUP OVER U> "wrote more data than requested" ?FAIL
|
||||
DUP 0 R@ FILE>POSITION 2@ D+ R@ FILE>POSITION 2!
|
||||
/STRING
|
||||
REPEAT ▪ 2DROP ▪ RDROP ;
|
||||
|
||||
: FILE-STATUS ( c-addr u -- x ) ;
|
||||
: WRITE-LINE ( c-addr u fileid -- )
|
||||
DUP >R WRITE-FILE (EOL) R> WRITE-FILE ;
|
||||
|
||||
: CLOSE-FILE ( fileid -- )
|
||||
FD>FILE ▪ DUP FILE>FD @ FILES AA-DELETE DROP
|
||||
DUP FILE>FD @ SYS_CLOSE SYSCALL1 DROP ( do not retry close )
|
||||
DUP FILE>BUFFER @ FREE ▪ FREE ;
|
||||
|
||||
: RENAME-FILE ( c-addr1 u1 c-addr2 u2 -- ) …TODO… ;
|
||||
: DELETE-FILE ( c-addr u -- ) …TODO… ;
|
||||
|
||||
: INCLUDE-FILE ( i*x fileid -- j*x ) …TODO… ;
|
||||
: INCLUDED ( i*x c-addr u -- j*x ) …TODO… ;
|
||||
|
||||
: FILE-STATUS ( c-addr u -- x ) …TODO… ;
|
||||
|
||||
ONLY FORTH DEFINITIONS
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue