From 8bf2fe25c2d6ed80c3d41cc664d13da865d6be6c Mon Sep 17 00:00:00 2001 From: Helmut Eller Date: Mon, 2 Jan 2017 08:47:34 +0100 Subject: [PATCH] Implement FLUSH-FILE * csrc/pf_guts.h (cforth_primitive_ids): Add ID_FILE_FLUSH, remove ID_RESERVED13. (THROW_FLUSH_FILE): New. * csrc/pf_inner.c (pfCatch): Add case for ID_FILE_FLUSH. * csrc/pfcompil.c (pfBuildDictionary): Add FLUSH-FILE. * fth/t_file.fth (FLUSH-FILE): Remove stub definition. --- csrc/pf_guts.h | 3 ++- csrc/pf_inner.c | 7 +++++++ csrc/pfcompil.c | 1 + fth/t_file.fth | 5 +---- 4 files changed, 11 insertions(+), 5 deletions(-) diff --git a/csrc/pf_guts.h b/csrc/pf_guts.h index 8f5e11f..4fa4bd0 100644 --- a/csrc/pf_guts.h +++ b/csrc/pf_guts.h @@ -281,6 +281,7 @@ enum cforth_primitive_ids ID_CELLS, /* DELETE-FILE */ ID_FILE_DELETE, + ID_FILE_FLUSH, /* FLUSH-FILE */ /* If you add a word here, take away one reserved word below. */ #ifdef PF_SUPPORT_FP /* Only reserve space if we are adding FP so that we can detect @@ -298,7 +299,6 @@ enum cforth_primitive_ids ID_RESERVED10, ID_RESERVED11, ID_RESERVED12, - ID_RESERVED13, ID_FP_D_TO_F, ID_FP_FSTORE, ID_FP_FTIMES, @@ -368,6 +368,7 @@ enum cforth_primitive_ids #define THROW_PAIRS (-22) #define THROW_FLOAT_STACK_UNDERFLOW ( -45) #define THROW_QUIT (-56) +#define THROW_FLUSH_FILE (-68) /* THROW codes unique to pForth */ #define THROW_BYE (-256) /* Exit program. */ diff --git a/csrc/pf_inner.c b/csrc/pf_inner.c index dcf12c6..06466c7 100644 --- a/csrc/pf_inner.c +++ b/csrc/pf_inner.c @@ -1091,6 +1091,13 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql )); TOS = TOS | PF_FAM_BINARY_FLAG; endcase; + case ID_FILE_FLUSH: /* ( fileid -- ior ) */ + { + FileStream *Stream = (FileStream *) TOS; + TOS = (sdFlushFile( Stream ) == 0) ? 0 : THROW_FLUSH_FILE; + } + endcase; + case ID_FILL: /* ( caddr num charval -- ) */ { register char *DstPtr; diff --git a/csrc/pfcompil.c b/csrc/pfcompil.c index 467d1e8..8a147b9 100644 --- a/csrc/pfcompil.c +++ b/csrc/pfcompil.c @@ -258,6 +258,7 @@ PForthDictionary pfBuildDictionary( cell_t HeaderSize, cell_t CodeSize ) CreateDicEntryC( ID_FILE_WRITE, "WRITE-FILE", 0 ); CreateDicEntryC( ID_FILE_POSITION, "FILE-POSITION", 0 ); CreateDicEntryC( ID_FILE_REPOSITION, "REPOSITION-FILE", 0 ); + CreateDicEntryC( ID_FILE_FLUSH, "FLUSH-FILE", 0 ); CreateDicEntryC( ID_FILE_RO, "R/O", 0 ); CreateDicEntryC( ID_FILE_RW, "R/W", 0 ); CreateDicEntryC( ID_FILE_WO, "W/O", 0 ); diff --git a/fth/t_file.fth b/fth/t_file.fth index 5f9e325..328ae7f 100644 --- a/fth/t_file.fth +++ b/fth/t_file.fth @@ -73,14 +73,11 @@ true value verbose : s= compare 0= ; : $" state IF postpone s" else ['] s" execute THEN ; immediate - -\ FIXME: stubs for missing definition -: flush-file drop -1 ; +\ FIXME: stubs for missing definitions : resize-file drop 2drop -1 ; : rename-file 2drop 2drop -1 ; : file-status 2drop 0 -1 ; - TESTING File Access word set DECIMAL -- 2.20.1