otherlibs/win32unix/winwait.c

   1 /***********************************************************************/
   2 /*                                                                     */
   3 /*                           Objective Caml                            */
   4 /*                                                                     */
   5 /*   Pascal Cuoq and Xavier Leroy, projet Cristal, INRIA Rocquencourt  */
   6 /*                                                                     */
   7 /*  Copyright 1996 Institut National de Recherche en Informatique et   */
   8 /*  en Automatique.  All rights reserved.  This file is distributed    */
   9 /*  under the terms of the GNU Library General Public License, with    */
  10 /*  the special exception on linking described in file ../../LICENSE.  */
  11 /*                                                                     */
  12 /***********************************************************************/
  13
  14 /* $Id$ */
  15
  16 #include <windows.h>
  17 #include <mlvalues.h>
  18 #include <alloc.h>
  19 #include <memory.h>
  20 #include "unixsupport.h"
  21 #include <sys/types.h>
  22
  23 static value alloc_process_status(HANDLE pid, int status)
  24 {
  25   value res, st;
  26
  27   st = alloc(1, 0);
  28   Field(st, 0) = Val_int(status);
  29   Begin_root (st);
  30     res = alloc_small(2, 0);
  31     Field(res, 0) = Val_long((intnat) pid);
  32     Field(res, 1) = st;
  33   End_roots();
  34   return res;
  35 }
  36
  37 enum { CAML_WNOHANG = 1, CAML_WUNTRACED = 2 };
  38
  39 static int wait_flag_table[] = { CAML_WNOHANG, CAML_WUNTRACED };
  40
  41 CAMLprim value win_waitpid(value vflags, value vpid_req)
  42 {
  43   int flags;
  44   DWORD status, retcode;
  45   HANDLE pid_req = (HANDLE) Long_val(vpid_req);
  46   DWORD err = 0;
  47
  48   flags = convert_flag_list(vflags, wait_flag_table);
  49   if ((flags & CAML_WNOHANG) == 0) {
  50     enter_blocking_section();
  51     retcode = WaitForSingleObject(pid_req, INFINITE);
  52     if (retcode == WAIT_FAILED) err = GetLastError();
  53     leave_blocking_section();
  54     if (err) {
  55       win32_maperr(err);
  56       uerror("waitpid", Nothing);
  57     }
  58   }
  59   if (! GetExitCodeProcess(pid_req, &status)) {
  60     win32_maperr(GetLastError());
  61     uerror("waitpid", Nothing);
  62   }
  63   if (status == STILL_ACTIVE)
  64     return alloc_process_status((HANDLE) 0, 0);
  65   else {
  66     CloseHandle(pid_req);
  67     return alloc_process_status(pid_req, status);
  68   }
  69 }