Merge pull request #31 from ellerh/implement-rename-file

Implement RENAME-FILE

diff --git a/csrc/pf_guts.h b/csrc/pf_guts.h
index 4fa4bd0..5339294 100644 (file)
--- a/csrc/pf_guts.h
+++ b/csrc/pf_guts.h
@@ -282,6 +282,7 @@ enum cforth_primitive_ids
     /* DELETE-FILE */
     ID_FILE_DELETE,
     ID_FILE_FLUSH,             /* FLUSH-FILE */
     /* DELETE-FILE */
     ID_FILE_DELETE,
     ID_FILE_FLUSH,             /* FLUSH-FILE */

+    ID_FILE_RENAME,            /* (RENAME-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
 /* 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_RESERVED09,
     ID_RESERVED10,
     ID_RESERVED11,
     ID_RESERVED09,
     ID_RESERVED10,
     ID_RESERVED11,

-    ID_RESERVED12,

     ID_FP_D_TO_F,
     ID_FP_FSTORE,
     ID_FP_FTIMES,
     ID_FP_D_TO_F,
     ID_FP_FSTORE,
     ID_FP_FTIMES,

diff --git a/csrc/pf_inner.c b/csrc/pf_inner.c
index 06466c7..0a6c003 100644 (file)
--- a/csrc/pf_inner.c
+++ b/csrc/pf_inner.c
@@ -1098,6 +1098,14 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql ));
            }
            endcase;
 
            }
            endcase;
 

+       case ID_FILE_RENAME: /* ( oldName newName -- ior ) */
+           {
+               char *New = (char *) TOS;
+               char *Old = (char *) M_POP;
+               TOS = sdRenameFile( Old, New );
+           }
+           endcase;
+

         case ID_FILL: /* ( caddr num charval -- ) */
             {
                 register char *DstPtr;
         case ID_FILL: /* ( caddr num charval -- ) */
             {
                 register char *DstPtr;

diff --git a/csrc/pf_io.c b/csrc/pf_io.c
index 3aedb49..819dc9f 100644 (file)
--- a/csrc/pf_io.c
+++ b/csrc/pf_io.c
@@ -221,5 +221,13 @@ FileStream *sdDeleteFile( const char *FileName )
     TOUCH(FileName);
     return NULL;
 }
     TOUCH(FileName);
     return NULL;
 }

+
+cell_t sdRenameFile( const char *OldName, const char *NewName )
+{
+    UNIMPLEMENTED("sdRenameFile");
+    TOUCH(OldName);
+    TOUCH(NewName);
+    return -1;
+}

 #endif
 
 #endif
 

diff --git a/csrc/pf_io.h b/csrc/pf_io.h
index 8af1667..7cf4310 100644 (file)
--- a/csrc/pf_io.h
+++ b/csrc/pf_io.h
@@ -85,6 +85,7 @@ void ioTerm( void );
     cell_t sdReadFile( void *ptr, cell_t Size, int32_t nItems, FileStream * Stream  );
     cell_t sdWriteFile( void *ptr, cell_t Size, int32_t nItems, FileStream * Stream  );
     cell_t sdSeekFile( FileStream * Stream, off_t Position, int32_t Mode );
     cell_t sdReadFile( void *ptr, cell_t Size, int32_t nItems, FileStream * Stream  );
     cell_t sdWriteFile( void *ptr, cell_t Size, int32_t nItems, FileStream * Stream  );
     cell_t sdSeekFile( FileStream * Stream, off_t Position, int32_t Mode );

+    cell_t sdRenameFile( const char *OldName, const char *NewName );

     off_t sdTellFile( FileStream * Stream );
     cell_t sdCloseFile( FileStream * Stream );
     cell_t sdInputChar( FileStream *stream );
     off_t sdTellFile( FileStream * Stream );
     cell_t sdCloseFile( FileStream * Stream );
     cell_t sdInputChar( FileStream *stream );


@@ -127,6 +128,7 @@ void ioTerm( void );
             #define sdTellFile      ftello
         #endif
         #define sdCloseFile     fclose
             #define sdTellFile      ftello
         #endif
         #define sdCloseFile     fclose

+        #define sdRenameFile    rename

         #define sdInputChar     fgetc
 
         #define PF_STDIN  ((FileStream *) stdin)
         #define sdInputChar     fgetc
 
         #define PF_STDIN  ((FileStream *) stdin)

diff --git a/csrc/pfcompil.c b/csrc/pfcompil.c
index 8a147b9..a3f0121 100644 (file)
--- a/csrc/pfcompil.c
+++ b/csrc/pfcompil.c
@@ -259,6 +259,7 @@ PForthDictionary pfBuildDictionary( cell_t HeaderSize, cell_t CodeSize )
     CreateDicEntryC( ID_FILE_POSITION, "FILE-POSITION",  0 );
     CreateDicEntryC( ID_FILE_REPOSITION, "REPOSITION-FILE",  0 );
     CreateDicEntryC( ID_FILE_FLUSH, "FLUSH-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_RENAME, "(RENAME-FILE)",  0 );

     CreateDicEntryC( ID_FILE_RO, "R/O",  0 );
     CreateDicEntryC( ID_FILE_RW, "R/W",  0 );
     CreateDicEntryC( ID_FILE_WO, "W/O",  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/file.fth b/fth/file.fth
index bc81f3a..b71edc5 100644 (file)
--- a/fth/file.fth
+++ b/fth/file.fth
@@ -50,6 +50,17 @@ private{
 create (LINE-TERMINATOR) \n c,
 : LINE-TERMINATOR ( -- c-addr u ) (line-terminator) 1 ;
 
 create (LINE-TERMINATOR) \n c,
 : LINE-TERMINATOR ( -- c-addr u ) (line-terminator) 1 ;
 

+\ Standard throw code
+\ See: http://lars.nocrew.org/forth2012/exception.html#table:throw
+-72 constant THROW_RENAME_FILE
+
+\ Copy the string C-ADDR/U1 to C-ADDR2 and append a NUL.
+: PLACE-CSTR  ( c-addr1 u1 c-addr2 -- )
+    2dup 2>r          ( c-addr1 u1 c-addr2 )  ( r: u1 c-addr2 )
+    swap cmove        ( ) ( r: u1 c-addr2 )
+    0 2r> + c!        ( )
+;
+

 }private
 
 \ This treats \n, \r\n, and \r as line terminator.  Reading is done
 }private
 
 \ This treats \n, \r\n, and \r as line terminator.  Reading is done


@@ -85,4 +96,16 @@ create (LINE-TERMINATOR) \n c,
     THEN
 ;
 
     THEN
 ;
 

+: RENAME-FILE ( c-addr1 u1 c-addr2 u2 -- ior )
+    { a1 u1 a2 u2 | new }
+    \ Convert the file-names to C-strings by copying them after HERE.
+    a1 u1 here place-cstr
+    here u1 1+ chars + to new
+    a2 u2 new place-cstr
+    here new (rename-file) 0=
+    IF 0
+    ELSE throw_rename_file
+    THEN
+;
+

 privatize
 privatize

diff --git a/fth/t_file.fth b/fth/t_file.fth
index 328ae7f..f024926 100644 (file)
--- a/fth/t_file.fth
+++ b/fth/t_file.fth
@@ -75,7 +75,6 @@ true value verbose
 
 \ FIXME: stubs for missing definitions
 : resize-file drop 2drop -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
 : file-status 2drop 0 -1 ;
 
 TESTING File Access word set


@@ -231,7 +230,7 @@ T{ SOURCE-ID DUP -1 = SWAP 0= OR -> FALSE }T
 TESTING RENAME-FILE FILE-STATUS FLUSH-FILE
 
 : FN3 S" fatest3.txt" ;
 TESTING RENAME-FILE FILE-STATUS FLUSH-FILE
 
 : FN3 S" fatest3.txt" ;

-: >END FID1 @ FILE-SIZE .s DROP FID1 @ REPOSITION-FILE ;
+: >END FID1 @ FILE-SIZE DROP FID1 @ REPOSITION-FILE ;

 
 
 T{ FN3 DELETE-FILE DROP -> }T
 
 
 T{ FN3 DELETE-FILE DROP -> }T


@@ -239,11 +238,11 @@ T{ FN1 FN3 RENAME-FILE 0= -> TRUE }T
 T{ FN1 FILE-STATUS SWAP DROP 0= -> FALSE }T
 T{ FN3 FILE-STATUS SWAP DROP 0= -> TRUE }T  \ Return value is undefined
 T{ FN3 R/W OPEN-FILE SWAP FID1 ! -> 0 }T
 T{ FN1 FILE-STATUS SWAP DROP 0= -> FALSE }T
 T{ FN3 FILE-STATUS SWAP DROP 0= -> TRUE }T  \ Return value is undefined
 T{ FN3 R/W OPEN-FILE SWAP FID1 ! -> 0 }T

-\ nyi T{ >END -> 0 }T
-\ nyi T{ S" Final line" fid1 @ WRITE-LINE -> 0 }T
+T{ >END -> 0 }T
+T{ S" Final line" fid1 @ WRITE-LINE -> 0 }T

 
 

-\ nyi T{ FID1 @ FLUSH-FILE -> 0 }T      \ Can only test FLUSH-FILE doesn't fail
-\ nyi T{ FID1 @ CLOSE-FILE -> 0 }T
+T{ FID1 @ FLUSH-FILE -> 0 }T      \ Can only test FLUSH-FILE doesn't fail
+T{ FID1 @ CLOSE-FILE -> 0 }T

 
 \ Tidy the test folder
 T{ fn3 DELETE-FILE DROP -> }T
 
 \ Tidy the test folder
 T{ fn3 DELETE-FILE DROP -> }T