Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/branches/primop-branch/src/runtime/c-libs/win32-process/win32-process.c
ViewVC logotype

Annotation of /sml/branches/primop-branch/src/runtime/c-libs/win32-process/win32-process.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1471 - (view) (download) (as text)

1 : monnier 249 /* win32-process.c
2 :     *
3 :     * COPYRIGHT (c) 1996 Bell Laboratories, Lucent Technologies
4 :     *
5 :     * interface to win32 process functions
6 :     */
7 :    
8 :     #include <windows.h>
9 :     #include <process.h>
10 :     #include <stdlib.h>
11 :    
12 :     #include "ml-base.h"
13 :     #include "ml-values.h"
14 :     #include "ml-objects.h"
15 :     #include "ml-c.h"
16 :    
17 :    
18 :     /* _ml_win32_PS_create_process : string -> word32
19 :     *
20 :     * Note: This function returns the handle to the created process
21 :     * This handle will need to be freed before the system releases
22 :     * the memory associated to the process.
23 :     * We will take care of this in the wait_for_single_object
24 :     * call. This is for the time being only used by CML.
25 :     * It could also cause problems later on.
26 :     */
27 :     ml_val_t _ml_win32_PS_create_process(ml_state_t *msp, ml_val_t arg)
28 :     {
29 :     char *str = STR_MLtoC(,arg);
30 :     PROCESS_INFORMATION pi;
31 :     STARTUPINFO si;
32 :     ml_val_t res;
33 :     BOOL fSuccess;
34 :     ZeroMemory (&si,sizeof(si));
35 :     si.cb = sizeof(si);
36 :     fSuccess = CreateProcess (NULL,str,NULL,NULL,FALSE,0,NULL,NULL,&si,&pi);
37 :     if (fSuccess) {
38 :     HANDLE hProcess = pi.hProcess;
39 :     CloseHandle (pi.hThread);
40 :     WORD_ALLOC (msp,res,(Word_t)hProcess);
41 :     return res;
42 :     }
43 :     WORD_ALLOC (msp,res,(Word_t)0);
44 :     return res;
45 :     }
46 :    
47 :     ml_val_t _ml_win32_PS_wait_for_single_object(ml_state_t *msp, ml_val_t arg)
48 :     {
49 :     HANDLE hProcess = (HANDLE) WORD_MLtoC (arg);
50 :     DWORD exit_code;
51 :     int res;
52 :     ml_val_t p,obj;
53 :     res = WaitForSingleObject (hProcess,0);
54 :     if (res==WAIT_TIMEOUT || res==WAIT_FAILED) {
55 :     /* information is not ready, or error */
56 :     obj = OPTION_NONE;
57 :     }
58 :     else {
59 :     /* WAIT_OBJECT_0 ... done, finished */
60 :     /* get info and return SOME(exit_status) */
61 :     GetExitCodeProcess (hProcess,&exit_code);
62 :     CloseHandle (hProcess); /* decrease ref count */
63 :     WORD_ALLOC (msp,p,(Word_t)exit_code);
64 :     OPTION_SOME(msp,obj,p);
65 :     }
66 :     return obj;
67 :     }
68 :    
69 :    
70 :     /* _ml_win32_PS_system : string -> word32
71 :     * command
72 :     *
73 :     */
74 :     ml_val_t _ml_win32_PS_system(ml_state_t *msp, ml_val_t arg)
75 :     {
76 :     int ret = system(STR_MLtoC(arg));
77 :     ml_val_t res;
78 :    
79 :     WORD_ALLOC(msp, res, (Word_t)ret);
80 :     return res;
81 :     }
82 :    
83 :     /* _ml_win32_PS_exit_process : word32 -> 'a
84 :     * exit code
85 :     *
86 :     */
87 :     void _ml_win32_PS_exit_process(ml_state_t *msp, ml_val_t arg)
88 :     {
89 :     ExitProcess((UINT)WORD_MLtoC(arg));
90 :     }
91 :    
92 :     /* _ml_win32_PS_get_environment_variable : string -> string option
93 :     * var
94 :     *
95 :     */
96 :     ml_val_t _ml_win32_PS_get_environment_variable(ml_state_t *msp, ml_val_t arg)
97 :     {
98 :     #define GEV_BUF_SZ 4096
99 :     char buf[GEV_BUF_SZ];
100 :     int ret = GetEnvironmentVariable(STR_MLtoC(arg),buf,GEV_BUF_SZ);
101 :     ml_val_t ml_s,res = OPTION_NONE;
102 :    
103 :     if (ret > GEV_BUF_SZ) {
104 :     return RAISE_SYSERR(msp,-1);
105 :     }
106 :     if (ret > 0) {
107 :     ml_s = ML_CString(msp,buf);
108 :     OPTION_SOME(msp,res,ml_s);
109 :     }
110 :     return res;
111 :     #undef GEV_BUF_SZ
112 :     }
113 :    
114 : macqueen 1471 /* _ml_win32_PS_sleep : word32 -> unit
115 :     *
116 :     * Suspend execution for interval in MILLIseconds.
117 :     */
118 :     ml_val_t _ml_win32_PS_sleep (ml_state_t *msp, ml_val_t arg)
119 :     {
120 :     Sleep ((DWORD) WORD_MLtoC(arg));
121 :     return ML_unit;
122 :     }
123 :    
124 : monnier 249 /* end of win32-process.c */

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0