alx/ueforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fixing file bugs

Browse Source
This commit is contained in:
Brad Nelson
2021-01-29 09:13:34 -08:00
parent 69db9aead4
commit d07e580eda
2 changed files with 11 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
ueforth/posix/posix.fs
View File

@ -77,29 +77,29 @@ decimal
' posix-bye is bye ' posix-bye is bye
( I/O Error Helpers ) ( I/O Error Helpers )
: 0<ior ( n -- n ior ) dup 0< if errno else 0 then ; : d0<ior ( n -- n ior ) dup 0< if errno else 0 then ;
( Generic Files ) ( Generic Files )
O_RDONLY constant r/o O_RDONLY constant r/o
O_WRONLY constant w/o O_WRONLY constant w/o
O_RDWR constant r/w O_RDWR constant r/w
octal 777 constant 0777 decimal octal 777 constant 0777 decimal
: open-file ( a n fam -- fh ior ) >r s>z r> 0777 open sign-extend 0<ior ; : open-file ( a n fam -- fh ior ) >r s>z r> 0777 open sign-extend d0<ior ;
: create-file ( a n fam -- fh ior ) : create-file ( a n fam -- fh ior )
>r s>z r> O_CREAT or 0777 open sign-extend 0<ior ; >r s>z r> O_CREAT or 0777 open sign-extend d0<ior ;
: close-file ( fh -- ior ) close sign-extend ; : close-file ( fh -- ior ) close sign-extend ;
: flush-file ( fh -- ior ) fsync sign-extend ; : flush-file ( fh -- ior ) fsync sign-extend ;
: delete-file ( a n -- ior ) s>z unlink sign-extend ; : delete-file ( a n -- ior ) s>z unlink sign-extend ;
: rename-file ( a n a n -- ior ) s>z -rot s>z swap rename sign-extend ; : rename-file ( a n a n -- ior ) s>z -rot s>z swap rename sign-extend ;
: read-file ( a n fh -- n ior ) -rot read 0<ior ; : read-file ( a n fh -- n ior ) -rot read d0<ior ;
: write-file ( a n fh -- ior ) -rot dup >r write r> = 0= ; : write-file ( a n fh -- ior ) -rot dup >r write r> = 0= ;
: file-position ( fh -- n ior ) 0 SEEK_CUR lseek 0<ior ; : file-position ( fh -- n ior ) 0 SEEK_CUR lseek d0<ior ;
: reposition-file ( n fh -- ior ) swap SEEK_SET lseek 0< ; : reposition-file ( n fh -- ior ) swap SEEK_SET lseek 0< ;
: resize-file ( n fh -- ior ) swap ftruncate 0< ; : resize-file ( n fh -- ior ) swap ftruncate 0< ;
: file-size ( fh -- n ior ) : file-size ( fh -- n ior )
dup 0 SEEK_CUR lseek >r dup 0 SEEK_CUR lseek >r
dup 0 SEEK_END lseek r> swap >r dup 0 SEEK_END lseek r> swap >r
SEEK_SET lseek drop r> 0<ior ; SEEK_SET lseek drop r> d0<ior ;
( Other Utils ) ( Other Utils )
: ms ( n -- ) 1000 * usleep drop ; : ms ( n -- ) 1000 * usleep drop ;

10
ueforth/windows/windows.fs
View File

@ -91,8 +91,8 @@ $80 constant FILE_ATTRIBUTE_NORMAL
( I/O Error Helpers ) ( I/O Error Helpers )
: ior ( f -- ior ) if GetLastError else 0 then ; : ior ( f -- ior ) if GetLastError else 0 then ;
: 0=ior ( n -- n ior ) dup 0= ior ; : 0=ior ( n -- n ior ) 0= ior ;
: 0<ior ( n -- n ior ) dup 0< ior ; : d0<ior ( n -- n ior ) dup 0< ior ;
: invalid?ior ( n -- ior ) $ffffffff = ior ; : invalid?ior ( n -- ior ) $ffffffff = ior ;
( Generic Files ) ( Generic Files )
@ -101,15 +101,15 @@ $40000000 constant w/o ( GENERIC_WRITE )
r/o w/o or constant r/w r/o w/o or constant r/w
: open-file ( a n fam -- fh ior ) : open-file ( a n fam -- fh ior )
>r s>z r> FILE_SHARE_READ FILE_SHARE_WRITE or NULL >r s>z r> FILE_SHARE_READ FILE_SHARE_WRITE or NULL
OPEN_EXISTING FILE_ATTRIBUTE_NORMAL NULL CreateFileA 0<ior ; OPEN_EXISTING FILE_ATTRIBUTE_NORMAL NULL CreateFileA d0<ior ;
: create-file ( a n fam -- fh ior ) : create-file ( a n fam -- fh ior )
>r s>z r> FILE_SHARE_READ FILE_SHARE_WRITE or NULL >r s>z r> FILE_SHARE_READ FILE_SHARE_WRITE or NULL
CREATE_ALWAYS FILE_ATTRIBUTE_NORMAL NULL CreateFileA 0<ior ; CREATE_ALWAYS FILE_ATTRIBUTE_NORMAL NULL CreateFileA d0<ior ;
: close-file ( fh -- ior ) CloseHandle 0=ior ; : close-file ( fh -- ior ) CloseHandle 0=ior ;
: flush-file ( fh -- ior ) FlushFileBuffers 0=ior ; : flush-file ( fh -- ior ) FlushFileBuffers 0=ior ;
: delete-file ( a n -- ior ) s>z DeleteFileA 0=ior ; : delete-file ( a n -- ior ) s>z DeleteFileA 0=ior ;
: rename-file ( a n a n -- ior ) s>z -rot s>z swap MoveFileA 0=ior ; : rename-file ( a n a n -- ior ) s>z -rot s>z swap MoveFileA 0=ior ;
: read-file ( a n fh -- n ior ) -rot 0 >r rp@ NULL ReadFile r> swap 0= ior ; : read-file ( a n fh -- n ior ) -rot 0 >r rp@ NULL ReadFile r> swap 0=ior ;
: write-file ( a n fh -- ior ) : write-file ( a n fh -- ior )
-rot dup >r 0 >r rp@ NULL WriteFile -rot dup >r 0 >r rp@ NULL WriteFile
if r> r> <> else rdrop rdrop GetLastError then ; if r> r> <> else rdrop rdrop GetLastError then ;