]> gitweb.factorcode.org Git - factor.git/commitdiff
Fix conflict
authorU-SLAVA-DFB8FF805\Slava <Slava@slava-dfb8ff805.(none)>
Thu, 15 May 2008 06:44:23 +0000 (01:44 -0500)
committerU-SLAVA-DFB8FF805\Slava <Slava@slava-dfb8ff805.(none)>
Thu, 15 May 2008 06:44:23 +0000 (01:44 -0500)
1  2 
extra/io/windows/files/files.factor
extra/io/windows/windows.factor

Simple merge
index 5b205d0dca2898d125509866ad3ec30e65700f29,4f34153b31a8f0a6406b1e42c7f947f09755bc6d..05c55ab5fefd5b36e86e6d4fb64b41745fe54e47
@@@ -8,17 -8,19 +8,29 @@@ windows.shell32 windows.types windows.w
  continuations math.bitfields system accessors ;
  IN: io.windows
  
- TUPLE: win32-file handle ptr ;
 -M: windows destruct-socket closesocket drop ;
++TUPLE: win32-handle handle disposed ;
  
- C: <win32-file> win32-file
 -TUPLE: win32-file handle ptr ;
++: new-win32-handle ( handle class -- win32-handle )
++    new swap >>handle ;
 -C: <win32-file> win32-file
++: <win32-handle> ( handle -- win32-handle )
++    win32-handle new-win32-handle ;
++
++M: win32-handle dispose* ( handle -- )
++    handle>> CloseHandle drop ;
++
++TUPLE: win32-file handle ptr disposed ;
++
++: <win32-file> ( handle -- win32-file )
++    win32-file new-win32-handle ;
++
++M: win32-file init-handle ( handle -- )
++    drop ;
  
  HOOK: CreateFile-flags io-backend ( DWORD -- DWORD )
  HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f )
  HOOK: add-completion io-backend ( port -- )
  
--M: windows normalize-directory ( string -- string )
--    normalize-path "\\" ?tail drop "\\*" append ;
--
  : share-mode ( -- fixnum )
      {
          FILE_SHARE_READ
  : security-attributes-inherit ( -- obj )
      default-security-attributes
      TRUE over set-SECURITY_ATTRIBUTES-bInheritHandle ; foldable
--
--M: win32-file init-handle ( handle -- )
--    drop ;
--
--M: win32-file close-handle ( handle -- )
-     handle>> close-handle ;
 -    win32-file-handle close-handle ;
--
--M: alien close-handle ( handle -- )
--    CloseHandle drop ;
--
--! Clean up resources (open handle) if add-completion fails
--: open-file ( path access-mode create-mode flags -- handle )
--    [
--        >r >r share-mode security-attributes-inherit r> r>
--        CreateFile-flags f CreateFile
-         dup invalid-handle?
-         |close-handle
 -        dup invalid-handle? dup close-later
--        dup add-completion
--    ] with-destructors ;
--
--: open-pipe-r/w ( path -- handle )
--    { GENERIC_READ GENERIC_WRITE } flags
--    OPEN_EXISTING 0 open-file ;
--
--: open-read ( path -- handle length )
--    GENERIC_READ OPEN_EXISTING 0 open-file 0 ;
--
--: open-write ( path -- handle length )
--    GENERIC_WRITE CREATE_ALWAYS 0 open-file 0 ;
--
--: (open-append) ( path -- handle )
--    GENERIC_WRITE OPEN_ALWAYS 0 open-file ;
--
--: open-existing ( path -- handle )
--    { GENERIC_READ GENERIC_WRITE } flags
--    share-mode
--    f
--    OPEN_EXISTING
--    FILE_FLAG_BACKUP_SEMANTICS
--    f CreateFileW dup win32-error=0/f ;
--
--: maybe-create-file ( path -- handle ? )
--    #! return true if file was just created
--    { GENERIC_READ GENERIC_WRITE } flags
--    share-mode
--    f
--    OPEN_ALWAYS
--    0 CreateFile-flags
--    f CreateFileW dup win32-error=0/f
--    GetLastError ERROR_ALREADY_EXISTS = not ;
--
--: set-file-pointer ( handle length method -- )
--    >r dupd d>w/w <uint> r> SetFilePointer
--    INVALID_SET_FILE_POINTER = [
--        CloseHandle "SetFilePointer failed" throw
--    ] when drop ;
--
--HOOK: open-append os ( path -- handle length )
--
--TUPLE: FileArgs
--    hFile lpBuffer nNumberOfBytesToRead
--    lpNumberOfBytesRet lpOverlapped ;
--
--C: <FileArgs> FileArgs
--
--: make-FileArgs ( port -- <FileArgs> )
-     {
-         [ handle>> handle>> ]
-         [ buffer>> ]
-         [ buffer>> buffer-length ]
-         [ drop "DWORD" <c-object> ]
-         [ FileArgs-overlapped ]
-     } cleave <FileArgs> ;
 -    [ port-handle win32-file-handle ] keep
 -    [ buffer>> ] keep
 -    [
 -        buffer>> buffer-length
 -        "DWORD" <c-object>
 -    ] keep FileArgs-overlapped <FileArgs> ;
--
--: setup-read ( <FileArgs> -- hFile lpBuffer nNumberOfBytesToRead lpNumberOfBytesRead lpOverlapped )
-     {
-         [ hFile>> ]
-         [ lpBuffer>> buffer-end ]
-         [ lpBuffer>> buffer-capacity ]
-         [ lpNumberOfBytesRet>> ]
-         [ lpOverlapped>> ]
-     } cleave ;
 -    [ FileArgs-hFile ] keep
 -    [ FileArgs-lpBuffer buffer-end ] keep
 -    [ FileArgs-lpBuffer buffer-capacity ] keep
 -    [ FileArgs-lpNumberOfBytesRet ] keep
 -    FileArgs-lpOverlapped ;
--
--: setup-write ( <FileArgs> -- hFile lpBuffer nNumberOfBytesToWrite lpNumberOfBytesWritten lpOverlapped )
-     {
-         [ hFile>> ]
-         [ lpBuffer>> buffer@ ]
-         [ lpBuffer>> buffer-length ]
-         [ lpNumberOfBytesRet>> ]
-         [ lpOverlapped>> ]
-     } cleave ;
 -    [ FileArgs-hFile ] keep
 -    [ FileArgs-lpBuffer buffer@ ] keep
 -    [ FileArgs-lpBuffer buffer-length ] keep
 -    [ FileArgs-lpNumberOfBytesRet ] keep
 -    FileArgs-lpOverlapped ;
--
--M: windows (file-reader) ( path -- stream )
--    open-read <win32-file> <input-port> ;
--
--M: windows (file-writer) ( path -- stream )
--    open-write <win32-file> <output-port> ;
--
--M: windows (file-appender) ( path -- stream )
--    open-append <win32-file> <output-port> ;
--
--M: windows move-file ( from to -- )
--    [ normalize-path ] bi@ MoveFile win32-error=0/f ;
--
--M: windows delete-file ( path -- )
--    normalize-path DeleteFile win32-error=0/f ;
--
--M: windows copy-file ( from to -- )
--    dup parent-directory make-directories
--    [ normalize-path ] bi@ 0 CopyFile win32-error=0/f ;
--
--M: windows make-directory ( path -- )
--    normalize-path
--    f CreateDirectory win32-error=0/f ;
--
--M: windows delete-directory ( path -- )
--    normalize-path
--    RemoveDirectory win32-error=0/f ;
--
--HOOK: WSASocket-flags io-backend ( -- DWORD )
--
--TUPLE: win32-socket < win32-file overlapped ;
--
--: <win32-socket> ( handle overlapped -- win32-socket )
--    win32-socket new
--        swap >>overlapped
--        swap >>handle ;
--
--: open-socket ( family type -- socket )
--    0 f 0 WSASocket-flags WSASocket dup socket-error ;
--
--USE: windows.winsock
--: init-sockaddr ( port# addrspec -- sockaddr )
--    dup sockaddr-type <c-object>
--    [ swap protocol-family swap set-sockaddr-in-family ] keep
--    [ >r htons r> set-sockaddr-in-port ] keep ;
--
--: server-sockaddr ( port# addrspec -- sockaddr )
--    init-sockaddr
--    [ INADDR_ANY swap set-sockaddr-in-addr ] keep ;
--
--: bind-socket ( socket sockaddr addrspec -- )
--    [ server-sockaddr ] keep
--    sockaddr-type heap-size bind socket-error ;
--
--TUPLE: socket-destructor alien ;
--
--C: <socket-destructor> socket-destructor
 -
 -HOOK: destruct-socket io-backend ( obj -- )
--
--M: socket-destructor dispose ( obj -- )
-     alien>> closesocket drop ;
 -    alien>> destruct-socket ;
--
- : |close-socket ( handle -- handle )
-     dup <socket-destructor> <only-once> |dispose drop ;
 -: close-socket-later ( handle -- )
 -    <socket-destructor> <only-once> |dispose drop ;
--
--: server-fd ( addrspec type -- fd )
-     >r dup protocol-family r> open-socket |close-socket
 -    >r dup protocol-family r> open-socket
 -        dup close-socket-later
--    dup rot make-sockaddr/size bind socket-error ;
--
--USE: namespaces
--
--! http://support.microsoft.com/kb/127144
--! NOTE: Possibly tweak this because of SYN flood attacks
--: listen-backlog ( -- n ) HEX: 7fffffff ; inline
--
--: listen-on-socket ( socket -- )
--    listen-backlog listen winsock-return-check ;
--
--M: win32-socket dispose ( stream -- )
-     handle>> closesocket drop ;
 -    win32-file-handle closesocket drop ;
--
--M: windows addrinfo-error ( n -- )
--    winsock-return-check ;
--
--: tcp-socket ( addrspec -- socket )
--    protocol-family SOCK_STREAM open-socket ;