add file input, INCLUDE-FILE, and INCLUDED

startup.4th

@@ -2025,13 +2025,18 @@ TERMINAL-BUFFER-BYTES ALLOCATE CONSTANT TERMINAL-BUFFER
 2VARIABLE TIB-LEFTOVER
 NULL 0 TIB-LEFTOVER 2!
 
+\ Placeholder for later support for input from files
+DEFER REFILL-FROM-FILE
+' FALSE IS REFILL-FROM-FILE
+
 FORTH DEFINITIONS
 
 \ Attempt to replace the parse area with the next line from the current source
 \ Return TRUE if the parse area was refilled, or FALSE otherwise
 \ REFILL always fails if the current source is a string (from EVALUATE)
 :FINALIZE REFILL  ( -- flag )
-   SOURCE-ID 0< IF FALSE EXIT THEN
+   SOURCE-ID -1 = IF FALSE EXIT THEN
+   SOURCE-ID 0> IF REFILL-FROM-FILE EXIT THEN
    \ Shift any leftover characters after the previous line to the start of the buffer
    TIB-LEFTOVER 2@ TERMINAL-BUFFER SWAP DUP >R CMOVE
    \ Look for the linefeed character which marks the end of the first line
@@ -2039,8 +2044,7 @@ FORTH DEFINITIONS
       \ If at the end with room in the buffer, read more from the file descriptor
       2DUP = IF
          DUP TERMINAL-BUFFER-BYTES U< IF
-            \ SOURCE-ID is the file descriptor number to read from
-            SOURCE-ID OVER TERMINAL-BUFFER TERMINAL-BUFFER-BYTES ROT /STRING
+            STDIN OVER TERMINAL-BUFFER TERMINAL-BUFFER-BYTES ROT /STRING
             ( S: length idx src-id buff buff-size )
             SYS_READ SYSCALL3-RETRY DUP 0< IF EXCP-FILE-IO THROW THEN
             ( S: length idx u-read )
@@ -2799,6 +2803,16 @@ STRUCT
    unsigned-long-long% FIELD stat64>ino
 ENDSTRUCT stat64%
 
+UTILITY DEFINITIONS
+
+4096 CONSTANT FILE-BUFFER-BYTES
+4096 CONSTANT SOURCE-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 ;
+
 SYSTEM DEFINITIONS
 
 STRUCT
@@ -2807,6 +2821,7 @@ STRUCT
    CELL%    FIELD FILE>BUFFER
    2CELL%   FIELD FILE>LEFTOVER
    2CELL%   FIELD FILE>POSITION
+   2CELL%   FIELD FILE>SOURCE
 ENDSTRUCT FILE%
 
 { CONTAINEROF FILE>NODE ▪ FILE>FD @ } ' <=> NEW-AA-TREE CONSTANT FILES
@@ -2818,14 +2833,18 @@ signed-long-long% %VARIABLE LLSEEK-RESULT
 : FD>FILE  ( fileid -- file-addr )
    FILES AA-LOOKUP ?DUP 0= "unknown file ID" ?FAIL ;
 
-UTILITY DEFINITIONS
+: CLEAR-LEFTOVER ( file-addr -- )
+   [ NULL 0 ] 2LITERAL ROT FILE>LEFTOVER 2! ;
 
-4096 CONSTANT FILE-BUFFER-BYTES
+: ENSURE-BUFFER ( file-addr -- )
+   FILE>BUFFER DUP @ NULL= IF
+      FILE-BUFFER-BYTES ALLOCATE SWAP !
+   ELSE DROP THEN ;
 
-: MAKE-CSTRING  ( c-addr1 u -- c-addr2 )
-   TUCK ▪ DUP 1+ ALLOCATE ▪ DUP >R ▪ SWAP CMOVE ▪ 0 ▪ SWAP R@ + C! ▪ R> ;
-
-: EMPTY-CSTRING "\0" DROP ;
+: ENSURE-SOURCE ( file-addr -- )
+   FILE>SOURCE DUP 2@ DROP NULL= IF
+      SOURCE-BUFFER-BYTES ALLOCATE 0 ROT 2!
+   ELSE DROP THEN ;
 
 FORTH DEFINITIONS
 
@@ -2838,9 +2857,10 @@ O_RDWR   CONSTANT R/W  ( -- fam )
 
 : OPEN-FILE  ( c-addr u fam -- fileid )
    FILE% %ALLOCATE >R
-   FILE-BUFFER-BYTES ALLOCATE R@ FILE>BUFFER !
-   [ NULL 0 ] 2LITERAL R@ FILE>LEFTOVER 2!
+   NULL R@ FILE>BUFFER !
+   R@ CLEAR-LEFTOVER
    0# R@ FILE>POSITION 2!
+   [ NULL 0 ] 2LITERAL R@ FILE>SOURCE 2!
    OPEN-HOW SIZEOF open_how% 0 FILL
    DUP 0 SWAP OPEN-HOW open_how>flags 2!
    [[ O_CREAT __O_TMPFILE OR ]] AND IF
@@ -2862,7 +2882,7 @@ O_RDWR   CONSTANT R/W  ( -- fam )
 : 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!
+   R@ CLEAR-LEFTOVER
    0<> IF RDROP EXCP-FILE-IO THROW THEN
    LLSEEK-RESULT 2@ SWAP R@ FILE>POSITION 2!
    RDROP ;
@@ -2885,6 +2905,7 @@ UTILITY DEFINITIONS
 : (READ-CHAR)  ( file-addr -- c TRUE | FALSE )
    >R
    R@ FILE>LEFTOVER 2@ NIP 0= IF
+      R@ ENSURE-BUFFER
       R@ FILE>FD @ R@ FILE>BUFFER @ FILE-BUFFER-BYTES
          SYS_READ SYSCALL3-RETRY
       DUP 0< IF DROP EXCP-FILE-IO THROW THEN
@@ -2920,7 +2941,7 @@ FORTH DEFINITIONS
          DUP max U<
       WHILE
          file (READ-CHAR)
-         DUP 0= IF NIP TRUE SWAP THEN
+         DUP 0= IF >R NIP DUP 0= SWAP R> THEN
       WHILE
          DUP LF <> DUP 0= IF NIP THEN
       WHILE
@@ -2930,6 +2951,27 @@ FORTH DEFINITIONS
       SWAP
    ENDLOCALS ;
 
+UTILITY DEFINITIONS
+
+: REFILL-FILE  ( fileid -- t=refilled )
+   FD>FILE >R
+   R@ ENSURE-SOURCE
+   R@ FILE>SOURCE 2@ DROP SOURCE-BUFFER-BYTES R@ FILE>FD @ READ-LINE
+   0= SWAP R@ FILE>SOURCE 2@ DROP SWAP R@ FILE>SOURCE 2! RDROP ;
+
+SYSTEM DEFINITIONS
+
+:FINALIZE REFILL-FROM-FILE  ( -- t=refilled )
+   SOURCE-ID DUP 0< "not a valid file source" ?FAIL
+   DUP [[ ' REFILL-FILE ]] CATCH ?DUP IF
+      DUP EXCP-FILE-IO <> IF RETHROW THEN
+      DROP 2DROP FALSE EXIT
+   THEN
+   DUP IF ▪ OVER FD>FILE FILE>SOURCE 2@ ▪ INPUT-BUFFER 2! ▪ 0 >IN ! ▪ THEN
+   NIP ;
+
+FORTH DEFINITIONS
+
 : WRITE-FILE  ( c-addr u fileid -- )
    FD>FILE >R
    R@ FILE>LEFTOVER 2@ NIP IF R@ FILE>FD @ FLUSH-FILE THEN
@@ -2947,13 +2989,19 @@ FORTH DEFINITIONS
 : 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 ;
+   DUP FILE>BUFFER @ FREE ▪ DUP FILE>SOURCE 2@ DROP 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… ;
+: INCLUDE-FILE  ( i*x fileid -- j*x )
+   SAVE-INPUT N>R ▪ SOURCE 2>R ▪ SOURCE-ID >R
+   CURRENT-SOURCE-ID !
+   BEGIN REFILL WHILE INTERPRET REPEAT
+   R> CURRENT-SOURCE-ID ! ▪ 2R> INPUT-BUFFER 2! ▪ NR> RESTORE-INPUT DROP ;
+
+: INCLUDED  ( i*x c-addr u -- j*x )
+   R/O OPEN-FILE DUP >R [[ ' INCLUDE-FILE ]] CATCH R> CLOSE-FILE RETHROW ;
 
 : FILE-STATUS  ( c-addr u -- x ) …TODO… ;