2008-01-31 01:52:06 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2004, 2008 Mackenzie Straight, Doug Coleman.
							 | 
						
					
						
							
								
									
										
										
										
											2007-11-13 01:10:26 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							
								
									
										
										
										
											2009-01-27 05:29:44 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								USING: alien alien.c-types arrays destructors io io.backend
							 | 
						
					
						
							
								
									
										
										
										
											2009-04-30 10:36:25 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								io.buffers io.files io.ports io.binary io.timeouts system
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								windows.errors strings kernel math namespaces sequences
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								windows.errors windows.kernel32 windows.shell32 windows.types
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								windows.winsock splitting continuations math.bitwise accessors ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-14 21:03:00 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: io.backend.windows
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-27 20:26:36 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: set-inherit ( handle ? -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-02 04:10:13 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ HANDLE_FLAG_INHERIT ] dip
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    >BOOLEAN SetHandleInformation win32-error=0/f ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-27 20:26:36 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-15 02:44:23 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								TUPLE: win32-handle handle disposed ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-15 02:44:23 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: new-win32-handle ( handle class -- win32-handle )
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-27 20:26:36 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    new swap [ >>handle ] [ f set-inherit ] bi ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-15 02:44:23 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: <win32-handle> ( handle -- win32-handle )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    win32-handle new-win32-handle ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: win32-handle dispose* ( handle -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    handle>> CloseHandle drop ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-15 06:20:42 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								TUPLE: win32-file < win32-handle ptr ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-15 02:44:23 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: <win32-file> ( handle -- win32-file )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    win32-file new-win32-handle ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-22 01:41:18 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: win32-file dispose
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    dup disposed>> [ drop ] [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        [ cancel-operation ] [ call-next-method ] bi
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] if ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-20 22:59:29 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2007-11-23 20:17:40 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								HOOK: CreateFile-flags io-backend ( DWORD -- DWORD )
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								HOOK: add-completion io-backend ( port -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-15 06:20:42 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: opened-file ( handle -- win32-file )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    dup invalid-handle?
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    <win32-file> |dispose
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    dup add-completion ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: share-mode ( -- fixnum )
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-02 14:29:09 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    {
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        FILE_SHARE_READ
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        FILE_SHARE_WRITE
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        FILE_SHARE_DELETE
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    } flags ; foldable
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-25 00:49:03 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: default-security-attributes ( -- obj )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    "SECURITY_ATTRIBUTES" <c-object>
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-04 13:02:25 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    "SECURITY_ATTRIBUTES" heap-size
							 | 
						
					
						
							
								
									
										
										
										
											2009-04-30 10:36:25 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    over set-SECURITY_ATTRIBUTES-nLength ;
							 |