steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Refactor open-file to allow flags and attributes as the fourth parameter

release
U-EE860\Administrator 2007-11-24 02:17:40 +01:00
parent f0d29daedd
commit 86070337fd
4 changed files with 15 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
extra/io/windows/ce/files/files.factor
View File

@ -7,7 +7,8 @@ IN: windows.ce.files
! M: windows-ce-io normalize-pathname ( string -- string ) ! M: windows-ce-io normalize-pathname ( string -- string )
! dup 1 tail* CHAR: \\ = [ "*" append ] [ "\\*" append ] if ; ! dup 1 tail* CHAR: \\ = [ "*" append ] [ "\\*" append ] if ;
M: windows-ce-io CreateFile-flags ( -- DWORD ) FILE_ATTRIBUTE_NORMAL ; M: windows-ce-io CreateFile-flags ( DWORD -- DWORD )
FILE_ATTRIBUTE_NORMAL bitor ;
M: windows-ce-io FileArgs-overlapped ( port -- f ) drop f ; M: windows-ce-io FileArgs-overlapped ( port -- f ) drop f ;
: finish-read ( port status bytes-ret -- ) : finish-read ( port status bytes-ret -- )

2
extra/io/windows/mmap/mmap.factor
View File

@ -62,7 +62,7 @@ M: windows-ce-io with-privileges
: mmap-open ( path access-mode create-mode flProtect access -- handle handle address ) : mmap-open ( path access-mode create-mode flProtect access -- handle handle address )
{ "SeCreateGlobalPrivilege" "SeLockMemoryPrivilege" } [ { "SeCreateGlobalPrivilege" "SeLockMemoryPrivilege" } [
>r >r open-file dup f r> 0 0 f >r >r 0 open-file dup f r> 0 0 f
CreateFileMapping [ win32-error=0/f ] keep CreateFileMapping [ win32-error=0/f ] keep
dup close-later dup close-later
dup dup

4
extra/io/windows/nt/files/files.factor
View File

@ -3,8 +3,8 @@ io.windows.nt io.windows.nt.backend kernel libc math
threads windows windows.kernel32 ; threads windows windows.kernel32 ;
IN: io.windows.nt.files IN: io.windows.nt.files
M: windows-nt-io CreateFile-flags ( -- DWORD ) M: windows-nt-io CreateFile-flags ( DWORD -- DWORD )
FILE_FLAG_OVERLAPPED ; FILE_FLAG_OVERLAPPED bitor ;
M: windows-nt-io FileArgs-overlapped ( port -- overlapped ) M: windows-nt-io FileArgs-overlapped ( port -- overlapped )
make-overlapped ; make-overlapped ;

18
extra/io/windows/windows.factor
View File

@ -23,7 +23,7 @@ TUPLE: win32-file handle ptr overlapped ;
: <win32-duplex-stream> ( in out -- stream ) : <win32-duplex-stream> ( in out -- stream )
>r f <win32-file> r> f <win32-file> handle>duplex-stream ; >r f <win32-file> r> f <win32-file> handle>duplex-stream ;
HOOK: CreateFile-flags io-backend ( -- DWORD ) HOOK: CreateFile-flags io-backend ( DWORD -- DWORD )
HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f ) HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f )
HOOK: add-completion io-backend ( port -- ) HOOK: add-completion io-backend ( port -- )
@ -31,7 +31,8 @@ M: windows-io normalize-directory ( string -- string )
"\\" ?tail drop "\\*" append ; "\\" ?tail drop "\\*" append ;
: share-mode ( -- fixnum ) : share-mode ( -- fixnum )
FILE_SHARE_READ FILE_SHARE_WRITE bitor ; inline FILE_SHARE_READ FILE_SHARE_WRITE bitor
FILE_SHARE_DELETE bitor ; foldable
M: win32-file init-handle ( handle -- ) M: win32-file init-handle ( handle -- )
drop ; drop ;
@ -40,24 +41,25 @@ M: win32-file close-handle ( handle -- )
win32-file-handle CloseHandle drop ; win32-file-handle CloseHandle drop ;
! Clean up resources (open handle) if add-completion fails ! Clean up resources (open handle) if add-completion fails
: open-file ( path access-mode create-mode -- handle ) : open-file ( path access-mode create-mode flags -- handle )
[ [
>r share-mode f r> CreateFile-flags f CreateFile >r >r >r normalize-pathname r>
share-mode f r> r> CreateFile-flags f CreateFile
dup invalid-handle? dup close-later dup invalid-handle? dup close-later
dup add-completion dup add-completion
] with-destructors ; ] with-destructors ;
: open-pipe-r/w ( path -- handle ) : open-pipe-r/w ( path -- handle )
GENERIC_READ GENERIC_WRITE bitor OPEN_EXISTING open-file ; GENERIC_READ GENERIC_WRITE bitor OPEN_EXISTING 0 open-file ;
: open-read ( path -- handle length ) : open-read ( path -- handle length )
normalize-pathname GENERIC_READ OPEN_EXISTING open-file 0 ; GENERIC_READ OPEN_EXISTING 0 open-file 0 ;
: open-write ( path -- handle length ) : open-write ( path -- handle length )
normalize-pathname GENERIC_WRITE CREATE_ALWAYS open-file 0 ; GENERIC_WRITE CREATE_ALWAYS 0 open-file 0 ;
: (open-append) ( path -- handle ) : (open-append) ( path -- handle )
normalize-pathname GENERIC_WRITE OPEN_ALWAYS open-file ; GENERIC_WRITE OPEN_ALWAYS 0 open-file ;
: set-file-pointer ( handle length -- ) : set-file-pointer ( handle length -- )
dupd d>w/w <uint> FILE_BEGIN SetFilePointer dupd d>w/w <uint> FILE_BEGIN SetFilePointer