parent
1ba96d255b
commit
545e58873e
|
@ -1,6 +1,7 @@
|
||||||
USING: alien alien.c-types destructors io.windows libc
|
USING: alien alien.c-types destructors io.windows libc
|
||||||
io.nonblocking io.streams.duplex windows.types math
|
io.nonblocking io.streams.duplex windows.types math
|
||||||
windows.kernel32 windows namespaces io.launcher kernel ;
|
windows.kernel32 windows namespaces io.launcher kernel
|
||||||
|
io.windows.nt.backend ;
|
||||||
IN: io.windows.launcher
|
IN: io.windows.launcher
|
||||||
|
|
||||||
! From MSDN: "Handles in PROCESS_INFORMATION must be closed with CloseHandle when they are no longer needed."
|
! From MSDN: "Handles in PROCESS_INFORMATION must be closed with CloseHandle when they are no longer needed."
|
||||||
|
|
|
@ -1,9 +1,35 @@
|
||||||
USING: alien alien.c-types arrays assocs combinators continuations
|
USING: alien alien.c-types arrays assocs combinators continuations
|
||||||
destructors io io.backend io.nonblocking io.windows io.windows.nt libc
|
destructors io io.backend io.nonblocking io.windows libc
|
||||||
kernel math namespaces sequences threads tuples.lib windows
|
kernel math namespaces sequences threads tuples.lib windows
|
||||||
windows.errors windows.kernel32 prettyprint ;
|
windows.errors windows.kernel32 prettyprint ;
|
||||||
IN: io.windows.nt.backend
|
IN: io.windows.nt.backend
|
||||||
|
|
||||||
|
: unicode-prefix ( -- seq )
|
||||||
|
"\\\\?\\" ; inline
|
||||||
|
|
||||||
|
M: windows-nt-io normalize-pathname ( string -- string )
|
||||||
|
dup string? [ "pathname must be a string" throw ] unless
|
||||||
|
"/" split "\\" join
|
||||||
|
{
|
||||||
|
! empty
|
||||||
|
{ [ dup empty? ] [ "empty path" throw ] }
|
||||||
|
! .\\foo
|
||||||
|
{ [ dup ".\\" head? ] [
|
||||||
|
>r unicode-prefix cwd r> 1 tail 3append
|
||||||
|
] }
|
||||||
|
! c:\\
|
||||||
|
{ [ dup 1 tail ":" head? ] [ >r unicode-prefix r> append ] }
|
||||||
|
! \\\\?\\c:\\foo
|
||||||
|
{ [ dup unicode-prefix head? ] [ ] }
|
||||||
|
! foo.txt ..\\foo.txt
|
||||||
|
{ [ t ] [
|
||||||
|
[
|
||||||
|
unicode-prefix % cwd %
|
||||||
|
dup first CHAR: \\ = [ CHAR: \\ , ] unless %
|
||||||
|
] "" make
|
||||||
|
] }
|
||||||
|
} cond [ "/\\." member? ] rtrim ;
|
||||||
|
|
||||||
SYMBOL: io-hash
|
SYMBOL: io-hash
|
||||||
|
|
||||||
TUPLE: io-callback port continuation ;
|
TUPLE: io-callback port continuation ;
|
||||||
|
@ -63,9 +89,9 @@ C: <GetQueuedCompletionStatusParams> GetQueuedCompletionStatusParams
|
||||||
GetQueuedCompletionStatus
|
GetQueuedCompletionStatus
|
||||||
] keep swap ;
|
] keep swap ;
|
||||||
|
|
||||||
: lookup-callback ( GetQueuedCompletion-args -- callback ? )
|
: lookup-callback ( GetQueuedCompletion-args -- callback )
|
||||||
GetQueuedCompletionStatusParams-lpOverlapped* *void*
|
GetQueuedCompletionStatusParams-lpOverlapped* *void*
|
||||||
\ io-hash get-global delete-at* ;
|
\ io-hash get-global delete-at drop ;
|
||||||
|
|
||||||
: wait-for-io ( timeout -- continuation/f )
|
: wait-for-io ( timeout -- continuation/f )
|
||||||
wait-for-overlapped
|
wait-for-overlapped
|
||||||
|
@ -73,15 +99,18 @@ C: <GetQueuedCompletionStatusParams> GetQueuedCompletionStatusParams
|
||||||
GetLastError dup (expected-io-error?) [
|
GetLastError dup (expected-io-error?) [
|
||||||
2drop f
|
2drop f
|
||||||
] [
|
] [
|
||||||
(win32-error-string) swap lookup-callback [
|
dup ERROR_HANDLE_EOF = [
|
||||||
|
drop lookup-callback [
|
||||||
|
io-callback-port t swap set-port-eof?
|
||||||
|
] keep io-callback-continuation
|
||||||
|
] [
|
||||||
|
(win32-error-string) swap lookup-callback
|
||||||
[ io-callback-port set-port-error ] keep
|
[ io-callback-port set-port-error ] keep
|
||||||
io-callback-continuation
|
io-callback-continuation
|
||||||
] [
|
|
||||||
drop "No callback found" 2array throw
|
|
||||||
] if
|
] if
|
||||||
] if
|
] if
|
||||||
] [
|
] [
|
||||||
lookup-callback [ io-callback-continuation ] when
|
lookup-callback io-callback-continuation
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: maybe-expire ( io-callbck -- )
|
: maybe-expire ( io-callbck -- )
|
||||||
|
@ -99,3 +128,12 @@ M: windows-nt-io io-multiplex ( ms -- )
|
||||||
cancel-timedout
|
cancel-timedout
|
||||||
[ wait-for-io ] [ global [ "error: " write . flush ] bind drop f ] recover
|
[ wait-for-io ] [ global [ "error: " write . flush ] bind drop f ] recover
|
||||||
[ schedule-thread ] when* ;
|
[ schedule-thread ] when* ;
|
||||||
|
|
||||||
|
M: windows-nt-io init-io ( -- )
|
||||||
|
#! Should only be called on startup. Calling this at any
|
||||||
|
#! other time can have unintended consequences.
|
||||||
|
global [
|
||||||
|
master-completion-port \ master-completion-port set
|
||||||
|
H{ } clone \ io-hash set
|
||||||
|
init-winsock
|
||||||
|
] bind ;
|
||||||
|
|
|
@ -1,51 +1,10 @@
|
||||||
! Copyright (C) 2004, 2007 Mackenzie Straight, Doug Coleman.
|
! Copyright (C) 2004, 2007 Mackenzie Straight, Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien alien.c-types assocs byte-arrays combinators
|
USE: io.windows
|
||||||
io.backend io.files io.nonblocking io.windows
|
|
||||||
kernel libc math namespaces qualified sequences
|
|
||||||
splitting strings threads windows windows.errors windows.winsock
|
|
||||||
windows.kernel32 ;
|
|
||||||
QUALIFIED: windows.winsock
|
|
||||||
IN: io.windows.nt
|
|
||||||
|
|
||||||
: unicode-prefix ( -- seq )
|
|
||||||
"\\\\?\\" ; inline
|
|
||||||
|
|
||||||
M: windows-nt-io normalize-pathname ( string -- string )
|
|
||||||
dup string? [ "pathname must be a string" throw ] unless
|
|
||||||
"/" split "\\" join
|
|
||||||
{
|
|
||||||
! empty
|
|
||||||
{ [ dup empty? ] [ "empty path" throw ] }
|
|
||||||
! .\\foo
|
|
||||||
{ [ dup ".\\" head? ] [
|
|
||||||
>r unicode-prefix cwd r> 1 tail 3append
|
|
||||||
] }
|
|
||||||
! c:\\
|
|
||||||
{ [ dup 1 tail ":" head? ] [ >r unicode-prefix r> append ] }
|
|
||||||
! \\\\?\\c:\\foo
|
|
||||||
{ [ dup unicode-prefix head? ] [ ] }
|
|
||||||
! foo.txt ..\\foo.txt
|
|
||||||
{ [ t ] [
|
|
||||||
[
|
|
||||||
unicode-prefix % cwd %
|
|
||||||
dup first CHAR: \\ = [ CHAR: \\ , ] unless %
|
|
||||||
] "" make
|
|
||||||
] }
|
|
||||||
} cond [ "/\\." member? ] rtrim ;
|
|
||||||
|
|
||||||
USE: io.windows.nt.backend
|
USE: io.windows.nt.backend
|
||||||
USE: io.windows.nt.files
|
USE: io.windows.nt.files
|
||||||
USE: io.windows.nt.sockets
|
USE: io.windows.nt.sockets
|
||||||
|
USE: io.backend
|
||||||
|
USE: namespaces
|
||||||
|
|
||||||
T{ windows-nt-io } io-backend set-global
|
T{ windows-nt-io } io-backend set-global
|
||||||
|
|
||||||
M: windows-nt-io init-io ( -- )
|
|
||||||
#! Should only be called on startup. Calling this at any
|
|
||||||
#! other time can have unintended consequences.
|
|
||||||
global [
|
|
||||||
master-completion-port \ master-completion-port set
|
|
||||||
H{ } clone \ io-hash set
|
|
||||||
init-winsock
|
|
||||||
] bind ;
|
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,8 @@
|
||||||
! Copyright (C) 2005, 2006 Doug Coleman.
|
! Copyright (C) 2005, 2006 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien alien.c-types alien.syntax parser namespaces kernel
|
USING: alien alien.c-types alien.syntax parser namespaces kernel
|
||||||
math windows.types windows.types init assocs sequences opengl.gl ;
|
math windows.types windows.types init assocs sequences opengl.gl
|
||||||
|
libc ;
|
||||||
IN: windows.opengl32
|
IN: windows.opengl32
|
||||||
|
|
||||||
! PIXELFORMATDESCRIPTOR flags
|
! PIXELFORMATDESCRIPTOR flags
|
||||||
|
|
Loading…
Reference in New Issue