This introduces a primitive (RENAME-FILE) which takes C-strings as
arguments. The conversion from Forth-strings to C-strings is done in
Forth code as it doesn't seem to be any easier to do it in C.
* csrc/pf_io.h (sdRenameFile): New. It has the same semantics as
rename(2) from <stdio.h>
* csrc/pf_io.c (sdRenameFile): New stub.
* csrc/pf_guts.h (cforth_primitive_ids): ID_FILE_RENAME added,
ID_RESERVED12 removed
* csrc/pf_inner.c: Add case for ID_FILE_RENAME.
* csrc/pfcompil.c (pfBuildDictionary): Create entry for (RENAME-FILE).
* fth/file.fth (RENAME-FILE): New.
(THROW_RENAME_FILE): New constant.
* fth/t_file.fth: Remove stub and uncomment some tests.
/* 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
ID_RESERVED09,
ID_RESERVED10,
ID_RESERVED11,
ID_RESERVED09,
ID_RESERVED10,
ID_RESERVED11,
ID_FP_D_TO_F,
ID_FP_FSTORE,
ID_FP_FTIMES,
ID_FP_D_TO_F,
ID_FP_FSTORE,
ID_FP_FTIMES,
+ 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;
TOUCH(FileName);
return NULL;
}
TOUCH(FileName);
return NULL;
}
+
+int sdRenameFile( const char *OldName, const char *NewName )
+{
+ UNIMPLEMENTED("sdRenameFile");
+ TOUCH(OldName);
+ TOUCH(NewName);
+ return -1;
+}
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 );
#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)
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 );
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 ;
+-72 constant THROW_RENAME_FILE
+
}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
+: 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
+ \ with trailing zeros added.
+ a1 here u1 move
+ 0 here u1 chars + c!
+ here u1 1+ chars + to new
+ a2 new u2 move
+ 0 new u2 chars + c!
+ here new (rename-file) 0=
+ IF 0
+ ELSE throw_rename_file
+ THEN
+;
+
\ 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
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
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