basis/io/backend/windows/windows.factor

   1 ! Copyright (C) 2004, 2008 Mackenzie Straight, Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien alien.c-types arrays destructors io io.backend
   4 io.buffers io.files io.ports io.binary io.timeouts system
   5 strings kernel math namespaces sequences windows.errors
   6 windows.kernel32 windows.shell32 windows.types windows.winsock
   7 splitting continuations math.bitwise accessors init sets assocs ;
   8 IN: io.backend.windows
   9
  10 : win32-handles ( -- assoc )
  11     \ win32-handles [ H{ } clone ] initialize-alien ;
  12
  13 TUPLE: win32-handle < identity-tuple handle disposed ;
  14
  15 M: win32-handle hashcode* handle>> hashcode* ;
  16
  17 : set-inherit ( handle ? -- )
  18     [ handle>> HANDLE_FLAG_INHERIT ] dip
  19     >BOOLEAN SetHandleInformation win32-error=0/f ;
  20
  21 : new-win32-handle ( handle class -- win32-handle )
  22     new swap >>handle
  23     dup f set-inherit
  24     dup win32-handles conjoin ;
  25
  26 : <win32-handle> ( handle -- win32-handle )
  27     win32-handle new-win32-handle ;
  28
  29 ERROR: disposing-twice ;
  30
  31 : unregister-handle ( handle -- )
  32     win32-handles delete-at*
  33     [ t >>disposed drop ] [ disposing-twice ] if ;
  34
  35 M: win32-handle dispose* ( handle -- )
  36     [ unregister-handle ] [ handle>> CloseHandle win32-error=0/f ] bi ;
  37
  38 TUPLE: win32-file < win32-handle ptr ;
  39
  40 : <win32-file> ( handle -- win32-file )
  41     win32-file new-win32-handle ;
  42
  43 M: win32-file dispose
  44     dup disposed>> [ drop ] [
  45         [ cancel-operation ] [ call-next-method ] bi
  46     ] if ;
  47
  48 HOOK: CreateFile-flags io-backend ( DWORD -- DWORD )
  49 HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f )
  50 HOOK: add-completion io-backend ( port -- )
  51
  52 : opened-file ( handle -- win32-file )
  53     dup invalid-handle?
  54     <win32-file> |dispose
  55     dup add-completion ;
  56
  57 : share-mode ( -- fixnum )
  58     {
  59         FILE_SHARE_READ
  60         FILE_SHARE_WRITE
  61         FILE_SHARE_DELETE
  62     } flags ; foldable
  63
  64 : default-security-attributes ( -- obj )
  65     "SECURITY_ATTRIBUTES" <c-object>
  66     "SECURITY_ATTRIBUTES" heap-size
  67     over set-SECURITY_ATTRIBUTES-nLength ;