implement some of the file I/O words

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 )
-: OPEN-FILE  ( c-addr u fam -- fileid ) ;
+   FILE% %ALLOCATE >R
-: REPOSITION-FILE  ( ud fileid -- ) ;
+   FILE-BUFFER-BYTES ALLOCATE R@ FILE>BUFFER !
-: FILE-POSITION  ( fileid -- ud ) ;
+   [ NULL 0 ] 2LITERAL R@ FILE>LEFTOVER 2!
-: RESIZE-FILE  ( ud fileid -- ) ;
+   0# R@ FILE>POSITION 2!
-: FILE-SIZE  ( fileid -- ud ) ;
+   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 ) ;
+: WRITE-FILE  ( c-addr u fileid -- )
-: INCLUDED  ( i*x c-addr u -- j*x ) ;
+   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