Menu
▾
▴
[Win32forth-cvs] win32forth/src CreateProcess.f, NONE, 1.1 Pre-save.f, 1.2, 1.3 Primutil.f, 1.55, 1.56 Shell.f, 1.11, 1.12 imageman.f, 1.28, 1.29 sysload.f, 1.3, 1.4 w32fMsg.f, 1.20, 1.21
|
From: George H. <geo...@us...> - 2013-03-07 15:29:05
|
Update of /cvsroot/win32forth/win32forth/src In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv7804 Modified Files: Pre-save.f Primutil.f Shell.f imageman.f sysload.f w32fMsg.f Added Files: CreateProcess.f Log Message: Removed dependencies between Shell.f and W32fMsg.f. Added file CreateProcess.f. Moved some values to Primutil.f from w32Msg.f to remove dependencies in imageman.f. Imroved save etc. Index: w32fMsg.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/w32fMsg.f,v retrieving revision 1.20 retrieving revision 1.21 diff -C2 -d -r1.20 -r1.21 *** w32fMsg.f 11 Jul 2011 18:50:40 -0000 1.20 --- w32fMsg.f 7 Mar 2013 15:29:02 -0000 1.21 *************** *** 112,123 **** \ ------------------------------------------------------------------------------ Require mapfile.f ! 0 value MyAppID \ *G My unique current win32forth application identifier \n \ ** A value of 0 means I don't share memory \n \ ** READ-ONLY : DON'T change this value directly, set \tNewAppID\d instead. ! 0 value NewAppID \ *G Set this value to change the ID of your application \n \ ** Change will be effective after either \tSAVE\d or \tTURNKEY\d . --- 112,125 ---- \ ------------------------------------------------------------------------------ + Require w32fMsgList.f + Require mapfile.f ! \ 0 value MyAppID \ *G My unique current win32forth application identifier \n \ ** A value of 0 means I don't share memory \n \ ** READ-ONLY : DON'T change this value directly, set \tNewAppID\d instead. ! \ 0 value NewAppID \ *G Set this value to change the ID of your application \n \ ** Change will be effective after either \tSAVE\d or \tTURNKEY\d . *************** *** 125,135 **** \ ** Used to configurate your application ! 0 value RunUnique \ *G Set this value to true if you want your application to run as a unique instance \n \ ** Change will be effective after either \tSAVE\d or \tTURNKEY\d . \n \ ** Used to configurate your application ! 0 value MyRunUnique \ true if I am running as a unique instance ! 0 value StopLaunching \ true if a new instance of me must be stopped create w32fshareName \ a complex enough win32forth application shared-memory name z," *.Win32ForthSharedMemory.*" --- 127,136 ---- \ ** Used to configurate your application ! \ 0 value RunUnique \ *G Set this value to true if you want your application to run as a unique instance \n \ ** Change will be effective after either \tSAVE\d or \tTURNKEY\d . \n \ ** Used to configurate your application ! \ 0 value MyRunUnique \ true if I am running as a unique instance create w32fshareName \ a complex enough win32forth application shared-memory name z," *.Win32ForthSharedMemory.*" *************** *** 188,191 **** --- 189,201 ---- -1 abort" in EnableW32FMsg : Enable shared memory before messaging" ; + : (?EnableConsoleMessages) ( -- ) + MyAppID w32fForth = \ if win32for.exe itself + if conhndl EnableW32FMsg then ; \ enable messaging thru Console + + : Set?EnableConsoleMessages ( -- ) + ['] (?EnableConsoleMessages) is ?EnableConsoleMessages ; + + initialization-chain chain-add Set?EnableConsoleMessages + : SetShared ( AppID -- ) \ append AppID record in shared memory w32fsharep \ get next available record *************** *** 456,518 **** \ ------------------------------------------------------------------------------ ! 10 proc CreateProcess ! 1 proc CloseHandle ! 1 proc IsIconic ! 2 proc ShowWindow ! 1 proc SetForegroundWindow ! 2 proc WaitForInputIdle ! ! create StartupInfo ! NoStack here 0 , \ cb ! 0 , \ lpReserved ! 0 , \ lpDesktop ! 0 , \ lpTitle ! 0 , \ dwX ! 0 , \ dwY ! 0 , \ dwXSize ! 0 , \ dwYSize ! 0 , \ dwXCountChars ! 0 , \ dwYCountChars ! 0 , \ dwFillAttribute ! STARTF_USESHOWWINDOW , \ dwFlags ! SW_SHOWNORMAL W, \ wShowWindow ! 0 W, \ cbReserved2 ! 0 , \ lpReserved2 ! 0 , \ hStdInput ! 0 , \ hStdOutput ! 0 , \ hStdError ! here over - swap ! ! ! create ProcInfo ! 0 , \ hProcess ! 0 , \ hThread ! 0 , \ dwPriocessId ! 0 , \ dwThreadId ! ! create processcmd max-path 1+ allot \ counted null-terminated command line ! ! : [CreateProcess] ( addr len -- flag ) \ create the process given as the first token in ! \ the "command line" addr/len . Flag true if failed ! ProcInfo 4 cells erase \ clear procinfo ! processcmd place ! processcmd +null \ null terminated command line string ! ProcInfo \ lppiProcInfo ! StartupInfo \ lpsiStartInfo ! 0 \ lpszCurDir ! 0 \ lpvEnvironment ! 0 \ fdwCreate ! 0 \ fInheritHandles ! 0 \ lpsaThread ! 0 \ lpsaProcess ! processcmd 1+ \ lpszCommandLine ! 0 \ lpszImageName ! call CreateProcess 0= ; ! ! : CloseProcess ( -- ) \ close process handle of opened process ! ProcInfo @ call CloseHandle drop ; \ process ! ! : CloseThread ( -- ) \ close thread handle of opened process ! ProcInfo cell+ @ call CloseHandle drop ; \ thread ! \ ------------------------------------------------------------------------------ --- 466,470 ---- \ ------------------------------------------------------------------------------ ! Require CreateProcess.f \ ------------------------------------------------------------------------------ *************** *** 543,547 **** SetForegroundWindow drop \ and activate it 2drop 0 ! else >r [createprocess] \ launch the w32fapp if r>drop -1 else 2000 30 time-taken * + ( ms) ProcInfo @ \ give the launched process a.. --- 495,499 ---- SetForegroundWindow drop \ and activate it 2drop 0 ! else >r ((createprocess)) \ launch the w32fapp if r>drop -1 else 2000 30 time-taken * + ( ms) ProcInfo @ \ give the launched process a.. Index: sysload.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/sysload.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** sysload.f 19 Aug 2011 13:10:45 -0000 1.3 --- sysload.f 7 Mar 2013 15:29:02 -0000 1.4 *************** *** 209,213 **** [char] " r@ c+place ! s" src=lib\" prepend<home>\ r@ +place bl word count -trailing r@ +place s" \*.F" r@ +place --- 209,213 ---- [char] " r@ c+place ! s" src\lib\" prepend<home>\ r@ +place bl word count -trailing r@ +place s" \*.F" r@ +place Index: Shell.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Shell.f,v retrieving revision 1.11 retrieving revision 1.12 diff -C2 -d -r1.11 -r1.12 *** Shell.f 31 Aug 2010 08:02:47 -0000 1.11 --- Shell.f 7 Mar 2013 15:29:02 -0000 1.12 *************** *** 13,19 **** ! \ [CreateProcess] is defined in w32fmsg.f ! Require w32fmsg.f 2 proc WaitForInputIdle --- 13,19 ---- ! \ ((CreateProcess)) is defined in CreateProcess.f ! Require CreateProcess.f 2 proc WaitForInputIdle *************** *** 36,40 **** : zEXEC-CMD ( a1 -- f1 ) \ execute a command line ! count [CreateProcess] dup 0= if CloseThread CloseProcess --- 36,40 ---- : zEXEC-CMD ( a1 -- f1 ) \ execute a command line ! count ((CreateProcess)) dup 0= if CloseThread CloseProcess *************** *** 42,46 **** : zEXEC-CMD-WAIT ( a1 -- f1 ) \ execute a command line, and wait for terminating of the process ! count [CreateProcess] dup 0= IF CloseThread \ close the thread handle EXEC-PROCESS-WAIT \ wait for the process --- 42,46 ---- : zEXEC-CMD-WAIT ( a1 -- f1 ) \ execute a command line, and wait for terminating of the process ! count ((CreateProcess)) dup 0= IF CloseThread \ close the thread handle EXEC-PROCESS-WAIT \ wait for the process Index: imageman.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/imageman.f,v retrieving revision 1.28 retrieving revision 1.29 diff -C2 -d -r1.28 -r1.29 *** imageman.f 5 Mar 2013 20:46:01 -0000 1.28 --- imageman.f 7 Mar 2013 15:29:02 -0000 1.29 *************** *** 864,869 **** s" Exception occured in Forth initialization" MsgBox \ .exception ? ! else MyAppID w32fForth = \ if win32for.exe itself ! if conhndl EnableW32FMsg then \ enable messaging thru Console action-of default-application catch --- 864,868 ---- s" Exception occured in Forth initialization" MsgBox \ .exception ? ! else ?EnableConsoleMessages action-of default-application catch *************** *** 931,953 **** ! : ((SAVE)) { addr len \ $name -- } \ build .exe ! MAXSTRING localAlloc: $name ! z" .EXE" \ .exe extension ! addr len $name ascii-z dup>r \ z-string the name ! call PathAddExtension drop \ add extension ! r> zcount &appdir count \ add application directory ! MakeAbsolutePath count \ if needed ! STD-IMG2EXE \ make image ! IMAGE-PTR release ; \ free image-copy buffer - : (SAVE) ( addr len -- ) \ use current image & build .exe - 2>r - MyAppId \ save saver's app params - if MyAppId SharedHwnd -1 - MyAppId MyRunUnique - else 0 0 0 - then \ ( -- [hwnd id runmode] id ) ConsoleMode --- 930,948 ---- ! \ : ((SAVE)) { addr len \ $name -- } \ build .exe ! \ MAXSTRING localAlloc: $name ! \ z" .EXE" \ .exe extension ! \ addr len $name ascii-z dup>r \ z-string the name ! \ call PathAddExtension drop \ add extension ! \ r> zcount &appdir count \ add application directory ! \ MakeAbsolutePath count \ if needed ! \ ! \ STD-IMG2EXE \ make image ! \ IMAGE-PTR release ; \ free image-copy buffer ! \ ! : (SAVE) { addr len | $name -- } \ use current image & build .exe ConsoleMode *************** *** 961,974 **** is DoConsoleBoot \ set SAVEd console mode 0 to ConsoleMode \ reset default (saver & image) ! RunAsNewAppID \ transiently switch to new appID IMAGE-COPY \ create memory .img ! 2r> ['] ((SAVE)) catch >r \ save memory image ! to RunUnique to NewAppID \ restore saver's app params ! RunAsNewAppID ! if EnableW32fMsg then - r> throw ; \ throw error after restore \ Note: no need to preserve BOOT and DEFAULT-APPLICATION because they are both --- 956,972 ---- is DoConsoleBoot \ set SAVEd console mode 0 to ConsoleMode \ reset default (saver & image) ! IMAGE-COPY \ create memory .img ! MAXSTRING localAlloc: $name ! z" .EXE" \ .exe extension ! addr len $name ascii-z dup>r \ z-string the name ! call PathAddExtension drop \ add extension ! r> zcount &appdir count \ add application directory ! MakeAbsolutePath count \ if needed ! STD-IMG2EXE \ make image ! IMAGE-PTR release ; \ free image-copy buffer \ Note: no need to preserve BOOT and DEFAULT-APPLICATION because they are both *************** *** 985,991 **** r> is default-application &except off \ no previous exceptions... ! 2r> ['] (SAVE) catch >r ! ! r> throw ; \ throw error after restore : SAVE ( cfa -<exename>- -- ) \ create application "exename" that runs the --- 983,987 ---- r> is default-application &except off \ no previous exceptions... ! 2r> (SAVE) ; : SAVE ( cfa -<exename>- -- ) \ create application "exename" that runs the Index: Pre-save.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Pre-save.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** Pre-save.f 3 Mar 2012 09:15:14 -0000 1.2 --- Pre-save.f 7 Mar 2013 15:29:02 -0000 1.3 *************** *** 31,33 **** --- 31,46 ---- pre-save-image-chain chain-add init-image-handles + : Init?EnableConsoleMessages ( -- ) + ['] noop ['] ?EnableConsoleMessages >image >body ! ; + + pre-save-image-chain chain-add Init?EnableConsoleMessages + in-previous + + : PreInitAppID ( -- ) + NewAppID &of MyAppID >image ! + RunUnique &of MyRunUnique >image ! + 0 to RunUnique \ restore defaults + 0 to NewAppID ; + + pre-save-image-chain chain-add PreInitAppID Index: Primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Primutil.f,v retrieving revision 1.55 retrieving revision 1.56 diff -C2 -d -r1.55 -r1.56 *** Primutil.f 14 Feb 2013 20:05:48 -0000 1.55 --- Primutil.f 7 Mar 2013 15:29:02 -0000 1.56 *************** *** 185,193 **** : defer@ ( xt1 -- xt2 ) \ 200X Core ext x:deferred ! \ *G xt1 is deffered word. xt2 is current setting. ?is >body @ ; : DEFER! ( xt2 xt1 -- ) \ 200X Core ext x:deferred ! \ *G xt1 is deffered word. xt2 is new setting. ?is >body ! ; --- 185,193 ---- : defer@ ( xt1 -- xt2 ) \ 200X Core ext x:deferred ! \ *G xt1 is deferred word. xt2 is current setting. ?is >body @ ; : DEFER! ( xt2 xt1 -- ) \ 200X Core ext x:deferred ! \ *G xt1 is deferred word. xt2 is new setting. ?is >body ! ; *************** *** 957,960 **** --- 957,974 ---- : ERASE$ ( adr - ) MAXSTRING ERASE ; + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + + 0 value MyAppID + 0 value NewAppID + 0 value RunUnique + 0 value MyRunUnique + 0 value StopLaunching \ true if a new instance of me must be stopped + + defer ?EnableConsoleMessages + ' noop is ?EnableConsoleMessages + + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- NEW FILE: CreateProcess.f --- \ $Id: CreateProcess.f,v 1.1 2013/03/07 15:29:02 georgeahubert Exp $ \ Made into separate file since it's used by both w32fMsg.f and Shell.f 10 proc CreateProcess 1 proc CloseHandle 1 proc IsIconic 2 proc ShowWindow 1 proc SetForegroundWindow 2 proc WaitForInputIdle create StartupInfo NoStack here 0 , \ cb 0 , \ lpReserved 0 , \ lpDesktop 0 , \ lpTitle 0 , \ dwX 0 , \ dwY 0 , \ dwXSize 0 , \ dwYSize 0 , \ dwXCountChars 0 , \ dwYCountChars 0 , \ dwFillAttribute STARTF_USESHOWWINDOW , \ dwFlags SW_SHOWNORMAL W, \ wShowWindow 0 W, \ cbReserved2 0 , \ lpReserved2 0 , \ hStdInput 0 , \ hStdOutput 0 , \ hStdError here over - swap ! create ProcInfo 0 , \ hProcess 0 , \ hThread 0 , \ dwPriocessId 0 , \ dwThreadId create processcmd max-path 1+ allot \ counted null-terminated command line : ((CreateProcess)) ( addr len -- flag ) \ create the process given as the first token in the "command line" addr/len . Flag true if failed ProcInfo 4 cells erase \ clear procinfo processcmd place processcmd +null \ null terminated command line string ProcInfo \ lppiProcInfo StartupInfo \ lpsiStartInfo 0 \ lpszCurDir 0 \ lpvEnvironment 0 \ fdwCreate 0 \ fInheritHandles 0 \ lpsaThread 0 \ lpsaProcess processcmd 1+ \ lpszCommandLine 0 \ lpszImageName call CreateProcess 0= ; : CloseProcess ( -- ) \ close process handle of opened process ProcInfo @ call CloseHandle drop ; \ process : CloseThread ( -- ) \ close thread handle of opened process ProcInfo cell+ @ call CloseHandle drop ; \ thread |
