io.launcher updates and destructors cleanup

core/system/system-tests.factor

@@ -3,3 +3,4 @@ IN: temporary
 
 [ t ] [ cell integer? ] unit-test
 [ t ] [ bootstrap-cell integer? ] unit-test
+[ ] [ os-env . ] unit-test

extra/destructors/destructors-tests.factor

@@ -3,22 +3,20 @@ IN: temporary
 
 TUPLE: dummy-obj destroyed? ;
 
-TUPLE: dummy-destructor ;
+: <dummy-obj> dummy-obj construct-empty ;
 
-: <dummy-destructor> ( obj ? -- newobj )
+TUPLE: dummy-destructor obj ;
-    <destructor> dummy-destructor construct-delegate ;
 
-M: dummy-destructor (destruct) ( obj -- )
+C: <dummy-destructor> dummy-destructor
-    destructor-obj t swap set-dummy-obj-destroyed? ;
 
-: <dummy-obj>
+M: dummy-destructor destruct ( obj -- )
-    \ dummy-obj construct-empty ;
+    dummy-destructor-obj t swap set-dummy-obj-destroyed? ;
 
 : destroy-always
-    t <dummy-destructor> push-destructor ;
+    <dummy-destructor> add-always-destructor ;
 
 : destroy-later
-    f <dummy-destructor> push-destructor ;
+    <dummy-destructor> add-error-destructor ;
 
 [ t ] [
     [

extra/destructors/destructors.factor

@@ -4,124 +4,86 @@ USING: continuations io.backend libc kernel namespaces
 sequences system vectors ;
 IN: destructors
 
-SYMBOL: destructors
+GENERIC: destruct ( obj -- )
 
-TUPLE: destructor obj always? destroyed? ;
+SYMBOL: error-destructors
+SYMBOL: always-destructors
 
-: <destructor> ( obj always? -- newobj )
+TUPLE: destructor object destroyed? ;
-    {
-        set-destructor-obj
-        set-destructor-always?
-    } destructor construct ;
 
-: push-destructor ( obj -- )
+M: destructor destruct
-    destructors [ ?push ] change ;
-
-GENERIC: (destruct) ( obj -- )
-
-: destruct ( obj -- )
     dup destructor-destroyed? [
         drop
     ] [
-        [ (destruct) t ] keep set-destructor-destroyed?
+        dup destructor-object destruct
+        t swap set-destructor-destroyed?
     ] if ;
 
-: destruct-always ( destructor -- )
+: <destructor> ( obj -- newobj )
-    dup destructor-always? [
+    f destructor construct-boa ;
-        destruct
+
-    ] [
+: add-error-destructor ( obj -- )
-        drop
+    <destructor> error-destructors get push ;
-    ] if ;
+
+: add-always-destructor ( obj -- )
+    <destructor> always-destructors get push ;
+
+: do-always-destructors ( -- )
+    always-destructors get [ destruct ] each ;
+
+: do-error-destructors ( -- )
+    error-destructors get [ destruct ] each ;
 
 : with-destructors ( quot -- )
     [
-        [ call ]
+        V{ } clone always-destructors set
-        [ destructors get [ destruct-always ] each ]
+        V{ } clone error-destructors set
-        [ destructors get [ destruct ] each ] cleanup
+        [ do-always-destructors ]
+        [ do-error-destructors ] cleanup
     ] with-scope ; inline
 
+! Memory allocations
+TUPLE: memory-destructor alien ;
 
+C: <memory-destructor> memory-destructor
 
-TUPLE: memory-destructor ;
+M: memory-destructor destruct ( obj -- )
-
+    memory-destructor-alien free ;
-: <memory-destructor> ( obj ? -- newobj )
-    <destructor> memory-destructor construct-delegate ;
-
-TUPLE: handle-destructor ;
-
-: <handle-destructor> ( obj ? -- newobj )
-    <destructor> handle-destructor construct-delegate ;
-
-TUPLE: socket-destructor ;
-
-: <socket-destructor> ( obj ? -- newobj )
-    <destructor> socket-destructor construct-delegate ;
-
-M: memory-destructor (destruct) ( obj -- )
-    destructor-obj free ;
-
-HOOK: (handle-destructor) io-backend ( obj -- )
-HOOK: (socket-destructor) io-backend ( obj -- )
-
-M: handle-destructor (destruct) ( obj -- ) (handle-destructor) ;
-M: socket-destructor (destruct) ( obj -- ) (socket-destructor) ;
 
 : free-always ( alien -- )
-    t <memory-destructor> push-destructor ;
+    <memory-destructor> add-always-destructor ;
 
 : free-later ( alien -- )
-    f <memory-destructor> push-destructor ;
+    <memory-destructor> add-error-destructor ;
+
+! Handles
+TUPLE: handle-destructor alien ;
+
+C: <handle-destructor> handle-destructor
+
+HOOK: destruct-handle io-backend ( obj -- )
+
+M: handle-destructor destruct ( obj -- )
+    handle-destructor-alien destruct-handle ;
 
 : close-always ( handle -- )
-    t <handle-destructor> push-destructor ;
+    <handle-destructor> add-always-destructor ;
 
 : close-later ( handle -- )
-    f <handle-destructor> push-destructor ;
+    <handle-destructor> add-error-destructor ;
+
+! Sockets
+TUPLE: socket-destructor alien ;
+
+C: <socket-destructor> socket-destructor
+
+HOOK: destruct-socket io-backend ( obj -- )
+
+M: socket-destructor destruct ( obj -- )
+    socket-destructor-alien destruct-socket ;
 
 : close-socket-always ( handle -- )
-    t <socket-destructor> push-destructor ;
+    <socket-destructor> add-always-destructor ;
 
 : close-socket-later ( handle -- )
-    f <socket-destructor> push-destructor ;
+    <socket-destructor> add-error-destructor ;
-
-
-! : add-destructor ( word quot -- )
-    ! >quotation
-    ! "slot-destructor" set-word-prop ;
-
-! MACRO: destruct ( class -- )
-    ! "slots" word-prop
-    ! [ slot-spec-reader "slot-destructor" word-prop ] subset
-    ! [
-        ! [
-            ! slot-spec-reader [ 1quotation ] keep
-            ! "slot-destructor" word-prop [ when* ] curry compose
-            ! [ keep f swap ] curry
-        ! ] keep slot-spec-writer 1quotation compose
-        ! dupd curry
-    ! ] map concat nip ;
-
-! : DTOR: scan-word parse-definition add-destructor ; parsing
-
-! : free-destructor ( word -- )
-    ! [ free ] add-destructor ;
-
-! : stream-destructor ( word -- )
-    ! [ stream-close ] add-destructor ;
-
-
-! TUPLE: foo a b c ;
-! C: <foo> foo
-
-! DTOR: foo-a "lol, a destructor" print drop ;
-! DTOR: foo-b "lol, b destructor" print drop ;
-
-! TUPLE: stuff mem stream ;
-! : <stuff>
-    ! 100 malloc
-    ! "license.txt" resource-path <file-reader>
-    ! \ stuff construct-boa ;
-
-! DTOR: stuff-mem free-destructor ;
-! DTOR: stuff-stream stream-destructor ;
-

extra/io/launcher/launcher.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.backend system kernel namespaces strings hashtables
-sequences assocs ;
+sequences assocs combinators ;
 IN: io.launcher
 
 SYMBOL: +command+
@@ -26,6 +26,18 @@ SYMBOL: append-environment
 : with-descriptor ( desc quot -- )
     default-descriptor [ >r clone r> bind ] bind ; inline
 
+: pass-environment? ( -- ? )
+    +environment+ get assoc-empty? not
+    +environment-mode+ get replace-environment eq? or ;
+
+: get-environment ( -- env )
+    +environment+ get
+    +environment-mode+ get {
+        { prepend-environment [ os-envs union ] }
+        { append-environment [ os-envs swap union ] }
+        { replace-environment [ ] }
+    } case ;
+
 GENERIC: >descriptor ( obj -- desc )
 
 M: string >descriptor +command+ associate ;

extra/io/unix/launcher/launcher.factor

@@ -15,19 +15,6 @@ USE: unix
     +command+ get
     [ "/bin/sh" "-c" rot 3array ] [ +arguments+ get ] if* ;
 
-: execve? ( -- ? )
-    +environment+ get assoc-empty?
-    [ +environment-mode+ get replace-environment eq? ]
-    [ t ] if ;
-
-: get-environment ( -- env )
-    +environment+ get
-    +environment-mode+ get {
-        { prepend-environment [ os-envs union ] }
-        { append-environment [ os-envs swap union ] }
-        { replace-environment [ ] }
-    } case ;
-
 : >null-term-array f add >c-void*-array ;
 
 : prepare-execvp ( -- cmd args )
@@ -47,7 +34,7 @@ USE: unix
 
 : (spawn-process) ( -- )
     [
-        execve? [
+        pass-environment? [
             prepare-execve execve
         ] [
             prepare-execvp execvp

extra/io/windows/launcher/launcher.factor

@@ -1,35 +1,37 @@
 USING: alien alien.c-types arrays continuations
-destructors io.windows libc
+destructors io io.windows libc
 io.nonblocking io.streams.duplex windows.types math
 windows.kernel32 windows namespaces io.launcher kernel
-sequences io.windows.nt.backend windows.errors ;
+sequences io.windows.nt.backend windows.errors assocs ;
-USE: io
-USE: prettyprint
 IN: io.windows.launcher
 
 ! From MSDN: "Handles in PROCESS_INFORMATION must be closed with CloseHandle when they are no longer needed."
 
 TUPLE: CreateProcess-args
-                            lpApplicationName
+       lpApplicationName
-                            lpCommandLine
+       lpCommandLine
-                            lpProcessAttributes
+       lpProcessAttributes
-                            lpThreadAttributes
+       lpThreadAttributes
-                            bInheritHandles
+       bInheritHandles
-                            dwCreateFlags
+       dwCreateFlags
-                            lpEnvironment
+       lpEnvironment
-                            lpCurrentDirectory
+       lpCurrentDirectory
-                            lpStartupInfo
+       lpStartupInfo
-                            lpProcessInformation
+       lpProcessInformation
-                            stdout-pipe stdin-pipe ;
+       stdout-pipe stdin-pipe ;
 
-: default-CreateProcess-args ( lpCommandLine -- obj )
+: dispose-CreateProcess-args ( args -- )
+    CreateProcess-args-lpProcessInformation dup
+    PROCESS_INFORMATION-hProcess [ CloseHandle drop ] when*
+    PROCESS_INFORMATION-hThread [ CloseHandle drop ] when* ;
+
+: default-CreateProcess-args ( -- obj )
     0
     0
     "STARTUPINFO" <c-object>
     "STARTUPINFO" heap-size over set-STARTUPINFO-cb
     "PROCESS_INFORMATION" <c-object>
     {
-        set-CreateProcess-args-lpCommandLine
         set-CreateProcess-args-bInheritHandles
         set-CreateProcess-args-dwCreateFlags
         set-CreateProcess-args-lpStartupInfo
@@ -50,130 +52,164 @@ TUPLE: CreateProcess-args
         CreateProcess-args-lpProcessInformation
     } get-slots CreateProcess win32-error=0/f ;
 
-M: windows-io run-process ( string -- )
+: fill-lpCommandLine
-    default-CreateProcess-args
+    +command+ get [
-    call-CreateProcess ;
+        [
+            +arguments+ get [ CHAR: \s , ] [
+                CHAR: " ,
+                [ dup CHAR: " = [ CHAR: \\ , ] when , ] each
+                CHAR: " ,
+            ] interleave
+        ] "" make
+    ] unless* over set-CreateProcess-args-lpCommandLine ;
 
-M: windows-io run-detached ( string -- )
+: fill-dwCreateFlags
-    default-CreateProcess-args
+    CREATE_UNICODE_ENVIRONMENT
-    DETACHED_PROCESS over set-CreateProcess-args-dwCreateFlags
+    +detached+ get [ DETACHED_PROCESS bitor ] when
-    call-CreateProcess ;
+    over set-CreateProcess-args-dwCreateFlags ;
 
-: default-security-attributes ( -- obj )
+: fill-lpEnvironment
-    "SECURITY_ATTRIBUTES" <c-object>
+    pass-environment? [
-    "SECURITY_ATTRIBUTES" heap-size over set-SECURITY_ATTRIBUTES-nLength ;
+        [
+            get-environment
+            [ swap % "=" % % "\0" % ] assoc-each
+            "\0" %
+        ] "" make >c-ushort-array
+        over set-CreateProcess-args-lpEnvironment
+    ] when ;
 
-: security-attributes-inherit ( -- obj )
+: wait-for-process ( args -- )
-    default-security-attributes
+    CreateProcess-args-lpProcessInformation
-    TRUE over set-SECURITY_ATTRIBUTES-bInheritHandle ;
+    PROCESS_INFORMATION-hProcess INFINITE
+    WaitForSingleObject drop ;
 
-: set-inherit ( handle ? -- )
+M: windows-io run-process* ( desc -- )
-    >r HANDLE_FLAG_INHERIT r> >BOOLEAN SetHandleInformation win32-error=0/f ;
-
-! http://msdn2.microsoft.com/en-us/library/ms682499.aspx
-
-TUPLE: pipe hRead hWrite ;
-
-C: <pipe> pipe
-
-: factor-pipe-name
-    "\\\\.\\pipe\\Factor" ;
-
-: create-named-pipe ( str -- handle )
-    PIPE_ACCESS_DUPLEX FILE_FLAG_OVERLAPPED bitor
-    PIPE_TYPE_BYTE PIPE_READMODE_BYTE PIPE_NOWAIT bitor bitor
-    PIPE_UNLIMITED_INSTANCES
-    default-buffer-size get
-    default-buffer-size get
-    0
-    security-attributes-inherit
-    CreateNamedPipe dup invalid-handle? ;
-
-: ERROR_PIPE_CONNECT 535 ; inline
-
-: pipe-connect-error? ( n -- ? )
-    ERROR_SUCCESS ERROR_PIPE_CONNECT 2array member? not ;
-
-! clear "ls" <process-stream> contents
-M: windows-nt-io <process-stream> ( command -- stream )
     [
-
-    break
         default-CreateProcess-args
-        TRUE over set-CreateProcess-args-bInheritHandles
+        fill-lpCommandLine
+        fill-dwCreateFlags
+        fill-lpEnvironment
+        dup call-CreateProcess
+        +detached+ get [ dup wait-for-process ] unless
+        dispose-CreateProcess-args
+    ] with-descriptor ;
 
-        dup CreateProcess-args-lpStartupInfo
+! : default-security-attributes ( -- obj )
-        STARTF_USESTDHANDLES over set-STARTUPINFO-dwFlags
+!     "SECURITY_ATTRIBUTES" <c-object>
-
+!     "SECURITY_ATTRIBUTES" heap-size over set-SECURITY_ATTRIBUTES-nLength ;
-        factor-pipe-name create-named-pipe
+!
-        global [ "Named pipe: " write dup . ] bind
+! : security-attributes-inherit ( -- obj )
-        dup t set-inherit
+!     default-security-attributes
-        [ add-completion ] keep
+!     TRUE over set-SECURITY_ATTRIBUTES-bInheritHandle ;
- 
+!
-        ! CreateFile
+! : set-inherit ( handle ? -- )
-        ! factor-pipe-name open-pipe-r/w
+!     >r HANDLE_FLAG_INHERIT r> >BOOLEAN SetHandleInformation win32-error=0/f ;
-        factor-pipe-name GENERIC_READ GENERIC_WRITE bitor
+!
-        0 f OPEN_EXISTING FILE_FLAG_OVERLAPPED f
+! ! http://msdn2.microsoft.com/en-us/library/ms682499.aspx
-        CreateFile
+!
-        global [ "Created File: " write dup . ] bind
+! TUPLE: pipe hRead hWrite ;
-        dup invalid-handle? dup close-later
+!
-        dup add-completion
+! C: <pipe> pipe
-
+!
-        swap (make-overlapped) ConnectNamedPipe zero? [
+! : factor-pipe-name
-            GetLastError pipe-connect-error? [
+!     "\\\\.\\pipe\\Factor" ;
-                win32-error-string throw
+!
-            ] when
+! : create-named-pipe ( str -- handle )
-        ] when
+!     PIPE_ACCESS_DUPLEX FILE_FLAG_OVERLAPPED bitor
-        dup t set-inherit
+!     PIPE_TYPE_BYTE PIPE_READMODE_BYTE PIPE_NOWAIT bitor bitor
-
+!     PIPE_UNLIMITED_INSTANCES
-        ! ERROR_PIPE_CONNECTED
+!     default-buffer-size get
-        [ pick set-CreateProcess-args-stdin-pipe ] keep
+!     default-buffer-size get
-        global [ "Setting the stdios to: " write dup . ] bind
+!     0
-        [ over set-STARTUPINFO-hStdOutput ] keep
+!     security-attributes-inherit
-        [ over set-STARTUPINFO-hStdInput ] keep
+!     CreateNamedPipe dup invalid-handle? ;
-        swap set-STARTUPINFO-hStdError
+!
+! : ERROR_PIPE_CONNECT 535 ; inline
+!
+! : pipe-connect-error? ( n -- ? )
+!     ERROR_SUCCESS ERROR_PIPE_CONNECT 2array member? not ;
+!
+! clear "ls" <process-stream> contents
+! M: windows-nt-io <process-stream> ( command -- stream )
+!     [
+!         [
+!             default-CreateProcess-args
+!             fill-lpCommandLine
+!             TRUE over set-CreateProcess-args-bInheritHandles
+!
+!             dup CreateProcess-args-lpStartupInfo
+!             STARTF_USESTDHANDLES over set-STARTUPINFO-dwFlags
+!
+!             factor-pipe-name create-named-pipe
+!             global [ "Named pipe: " write dup . ] bind
+!             dup t set-inherit
+!             [ add-completion ] keep
+!
+!             ! CreateFile
+!             ! factor-pipe-name open-pipe-r/w
+!             factor-pipe-name GENERIC_READ GENERIC_WRITE bitor
+!             0 f OPEN_EXISTING FILE_FLAG_OVERLAPPED f
+!             CreateFile
+!             global [ "Created File: " write dup . ] bind
+!             dup invalid-handle? dup close-later
+!             dup add-completion
+!
+!             swap (make-overlapped) ConnectNamedPipe zero? [
+!                 GetLastError pipe-connect-error? [
+!                     win32-error-string throw
+!                 ] when
+!             ] when
+!             dup t set-inherit
+!
+!             ! ERROR_PIPE_CONNECTED
+!             [ pick set-CreateProcess-args-stdin-pipe ] keep
+!             global [ "Setting the stdios to: " write dup . ] bind
+!             [ over set-STARTUPINFO-hStdOutput ] keep
+!             [ over set-STARTUPINFO-hStdInput ] keep
+!             swap set-STARTUPINFO-hStdError
+!             !
+!             [ call-CreateProcess ] keep
+!             [ CreateProcess-args-stdin-pipe f <win32-file> dup handle>duplex-stream ] keep
+!             drop ! TODO: close handles instead of drop
+!         ] with-destructors
+!     ] with-descriptor ;
+!
+! : create-pipe ( -- pipe )
+!     "HANDLE" <c-object>
+!     "HANDLE" <c-object>
+!     [
+!         security-attributes-inherit
+!         0
+!         CreatePipe win32-error=0/f
+!     ] 2keep
+!     [ *void* dup close-later ] 2apply <pipe> ;
+!
+! M: windows-ce-io process-stream*
+!     [
+!         default-CreateProcess-args
+!         TRUE over set-CreateProcess-args-bInheritHandles
+!
+!         create-pipe  ! for child's STDOUT
+!         dup pipe-hRead f set-inherit
+!         over set-CreateProcess-args-stdout-pipe
+!
+!         create-pipe  ! for child's STDIN
+!         dup pipe-hWrite f set-inherit
+!         over set-CreateProcess-args-stdin-pipe
+!
+!         dup CreateProcess-args-lpStartupInfo
+!         STARTF_USESTDHANDLES over set-STARTUPINFO-dwFlags
+!
+!         over CreateProcess-args-stdout-pipe
+!             pipe-hWrite over set-STARTUPINFO-hStdOutput
+!         over CreateProcess-args-stdout-pipe
+!             pipe-hWrite over set-STARTUPINFO-hStdError
+!         over CreateProcess-args-stdin-pipe
+!             pipe-hRead swap set-STARTUPINFO-hStdInput
+!
+!         [ call-CreateProcess ] keep
+!         [ CreateProcess-args-stdin-pipe pipe-hRead f <win32-file> <reader> ] keep
+!         [ CreateProcess-args-stdout-pipe pipe-hWrite f <win32-file> <writer> <duplex-stream> ] keep
+!         drop ! TODO: close handles instead of drop
+!     ] with-destructors ;
 !
-        [ call-CreateProcess ] keep
-        [ CreateProcess-args-stdin-pipe f <win32-file> dup handle>duplex-stream ] keep
-        drop ! TODO: close handles instead of drop
-    ] with-destructors ;
-
-: create-pipe ( -- pipe )
-    "HANDLE" <c-object>
-    "HANDLE" <c-object>
-    [
-        security-attributes-inherit
-        0
-        CreatePipe win32-error=0/f
-    ] 2keep
-    [ *void* dup close-later ] 2apply <pipe> ;
-
-M: windows-ce-io <process-stream>
-    [
-        default-CreateProcess-args
-        TRUE over set-CreateProcess-args-bInheritHandles
-
-        create-pipe  ! for child's STDOUT
-        dup pipe-hRead f set-inherit
-        over set-CreateProcess-args-stdout-pipe
-
-        create-pipe  ! for child's STDIN
-        dup pipe-hWrite f set-inherit
-        over set-CreateProcess-args-stdin-pipe
-
-        dup CreateProcess-args-lpStartupInfo
-        STARTF_USESTDHANDLES over set-STARTUPINFO-dwFlags
-
-        over CreateProcess-args-stdout-pipe
-            pipe-hWrite over set-STARTUPINFO-hStdOutput
-        over CreateProcess-args-stdout-pipe
-            pipe-hWrite over set-STARTUPINFO-hStdError
-        over CreateProcess-args-stdin-pipe
-            pipe-hRead swap set-STARTUPINFO-hStdInput
-
-        [ call-CreateProcess ] keep
-        [ CreateProcess-args-stdin-pipe pipe-hRead f <win32-file> <reader> ] keep
-        [ CreateProcess-args-stdout-pipe pipe-hWrite f <win32-file> <writer> <duplex-stream> ] keep
-        drop ! TODO: close handles instead of drop
-    ] with-destructors ;
-

extra/io/windows/windows.factor

@@ -1,32 +1,31 @@
+! Copyright (C) 2004, 2007 Mackenzie Straight, Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types arrays destructors io io.backend
 io.buffers io.files io.nonblocking io.sockets io.binary
 io.sockets.impl windows.errors strings io.streams.duplex kernel
 math namespaces sequences windows windows.kernel32
-windows.winsock windows.winsock.private ;
+windows.winsock splitting ;
 IN: io.windows
 
 TUPLE: windows-nt-io ;
 TUPLE: windows-ce-io ;
 UNION: windows-io windows-nt-io windows-ce-io ;
 
-M: windows-io (handle-destructor) ( obj -- )
+M: windows-io destruct-handle CloseHandle drop ;
-    destructor-obj CloseHandle drop ;
 
-M: windows-io (socket-destructor) ( obj -- )
+M: windows-io destruct-socket closesocket drop ;
-    destructor-obj closesocket drop ;
 
 TUPLE: win32-file handle ptr overlapped ;
 
-: <win32-file>  ( handle ptr -- obj )
+: <win32-file> ( handle ptr -- obj )
-    { set-win32-file-handle set-win32-file-ptr }
+    f win32-file construct-boa ;
-    \ win32-file construct ;
 
 HOOK: CreateFile-flags io-backend ( -- DWORD )
 HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f )
 HOOK: add-completion io-backend ( port -- )
 
 M: windows-io normalize-directory ( string -- string )
-    dup peek CHAR: \\ = "*" "\\*" ? append ;
+    "\\" ?tail drop "\\*" append ;
 
 : share-mode ( -- fixnum )
     FILE_SHARE_READ FILE_SHARE_WRITE bitor ; inline

extra/windows/kernel32/kernel32.factor

@@ -135,8 +135,6 @@ TYPEDEF: FILE_NOTIFY_INFORMATION* PFILE_NOTIFY_INFORMATION
 : TIME_ZONE_ID_INVALID HEX: FFFFFFFF ; inline
 
 
-: CREATE_DEFAULT_ERROR_MODE HEX: 4000000 ; inline
-: DETACHED_PROCESS 8 ; inline
 : PF_XMMI64_INSTRUCTIONS_AVAILABLE 10 ; inline
 : PF_SSE3_INSTRUCTIONS_AVAILABLE 13 ; inline
 
@@ -614,6 +612,31 @@ FUNCTION: HANDLE CreateNamedPipeW ( LPCTSTR lpName, DWORD dwOpenMode, DWORD dwPi
 
 ! FUNCTION: CreateNlsSecurityDescriptor
 FUNCTION: BOOL CreatePipe ( PHANDLE hReadPipe, PHANDLE hWritePipe, LPSECURITY_ATTRIBUTES lpPipeAttributes, DWORD nSize ) ;
+
+: DEBUG_PROCESS                   HEX: 00000001 ;
+: DEBUG_ONLY_THIS_PROCESS         HEX: 00000002 ;
+: CREATE_SUSPENDED                HEX: 00000004 ;
+: DETACHED_PROCESS                HEX: 00000008 ;
+: CREATE_NEW_CONSOLE              HEX: 00000010 ;
+: NORMAL_PRIORITY_CLASS           HEX: 00000020 ;
+: IDLE_PRIORITY_CLASS             HEX: 00000040 ;
+: HIGH_PRIORITY_CLASS             HEX: 00000080 ;
+: REALTIME_PRIORITY_CLASS         HEX: 00000100 ;
+: CREATE_NEW_PROCESS_GROUP        HEX: 00000200 ;
+: CREATE_UNICODE_ENVIRONMENT      HEX: 00000400 ;
+: CREATE_SEPARATE_WOW_VDM         HEX: 00000800 ;
+: CREATE_SHARED_WOW_VDM           HEX: 00001000 ;
+: CREATE_FORCEDOS                 HEX: 00002000 ;
+: BELOW_NORMAL_PRIORITY_CLASS     HEX: 00004000 ;
+: ABOVE_NORMAL_PRIORITY_CLASS     HEX: 00008000 ;
+: CREATE_BREAKAWAY_FROM_JOB       HEX: 01000000 ;
+: CREATE_WITH_USERPROFILE         HEX: 02000000 ;
+: CREATE_DEFAULT_ERROR_MODE       HEX: 04000000 ;
+: CREATE_NO_WINDOW                HEX: 08000000 ;
+: PROFILE_USER                    HEX: 10000000 ;
+: PROFILE_KERNEL                  HEX: 20000000 ;
+: PROFILE_SERVER                  HEX: 40000000 ;
+
 FUNCTION: BOOL CreateProcessW ( LPCTSTR lpApplicationname,
                                 LPTSTR lpCommandLine,
                                 LPSECURITY_ATTRIBUTES lpProcessAttributes,
@@ -1471,7 +1494,7 @@ FUNCTION: BOOL VirtualQueryEx ( HANDLE hProcess, void* lpAddress, MEMORY_BASIC_I
 ! FUNCTION: WaitForDebugEvent
 ! FUNCTION: WaitForMultipleObjects
 ! FUNCTION: WaitForMultipleObjectsEx
-! FUNCTION: WaitForSingleObject
+FUNCTION: BOOL WaitForSingleObject ( HANDLE hHandle, DWORD dwMilliseconds ) ;
 ! FUNCTION: WaitForSingleObjectEx
 ! FUNCTION: WaitNamedPipeA
 ! FUNCTION: WaitNamedPipeW

extra/windows/winsock/winsock.factor

@@ -147,11 +147,9 @@ FUNCTION: int setsockopt ( SOCKET s, int level, int optname, char* optval, int o
 
 FUNCTION: ushort htons ( ushort n ) ;
 FUNCTION: ushort ntohs ( ushort n ) ;
-<PRIVATE
 FUNCTION: int bind ( void* socket, sockaddr_in* sockaddr, int len ) ;
 FUNCTION: int listen ( void* socket, int backlog ) ;
 FUNCTION: char* inet_ntoa ( int in-addr ) ;
-PRIVATE>
 FUNCTION: int getaddrinfo ( char* nodename,
                             char* servername,
                             addrinfo* hints,