diff --git a/startup.4th b/startup.4th index 0c53c73..80d4310 100644 --- a/startup.4th +++ b/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… ;