From 86070337fd372fff42d6685e2d962c5224ecc11e Mon Sep 17 00:00:00 2001
From: "U-EE860\\Administrator" <Administrator@EE860.(none)>
Date: Sat, 24 Nov 2007 02:17:40 +0100
Subject: [PATCH] Refactor open-file to allow flags and attributes as the
 fourth parameter

---
 extra/io/windows/ce/files/files.factor |  3 ++-
 extra/io/windows/mmap/mmap.factor      |  2 +-
 extra/io/windows/nt/files/files.factor |  4 ++--
 extra/io/windows/windows.factor        | 18 ++++++++++--------
 4 files changed, 15 insertions(+), 12 deletions(-)

diff --git a/extra/io/windows/ce/files/files.factor b/extra/io/windows/ce/files/files.factor
index df5dc65094..c4f5b2ef9e 100755
--- a/extra/io/windows/ce/files/files.factor
+++ b/extra/io/windows/ce/files/files.factor
@@ -7,7 +7,8 @@ IN: windows.ce.files
 ! M: windows-ce-io normalize-pathname ( string -- string )
     ! 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 ;
 
 : finish-read ( port status bytes-ret -- )
diff --git a/extra/io/windows/mmap/mmap.factor b/extra/io/windows/mmap/mmap.factor
index ca5d2bbd9a..27587e8340 100755
--- a/extra/io/windows/mmap/mmap.factor
+++ b/extra/io/windows/mmap/mmap.factor
@@ -62,7 +62,7 @@ M: windows-ce-io with-privileges
 
 : mmap-open ( path access-mode create-mode flProtect access -- handle handle address )
     { "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
         dup close-later
         dup
diff --git a/extra/io/windows/nt/files/files.factor b/extra/io/windows/nt/files/files.factor
index d53f5fcb40..5eed39224c 100755
--- a/extra/io/windows/nt/files/files.factor
+++ b/extra/io/windows/nt/files/files.factor
@@ -3,8 +3,8 @@ io.windows.nt io.windows.nt.backend kernel libc math
 threads windows windows.kernel32 ;
 IN: io.windows.nt.files
 
-M: windows-nt-io CreateFile-flags ( -- DWORD )
-    FILE_FLAG_OVERLAPPED ;
+M: windows-nt-io CreateFile-flags ( DWORD -- DWORD )
+    FILE_FLAG_OVERLAPPED bitor ;
 
 M: windows-nt-io FileArgs-overlapped ( port -- overlapped )
     make-overlapped ;
diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor
index ac0ede0e06..b0ec7f8436 100755
--- a/extra/io/windows/windows.factor
+++ b/extra/io/windows/windows.factor
@@ -23,7 +23,7 @@ TUPLE: win32-file handle ptr overlapped ;
 : <win32-duplex-stream> ( in out -- 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: add-completion io-backend ( port -- )
 
@@ -31,7 +31,8 @@ M: windows-io normalize-directory ( string -- string )
     "\\" ?tail drop "\\*" append ;
 
 : 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 -- )
     drop ;
@@ -40,24 +41,25 @@ M: win32-file close-handle ( handle -- )
     win32-file-handle CloseHandle drop ;
 
 ! 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 add-completion
     ] with-destructors ;
 
 : 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 )
-    normalize-pathname GENERIC_READ OPEN_EXISTING open-file 0 ;
+    GENERIC_READ OPEN_EXISTING 0 open-file 0 ;
 
 : 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 )
-    normalize-pathname GENERIC_WRITE OPEN_ALWAYS open-file ;
+    GENERIC_WRITE OPEN_ALWAYS 0 open-file ;
 
 : set-file-pointer ( handle length -- )
     dupd d>w/w <uint> FILE_BEGIN SetFilePointer