From 8d2c2052594284dc08a548589d63b6bcaf28f653 Mon Sep 17 00:00:00 2001 From: Helmut Eller Date: Tue, 3 Jan 2017 22:13:53 +0100 Subject: [PATCH] Implement FILE-STATUS This implements FILE-STATUS on top of OPEN-FILE: FILE-STATUS succeeds if we can open the file in read-only mode. This way we avoid adding yet another primitive. * fth/file.fth (FILE-STATUS): New * fth/t_file.fth (FILE-STATUS): Delete stub --- fth/file.fth | 14 ++++++++++++++ fth/t_file.fth | 5 +---- 2 files changed, 15 insertions(+), 4 deletions(-) diff --git a/fth/file.fth b/fth/file.fth index 8fe0810..0017942 100644 --- a/fth/file.fth +++ b/fth/file.fth @@ -127,4 +127,18 @@ create (LINE-TERMINATOR) \n c, ENDCASE ; immediate +\ We basically try to open the file in read-only mode. That seems to +\ be the best that we can do with ANSI C. If we ever want to do +\ something more sophisticated, like calling access(2), we must create +\ a proper primitive. (OTOH, portable programs can't assume much +\ about FILE-STATUS and non-portable programs could create a custom +\ function for access(2).) +: FILE-STATUS ( c-addr u -- x ior ) + r/o bin open-file ( fileid ior1 ) + ?dup + IF ( fileid ior1 ) + ELSE close-file 0 swap ( 0 ior2 ) + THEN +; + privatize diff --git a/fth/t_file.fth b/fth/t_file.fth index 388008c..018ca58 100644 --- a/fth/t_file.fth +++ b/fth/t_file.fth @@ -60,7 +60,7 @@ include? }T{ t_tools.fth true fp-require-e ! -true value verbose +false value verbose : testing verbose IF @@ -73,9 +73,6 @@ true value verbose : s= compare 0= ; : $" state IF postpone s" else ['] s" execute THEN ; immediate -\ FIXME: stubs for missing definitions -: file-status 2drop 0 -1 ; - TESTING File Access word set DECIMAL -- 2.20.1