Fix launcher and windows bootstrap

Fix native io on Vista
Add missing use
release
U-C4\Administrator 2007-09-21 17:00:47 -05:00
parent 1ba96d255b
commit 545e58873e
4 changed files with 52 additions and 53 deletions

View File

@ -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."

View File

@ -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 ;

View File

@ -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 ;

View File

@ -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