From c9c7548ffd983df67e506bf4d347a6d53ff8faa0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 6 Mar 2008 20:45:56 -0600
Subject: [PATCH] Updating windows launcher for new-slots

---
 extra/io/windows/launcher/launcher.factor | 90 +++++++++++------------
 1 file changed, 43 insertions(+), 47 deletions(-)

diff --git a/extra/io/windows/launcher/launcher.factor b/extra/io/windows/launcher/launcher.factor
index 708dc1dc38..4af16ec375 100755
--- a/extra/io/windows/launcher/launcher.factor
+++ b/extra/io/windows/launcher/launcher.factor
@@ -5,7 +5,7 @@ io.windows io.windows.nt.pipes libc io.nonblocking
 io.streams.duplex windows.types math windows.kernel32 windows
 namespaces io.launcher kernel sequences windows.errors assocs
 splitting system threads init strings combinators
-io.backend ;
+io.backend new-slots accessors ;
 IN: io.windows.launcher
 
 TUPLE: CreateProcess-args
@@ -22,30 +22,25 @@ TUPLE: CreateProcess-args
        stdout-pipe stdin-pipe ;
 
 : default-CreateProcess-args ( -- obj )
-    0
+    CreateProcess-args construct-empty
+    0 >>dwCreateFlags
     "STARTUPINFO" <c-object>
-    "STARTUPINFO" heap-size over set-STARTUPINFO-cb
-    "PROCESS_INFORMATION" <c-object>
-    TRUE
-    {
-        set-CreateProcess-args-dwCreateFlags
-        set-CreateProcess-args-lpStartupInfo
-        set-CreateProcess-args-lpProcessInformation
-        set-CreateProcess-args-bInheritHandles
-    } \ CreateProcess-args construct ;
+    "STARTUPINFO" heap-size over set-STARTUPINFO-cb >>lpStartupInfo
+    "PROCESS_INFORMATION" <c-object> >>lpProcessInformation
+    TRUE >>bInheritHandles ;
 
 : call-CreateProcess ( CreateProcess-args -- )
     {
-        CreateProcess-args-lpApplicationName
-        CreateProcess-args-lpCommandLine
-        CreateProcess-args-lpProcessAttributes
-        CreateProcess-args-lpThreadAttributes
-        CreateProcess-args-bInheritHandles
-        CreateProcess-args-dwCreateFlags
-        CreateProcess-args-lpEnvironment
-        CreateProcess-args-lpCurrentDirectory
-        CreateProcess-args-lpStartupInfo
-        CreateProcess-args-lpProcessInformation
+        lpApplicationName>>
+        lpCommandLine>>
+        lpProcessAttributes>>
+        lpThreadAttributes>>
+        bInheritHandles>>
+        dwCreateFlags>>
+        lpEnvironment>>
+        lpCurrentDirectory>>
+        lpStartupInfo>>
+        lpProcessInformation>>
     } get-slots CreateProcess win32-error=0/f ;
 
 : escape-argument ( str -- newstr )
@@ -54,54 +49,55 @@ TUPLE: CreateProcess-args
 : join-arguments ( args -- cmd-line )
     [ escape-argument ] map " " join ;
 
-: app-name/cmd-line ( -- app-name cmd-line )
-    +command+ get [
+: app-name/cmd-line ( process -- app-name cmd-line )
+    command>> dup string? [
         " " split1
     ] [
-        +arguments+ get unclip swap join-arguments
-    ] if* ;
+        unclip swap join-arguments
+    ] if ;
 
-: cmd-line ( -- cmd-line )
-    +command+ get [ +arguments+ get join-arguments ] unless* ;
+: cmd-line ( process -- cmd-line )
+    command>> dup string? [ join-arguments ] unless ;
 
-: fill-lpApplicationName
-    app-name/cmd-line
-    pick set-CreateProcess-args-lpCommandLine
-    over set-CreateProcess-args-lpApplicationName ;
+: fill-lpApplicationName ( process args -- process args )
+    over app-name/cmd-line
+    >r >>lpApplicationName
+    r> >>lpCommandLine ;
 
-: fill-lpCommandLine
-    cmd-line over set-CreateProcess-args-lpCommandLine ;
+: fill-lpCommandLine ( process args -- process args )
+    over cmd-line >>lpCommandLine ;
 
-: fill-dwCreateFlags
+: fill-dwCreateFlags ( process args -- process args )
     0
-    pass-environment? [ CREATE_UNICODE_ENVIRONMENT bitor ] when
-    +detached+ get winnt? and [ DETACHED_PROCESS bitor ] when
-    over set-CreateProcess-args-dwCreateFlags ;
+    over pass-environment? [ CREATE_UNICODE_ENVIRONMENT bitor ] when
+    over detached>> winnt? and [ DETACHED_PROCESS bitor ] when
+    >>dwCreateFlags ;
 
-: fill-lpEnvironment
-    pass-environment? [
+: fill-lpEnvironment ( process args -- process args )
+    over pass-environment? [
         [
-            get-environment
+            over get-environment
             [ "=" swap 3append string>u16-alien % ] assoc-each
             "\0" %
         ] { } make >c-ushort-array
-        over set-CreateProcess-args-lpEnvironment
+        >>lpEnvironment
     ] when ;
 
-: fill-startup-info
-    dup CreateProcess-args-lpStartupInfo
+: fill-startup-info ( process args -- process args )
+    dup lpStartupInfo>>
     STARTF_USESTDHANDLES swap set-STARTUPINFO-dwFlags ;
 
-HOOK: fill-redirection io-backend ( args -- args )
+HOOK: fill-redirection io-backend ( process args -- process args )
 
 M: windows-ce-io fill-redirection ;
 
-: make-CreateProcess-args ( -- args )
+: make-CreateProcess-args ( process -- args )
     default-CreateProcess-args
     wince? [ fill-lpApplicationName ] [ fill-lpCommandLine ] if
     fill-dwCreateFlags
     fill-lpEnvironment
-    fill-startup-info ;
+    fill-startup-info
+    nip ;
 
 M: windows-io current-process-handle ( -- handle )
     GetCurrentProcessId ;
@@ -112,7 +108,7 @@ M: windows-io run-process* ( desc -- handle )
             make-CreateProcess-args
             fill-redirection
             dup call-CreateProcess
-            CreateProcess-args-lpProcessInformation <process>
+            CreateProcess-args-lpProcessInformation
         ] with-descriptor
     ] with-destructors ;